]> git.sur5r.net Git - openocd/blob - src/helper/jim.c
Audit and reduce #include directives in jim source files.
[openocd] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2  *
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>
11  * 
12  * The FreeBSD license
13  * 
14  * Redistribution and use in source and binary forms, with or without
15  * modification, are permitted provided that the following conditions
16  * are met:
17  * 
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.
24  * 
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.
37  * 
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.
41  **/
42 #ifdef HAVE_CONFIG_H
43 #include "config.h"
44 #endif
45
46 #define __JIM_CORE__
47 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
48
49 #ifdef __ECOS
50 #include <pkgconf/jimtcl.h>
51 #endif
52 #ifndef JIM_ANSIC
53 #define JIM_DYNLIB      /* Dynamic library support for UNIX and WIN32 */
54 #endif /* JIM_ANSIC */
55
56 #include <stdarg.h>
57 #include <limits.h>
58
59 #include "replacements.h"
60
61 /* Include the platform dependent libraries for
62  * dynamic loading of libraries. */
63 #ifdef JIM_DYNLIB
64 #if defined(_WIN32) || defined(WIN32)
65 #ifndef WIN32
66 #define WIN32 1
67 #endif
68 #ifndef STRICT
69 #define STRICT
70 #endif
71 #define WIN32_LEAN_AND_MEAN
72 #include <windows.h>
73 #if _MSC_VER >= 1000
74 #pragma warning(disable:4146)
75 #endif /* _MSC_VER */
76 #else
77 #include <dlfcn.h>
78 #endif /* WIN32 */
79 #endif /* JIM_DYNLIB */
80
81 #ifdef __ECOS
82 #include <cyg/jimtcl/jim.h>
83 #else
84 #include "jim.h"
85 #endif
86
87 #ifdef HAVE_BACKTRACE
88 #include <execinfo.h>
89 #endif
90
91 /* -----------------------------------------------------------------------------
92  * Global variables
93  * ---------------------------------------------------------------------------*/
94
95 /* A shared empty string for the objects string representation.
96  * Jim_InvalidateStringRep knows about it and don't try to free. */
97 static char *JimEmptyStringRep = (char*) "";
98
99 /* -----------------------------------------------------------------------------
100  * Required prototypes of not exported functions
101  * ---------------------------------------------------------------------------*/
102 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
103 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
104 static void JimRegisterCoreApi(Jim_Interp *interp);
105
106 static Jim_HashTableType *getJimVariablesHashTableType(void);
107
108 /* -----------------------------------------------------------------------------
109  * Utility functions
110  * ---------------------------------------------------------------------------*/
111
112 static char *
113 jim_vasprintf( const char *fmt, va_list ap )
114 {
115 #ifndef HAVE_VASPRINTF
116         /* yucky way */
117 static char buf[2048];
118         vsnprintf( buf, sizeof(buf), fmt, ap );
119         /* garentee termination */
120         buf[sizeof(buf)-1] = 0;
121 #else
122         char *buf;
123         int result;
124         result = vasprintf( &buf, fmt, ap );
125         if (result < 0) exit(-1);
126 #endif
127         return buf;
128 }
129
130 static void
131 jim_vasprintf_done( void *buf )
132 {
133 #ifndef HAVE_VASPRINTF
134         (void)(buf);
135 #else
136         free(buf);
137 #endif
138 }
139         
140
141 /*
142  * Convert a string to a jim_wide INTEGER.
143  * This function originates from BSD.
144  *
145  * Ignores `locale' stuff.  Assumes that the upper and lower case
146  * alphabets and digits are each contiguous.
147  */
148 #ifdef HAVE_LONG_LONG_INT
149 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
150 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
151 {
152     register const char *s;
153     register unsigned jim_wide acc;
154     register unsigned char c;
155     register unsigned jim_wide qbase, cutoff;
156     register int neg, any, cutlim;
157
158     /*
159      * Skip white space and pick up leading +/- sign if any.
160      * If base is 0, allow 0x for hex and 0 for octal, else
161      * assume decimal; if base is already 16, allow 0x.
162      */
163     s = nptr;
164     do {
165         c = *s++;
166     } while (isspace(c));
167     if (c == '-') {
168         neg = 1;
169         c = *s++;
170     } else {
171         neg = 0;
172         if (c == '+')
173             c = *s++;
174     }
175     if ((base == 0 || base == 16) &&
176         c == '0' && (*s == 'x' || *s == 'X')) {
177         c = s[1];
178         s += 2;
179         base = 16;
180     }
181     if (base == 0)
182         base = c == '0' ? 8 : 10;
183
184     /*
185      * Compute the cutoff value between legal numbers and illegal
186      * numbers.  That is the largest legal value, divided by the
187      * base.  An input number that is greater than this value, if
188      * followed by a legal input character, is too big.  One that
189      * is equal to this value may be valid or not; the limit
190      * between valid and invalid numbers is then based on the last
191      * digit.  For instance, if the range for quads is
192      * [-9223372036854775808..9223372036854775807] and the input base
193      * is 10, cutoff will be set to 922337203685477580 and cutlim to
194      * either 7 (neg==0) or 8 (neg==1), meaning that if we have
195      * accumulated a value > 922337203685477580, or equal but the
196      * next digit is > 7 (or 8), the number is too big, and we will
197      * return a range error.
198      *
199      * Set any if any `digits' consumed; make it negative to indicate
200      * overflow.
201      */
202     qbase = (unsigned)base;
203     cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
204         : LLONG_MAX;
205     cutlim = (int)(cutoff % qbase);
206     cutoff /= qbase;
207     for (acc = 0, any = 0;; c = *s++) {
208         if (!JimIsAscii(c))
209             break;
210         if (isdigit(c))
211             c -= '0';
212         else if (isalpha(c))
213             c -= isupper(c) ? 'A' - 10 : 'a' - 10;
214         else
215             break;
216         if (c >= base)
217             break;
218         if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
219             any = -1;
220         else {
221             any = 1;
222             acc *= qbase;
223             acc += c;
224         }
225     }
226     if (any < 0) {
227         acc = neg ? LLONG_MIN : LLONG_MAX;
228         errno = ERANGE;
229     } else if (neg)
230         acc = -acc;
231     if (endptr != 0)
232         *endptr = (char *)(any ? s - 1 : nptr);
233     return (acc);
234 }
235 #endif
236
237 /* Glob-style pattern matching. */
238 static int JimStringMatch(const char *pattern, int patternLen,
239         const char *string, int stringLen, int nocase)
240 {
241     while(patternLen) {
242         switch(pattern[0]) {
243         case '*':
244             while (pattern[1] == '*') {
245                 pattern++;
246                 patternLen--;
247             }
248             if (patternLen == 1)
249                 return 1; /* match */
250             while(stringLen) {
251                 if (JimStringMatch(pattern+1, patternLen-1,
252                             string, stringLen, nocase))
253                     return 1; /* match */
254                 string++;
255                 stringLen--;
256             }
257             return 0; /* no match */
258             break;
259         case '?':
260             if (stringLen == 0)
261                 return 0; /* no match */
262             string++;
263             stringLen--;
264             break;
265         case '[':
266         {
267             int not, match;
268
269             pattern++;
270             patternLen--;
271             not = pattern[0] == '^';
272             if (not) {
273                 pattern++;
274                 patternLen--;
275             }
276             match = 0;
277             while(1) {
278                 if (pattern[0] == '\\') {
279                     pattern++;
280                     patternLen--;
281                     if (pattern[0] == string[0])
282                         match = 1;
283                 } else if (pattern[0] == ']') {
284                     break;
285                 } else if (patternLen == 0) {
286                     pattern--;
287                     patternLen++;
288                     break;
289                 } else if (pattern[1] == '-' && patternLen >= 3) {
290                     int start = pattern[0];
291                     int end = pattern[2];
292                     int c = string[0];
293                     if (start > end) {
294                         int t = start;
295                         start = end;
296                         end = t;
297                     }
298                     if (nocase) {
299                         start = tolower(start);
300                         end = tolower(end);
301                         c = tolower(c);
302                     }
303                     pattern += 2;
304                     patternLen -= 2;
305                     if (c >= start && c <= end)
306                         match = 1;
307                 } else {
308                     if (!nocase) {
309                         if (pattern[0] == string[0])
310                             match = 1;
311                     } else {
312                         if (tolower((int)pattern[0]) == tolower((int)string[0]))
313                             match = 1;
314                     }
315                 }
316                 pattern++;
317                 patternLen--;
318             }
319             if (not)
320                 match = !match;
321             if (!match)
322                 return 0; /* no match */
323             string++;
324             stringLen--;
325             break;
326         }
327         case '\\':
328             if (patternLen >= 2) {
329                 pattern++;
330                 patternLen--;
331             }
332             /* fall through */
333         default:
334             if (!nocase) {
335                 if (pattern[0] != string[0])
336                     return 0; /* no match */
337             } else {
338                 if (tolower((int)pattern[0]) != tolower((int)string[0]))
339                     return 0; /* no match */
340             }
341             string++;
342             stringLen--;
343             break;
344         }
345         pattern++;
346         patternLen--;
347         if (stringLen == 0) {
348             while(*pattern == '*') {
349                 pattern++;
350                 patternLen--;
351             }
352             break;
353         }
354     }
355     if (patternLen == 0 && stringLen == 0)
356         return 1;
357     return 0;
358 }
359
360 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
361         int nocase)
362 {
363     unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
364
365     if (nocase == 0) {
366         while(l1 && l2) {
367             if (*u1 != *u2)
368                 return (int)*u1-*u2;
369             u1++; u2++; l1--; l2--;
370         }
371         if (!l1 && !l2) return 0;
372         return l1-l2;
373     } else {
374         while(l1 && l2) {
375             if (tolower((int)*u1) != tolower((int)*u2))
376                 return tolower((int)*u1)-tolower((int)*u2);
377             u1++; u2++; l1--; l2--;
378         }
379         if (!l1 && !l2) return 0;
380         return l1-l2;
381     }
382 }
383
384 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
385  * The index of the first occurrence of s1 in s2 is returned. 
386  * If s1 is not found inside s2, -1 is returned. */
387 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
388 {
389     int i;
390
391     if (!l1 || !l2 || l1 > l2) return -1;
392     if (index < 0) index = 0;
393     s2 += index;
394     for (i = index; i <= l2-l1; i++) {
395         if (memcmp(s2, s1, l1) == 0)
396             return i;
397         s2++;
398     }
399     return -1;
400 }
401
402 int Jim_WideToString(char *buf, jim_wide wideValue)
403 {
404     const char *fmt = "%" JIM_WIDE_MODIFIER;
405     return sprintf(buf, fmt, wideValue);
406 }
407
408 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
409 {
410     char *endptr;
411
412 #ifdef HAVE_LONG_LONG_INT
413     *widePtr = JimStrtoll(str, &endptr, base);
414 #else
415     *widePtr = strtol(str, &endptr, base);
416 #endif
417     if ((str[0] == '\0') || (str == endptr) )
418         return JIM_ERR;
419     if (endptr[0] != '\0') {
420         while(*endptr) {
421             if (!isspace((int)*endptr))
422                 return JIM_ERR;
423             endptr++;
424         }
425     }
426     return JIM_OK;
427 }
428
429 int Jim_StringToIndex(const char *str, int *intPtr)
430 {
431     char *endptr;
432
433     *intPtr = strtol(str, &endptr, 10);
434     if ( (str[0] == '\0') || (str == endptr) )
435         return JIM_ERR;
436     if (endptr[0] != '\0') {
437         while(*endptr) {
438             if (!isspace((int)*endptr))
439                 return JIM_ERR;
440             endptr++;
441         }
442     }
443     return JIM_OK;
444 }
445
446 /* The string representation of references has two features in order
447  * to make the GC faster. The first is that every reference starts
448  * with a non common character '~', in order to make the string matching
449  * fater. The second is that the reference string rep his 32 characters
450  * in length, this allows to avoid to check every object with a string
451  * repr < 32, and usually there are many of this objects. */
452
453 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
454
455 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
456 {
457     const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
458     sprintf(buf, fmt, refPtr->tag, id);
459     return JIM_REFERENCE_SPACE;
460 }
461
462 int Jim_DoubleToString(char *buf, double doubleValue)
463 {
464     char *s;
465     int len;
466
467     len = sprintf(buf, "%.17g", doubleValue);
468     s = buf;
469     while(*s) {
470         if (*s == '.') return len;
471         s++;
472     }
473     /* Add a final ".0" if it's a number. But not
474      * for NaN or InF */
475     if (isdigit((int)buf[0])
476         || ((buf[0] == '-' || buf[0] == '+')
477             && isdigit((int)buf[1]))) {
478         s[0] = '.';
479         s[1] = '0';
480         s[2] = '\0';
481         return len+2;
482     }
483     return len;
484 }
485
486 int Jim_StringToDouble(const char *str, double *doublePtr)
487 {
488     char *endptr;
489
490     *doublePtr = strtod(str, &endptr);
491     if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
492         return JIM_ERR;
493     return JIM_OK;
494 }
495
496 static jim_wide JimPowWide(jim_wide b, jim_wide e)
497 {
498     jim_wide i, res = 1;
499     if ((b==0 && e!=0) || (e<0)) return 0;
500     for(i=0; i<e; i++) {res *= b;}
501     return res;
502 }
503
504 /* -----------------------------------------------------------------------------
505  * Special functions
506  * ---------------------------------------------------------------------------*/
507
508 /* Note that 'interp' may be NULL if not available in the
509  * context of the panic. It's only useful to get the error
510  * file descriptor, it will default to stderr otherwise. */
511 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
512 {
513     va_list ap;
514
515     va_start(ap, fmt);
516         /* 
517          * Send it here first.. Assuming STDIO still works
518          */
519     fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
520     vfprintf(stderr, fmt, ap);
521     fprintf(stderr, JIM_NL JIM_NL);
522     va_end(ap);
523
524 #ifdef HAVE_BACKTRACE
525     {
526         void *array[40];
527         int size, i;
528         char **strings;
529
530         size = backtrace(array, 40);
531         strings = backtrace_symbols(array, size);
532         for (i = 0; i < size; i++)
533             fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
534         fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
535         fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
536     }
537 #endif
538         
539         /* This may actually crash... we do it last */
540         if( interp && interp->cookie_stderr ){
541                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
542                 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
543                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL JIM_NL );
544         }
545     abort();
546 }
547
548 /* -----------------------------------------------------------------------------
549  * Memory allocation
550  * ---------------------------------------------------------------------------*/
551
552 /* Macro used for memory debugging.
553  * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
554  * and similary for Jim_Realloc and Jim_Free */
555 #if 0
556 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
557 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
558 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
559 #endif
560
561 void *Jim_Alloc(int size)
562 {
563         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
564         if (size==0)
565                 size=1;
566     void *p = malloc(size);
567     if (p == NULL)
568         Jim_Panic(NULL,"malloc: Out of memory");
569     return p;
570 }
571
572 void Jim_Free(void *ptr) {
573     free(ptr);
574 }
575
576 void *Jim_Realloc(void *ptr, int size)
577 {
578         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
579         if (size==0)
580                 size=1;
581     void *p = realloc(ptr, size);
582     if (p == NULL)
583         Jim_Panic(NULL,"realloc: Out of memory");
584     return p;
585 }
586
587 char *Jim_StrDup(const char *s)
588 {
589     int l = strlen(s);
590     char *copy = Jim_Alloc(l+1);
591
592     memcpy(copy, s, l+1);
593     return copy;
594 }
595
596 char *Jim_StrDupLen(const char *s, int l)
597 {
598     char *copy = Jim_Alloc(l+1);
599     
600     memcpy(copy, s, l+1);
601     copy[l] = 0;    /* Just to be sure, original could be substring */
602     return copy;
603 }
604
605 /* -----------------------------------------------------------------------------
606  * Time related functions
607  * ---------------------------------------------------------------------------*/
608 /* Returns microseconds of CPU used since start. */
609 static jim_wide JimClock(void)
610 {
611 #if (defined WIN32) && !(defined JIM_ANSIC)
612     LARGE_INTEGER t, f;
613     QueryPerformanceFrequency(&f);
614     QueryPerformanceCounter(&t);
615     return (long)((t.QuadPart * 1000000) / f.QuadPart);
616 #else /* !WIN32 */
617     clock_t clocks = clock();
618
619     return (long)(clocks*(1000000/CLOCKS_PER_SEC));
620 #endif /* WIN32 */
621 }
622
623 /* -----------------------------------------------------------------------------
624  * Hash Tables
625  * ---------------------------------------------------------------------------*/
626
627 /* -------------------------- private prototypes ---------------------------- */
628 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
629 static unsigned int JimHashTableNextPower(unsigned int size);
630 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
631
632 /* -------------------------- hash functions -------------------------------- */
633
634 /* Thomas Wang's 32 bit Mix Function */
635 unsigned int Jim_IntHashFunction(unsigned int key)
636 {
637     key += ~(key << 15);
638     key ^=  (key >> 10);
639     key +=  (key << 3);
640     key ^=  (key >> 6);
641     key += ~(key << 11);
642     key ^=  (key >> 16);
643     return key;
644 }
645
646 /* Identity hash function for integer keys */
647 unsigned int Jim_IdentityHashFunction(unsigned int key)
648 {
649     return key;
650 }
651
652 /* Generic hash function (we are using to multiply by 9 and add the byte
653  * as Tcl) */
654 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
655 {
656     unsigned int h = 0;
657     while(len--)
658         h += (h<<3)+*buf++;
659     return h;
660 }
661
662 /* ----------------------------- API implementation ------------------------- */
663 /* reset an hashtable already initialized with ht_init().
664  * NOTE: This function should only called by ht_destroy(). */
665 static void JimResetHashTable(Jim_HashTable *ht)
666 {
667     ht->table = NULL;
668     ht->size = 0;
669     ht->sizemask = 0;
670     ht->used = 0;
671     ht->collisions = 0;
672 }
673
674 /* Initialize the hash table */
675 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
676         void *privDataPtr)
677 {
678     JimResetHashTable(ht);
679     ht->type = type;
680     ht->privdata = privDataPtr;
681     return JIM_OK;
682 }
683
684 /* Resize the table to the minimal size that contains all the elements,
685  * but with the invariant of a USER/BUCKETS ration near to <= 1 */
686 int Jim_ResizeHashTable(Jim_HashTable *ht)
687 {
688     int minimal = ht->used;
689
690     if (minimal < JIM_HT_INITIAL_SIZE)
691         minimal = JIM_HT_INITIAL_SIZE;
692     return Jim_ExpandHashTable(ht, minimal);
693 }
694
695 /* Expand or create the hashtable */
696 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
697 {
698     Jim_HashTable n; /* the new hashtable */
699     unsigned int realsize = JimHashTableNextPower(size), i;
700
701     /* the size is invalid if it is smaller than the number of
702      * elements already inside the hashtable */
703     if (ht->used >= size)
704         return JIM_ERR;
705
706     Jim_InitHashTable(&n, ht->type, ht->privdata);
707     n.size = realsize;
708     n.sizemask = realsize-1;
709     n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
710
711     /* Initialize all the pointers to NULL */
712     memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
713
714     /* Copy all the elements from the old to the new table:
715      * note that if the old hash table is empty ht->size is zero,
716      * so Jim_ExpandHashTable just creates an hash table. */
717     n.used = ht->used;
718     for (i = 0; i < ht->size && ht->used > 0; i++) {
719         Jim_HashEntry *he, *nextHe;
720
721         if (ht->table[i] == NULL) continue;
722         
723         /* For each hash entry on this slot... */
724         he = ht->table[i];
725         while(he) {
726             unsigned int h;
727
728             nextHe = he->next;
729             /* Get the new element index */
730             h = Jim_HashKey(ht, he->key) & n.sizemask;
731             he->next = n.table[h];
732             n.table[h] = he;
733             ht->used--;
734             /* Pass to the next element */
735             he = nextHe;
736         }
737     }
738     assert(ht->used == 0);
739     Jim_Free(ht->table);
740
741     /* Remap the new hashtable in the old */
742     *ht = n;
743     return JIM_OK;
744 }
745
746 /* Add an element to the target hash table */
747 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
748 {
749     int index;
750     Jim_HashEntry *entry;
751
752     /* Get the index of the new element, or -1 if
753      * the element already exists. */
754     if ((index = JimInsertHashEntry(ht, key)) == -1)
755         return JIM_ERR;
756
757     /* Allocates the memory and stores key */
758     entry = Jim_Alloc(sizeof(*entry));
759     entry->next = ht->table[index];
760     ht->table[index] = entry;
761
762     /* Set the hash entry fields. */
763     Jim_SetHashKey(ht, entry, key);
764     Jim_SetHashVal(ht, entry, val);
765     ht->used++;
766     return JIM_OK;
767 }
768
769 /* Add an element, discarding the old if the key already exists */
770 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
771 {
772     Jim_HashEntry *entry;
773
774     /* Try to add the element. If the key
775      * does not exists Jim_AddHashEntry will suceed. */
776     if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
777         return JIM_OK;
778     /* It already exists, get the entry */
779     entry = Jim_FindHashEntry(ht, key);
780     /* Free the old value and set the new one */
781     Jim_FreeEntryVal(ht, entry);
782     Jim_SetHashVal(ht, entry, val);
783     return JIM_OK;
784 }
785
786 /* Search and remove an element */
787 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
788 {
789     unsigned int h;
790     Jim_HashEntry *he, *prevHe;
791
792     if (ht->size == 0)
793         return JIM_ERR;
794     h = Jim_HashKey(ht, key) & ht->sizemask;
795     he = ht->table[h];
796
797     prevHe = NULL;
798     while(he) {
799         if (Jim_CompareHashKeys(ht, key, he->key)) {
800             /* Unlink the element from the list */
801             if (prevHe)
802                 prevHe->next = he->next;
803             else
804                 ht->table[h] = he->next;
805             Jim_FreeEntryKey(ht, he);
806             Jim_FreeEntryVal(ht, he);
807             Jim_Free(he);
808             ht->used--;
809             return JIM_OK;
810         }
811         prevHe = he;
812         he = he->next;
813     }
814     return JIM_ERR; /* not found */
815 }
816
817 /* Destroy an entire hash table */
818 int Jim_FreeHashTable(Jim_HashTable *ht)
819 {
820     unsigned int i;
821
822     /* Free all the elements */
823     for (i = 0; i < ht->size && ht->used > 0; i++) {
824         Jim_HashEntry *he, *nextHe;
825
826         if ((he = ht->table[i]) == NULL) continue;
827         while(he) {
828             nextHe = he->next;
829             Jim_FreeEntryKey(ht, he);
830             Jim_FreeEntryVal(ht, he);
831             Jim_Free(he);
832             ht->used--;
833             he = nextHe;
834         }
835     }
836     /* Free the table and the allocated cache structure */
837     Jim_Free(ht->table);
838     /* Re-initialize the table */
839     JimResetHashTable(ht);
840     return JIM_OK; /* never fails */
841 }
842
843 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
844 {
845     Jim_HashEntry *he;
846     unsigned int h;
847
848     if (ht->size == 0) return NULL;
849     h = Jim_HashKey(ht, key) & ht->sizemask;
850     he = ht->table[h];
851     while(he) {
852         if (Jim_CompareHashKeys(ht, key, he->key))
853             return he;
854         he = he->next;
855     }
856     return NULL;
857 }
858
859 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
860 {
861     Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
862
863     iter->ht = ht;
864     iter->index = -1;
865     iter->entry = NULL;
866     iter->nextEntry = NULL;
867     return iter;
868 }
869
870 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
871 {
872     while (1) {
873         if (iter->entry == NULL) {
874             iter->index++;
875             if (iter->index >=
876                     (signed)iter->ht->size) break;
877             iter->entry = iter->ht->table[iter->index];
878         } else {
879             iter->entry = iter->nextEntry;
880         }
881         if (iter->entry) {
882             /* We need to save the 'next' here, the iterator user
883              * may delete the entry we are returning. */
884             iter->nextEntry = iter->entry->next;
885             return iter->entry;
886         }
887     }
888     return NULL;
889 }
890
891 /* ------------------------- private functions ------------------------------ */
892
893 /* Expand the hash table if needed */
894 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
895 {
896     /* If the hash table is empty expand it to the intial size,
897      * if the table is "full" dobule its size. */
898     if (ht->size == 0)
899         return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
900     if (ht->size == ht->used)
901         return Jim_ExpandHashTable(ht, ht->size*2);
902     return JIM_OK;
903 }
904
905 /* Our hash table capability is a power of two */
906 static unsigned int JimHashTableNextPower(unsigned int size)
907 {
908     unsigned int i = JIM_HT_INITIAL_SIZE;
909
910     if (size >= 2147483648U)
911         return 2147483648U;
912     while(1) {
913         if (i >= size)
914             return i;
915         i *= 2;
916     }
917 }
918
919 /* Returns the index of a free slot that can be populated with
920  * an hash entry for the given 'key'.
921  * If the key already exists, -1 is returned. */
922 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
923 {
924     unsigned int h;
925     Jim_HashEntry *he;
926
927     /* Expand the hashtable if needed */
928     if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
929         return -1;
930     /* Compute the key hash value */
931     h = Jim_HashKey(ht, key) & ht->sizemask;
932     /* Search if this slot does not already contain the given key */
933     he = ht->table[h];
934     while(he) {
935         if (Jim_CompareHashKeys(ht, key, he->key))
936             return -1;
937         he = he->next;
938     }
939     return h;
940 }
941
942 /* ----------------------- StringCopy Hash Table Type ------------------------*/
943
944 static unsigned int JimStringCopyHTHashFunction(const void *key)
945 {
946     return Jim_GenHashFunction(key, strlen(key));
947 }
948
949 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
950 {
951     int len = strlen(key);
952     char *copy = Jim_Alloc(len+1);
953     JIM_NOTUSED(privdata);
954
955     memcpy(copy, key, len);
956     copy[len] = '\0';
957     return copy;
958 }
959
960 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
961 {
962     int len = strlen(val);
963     char *copy = Jim_Alloc(len+1);
964     JIM_NOTUSED(privdata);
965
966     memcpy(copy, val, len);
967     copy[len] = '\0';
968     return copy;
969 }
970
971 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
972         const void *key2)
973 {
974     JIM_NOTUSED(privdata);
975
976     return strcmp(key1, key2) == 0;
977 }
978
979 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
980 {
981     JIM_NOTUSED(privdata);
982
983     Jim_Free((void*)key); /* ATTENTION: const cast */
984 }
985
986 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
987 {
988     JIM_NOTUSED(privdata);
989
990     Jim_Free((void*)val); /* ATTENTION: const cast */
991 }
992
993 static Jim_HashTableType JimStringCopyHashTableType = {
994     JimStringCopyHTHashFunction,        /* hash function */
995     JimStringCopyHTKeyDup,              /* key dup */
996     NULL,                               /* val dup */
997     JimStringCopyHTKeyCompare,          /* key compare */
998     JimStringCopyHTKeyDestructor,       /* key destructor */
999     NULL                                /* val destructor */
1000 };
1001
1002 /* This is like StringCopy but does not auto-duplicate the key.
1003  * It's used for intepreter's shared strings. */
1004 static Jim_HashTableType JimSharedStringsHashTableType = {
1005     JimStringCopyHTHashFunction,        /* hash function */
1006     NULL,                               /* key dup */
1007     NULL,                               /* val dup */
1008     JimStringCopyHTKeyCompare,          /* key compare */
1009     JimStringCopyHTKeyDestructor,       /* key destructor */
1010     NULL                                /* val destructor */
1011 };
1012
1013 /* This is like StringCopy but also automatically handle dynamic
1014  * allocated C strings as values. */
1015 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1016     JimStringCopyHTHashFunction,        /* hash function */
1017     JimStringCopyHTKeyDup,              /* key dup */
1018     JimStringKeyValCopyHTValDup,        /* val dup */
1019     JimStringCopyHTKeyCompare,          /* key compare */
1020     JimStringCopyHTKeyDestructor,       /* key destructor */
1021     JimStringKeyValCopyHTValDestructor, /* val destructor */
1022 };
1023
1024 typedef struct AssocDataValue {
1025     Jim_InterpDeleteProc *delProc;
1026     void *data;
1027 } AssocDataValue;
1028
1029 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1030 {
1031     AssocDataValue *assocPtr = (AssocDataValue *)data;
1032     if (assocPtr->delProc != NULL)
1033         assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1034     Jim_Free(data);
1035 }
1036
1037 static Jim_HashTableType JimAssocDataHashTableType = {
1038     JimStringCopyHTHashFunction,         /* hash function */
1039     JimStringCopyHTKeyDup,               /* key dup */
1040     NULL,                                /* val dup */
1041     JimStringCopyHTKeyCompare,           /* key compare */
1042     JimStringCopyHTKeyDestructor,        /* key destructor */
1043     JimAssocDataHashTableValueDestructor /* val destructor */
1044 };
1045
1046 /* -----------------------------------------------------------------------------
1047  * Stack - This is a simple generic stack implementation. It is used for
1048  * example in the 'expr' expression compiler.
1049  * ---------------------------------------------------------------------------*/
1050 void Jim_InitStack(Jim_Stack *stack)
1051 {
1052     stack->len = 0;
1053     stack->maxlen = 0;
1054     stack->vector = NULL;
1055 }
1056
1057 void Jim_FreeStack(Jim_Stack *stack)
1058 {
1059     Jim_Free(stack->vector);
1060 }
1061
1062 int Jim_StackLen(Jim_Stack *stack)
1063 {
1064     return stack->len;
1065 }
1066
1067 void Jim_StackPush(Jim_Stack *stack, void *element) {
1068     int neededLen = stack->len+1;
1069     if (neededLen > stack->maxlen) {
1070         stack->maxlen = neededLen*2;
1071         stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1072     }
1073     stack->vector[stack->len] = element;
1074     stack->len++;
1075 }
1076
1077 void *Jim_StackPop(Jim_Stack *stack)
1078 {
1079     if (stack->len == 0) return NULL;
1080     stack->len--;
1081     return stack->vector[stack->len];
1082 }
1083
1084 void *Jim_StackPeek(Jim_Stack *stack)
1085 {
1086     if (stack->len == 0) return NULL;
1087     return stack->vector[stack->len-1];
1088 }
1089
1090 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1091 {
1092     int i;
1093
1094     for (i = 0; i < stack->len; i++)
1095         freeFunc(stack->vector[i]);
1096 }
1097
1098 /* -----------------------------------------------------------------------------
1099  * Parser
1100  * ---------------------------------------------------------------------------*/
1101
1102 /* Token types */
1103 #define JIM_TT_NONE -1        /* No token returned */
1104 #define JIM_TT_STR 0        /* simple string */
1105 #define JIM_TT_ESC 1        /* string that needs escape chars conversion */
1106 #define JIM_TT_VAR 2        /* var substitution */
1107 #define JIM_TT_DICTSUGAR 3    /* Syntax sugar for [dict get], $foo(bar) */
1108 #define JIM_TT_CMD 4        /* command substitution */
1109 #define JIM_TT_SEP 5        /* word separator */
1110 #define JIM_TT_EOL 6        /* line separator */
1111
1112 /* Additional token types needed for expressions */
1113 #define JIM_TT_SUBEXPR_START 7
1114 #define JIM_TT_SUBEXPR_END 8
1115 #define JIM_TT_EXPR_NUMBER 9
1116 #define JIM_TT_EXPR_OPERATOR 10
1117
1118 /* Parser states */
1119 #define JIM_PS_DEF 0        /* Default state */
1120 #define JIM_PS_QUOTE 1        /* Inside "" */
1121
1122 /* Parser context structure. The same context is used both to parse
1123  * Tcl scripts and lists. */
1124 struct JimParserCtx {
1125     const char *prg;     /* Program text */
1126     const char *p;       /* Pointer to the point of the program we are parsing */
1127     int len;             /* Left length of 'prg' */
1128     int linenr;          /* Current line number */
1129     const char *tstart;
1130     const char *tend;    /* Returned token is at tstart-tend in 'prg'. */
1131     int tline;           /* Line number of the returned token */
1132     int tt;              /* Token type */
1133     int eof;             /* Non zero if EOF condition is true. */
1134     int state;           /* Parser state */
1135     int comment;         /* Non zero if the next chars may be a comment. */
1136 };
1137
1138 #define JimParserEof(c) ((c)->eof)
1139 #define JimParserTstart(c) ((c)->tstart)
1140 #define JimParserTend(c) ((c)->tend)
1141 #define JimParserTtype(c) ((c)->tt)
1142 #define JimParserTline(c) ((c)->tline)
1143
1144 static int JimParseScript(struct JimParserCtx *pc);
1145 static int JimParseSep(struct JimParserCtx *pc);
1146 static int JimParseEol(struct JimParserCtx *pc);
1147 static int JimParseCmd(struct JimParserCtx *pc);
1148 static int JimParseVar(struct JimParserCtx *pc);
1149 static int JimParseBrace(struct JimParserCtx *pc);
1150 static int JimParseStr(struct JimParserCtx *pc);
1151 static int JimParseComment(struct JimParserCtx *pc);
1152 static char *JimParserGetToken(struct JimParserCtx *pc,
1153         int *lenPtr, int *typePtr, int *linePtr);
1154
1155 /* Initialize a parser context.
1156  * 'prg' is a pointer to the program text, linenr is the line
1157  * number of the first line contained in the program. */
1158 void JimParserInit(struct JimParserCtx *pc, const char *prg, 
1159         int len, int linenr)
1160 {
1161     pc->prg = prg;
1162     pc->p = prg;
1163     pc->len = len;
1164     pc->tstart = NULL;
1165     pc->tend = NULL;
1166     pc->tline = 0;
1167     pc->tt = JIM_TT_NONE;
1168     pc->eof = 0;
1169     pc->state = JIM_PS_DEF;
1170     pc->linenr = linenr;
1171     pc->comment = 1;
1172 }
1173
1174 int JimParseScript(struct JimParserCtx *pc)
1175 {
1176     while(1) { /* the while is used to reiterate with continue if needed */
1177         if (!pc->len) {
1178             pc->tstart = pc->p;
1179             pc->tend = pc->p-1;
1180             pc->tline = pc->linenr;
1181             pc->tt = JIM_TT_EOL;
1182             pc->eof = 1;
1183             return JIM_OK;
1184         }
1185         switch(*(pc->p)) {
1186         case '\\':
1187             if (*(pc->p+1) == '\n')
1188                 return JimParseSep(pc);
1189             else {
1190                 pc->comment = 0;
1191                 return JimParseStr(pc);
1192             }
1193             break;
1194         case ' ':
1195         case '\t':
1196         case '\r':
1197             if (pc->state == JIM_PS_DEF)
1198                 return JimParseSep(pc);
1199             else {
1200                 pc->comment = 0;
1201                 return JimParseStr(pc);
1202             }
1203             break;
1204         case '\n':
1205         case ';':
1206             pc->comment = 1;
1207             if (pc->state == JIM_PS_DEF)
1208                 return JimParseEol(pc);
1209             else
1210                 return JimParseStr(pc);
1211             break;
1212         case '[':
1213             pc->comment = 0;
1214             return JimParseCmd(pc);
1215             break;
1216         case '$':
1217             pc->comment = 0;
1218             if (JimParseVar(pc) == JIM_ERR) {
1219                 pc->tstart = pc->tend = pc->p++; pc->len--;
1220                 pc->tline = pc->linenr;
1221                 pc->tt = JIM_TT_STR;
1222                 return JIM_OK;
1223             } else
1224                 return JIM_OK;
1225             break;
1226         case '#':
1227             if (pc->comment) {
1228                 JimParseComment(pc);
1229                 continue;
1230             } else {
1231                 return JimParseStr(pc);
1232             }
1233         default:
1234             pc->comment = 0;
1235             return JimParseStr(pc);
1236             break;
1237         }
1238         return JIM_OK;
1239     }
1240 }
1241
1242 int JimParseSep(struct JimParserCtx *pc)
1243 {
1244     pc->tstart = pc->p;
1245     pc->tline = pc->linenr;
1246     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1247            (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1248         if (*pc->p == '\\') {
1249             pc->p++; pc->len--;
1250             pc->linenr++;
1251         }
1252         pc->p++; pc->len--;
1253     }
1254     pc->tend = pc->p-1;
1255     pc->tt = JIM_TT_SEP;
1256     return JIM_OK;
1257 }
1258
1259 int JimParseEol(struct JimParserCtx *pc)
1260 {
1261     pc->tstart = pc->p;
1262     pc->tline = pc->linenr;
1263     while (*pc->p == ' ' || *pc->p == '\n' ||
1264            *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1265         if (*pc->p == '\n')
1266             pc->linenr++;
1267         pc->p++; pc->len--;
1268     }
1269     pc->tend = pc->p-1;
1270     pc->tt = JIM_TT_EOL;
1271     return JIM_OK;
1272 }
1273
1274 /* Todo. Don't stop if ']' appears inside {} or quoted.
1275  * Also should handle the case of puts [string length "]"] */
1276 int JimParseCmd(struct JimParserCtx *pc)
1277 {
1278     int level = 1;
1279     int blevel = 0;
1280
1281     pc->tstart = ++pc->p; pc->len--;
1282     pc->tline = pc->linenr;
1283     while (1) {
1284         if (pc->len == 0) {
1285             break;
1286         } else if (*pc->p == '[' && blevel == 0) {
1287             level++;
1288         } else if (*pc->p == ']' && blevel == 0) {
1289             level--;
1290             if (!level) break;
1291         } else if (*pc->p == '\\') {
1292             pc->p++; pc->len--;
1293         } else if (*pc->p == '{') {
1294             blevel++;
1295         } else if (*pc->p == '}') {
1296             if (blevel != 0)
1297                 blevel--;
1298         } else if (*pc->p == '\n')
1299             pc->linenr++;
1300         pc->p++; pc->len--;
1301     }
1302     pc->tend = pc->p-1;
1303     pc->tt = JIM_TT_CMD;
1304     if (*pc->p == ']') {
1305         pc->p++; pc->len--;
1306     }
1307     return JIM_OK;
1308 }
1309
1310 int JimParseVar(struct JimParserCtx *pc)
1311 {
1312     int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1313
1314     pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1315     pc->tline = pc->linenr;
1316     if (*pc->p == '{') {
1317         pc->tstart = ++pc->p; pc->len--;
1318         brace = 1;
1319     }
1320     if (brace) {
1321         while (!stop) {
1322             if (*pc->p == '}' || pc->len == 0) {
1323                 pc->tend = pc->p-1;
1324                 stop = 1;
1325                 if (pc->len == 0)
1326                     break;
1327             }
1328             else if (*pc->p == '\n')
1329                 pc->linenr++;
1330             pc->p++; pc->len--;
1331         }
1332     } else {
1333         /* Include leading colons */
1334         while (*pc->p == ':') {
1335             pc->p++;
1336             pc->len--;
1337         }
1338         while (!stop) {
1339             if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1340                 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1341                 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1342                 stop = 1;
1343             else {
1344                 pc->p++; pc->len--;
1345             }
1346         }
1347         /* Parse [dict get] syntax sugar. */
1348         if (*pc->p == '(') {
1349             while (*pc->p != ')' && pc->len) {
1350                 pc->p++; pc->len--;
1351                 if (*pc->p == '\\' && pc->len >= 2) {
1352                     pc->p += 2; pc->len -= 2;
1353                 }
1354             }
1355             if (*pc->p != '\0') {
1356                 pc->p++; pc->len--;
1357             }
1358             ttype = JIM_TT_DICTSUGAR;
1359         }
1360         pc->tend = pc->p-1;
1361     }
1362     /* Check if we parsed just the '$' character.
1363      * That's not a variable so an error is returned
1364      * to tell the state machine to consider this '$' just
1365      * a string. */
1366     if (pc->tstart == pc->p) {
1367         pc->p--; pc->len++;
1368         return JIM_ERR;
1369     }
1370     pc->tt = ttype;
1371     return JIM_OK;
1372 }
1373
1374 int JimParseBrace(struct JimParserCtx *pc)
1375 {
1376     int level = 1;
1377
1378     pc->tstart = ++pc->p; pc->len--;
1379     pc->tline = pc->linenr;
1380     while (1) {
1381         if (*pc->p == '\\' && pc->len >= 2) {
1382             pc->p++; pc->len--;
1383             if (*pc->p == '\n')
1384                 pc->linenr++;
1385         } else if (*pc->p == '{') {
1386             level++;
1387         } else if (pc->len == 0 || *pc->p == '}') {
1388             level--;
1389             if (pc->len == 0 || level == 0) {
1390                 pc->tend = pc->p-1;
1391                 if (pc->len != 0) {
1392                     pc->p++; pc->len--;
1393                 }
1394                 pc->tt = JIM_TT_STR;
1395                 return JIM_OK;
1396             }
1397         } else if (*pc->p == '\n') {
1398             pc->linenr++;
1399         }
1400         pc->p++; pc->len--;
1401     }
1402     return JIM_OK; /* unreached */
1403 }
1404
1405 int JimParseStr(struct JimParserCtx *pc)
1406 {
1407     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1408             pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1409     if (newword && *pc->p == '{') {
1410         return JimParseBrace(pc);
1411     } else if (newword && *pc->p == '"') {
1412         pc->state = JIM_PS_QUOTE;
1413         pc->p++; pc->len--;
1414     }
1415     pc->tstart = pc->p;
1416     pc->tline = pc->linenr;
1417     while (1) {
1418         if (pc->len == 0) {
1419             pc->tend = pc->p-1;
1420             pc->tt = JIM_TT_ESC;
1421             return JIM_OK;
1422         }
1423         switch(*pc->p) {
1424         case '\\':
1425             if (pc->state == JIM_PS_DEF &&
1426                 *(pc->p+1) == '\n') {
1427                 pc->tend = pc->p-1;
1428                 pc->tt = JIM_TT_ESC;
1429                 return JIM_OK;
1430             }
1431             if (pc->len >= 2) {
1432                 pc->p++; pc->len--;
1433             }
1434             break;
1435         case '$':
1436         case '[':
1437             pc->tend = pc->p-1;
1438             pc->tt = JIM_TT_ESC;
1439             return JIM_OK;
1440         case ' ':
1441         case '\t':
1442         case '\n':
1443         case '\r':
1444         case ';':
1445             if (pc->state == JIM_PS_DEF) {
1446                 pc->tend = pc->p-1;
1447                 pc->tt = JIM_TT_ESC;
1448                 return JIM_OK;
1449             } else if (*pc->p == '\n') {
1450                 pc->linenr++;
1451             }
1452             break;
1453         case '"':
1454             if (pc->state == JIM_PS_QUOTE) {
1455                 pc->tend = pc->p-1;
1456                 pc->tt = JIM_TT_ESC;
1457                 pc->p++; pc->len--;
1458                 pc->state = JIM_PS_DEF;
1459                 return JIM_OK;
1460             }
1461             break;
1462         }
1463         pc->p++; pc->len--;
1464     }
1465     return JIM_OK; /* unreached */
1466 }
1467
1468 int JimParseComment(struct JimParserCtx *pc)
1469 {
1470     while (*pc->p) {
1471         if (*pc->p == '\n') {
1472             pc->linenr++;
1473             if (*(pc->p-1) != '\\') {
1474                 pc->p++; pc->len--;
1475                 return JIM_OK;
1476             }
1477         }
1478         pc->p++; pc->len--;
1479     }
1480     return JIM_OK;
1481 }
1482
1483 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1484 static int xdigitval(int c)
1485 {
1486     if (c >= '0' && c <= '9') return c-'0';
1487     if (c >= 'a' && c <= 'f') return c-'a'+10;
1488     if (c >= 'A' && c <= 'F') return c-'A'+10;
1489     return -1;
1490 }
1491
1492 static int odigitval(int c)
1493 {
1494     if (c >= '0' && c <= '7') return c-'0';
1495     return -1;
1496 }
1497
1498 /* Perform Tcl escape substitution of 's', storing the result
1499  * string into 'dest'. The escaped string is guaranteed to
1500  * be the same length or shorted than the source string.
1501  * Slen is the length of the string at 's', if it's -1 the string
1502  * length will be calculated by the function.
1503  *
1504  * The function returns the length of the resulting string. */
1505 static int JimEscape(char *dest, const char *s, int slen)
1506 {
1507     char *p = dest;
1508     int i, len;
1509     
1510     if (slen == -1)
1511         slen = strlen(s);
1512
1513     for (i = 0; i < slen; i++) {
1514         switch(s[i]) {
1515         case '\\':
1516             switch(s[i+1]) {
1517             case 'a': *p++ = 0x7; i++; break;
1518             case 'b': *p++ = 0x8; i++; break;
1519             case 'f': *p++ = 0xc; i++; break;
1520             case 'n': *p++ = 0xa; i++; break;
1521             case 'r': *p++ = 0xd; i++; break;
1522             case 't': *p++ = 0x9; i++; break;
1523             case 'v': *p++ = 0xb; i++; break;
1524             case '\0': *p++ = '\\'; i++; break;
1525             case '\n': *p++ = ' '; i++; break;
1526             default:
1527                   if (s[i+1] == 'x') {
1528                     int val = 0;
1529                     int c = xdigitval(s[i+2]);
1530                     if (c == -1) {
1531                         *p++ = 'x';
1532                         i++;
1533                         break;
1534                     }
1535                     val = c;
1536                     c = xdigitval(s[i+3]);
1537                     if (c == -1) {
1538                         *p++ = val;
1539                         i += 2;
1540                         break;
1541                     }
1542                     val = (val*16)+c;
1543                     *p++ = val;
1544                     i += 3;
1545                     break;
1546                   } else if (s[i+1] >= '0' && s[i+1] <= '7')
1547                   {
1548                     int val = 0;
1549                     int c = odigitval(s[i+1]);
1550                     val = c;
1551                     c = odigitval(s[i+2]);
1552                     if (c == -1) {
1553                         *p++ = val;
1554                         i ++;
1555                         break;
1556                     }
1557                     val = (val*8)+c;
1558                     c = odigitval(s[i+3]);
1559                     if (c == -1) {
1560                         *p++ = val;
1561                         i += 2;
1562                         break;
1563                     }
1564                     val = (val*8)+c;
1565                     *p++ = val;
1566                     i += 3;
1567                   } else {
1568                     *p++ = s[i+1];
1569                     i++;
1570                   }
1571                   break;
1572             }
1573             break;
1574         default:
1575             *p++ = s[i];
1576             break;
1577         }
1578     }
1579     len = p-dest;
1580     *p++ = '\0';
1581     return len;
1582 }
1583
1584 /* Returns a dynamically allocated copy of the current token in the
1585  * parser context. The function perform conversion of escapes if
1586  * the token is of type JIM_TT_ESC.
1587  *
1588  * Note that after the conversion, tokens that are grouped with
1589  * braces in the source code, are always recognizable from the
1590  * identical string obtained in a different way from the type.
1591  *
1592  * For exmple the string:
1593  *
1594  * {expand}$a
1595  * 
1596  * will return as first token "expand", of type JIM_TT_STR
1597  *
1598  * While the string:
1599  *
1600  * expand$a
1601  *
1602  * will return as first token "expand", of type JIM_TT_ESC
1603  */
1604 char *JimParserGetToken(struct JimParserCtx *pc,
1605         int *lenPtr, int *typePtr, int *linePtr)
1606 {
1607     const char *start, *end;
1608     char *token;
1609     int len;
1610
1611     start = JimParserTstart(pc);
1612     end = JimParserTend(pc);
1613     if (start > end) {
1614         if (lenPtr) *lenPtr = 0;
1615         if (typePtr) *typePtr = JimParserTtype(pc);
1616         if (linePtr) *linePtr = JimParserTline(pc);
1617         token = Jim_Alloc(1);
1618         token[0] = '\0';
1619         return token;
1620     }
1621     len = (end-start)+1;
1622     token = Jim_Alloc(len+1);
1623     if (JimParserTtype(pc) != JIM_TT_ESC) {
1624         /* No escape conversion needed? Just copy it. */
1625         memcpy(token, start, len);
1626         token[len] = '\0';
1627     } else {
1628         /* Else convert the escape chars. */
1629         len = JimEscape(token, start, len);
1630     }
1631     if (lenPtr) *lenPtr = len;
1632     if (typePtr) *typePtr = JimParserTtype(pc);
1633     if (linePtr) *linePtr = JimParserTline(pc);
1634     return token;
1635 }
1636
1637 /* The following functin is not really part of the parsing engine of Jim,
1638  * but it somewhat related. Given an string and its length, it tries
1639  * to guess if the script is complete or there are instead " " or { }
1640  * open and not completed. This is useful for interactive shells
1641  * implementation and for [info complete].
1642  *
1643  * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1644  * '{' on scripts incomplete missing one or more '}' to be balanced.
1645  * '"' on scripts incomplete missing a '"' char.
1646  *
1647  * If the script is complete, 1 is returned, otherwise 0. */
1648 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1649 {
1650     int level = 0;
1651     int state = ' ';
1652
1653     while(len) {
1654         switch (*s) {
1655             case '\\':
1656                 if (len > 1)
1657                     s++;
1658                 break;
1659             case '"':
1660                 if (state == ' ') {
1661                     state = '"';
1662                 } else if (state == '"') {
1663                     state = ' ';
1664                 }
1665                 break;
1666             case '{':
1667                 if (state == '{') {
1668                     level++;
1669                 } else if (state == ' ') {
1670                     state = '{';
1671                     level++;
1672                 }
1673                 break;
1674             case '}':
1675                 if (state == '{') {
1676                     level--;
1677                     if (level == 0)
1678                         state = ' ';
1679                 }
1680                 break;
1681         }
1682         s++;
1683         len--;
1684     }
1685     if (stateCharPtr)
1686         *stateCharPtr = state;
1687     return state == ' ';
1688 }
1689
1690 /* -----------------------------------------------------------------------------
1691  * Tcl Lists parsing
1692  * ---------------------------------------------------------------------------*/
1693 static int JimParseListSep(struct JimParserCtx *pc);
1694 static int JimParseListStr(struct JimParserCtx *pc);
1695
1696 int JimParseList(struct JimParserCtx *pc)
1697 {
1698     if (pc->len == 0) {
1699         pc->tstart = pc->tend = pc->p;
1700         pc->tline = pc->linenr;
1701         pc->tt = JIM_TT_EOL;
1702         pc->eof = 1;
1703         return JIM_OK;
1704     }
1705     switch(*pc->p) {
1706     case ' ':
1707     case '\n':
1708     case '\t':
1709     case '\r':
1710         if (pc->state == JIM_PS_DEF)
1711             return JimParseListSep(pc);
1712         else
1713             return JimParseListStr(pc);
1714         break;
1715     default:
1716         return JimParseListStr(pc);
1717         break;
1718     }
1719     return JIM_OK;
1720 }
1721
1722 int JimParseListSep(struct JimParserCtx *pc)
1723 {
1724     pc->tstart = pc->p;
1725     pc->tline = pc->linenr;
1726     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1727     {
1728         pc->p++; pc->len--;
1729     }
1730     pc->tend = pc->p-1;
1731     pc->tt = JIM_TT_SEP;
1732     return JIM_OK;
1733 }
1734
1735 int JimParseListStr(struct JimParserCtx *pc)
1736 {
1737     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1738             pc->tt == JIM_TT_NONE);
1739     if (newword && *pc->p == '{') {
1740         return JimParseBrace(pc);
1741     } else if (newword && *pc->p == '"') {
1742         pc->state = JIM_PS_QUOTE;
1743         pc->p++; pc->len--;
1744     }
1745     pc->tstart = pc->p;
1746     pc->tline = pc->linenr;
1747     while (1) {
1748         if (pc->len == 0) {
1749             pc->tend = pc->p-1;
1750             pc->tt = JIM_TT_ESC;
1751             return JIM_OK;
1752         }
1753         switch(*pc->p) {
1754         case '\\':
1755             pc->p++; pc->len--;
1756             break;
1757         case ' ':
1758         case '\t':
1759         case '\n':
1760         case '\r':
1761             if (pc->state == JIM_PS_DEF) {
1762                 pc->tend = pc->p-1;
1763                 pc->tt = JIM_TT_ESC;
1764                 return JIM_OK;
1765             } else if (*pc->p == '\n') {
1766                 pc->linenr++;
1767             }
1768             break;
1769         case '"':
1770             if (pc->state == JIM_PS_QUOTE) {
1771                 pc->tend = pc->p-1;
1772                 pc->tt = JIM_TT_ESC;
1773                 pc->p++; pc->len--;
1774                 pc->state = JIM_PS_DEF;
1775                 return JIM_OK;
1776             }
1777             break;
1778         }
1779         pc->p++; pc->len--;
1780     }
1781     return JIM_OK; /* unreached */
1782 }
1783
1784 /* -----------------------------------------------------------------------------
1785  * Jim_Obj related functions
1786  * ---------------------------------------------------------------------------*/
1787
1788 /* Return a new initialized object. */
1789 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1790 {
1791     Jim_Obj *objPtr;
1792
1793     /* -- Check if there are objects in the free list -- */
1794     if (interp->freeList != NULL) {
1795         /* -- Unlink the object from the free list -- */
1796         objPtr = interp->freeList;
1797         interp->freeList = objPtr->nextObjPtr;
1798     } else {
1799         /* -- No ready to use objects: allocate a new one -- */
1800         objPtr = Jim_Alloc(sizeof(*objPtr));
1801     }
1802
1803     /* Object is returned with refCount of 0. Every
1804      * kind of GC implemented should take care to don't try
1805      * to scan objects with refCount == 0. */
1806     objPtr->refCount = 0;
1807     /* All the other fields are left not initialized to save time.
1808      * The caller will probably want set they to the right
1809      * value anyway. */
1810
1811     /* -- Put the object into the live list -- */
1812     objPtr->prevObjPtr = NULL;
1813     objPtr->nextObjPtr = interp->liveList;
1814     if (interp->liveList)
1815         interp->liveList->prevObjPtr = objPtr;
1816     interp->liveList = objPtr;
1817
1818     return objPtr;
1819 }
1820
1821 /* Free an object. Actually objects are never freed, but
1822  * just moved to the free objects list, where they will be
1823  * reused by Jim_NewObj(). */
1824 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1825 {
1826     /* Check if the object was already freed, panic. */
1827     if (objPtr->refCount != 0)  {
1828         Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1829                 objPtr->refCount);
1830     }
1831     /* Free the internal representation */
1832     Jim_FreeIntRep(interp, objPtr);
1833     /* Free the string representation */
1834     if (objPtr->bytes != NULL) {
1835         if (objPtr->bytes != JimEmptyStringRep)
1836             Jim_Free(objPtr->bytes);
1837     }
1838     /* Unlink the object from the live objects list */
1839     if (objPtr->prevObjPtr)
1840         objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1841     if (objPtr->nextObjPtr)
1842         objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1843     if (interp->liveList == objPtr)
1844         interp->liveList = objPtr->nextObjPtr;
1845     /* Link the object into the free objects list */
1846     objPtr->prevObjPtr = NULL;
1847     objPtr->nextObjPtr = interp->freeList;
1848     if (interp->freeList)
1849         interp->freeList->prevObjPtr = objPtr;
1850     interp->freeList = objPtr;
1851     objPtr->refCount = -1;
1852 }
1853
1854 /* Invalidate the string representation of an object. */
1855 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1856 {
1857     if (objPtr->bytes != NULL) {
1858         if (objPtr->bytes != JimEmptyStringRep)
1859             Jim_Free(objPtr->bytes);
1860     }
1861     objPtr->bytes = NULL;
1862 }
1863
1864 #define Jim_SetStringRep(o, b, l) \
1865     do { (o)->bytes = b; (o)->length = l; } while (0)
1866
1867 /* Set the initial string representation for an object.
1868  * Does not try to free an old one. */
1869 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1870 {
1871     if (length == 0) {
1872         objPtr->bytes = JimEmptyStringRep;
1873         objPtr->length = 0;
1874     } else {
1875         objPtr->bytes = Jim_Alloc(length+1);
1876         objPtr->length = length;
1877         memcpy(objPtr->bytes, bytes, length);
1878         objPtr->bytes[length] = '\0';
1879     }
1880 }
1881
1882 /* Duplicate an object. The returned object has refcount = 0. */
1883 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1884 {
1885     Jim_Obj *dupPtr;
1886
1887     dupPtr = Jim_NewObj(interp);
1888     if (objPtr->bytes == NULL) {
1889         /* Object does not have a valid string representation. */
1890         dupPtr->bytes = NULL;
1891     } else {
1892         Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1893     }
1894     if (objPtr->typePtr != NULL) {
1895         if (objPtr->typePtr->dupIntRepProc == NULL) {
1896             dupPtr->internalRep = objPtr->internalRep;
1897         } else {
1898             objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1899         }
1900         dupPtr->typePtr = objPtr->typePtr;
1901     } else {
1902         dupPtr->typePtr = NULL;
1903     }
1904     return dupPtr;
1905 }
1906
1907 /* Return the string representation for objPtr. If the object
1908  * string representation is invalid, calls the method to create
1909  * a new one starting from the internal representation of the object. */
1910 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1911 {
1912     if (objPtr->bytes == NULL) {
1913         /* Invalid string repr. Generate it. */
1914         if (objPtr->typePtr->updateStringProc == NULL) {
1915             Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1916                 objPtr->typePtr->name);
1917         }
1918         objPtr->typePtr->updateStringProc(objPtr);
1919     }
1920     if (lenPtr)
1921         *lenPtr = objPtr->length;
1922     return objPtr->bytes;
1923 }
1924
1925 /* Just returns the length of the object's string rep */
1926 int Jim_Length(Jim_Obj *objPtr)
1927 {
1928     int len;
1929
1930     Jim_GetString(objPtr, &len);
1931     return len;
1932 }
1933
1934 /* -----------------------------------------------------------------------------
1935  * String Object
1936  * ---------------------------------------------------------------------------*/
1937 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1938 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1939
1940 static Jim_ObjType stringObjType = {
1941     "string",
1942     NULL,
1943     DupStringInternalRep,
1944     NULL,
1945     JIM_TYPE_REFERENCES,
1946 };
1947
1948 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1949 {
1950     JIM_NOTUSED(interp);
1951
1952     /* This is a bit subtle: the only caller of this function
1953      * should be Jim_DuplicateObj(), that will copy the
1954      * string representaion. After the copy, the duplicated
1955      * object will not have more room in teh buffer than
1956      * srcPtr->length bytes. So we just set it to length. */
1957     dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1958 }
1959
1960 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1961 {
1962     /* Get a fresh string representation. */
1963     (void) Jim_GetString(objPtr, NULL);
1964     /* Free any other internal representation. */
1965     Jim_FreeIntRep(interp, objPtr);
1966     /* Set it as string, i.e. just set the maxLength field. */
1967     objPtr->typePtr = &stringObjType;
1968     objPtr->internalRep.strValue.maxLength = objPtr->length;
1969     return JIM_OK;
1970 }
1971
1972 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1973 {
1974     Jim_Obj *objPtr = Jim_NewObj(interp);
1975
1976     if (len == -1)
1977         len = strlen(s);
1978     /* Alloc/Set the string rep. */
1979     if (len == 0) {
1980         objPtr->bytes = JimEmptyStringRep;
1981         objPtr->length = 0;
1982     } else {
1983         objPtr->bytes = Jim_Alloc(len+1);
1984         objPtr->length = len;
1985         memcpy(objPtr->bytes, s, len);
1986         objPtr->bytes[len] = '\0';
1987     }
1988
1989     /* No typePtr field for the vanilla string object. */
1990     objPtr->typePtr = NULL;
1991     return objPtr;
1992 }
1993
1994 /* This version does not try to duplicate the 's' pointer, but
1995  * use it directly. */
1996 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
1997 {
1998     Jim_Obj *objPtr = Jim_NewObj(interp);
1999
2000     if (len == -1)
2001         len = strlen(s);
2002     Jim_SetStringRep(objPtr, s, len);
2003     objPtr->typePtr = NULL;
2004     return objPtr;
2005 }
2006
2007 /* Low-level string append. Use it only against objects
2008  * of type "string". */
2009 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2010 {
2011     int needlen;
2012
2013     if (len == -1)
2014         len = strlen(str);
2015     needlen = objPtr->length + len;
2016     if (objPtr->internalRep.strValue.maxLength < needlen ||
2017         objPtr->internalRep.strValue.maxLength == 0) {
2018         if (objPtr->bytes == JimEmptyStringRep) {
2019             objPtr->bytes = Jim_Alloc((needlen*2)+1);
2020         } else {
2021             objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2022         }
2023         objPtr->internalRep.strValue.maxLength = needlen*2;
2024     }
2025     memcpy(objPtr->bytes + objPtr->length, str, len);
2026     objPtr->bytes[objPtr->length+len] = '\0';
2027     objPtr->length += len;
2028 }
2029
2030 /* Low-level wrapper to append an object. */
2031 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2032 {
2033     int len;
2034     const char *str;
2035
2036     str = Jim_GetString(appendObjPtr, &len);
2037     StringAppendString(objPtr, str, len);
2038 }
2039
2040 /* Higher level API to append strings to objects. */
2041 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2042         int len)
2043 {
2044     if (Jim_IsShared(objPtr))
2045         Jim_Panic(interp,"Jim_AppendString called with shared object");
2046     if (objPtr->typePtr != &stringObjType)
2047         SetStringFromAny(interp, objPtr);
2048     StringAppendString(objPtr, str, len);
2049 }
2050
2051 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2052 {
2053         char *buf;
2054         va_list ap;
2055
2056         va_start( ap, fmt );
2057         buf = jim_vasprintf( fmt, ap );
2058         va_end(ap);
2059
2060         if( buf ){
2061                 Jim_AppendString( interp, objPtr, buf, -1 );
2062                 jim_vasprintf_done(buf);
2063         }
2064 }
2065
2066
2067 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2068         Jim_Obj *appendObjPtr)
2069 {
2070     int len;
2071     const char *str;
2072
2073     str = Jim_GetString(appendObjPtr, &len);
2074     Jim_AppendString(interp, objPtr, str, len);
2075 }
2076
2077 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2078 {
2079     va_list ap;
2080
2081     if (objPtr->typePtr != &stringObjType)
2082         SetStringFromAny(interp, objPtr);
2083     va_start(ap, objPtr);
2084     while (1) {
2085         char *s = va_arg(ap, char*);
2086
2087         if (s == NULL) break;
2088         Jim_AppendString(interp, objPtr, s, -1);
2089     }
2090     va_end(ap);
2091 }
2092
2093 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2094 {
2095     const char *aStr, *bStr;
2096     int aLen, bLen, i;
2097
2098     if (aObjPtr == bObjPtr) return 1;
2099     aStr = Jim_GetString(aObjPtr, &aLen);
2100     bStr = Jim_GetString(bObjPtr, &bLen);
2101     if (aLen != bLen) return 0;
2102     if (nocase == 0)
2103         return memcmp(aStr, bStr, aLen) == 0;
2104     for (i = 0; i < aLen; i++) {
2105         if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2106             return 0;
2107     }
2108     return 1;
2109 }
2110
2111 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2112         int nocase)
2113 {
2114     const char *pattern, *string;
2115     int patternLen, stringLen;
2116
2117     pattern = Jim_GetString(patternObjPtr, &patternLen);
2118     string = Jim_GetString(objPtr, &stringLen);
2119     return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2120 }
2121
2122 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2123         Jim_Obj *secondObjPtr, int nocase)
2124 {
2125     const char *s1, *s2;
2126     int l1, l2;
2127
2128     s1 = Jim_GetString(firstObjPtr, &l1);
2129     s2 = Jim_GetString(secondObjPtr, &l2);
2130     return JimStringCompare(s1, l1, s2, l2, nocase);
2131 }
2132
2133 /* Convert a range, as returned by Jim_GetRange(), into
2134  * an absolute index into an object of the specified length.
2135  * This function may return negative values, or values
2136  * bigger or equal to the length of the list if the index
2137  * is out of range. */
2138 static int JimRelToAbsIndex(int len, int index)
2139 {
2140     if (index < 0)
2141         return len + index;
2142     return index;
2143 }
2144
2145 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2146  * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2147  * for implementation of commands like [string range] and [lrange].
2148  *
2149  * The resulting range is guaranteed to address valid elements of
2150  * the structure. */
2151 static void JimRelToAbsRange(int len, int first, int last,
2152         int *firstPtr, int *lastPtr, int *rangeLenPtr)
2153 {
2154     int rangeLen;
2155
2156     if (first > last) {
2157         rangeLen = 0;
2158     } else {
2159         rangeLen = last-first+1;
2160         if (rangeLen) {
2161             if (first < 0) {
2162                 rangeLen += first;
2163                 first = 0;
2164             }
2165             if (last >= len) {
2166                 rangeLen -= (last-(len-1));
2167                 last = len-1;
2168             }
2169         }
2170     }
2171     if (rangeLen < 0) rangeLen = 0;
2172
2173     *firstPtr = first;
2174     *lastPtr = last;
2175     *rangeLenPtr = rangeLen;
2176 }
2177
2178 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2179         Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2180 {
2181     int first, last;
2182     const char *str;
2183     int len, rangeLen;
2184
2185     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2186         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2187         return NULL;
2188     str = Jim_GetString(strObjPtr, &len);
2189     first = JimRelToAbsIndex(len, first);
2190     last = JimRelToAbsIndex(len, last);
2191     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2192     return Jim_NewStringObj(interp, str+first, rangeLen);
2193 }
2194
2195 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2196 {
2197     char *buf;
2198     int i;
2199     if (strObjPtr->typePtr != &stringObjType) {
2200         SetStringFromAny(interp, strObjPtr);
2201     }
2202
2203     buf = Jim_Alloc(strObjPtr->length+1);
2204
2205     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2206     for (i = 0; i < strObjPtr->length; i++)
2207         buf[i] = tolower(buf[i]);
2208     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2209 }
2210
2211 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2212 {
2213     char *buf;
2214     int i;
2215     if (strObjPtr->typePtr != &stringObjType) {
2216         SetStringFromAny(interp, strObjPtr);
2217     }
2218
2219     buf = Jim_Alloc(strObjPtr->length+1);
2220
2221     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2222     for (i = 0; i < strObjPtr->length; i++)
2223         buf[i] = toupper(buf[i]);
2224     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2225 }
2226
2227 /* This is the core of the [format] command.
2228  * TODO: Lots of things work - via a hack
2229  *       However, no format item can be >= JIM_MAX_FMT 
2230  */
2231 #define JIM_MAX_FMT 2048
2232 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2233         int objc, Jim_Obj *const *objv, char *sprintf_buf)
2234 {
2235     const char *fmt, *_fmt;
2236     int fmtLen;
2237     Jim_Obj *resObjPtr;
2238     
2239
2240     fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2241         _fmt = fmt;
2242     resObjPtr = Jim_NewStringObj(interp, "", 0);
2243     while (fmtLen) {
2244         const char *p = fmt;
2245         char spec[2], c;
2246         jim_wide wideValue;
2247                 double doubleValue;
2248                 /* we cheat and use Sprintf()! */
2249                 char fmt_str[100];
2250                 char *cp;
2251                 int width;
2252                 int ljust;
2253                 int zpad;
2254                 int spad;
2255                 int altfm;
2256                 int forceplus;
2257                 int prec;
2258                 int inprec;
2259                 int haveprec;
2260                 int accum;
2261
2262         while (*fmt != '%' && fmtLen) {
2263             fmt++; fmtLen--;
2264         }
2265         Jim_AppendString(interp, resObjPtr, p, fmt-p);
2266         if (fmtLen == 0)
2267             break;
2268         fmt++; fmtLen--; /* skip '%' */
2269                 zpad = 0;
2270                 spad = 0;
2271                 width = -1;
2272                 ljust = 0;
2273                 altfm = 0;
2274                 forceplus = 0;
2275                 inprec = 0;
2276                 haveprec = 0;
2277                 prec = -1; /* not found yet */
2278     next_fmt:
2279                 if( fmtLen <= 0 ){
2280                         break;
2281                 }
2282                 switch( *fmt ){
2283                         /* terminals */
2284         case 'b': /* binary - not all printfs() do this */
2285                 case 's': /* string */
2286                 case 'i': /* integer */
2287                 case 'd': /* decimal */
2288                 case 'x': /* hex */
2289                 case 'X': /* CAP hex */
2290                 case 'c': /* char */
2291                 case 'o': /* octal */
2292                 case 'u': /* unsigned */
2293                 case 'f': /* float */
2294                         break;
2295                         
2296                         /* non-terminals */
2297                 case '0': /* zero pad */
2298                         zpad = 1;
2299                         fmt++;  fmtLen--;
2300                         goto next_fmt;
2301                         break;
2302                 case '+':
2303                         forceplus = 1;
2304                         fmt++;  fmtLen--;
2305                         goto next_fmt;
2306                         break;
2307                 case ' ': /* sign space */
2308                         spad = 1;
2309                         fmt++;  fmtLen--;
2310                         goto next_fmt;
2311                         break;
2312                 case '-':
2313                         ljust = 1;
2314                         fmt++;  fmtLen--;
2315                         goto next_fmt;
2316                         break;
2317                 case '#':
2318                         altfm = 1;
2319                         fmt++; fmtLen--;
2320                         goto next_fmt;
2321                         
2322                 case '.':
2323                         inprec = 1;
2324                         fmt++; fmtLen--;
2325                         goto next_fmt;
2326                         break;
2327                 case '1':
2328                 case '2':
2329                 case '3':
2330                 case '4':
2331                 case '5':
2332                 case '6':
2333                 case '7':
2334                 case '8':
2335                 case '9':
2336                         accum = 0;
2337                         while( isdigit(*fmt) && (fmtLen > 0) ){
2338                                 accum = (accum * 10) + (*fmt - '0');
2339                                 fmt++;  fmtLen--;
2340                         }
2341                         if( inprec ){
2342                                 haveprec = 1;
2343                                 prec = accum;
2344                         } else {
2345                                 width = accum;
2346                         }
2347                         goto next_fmt;
2348                 case '*':
2349                         /* suck up the next item as an integer */
2350                         fmt++;  fmtLen--;
2351                         objc--;
2352                         if( objc <= 0 ){
2353                                 goto not_enough_args;
2354                         }
2355                         if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2356                                 Jim_FreeNewObj(interp, resObjPtr );
2357                                 return NULL;
2358                         }
2359                         if( inprec ){
2360                                 haveprec = 1;
2361                                 prec = wideValue;
2362                                 if( prec < 0 ){
2363                                         /* man 3 printf says */
2364                                         /* if prec is negative, it is zero */
2365                                         prec = 0;
2366                                 }
2367                         } else {
2368                         width = wideValue;
2369                         if( width < 0 ){
2370                                 ljust = 1;
2371                                 width = -width;
2372                         }
2373                         }
2374                         objv++;
2375                         goto next_fmt;
2376                         break;
2377                 }
2378                 
2379                 
2380                 if (*fmt != '%') {
2381             if (objc == 0) {
2382                         not_enough_args:
2383                 Jim_FreeNewObj(interp, resObjPtr);
2384                 Jim_SetResultString(interp,
2385                                                                         "not enough arguments for all format specifiers", -1);
2386                 return NULL;
2387             } else {
2388                 objc--;
2389             }
2390         }
2391                 
2392                 /*
2393                  * Create the formatter
2394                  * cause we cheat and use sprintf()
2395                  */
2396                 cp = fmt_str;
2397                 *cp++ = '%';
2398                 if( altfm ){
2399                         *cp++ = '#';
2400                 }
2401                 if( forceplus ){
2402                         *cp++ = '+';
2403                 } else if( spad ){
2404                         /* PLUS overrides */
2405                         *cp++ = ' ';
2406                 }
2407                 if( ljust ){
2408                         *cp++ = '-';
2409                 }
2410                 if( zpad  ){
2411                         *cp++ = '0';
2412                 }
2413                 if( width > 0 ){
2414                         sprintf( cp, "%d", width );
2415                         /* skip ahead */
2416                         cp = strchr(cp,0);
2417                 }
2418                 /* did we find a period? */
2419                 if( inprec ){
2420                         /* then add it */
2421                         *cp++ = '.';
2422                         /* did something occur after the period? */
2423                         if( haveprec ){
2424                                 sprintf( cp, "%d", prec );
2425                         }
2426                         cp = strchr(cp,0);
2427                 }
2428                 *cp = 0;
2429
2430                 /* here we do the work */
2431                 /* actually - we make sprintf() do it for us */
2432         switch(*fmt) {
2433         case 's':
2434                         *cp++ = 's';
2435                         *cp   = 0;
2436                         /* BUG: we do not handled embeded NULLs */
2437                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2438             break;
2439         case 'c':
2440                         *cp++ = 'c';
2441                         *cp   = 0;
2442             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2443                 Jim_FreeNewObj(interp, resObjPtr);
2444                 return NULL;
2445             }
2446             c = (char) wideValue;
2447                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2448             break;
2449                 case 'f':
2450                 case 'F':
2451                 case 'g':
2452                 case 'G':
2453                 case 'e':
2454                 case 'E':
2455                         *cp++ = *fmt;
2456                         *cp   = 0;
2457                         if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2458                                 Jim_FreeNewObj( interp, resObjPtr );
2459                                 return NULL;
2460                         }
2461                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2462                         break;
2463         case 'b':
2464         case 'd':
2465         case 'o':
2466                 case 'i':
2467                 case 'u':
2468                 case 'x':
2469                 case 'X':
2470                         /* jim widevaluse are 64bit */
2471                         if( sizeof(jim_wide) == sizeof(long long) ){
2472                                 *cp++ = 'l'; 
2473                                 *cp++ = 'l';
2474                         } else {
2475                                 *cp++ = 'l';
2476                         }
2477                         *cp++ = *fmt;
2478                         *cp   = 0;
2479             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2480                 Jim_FreeNewObj(interp, resObjPtr);
2481                 return NULL;
2482             }
2483                         snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2484             break;
2485         case '%':
2486                         sprintf_buf[0] = '%';
2487                         sprintf_buf[1] = 0;
2488                         objv--; /* undo the objv++ below */
2489             break;
2490         default:
2491             spec[0] = *fmt; spec[1] = '\0';
2492             Jim_FreeNewObj(interp, resObjPtr);
2493             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2494             Jim_AppendStrings(interp, Jim_GetResult(interp),
2495                     "bad field specifier \"",  spec, "\"", NULL);
2496             return NULL;
2497         }
2498                 /* force terminate */
2499 #if 0
2500                 printf("FMT was: %s\n", fmt_str );
2501                 printf("RES was: |%s|\n", sprintf_buf );
2502 #endif
2503                 
2504                 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2505                 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2506                 /* next obj */
2507                 objv++;
2508         fmt++;
2509         fmtLen--;
2510     }
2511     return resObjPtr;
2512 }
2513
2514 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2515         int objc, Jim_Obj *const *objv)
2516 {
2517         char *sprintf_buf=malloc(JIM_MAX_FMT);
2518         Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2519         free(sprintf_buf);
2520         return t; 
2521 }
2522
2523 /* -----------------------------------------------------------------------------
2524  * Compared String Object
2525  * ---------------------------------------------------------------------------*/
2526
2527 /* This is strange object that allows to compare a C literal string
2528  * with a Jim object in very short time if the same comparison is done
2529  * multiple times. For example every time the [if] command is executed,
2530  * Jim has to check if a given argument is "else". This comparions if
2531  * the code has no errors are true most of the times, so we can cache
2532  * inside the object the pointer of the string of the last matching
2533  * comparison. Because most C compilers perform literal sharing,
2534  * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2535  * this works pretty well even if comparisons are at different places
2536  * inside the C code. */
2537
2538 static Jim_ObjType comparedStringObjType = {
2539     "compared-string",
2540     NULL,
2541     NULL,
2542     NULL,
2543     JIM_TYPE_REFERENCES,
2544 };
2545
2546 /* The only way this object is exposed to the API is via the following
2547  * function. Returns true if the string and the object string repr.
2548  * are the same, otherwise zero is returned.
2549  *
2550  * Note: this isn't binary safe, but it hardly needs to be.*/
2551 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2552         const char *str)
2553 {
2554     if (objPtr->typePtr == &comparedStringObjType &&
2555         objPtr->internalRep.ptr == str)
2556         return 1;
2557     else {
2558         const char *objStr = Jim_GetString(objPtr, NULL);
2559         if (strcmp(str, objStr) != 0) return 0;
2560         if (objPtr->typePtr != &comparedStringObjType) {
2561             Jim_FreeIntRep(interp, objPtr);
2562             objPtr->typePtr = &comparedStringObjType;
2563         }
2564         objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2565         return 1;
2566     }
2567 }
2568
2569 int qsortCompareStringPointers(const void *a, const void *b)
2570 {
2571     char * const *sa = (char * const *)a;
2572     char * const *sb = (char * const *)b;
2573     return strcmp(*sa, *sb);
2574 }
2575
2576 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2577         const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2578 {
2579     const char * const *entryPtr = NULL;
2580     char **tablePtrSorted;
2581     int i, count = 0;
2582
2583     *indexPtr = -1;
2584     for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2585         if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2586             *indexPtr = i;
2587             return JIM_OK;
2588         }
2589         count++; /* If nothing matches, this will reach the len of tablePtr */
2590     }
2591     if (flags & JIM_ERRMSG) {
2592         if (name == NULL)
2593             name = "option";
2594         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2595         Jim_AppendStrings(interp, Jim_GetResult(interp),
2596             "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2597             NULL);
2598         tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2599         memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2600         qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2601         for (i = 0; i < count; i++) {
2602             if (i+1 == count && count > 1)
2603                 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2604             Jim_AppendString(interp, Jim_GetResult(interp),
2605                     tablePtrSorted[i], -1);
2606             if (i+1 != count)
2607                 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2608         }
2609         Jim_Free(tablePtrSorted);
2610     }
2611     return JIM_ERR;
2612 }
2613
2614 int Jim_GetNvp(Jim_Interp *interp, 
2615                            Jim_Obj *objPtr,
2616                            const Jim_Nvp *nvp_table, 
2617                            const Jim_Nvp ** result)
2618 {
2619         Jim_Nvp *n;
2620         int e;
2621
2622         e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2623         if( e == JIM_ERR ){
2624                 return e;
2625         }
2626
2627         /* Success? found? */
2628         if( n->name ){
2629                 /* remove const */
2630                 *result = (Jim_Nvp *)n;
2631                 return JIM_OK;
2632         } else {
2633                 return JIM_ERR;
2634         }
2635 }
2636
2637 /* -----------------------------------------------------------------------------
2638  * Source Object
2639  *
2640  * This object is just a string from the language point of view, but
2641  * in the internal representation it contains the filename and line number
2642  * where this given token was read. This information is used by
2643  * Jim_EvalObj() if the object passed happens to be of type "source".
2644  *
2645  * This allows to propagate the information about line numbers and file
2646  * names and give error messages with absolute line numbers.
2647  *
2648  * Note that this object uses shared strings for filenames, and the
2649  * pointer to the filename together with the line number is taken into
2650  * the space for the "inline" internal represenation of the Jim_Object,
2651  * so there is almost memory zero-overhead.
2652  *
2653  * Also the object will be converted to something else if the given
2654  * token it represents in the source file is not something to be
2655  * evaluated (not a script), and will be specialized in some other way,
2656  * so the time overhead is alzo null.
2657  * ---------------------------------------------------------------------------*/
2658
2659 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2660 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2661
2662 static Jim_ObjType sourceObjType = {
2663     "source",
2664     FreeSourceInternalRep,
2665     DupSourceInternalRep,
2666     NULL,
2667     JIM_TYPE_REFERENCES,
2668 };
2669
2670 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2671 {
2672     Jim_ReleaseSharedString(interp,
2673             objPtr->internalRep.sourceValue.fileName);
2674 }
2675
2676 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2677 {
2678     dupPtr->internalRep.sourceValue.fileName =
2679         Jim_GetSharedString(interp,
2680                 srcPtr->internalRep.sourceValue.fileName);
2681     dupPtr->internalRep.sourceValue.lineNumber =
2682         dupPtr->internalRep.sourceValue.lineNumber;
2683     dupPtr->typePtr = &sourceObjType;
2684 }
2685
2686 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2687         const char *fileName, int lineNumber)
2688 {
2689     if (Jim_IsShared(objPtr))
2690         Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2691     if (objPtr->typePtr != NULL)
2692         Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2693     objPtr->internalRep.sourceValue.fileName =
2694         Jim_GetSharedString(interp, fileName);
2695     objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2696     objPtr->typePtr = &sourceObjType;
2697 }
2698
2699 /* -----------------------------------------------------------------------------
2700  * Script Object
2701  * ---------------------------------------------------------------------------*/
2702
2703 #define JIM_CMDSTRUCT_EXPAND -1
2704
2705 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2706 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2707 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2708
2709 static Jim_ObjType scriptObjType = {
2710     "script",
2711     FreeScriptInternalRep,
2712     DupScriptInternalRep,
2713     NULL,
2714     JIM_TYPE_REFERENCES,
2715 };
2716
2717 /* The ScriptToken structure represents every token into a scriptObj.
2718  * Every token contains an associated Jim_Obj that can be specialized
2719  * by commands operating on it. */
2720 typedef struct ScriptToken {
2721     int type;
2722     Jim_Obj *objPtr;
2723     int linenr;
2724 } ScriptToken;
2725
2726 /* This is the script object internal representation. An array of
2727  * ScriptToken structures, with an associated command structure array.
2728  * The command structure is a pre-computed representation of the
2729  * command length and arguments structure as a simple liner array
2730  * of integers.
2731  * 
2732  * For example the script:
2733  *
2734  * puts hello
2735  * set $i $x$y [foo]BAR
2736  *
2737  * will produce a ScriptObj with the following Tokens:
2738  *
2739  * ESC puts
2740  * SEP
2741  * ESC hello
2742  * EOL
2743  * ESC set
2744  * EOL
2745  * VAR i
2746  * SEP
2747  * VAR x
2748  * VAR y
2749  * SEP
2750  * CMD foo
2751  * ESC BAR
2752  * EOL
2753  *
2754  * This is a description of the tokens, separators, and of lines.
2755  * The command structure instead represents the number of arguments
2756  * of every command, followed by the tokens of which every argument
2757  * is composed. So for the example script, the cmdstruct array will
2758  * contain:
2759  *
2760  * 2 1 1 4 1 1 2 2
2761  *
2762  * Because "puts hello" has two args (2), composed of single tokens (1 1)
2763  * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2764  * composed of single tokens (1 1) and the last two of double tokens
2765  * (2 2).
2766  *
2767  * The precomputation of the command structure makes Jim_Eval() faster,
2768  * and simpler because there aren't dynamic lengths / allocations.
2769  *
2770  * -- {expand} handling --
2771  *
2772  * Expand is handled in a special way. When a command
2773  * contains at least an argument with the {expand} prefix,
2774  * the command structure presents a -1 before the integer
2775  * describing the number of arguments. This is used in order
2776  * to send the command exection to a different path in case
2777  * of {expand} and guarantee a fast path for the more common
2778  * case. Also, the integers describing the number of tokens
2779  * are expressed with negative sign, to allow for fast check
2780  * of what's an {expand}-prefixed argument and what not.
2781  *
2782  * For example the command:
2783  *
2784  * list {expand}{1 2}
2785  *
2786  * Will produce the following cmdstruct array:
2787  *
2788  * -1 2 1 -2
2789  *
2790  * -- the substFlags field of the structure --
2791  *
2792  * The scriptObj structure is used to represent both "script" objects
2793  * and "subst" objects. In the second case, the cmdStruct related
2794  * fields are not used at all, but there is an additional field used
2795  * that is 'substFlags': this represents the flags used to turn
2796  * the string into the intenral representation used to perform the
2797  * substitution. If this flags are not what the application requires
2798  * the scriptObj is created again. For example the script:
2799  *
2800  * subst -nocommands $string
2801  * subst -novariables $string
2802  *
2803  * Will recreate the internal representation of the $string object
2804  * two times.
2805  */
2806 typedef struct ScriptObj {
2807     int len; /* Length as number of tokens. */
2808     int commands; /* number of top-level commands in script. */
2809     ScriptToken *token; /* Tokens array. */
2810     int *cmdStruct; /* commands structure */
2811     int csLen; /* length of the cmdStruct array. */
2812     int substFlags; /* flags used for the compilation of "subst" objects */
2813     int inUse; /* Used to share a ScriptObj. Currently
2814               only used by Jim_EvalObj() as protection against
2815               shimmering of the currently evaluated object. */
2816     char *fileName;
2817 } ScriptObj;
2818
2819 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2820 {
2821     int i;
2822     struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2823
2824     script->inUse--;
2825     if (script->inUse != 0) return;
2826     for (i = 0; i < script->len; i++) {
2827         if (script->token[i].objPtr != NULL)
2828             Jim_DecrRefCount(interp, script->token[i].objPtr);
2829     }
2830     Jim_Free(script->token);
2831     Jim_Free(script->cmdStruct);
2832     Jim_Free(script->fileName);
2833     Jim_Free(script);
2834 }
2835
2836 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2837 {
2838     JIM_NOTUSED(interp);
2839     JIM_NOTUSED(srcPtr);
2840
2841     /* Just returns an simple string. */
2842     dupPtr->typePtr = NULL;
2843 }
2844
2845 /* Add a new token to the internal repr of a script object */
2846 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2847         char *strtoken, int len, int type, char *filename, int linenr)
2848 {
2849     int prevtype;
2850     struct ScriptToken *token;
2851
2852     prevtype = (script->len == 0) ? JIM_TT_EOL : \
2853         script->token[script->len-1].type;
2854     /* Skip tokens without meaning, like words separators
2855      * following a word separator or an end of command and
2856      * so on. */
2857     if (prevtype == JIM_TT_EOL) {
2858         if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2859             Jim_Free(strtoken);
2860             return;
2861         }
2862     } else if (prevtype == JIM_TT_SEP) {
2863         if (type == JIM_TT_SEP) {
2864             Jim_Free(strtoken);
2865             return;
2866         } else if (type == JIM_TT_EOL) {
2867             /* If an EOL is following by a SEP, drop the previous
2868              * separator. */
2869             script->len--;
2870             Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2871         }
2872     } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2873             type == JIM_TT_ESC && len == 0)
2874     {
2875         /* Don't add empty tokens used in interpolation */
2876         Jim_Free(strtoken);
2877         return;
2878     }
2879     /* Make space for a new istruction */
2880     script->len++;
2881     script->token = Jim_Realloc(script->token,
2882             sizeof(ScriptToken)*script->len);
2883     /* Initialize the new token */
2884     token = script->token+(script->len-1);
2885     token->type = type;
2886     /* Every object is intially as a string, but the
2887      * internal type may be specialized during execution of the
2888      * script. */
2889     token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2890     /* To add source info to SEP and EOL tokens is useless because
2891      * they will never by called as arguments of Jim_EvalObj(). */
2892     if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2893         JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2894     Jim_IncrRefCount(token->objPtr);
2895     token->linenr = linenr;
2896 }
2897
2898 /* Add an integer into the command structure field of the script object. */
2899 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2900 {
2901     script->csLen++;
2902     script->cmdStruct = Jim_Realloc(script->cmdStruct,
2903                     sizeof(int)*script->csLen);
2904     script->cmdStruct[script->csLen-1] = val;
2905 }
2906
2907 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2908  * of objPtr. Search nested script objects recursively. */
2909 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2910         ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2911 {
2912     int i;
2913
2914     for (i = 0; i < script->len; i++) {
2915         if (script->token[i].objPtr != objPtr &&
2916             Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2917             return script->token[i].objPtr;
2918         }
2919         /* Enter recursively on scripts only if the object
2920          * is not the same as the one we are searching for
2921          * shared occurrences. */
2922         if (script->token[i].objPtr->typePtr == &scriptObjType &&
2923             script->token[i].objPtr != objPtr) {
2924             Jim_Obj *foundObjPtr;
2925
2926             ScriptObj *subScript =
2927                 script->token[i].objPtr->internalRep.ptr;
2928             /* Don't recursively enter the script we are trying
2929              * to make shared to avoid circular references. */
2930             if (subScript == scriptBarrier) continue;
2931             if (subScript != script) {
2932                 foundObjPtr =
2933                     ScriptSearchLiteral(interp, subScript,
2934                             scriptBarrier, objPtr);
2935                 if (foundObjPtr != NULL)
2936                     return foundObjPtr;
2937             }
2938         }
2939     }
2940     return NULL;
2941 }
2942
2943 /* Share literals of a script recursively sharing sub-scripts literals. */
2944 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2945         ScriptObj *topLevelScript)
2946 {
2947     int i, j;
2948
2949     return;
2950     /* Try to share with toplevel object. */
2951     if (topLevelScript != NULL) {
2952         for (i = 0; i < script->len; i++) {
2953             Jim_Obj *foundObjPtr;
2954             char *str = script->token[i].objPtr->bytes;
2955
2956             if (script->token[i].objPtr->refCount != 1) continue;
2957             if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2958             if (strchr(str, ' ') || strchr(str, '\n')) continue;
2959             foundObjPtr = ScriptSearchLiteral(interp,
2960                     topLevelScript,
2961                     script, /* barrier */
2962                     script->token[i].objPtr);
2963             if (foundObjPtr != NULL) {
2964                 Jim_IncrRefCount(foundObjPtr);
2965                 Jim_DecrRefCount(interp,
2966                         script->token[i].objPtr);
2967                 script->token[i].objPtr = foundObjPtr;
2968             }
2969         }
2970     }
2971     /* Try to share locally */
2972     for (i = 0; i < script->len; i++) {
2973         char *str = script->token[i].objPtr->bytes;
2974
2975         if (script->token[i].objPtr->refCount != 1) continue;
2976         if (strchr(str, ' ') || strchr(str, '\n')) continue;
2977         for (j = 0; j < script->len; j++) {
2978             if (script->token[i].objPtr !=
2979                     script->token[j].objPtr &&
2980                 Jim_StringEqObj(script->token[i].objPtr,
2981                             script->token[j].objPtr, 0))
2982             {
2983                 Jim_IncrRefCount(script->token[j].objPtr);
2984                 Jim_DecrRefCount(interp,
2985                         script->token[i].objPtr);
2986                 script->token[i].objPtr =
2987                     script->token[j].objPtr;
2988             }
2989         }
2990     }
2991 }
2992
2993 /* This method takes the string representation of an object
2994  * as a Tcl script, and generates the pre-parsed internal representation
2995  * of the script. */
2996 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2997 {
2998     int scriptTextLen;
2999     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3000     struct JimParserCtx parser;
3001     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3002     ScriptToken *token;
3003     int args, tokens, start, end, i;
3004     int initialLineNumber;
3005     int propagateSourceInfo = 0;
3006
3007     script->len = 0;
3008     script->csLen = 0;
3009     script->commands = 0;
3010     script->token = NULL;
3011     script->cmdStruct = NULL;
3012     script->inUse = 1;
3013     /* Try to get information about filename / line number */
3014     if (objPtr->typePtr == &sourceObjType) {
3015         script->fileName =
3016             Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3017         initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3018         propagateSourceInfo = 1;
3019     } else {
3020         script->fileName = Jim_StrDup("");
3021         initialLineNumber = 1;
3022     }
3023
3024     JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3025     while(!JimParserEof(&parser)) {
3026         char *token;
3027         int len, type, linenr;
3028
3029         JimParseScript(&parser);
3030         token = JimParserGetToken(&parser, &len, &type, &linenr);
3031         ScriptObjAddToken(interp, script, token, len, type,
3032                 propagateSourceInfo ? script->fileName : NULL,
3033                 linenr);
3034     }
3035     token = script->token;
3036
3037     /* Compute the command structure array
3038      * (see the ScriptObj struct definition for more info) */
3039     start = 0; /* Current command start token index */
3040     end = -1; /* Current command end token index */
3041     while (1) {
3042         int expand = 0; /* expand flag. set to 1 on {expand} form. */
3043         int interpolation = 0; /* set to 1 if there is at least one
3044                       argument of the command obtained via
3045                       interpolation of more tokens. */
3046         /* Search for the end of command, while
3047          * count the number of args. */
3048         start = ++end;
3049         if (start >= script->len) break;
3050         args = 1; /* Number of args in current command */
3051         while (token[end].type != JIM_TT_EOL) {
3052             if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3053                     token[end-1].type == JIM_TT_EOL)
3054             {
3055                 if (token[end].type == JIM_TT_STR &&
3056                     token[end+1].type != JIM_TT_SEP &&
3057                     token[end+1].type != JIM_TT_EOL &&
3058                     (!strcmp(token[end].objPtr->bytes, "expand") ||
3059                      !strcmp(token[end].objPtr->bytes, "*")))
3060                     expand++;
3061             }
3062             if (token[end].type == JIM_TT_SEP)
3063                 args++;
3064             end++;
3065         }
3066         interpolation = !((end-start+1) == args*2);
3067         /* Add the 'number of arguments' info into cmdstruct.
3068          * Negative value if there is list expansion involved. */
3069         if (expand)
3070             ScriptObjAddInt(script, -1);
3071         ScriptObjAddInt(script, args);
3072         /* Now add info about the number of tokens. */
3073         tokens = 0; /* Number of tokens in current argument. */
3074         expand = 0;
3075         for (i = start; i <= end; i++) {
3076             if (token[i].type == JIM_TT_SEP ||
3077                 token[i].type == JIM_TT_EOL)
3078             {
3079                 if (tokens == 1 && expand)
3080                     expand = 0;
3081                 ScriptObjAddInt(script,
3082                         expand ? -tokens : tokens);
3083
3084                 expand = 0;
3085                 tokens = 0;
3086                 continue;
3087             } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3088                    (!strcmp(token[i].objPtr->bytes, "expand") ||
3089                     !strcmp(token[i].objPtr->bytes, "*")))
3090             {
3091                 expand++;
3092             }
3093             tokens++;
3094         }
3095     }
3096     /* Perform literal sharing, but only for objects that appear
3097      * to be scripts written as literals inside the source code,
3098      * and not computed at runtime. Literal sharing is a costly
3099      * operation that should be done only against objects that
3100      * are likely to require compilation only the first time, and
3101      * then are executed multiple times. */
3102     if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3103         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3104         if (bodyObjPtr->typePtr == &scriptObjType) {
3105             ScriptObj *bodyScript =
3106                 bodyObjPtr->internalRep.ptr;
3107             ScriptShareLiterals(interp, script, bodyScript);
3108         }
3109     } else if (propagateSourceInfo) {
3110         ScriptShareLiterals(interp, script, NULL);
3111     }
3112     /* Free the old internal rep and set the new one. */
3113     Jim_FreeIntRep(interp, objPtr);
3114     Jim_SetIntRepPtr(objPtr, script);
3115     objPtr->typePtr = &scriptObjType;
3116     return JIM_OK;
3117 }
3118
3119 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3120 {
3121     if (objPtr->typePtr != &scriptObjType) {
3122         SetScriptFromAny(interp, objPtr);
3123     }
3124     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3125 }
3126
3127 /* -----------------------------------------------------------------------------
3128  * Commands
3129  * ---------------------------------------------------------------------------*/
3130
3131 /* Commands HashTable Type.
3132  *
3133  * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3134 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3135 {
3136     Jim_Cmd *cmdPtr = (void*) val;
3137
3138     if (cmdPtr->cmdProc == NULL) {
3139         Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3140         Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3141         if (cmdPtr->staticVars) {
3142             Jim_FreeHashTable(cmdPtr->staticVars);
3143             Jim_Free(cmdPtr->staticVars);
3144         }
3145     } else if (cmdPtr->delProc != NULL) {
3146             /* If it was a C coded command, call the delProc if any */
3147             cmdPtr->delProc(interp, cmdPtr->privData);
3148     }
3149     Jim_Free(val);
3150 }
3151
3152 static Jim_HashTableType JimCommandsHashTableType = {
3153     JimStringCopyHTHashFunction,        /* hash function */
3154     JimStringCopyHTKeyDup,        /* key dup */
3155     NULL,                    /* val dup */
3156     JimStringCopyHTKeyCompare,        /* key compare */
3157     JimStringCopyHTKeyDestructor,        /* key destructor */
3158     Jim_CommandsHT_ValDestructor        /* val destructor */
3159 };
3160
3161 /* ------------------------- Commands related functions --------------------- */
3162
3163 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3164         Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3165 {
3166     Jim_HashEntry *he;
3167     Jim_Cmd *cmdPtr;
3168
3169     he = Jim_FindHashEntry(&interp->commands, cmdName);
3170     if (he == NULL) { /* New command to create */
3171         cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3172         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3173     } else {
3174         Jim_InterpIncrProcEpoch(interp);
3175         /* Free the arglist/body objects if it was a Tcl procedure */
3176         cmdPtr = he->val;
3177         if (cmdPtr->cmdProc == NULL) {
3178             Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3179             Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3180             if (cmdPtr->staticVars) {
3181                 Jim_FreeHashTable(cmdPtr->staticVars);
3182                 Jim_Free(cmdPtr->staticVars);
3183             }
3184             cmdPtr->staticVars = NULL;
3185         } else if (cmdPtr->delProc != NULL) {
3186             /* If it was a C coded command, call the delProc if any */
3187             cmdPtr->delProc(interp, cmdPtr->privData);
3188         }
3189     }
3190
3191     /* Store the new details for this proc */
3192     cmdPtr->delProc = delProc;
3193     cmdPtr->cmdProc = cmdProc;
3194     cmdPtr->privData = privData;
3195
3196     /* There is no need to increment the 'proc epoch' because
3197      * creation of a new procedure can never affect existing
3198      * cached commands. We don't do negative caching. */
3199     return JIM_OK;
3200 }
3201
3202 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3203         Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3204         int arityMin, int arityMax)
3205 {
3206     Jim_Cmd *cmdPtr;
3207
3208     cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3209     cmdPtr->cmdProc = NULL; /* Not a C coded command */
3210     cmdPtr->argListObjPtr = argListObjPtr;
3211     cmdPtr->bodyObjPtr = bodyObjPtr;
3212     Jim_IncrRefCount(argListObjPtr);
3213     Jim_IncrRefCount(bodyObjPtr);
3214     cmdPtr->arityMin = arityMin;
3215     cmdPtr->arityMax = arityMax;
3216     cmdPtr->staticVars = NULL;
3217    
3218     /* Create the statics hash table. */
3219     if (staticsListObjPtr) {
3220         int len, i;
3221
3222         Jim_ListLength(interp, staticsListObjPtr, &len);
3223         if (len != 0) {
3224             cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3225             Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3226                     interp);
3227             for (i = 0; i < len; i++) {
3228                 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3229                 Jim_Var *varPtr;
3230                 int subLen;
3231
3232                 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3233                 /* Check if it's composed of two elements. */
3234                 Jim_ListLength(interp, objPtr, &subLen);
3235                 if (subLen == 1 || subLen == 2) {
3236                     /* Try to get the variable value from the current
3237                      * environment. */
3238                     Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3239                     if (subLen == 1) {
3240                         initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3241                                 JIM_NONE);
3242                         if (initObjPtr == NULL) {
3243                             Jim_SetResult(interp,
3244                                     Jim_NewEmptyStringObj(interp));
3245                             Jim_AppendStrings(interp, Jim_GetResult(interp),
3246                                 "variable for initialization of static \"",
3247                                 Jim_GetString(nameObjPtr, NULL),
3248                                 "\" not found in the local context",
3249                                 NULL);
3250                             goto err;
3251                         }
3252                     } else {
3253                         Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3254                     }
3255                     varPtr = Jim_Alloc(sizeof(*varPtr));
3256                     varPtr->objPtr = initObjPtr;
3257                     Jim_IncrRefCount(initObjPtr);
3258                     varPtr->linkFramePtr = NULL;
3259                     if (Jim_AddHashEntry(cmdPtr->staticVars,
3260                             Jim_GetString(nameObjPtr, NULL),
3261                             varPtr) != JIM_OK)
3262                     {
3263                         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3264                         Jim_AppendStrings(interp, Jim_GetResult(interp),
3265                             "static variable name \"",
3266                             Jim_GetString(objPtr, NULL), "\"",
3267                             " duplicated in statics list", NULL);
3268                         Jim_DecrRefCount(interp, initObjPtr);
3269                         Jim_Free(varPtr);
3270                         goto err;
3271                     }
3272                 } else {
3273                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274                     Jim_AppendStrings(interp, Jim_GetResult(interp),
3275                         "too many fields in static specifier \"",
3276                         objPtr, "\"", NULL);
3277                     goto err;
3278                 }
3279             }
3280         }
3281     }
3282
3283     /* Add the new command */
3284
3285     /* it may already exist, so we try to delete the old one */
3286     if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3287         /* There was an old procedure with the same name, this requires
3288          * a 'proc epoch' update. */
3289         Jim_InterpIncrProcEpoch(interp);
3290     }
3291     /* If a procedure with the same name didn't existed there is no need
3292      * to increment the 'proc epoch' because creation of a new procedure
3293      * can never affect existing cached commands. We don't do
3294      * negative caching. */
3295     Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3296     return JIM_OK;
3297
3298 err:
3299     Jim_FreeHashTable(cmdPtr->staticVars);
3300     Jim_Free(cmdPtr->staticVars);
3301     Jim_DecrRefCount(interp, argListObjPtr);
3302     Jim_DecrRefCount(interp, bodyObjPtr);
3303     Jim_Free(cmdPtr);
3304     return JIM_ERR;
3305 }
3306
3307 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3308 {
3309     if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3310         return JIM_ERR;
3311     Jim_InterpIncrProcEpoch(interp);
3312     return JIM_OK;
3313 }
3314
3315 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, 
3316         const char *newName)
3317 {
3318     Jim_Cmd *cmdPtr;
3319     Jim_HashEntry *he;
3320     Jim_Cmd *copyCmdPtr;
3321
3322     if (newName[0] == '\0') /* Delete! */
3323         return Jim_DeleteCommand(interp, oldName);
3324     /* Rename */
3325     he = Jim_FindHashEntry(&interp->commands, oldName);
3326     if (he == NULL)
3327         return JIM_ERR; /* Invalid command name */
3328     cmdPtr = he->val;
3329     copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3330     *copyCmdPtr = *cmdPtr;
3331     /* In order to avoid that a procedure will get arglist/body/statics
3332      * freed by the hash table methods, fake a C-coded command
3333      * setting cmdPtr->cmdProc as not NULL */
3334     cmdPtr->cmdProc = (void*)1;
3335     /* Also make sure delProc is NULL. */
3336     cmdPtr->delProc = NULL;
3337     /* Destroy the old command, and make sure the new is freed
3338      * as well. */
3339     Jim_DeleteHashEntry(&interp->commands, oldName);
3340     Jim_DeleteHashEntry(&interp->commands, newName);
3341     /* Now the new command. We are sure it can't fail because
3342      * the target name was already freed. */
3343     Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3344     /* Increment the epoch */
3345     Jim_InterpIncrProcEpoch(interp);
3346     return JIM_OK;
3347 }
3348
3349 /* -----------------------------------------------------------------------------
3350  * Command object
3351  * ---------------------------------------------------------------------------*/
3352
3353 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3354
3355 static Jim_ObjType commandObjType = {
3356     "command",
3357     NULL,
3358     NULL,
3359     NULL,
3360     JIM_TYPE_REFERENCES,
3361 };
3362
3363 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3364 {
3365     Jim_HashEntry *he;
3366     const char *cmdName;
3367
3368     /* Get the string representation */
3369     cmdName = Jim_GetString(objPtr, NULL);
3370     /* Lookup this name into the commands hash table */
3371     he = Jim_FindHashEntry(&interp->commands, cmdName);
3372     if (he == NULL)
3373         return JIM_ERR;
3374
3375     /* Free the old internal repr and set the new one. */
3376     Jim_FreeIntRep(interp, objPtr);
3377     objPtr->typePtr = &commandObjType;
3378     objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3379     objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3380     return JIM_OK;
3381 }
3382
3383 /* This function returns the command structure for the command name
3384  * stored in objPtr. It tries to specialize the objPtr to contain
3385  * a cached info instead to perform the lookup into the hash table
3386  * every time. The information cached may not be uptodate, in such
3387  * a case the lookup is performed and the cache updated. */
3388 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3389 {
3390     if ((objPtr->typePtr != &commandObjType ||
3391         objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3392         SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3393         if (flags & JIM_ERRMSG) {
3394             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3395             Jim_AppendStrings(interp, Jim_GetResult(interp),
3396                 "invalid command name \"", objPtr->bytes, "\"",
3397                 NULL);
3398         }
3399         return NULL;
3400     }
3401     return objPtr->internalRep.cmdValue.cmdPtr;
3402 }
3403
3404 /* -----------------------------------------------------------------------------
3405  * Variables
3406  * ---------------------------------------------------------------------------*/
3407
3408 /* Variables HashTable Type.
3409  *
3410  * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3411 static void JimVariablesHTValDestructor(void *interp, void *val)
3412 {
3413     Jim_Var *varPtr = (void*) val;
3414
3415     Jim_DecrRefCount(interp, varPtr->objPtr);
3416     Jim_Free(val);
3417 }
3418
3419 static Jim_HashTableType JimVariablesHashTableType = {
3420     JimStringCopyHTHashFunction,        /* hash function */
3421     JimStringCopyHTKeyDup,              /* key dup */
3422     NULL,                               /* val dup */
3423     JimStringCopyHTKeyCompare,        /* key compare */
3424     JimStringCopyHTKeyDestructor,     /* key destructor */
3425     JimVariablesHTValDestructor       /* val destructor */
3426 };
3427
3428 static Jim_HashTableType *getJimVariablesHashTableType(void)
3429 {
3430         return &JimVariablesHashTableType;
3431 }
3432
3433 /* -----------------------------------------------------------------------------
3434  * Variable object
3435  * ---------------------------------------------------------------------------*/
3436
3437 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3438
3439 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3440
3441 static Jim_ObjType variableObjType = {
3442     "variable",
3443     NULL,
3444     NULL,
3445     NULL,
3446     JIM_TYPE_REFERENCES,
3447 };
3448
3449 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3450  * is in the form "varname(key)". */
3451 static int Jim_NameIsDictSugar(const char *str, int len)
3452 {
3453     if (len == -1)
3454         len = strlen(str);
3455     if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3456         return 1;
3457     return 0;
3458 }
3459
3460 /* This method should be called only by the variable API.
3461  * It returns JIM_OK on success (variable already exists),
3462  * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3463  * a variable name, but syntax glue for [dict] i.e. the last
3464  * character is ')' */
3465 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3466 {
3467     Jim_HashEntry *he;
3468     const char *varName;
3469     int len;
3470
3471     /* Check if the object is already an uptodate variable */
3472     if (objPtr->typePtr == &variableObjType &&
3473         objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3474         return JIM_OK; /* nothing to do */
3475     /* Get the string representation */
3476     varName = Jim_GetString(objPtr, &len);
3477     /* Make sure it's not syntax glue to get/set dict. */
3478     if (Jim_NameIsDictSugar(varName, len))
3479             return JIM_DICT_SUGAR;
3480     if (varName[0] == ':' && varName[1] == ':') {
3481         he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3482         if (he == NULL) {
3483             return JIM_ERR;
3484         }
3485     }
3486     else {
3487         /* Lookup this name into the variables hash table */
3488         he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3489         if (he == NULL) {
3490             /* Try with static vars. */
3491             if (interp->framePtr->staticVars == NULL)
3492                 return JIM_ERR;
3493             if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3494                 return JIM_ERR;
3495         }
3496     }
3497     /* Free the old internal repr and set the new one. */
3498     Jim_FreeIntRep(interp, objPtr);
3499     objPtr->typePtr = &variableObjType;
3500     objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3501     objPtr->internalRep.varValue.varPtr = (void*)he->val;
3502     return JIM_OK;
3503 }
3504
3505 /* -------------------- Variables related functions ------------------------- */
3506 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3507         Jim_Obj *valObjPtr);
3508 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3509
3510 /* For now that's dummy. Variables lookup should be optimized
3511  * in many ways, with caching of lookups, and possibly with
3512  * a table of pre-allocated vars in every CallFrame for local vars.
3513  * All the caching should also have an 'epoch' mechanism similar
3514  * to the one used by Tcl for procedures lookup caching. */
3515
3516 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3517 {
3518     const char *name;
3519     Jim_Var *var;
3520     int err;
3521
3522     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3523         /* Check for [dict] syntax sugar. */
3524         if (err == JIM_DICT_SUGAR)
3525             return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3526         /* New variable to create */
3527         name = Jim_GetString(nameObjPtr, NULL);
3528
3529         var = Jim_Alloc(sizeof(*var));
3530         var->objPtr = valObjPtr;
3531         Jim_IncrRefCount(valObjPtr);
3532         var->linkFramePtr = NULL;
3533         /* Insert the new variable */
3534         if (name[0] == ':' && name[1] == ':') {
3535             /* Into to the top evel frame */
3536             Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3537         }
3538         else {
3539             Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3540         }
3541         /* Make the object int rep a variable */
3542         Jim_FreeIntRep(interp, nameObjPtr);
3543         nameObjPtr->typePtr = &variableObjType;
3544         nameObjPtr->internalRep.varValue.callFrameId =
3545             interp->framePtr->id;
3546         nameObjPtr->internalRep.varValue.varPtr = var;
3547     } else {
3548         var = nameObjPtr->internalRep.varValue.varPtr;
3549         if (var->linkFramePtr == NULL) {
3550             Jim_IncrRefCount(valObjPtr);
3551             Jim_DecrRefCount(interp, var->objPtr);
3552             var->objPtr = valObjPtr;
3553         } else { /* Else handle the link */
3554             Jim_CallFrame *savedCallFrame;
3555
3556             savedCallFrame = interp->framePtr;
3557             interp->framePtr = var->linkFramePtr;
3558             err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3559             interp->framePtr = savedCallFrame;
3560             if (err != JIM_OK)
3561                 return err;
3562         }
3563     }
3564     return JIM_OK;
3565 }
3566
3567 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3568 {
3569     Jim_Obj *nameObjPtr;
3570     int result;
3571
3572     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3573     Jim_IncrRefCount(nameObjPtr);
3574     result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3575     Jim_DecrRefCount(interp, nameObjPtr);
3576     return result;
3577 }
3578
3579 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3580 {
3581     Jim_CallFrame *savedFramePtr;
3582     int result;
3583
3584     savedFramePtr = interp->framePtr;
3585     interp->framePtr = interp->topFramePtr;
3586     result = Jim_SetVariableStr(interp, name, objPtr);
3587     interp->framePtr = savedFramePtr;
3588     return result;
3589 }
3590
3591 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3592 {
3593     Jim_Obj *nameObjPtr, *valObjPtr;
3594     int result;
3595
3596     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3597     valObjPtr = Jim_NewStringObj(interp, val, -1);
3598     Jim_IncrRefCount(nameObjPtr);
3599     Jim_IncrRefCount(valObjPtr);
3600     result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3601     Jim_DecrRefCount(interp, nameObjPtr);
3602     Jim_DecrRefCount(interp, valObjPtr);
3603     return result;
3604 }
3605
3606 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3607         Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3608 {
3609     const char *varName;
3610     int len;
3611
3612     /* Check for cycles. */
3613     if (interp->framePtr == targetCallFrame) {
3614         Jim_Obj *objPtr = targetNameObjPtr;
3615         Jim_Var *varPtr;
3616         /* Cycles are only possible with 'uplevel 0' */
3617         while(1) {
3618             if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3619                 Jim_SetResultString(interp,
3620                     "can't upvar from variable to itself", -1);
3621                 return JIM_ERR;
3622             }
3623             if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3624                 break;
3625             varPtr = objPtr->internalRep.varValue.varPtr;
3626             if (varPtr->linkFramePtr != targetCallFrame) break;
3627             objPtr = varPtr->objPtr;
3628         }
3629     }
3630     varName = Jim_GetString(nameObjPtr, &len);
3631     if (Jim_NameIsDictSugar(varName, len)) {
3632         Jim_SetResultString(interp,
3633             "Dict key syntax invalid as link source", -1);
3634         return JIM_ERR;
3635     }
3636     /* Perform the binding */
3637     Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3638     /* We are now sure 'nameObjPtr' type is variableObjType */
3639     nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3640     return JIM_OK;
3641 }
3642
3643 /* Return the Jim_Obj pointer associated with a variable name,
3644  * or NULL if the variable was not found in the current context.
3645  * The same optimization discussed in the comment to the
3646  * 'SetVariable' function should apply here. */
3647 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3648 {
3649     int err;
3650
3651     /* All the rest is handled here */
3652     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3653         /* Check for [dict] syntax sugar. */
3654         if (err == JIM_DICT_SUGAR)
3655             return JimDictSugarGet(interp, nameObjPtr);
3656         if (flags & JIM_ERRMSG) {
3657             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3658             Jim_AppendStrings(interp, Jim_GetResult(interp),
3659                 "can't read \"", nameObjPtr->bytes,
3660                 "\": no such variable", NULL);
3661         }
3662         return NULL;
3663     } else {
3664         Jim_Var *varPtr;
3665         Jim_Obj *objPtr;
3666         Jim_CallFrame *savedCallFrame;
3667
3668         varPtr = nameObjPtr->internalRep.varValue.varPtr;
3669         if (varPtr->linkFramePtr == NULL)
3670             return varPtr->objPtr;
3671         /* The variable is a link? Resolve it. */
3672         savedCallFrame = interp->framePtr;
3673         interp->framePtr = varPtr->linkFramePtr;
3674         objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3675         if (objPtr == NULL && flags & JIM_ERRMSG) {
3676             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3677             Jim_AppendStrings(interp, Jim_GetResult(interp),
3678                 "can't read \"", nameObjPtr->bytes,
3679                 "\": no such variable", NULL);
3680         }
3681         interp->framePtr = savedCallFrame;
3682         return objPtr;
3683     }
3684 }
3685
3686 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3687         int flags)
3688 {
3689     Jim_CallFrame *savedFramePtr;
3690     Jim_Obj *objPtr;
3691
3692     savedFramePtr = interp->framePtr;
3693     interp->framePtr = interp->topFramePtr;
3694     objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3695     interp->framePtr = savedFramePtr;
3696
3697     return objPtr;
3698 }
3699
3700 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3701 {
3702     Jim_Obj *nameObjPtr, *varObjPtr;
3703
3704     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3705     Jim_IncrRefCount(nameObjPtr);
3706     varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3707     Jim_DecrRefCount(interp, nameObjPtr);
3708     return varObjPtr;
3709 }
3710
3711 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3712         int flags)
3713 {
3714     Jim_CallFrame *savedFramePtr;
3715     Jim_Obj *objPtr;
3716
3717     savedFramePtr = interp->framePtr;
3718     interp->framePtr = interp->topFramePtr;
3719     objPtr = Jim_GetVariableStr(interp, name, flags);
3720     interp->framePtr = savedFramePtr;
3721
3722     return objPtr;
3723 }
3724
3725 /* Unset a variable.
3726  * Note: On success unset invalidates all the variable objects created
3727  * in the current call frame incrementing. */
3728 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3729 {
3730     const char *name;
3731     Jim_Var *varPtr;
3732     int err;
3733     
3734     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3735         /* Check for [dict] syntax sugar. */
3736         if (err == JIM_DICT_SUGAR)
3737             return JimDictSugarSet(interp, nameObjPtr, NULL);
3738         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3739         Jim_AppendStrings(interp, Jim_GetResult(interp),
3740             "can't unset \"", nameObjPtr->bytes,
3741             "\": no such variable", NULL);
3742         return JIM_ERR; /* var not found */
3743     }
3744     varPtr = nameObjPtr->internalRep.varValue.varPtr;
3745     /* If it's a link call UnsetVariable recursively */
3746     if (varPtr->linkFramePtr) {
3747         int retval;
3748
3749         Jim_CallFrame *savedCallFrame;
3750
3751         savedCallFrame = interp->framePtr;
3752         interp->framePtr = varPtr->linkFramePtr;
3753         retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3754         interp->framePtr = savedCallFrame;
3755         if (retval != JIM_OK && flags & JIM_ERRMSG) {
3756             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3757             Jim_AppendStrings(interp, Jim_GetResult(interp),
3758                 "can't unset \"", nameObjPtr->bytes,
3759                 "\": no such variable", NULL);
3760         }
3761         return retval;
3762     } else {
3763         name = Jim_GetString(nameObjPtr, NULL);
3764         if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3765                 != JIM_OK) return JIM_ERR;
3766         /* Change the callframe id, invalidating var lookup caching */
3767         JimChangeCallFrameId(interp, interp->framePtr);
3768         return JIM_OK;
3769     }
3770 }
3771
3772 /* ----------  Dict syntax sugar (similar to array Tcl syntax) -------------- */
3773
3774 /* Given a variable name for [dict] operation syntax sugar,
3775  * this function returns two objects, the first with the name
3776  * of the variable to set, and the second with the rispective key.
3777  * For example "foo(bar)" will return objects with string repr. of
3778  * "foo" and "bar".
3779  *
3780  * The returned objects have refcount = 1. The function can't fail. */
3781 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3782         Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3783 {
3784     const char *str, *p;
3785     char *t;
3786     int len, keyLen, nameLen;
3787     Jim_Obj *varObjPtr, *keyObjPtr;
3788
3789     str = Jim_GetString(objPtr, &len);
3790     p = strchr(str, '(');
3791     p++;
3792     keyLen = len-((p-str)+1);
3793     nameLen = (p-str)-1;
3794     /* Create the objects with the variable name and key. */
3795     t = Jim_Alloc(nameLen+1);
3796     memcpy(t, str, nameLen);
3797     t[nameLen] = '\0';
3798     varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3799
3800     t = Jim_Alloc(keyLen+1);
3801     memcpy(t, p, keyLen);
3802     t[keyLen] = '\0';
3803     keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3804
3805     Jim_IncrRefCount(varObjPtr);
3806     Jim_IncrRefCount(keyObjPtr);
3807     *varPtrPtr = varObjPtr;
3808     *keyPtrPtr = keyObjPtr;
3809 }
3810
3811 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3812  * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3813 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3814         Jim_Obj *valObjPtr)
3815 {
3816     Jim_Obj *varObjPtr, *keyObjPtr;
3817     int err = JIM_OK;
3818
3819     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3820     err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3821             valObjPtr);
3822     Jim_DecrRefCount(interp, varObjPtr);
3823     Jim_DecrRefCount(interp, keyObjPtr);
3824     return err;
3825 }
3826
3827 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3828 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3829 {
3830     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3831
3832     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3833     dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3834     if (!dictObjPtr) {
3835         resObjPtr = NULL;
3836         goto err;
3837     }
3838     if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3839             != JIM_OK) {
3840         resObjPtr = NULL;
3841     }
3842 err:
3843     Jim_DecrRefCount(interp, varObjPtr);
3844     Jim_DecrRefCount(interp, keyObjPtr);
3845     return resObjPtr;
3846 }
3847
3848 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3849
3850 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3851 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3852         Jim_Obj *dupPtr);
3853
3854 static Jim_ObjType dictSubstObjType = {
3855     "dict-substitution",
3856     FreeDictSubstInternalRep,
3857     DupDictSubstInternalRep,
3858     NULL,
3859     JIM_TYPE_NONE,
3860 };
3861
3862 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3863 {
3864     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3865     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3866 }
3867
3868 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3869         Jim_Obj *dupPtr)
3870 {
3871     JIM_NOTUSED(interp);
3872
3873     dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3874         srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3875     dupPtr->internalRep.dictSubstValue.indexObjPtr =
3876         srcPtr->internalRep.dictSubstValue.indexObjPtr;
3877     dupPtr->typePtr = &dictSubstObjType;
3878 }
3879
3880 /* This function is used to expand [dict get] sugar in the form
3881  * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3882  * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3883  * object that is *guaranteed* to be in the form VARNAME(INDEX).
3884  * The 'index' part is [subst]ituted, and is used to lookup a key inside
3885  * the [dict]ionary contained in variable VARNAME. */
3886 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3887 {
3888     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3889     Jim_Obj *substKeyObjPtr = NULL;
3890
3891     if (objPtr->typePtr != &dictSubstObjType) {
3892         JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3893         Jim_FreeIntRep(interp, objPtr);
3894         objPtr->typePtr = &dictSubstObjType;
3895         objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3896         objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3897     }
3898     if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3899                 &substKeyObjPtr, JIM_NONE)
3900             != JIM_OK) {
3901         substKeyObjPtr = NULL;
3902         goto err;
3903     }
3904     Jim_IncrRefCount(substKeyObjPtr);
3905     dictObjPtr = Jim_GetVariable(interp,
3906             objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3907     if (!dictObjPtr) {
3908         resObjPtr = NULL;
3909         goto err;
3910     }
3911     if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3912             != JIM_OK) {
3913         resObjPtr = NULL;
3914         goto err;
3915     }
3916 err:
3917     if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3918     return resObjPtr;
3919 }
3920
3921 /* -----------------------------------------------------------------------------
3922  * CallFrame
3923  * ---------------------------------------------------------------------------*/
3924
3925 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3926 {
3927     Jim_CallFrame *cf;
3928     if (interp->freeFramesList) {
3929         cf = interp->freeFramesList;
3930         interp->freeFramesList = cf->nextFramePtr;
3931     } else {
3932         cf = Jim_Alloc(sizeof(*cf));
3933         cf->vars.table = NULL;
3934     }
3935
3936     cf->id = interp->callFrameEpoch++;
3937     cf->parentCallFrame = NULL;
3938     cf->argv = NULL;
3939     cf->argc = 0;
3940     cf->procArgsObjPtr = NULL;
3941     cf->procBodyObjPtr = NULL;
3942     cf->nextFramePtr = NULL;
3943     cf->staticVars = NULL;
3944     if (cf->vars.table == NULL)
3945         Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3946     return cf;
3947 }
3948
3949 /* Used to invalidate every caching related to callframe stability. */
3950 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3951 {
3952     cf->id = interp->callFrameEpoch++;
3953 }
3954
3955 #define JIM_FCF_NONE 0 /* no flags */
3956 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3957 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3958         int flags)
3959 {
3960     if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3961     if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3962     if (!(flags & JIM_FCF_NOHT))
3963         Jim_FreeHashTable(&cf->vars);
3964     else {
3965         int i;
3966         Jim_HashEntry **table = cf->vars.table, *he;
3967
3968         for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3969             he = table[i];
3970             while (he != NULL) {
3971                 Jim_HashEntry *nextEntry = he->next;
3972                 Jim_Var *varPtr = (void*) he->val;
3973
3974                 Jim_DecrRefCount(interp, varPtr->objPtr);
3975                 Jim_Free(he->val);
3976                 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3977                 Jim_Free(he);
3978                 table[i] = NULL;
3979                 he = nextEntry;
3980             }
3981         }
3982         cf->vars.used = 0;
3983     }
3984     cf->nextFramePtr = interp->freeFramesList;
3985     interp->freeFramesList = cf;
3986 }
3987
3988 /* -----------------------------------------------------------------------------
3989  * References
3990  * ---------------------------------------------------------------------------*/
3991
3992 /* References HashTable Type.
3993  *
3994  * Keys are jim_wide integers, dynamically allocated for now but in the
3995  * future it's worth to cache this 8 bytes objects. Values are poitners
3996  * to Jim_References. */
3997 static void JimReferencesHTValDestructor(void *interp, void *val)
3998 {
3999     Jim_Reference *refPtr = (void*) val;
4000
4001     Jim_DecrRefCount(interp, refPtr->objPtr);
4002     if (refPtr->finalizerCmdNamePtr != NULL) {
4003         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4004     }
4005     Jim_Free(val);
4006 }
4007
4008 unsigned int JimReferencesHTHashFunction(const void *key)
4009 {
4010     /* Only the least significant bits are used. */
4011     const jim_wide *widePtr = key;
4012     unsigned int intValue = (unsigned int) *widePtr;
4013     return Jim_IntHashFunction(intValue);
4014 }
4015
4016 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4017 {
4018     /* Only the least significant bits are used. */
4019     const jim_wide *widePtr = key;
4020     unsigned int intValue = (unsigned int) *widePtr;
4021     return intValue; /* identity function. */
4022 }
4023
4024 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4025 {
4026     void *copy = Jim_Alloc(sizeof(jim_wide));
4027     JIM_NOTUSED(privdata);
4028
4029     memcpy(copy, key, sizeof(jim_wide));
4030     return copy;
4031 }
4032
4033 int JimReferencesHTKeyCompare(void *privdata, const void *key1, 
4034         const void *key2)
4035 {
4036     JIM_NOTUSED(privdata);
4037
4038     return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4039 }
4040
4041 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4042 {
4043     JIM_NOTUSED(privdata);
4044
4045     Jim_Free((void*)key);
4046 }
4047
4048 static Jim_HashTableType JimReferencesHashTableType = {
4049     JimReferencesHTHashFunction,    /* hash function */
4050     JimReferencesHTKeyDup,          /* key dup */
4051     NULL,                           /* val dup */
4052     JimReferencesHTKeyCompare,      /* key compare */
4053     JimReferencesHTKeyDestructor,   /* key destructor */
4054     JimReferencesHTValDestructor    /* val destructor */
4055 };
4056
4057 /* -----------------------------------------------------------------------------
4058  * Reference object type and References API
4059  * ---------------------------------------------------------------------------*/
4060
4061 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4062
4063 static Jim_ObjType referenceObjType = {
4064     "reference",
4065     NULL,
4066     NULL,
4067     UpdateStringOfReference,
4068     JIM_TYPE_REFERENCES,
4069 };
4070
4071 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4072 {
4073     int len;
4074     char buf[JIM_REFERENCE_SPACE+1];
4075     Jim_Reference *refPtr;
4076
4077     refPtr = objPtr->internalRep.refValue.refPtr;
4078     len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4079     objPtr->bytes = Jim_Alloc(len+1);
4080     memcpy(objPtr->bytes, buf, len+1);
4081     objPtr->length = len;
4082 }
4083
4084 /* returns true if 'c' is a valid reference tag character.
4085  * i.e. inside the range [_a-zA-Z0-9] */
4086 static int isrefchar(int c)
4087 {
4088     if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4089         (c >= '0' && c <= '9')) return 1;
4090     return 0;
4091 }
4092
4093 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4094 {
4095     jim_wide wideValue;
4096     int i, len;
4097     const char *str, *start, *end;
4098     char refId[21];
4099     Jim_Reference *refPtr;
4100     Jim_HashEntry *he;
4101
4102     /* Get the string representation */
4103     str = Jim_GetString(objPtr, &len);
4104     /* Check if it looks like a reference */
4105     if (len < JIM_REFERENCE_SPACE) goto badformat;
4106     /* Trim spaces */
4107     start = str;
4108     end = str+len-1;
4109     while (*start == ' ') start++;
4110     while (*end == ' ' && end > start) end--;
4111     if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4112     /* <reference.<1234567>.%020> */
4113     if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4114     if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4115     /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4116     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4117         if (!isrefchar(start[12+i])) goto badformat;
4118     }
4119     /* Extract info from the refernece. */
4120     memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4121     refId[20] = '\0';
4122     /* Try to convert the ID into a jim_wide */
4123     if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4124     /* Check if the reference really exists! */
4125     he = Jim_FindHashEntry(&interp->references, &wideValue);
4126     if (he == NULL) {
4127         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4128         Jim_AppendStrings(interp, Jim_GetResult(interp),
4129                 "Invalid reference ID \"", str, "\"", NULL);
4130         return JIM_ERR;
4131     }
4132     refPtr = he->val;
4133     /* Free the old internal repr and set the new one. */
4134     Jim_FreeIntRep(interp, objPtr);
4135     objPtr->typePtr = &referenceObjType;
4136     objPtr->internalRep.refValue.id = wideValue;
4137     objPtr->internalRep.refValue.refPtr = refPtr;
4138     return JIM_OK;
4139
4140 badformat:
4141     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4142     Jim_AppendStrings(interp, Jim_GetResult(interp),
4143             "expected reference but got \"", str, "\"", NULL);
4144     return JIM_ERR;
4145 }
4146
4147 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4148  * as finalizer command (or NULL if there is no finalizer).
4149  * The returned reference object has refcount = 0. */
4150 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4151         Jim_Obj *cmdNamePtr)
4152 {
4153     struct Jim_Reference *refPtr;
4154     jim_wide wideValue = interp->referenceNextId;
4155     Jim_Obj *refObjPtr;
4156     const char *tag;
4157     int tagLen, i;
4158
4159     /* Perform the Garbage Collection if needed. */
4160     Jim_CollectIfNeeded(interp);
4161
4162     refPtr = Jim_Alloc(sizeof(*refPtr));
4163     refPtr->objPtr = objPtr;
4164     Jim_IncrRefCount(objPtr);
4165     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4166     if (cmdNamePtr)
4167         Jim_IncrRefCount(cmdNamePtr);
4168     Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4169     refObjPtr = Jim_NewObj(interp);
4170     refObjPtr->typePtr = &referenceObjType;
4171     refObjPtr->bytes = NULL;
4172     refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4173     refObjPtr->internalRep.refValue.refPtr = refPtr;
4174     interp->referenceNextId++;
4175     /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4176      * that does not pass the 'isrefchar' test is replaced with '_' */
4177     tag = Jim_GetString(tagPtr, &tagLen);
4178     if (tagLen > JIM_REFERENCE_TAGLEN)
4179         tagLen = JIM_REFERENCE_TAGLEN;
4180     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4181         if (i < tagLen)
4182             refPtr->tag[i] = tag[i];
4183         else
4184             refPtr->tag[i] = '_';
4185     }
4186     refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4187     return refObjPtr;
4188 }
4189
4190 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4191 {
4192     if (objPtr->typePtr != &referenceObjType &&
4193         SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4194         return NULL;
4195     return objPtr->internalRep.refValue.refPtr;
4196 }
4197
4198 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4199 {
4200     Jim_Reference *refPtr;
4201
4202     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4203         return JIM_ERR;
4204     Jim_IncrRefCount(cmdNamePtr);
4205     if (refPtr->finalizerCmdNamePtr)
4206         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4207     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4208     return JIM_OK;
4209 }
4210
4211 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4212 {
4213     Jim_Reference *refPtr;
4214
4215     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4216         return JIM_ERR;
4217     *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4218     return JIM_OK;
4219 }
4220
4221 /* -----------------------------------------------------------------------------
4222  * References Garbage Collection
4223  * ---------------------------------------------------------------------------*/
4224
4225 /* This the hash table type for the "MARK" phase of the GC */
4226 static Jim_HashTableType JimRefMarkHashTableType = {
4227     JimReferencesHTHashFunction,    /* hash function */
4228     JimReferencesHTKeyDup,          /* key dup */
4229     NULL,                           /* val dup */
4230     JimReferencesHTKeyCompare,      /* key compare */
4231     JimReferencesHTKeyDestructor,   /* key destructor */
4232     NULL                            /* val destructor */
4233 };
4234
4235 /* #define JIM_DEBUG_GC 1 */
4236
4237 /* Performs the garbage collection. */
4238 int Jim_Collect(Jim_Interp *interp)
4239 {
4240     Jim_HashTable marks;
4241     Jim_HashTableIterator *htiter;
4242     Jim_HashEntry *he;
4243     Jim_Obj *objPtr;
4244     int collected = 0;
4245
4246     /* Avoid recursive calls */
4247     if (interp->lastCollectId == -1) {
4248         /* Jim_Collect() already running. Return just now. */
4249         return 0;
4250     }
4251     interp->lastCollectId = -1;
4252
4253     /* Mark all the references found into the 'mark' hash table.
4254      * The references are searched in every live object that
4255      * is of a type that can contain references. */
4256     Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4257     objPtr = interp->liveList;
4258     while(objPtr) {
4259         if (objPtr->typePtr == NULL ||
4260             objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4261             const char *str, *p;
4262             int len;
4263
4264             /* If the object is of type reference, to get the
4265              * Id is simple... */
4266             if (objPtr->typePtr == &referenceObjType) {
4267                 Jim_AddHashEntry(&marks,
4268                     &objPtr->internalRep.refValue.id, NULL);
4269 #ifdef JIM_DEBUG_GC
4270                 Jim_fprintf(interp,interp->cookie_stdout,
4271                     "MARK (reference): %d refcount: %d" JIM_NL, 
4272                     (int) objPtr->internalRep.refValue.id,
4273                     objPtr->refCount);
4274 #endif
4275                 objPtr = objPtr->nextObjPtr;
4276                 continue;
4277             }
4278             /* Get the string repr of the object we want
4279              * to scan for references. */
4280             p = str = Jim_GetString(objPtr, &len);
4281             /* Skip objects too little to contain references. */
4282             if (len < JIM_REFERENCE_SPACE) {
4283                 objPtr = objPtr->nextObjPtr;
4284                 continue;
4285             }
4286             /* Extract references from the object string repr. */
4287             while(1) {
4288                 int i;
4289                 jim_wide id;
4290                 char buf[21];
4291
4292                 if ((p = strstr(p, "<reference.<")) == NULL)
4293                     break;
4294                 /* Check if it's a valid reference. */
4295                 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4296                 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4297                 for (i = 21; i <= 40; i++)
4298                     if (!isdigit((int)p[i]))
4299                         break;
4300                 /* Get the ID */
4301                 memcpy(buf, p+21, 20);
4302                 buf[20] = '\0';
4303                 Jim_StringToWide(buf, &id, 10);
4304
4305                 /* Ok, a reference for the given ID
4306                  * was found. Mark it. */
4307                 Jim_AddHashEntry(&marks, &id, NULL);
4308 #ifdef JIM_DEBUG_GC
4309                 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4310 #endif
4311                 p += JIM_REFERENCE_SPACE;
4312             }
4313         }
4314         objPtr = objPtr->nextObjPtr;
4315     }
4316
4317     /* Run the references hash table to destroy every reference that
4318      * is not referenced outside (not present in the mark HT). */
4319     htiter = Jim_GetHashTableIterator(&interp->references);
4320     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4321         const jim_wide *refId;
4322         Jim_Reference *refPtr;
4323
4324         refId = he->key;
4325         /* Check if in the mark phase we encountered
4326          * this reference. */
4327         if (Jim_FindHashEntry(&marks, refId) == NULL) {
4328 #ifdef JIM_DEBUG_GC
4329             Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4330 #endif
4331             collected++;
4332             /* Drop the reference, but call the
4333              * finalizer first if registered. */
4334             refPtr = he->val;
4335             if (refPtr->finalizerCmdNamePtr) {
4336                 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4337                 Jim_Obj *objv[3], *oldResult;
4338
4339                 JimFormatReference(refstr, refPtr, *refId);
4340
4341                 objv[0] = refPtr->finalizerCmdNamePtr;
4342                 objv[1] = Jim_NewStringObjNoAlloc(interp,
4343                         refstr, 32);
4344                 objv[2] = refPtr->objPtr;
4345                 Jim_IncrRefCount(objv[0]);
4346                 Jim_IncrRefCount(objv[1]);
4347                 Jim_IncrRefCount(objv[2]);
4348
4349                 /* Drop the reference itself */
4350                 Jim_DeleteHashEntry(&interp->references, refId);
4351
4352                 /* Call the finalizer. Errors ignored. */
4353                 oldResult = interp->result;
4354                 Jim_IncrRefCount(oldResult);
4355                 Jim_EvalObjVector(interp, 3, objv);
4356                 Jim_SetResult(interp, oldResult);
4357                 Jim_DecrRefCount(interp, oldResult);
4358
4359                 Jim_DecrRefCount(interp, objv[0]);
4360                 Jim_DecrRefCount(interp, objv[1]);
4361                 Jim_DecrRefCount(interp, objv[2]);
4362             } else {
4363                 Jim_DeleteHashEntry(&interp->references, refId);
4364             }
4365         }
4366     }
4367     Jim_FreeHashTableIterator(htiter);
4368     Jim_FreeHashTable(&marks);
4369     interp->lastCollectId = interp->referenceNextId;
4370     interp->lastCollectTime = time(NULL);
4371     return collected;
4372 }
4373
4374 #define JIM_COLLECT_ID_PERIOD 5000
4375 #define JIM_COLLECT_TIME_PERIOD 300
4376
4377 void Jim_CollectIfNeeded(Jim_Interp *interp)
4378 {
4379     jim_wide elapsedId;
4380     int elapsedTime;
4381     
4382     elapsedId = interp->referenceNextId - interp->lastCollectId;
4383     elapsedTime = time(NULL) - interp->lastCollectTime;
4384
4385
4386     if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4387         elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4388         Jim_Collect(interp);
4389     }
4390 }
4391
4392 /* -----------------------------------------------------------------------------
4393  * Interpreter related functions
4394  * ---------------------------------------------------------------------------*/
4395
4396 Jim_Interp *Jim_CreateInterp(void)
4397 {
4398     Jim_Interp *i = Jim_Alloc(sizeof(*i));
4399     Jim_Obj *pathPtr;
4400
4401     i->errorLine = 0;
4402     i->errorFileName = Jim_StrDup("");
4403     i->numLevels = 0;
4404     i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4405     i->returnCode = JIM_OK;
4406     i->exitCode = 0;
4407     i->procEpoch = 0;
4408     i->callFrameEpoch = 0;
4409     i->liveList = i->freeList = NULL;
4410     i->scriptFileName = Jim_StrDup("");
4411     i->referenceNextId = 0;
4412     i->lastCollectId = 0;
4413     i->lastCollectTime = time(NULL);
4414     i->freeFramesList = NULL;
4415     i->prngState = NULL;
4416     i->evalRetcodeLevel = -1;
4417     i->cookie_stdin = stdin;
4418     i->cookie_stdout = stdout;
4419     i->cookie_stderr = stderr;
4420         i->cb_fwrite   = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4421         i->cb_fread    = ((size_t (*)(       void *, size_t, size_t, void *))(fread));
4422         i->cb_vfprintf = ((int    (*)( void *, const char *fmt, va_list ))(vfprintf));
4423         i->cb_fflush   = ((int    (*)( void *))(fflush));
4424         i->cb_fgets    = ((char * (*)( char *, int, void *))(fgets));
4425
4426     /* Note that we can create objects only after the
4427      * interpreter liveList and freeList pointers are
4428      * initialized to NULL. */
4429     Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4430     Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4431     Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4432             NULL);
4433     Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4434     Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4435     Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4436     i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4437     i->emptyObj = Jim_NewEmptyStringObj(i);
4438     i->result = i->emptyObj;
4439     i->stackTrace = Jim_NewListObj(i, NULL, 0);
4440     i->unknown = Jim_NewStringObj(i, "unknown", -1);
4441     i->unknown_called = 0;
4442     Jim_IncrRefCount(i->emptyObj);
4443     Jim_IncrRefCount(i->result);
4444     Jim_IncrRefCount(i->stackTrace);
4445     Jim_IncrRefCount(i->unknown);
4446
4447     /* Initialize key variables every interpreter should contain */
4448     pathPtr = Jim_NewStringObj(i, "./", -1);
4449     Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4450     Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4451
4452     /* Export the core API to extensions */
4453     JimRegisterCoreApi(i);
4454     return i;
4455 }
4456
4457 /* This is the only function Jim exports directly without
4458  * to use the STUB system. It is only used by embedders
4459  * in order to get an interpreter with the Jim API pointers
4460  * registered. */
4461 Jim_Interp *ExportedJimCreateInterp(void)
4462 {
4463     return Jim_CreateInterp();
4464 }
4465
4466 void Jim_FreeInterp(Jim_Interp *i)
4467 {
4468     Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4469     Jim_Obj *objPtr, *nextObjPtr;
4470
4471     Jim_DecrRefCount(i, i->emptyObj);
4472     Jim_DecrRefCount(i, i->result);
4473     Jim_DecrRefCount(i, i->stackTrace);
4474     Jim_DecrRefCount(i, i->unknown);
4475     Jim_Free((void*)i->errorFileName);
4476     Jim_Free((void*)i->scriptFileName);
4477     Jim_FreeHashTable(&i->commands);
4478     Jim_FreeHashTable(&i->references);
4479     Jim_FreeHashTable(&i->stub);
4480     Jim_FreeHashTable(&i->assocData);
4481     Jim_FreeHashTable(&i->packages);
4482     Jim_Free(i->prngState);
4483     /* Free the call frames list */
4484     while(cf) {
4485         prevcf = cf->parentCallFrame;
4486         JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4487         cf = prevcf;
4488     }
4489     /* Check that the live object list is empty, otherwise
4490      * there is a memory leak. */
4491     if (i->liveList != NULL) {
4492         Jim_Obj *objPtr = i->liveList;
4493     
4494         Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4495         Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4496         while(objPtr) {
4497             const char *type = objPtr->typePtr ?
4498                 objPtr->typePtr->name : "";
4499             Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4500                     objPtr, type,
4501                     objPtr->bytes ? objPtr->bytes
4502                     : "(null)", objPtr->refCount);
4503             if (objPtr->typePtr == &sourceObjType) {
4504                 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4505                 objPtr->internalRep.sourceValue.fileName,
4506                 objPtr->internalRep.sourceValue.lineNumber);
4507             }
4508             objPtr = objPtr->nextObjPtr;
4509         }
4510         Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4511         Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4512     }
4513     /* Free all the freed objects. */
4514     objPtr = i->freeList;
4515     while (objPtr) {
4516         nextObjPtr = objPtr->nextObjPtr;
4517         Jim_Free(objPtr);
4518         objPtr = nextObjPtr;
4519     }
4520     /* Free cached CallFrame structures */
4521     cf = i->freeFramesList;
4522     while(cf) {
4523         nextcf = cf->nextFramePtr;
4524         if (cf->vars.table != NULL)
4525             Jim_Free(cf->vars.table);
4526         Jim_Free(cf);
4527         cf = nextcf;
4528     }
4529     /* Free the sharedString hash table. Make sure to free it
4530      * after every other Jim_Object was freed. */
4531     Jim_FreeHashTable(&i->sharedStrings);
4532     /* Free the interpreter structure. */
4533     Jim_Free(i);
4534 }
4535
4536 /* Store the call frame relative to the level represented by
4537  * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4538  * level is assumed to be '1'.
4539  *
4540  * If a newLevelptr int pointer is specified, the function stores
4541  * the absolute level integer value of the new target callframe into
4542  * *newLevelPtr. (this is used to adjust interp->numLevels
4543  * in the implementation of [uplevel], so that [info level] will
4544  * return a correct information).
4545  *
4546  * This function accepts the 'level' argument in the form
4547  * of the commands [uplevel] and [upvar].
4548  *
4549  * For a function accepting a relative integer as level suitable
4550  * for implementation of [info level ?level?] check the
4551  * GetCallFrameByInteger() function. */
4552 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4553         Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4554 {
4555     long level;
4556     const char *str;
4557     Jim_CallFrame *framePtr;
4558
4559     if (newLevelPtr) *newLevelPtr = interp->numLevels;
4560     if (levelObjPtr) {
4561         str = Jim_GetString(levelObjPtr, NULL);
4562         if (str[0] == '#') {
4563             char *endptr;
4564             /* speedup for the toplevel (level #0) */
4565             if (str[1] == '0' && str[2] == '\0') {
4566                 if (newLevelPtr) *newLevelPtr = 0;
4567                 *framePtrPtr = interp->topFramePtr;
4568                 return JIM_OK;
4569             }
4570
4571             level = strtol(str+1, &endptr, 0);
4572             if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4573                 goto badlevel;
4574             /* An 'absolute' level is converted into the
4575              * 'number of levels to go back' format. */
4576             level = interp->numLevels - level;
4577             if (level < 0) goto badlevel;
4578         } else {
4579             if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4580                 goto badlevel;
4581         }
4582     } else {
4583         str = "1"; /* Needed to format the error message. */
4584         level = 1;
4585     }
4586     /* Lookup */
4587     framePtr = interp->framePtr;
4588     if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4589     while (level--) {
4590         framePtr = framePtr->parentCallFrame;
4591         if (framePtr == NULL) goto badlevel;
4592     }
4593     *framePtrPtr = framePtr;
4594     return JIM_OK;
4595 badlevel:
4596     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4597     Jim_AppendStrings(interp, Jim_GetResult(interp),
4598             "bad level \"", str, "\"", NULL);
4599     return JIM_ERR;
4600 }
4601
4602 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4603  * as a relative integer like in the [info level ?level?] command. */
4604 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4605         Jim_CallFrame **framePtrPtr)
4606 {
4607     jim_wide level;
4608     jim_wide relLevel; /* level relative to the current one. */
4609     Jim_CallFrame *framePtr;
4610
4611     if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4612         goto badlevel;
4613     if (level > 0) {
4614         /* An 'absolute' level is converted into the
4615          * 'number of levels to go back' format. */
4616         relLevel = interp->numLevels - level;
4617     } else {
4618         relLevel = -level;
4619     }
4620     /* Lookup */
4621     framePtr = interp->framePtr;
4622     while (relLevel--) {
4623         framePtr = framePtr->parentCallFrame;
4624         if (framePtr == NULL) goto badlevel;
4625     }
4626     *framePtrPtr = framePtr;
4627     return JIM_OK;
4628 badlevel:
4629     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4630     Jim_AppendStrings(interp, Jim_GetResult(interp),
4631             "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4632     return JIM_ERR;
4633 }
4634
4635 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4636 {
4637     Jim_Free((void*)interp->errorFileName);
4638     interp->errorFileName = Jim_StrDup(filename);
4639 }
4640
4641 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4642 {
4643     interp->errorLine = linenr;
4644 }
4645
4646 static void JimResetStackTrace(Jim_Interp *interp)
4647 {
4648     Jim_DecrRefCount(interp, interp->stackTrace);
4649     interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4650     Jim_IncrRefCount(interp->stackTrace);
4651 }
4652
4653 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4654         const char *filename, int linenr)
4655 {
4656     /* No need to add this dummy entry to the stack trace */
4657     if (strcmp(procname, "unknown") == 0) {
4658         return;
4659     }
4660
4661     if (Jim_IsShared(interp->stackTrace)) {
4662         interp->stackTrace =
4663             Jim_DuplicateObj(interp, interp->stackTrace);
4664         Jim_IncrRefCount(interp->stackTrace);
4665     }
4666     Jim_ListAppendElement(interp, interp->stackTrace,
4667             Jim_NewStringObj(interp, procname, -1));
4668     Jim_ListAppendElement(interp, interp->stackTrace,
4669             Jim_NewStringObj(interp, filename, -1));
4670     Jim_ListAppendElement(interp, interp->stackTrace,
4671             Jim_NewIntObj(interp, linenr));
4672 }
4673
4674 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4675 {
4676     AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4677     assocEntryPtr->delProc = delProc;
4678     assocEntryPtr->data = data;
4679     return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4680 }
4681
4682 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4683 {
4684     Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4685     if (entryPtr != NULL) {
4686         AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4687         return assocEntryPtr->data;
4688     }
4689     return NULL;
4690 }
4691
4692 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4693 {
4694     return Jim_DeleteHashEntry(&interp->assocData, key);
4695 }
4696
4697 int Jim_GetExitCode(Jim_Interp *interp) {
4698     return interp->exitCode;
4699 }
4700
4701 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4702 {
4703     if (fp != NULL) interp->cookie_stdin = fp;
4704     return interp->cookie_stdin;
4705 }
4706
4707 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4708 {
4709     if (fp != NULL) interp->cookie_stdout = fp;
4710     return interp->cookie_stdout;
4711 }
4712
4713 void *Jim_SetStderr(Jim_Interp *interp, void  *fp)
4714 {
4715     if (fp != NULL) interp->cookie_stderr = fp;
4716     return interp->cookie_stderr;
4717 }
4718
4719 /* -----------------------------------------------------------------------------
4720  * Shared strings.
4721  * Every interpreter has an hash table where to put shared dynamically
4722  * allocate strings that are likely to be used a lot of times.
4723  * For example, in the 'source' object type, there is a pointer to
4724  * the filename associated with that object. Every script has a lot
4725  * of this objects with the identical file name, so it is wise to share
4726  * this info.
4727  *
4728  * The API is trivial: Jim_GetSharedString(interp, "foobar")
4729  * returns the pointer to the shared string. Every time a reference
4730  * to the string is no longer used, the user should call
4731  * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4732  * a given string, it is removed from the hash table.
4733  * ---------------------------------------------------------------------------*/
4734 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4735 {
4736     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4737
4738     if (he == NULL) {
4739         char *strCopy = Jim_StrDup(str);
4740
4741         Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4742         return strCopy;
4743     } else {
4744         long refCount = (long) he->val;
4745
4746         refCount++;
4747         he->val = (void*) refCount;
4748         return he->key;
4749     }
4750 }
4751
4752 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4753 {
4754     long refCount;
4755     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4756
4757     if (he == NULL)
4758         Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4759               "unknown shared string '%s'", str);
4760     refCount = (long) he->val;
4761     refCount--;
4762     if (refCount == 0) {
4763         Jim_DeleteHashEntry(&interp->sharedStrings, str);
4764     } else {
4765         he->val = (void*) refCount;
4766     }
4767 }
4768
4769 /* -----------------------------------------------------------------------------
4770  * Integer object
4771  * ---------------------------------------------------------------------------*/
4772 #define JIM_INTEGER_SPACE 24
4773
4774 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4775 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4776
4777 static Jim_ObjType intObjType = {
4778     "int",
4779     NULL,
4780     NULL,
4781     UpdateStringOfInt,
4782     JIM_TYPE_NONE,
4783 };
4784
4785 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4786 {
4787     int len;
4788     char buf[JIM_INTEGER_SPACE+1];
4789
4790     len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4791     objPtr->bytes = Jim_Alloc(len+1);
4792     memcpy(objPtr->bytes, buf, len+1);
4793     objPtr->length = len;
4794 }
4795
4796 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4797 {
4798     jim_wide wideValue;
4799     const char *str;
4800
4801     /* Get the string representation */
4802     str = Jim_GetString(objPtr, NULL);
4803     /* Try to convert into a jim_wide */
4804     if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4805         if (flags & JIM_ERRMSG) {
4806             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4807             Jim_AppendStrings(interp, Jim_GetResult(interp),
4808                     "expected integer but got \"", str, "\"", NULL);
4809         }
4810         return JIM_ERR;
4811     }
4812     if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4813         errno == ERANGE) {
4814         Jim_SetResultString(interp,
4815             "Integer value too big to be represented", -1);
4816         return JIM_ERR;
4817     }
4818     /* Free the old internal repr and set the new one. */
4819     Jim_FreeIntRep(interp, objPtr);
4820     objPtr->typePtr = &intObjType;
4821     objPtr->internalRep.wideValue = wideValue;
4822     return JIM_OK;
4823 }
4824
4825 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4826 {
4827     if (objPtr->typePtr != &intObjType &&
4828         SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4829         return JIM_ERR;
4830     *widePtr = objPtr->internalRep.wideValue;
4831     return JIM_OK;
4832 }
4833
4834 /* Get a wide but does not set an error if the format is bad. */
4835 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4836         jim_wide *widePtr)
4837 {
4838     if (objPtr->typePtr != &intObjType &&
4839         SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4840         return JIM_ERR;
4841     *widePtr = objPtr->internalRep.wideValue;
4842     return JIM_OK;
4843 }
4844
4845 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4846 {
4847     jim_wide wideValue;
4848     int retval;
4849
4850     retval = Jim_GetWide(interp, objPtr, &wideValue);
4851     if (retval == JIM_OK) {
4852         *longPtr = (long) wideValue;
4853         return JIM_OK;
4854     }
4855     return JIM_ERR;
4856 }
4857
4858 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4859 {
4860     if (Jim_IsShared(objPtr))
4861         Jim_Panic(interp,"Jim_SetWide called with shared object");
4862     if (objPtr->typePtr != &intObjType) {
4863         Jim_FreeIntRep(interp, objPtr);
4864         objPtr->typePtr = &intObjType;
4865     }
4866     Jim_InvalidateStringRep(objPtr);
4867     objPtr->internalRep.wideValue = wideValue;
4868 }
4869
4870 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4871 {
4872     Jim_Obj *objPtr;
4873
4874     objPtr = Jim_NewObj(interp);
4875     objPtr->typePtr = &intObjType;
4876     objPtr->bytes = NULL;
4877     objPtr->internalRep.wideValue = wideValue;
4878     return objPtr;
4879 }
4880
4881 /* -----------------------------------------------------------------------------
4882  * Double object
4883  * ---------------------------------------------------------------------------*/
4884 #define JIM_DOUBLE_SPACE 30
4885
4886 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4887 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4888
4889 static Jim_ObjType doubleObjType = {
4890     "double",
4891     NULL,
4892     NULL,
4893     UpdateStringOfDouble,
4894     JIM_TYPE_NONE,
4895 };
4896
4897 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4898 {
4899     int len;
4900     char buf[JIM_DOUBLE_SPACE+1];
4901
4902     len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4903     objPtr->bytes = Jim_Alloc(len+1);
4904     memcpy(objPtr->bytes, buf, len+1);
4905     objPtr->length = len;
4906 }
4907
4908 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4909 {
4910     double doubleValue;
4911     const char *str;
4912
4913     /* Get the string representation */
4914     str = Jim_GetString(objPtr, NULL);
4915     /* Try to convert into a double */
4916     if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4917         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4918         Jim_AppendStrings(interp, Jim_GetResult(interp),
4919                 "expected number but got '", str, "'", NULL);
4920         return JIM_ERR;
4921     }
4922     /* Free the old internal repr and set the new one. */
4923     Jim_FreeIntRep(interp, objPtr);
4924     objPtr->typePtr = &doubleObjType;
4925     objPtr->internalRep.doubleValue = doubleValue;
4926     return JIM_OK;
4927 }
4928
4929 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4930 {
4931     if (objPtr->typePtr != &doubleObjType &&
4932         SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4933         return JIM_ERR;
4934     *doublePtr = objPtr->internalRep.doubleValue;
4935     return JIM_OK;
4936 }
4937
4938 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4939 {
4940     if (Jim_IsShared(objPtr))
4941         Jim_Panic(interp,"Jim_SetDouble called with shared object");
4942     if (objPtr->typePtr != &doubleObjType) {
4943         Jim_FreeIntRep(interp, objPtr);
4944         objPtr->typePtr = &doubleObjType;
4945     }
4946     Jim_InvalidateStringRep(objPtr);
4947     objPtr->internalRep.doubleValue = doubleValue;
4948 }
4949
4950 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4951 {
4952     Jim_Obj *objPtr;
4953
4954     objPtr = Jim_NewObj(interp);
4955     objPtr->typePtr = &doubleObjType;
4956     objPtr->bytes = NULL;
4957     objPtr->internalRep.doubleValue = doubleValue;
4958     return objPtr;
4959 }
4960
4961 /* -----------------------------------------------------------------------------
4962  * List object
4963  * ---------------------------------------------------------------------------*/
4964 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4965 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4966 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4967 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4968 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4969
4970 /* Note that while the elements of the list may contain references,
4971  * the list object itself can't. This basically means that the
4972  * list object string representation as a whole can't contain references
4973  * that are not presents in the single elements. */
4974 static Jim_ObjType listObjType = {
4975     "list",
4976     FreeListInternalRep,
4977     DupListInternalRep,
4978     UpdateStringOfList,
4979     JIM_TYPE_NONE,
4980 };
4981
4982 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4983 {
4984     int i;
4985
4986     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4987         Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4988     }
4989     Jim_Free(objPtr->internalRep.listValue.ele);
4990 }
4991
4992 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4993 {
4994     int i;
4995     JIM_NOTUSED(interp);
4996
4997     dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4998     dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4999     dupPtr->internalRep.listValue.ele =
5000         Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5001     memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5002             sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5003     for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5004         Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5005     }
5006     dupPtr->typePtr = &listObjType;
5007 }
5008
5009 /* The following function checks if a given string can be encoded
5010  * into a list element without any kind of quoting, surrounded by braces,
5011  * or using escapes to quote. */
5012 #define JIM_ELESTR_SIMPLE 0
5013 #define JIM_ELESTR_BRACE 1
5014 #define JIM_ELESTR_QUOTE 2
5015 static int ListElementQuotingType(const char *s, int len)
5016 {
5017     int i, level, trySimple = 1;
5018
5019     /* Try with the SIMPLE case */
5020     if (len == 0) return JIM_ELESTR_BRACE;
5021     if (s[0] == '"' || s[0] == '{') {
5022         trySimple = 0;
5023         goto testbrace;
5024     }
5025     for (i = 0; i < len; i++) {
5026         switch(s[i]) {
5027         case ' ':
5028         case '$':
5029         case '"':
5030         case '[':
5031         case ']':
5032         case ';':
5033         case '\\':
5034         case '\r':
5035         case '\n':
5036         case '\t':
5037         case '\f':
5038         case '\v':
5039             trySimple = 0;
5040         case '{':
5041         case '}':
5042             goto testbrace;
5043         }
5044     }
5045     return JIM_ELESTR_SIMPLE;
5046
5047 testbrace:
5048     /* Test if it's possible to do with braces */
5049     if (s[len-1] == '\\' ||
5050         s[len-1] == ']') return JIM_ELESTR_QUOTE;
5051     level = 0;
5052     for (i = 0; i < len; i++) {
5053         switch(s[i]) {
5054         case '{': level++; break;
5055         case '}': level--;
5056               if (level < 0) return JIM_ELESTR_QUOTE;
5057               break;
5058         case '\\':
5059               if (s[i+1] == '\n')
5060                   return JIM_ELESTR_QUOTE;
5061               else
5062                   if (s[i+1] != '\0') i++;
5063               break;
5064         }
5065     }
5066     if (level == 0) {
5067         if (!trySimple) return JIM_ELESTR_BRACE;
5068         for (i = 0; i < len; i++) {
5069             switch(s[i]) {
5070             case ' ':
5071             case '$':
5072             case '"':
5073             case '[':
5074             case ']':
5075             case ';':
5076             case '\\':
5077             case '\r':
5078             case '\n':
5079             case '\t':
5080             case '\f':
5081             case '\v':
5082                 return JIM_ELESTR_BRACE;
5083                 break;
5084             }
5085         }
5086         return JIM_ELESTR_SIMPLE;
5087     }
5088     return JIM_ELESTR_QUOTE;
5089 }
5090
5091 /* Returns the malloc-ed representation of a string
5092  * using backslash to quote special chars. */
5093 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5094 {
5095     char *q = Jim_Alloc(len*2+1), *p;
5096
5097     p = q;
5098     while(*s) {
5099         switch (*s) {
5100         case ' ':
5101         case '$':
5102         case '"':
5103         case '[':
5104         case ']':
5105         case '{':
5106         case '}':
5107         case ';':
5108         case '\\':
5109             *p++ = '\\';
5110             *p++ = *s++;
5111             break;
5112         case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5113         case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5114         case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5115         case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5116         case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5117         default:
5118             *p++ = *s++;
5119             break;
5120         }
5121     }
5122     *p = '\0';
5123     *qlenPtr = p-q;
5124     return q;
5125 }
5126
5127 void UpdateStringOfList(struct Jim_Obj *objPtr)
5128 {
5129     int i, bufLen, realLength;
5130     const char *strRep;
5131     char *p;
5132     int *quotingType;
5133     Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5134
5135     /* (Over) Estimate the space needed. */
5136     quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5137     bufLen = 0;
5138     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5139         int len;
5140
5141         strRep = Jim_GetString(ele[i], &len);
5142         quotingType[i] = ListElementQuotingType(strRep, len);
5143         switch (quotingType[i]) {
5144         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5145         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5146         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5147         }
5148         bufLen++; /* elements separator. */
5149     }
5150     bufLen++;
5151
5152     /* Generate the string rep. */
5153     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5154     realLength = 0;
5155     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5156         int len, qlen;
5157         const char *strRep = Jim_GetString(ele[i], &len);
5158         char *q;
5159
5160         switch(quotingType[i]) {
5161         case JIM_ELESTR_SIMPLE:
5162             memcpy(p, strRep, len);
5163             p += len;
5164             realLength += len;
5165             break;
5166         case JIM_ELESTR_BRACE:
5167             *p++ = '{';
5168             memcpy(p, strRep, len);
5169             p += len;
5170             *p++ = '}';
5171             realLength += len+2;
5172             break;
5173         case JIM_ELESTR_QUOTE:
5174             q = BackslashQuoteString(strRep, len, &qlen);
5175             memcpy(p, q, qlen);
5176             Jim_Free(q);
5177             p += qlen;
5178             realLength += qlen;
5179             break;
5180         }
5181         /* Add a separating space */
5182         if (i+1 != objPtr->internalRep.listValue.len) {
5183             *p++ = ' ';
5184             realLength ++;
5185         }
5186     }
5187     *p = '\0'; /* nul term. */
5188     objPtr->length = realLength;
5189     Jim_Free(quotingType);
5190 }
5191
5192 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5193 {
5194     struct JimParserCtx parser;
5195     const char *str;
5196     int strLen;
5197
5198     /* Get the string representation */
5199     str = Jim_GetString(objPtr, &strLen);
5200
5201     /* Free the old internal repr just now and initialize the
5202      * new one just now. The string->list conversion can't fail. */
5203     Jim_FreeIntRep(interp, objPtr);
5204     objPtr->typePtr = &listObjType;
5205     objPtr->internalRep.listValue.len = 0;
5206     objPtr->internalRep.listValue.maxLen = 0;
5207     objPtr->internalRep.listValue.ele = NULL;
5208
5209     /* Convert into a list */
5210     JimParserInit(&parser, str, strLen, 1);
5211     while(!JimParserEof(&parser)) {
5212         char *token;
5213         int tokenLen, type;
5214         Jim_Obj *elementPtr;
5215
5216         JimParseList(&parser);
5217         if (JimParserTtype(&parser) != JIM_TT_STR &&
5218             JimParserTtype(&parser) != JIM_TT_ESC)
5219             continue;
5220         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5221         elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5222         ListAppendElement(objPtr, elementPtr);
5223     }
5224     return JIM_OK;
5225 }
5226
5227 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, 
5228         int len)
5229 {
5230     Jim_Obj *objPtr;
5231     int i;
5232
5233     objPtr = Jim_NewObj(interp);
5234     objPtr->typePtr = &listObjType;
5235     objPtr->bytes = NULL;
5236     objPtr->internalRep.listValue.ele = NULL;
5237     objPtr->internalRep.listValue.len = 0;
5238     objPtr->internalRep.listValue.maxLen = 0;
5239     for (i = 0; i < len; i++) {
5240         ListAppendElement(objPtr, elements[i]);
5241     }
5242     return objPtr;
5243 }
5244
5245 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5246  * length of the vector. Note that the user of this function should make
5247  * sure that the list object can't shimmer while the vector returned
5248  * is in use, this vector is the one stored inside the internal representation
5249  * of the list object. This function is not exported, extensions should
5250  * always access to the List object elements using Jim_ListIndex(). */
5251 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5252         Jim_Obj ***listVec)
5253 {
5254     Jim_ListLength(interp, listObj, argc);
5255     assert(listObj->typePtr == &listObjType);
5256     *listVec = listObj->internalRep.listValue.ele;
5257 }
5258
5259 /* ListSortElements type values */
5260 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5261       JIM_LSORT_NOCASE_DECR};
5262
5263 /* Sort the internal rep of a list. */
5264 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5265 {
5266     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5267 }
5268
5269 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5270 {
5271     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5272 }
5273
5274 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5275 {
5276     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5277 }
5278
5279 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5280 {
5281     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5282 }
5283
5284 /* Sort a list *in place*. MUST be called with non-shared objects. */
5285 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5286 {
5287     typedef int (qsort_comparator)(const void *, const void *);
5288     int (*fn)(Jim_Obj**, Jim_Obj**);
5289     Jim_Obj **vector;
5290     int len;
5291
5292     if (Jim_IsShared(listObjPtr))
5293         Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5294     if (listObjPtr->typePtr != &listObjType)
5295         SetListFromAny(interp, listObjPtr);
5296
5297     vector = listObjPtr->internalRep.listValue.ele;
5298     len = listObjPtr->internalRep.listValue.len;
5299     switch (type) {
5300         case JIM_LSORT_ASCII: fn = ListSortString;  break;
5301         case JIM_LSORT_NOCASE: fn = ListSortStringNoCase;  break;
5302         case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr;  break;
5303         case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr;  break;
5304         default:
5305             fn = NULL; /* avoid warning */
5306             Jim_Panic(interp,"ListSort called with invalid sort type");
5307     }
5308     qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5309     Jim_InvalidateStringRep(listObjPtr);
5310 }
5311
5312 /* This is the low-level function to append an element to a list.
5313  * The higher-level Jim_ListAppendElement() performs shared object
5314  * check and invalidate the string repr. This version is used
5315  * in the internals of the List Object and is not exported.
5316  *
5317  * NOTE: this function can be called only against objects
5318  * with internal type of List. */
5319 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5320 {
5321     int requiredLen = listPtr->internalRep.listValue.len + 1;
5322
5323     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5324         int maxLen = requiredLen * 2;
5325
5326         listPtr->internalRep.listValue.ele =
5327             Jim_Realloc(listPtr->internalRep.listValue.ele,
5328                     sizeof(Jim_Obj*)*maxLen);
5329         listPtr->internalRep.listValue.maxLen = maxLen;
5330     }
5331     listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5332         objPtr;
5333     listPtr->internalRep.listValue.len ++;
5334     Jim_IncrRefCount(objPtr);
5335 }
5336
5337 /* This is the low-level function to insert elements into a list.
5338  * The higher-level Jim_ListInsertElements() performs shared object
5339  * check and invalidate the string repr. This version is used
5340  * in the internals of the List Object and is not exported.
5341  *
5342  * NOTE: this function can be called only against objects
5343  * with internal type of List. */
5344 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5345         Jim_Obj *const *elemVec)
5346 {
5347     int currentLen = listPtr->internalRep.listValue.len;
5348     int requiredLen = currentLen + elemc;
5349     int i;
5350     Jim_Obj **point;
5351
5352     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5353         int maxLen = requiredLen * 2;
5354
5355         listPtr->internalRep.listValue.ele =
5356             Jim_Realloc(listPtr->internalRep.listValue.ele,
5357                     sizeof(Jim_Obj*)*maxLen);
5358         listPtr->internalRep.listValue.maxLen = maxLen;
5359     }
5360     point = listPtr->internalRep.listValue.ele + index;
5361     memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5362     for (i=0; i < elemc; ++i) {
5363         point[i] = elemVec[i];
5364         Jim_IncrRefCount(point[i]);
5365     }
5366     listPtr->internalRep.listValue.len += elemc;
5367 }
5368
5369 /* Appends every element of appendListPtr into listPtr.
5370  * Both have to be of the list type. */
5371 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5372 {
5373     int i, oldLen = listPtr->internalRep.listValue.len;
5374     int appendLen = appendListPtr->internalRep.listValue.len;
5375     int requiredLen = oldLen + appendLen;
5376
5377     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5378         int maxLen = requiredLen * 2;
5379
5380         listPtr->internalRep.listValue.ele =
5381             Jim_Realloc(listPtr->internalRep.listValue.ele,
5382                     sizeof(Jim_Obj*)*maxLen);
5383         listPtr->internalRep.listValue.maxLen = maxLen;
5384     }
5385     for (i = 0; i < appendLen; i++) {
5386         Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5387         listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5388         Jim_IncrRefCount(objPtr);
5389     }
5390     listPtr->internalRep.listValue.len += appendLen;
5391 }
5392
5393 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5394 {
5395     if (Jim_IsShared(listPtr))
5396         Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5397     if (listPtr->typePtr != &listObjType)
5398         SetListFromAny(interp, listPtr);
5399     Jim_InvalidateStringRep(listPtr);
5400     ListAppendElement(listPtr, objPtr);
5401 }
5402
5403 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5404 {
5405     if (Jim_IsShared(listPtr))
5406         Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5407     if (listPtr->typePtr != &listObjType)
5408         SetListFromAny(interp, listPtr);
5409     Jim_InvalidateStringRep(listPtr);
5410     ListAppendList(listPtr, appendListPtr);
5411 }
5412
5413 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5414 {
5415     if (listPtr->typePtr != &listObjType)
5416         SetListFromAny(interp, listPtr);
5417     *intPtr = listPtr->internalRep.listValue.len;
5418 }
5419
5420 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5421         int objc, Jim_Obj *const *objVec)
5422 {
5423     if (Jim_IsShared(listPtr))
5424         Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5425     if (listPtr->typePtr != &listObjType)
5426         SetListFromAny(interp, listPtr);
5427     if (index >= 0 && index > listPtr->internalRep.listValue.len)
5428         index = listPtr->internalRep.listValue.len;
5429     else if (index < 0 ) 
5430         index = 0;
5431     Jim_InvalidateStringRep(listPtr);
5432     ListInsertElements(listPtr, index, objc, objVec);
5433 }
5434
5435 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5436         Jim_Obj **objPtrPtr, int flags)
5437 {
5438     if (listPtr->typePtr != &listObjType)
5439         SetListFromAny(interp, listPtr);
5440     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5441         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5442         if (flags & JIM_ERRMSG) {
5443             Jim_SetResultString(interp,
5444                 "list index out of range", -1);
5445         }
5446         return JIM_ERR;
5447     }
5448     if (index < 0)
5449         index = listPtr->internalRep.listValue.len+index;
5450     *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5451     return JIM_OK;
5452 }
5453
5454 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5455         Jim_Obj *newObjPtr, int flags)
5456 {
5457     if (listPtr->typePtr != &listObjType)
5458         SetListFromAny(interp, listPtr);
5459     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5460         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5461         if (flags & JIM_ERRMSG) {
5462             Jim_SetResultString(interp,
5463                 "list index out of range", -1);
5464         }
5465         return JIM_ERR;
5466     }
5467     if (index < 0)
5468         index = listPtr->internalRep.listValue.len+index;
5469     Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5470     listPtr->internalRep.listValue.ele[index] = newObjPtr;
5471     Jim_IncrRefCount(newObjPtr);
5472     return JIM_OK;
5473 }
5474
5475 /* Modify the list stored into the variable named 'varNamePtr'
5476  * setting the element specified by the 'indexc' indexes objects in 'indexv',
5477  * with the new element 'newObjptr'. */
5478 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5479         Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5480 {
5481     Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5482     int shared, i, index;
5483
5484     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5485     if (objPtr == NULL)
5486         return JIM_ERR;
5487     if ((shared = Jim_IsShared(objPtr)))
5488         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5489     for (i = 0; i < indexc-1; i++) {
5490         listObjPtr = objPtr;
5491         if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5492             goto err;
5493         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5494                     JIM_ERRMSG) != JIM_OK) {
5495             goto err;
5496         }
5497         if (Jim_IsShared(objPtr)) {
5498             objPtr = Jim_DuplicateObj(interp, objPtr);
5499             ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5500         }
5501         Jim_InvalidateStringRep(listObjPtr);
5502     }
5503     if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5504         goto err;
5505     if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5506         goto err;
5507     Jim_InvalidateStringRep(objPtr);
5508     Jim_InvalidateStringRep(varObjPtr);
5509     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5510         goto err;
5511     Jim_SetResult(interp, varObjPtr);
5512     return JIM_OK;
5513 err:
5514     if (shared) {
5515         Jim_FreeNewObj(interp, varObjPtr);
5516     }
5517     return JIM_ERR;
5518 }
5519
5520 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5521 {
5522     int i;
5523
5524     /* If all the objects in objv are lists without string rep.
5525      * it's possible to return a list as result, that's the
5526      * concatenation of all the lists. */
5527     for (i = 0; i < objc; i++) {
5528         if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5529             break;
5530     }
5531     if (i == objc) {
5532         Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5533         for (i = 0; i < objc; i++)
5534             Jim_ListAppendList(interp, objPtr, objv[i]);
5535         return objPtr;
5536     } else {
5537         /* Else... we have to glue strings together */
5538         int len = 0, objLen;
5539         char *bytes, *p;
5540
5541         /* Compute the length */
5542         for (i = 0; i < objc; i++) {
5543             Jim_GetString(objv[i], &objLen);
5544             len += objLen;
5545         }
5546         if (objc) len += objc-1;
5547         /* Create the string rep, and a stinrg object holding it. */
5548         p = bytes = Jim_Alloc(len+1);
5549         for (i = 0; i < objc; i++) {
5550             const char *s = Jim_GetString(objv[i], &objLen);
5551             while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5552             {
5553                 s++; objLen--; len--;
5554             }
5555             while (objLen && (s[objLen-1] == ' ' ||
5556                 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5557                 objLen--; len--;
5558             }
5559             memcpy(p, s, objLen);
5560             p += objLen;
5561             if (objLen && i+1 != objc) {
5562                 *p++ = ' ';
5563             } else if (i+1 != objc) {
5564                 /* Drop the space calcuated for this
5565                  * element that is instead null. */
5566                 len--;
5567             }
5568         }
5569         *p = '\0';
5570         return Jim_NewStringObjNoAlloc(interp, bytes, len);
5571     }
5572 }
5573
5574 /* Returns a list composed of the elements in the specified range.
5575  * first and start are directly accepted as Jim_Objects and
5576  * processed for the end?-index? case. */
5577 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5578 {
5579     int first, last;
5580     int len, rangeLen;
5581
5582     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5583         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5584         return NULL;
5585     Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5586     first = JimRelToAbsIndex(len, first);
5587     last = JimRelToAbsIndex(len, last);
5588     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5589     return Jim_NewListObj(interp,
5590             listObjPtr->internalRep.listValue.ele+first, rangeLen);
5591 }
5592
5593 /* -----------------------------------------------------------------------------
5594  * Dict object
5595  * ---------------------------------------------------------------------------*/
5596 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5597 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5598 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5599 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5600
5601 /* Dict HashTable Type.
5602  *
5603  * Keys and Values are Jim objects. */
5604
5605 unsigned int JimObjectHTHashFunction(const void *key)
5606 {
5607     const char *str;
5608     Jim_Obj *objPtr = (Jim_Obj*) key;
5609     int len, h;
5610
5611     str = Jim_GetString(objPtr, &len);
5612     h = Jim_GenHashFunction((unsigned char*)str, len);
5613     return h;
5614 }
5615
5616 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5617 {
5618     JIM_NOTUSED(privdata);
5619
5620     return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5621 }
5622
5623 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5624 {
5625     Jim_Obj *objPtr = val;
5626
5627     Jim_DecrRefCount(interp, objPtr);
5628 }
5629
5630 static Jim_HashTableType JimDictHashTableType = {
5631     JimObjectHTHashFunction,            /* hash function */
5632     NULL,                               /* key dup */
5633     NULL,                               /* val dup */
5634     JimObjectHTKeyCompare,              /* key compare */
5635     (void(*)(void*, const void*))       /* ATTENTION: const cast */
5636         JimObjectHTKeyValDestructor,    /* key destructor */
5637     JimObjectHTKeyValDestructor         /* val destructor */
5638 };
5639
5640 /* Note that while the elements of the dict may contain references,
5641  * the list object itself can't. This basically means that the
5642  * dict object string representation as a whole can't contain references
5643  * that are not presents in the single elements. */
5644 static Jim_ObjType dictObjType = {
5645     "dict",
5646     FreeDictInternalRep,
5647     DupDictInternalRep,
5648     UpdateStringOfDict,
5649     JIM_TYPE_NONE,
5650 };
5651
5652 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5653 {
5654     JIM_NOTUSED(interp);
5655
5656     Jim_FreeHashTable(objPtr->internalRep.ptr);
5657     Jim_Free(objPtr->internalRep.ptr);
5658 }
5659
5660 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5661 {
5662     Jim_HashTable *ht, *dupHt;
5663     Jim_HashTableIterator *htiter;
5664     Jim_HashEntry *he;
5665
5666     /* Create a new hash table */
5667     ht = srcPtr->internalRep.ptr;
5668     dupHt = Jim_Alloc(sizeof(*dupHt));
5669     Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5670     if (ht->size != 0)
5671         Jim_ExpandHashTable(dupHt, ht->size);
5672     /* Copy every element from the source to the dup hash table */
5673     htiter = Jim_GetHashTableIterator(ht);
5674     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5675         const Jim_Obj *keyObjPtr = he->key;
5676         Jim_Obj *valObjPtr = he->val;
5677
5678         Jim_IncrRefCount((Jim_Obj*)keyObjPtr);  /* ATTENTION: const cast */
5679         Jim_IncrRefCount(valObjPtr);
5680         Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5681     }
5682     Jim_FreeHashTableIterator(htiter);
5683
5684     dupPtr->internalRep.ptr = dupHt;
5685     dupPtr->typePtr = &dictObjType;
5686 }
5687
5688 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5689 {
5690     int i, bufLen, realLength;
5691     const char *strRep;
5692     char *p;
5693     int *quotingType, objc;
5694     Jim_HashTable *ht;
5695     Jim_HashTableIterator *htiter;
5696     Jim_HashEntry *he;
5697     Jim_Obj **objv;
5698
5699     /* Trun the hash table into a flat vector of Jim_Objects. */
5700     ht = objPtr->internalRep.ptr;
5701     objc = ht->used*2;
5702     objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5703     htiter = Jim_GetHashTableIterator(ht);
5704     i = 0;
5705     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5706         objv[i++] = (Jim_Obj*)he->key;  /* ATTENTION: const cast */
5707         objv[i++] = he->val;
5708     }
5709     Jim_FreeHashTableIterator(htiter);
5710     /* (Over) Estimate the space needed. */
5711     quotingType = Jim_Alloc(sizeof(int)*objc);
5712     bufLen = 0;
5713     for (i = 0; i < objc; i++) {
5714         int len;
5715
5716         strRep = Jim_GetString(objv[i], &len);
5717         quotingType[i] = ListElementQuotingType(strRep, len);
5718         switch (quotingType[i]) {
5719         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5720         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5721         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5722         }
5723         bufLen++; /* elements separator. */
5724     }
5725     bufLen++;
5726
5727     /* Generate the string rep. */
5728     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5729     realLength = 0;
5730     for (i = 0; i < objc; i++) {
5731         int len, qlen;
5732         const char *strRep = Jim_GetString(objv[i], &len);
5733         char *q;
5734
5735         switch(quotingType[i]) {
5736         case JIM_ELESTR_SIMPLE:
5737             memcpy(p, strRep, len);
5738             p += len;
5739             realLength += len;
5740             break;
5741         case JIM_ELESTR_BRACE:
5742             *p++ = '{';
5743             memcpy(p, strRep, len);
5744             p += len;
5745             *p++ = '}';
5746             realLength += len+2;
5747             break;
5748         case JIM_ELESTR_QUOTE:
5749             q = BackslashQuoteString(strRep, len, &qlen);
5750             memcpy(p, q, qlen);
5751             Jim_Free(q);
5752             p += qlen;
5753             realLength += qlen;
5754             break;
5755         }
5756         /* Add a separating space */
5757         if (i+1 != objc) {
5758             *p++ = ' ';
5759             realLength ++;
5760         }
5761     }
5762     *p = '\0'; /* nul term. */
5763     objPtr->length = realLength;
5764     Jim_Free(quotingType);
5765     Jim_Free(objv);
5766 }
5767
5768 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5769 {
5770     struct JimParserCtx parser;
5771     Jim_HashTable *ht;
5772     Jim_Obj *objv[2];
5773     const char *str;
5774     int i, strLen;
5775
5776     /* Get the string representation */
5777     str = Jim_GetString(objPtr, &strLen);
5778
5779     /* Free the old internal repr just now and initialize the
5780      * new one just now. The string->list conversion can't fail. */
5781     Jim_FreeIntRep(interp, objPtr);
5782     ht = Jim_Alloc(sizeof(*ht));
5783     Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5784     objPtr->typePtr = &dictObjType;
5785     objPtr->internalRep.ptr = ht;
5786
5787     /* Convert into a dict */
5788     JimParserInit(&parser, str, strLen, 1);
5789     i = 0;
5790     while(!JimParserEof(&parser)) {
5791         char *token;
5792         int tokenLen, type;
5793
5794         JimParseList(&parser);
5795         if (JimParserTtype(&parser) != JIM_TT_STR &&
5796             JimParserTtype(&parser) != JIM_TT_ESC)
5797             continue;
5798         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5799         objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5800         if (i == 2) {
5801             i = 0;
5802             Jim_IncrRefCount(objv[0]);
5803             Jim_IncrRefCount(objv[1]);
5804             if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5805                 Jim_HashEntry *he;
5806                 he = Jim_FindHashEntry(ht, objv[0]);
5807                 Jim_DecrRefCount(interp, objv[0]);
5808                 /* ATTENTION: const cast */
5809                 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5810                 he->val = objv[1];
5811             }
5812         }
5813     }
5814     if (i) {
5815         Jim_FreeNewObj(interp, objv[0]);
5816         objPtr->typePtr = NULL;
5817         Jim_FreeHashTable(ht);
5818         Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5819         return JIM_ERR;
5820     }
5821     return JIM_OK;
5822 }
5823
5824 /* Dict object API */
5825
5826 /* Add an element to a dict. objPtr must be of the "dict" type.
5827  * The higer-level exported function is Jim_DictAddElement().
5828  * If an element with the specified key already exists, the value
5829  * associated is replaced with the new one.
5830  *
5831  * if valueObjPtr == NULL, the key is instead removed if it exists. */
5832 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5833         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5834 {
5835     Jim_HashTable *ht = objPtr->internalRep.ptr;
5836
5837     if (valueObjPtr == NULL) { /* unset */
5838         Jim_DeleteHashEntry(ht, keyObjPtr);
5839         return;
5840     }
5841     Jim_IncrRefCount(keyObjPtr);
5842     Jim_IncrRefCount(valueObjPtr);
5843     if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5844         Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5845         Jim_DecrRefCount(interp, keyObjPtr);
5846         /* ATTENTION: const cast */
5847         Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5848         he->val = valueObjPtr;
5849     }
5850 }
5851
5852 /* Add an element, higher-level interface for DictAddElement().
5853  * If valueObjPtr == NULL, the key is removed if it exists. */
5854 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5855         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5856 {
5857     if (Jim_IsShared(objPtr))
5858         Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5859     if (objPtr->typePtr != &dictObjType) {
5860         if (SetDictFromAny(interp, objPtr) != JIM_OK)
5861             return JIM_ERR;
5862     }
5863     DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5864     Jim_InvalidateStringRep(objPtr);
5865     return JIM_OK;
5866 }
5867
5868 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5869 {
5870     Jim_Obj *objPtr;
5871     int i;
5872
5873     if (len % 2)
5874         Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5875
5876     objPtr = Jim_NewObj(interp);
5877     objPtr->typePtr = &dictObjType;
5878     objPtr->bytes = NULL;
5879     objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5880     Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5881     for (i = 0; i < len; i += 2)
5882         DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5883     return objPtr;
5884 }
5885
5886 /* Return the value associated to the specified dict key */
5887 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5888         Jim_Obj **objPtrPtr, int flags)
5889 {
5890     Jim_HashEntry *he;
5891     Jim_HashTable *ht;
5892
5893     if (dictPtr->typePtr != &dictObjType) {
5894         if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5895             return JIM_ERR;
5896     }
5897     ht = dictPtr->internalRep.ptr;
5898     if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5899         if (flags & JIM_ERRMSG) {
5900             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5901             Jim_AppendStrings(interp, Jim_GetResult(interp),
5902                     "key \"", Jim_GetString(keyPtr, NULL),
5903                     "\" not found in dictionary", NULL);
5904         }
5905         return JIM_ERR;
5906     }
5907     *objPtrPtr = he->val;
5908     return JIM_OK;
5909 }
5910
5911 /* Return the value associated to the specified dict keys */
5912 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5913         Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5914 {
5915     Jim_Obj *objPtr;
5916     int i;
5917
5918     if (keyc == 0) {
5919         *objPtrPtr = dictPtr;
5920         return JIM_OK;
5921     }
5922
5923     for (i = 0; i < keyc; i++) {
5924         if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5925                 != JIM_OK)
5926             return JIM_ERR;
5927         dictPtr = objPtr;
5928     }
5929     *objPtrPtr = objPtr;
5930     return JIM_OK;
5931 }
5932
5933 /* Modify the dict stored into the variable named 'varNamePtr'
5934  * setting the element specified by the 'keyc' keys objects in 'keyv',
5935  * with the new value of the element 'newObjPtr'.
5936  *
5937  * If newObjPtr == NULL the operation is to remove the given key
5938  * from the dictionary. */
5939 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5940         Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5941 {
5942     Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5943     int shared, i;
5944
5945     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5946     if (objPtr == NULL) {
5947         if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5948             return JIM_ERR;
5949         varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5950         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5951             Jim_FreeNewObj(interp, varObjPtr);
5952             return JIM_ERR;
5953         }
5954     }
5955     if ((shared = Jim_IsShared(objPtr)))
5956         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5957     for (i = 0; i < keyc-1; i++) {
5958         dictObjPtr = objPtr;
5959
5960         /* Check if it's a valid dictionary */
5961         if (dictObjPtr->typePtr != &dictObjType) {
5962             if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5963                 goto err;
5964         }
5965         /* Check if the given key exists. */
5966         Jim_InvalidateStringRep(dictObjPtr);
5967         if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5968             newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5969         {
5970             /* This key exists at the current level.
5971              * Make sure it's not shared!. */
5972             if (Jim_IsShared(objPtr)) {
5973                 objPtr = Jim_DuplicateObj(interp, objPtr);
5974                 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5975             }
5976         } else {
5977             /* Key not found. If it's an [unset] operation
5978              * this is an error. Only the last key may not
5979              * exist. */
5980             if (newObjPtr == NULL)
5981                 goto err;
5982             /* Otherwise set an empty dictionary
5983              * as key's value. */
5984             objPtr = Jim_NewDictObj(interp, NULL, 0);
5985             DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5986         }
5987     }
5988     if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5989             != JIM_OK)
5990         goto err;
5991     Jim_InvalidateStringRep(objPtr);
5992     Jim_InvalidateStringRep(varObjPtr);
5993     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5994         goto err;
5995     Jim_SetResult(interp, varObjPtr);
5996     return JIM_OK;
5997 err:
5998     if (shared) {
5999         Jim_FreeNewObj(interp, varObjPtr);
6000     }
6001     return JIM_ERR;
6002 }
6003
6004 /* -----------------------------------------------------------------------------
6005  * Index object
6006  * ---------------------------------------------------------------------------*/
6007 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6008 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6009
6010 static Jim_ObjType indexObjType = {
6011     "index",
6012     NULL,
6013     NULL,
6014     UpdateStringOfIndex,
6015     JIM_TYPE_NONE,
6016 };
6017
6018 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6019 {
6020     int len;
6021     char buf[JIM_INTEGER_SPACE+1];
6022
6023     if (objPtr->internalRep.indexValue >= 0)
6024         len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6025     else if (objPtr->internalRep.indexValue == -1)
6026         len = sprintf(buf, "end");
6027     else {
6028         len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6029     }
6030     objPtr->bytes = Jim_Alloc(len+1);
6031     memcpy(objPtr->bytes, buf, len+1);
6032     objPtr->length = len;
6033 }
6034
6035 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6036 {
6037     int index, end = 0;
6038     const char *str;
6039
6040     /* Get the string representation */
6041     str = Jim_GetString(objPtr, NULL);
6042     /* Try to convert into an index */
6043     if (!strcmp(str, "end")) {
6044         index = 0;
6045         end = 1;
6046     } else {
6047         if (!strncmp(str, "end-", 4)) {
6048             str += 4;
6049             end = 1;
6050         }
6051         if (Jim_StringToIndex(str, &index) != JIM_OK) {
6052             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6053             Jim_AppendStrings(interp, Jim_GetResult(interp),
6054                     "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6055                     "must be integer or end?-integer?", NULL);
6056             return JIM_ERR;
6057         }
6058     }
6059     if (end) {
6060         if (index < 0)
6061             index = INT_MAX;
6062         else
6063             index = -(index+1);
6064     } else if (!end && index < 0)
6065         index = -INT_MAX;
6066     /* Free the old internal repr and set the new one. */
6067     Jim_FreeIntRep(interp, objPtr);
6068     objPtr->typePtr = &indexObjType;
6069     objPtr->internalRep.indexValue = index;
6070     return JIM_OK;
6071 }
6072
6073 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6074 {
6075     /* Avoid shimmering if the object is an integer. */
6076     if (objPtr->typePtr == &intObjType) {
6077         jim_wide val = objPtr->internalRep.wideValue;
6078         if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6079             *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6080             return JIM_OK;
6081         }
6082     }
6083     if (objPtr->typePtr != &indexObjType &&
6084         SetIndexFromAny(interp, objPtr) == JIM_ERR)
6085         return JIM_ERR;
6086     *indexPtr = objPtr->internalRep.indexValue;
6087     return JIM_OK;
6088 }
6089
6090 /* -----------------------------------------------------------------------------
6091  * Return Code Object.
6092  * ---------------------------------------------------------------------------*/
6093
6094 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6095
6096 static Jim_ObjType returnCodeObjType = {
6097     "return-code",
6098     NULL,
6099     NULL,
6100     NULL,
6101     JIM_TYPE_NONE,
6102 };
6103
6104 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6105 {
6106     const char *str;
6107     int strLen, returnCode;
6108     jim_wide wideValue;
6109
6110     /* Get the string representation */
6111     str = Jim_GetString(objPtr, &strLen);
6112     /* Try to convert into an integer */
6113     if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6114         returnCode = (int) wideValue;
6115     else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6116         returnCode = JIM_OK;
6117     else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6118         returnCode = JIM_ERR;
6119     else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6120         returnCode = JIM_RETURN;
6121     else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6122         returnCode = JIM_BREAK;
6123     else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6124         returnCode = JIM_CONTINUE;
6125     else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6126         returnCode = JIM_EVAL;
6127     else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6128         returnCode = JIM_EXIT;
6129     else {
6130         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6131         Jim_AppendStrings(interp, Jim_GetResult(interp),
6132                 "expected return code but got '", str, "'",
6133                 NULL);
6134         return JIM_ERR;
6135     }
6136     /* Free the old internal repr and set the new one. */
6137     Jim_FreeIntRep(interp, objPtr);
6138     objPtr->typePtr = &returnCodeObjType;
6139     objPtr->internalRep.returnCode = returnCode;
6140     return JIM_OK;
6141 }
6142
6143 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6144 {
6145     if (objPtr->typePtr != &returnCodeObjType &&
6146         SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6147         return JIM_ERR;
6148     *intPtr = objPtr->internalRep.returnCode;
6149     return JIM_OK;
6150 }
6151
6152 /* -----------------------------------------------------------------------------
6153  * Expression Parsing
6154  * ---------------------------------------------------------------------------*/
6155 static int JimParseExprOperator(struct JimParserCtx *pc);
6156 static int JimParseExprNumber(struct JimParserCtx *pc);
6157 static int JimParseExprIrrational(struct JimParserCtx *pc);
6158
6159 /* Exrp's Stack machine operators opcodes. */
6160
6161 /* Binary operators (numbers) */
6162 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6163 #define JIM_EXPROP_MUL 0
6164 #define JIM_EXPROP_DIV 1
6165 #define JIM_EXPROP_MOD 2
6166 #define JIM_EXPROP_SUB 3
6167 #define JIM_EXPROP_ADD 4
6168 #define JIM_EXPROP_LSHIFT 5
6169 #define JIM_EXPROP_RSHIFT 6
6170 #define JIM_EXPROP_ROTL 7
6171 #define JIM_EXPROP_ROTR 8
6172 #define JIM_EXPROP_LT 9
6173 #define JIM_EXPROP_GT 10
6174 #define JIM_EXPROP_LTE 11
6175 #define JIM_EXPROP_GTE 12
6176 #define JIM_EXPROP_NUMEQ 13
6177 #define JIM_EXPROP_NUMNE 14
6178 #define JIM_EXPROP_BITAND 15
6179 #define JIM_EXPROP_BITXOR 16
6180 #define JIM_EXPROP_BITOR 17
6181 #define JIM_EXPROP_LOGICAND 18
6182 #define JIM_EXPROP_LOGICOR 19
6183 #define JIM_EXPROP_LOGICAND_LEFT 20
6184 #define JIM_EXPROP_LOGICOR_LEFT 21
6185 #define JIM_EXPROP_POW 22
6186 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6187
6188 /* Binary operators (strings) */
6189 #define JIM_EXPROP_STREQ 23
6190 #define JIM_EXPROP_STRNE 24
6191
6192 /* Unary operators (numbers) */
6193 #define JIM_EXPROP_NOT 25
6194 #define JIM_EXPROP_BITNOT 26
6195 #define JIM_EXPROP_UNARYMINUS 27
6196 #define JIM_EXPROP_UNARYPLUS 28
6197 #define JIM_EXPROP_LOGICAND_RIGHT 29
6198 #define JIM_EXPROP_LOGICOR_RIGHT 30
6199
6200 /* Ternary operators */
6201 #define JIM_EXPROP_TERNARY 31
6202
6203 /* Operands */
6204 #define JIM_EXPROP_NUMBER 32
6205 #define JIM_EXPROP_COMMAND 33
6206 #define JIM_EXPROP_VARIABLE 34
6207 #define JIM_EXPROP_DICTSUGAR 35
6208 #define JIM_EXPROP_SUBST 36
6209 #define JIM_EXPROP_STRING 37
6210
6211 /* Operators table */
6212 typedef struct Jim_ExprOperator {
6213     const char *name;
6214     int precedence;
6215     int arity;
6216     int opcode;
6217 } Jim_ExprOperator;
6218
6219 /* name - precedence - arity - opcode */
6220 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6221     {"!", 300, 1, JIM_EXPROP_NOT},
6222     {"~", 300, 1, JIM_EXPROP_BITNOT},
6223     {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6224     {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6225
6226     {"**", 250, 2, JIM_EXPROP_POW},
6227
6228     {"*", 200, 2, JIM_EXPROP_MUL},
6229     {"/", 200, 2, JIM_EXPROP_DIV},
6230     {"%", 200, 2, JIM_EXPROP_MOD},
6231
6232     {"-", 100, 2, JIM_EXPROP_SUB},
6233     {"+", 100, 2, JIM_EXPROP_ADD},
6234
6235     {"<<<", 90, 3, JIM_EXPROP_ROTL},
6236     {">>>", 90, 3, JIM_EXPROP_ROTR},
6237     {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6238     {">>", 90, 2, JIM_EXPROP_RSHIFT},
6239
6240     {"<",  80, 2, JIM_EXPROP_LT},
6241     {">",  80, 2, JIM_EXPROP_GT},
6242     {"<=", 80, 2, JIM_EXPROP_LTE},
6243     {">=", 80, 2, JIM_EXPROP_GTE},
6244
6245     {"==", 70, 2, JIM_EXPROP_NUMEQ},
6246     {"!=", 70, 2, JIM_EXPROP_NUMNE},
6247
6248     {"eq", 60, 2, JIM_EXPROP_STREQ},
6249     {"ne", 60, 2, JIM_EXPROP_STRNE},
6250
6251     {"&", 50, 2, JIM_EXPROP_BITAND},
6252     {"^", 49, 2, JIM_EXPROP_BITXOR},
6253     {"|", 48, 2, JIM_EXPROP_BITOR},
6254
6255     {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6256     {"||", 10, 2, JIM_EXPROP_LOGICOR},
6257
6258     {"?", 5, 3, JIM_EXPROP_TERNARY},
6259     /* private operators */
6260     {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6261     {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6262     {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6263     {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6264 };
6265
6266 #define JIM_EXPR_OPERATORS_NUM \
6267     (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6268
6269 int JimParseExpression(struct JimParserCtx *pc)
6270 {
6271     /* Discard spaces and quoted newline */
6272     while(*(pc->p) == ' ' ||
6273           *(pc->p) == '\t' ||
6274           *(pc->p) == '\r' ||
6275           *(pc->p) == '\n' ||
6276             (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6277         pc->p++; pc->len--;
6278     }
6279
6280     if (pc->len == 0) {
6281         pc->tstart = pc->tend = pc->p;
6282         pc->tline = pc->linenr;
6283         pc->tt = JIM_TT_EOL;
6284         pc->eof = 1;
6285         return JIM_OK;
6286     }
6287     switch(*(pc->p)) {
6288     case '(':
6289         pc->tstart = pc->tend = pc->p;
6290         pc->tline = pc->linenr;
6291         pc->tt = JIM_TT_SUBEXPR_START;
6292         pc->p++; pc->len--;
6293         break;
6294     case ')':
6295         pc->tstart = pc->tend = pc->p;
6296         pc->tline = pc->linenr;
6297         pc->tt = JIM_TT_SUBEXPR_END;
6298         pc->p++; pc->len--;
6299         break;
6300     case '[':
6301         return JimParseCmd(pc);
6302         break;
6303     case '$':
6304         if (JimParseVar(pc) == JIM_ERR)
6305             return JimParseExprOperator(pc);
6306         else
6307             return JIM_OK;
6308         break;
6309     case '-':
6310         if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6311             isdigit((int)*(pc->p+1)))
6312             return JimParseExprNumber(pc);
6313         else
6314             return JimParseExprOperator(pc);
6315         break;
6316     case '0': case '1': case '2': case '3': case '4':
6317     case '5': case '6': case '7': case '8': case '9': case '.':
6318         return JimParseExprNumber(pc);
6319         break;
6320     case '"':
6321     case '{':
6322         /* Here it's possible to reuse the List String parsing. */
6323         pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6324         return JimParseListStr(pc);
6325         break;
6326     case 'N': case 'I':
6327     case 'n': case 'i':
6328         if (JimParseExprIrrational(pc) == JIM_ERR)
6329             return JimParseExprOperator(pc);
6330         break;
6331     default:
6332         return JimParseExprOperator(pc);
6333         break;
6334     }
6335     return JIM_OK;
6336 }
6337
6338 int JimParseExprNumber(struct JimParserCtx *pc)
6339 {
6340     int allowdot = 1;
6341     int allowhex = 0;
6342
6343     pc->tstart = pc->p;
6344     pc->tline = pc->linenr;
6345     if (*pc->p == '-') {
6346         pc->p++; pc->len--;
6347     }
6348     while (  isdigit((int)*pc->p) 
6349           || (allowhex && isxdigit((int)*pc->p) )
6350           || (allowdot && *pc->p == '.') 
6351           || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6352               (*pc->p == 'x' || *pc->p == 'X'))
6353           )
6354     {
6355         if ((*pc->p == 'x') || (*pc->p == 'X')) {
6356             allowhex = 1;
6357             allowdot = 0;
6358                 }
6359         if (*pc->p == '.')
6360             allowdot = 0;
6361         pc->p++; pc->len--;
6362         if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6363             pc->p += 2; pc->len -= 2;
6364         }
6365     }
6366     pc->tend = pc->p-1;
6367     pc->tt = JIM_TT_EXPR_NUMBER;
6368     return JIM_OK;
6369 }
6370
6371 int JimParseExprIrrational(struct JimParserCtx *pc)
6372 {
6373     const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6374     const char **token;
6375     for (token = Tokens; *token != NULL; token++) {
6376         int len = strlen(*token);
6377         if (strncmp(*token, pc->p, len) == 0) {
6378             pc->tstart = pc->p;
6379             pc->tend = pc->p + len - 1;
6380             pc->p += len; pc->len -= len;
6381             pc->tline = pc->linenr;
6382             pc->tt = JIM_TT_EXPR_NUMBER;
6383             return JIM_OK;
6384         }
6385     }
6386     return JIM_ERR;
6387 }
6388
6389 int JimParseExprOperator(struct JimParserCtx *pc)
6390 {
6391     int i;
6392     int bestIdx = -1, bestLen = 0;
6393
6394     /* Try to get the longest match. */
6395     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6396         const char *opname;
6397         int oplen;
6398
6399         opname = Jim_ExprOperators[i].name;
6400         if (opname == NULL) continue;
6401         oplen = strlen(opname);
6402
6403         if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6404             bestIdx = i;
6405             bestLen = oplen;
6406         }
6407     }
6408     if (bestIdx == -1) return JIM_ERR;
6409     pc->tstart = pc->p;
6410     pc->tend = pc->p + bestLen - 1;
6411     pc->p += bestLen; pc->len -= bestLen;
6412     pc->tline = pc->linenr;
6413     pc->tt = JIM_TT_EXPR_OPERATOR;
6414     return JIM_OK;
6415 }
6416
6417 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6418 {
6419     int i;
6420     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6421         if (Jim_ExprOperators[i].name &&
6422             strcmp(opname, Jim_ExprOperators[i].name) == 0)
6423             return &Jim_ExprOperators[i];
6424     return NULL;
6425 }
6426
6427 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6428 {
6429     int i;
6430     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6431         if (Jim_ExprOperators[i].opcode == opcode)
6432             return &Jim_ExprOperators[i];
6433     return NULL;
6434 }
6435
6436 /* -----------------------------------------------------------------------------
6437  * Expression Object
6438  * ---------------------------------------------------------------------------*/
6439 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6440 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6441 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6442
6443 static Jim_ObjType exprObjType = {
6444     "expression",
6445     FreeExprInternalRep,
6446     DupExprInternalRep,
6447     NULL,
6448     JIM_TYPE_REFERENCES,
6449 };
6450
6451 /* Expr bytecode structure */
6452 typedef struct ExprByteCode {
6453     int *opcode;        /* Integer array of opcodes. */
6454     Jim_Obj **obj;      /* Array of associated Jim Objects. */
6455     int len;            /* Bytecode length */
6456     int inUse;          /* Used for sharing. */
6457 } ExprByteCode;
6458
6459 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6460 {
6461     int i;
6462     ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6463
6464     expr->inUse--;
6465     if (expr->inUse != 0) return;
6466     for (i = 0; i < expr->len; i++)
6467         Jim_DecrRefCount(interp, expr->obj[i]);
6468     Jim_Free(expr->opcode);
6469     Jim_Free(expr->obj);
6470     Jim_Free(expr);
6471 }
6472
6473 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6474 {
6475     JIM_NOTUSED(interp);
6476     JIM_NOTUSED(srcPtr);
6477
6478     /* Just returns an simple string. */
6479     dupPtr->typePtr = NULL;
6480 }
6481
6482 /* Add a new instruction to an expression bytecode structure. */
6483 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6484         int opcode, char *str, int len)
6485 {
6486     expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6487     expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6488     expr->opcode[expr->len] = opcode;
6489     expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6490     Jim_IncrRefCount(expr->obj[expr->len]);
6491     expr->len++;
6492 }
6493
6494 /* Check if an expr program looks correct. */
6495 static int ExprCheckCorrectness(ExprByteCode *expr)
6496 {
6497     int i;
6498     int stacklen = 0;
6499
6500     /* Try to check if there are stack underflows,
6501      * and make sure at the end of the program there is
6502      * a single result on the stack. */
6503     for (i = 0; i < expr->len; i++) {
6504         switch(expr->opcode[i]) {
6505         case JIM_EXPROP_NUMBER:
6506         case JIM_EXPROP_STRING:
6507         case JIM_EXPROP_SUBST:
6508         case JIM_EXPROP_VARIABLE:
6509         case JIM_EXPROP_DICTSUGAR:
6510         case JIM_EXPROP_COMMAND:
6511             stacklen++;
6512             break;
6513         case JIM_EXPROP_NOT:
6514         case JIM_EXPROP_BITNOT:
6515         case JIM_EXPROP_UNARYMINUS:
6516         case JIM_EXPROP_UNARYPLUS:
6517             /* Unary operations */
6518             if (stacklen < 1) return JIM_ERR;
6519             break;
6520         case JIM_EXPROP_ADD:
6521         case JIM_EXPROP_SUB:
6522         case JIM_EXPROP_MUL:
6523         case JIM_EXPROP_DIV:
6524         case JIM_EXPROP_MOD:
6525         case JIM_EXPROP_LT:
6526         case JIM_EXPROP_GT:
6527         case JIM_EXPROP_LTE:
6528         case JIM_EXPROP_GTE:
6529         case JIM_EXPROP_ROTL:
6530         case JIM_EXPROP_ROTR:
6531         case JIM_EXPROP_LSHIFT:
6532         case JIM_EXPROP_RSHIFT:
6533         case JIM_EXPROP_NUMEQ:
6534         case JIM_EXPROP_NUMNE:
6535         case JIM_EXPROP_STREQ:
6536         case JIM_EXPROP_STRNE:
6537         case JIM_EXPROP_BITAND:
6538         case JIM_EXPROP_BITXOR:
6539         case JIM_EXPROP_BITOR:
6540         case JIM_EXPROP_LOGICAND:
6541         case JIM_EXPROP_LOGICOR:
6542         case JIM_EXPROP_POW:
6543             /* binary operations */
6544             if (stacklen < 2) return JIM_ERR;
6545             stacklen--;
6546             break;
6547         default:
6548             Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6549             break;
6550         }
6551     }
6552     if (stacklen != 1) return JIM_ERR;
6553     return JIM_OK;
6554 }
6555
6556 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6557         ScriptObj *topLevelScript)
6558 {
6559     int i;
6560
6561     return;
6562     for (i = 0; i < expr->len; i++) {
6563         Jim_Obj *foundObjPtr;
6564
6565         if (expr->obj[i] == NULL) continue;
6566         foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6567                 NULL, expr->obj[i]);
6568         if (foundObjPtr != NULL) {
6569             Jim_IncrRefCount(foundObjPtr);
6570             Jim_DecrRefCount(interp, expr->obj[i]);
6571             expr->obj[i] = foundObjPtr;
6572         }
6573     }
6574 }
6575
6576 /* This procedure converts every occurrence of || and && opereators
6577  * in lazy unary versions.
6578  *
6579  * a b || is converted into:
6580  *
6581  * a <offset> |L b |R
6582  *
6583  * a b && is converted into:
6584  *
6585  * a <offset> &L b &R
6586  *
6587  * "|L" checks if 'a' is true:
6588  *   1) if it is true pushes 1 and skips <offset> istructions to reach
6589  *      the opcode just after |R.
6590  *   2) if it is false does nothing.
6591  * "|R" checks if 'b' is true:
6592  *   1) if it is true pushes 1, otherwise pushes 0.
6593  *
6594  * "&L" checks if 'a' is true:
6595  *   1) if it is true does nothing.
6596  *   2) If it is false pushes 0 and skips <offset> istructions to reach
6597  *      the opcode just after &R
6598  * "&R" checks if 'a' is true:
6599  *      if it is true pushes 1, otherwise pushes 0.
6600  */
6601 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6602 {
6603     while (1) {
6604         int index = -1, leftindex, arity, i, offset;
6605         Jim_ExprOperator *op;
6606
6607         /* Search for || or && */
6608         for (i = 0; i < expr->len; i++) {
6609             if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6610                 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6611                 index = i;
6612                 break;
6613             }
6614         }
6615         if (index == -1) return;
6616         /* Search for the end of the first operator */
6617         leftindex = index-1;
6618         arity = 1;
6619         while(arity) {
6620             switch(expr->opcode[leftindex]) {
6621             case JIM_EXPROP_NUMBER:
6622             case JIM_EXPROP_COMMAND:
6623             case JIM_EXPROP_VARIABLE:
6624             case JIM_EXPROP_DICTSUGAR:
6625             case JIM_EXPROP_SUBST:
6626             case JIM_EXPROP_STRING:
6627                 break;
6628             default:
6629                 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6630                 if (op == NULL) {
6631                     Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6632                 }
6633                 arity += op->arity;
6634                 break;
6635             }
6636             arity--;
6637             leftindex--;
6638         }
6639         leftindex++;
6640         expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6641         expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6642         memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6643                 sizeof(int)*(expr->len-leftindex));
6644         memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6645                 sizeof(Jim_Obj*)*(expr->len-leftindex));
6646         expr->len += 2;
6647         index += 2;
6648         offset = (index-leftindex)-1;
6649         Jim_DecrRefCount(interp, expr->obj[index]);
6650         if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6651             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6652             expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6653             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6654             expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6655         } else {
6656             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6657             expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6658             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6659             expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6660         }
6661         expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6662         expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6663         Jim_IncrRefCount(expr->obj[index]);
6664         Jim_IncrRefCount(expr->obj[leftindex]);
6665         Jim_IncrRefCount(expr->obj[leftindex+1]);
6666     }
6667 }
6668
6669 /* This method takes the string representation of an expression
6670  * and generates a program for the Expr's stack-based VM. */
6671 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6672 {
6673     int exprTextLen;
6674     const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6675     struct JimParserCtx parser;
6676     int i, shareLiterals;
6677     ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6678     Jim_Stack stack;
6679     Jim_ExprOperator *op;
6680
6681     /* Perform literal sharing with the current procedure
6682      * running only if this expression appears to be not generated
6683      * at runtime. */
6684     shareLiterals = objPtr->typePtr == &sourceObjType;
6685
6686     expr->opcode = NULL;
6687     expr->obj = NULL;
6688     expr->len = 0;
6689     expr->inUse = 1;
6690
6691     Jim_InitStack(&stack);
6692     JimParserInit(&parser, exprText, exprTextLen, 1);
6693     while(!JimParserEof(&parser)) {
6694         char *token;
6695         int len, type;
6696
6697         if (JimParseExpression(&parser) != JIM_OK) {
6698             Jim_SetResultString(interp, "Syntax error in expression", -1);
6699             goto err;
6700         }
6701         token = JimParserGetToken(&parser, &len, &type, NULL);
6702         if (type == JIM_TT_EOL) {
6703             Jim_Free(token);
6704             break;
6705         }
6706         switch(type) {
6707         case JIM_TT_STR:
6708             ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6709             break;
6710         case JIM_TT_ESC:
6711             ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6712             break;
6713         case JIM_TT_VAR:
6714             ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6715             break;
6716         case JIM_TT_DICTSUGAR:
6717             ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6718             break;
6719         case JIM_TT_CMD:
6720             ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6721             break;
6722         case JIM_TT_EXPR_NUMBER:
6723             ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6724             break;
6725         case JIM_TT_EXPR_OPERATOR:
6726             op = JimExprOperatorInfo(token);
6727             while(1) {
6728                 Jim_ExprOperator *stackTopOp;
6729
6730                 if (Jim_StackPeek(&stack) != NULL) {
6731                     stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6732                 } else {
6733                     stackTopOp = NULL;
6734                 }
6735                 if (Jim_StackLen(&stack) && op->arity != 1 &&
6736                     stackTopOp && stackTopOp->precedence >= op->precedence)
6737                 {
6738                     ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6739                         Jim_StackPeek(&stack), -1);
6740                     Jim_StackPop(&stack);
6741                 } else {
6742                     break;
6743                 }
6744             }
6745             Jim_StackPush(&stack, token);
6746             break;
6747         case JIM_TT_SUBEXPR_START:
6748             Jim_StackPush(&stack, Jim_StrDup("("));
6749             Jim_Free(token);
6750             break;
6751         case JIM_TT_SUBEXPR_END:
6752             {
6753                 int found = 0;
6754                 while(Jim_StackLen(&stack)) {
6755                     char *opstr = Jim_StackPop(&stack);
6756                     if (!strcmp(opstr, "(")) {
6757                         Jim_Free(opstr);
6758                         found = 1;
6759                         break;
6760                     }
6761                     op = JimExprOperatorInfo(opstr);
6762                     ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6763                 }
6764                 if (!found) {
6765                     Jim_SetResultString(interp,
6766                         "Unexpected close parenthesis", -1);
6767                     goto err;
6768                 }
6769             }
6770             Jim_Free(token);
6771             break;
6772         default:
6773             Jim_Panic(interp,"Default reached in SetExprFromAny()");
6774             break;
6775         }
6776     }
6777     while (Jim_StackLen(&stack)) {
6778         char *opstr = Jim_StackPop(&stack);
6779         op = JimExprOperatorInfo(opstr);
6780         if (op == NULL && !strcmp(opstr, "(")) {
6781             Jim_Free(opstr);
6782             Jim_SetResultString(interp, "Missing close parenthesis", -1);
6783             goto err;
6784         }
6785         ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6786     }
6787     /* Check program correctness. */
6788     if (ExprCheckCorrectness(expr) != JIM_OK) {
6789         Jim_SetResultString(interp, "Invalid expression", -1);
6790         goto err;
6791     }
6792
6793     /* Free the stack used for the compilation. */
6794     Jim_FreeStackElements(&stack, Jim_Free);
6795     Jim_FreeStack(&stack);
6796
6797     /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6798     ExprMakeLazy(interp, expr);
6799
6800     /* Perform literal sharing */
6801     if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6802         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6803         if (bodyObjPtr->typePtr == &scriptObjType) {
6804             ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6805             ExprShareLiterals(interp, expr, bodyScript);
6806         }
6807     }
6808
6809     /* Free the old internal rep and set the new one. */
6810     Jim_FreeIntRep(interp, objPtr);
6811     Jim_SetIntRepPtr(objPtr, expr);
6812     objPtr->typePtr = &exprObjType;
6813     return JIM_OK;
6814
6815 err:    /* we jump here on syntax/compile errors. */
6816     Jim_FreeStackElements(&stack, Jim_Free);
6817     Jim_FreeStack(&stack);
6818     Jim_Free(expr->opcode);
6819     for (i = 0; i < expr->len; i++) {
6820         Jim_DecrRefCount(interp,expr->obj[i]);
6821     }
6822     Jim_Free(expr->obj);
6823     Jim_Free(expr);
6824     return JIM_ERR;
6825 }
6826
6827 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6828 {
6829     if (objPtr->typePtr != &exprObjType) {
6830         if (SetExprFromAny(interp, objPtr) != JIM_OK)
6831             return NULL;
6832     }
6833     return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6834 }
6835
6836 /* -----------------------------------------------------------------------------
6837  * Expressions evaluation.
6838  * Jim uses a specialized stack-based virtual machine for expressions,
6839  * that takes advantage of the fact that expr's operators
6840  * can't be redefined.
6841  *
6842  * Jim_EvalExpression() uses the bytecode compiled by
6843  * SetExprFromAny() method of the "expression" object.
6844  *
6845  * On success a Tcl Object containing the result of the evaluation
6846  * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6847  * returned.
6848  * On error the function returns a retcode != to JIM_OK and set a suitable
6849  * error on the interp.
6850  * ---------------------------------------------------------------------------*/
6851 #define JIM_EE_STATICSTACK_LEN 10
6852
6853 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6854         Jim_Obj **exprResultPtrPtr)
6855 {
6856     ExprByteCode *expr;
6857     Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6858     int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6859
6860     Jim_IncrRefCount(exprObjPtr);
6861     expr = Jim_GetExpression(interp, exprObjPtr);
6862     if (!expr) {
6863         Jim_DecrRefCount(interp, exprObjPtr);
6864         return JIM_ERR; /* error in expression. */
6865     }
6866     /* In order to avoid that the internal repr gets freed due to
6867      * shimmering of the exprObjPtr's object, we make the internal rep
6868      * shared. */
6869     expr->inUse++;
6870
6871     /* The stack-based expr VM itself */
6872
6873     /* Stack allocation. Expr programs have the feature that
6874      * a program of length N can't require a stack longer than
6875      * N. */
6876     if (expr->len > JIM_EE_STATICSTACK_LEN)
6877         stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6878     else
6879         stack = staticStack;
6880
6881     /* Execute every istruction */
6882     for (i = 0; i < expr->len; i++) {
6883         Jim_Obj *A, *B, *objPtr;
6884         jim_wide wA, wB, wC;
6885         double dA, dB, dC;
6886         const char *sA, *sB;
6887         int Alen, Blen, retcode;
6888         int opcode = expr->opcode[i];
6889
6890         if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6891             stack[stacklen++] = expr->obj[i];
6892             Jim_IncrRefCount(expr->obj[i]);
6893         } else if (opcode == JIM_EXPROP_VARIABLE) {
6894             objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6895             if (objPtr == NULL) {
6896                 error = 1;
6897                 goto err;
6898             }
6899             stack[stacklen++] = objPtr;
6900             Jim_IncrRefCount(objPtr);
6901         } else if (opcode == JIM_EXPROP_SUBST) {
6902             if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6903                         &objPtr, JIM_NONE)) != JIM_OK)
6904             {
6905                 error = 1;
6906                 errRetCode = retcode;
6907                 goto err;
6908             }
6909             stack[stacklen++] = objPtr;
6910             Jim_IncrRefCount(objPtr);
6911         } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6912             objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6913             if (objPtr == NULL) {
6914                 error = 1;
6915                 goto err;
6916             }
6917             stack[stacklen++] = objPtr;
6918             Jim_IncrRefCount(objPtr);
6919         } else if (opcode == JIM_EXPROP_COMMAND) {
6920             if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6921                 error = 1;
6922                 errRetCode = retcode;
6923                 goto err;
6924             }
6925             stack[stacklen++] = interp->result;
6926             Jim_IncrRefCount(interp->result);
6927         } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6928                    opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6929         {
6930             /* Note that there isn't to increment the
6931              * refcount of objects. the references are moved
6932              * from stack to A and B. */
6933             B = stack[--stacklen];
6934             A = stack[--stacklen];
6935
6936             /* --- Integer --- */
6937             if ((A->typePtr == &doubleObjType && !A->bytes) ||
6938                 (B->typePtr == &doubleObjType && !B->bytes) ||
6939                 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6940                 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6941                 goto trydouble;
6942             }
6943             Jim_DecrRefCount(interp, A);
6944             Jim_DecrRefCount(interp, B);
6945             switch(expr->opcode[i]) {
6946             case JIM_EXPROP_ADD: wC = wA+wB; break;
6947             case JIM_EXPROP_SUB: wC = wA-wB; break;
6948             case JIM_EXPROP_MUL: wC = wA*wB; break;
6949             case JIM_EXPROP_LT: wC = wA<wB; break;
6950             case JIM_EXPROP_GT: wC = wA>wB; break;
6951             case JIM_EXPROP_LTE: wC = wA<=wB; break;
6952             case JIM_EXPROP_GTE: wC = wA>=wB; break;
6953             case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6954             case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6955             case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6956             case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6957             case JIM_EXPROP_BITAND: wC = wA&wB; break;
6958             case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6959             case JIM_EXPROP_BITOR: wC = wA|wB; break;
6960             case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6961             case JIM_EXPROP_LOGICAND_LEFT:
6962                 if (wA == 0) {
6963                     i += (int)wB;
6964                     wC = 0;
6965                 } else {
6966                     continue;
6967                 }
6968                 break;
6969             case JIM_EXPROP_LOGICOR_LEFT:
6970                 if (wA != 0) {
6971                     i += (int)wB;
6972                     wC = 1;
6973                 } else {
6974                     continue;
6975                 }
6976                 break;
6977             case JIM_EXPROP_DIV:
6978                 if (wB == 0) goto divbyzero;
6979                 wC = wA/wB;
6980                 break;
6981             case JIM_EXPROP_MOD:
6982                 if (wB == 0) goto divbyzero;
6983                 wC = wA%wB;
6984                 break;
6985             case JIM_EXPROP_ROTL: {
6986                 /* uint32_t would be better. But not everyone has inttypes.h?*/
6987                 unsigned long uA = (unsigned long)wA;
6988 #ifdef _MSC_VER
6989                 wC = _rotl(uA,(unsigned long)wB);
6990 #else
6991                 const unsigned int S = sizeof(unsigned long) * 8;
6992                 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6993 #endif
6994                 break;
6995             }
6996             case JIM_EXPROP_ROTR: {
6997                 unsigned long uA = (unsigned long)wA;
6998 #ifdef _MSC_VER
6999                 wC = _rotr(uA,(unsigned long)wB);
7000 #else
7001                 const unsigned int S = sizeof(unsigned long) * 8;
7002                 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7003 #endif
7004                 break;
7005             }
7006
7007             default:
7008                 wC = 0; /* avoid gcc warning */
7009                 break;
7010             }
7011             stack[stacklen] = Jim_NewIntObj(interp, wC);
7012             Jim_IncrRefCount(stack[stacklen]);
7013             stacklen++;
7014             continue;
7015 trydouble:
7016             /* --- Double --- */
7017             if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7018                 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7019
7020                 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7021                 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7022                     opcode = JIM_EXPROP_STRNE;
7023                     goto retry_as_string;
7024                 }
7025                 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7026                     opcode = JIM_EXPROP_STREQ;
7027                     goto retry_as_string;
7028                 }
7029                 Jim_DecrRefCount(interp, A);
7030                 Jim_DecrRefCount(interp, B);
7031                 error = 1;
7032                 goto err;
7033             }
7034             Jim_DecrRefCount(interp, A);
7035             Jim_DecrRefCount(interp, B);
7036             switch(expr->opcode[i]) {
7037             case JIM_EXPROP_ROTL:
7038             case JIM_EXPROP_ROTR:
7039             case JIM_EXPROP_LSHIFT:
7040             case JIM_EXPROP_RSHIFT:
7041             case JIM_EXPROP_BITAND:
7042             case JIM_EXPROP_BITXOR:
7043             case JIM_EXPROP_BITOR:
7044             case JIM_EXPROP_MOD:
7045             case JIM_EXPROP_POW:
7046                 Jim_SetResultString(interp,
7047                     "Got floating-point value where integer was expected", -1);
7048                 error = 1;
7049                 goto err;
7050                 break;
7051             case JIM_EXPROP_ADD: dC = dA+dB; break;
7052             case JIM_EXPROP_SUB: dC = dA-dB; break;
7053             case JIM_EXPROP_MUL: dC = dA*dB; break;
7054             case JIM_EXPROP_LT: dC = dA<dB; break;
7055             case JIM_EXPROP_GT: dC = dA>dB; break;
7056             case JIM_EXPROP_LTE: dC = dA<=dB; break;
7057             case JIM_EXPROP_GTE: dC = dA>=dB; break;
7058             case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7059             case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7060             case JIM_EXPROP_LOGICAND_LEFT:
7061                 if (dA == 0) {
7062                     i += (int)dB;
7063                     dC = 0;
7064                 } else {
7065                     continue;
7066                 }
7067                 break;
7068             case JIM_EXPROP_LOGICOR_LEFT:
7069                 if (dA != 0) {
7070                     i += (int)dB;
7071                     dC = 1;
7072                 } else {
7073                     continue;
7074                 }
7075                 break;
7076             case JIM_EXPROP_DIV:
7077                 if (dB == 0) goto divbyzero;
7078                 dC = dA/dB;
7079                 break;
7080             default:
7081                 dC = 0; /* avoid gcc warning */
7082                 break;
7083             }
7084             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7085             Jim_IncrRefCount(stack[stacklen]);
7086             stacklen++;
7087         } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7088             B = stack[--stacklen];
7089             A = stack[--stacklen];
7090 retry_as_string:
7091             sA = Jim_GetString(A, &Alen);
7092             sB = Jim_GetString(B, &Blen);
7093             switch(opcode) {
7094             case JIM_EXPROP_STREQ:
7095                 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7096                     wC = 1;
7097                 else
7098                     wC = 0;
7099                 break;
7100             case JIM_EXPROP_STRNE:
7101                 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7102                     wC = 1;
7103                 else
7104                     wC = 0;
7105                 break;
7106             default:
7107                 wC = 0; /* avoid gcc warning */
7108                 break;
7109             }
7110             Jim_DecrRefCount(interp, A);
7111             Jim_DecrRefCount(interp, B);
7112             stack[stacklen] = Jim_NewIntObj(interp, wC);
7113             Jim_IncrRefCount(stack[stacklen]);
7114             stacklen++;
7115         } else if (opcode == JIM_EXPROP_NOT ||
7116                    opcode == JIM_EXPROP_BITNOT ||
7117                    opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7118                    opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7119             /* Note that there isn't to increment the
7120              * refcount of objects. the references are moved
7121              * from stack to A and B. */
7122             A = stack[--stacklen];
7123
7124             /* --- Integer --- */
7125             if ((A->typePtr == &doubleObjType && !A->bytes) ||
7126                 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7127                 goto trydouble_unary;
7128             }
7129             Jim_DecrRefCount(interp, A);
7130             switch(expr->opcode[i]) {
7131             case JIM_EXPROP_NOT: wC = !wA; break;
7132             case JIM_EXPROP_BITNOT: wC = ~wA; break;
7133             case JIM_EXPROP_LOGICAND_RIGHT:
7134             case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7135             default:
7136                 wC = 0; /* avoid gcc warning */
7137                 break;
7138             }
7139             stack[stacklen] = Jim_NewIntObj(interp, wC);
7140             Jim_IncrRefCount(stack[stacklen]);
7141             stacklen++;
7142             continue;
7143 trydouble_unary:
7144             /* --- Double --- */
7145             if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7146                 Jim_DecrRefCount(interp, A);
7147                 error = 1;
7148                 goto err;
7149             }
7150             Jim_DecrRefCount(interp, A);
7151             switch(expr->opcode[i]) {
7152             case JIM_EXPROP_NOT: dC = !dA; break;
7153             case JIM_EXPROP_LOGICAND_RIGHT:
7154             case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7155             case JIM_EXPROP_BITNOT:
7156                 Jim_SetResultString(interp,
7157                     "Got floating-point value where integer was expected", -1);
7158                 error = 1;
7159                 goto err;
7160                 break;
7161             default:
7162                 dC = 0; /* avoid gcc warning */
7163                 break;
7164             }
7165             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7166             Jim_IncrRefCount(stack[stacklen]);
7167             stacklen++;
7168         } else {
7169             Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7170         }
7171     }
7172 err:
7173     /* There is no need to decerement the inUse field because
7174      * this reference is transfered back into the exprObjPtr. */
7175     Jim_FreeIntRep(interp, exprObjPtr);
7176     exprObjPtr->typePtr = &exprObjType;
7177     Jim_SetIntRepPtr(exprObjPtr, expr);
7178     Jim_DecrRefCount(interp, exprObjPtr);
7179     if (!error) {
7180         *exprResultPtrPtr = stack[0];
7181         Jim_IncrRefCount(stack[0]);
7182         errRetCode = JIM_OK;
7183     }
7184     for (i = 0; i < stacklen; i++) {
7185         Jim_DecrRefCount(interp, stack[i]);
7186     }
7187     if (stack != staticStack)
7188         Jim_Free(stack);
7189     return errRetCode;
7190 divbyzero:
7191     error = 1;
7192     Jim_SetResultString(interp, "Division by zero", -1);
7193     goto err;
7194 }
7195
7196 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7197 {
7198     int retcode;
7199     jim_wide wideValue;
7200     double doubleValue;
7201     Jim_Obj *exprResultPtr;
7202
7203     retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7204     if (retcode != JIM_OK)
7205         return retcode;
7206     if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7207         if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7208         {
7209             Jim_DecrRefCount(interp, exprResultPtr);
7210             return JIM_ERR;
7211         } else {
7212             Jim_DecrRefCount(interp, exprResultPtr);
7213             *boolPtr = doubleValue != 0;
7214             return JIM_OK;
7215         }
7216     }
7217     Jim_DecrRefCount(interp, exprResultPtr);
7218     *boolPtr = wideValue != 0;
7219     return JIM_OK;
7220 }
7221
7222 /* -----------------------------------------------------------------------------
7223  * ScanFormat String Object
7224  * ---------------------------------------------------------------------------*/
7225
7226 /* This Jim_Obj will held a parsed representation of a format string passed to
7227  * the Jim_ScanString command. For error diagnostics, the scanformat string has
7228  * to be parsed in its entirely first and then, if correct, can be used for
7229  * scanning. To avoid endless re-parsing, the parsed representation will be
7230  * stored in an internal representation and re-used for performance reason. */
7231  
7232 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7233  * scanformat string. This part will later be used to extract information
7234  * out from the string to be parsed by Jim_ScanString */
7235  
7236 typedef struct ScanFmtPartDescr {
7237     char type;         /* Type of conversion (e.g. c, d, f) */
7238     char modifier;     /* Modify type (e.g. l - long, h - short */
7239     size_t  width;     /* Maximal width of input to be converted */
7240     int  pos;          /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */ 
7241     char *arg;         /* Specification of a CHARSET conversion */
7242     char *prefix;      /* Prefix to be scanned literally before conversion */
7243 } ScanFmtPartDescr;
7244
7245 /* The ScanFmtStringObj will held the internal representation of a scanformat
7246  * string parsed and separated in part descriptions. Furthermore it contains
7247  * the original string representation of the scanformat string to allow for
7248  * fast update of the Jim_Obj's string representation part.
7249  *
7250  * As add-on the internal object representation add some scratch pad area
7251  * for usage by Jim_ScanString to avoid endless allocating and freeing of
7252  * memory for purpose of string scanning.
7253  *
7254  * The error member points to a static allocated string in case of a mal-
7255  * formed scanformat string or it contains '0' (NULL) in case of a valid
7256  * parse representation.
7257  *
7258  * The whole memory of the internal representation is allocated as a single
7259  * area of memory that will be internally separated. So freeing and duplicating
7260  * of such an object is cheap */
7261
7262 typedef struct ScanFmtStringObj {
7263     jim_wide        size;         /* Size of internal repr in bytes */
7264     char            *stringRep;   /* Original string representation */
7265     size_t          count;        /* Number of ScanFmtPartDescr contained */
7266     size_t          convCount;    /* Number of conversions that will assign */
7267     size_t          maxPos;       /* Max position index if XPG3 is used */
7268     const char      *error;       /* Ptr to error text (NULL if no error */
7269     char            *scratch;     /* Some scratch pad used by Jim_ScanString */
7270     ScanFmtPartDescr descr[1];    /* The vector of partial descriptions */
7271 } ScanFmtStringObj;
7272
7273
7274 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7275 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7276 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7277
7278 static Jim_ObjType scanFmtStringObjType = {
7279     "scanformatstring",
7280     FreeScanFmtInternalRep,
7281     DupScanFmtInternalRep,
7282     UpdateStringOfScanFmt,
7283     JIM_TYPE_NONE,
7284 };
7285
7286 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7287 {
7288     JIM_NOTUSED(interp);
7289     Jim_Free((char*)objPtr->internalRep.ptr);
7290     objPtr->internalRep.ptr = 0;
7291 }
7292
7293 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7294 {
7295     size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7296     ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7297
7298     JIM_NOTUSED(interp);
7299     memcpy(newVec, srcPtr->internalRep.ptr, size);
7300     dupPtr->internalRep.ptr = newVec;
7301     dupPtr->typePtr = &scanFmtStringObjType;
7302 }
7303
7304 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7305 {
7306     char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7307
7308     objPtr->bytes = Jim_StrDup(bytes);
7309     objPtr->length = strlen(bytes);
7310 }
7311
7312 /* SetScanFmtFromAny will parse a given string and create the internal
7313  * representation of the format specification. In case of an error
7314  * the error data member of the internal representation will be set
7315  * to an descriptive error text and the function will be left with
7316  * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7317  * specification */
7318
7319 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7320 {
7321     ScanFmtStringObj *fmtObj;
7322     char *buffer;
7323     int maxCount, i, approxSize, lastPos = -1;
7324     const char *fmt = objPtr->bytes;
7325     int maxFmtLen = objPtr->length;
7326     const char *fmtEnd = fmt + maxFmtLen;
7327     int curr;
7328
7329     Jim_FreeIntRep(interp, objPtr);
7330     /* Count how many conversions could take place maximally */
7331     for (i=0, maxCount=0; i < maxFmtLen; ++i)
7332         if (fmt[i] == '%')
7333             ++maxCount;
7334     /* Calculate an approximation of the memory necessary */
7335     approxSize = sizeof(ScanFmtStringObj)           /* Size of the container */
7336         + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7337         + maxFmtLen * sizeof(char) + 3 + 1          /* Scratch + "%n" + '\0' */
7338         + maxFmtLen * sizeof(char) + 1              /* Original stringrep */
7339         + maxFmtLen * sizeof(char)                  /* Arg for CHARSETs */
7340         + (maxCount +1) * sizeof(char)              /* '\0' for every partial */
7341         + 1;                                        /* safety byte */
7342     fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7343     memset(fmtObj, 0, approxSize);
7344     fmtObj->size = approxSize;
7345     fmtObj->maxPos = 0;
7346     fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7347     fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7348     memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7349     buffer = fmtObj->stringRep + maxFmtLen + 1;
7350     objPtr->internalRep.ptr = fmtObj;
7351     objPtr->typePtr = &scanFmtStringObjType;
7352     for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7353         int width=0, skip;
7354         ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7355         fmtObj->count++;
7356         descr->width = 0;                   /* Assume width unspecified */ 
7357         /* Overread and store any "literal" prefix */
7358         if (*fmt != '%' || fmt[1] == '%') {
7359             descr->type = 0;
7360             descr->prefix = &buffer[i];
7361             for (; fmt < fmtEnd; ++fmt) {
7362                 if (*fmt == '%') {
7363                     if (fmt[1] != '%') break;
7364                     ++fmt;
7365                 }
7366                 buffer[i++] = *fmt;
7367             }
7368             buffer[i++] = 0;
7369         } 
7370         /* Skip the conversion introducing '%' sign */
7371         ++fmt;      
7372         /* End reached due to non-conversion literal only? */
7373         if (fmt >= fmtEnd)
7374             goto done;
7375         descr->pos = 0;                     /* Assume "natural" positioning */
7376         if (*fmt == '*') {
7377             descr->pos = -1;       /* Okay, conversion will not be assigned */
7378             ++fmt;
7379         } else
7380             fmtObj->convCount++;    /* Otherwise count as assign-conversion */
7381         /* Check if next token is a number (could be width or pos */
7382         if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7383             fmt += skip;
7384             /* Was the number a XPG3 position specifier? */
7385             if (descr->pos != -1 && *fmt == '$') {
7386                 int prev;
7387                 ++fmt;
7388                 descr->pos = width;
7389                 width = 0;
7390                 /* Look if "natural" postioning and XPG3 one was mixed */
7391                 if ((lastPos == 0 && descr->pos > 0)
7392                         || (lastPos > 0 && descr->pos == 0)) {
7393                     fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7394                     return JIM_ERR;
7395                 }
7396                 /* Look if this position was already used */
7397                 for (prev=0; prev < curr; ++prev) {
7398                     if (fmtObj->descr[prev].pos == -1) continue;
7399                     if (fmtObj->descr[prev].pos == descr->pos) {
7400                         fmtObj->error = "same \"%n$\" conversion specifier "
7401                             "used more than once";
7402                         return JIM_ERR;
7403                     }
7404                 }
7405                 /* Try to find a width after the XPG3 specifier */
7406                 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7407                     descr->width = width;
7408                     fmt += skip;
7409                 }
7410                 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7411                     fmtObj->maxPos = descr->pos;
7412             } else {
7413                 /* Number was not a XPG3, so it has to be a width */
7414                 descr->width = width;
7415             }
7416         }
7417         /* If positioning mode was undetermined yet, fix this */
7418         if (lastPos == -1)
7419             lastPos = descr->pos;
7420         /* Handle CHARSET conversion type ... */
7421         if (*fmt == '[') {
7422             int swapped = 1, beg = i, end, j;
7423             descr->type = '[';
7424             descr->arg = &buffer[i];
7425             ++fmt;
7426             if (*fmt == '^') buffer[i++] = *fmt++;
7427             if (*fmt == ']') buffer[i++] = *fmt++;
7428             while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7429             if (*fmt != ']') {
7430                 fmtObj->error = "unmatched [ in format string";
7431                 return JIM_ERR;
7432             } 
7433             end = i;
7434             buffer[i++] = 0;
7435             /* In case a range fence was given "backwards", swap it */
7436             while (swapped) {
7437                 swapped = 0;
7438                 for (j=beg+1; j < end-1; ++j) {
7439                     if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7440                         char tmp = buffer[j-1];
7441                         buffer[j-1] = buffer[j+1];
7442                         buffer[j+1] = tmp;
7443                         swapped = 1;
7444                     }
7445                 }
7446             }
7447         } else {
7448             /* Remember any valid modifier if given */
7449             if (strchr("hlL", *fmt) != 0)
7450                 descr->modifier = tolower((int)*fmt++);
7451             
7452             descr->type = *fmt;
7453             if (strchr("efgcsndoxui", *fmt) == 0) {
7454                 fmtObj->error = "bad scan conversion character";
7455                 return JIM_ERR;
7456             } else if (*fmt == 'c' && descr->width != 0) {
7457                 fmtObj->error = "field width may not be specified in %c "
7458                     "conversion";
7459                 return JIM_ERR;
7460             } else if (*fmt == 'u' && descr->modifier == 'l') {
7461                 fmtObj->error = "unsigned wide not supported";
7462                 return JIM_ERR;
7463             }
7464         }
7465         curr++;
7466     }
7467 done:
7468     if (fmtObj->convCount == 0) {
7469         fmtObj->error = "no any conversion specifier given";
7470         return JIM_ERR;
7471     }
7472     return JIM_OK;
7473 }
7474
7475 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7476
7477 #define FormatGetCnvCount(_fo_) \
7478     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7479 #define FormatGetMaxPos(_fo_) \
7480     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7481 #define FormatGetError(_fo_) \
7482     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7483
7484 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7485  * charsets ([a-z123]) within scanning. Later on perhaps a base for a 
7486  * bitvector implementation in Jim? */ 
7487
7488 static int JimTestBit(const char *bitvec, char ch)
7489 {
7490     div_t pos = div(ch-1, 8);
7491     return bitvec[pos.quot] & (1 << pos.rem);
7492 }
7493
7494 static void JimSetBit(char *bitvec, char ch)
7495 {
7496     div_t pos = div(ch-1, 8);
7497     bitvec[pos.quot] |= (1 << pos.rem);
7498 }
7499
7500 #if 0 /* currently not used */
7501 static void JimClearBit(char *bitvec, char ch)
7502 {
7503     div_t pos = div(ch-1, 8);
7504     bitvec[pos.quot] &= ~(1 << pos.rem);
7505 }
7506 #endif
7507
7508 /* JimScanAString is used to scan an unspecified string that ends with
7509  * next WS, or a string that is specified via a charset. The charset
7510  * is currently implemented in a way to only allow for usage with
7511  * ASCII. Whenever we will switch to UNICODE, another idea has to
7512  * be born :-/
7513  *
7514  * FIXME: Works only with ASCII */
7515
7516 static Jim_Obj *
7517 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7518 {
7519     size_t i;
7520     Jim_Obj *result;
7521     char charset[256/8+1];  /* A Charset may contain max 256 chars */
7522     char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7523
7524     /* First init charset to nothing or all, depending if a specified
7525      * or an unspecified string has to be parsed */
7526     memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7527     if (sdescr) {
7528         /* There was a set description given, that means we are parsing
7529          * a specified string. So we have to build a corresponding 
7530          * charset reflecting the description */
7531         int notFlag = 0;
7532         /* Should the set be negated at the end? */
7533         if (*sdescr == '^') {
7534             notFlag = 1;
7535             ++sdescr;
7536         }
7537         /* Here '-' is meant literally and not to define a range */
7538         if (*sdescr == '-') {
7539             JimSetBit(charset, '-');
7540             ++sdescr;
7541         }
7542         while (*sdescr) {
7543             if (sdescr[1] == '-' && sdescr[2] != 0) {
7544                 /* Handle range definitions */
7545                 int i;
7546                 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7547                     JimSetBit(charset, (char)i);
7548                 sdescr += 3;
7549             } else {
7550                 /* Handle verbatim character definitions */
7551                 JimSetBit(charset, *sdescr++);
7552             }
7553         }
7554         /* Negate the charset if there was a NOT given */
7555         for (i=0; notFlag && i < sizeof(charset); ++i)
7556             charset[i] = ~charset[i];
7557     } 
7558     /* And after all the mess above, the real work begin ... */
7559     while (str && *str) {
7560         if (!sdescr && isspace((int)*str))
7561             break; /* EOS via WS if unspecified */
7562         if (JimTestBit(charset, *str)) *buffer++ = *str++;
7563         else break;             /* EOS via mismatch if specified scanning */
7564     }
7565     *buffer = 0;                /* Close the string properly ... */
7566     result = Jim_NewStringObj(interp, anchor, -1);
7567     Jim_Free(anchor);           /* ... and free it afer usage */
7568     return result;
7569 }
7570
7571 /* ScanOneEntry will scan one entry out of the string passed as argument.
7572  * It use the sscanf() function for this task. After extracting and
7573  * converting of the value, the count of scanned characters will be
7574  * returned of -1 in case of no conversion tool place and string was
7575  * already scanned thru */
7576
7577 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7578         ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7579 {
7580 #   define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7581         ? sizeof(jim_wide)                             \
7582         : sizeof(double))
7583     char buffer[MAX_SIZE];
7584     char *value = buffer;
7585     const char *tok;
7586     const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7587     size_t sLen = strlen(&str[pos]), scanned = 0;
7588     size_t anchor = pos;
7589     int i;
7590
7591     /* First pessimiticly assume, we will not scan anything :-) */
7592     *valObjPtr = 0;
7593     if (descr->prefix) {
7594         /* There was a prefix given before the conversion, skip it and adjust
7595          * the string-to-be-parsed accordingly */
7596         for (i=0; str[pos] && descr->prefix[i]; ++i) {
7597             /* If prefix require, skip WS */
7598             if (isspace((int)descr->prefix[i]))
7599                 while (str[pos] && isspace((int)str[pos])) ++pos;
7600             else if (descr->prefix[i] != str[pos]) 
7601                 break;  /* Prefix do not match here, leave the loop */
7602             else
7603                 ++pos;  /* Prefix matched so far, next round */
7604         }
7605         if (str[pos] == 0)
7606             return -1;  /* All of str consumed: EOF condition */
7607         else if (descr->prefix[i] != 0)
7608             return 0;   /* Not whole prefix consumed, no conversion possible */
7609     }
7610     /* For all but following conversion, skip leading WS */
7611     if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7612         while (isspace((int)str[pos])) ++pos;
7613     /* Determine how much skipped/scanned so far */
7614     scanned = pos - anchor;
7615     if (descr->type == 'n') {
7616         /* Return pseudo conversion means: how much scanned so far? */
7617         *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7618     } else if (str[pos] == 0) {
7619         /* Cannot scan anything, as str is totally consumed */
7620         return -1;
7621     } else {
7622         /* Processing of conversions follows ... */
7623         if (descr->width > 0) {
7624             /* Do not try to scan as fas as possible but only the given width.
7625              * To ensure this, we copy the part that should be scanned. */
7626             size_t tLen = descr->width > sLen ? sLen : descr->width;
7627             tok = Jim_StrDupLen(&str[pos], tLen);
7628         } else {
7629             /* As no width was given, simply refer to the original string */
7630             tok = &str[pos];
7631         }
7632         switch (descr->type) {
7633             case 'c':
7634                 *valObjPtr = Jim_NewIntObj(interp, *tok);
7635                 scanned += 1;
7636                 break;
7637             case 'd': case 'o': case 'x': case 'u': case 'i': {
7638                 jim_wide jwvalue;
7639                 long lvalue;
7640                 char *endp;  /* Position where the number finished */
7641                 int base = descr->type == 'o' ? 8
7642                     : descr->type == 'x' ? 16
7643                     : descr->type == 'i' ? 0
7644                     : 10;
7645                     
7646                 do {
7647                     /* Try to scan a number with the given base */
7648                     if (descr->modifier == 'l')
7649                     {
7650 #ifdef HAVE_LONG_LONG_INT
7651                         jwvalue = JimStrtoll(tok, &endp, base),
7652 #else
7653                         jwvalue = strtol(tok, &endp, base),
7654 #endif
7655                         memcpy(value, &jwvalue, sizeof(jim_wide));
7656                     }
7657                     else
7658                     {
7659                       if (descr->type == 'u')
7660                         lvalue = strtoul(tok, &endp, base);
7661                       else
7662                         lvalue = strtol(tok, &endp, base);
7663                       memcpy(value, &lvalue, sizeof(lvalue));
7664                     }
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;
7671                     else break;
7672                 } while (1);
7673                 if (endp != tok) {
7674                     /* There was some number sucessfully scanned! */
7675                     if (descr->modifier == 'l')
7676                         *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7677                     else
7678                         *valObjPtr = Jim_NewIntObj(interp, lvalue);
7679                     /* Adjust the number-of-chars scanned so far */
7680                     scanned += endp - tok;
7681                 } else {
7682                     /* Nothing was scanned. We have to determine if this
7683                      * happened due to e.g. prefix mismatch or input str
7684                      * exhausted */
7685                     scanned = *tok ? 0 : -1;
7686                 }
7687                 break;
7688             }
7689             case 's': case '[': {
7690                 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7691                 scanned += Jim_Length(*valObjPtr);
7692                 break;
7693             }
7694             case 'e': case 'f': case 'g': {
7695                 char *endp;
7696
7697                 double dvalue = strtod(tok, &endp);
7698                 memcpy(value, &dvalue, sizeof(double));
7699                 if (endp != tok) {
7700                     /* There was some number sucessfully scanned! */
7701                     *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7702                     /* Adjust the number-of-chars scanned so far */
7703                     scanned += endp - tok;
7704                 } else {
7705                     /* Nothing was scanned. We have to determine if this
7706                      * happened due to e.g. prefix mismatch or input str
7707                      * exhausted */
7708                     scanned = *tok ? 0 : -1;
7709                 }
7710                 break;
7711             }
7712         }
7713         /* If a substring was allocated (due to pre-defined width) do not
7714          * forget to free it */
7715         if (tok != &str[pos])
7716             Jim_Free((char*)tok);
7717     }
7718     return scanned;
7719 }
7720
7721 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7722  * string and returns all converted (and not ignored) values in a list back
7723  * to the caller. If an error occured, a NULL pointer will be returned */
7724
7725 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7726         Jim_Obj *fmtObjPtr, int flags)
7727 {
7728     size_t i, pos;
7729     int scanned = 1;
7730     const char *str = Jim_GetString(strObjPtr, 0);
7731     Jim_Obj *resultList = 0;
7732     Jim_Obj **resultVec;
7733     int resultc;
7734     Jim_Obj *emptyStr = 0;
7735     ScanFmtStringObj *fmtObj;
7736
7737     /* If format specification is not an object, convert it! */
7738     if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7739         SetScanFmtFromAny(interp, fmtObjPtr);
7740     fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7741     /* Check if format specification was valid */
7742     if (fmtObj->error != 0) {
7743         if (flags & JIM_ERRMSG)
7744             Jim_SetResultString(interp, fmtObj->error, -1);
7745         return 0;
7746     }
7747     /* Allocate a new "shared" empty string for all unassigned conversions */
7748     emptyStr = Jim_NewEmptyStringObj(interp);
7749     Jim_IncrRefCount(emptyStr);
7750     /* Create a list and fill it with empty strings up to max specified XPG3 */
7751     resultList = Jim_NewListObj(interp, 0, 0);
7752     if (fmtObj->maxPos > 0) {
7753         for (i=0; i < fmtObj->maxPos; ++i)
7754             Jim_ListAppendElement(interp, resultList, emptyStr);
7755         JimListGetElements(interp, resultList, &resultc, &resultVec);
7756     }
7757     /* Now handle every partial format description */
7758     for (i=0, pos=0; i < fmtObj->count; ++i) {
7759         ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7760         Jim_Obj *value = 0;
7761         /* Only last type may be "literal" w/o conversion - skip it! */
7762         if (descr->type == 0) continue;
7763         /* As long as any conversion could be done, we will proceed */
7764         if (scanned > 0)
7765             scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7766         /* In case our first try results in EOF, we will leave */
7767         if (scanned == -1 && i == 0)
7768             goto eof;
7769         /* Advance next pos-to-be-scanned for the amount scanned already */
7770         pos += scanned;
7771         /* value == 0 means no conversion took place so take empty string */
7772         if (value == 0)
7773             value = Jim_NewEmptyStringObj(interp);
7774         /* If value is a non-assignable one, skip it */
7775         if (descr->pos == -1) {
7776             Jim_FreeNewObj(interp, value);
7777         } else if (descr->pos == 0)
7778             /* Otherwise append it to the result list if no XPG3 was given */
7779             Jim_ListAppendElement(interp, resultList, value);
7780         else if (resultVec[descr->pos-1] == emptyStr) {
7781             /* But due to given XPG3, put the value into the corr. slot */
7782             Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7783             Jim_IncrRefCount(value);
7784             resultVec[descr->pos-1] = value;
7785         } else {
7786             /* Otherwise, the slot was already used - free obj and ERROR */
7787             Jim_FreeNewObj(interp, value);
7788             goto err;
7789         }
7790     }
7791     Jim_DecrRefCount(interp, emptyStr);
7792     return resultList;
7793 eof:
7794     Jim_DecrRefCount(interp, emptyStr);
7795     Jim_FreeNewObj(interp, resultList);
7796     return (Jim_Obj*)EOF;
7797 err:
7798     Jim_DecrRefCount(interp, emptyStr);
7799     Jim_FreeNewObj(interp, resultList);
7800     return 0;
7801 }
7802
7803 /* -----------------------------------------------------------------------------
7804  * Pseudo Random Number Generation
7805  * ---------------------------------------------------------------------------*/
7806 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7807         int seedLen);
7808
7809 /* Initialize the sbox with the numbers from 0 to 255 */
7810 static void JimPrngInit(Jim_Interp *interp)
7811 {
7812     int i;
7813     unsigned int seed[256];
7814
7815     interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7816     for (i = 0; i < 256; i++)
7817         seed[i] = (rand() ^ time(NULL) ^ clock());
7818     JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7819 }
7820
7821 /* Generates N bytes of random data */
7822 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7823 {
7824     Jim_PrngState *prng;
7825     unsigned char *destByte = (unsigned char*) dest;
7826     unsigned int si, sj, x;
7827
7828     /* initialization, only needed the first time */
7829     if (interp->prngState == NULL)
7830         JimPrngInit(interp);
7831     prng = interp->prngState;
7832     /* generates 'len' bytes of pseudo-random numbers */
7833     for (x = 0; x < len; x++) {
7834         prng->i = (prng->i+1) & 0xff;
7835         si = prng->sbox[prng->i];
7836         prng->j = (prng->j + si) & 0xff;
7837         sj = prng->sbox[prng->j];
7838         prng->sbox[prng->i] = sj;
7839         prng->sbox[prng->j] = si;
7840         *destByte++ = prng->sbox[(si+sj)&0xff];
7841     }
7842 }
7843
7844 /* Re-seed the generator with user-provided bytes */
7845 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7846         int seedLen)
7847 {
7848     int i;
7849     unsigned char buf[256];
7850     Jim_PrngState *prng;
7851
7852     /* initialization, only needed the first time */
7853     if (interp->prngState == NULL)
7854         JimPrngInit(interp);
7855     prng = interp->prngState;
7856
7857     /* Set the sbox[i] with i */
7858     for (i = 0; i < 256; i++)
7859         prng->sbox[i] = i;
7860     /* Now use the seed to perform a random permutation of the sbox */
7861     for (i = 0; i < seedLen; i++) {
7862         unsigned char t;
7863
7864         t = prng->sbox[i&0xFF];
7865         prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7866         prng->sbox[seed[i]] = t;
7867     }
7868     prng->i = prng->j = 0;
7869     /* discard the first 256 bytes of stream. */
7870     JimRandomBytes(interp, buf, 256);
7871 }
7872
7873 /* -----------------------------------------------------------------------------
7874  * Dynamic libraries support (WIN32 not supported)
7875  * ---------------------------------------------------------------------------*/
7876
7877 #ifdef JIM_DYNLIB
7878 #ifdef WIN32
7879 #define RTLD_LAZY 0
7880 void * dlopen(const char *path, int mode) 
7881 {
7882     JIM_NOTUSED(mode);
7883
7884     return (void *)LoadLibraryA(path);
7885 }
7886 int dlclose(void *handle)
7887 {
7888     FreeLibrary((HANDLE)handle);
7889     return 0;
7890 }
7891 void *dlsym(void *handle, const char *symbol)
7892 {
7893     return GetProcAddress((HMODULE)handle, symbol);
7894 }
7895 static char win32_dlerror_string[121];
7896 const char *dlerror(void)
7897 {
7898     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7899                    LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7900     return win32_dlerror_string;
7901 }
7902 #endif /* WIN32 */
7903
7904 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7905 {
7906     Jim_Obj *libPathObjPtr;
7907     int prefixc, i;
7908     void *handle;
7909     int (*onload)(Jim_Interp *interp);
7910
7911     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7912     if (libPathObjPtr == NULL) {
7913         prefixc = 0;
7914         libPathObjPtr = NULL;
7915     } else {
7916         Jim_IncrRefCount(libPathObjPtr);
7917         Jim_ListLength(interp, libPathObjPtr, &prefixc);
7918     }
7919
7920     for (i = -1; i < prefixc; i++) {
7921         if (i < 0) {
7922             handle = dlopen(pathName, RTLD_LAZY);
7923         } else {
7924             FILE *fp;
7925             char buf[JIM_PATH_LEN];
7926             const char *prefix;
7927             int prefixlen;
7928             Jim_Obj *prefixObjPtr;
7929             
7930             buf[0] = '\0';
7931             if (Jim_ListIndex(interp, libPathObjPtr, i,
7932                     &prefixObjPtr, JIM_NONE) != JIM_OK)
7933                 continue;
7934             prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7935             if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7936                 continue;
7937             if (*pathName == '/') {
7938                 strcpy(buf, pathName);
7939             }    
7940             else if (prefixlen && prefix[prefixlen-1] == '/')
7941                 sprintf(buf, "%s%s", prefix, pathName);
7942             else
7943                 sprintf(buf, "%s/%s", prefix, pathName);
7944             fp = fopen(buf, "r");
7945             if (fp == NULL)
7946                 continue;
7947             fclose(fp);
7948             handle = dlopen(buf, RTLD_LAZY);
7949         }
7950         if (handle == NULL) {
7951             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7952             Jim_AppendStrings(interp, Jim_GetResult(interp),
7953                 "error loading extension \"", pathName,
7954                 "\": ", dlerror(), NULL);
7955             if (i < 0)
7956                 continue;
7957             goto err;
7958         }
7959         if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7960             Jim_SetResultString(interp,
7961                     "No Jim_OnLoad symbol found on extension", -1);
7962             goto err;
7963         }
7964         if (onload(interp) == JIM_ERR) {
7965             dlclose(handle);
7966             goto err;
7967         }
7968         Jim_SetEmptyResult(interp);
7969         if (libPathObjPtr != NULL)
7970             Jim_DecrRefCount(interp, libPathObjPtr);
7971         return JIM_OK;
7972     }
7973 err:
7974     if (libPathObjPtr != NULL)
7975         Jim_DecrRefCount(interp, libPathObjPtr);
7976     return JIM_ERR;
7977 }
7978 #else /* JIM_DYNLIB */
7979 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7980 {
7981     JIM_NOTUSED(interp);
7982     JIM_NOTUSED(pathName);
7983
7984     Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7985     return JIM_ERR;
7986 }
7987 #endif/* JIM_DYNLIB */
7988
7989 /* -----------------------------------------------------------------------------
7990  * Packages handling
7991  * ---------------------------------------------------------------------------*/
7992
7993 #define JIM_PKG_ANY_VERSION -1
7994
7995 /* Convert a string of the type "1.2" into an integer.
7996  * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted 
7997  * to the integer with value 102 */
7998 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7999         int *intPtr, int flags)
8000 {
8001     char *copy;
8002     jim_wide major, minor;
8003     char *majorStr, *minorStr, *p;
8004
8005     if (v[0] == '\0') {
8006         *intPtr = JIM_PKG_ANY_VERSION;
8007         return JIM_OK;
8008     }
8009
8010     copy = Jim_StrDup(v);
8011     p = strchr(copy, '.');
8012     if (p == NULL) goto badfmt;
8013     *p = '\0';
8014     majorStr = copy;
8015     minorStr = p+1;
8016
8017     if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8018         Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8019         goto badfmt;
8020     *intPtr = (int)(major*100+minor);
8021     Jim_Free(copy);
8022     return JIM_OK;
8023
8024 badfmt:
8025     Jim_Free(copy);
8026     if (flags & JIM_ERRMSG) {
8027         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8028         Jim_AppendStrings(interp, Jim_GetResult(interp),
8029                 "invalid package version '", v, "'", NULL);
8030     }
8031     return JIM_ERR;
8032 }
8033
8034 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8035 static int JimPackageMatchVersion(int needed, int actual, int flags)
8036 {
8037     if (needed == JIM_PKG_ANY_VERSION) return 1;
8038     if (flags & JIM_MATCHVER_EXACT) {
8039         return needed == actual;
8040     } else {
8041         return needed/100 == actual/100 && (needed <= actual);
8042     }
8043 }
8044
8045 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8046         int flags)
8047 {
8048     int intVersion;
8049     /* Check if the version format is ok */
8050     if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8051         return JIM_ERR;
8052     /* If the package was already provided returns an error. */
8053     if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8054         if (flags & JIM_ERRMSG) {
8055             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8056             Jim_AppendStrings(interp, Jim_GetResult(interp),
8057                     "package '", name, "' was already provided", NULL);
8058         }
8059         return JIM_ERR;
8060     }
8061     Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8062     return JIM_OK;
8063 }
8064
8065 #ifndef JIM_ANSIC
8066
8067 #ifndef WIN32
8068 # include <sys/types.h>
8069 # include <dirent.h>
8070 #else
8071 # include <io.h>
8072 /* Posix dirent.h compatiblity layer for WIN32.
8073  * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8074  * Copyright Salvatore Sanfilippo ,2005.
8075  *
8076  * Permission to use, copy, modify, and distribute this software and its
8077  * documentation for any purpose is hereby granted without fee, provided
8078  * that this copyright and permissions notice appear in all copies and
8079  * derivatives.
8080  *
8081  * This software is supplied "as is" without express or implied warranty.
8082  * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8083  */
8084
8085 struct dirent {
8086     char *d_name;
8087 };
8088
8089 typedef struct DIR {
8090     long                handle; /* -1 for failed rewind */
8091     struct _finddata_t  info;
8092     struct dirent       result; /* d_name null iff first time */
8093     char                *name;  /* null-terminated char string */
8094 } DIR;
8095
8096 DIR *opendir(const char *name)
8097 {
8098     DIR *dir = 0;
8099
8100     if(name && name[0]) {
8101         size_t base_length = strlen(name);
8102         const char *all = /* search pattern must end with suitable wildcard */
8103             strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8104
8105         if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8106            (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8107         {
8108             strcat(strcpy(dir->name, name), all);
8109
8110             if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8111                 dir->result.d_name = 0;
8112             else { /* rollback */
8113                 Jim_Free(dir->name);
8114                 Jim_Free(dir);
8115                 dir = 0;
8116             }
8117         } else { /* rollback */
8118             Jim_Free(dir);
8119             dir   = 0;
8120             errno = ENOMEM;
8121         }
8122     } else {
8123         errno = EINVAL;
8124     }
8125     return dir;
8126 }
8127
8128 int closedir(DIR *dir)
8129 {
8130     int result = -1;
8131
8132     if(dir) {
8133         if(dir->handle != -1)
8134             result = _findclose(dir->handle);
8135         Jim_Free(dir->name);
8136         Jim_Free(dir);
8137     }
8138     if(result == -1) /* map all errors to EBADF */
8139         errno = EBADF;
8140     return result;
8141 }
8142
8143 struct dirent *readdir(DIR *dir)
8144 {
8145     struct dirent *result = 0;
8146
8147     if(dir && dir->handle != -1) {
8148         if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8149             result         = &dir->result;
8150             result->d_name = dir->info.name;
8151         }
8152     } else {
8153         errno = EBADF;
8154     }
8155     return result;
8156 }
8157
8158 #endif /* WIN32 */
8159
8160 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8161         int prefixc, const char *pkgName, int pkgVer, int flags)
8162 {
8163     int bestVer = -1, i;
8164     int pkgNameLen = strlen(pkgName);
8165     char *bestPackage = NULL;
8166     struct dirent *de;
8167
8168     for (i = 0; i < prefixc; i++) {
8169         DIR *dir;
8170         char buf[JIM_PATH_LEN];
8171         int prefixLen;
8172
8173         if (prefixes[i] == NULL) continue;
8174         strncpy(buf, prefixes[i], JIM_PATH_LEN);
8175         buf[JIM_PATH_LEN-1] = '\0';
8176         prefixLen = strlen(buf);
8177         if (prefixLen && buf[prefixLen-1] == '/')
8178             buf[prefixLen-1] = '\0';
8179
8180         if ((dir = opendir(buf)) == NULL) continue;
8181         while ((de = readdir(dir)) != NULL) {
8182             char *fileName = de->d_name;
8183             int fileNameLen = strlen(fileName);
8184
8185             if (strncmp(fileName, "jim-", 4) == 0 &&
8186                 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8187                 *(fileName+4+pkgNameLen) == '-' &&
8188                 fileNameLen > 4 && /* note that this is not really useful */
8189                 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8190                  strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8191                  strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8192             {
8193                 char ver[6]; /* xx.yy<nulterm> */
8194                 char *p = strrchr(fileName, '.');
8195                 int verLen, fileVer;
8196
8197                 verLen = p - (fileName+4+pkgNameLen+1);
8198                 if (verLen < 3 || verLen > 5) continue;
8199                 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8200                 ver[verLen] = '\0';
8201                 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8202                         != JIM_OK) continue;
8203                 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8204                     (bestVer == -1 || bestVer < fileVer))
8205                 {
8206                     bestVer = fileVer;
8207                     Jim_Free(bestPackage);
8208                     bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8209                     sprintf(bestPackage, "%s/%s", buf, fileName);
8210                 }
8211             }
8212         }
8213         closedir(dir);
8214     }
8215     return bestPackage;
8216 }
8217
8218 #else /* JIM_ANSIC */
8219
8220 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8221         int prefixc, const char *pkgName, int pkgVer, int flags)
8222 {
8223     JIM_NOTUSED(interp);
8224     JIM_NOTUSED(prefixes);
8225     JIM_NOTUSED(prefixc);
8226     JIM_NOTUSED(pkgName);
8227     JIM_NOTUSED(pkgVer);
8228     JIM_NOTUSED(flags);
8229     return NULL;
8230 }
8231
8232 #endif /* JIM_ANSIC */
8233
8234 /* Search for a suitable package under every dir specified by jim_libpath
8235  * and load it if possible. If a suitable package was loaded with success
8236  * JIM_OK is returned, otherwise JIM_ERR is returned. */
8237 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8238         int flags)
8239 {
8240     Jim_Obj *libPathObjPtr;
8241     char **prefixes, *best;
8242     int prefixc, i, retCode = JIM_OK;
8243
8244     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8245     if (libPathObjPtr == NULL) {
8246         prefixc = 0;
8247         libPathObjPtr = NULL;
8248     } else {
8249         Jim_IncrRefCount(libPathObjPtr);
8250         Jim_ListLength(interp, libPathObjPtr, &prefixc);
8251     }
8252
8253     prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8254     for (i = 0; i < prefixc; i++) {
8255             Jim_Obj *prefixObjPtr;
8256             if (Jim_ListIndex(interp, libPathObjPtr, i,
8257                     &prefixObjPtr, JIM_NONE) != JIM_OK)
8258             {
8259                 prefixes[i] = NULL;
8260                 continue;
8261             }
8262             prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8263     }
8264     /* Scan every directory to find the "best" package. */
8265     best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8266     if (best != NULL) {
8267         char *p = strrchr(best, '.');
8268         /* Try to load/source it */
8269         if (p && strcmp(p, ".tcl") == 0) {
8270             retCode = Jim_EvalFile(interp, best);
8271         } else {
8272             retCode = Jim_LoadLibrary(interp, best);
8273         }
8274     } else {
8275         retCode = JIM_ERR;
8276     }
8277     Jim_Free(best);
8278     for (i = 0; i < prefixc; i++)
8279         Jim_Free(prefixes[i]);
8280     Jim_Free(prefixes);
8281     if (libPathObjPtr)
8282         Jim_DecrRefCount(interp, libPathObjPtr);
8283     return retCode;
8284 }
8285
8286 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8287         const char *ver, int flags)
8288 {
8289     Jim_HashEntry *he;
8290     int requiredVer;
8291
8292     /* Start with an empty error string */
8293     Jim_SetResultString(interp, "", 0);
8294
8295     if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8296         return NULL;
8297     he = Jim_FindHashEntry(&interp->packages, name);
8298     if (he == NULL) {
8299         /* Try to load the package. */
8300         if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8301             he = Jim_FindHashEntry(&interp->packages, name);
8302             if (he == NULL) {
8303                 return "?";
8304             }
8305             return he->val;
8306         }
8307         /* No way... return an error. */
8308         if (flags & JIM_ERRMSG) {
8309             int len;
8310             Jim_GetString(Jim_GetResult(interp), &len);
8311             Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8312                     "Can't find package '", name, "'", NULL);
8313         }
8314         return NULL;
8315     } else {
8316         int actualVer;
8317         if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8318                 != JIM_OK)
8319         {
8320             return NULL;
8321         }
8322         /* Check if version matches. */
8323         if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8324             Jim_AppendStrings(interp, Jim_GetResult(interp),
8325                     "Package '", name, "' already loaded, but with version ",
8326                     he->val, NULL);
8327             return NULL;
8328         }
8329         return he->val;
8330     }
8331 }
8332
8333 /* -----------------------------------------------------------------------------
8334  * Eval
8335  * ---------------------------------------------------------------------------*/
8336 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8337 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8338
8339 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8340         Jim_Obj *const *argv);
8341
8342 /* Handle calls to the [unknown] command */
8343 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8344 {
8345     Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8346     int retCode;
8347
8348     /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8349      * done here
8350      */
8351     if (interp->unknown_called) {
8352         return JIM_ERR;
8353     }
8354
8355     /* If the [unknown] command does not exists returns
8356      * just now */
8357     if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8358         return JIM_ERR;
8359
8360     /* The object interp->unknown just contains
8361      * the "unknown" string, it is used in order to
8362      * avoid to lookup the unknown command every time
8363      * but instread to cache the result. */
8364     if (argc+1 <= JIM_EVAL_SARGV_LEN)
8365         v = sv;
8366     else
8367         v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8368     /* Make a copy of the arguments vector, but shifted on
8369      * the right of one position. The command name of the
8370      * command will be instead the first argument of the
8371      * [unknonw] call. */
8372     memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8373     v[0] = interp->unknown;
8374     /* Call it */
8375     interp->unknown_called++;
8376     retCode = Jim_EvalObjVector(interp, argc+1, v);
8377     interp->unknown_called--;
8378
8379     /* Clean up */
8380     if (v != sv)
8381         Jim_Free(v);
8382     return retCode;
8383 }
8384
8385 /* Eval the object vector 'objv' composed of 'objc' elements.
8386  * Every element is used as single argument.
8387  * Jim_EvalObj() will call this function every time its object
8388  * argument is of "list" type, with no string representation.
8389  *
8390  * This is possible because the string representation of a
8391  * list object generated by the UpdateStringOfList is made
8392  * in a way that ensures that every list element is a different
8393  * command argument. */
8394 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8395 {
8396     int i, retcode;
8397     Jim_Cmd *cmdPtr;
8398
8399     /* Incr refcount of arguments. */
8400     for (i = 0; i < objc; i++)
8401         Jim_IncrRefCount(objv[i]);
8402     /* Command lookup */
8403     cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8404     if (cmdPtr == NULL) {
8405         retcode = JimUnknown(interp, objc, objv);
8406     } else {
8407         /* Call it -- Make sure result is an empty object. */
8408         Jim_SetEmptyResult(interp);
8409         if (cmdPtr->cmdProc) {
8410             interp->cmdPrivData = cmdPtr->privData;
8411             retcode = cmdPtr->cmdProc(interp, objc, objv);
8412             if (retcode == JIM_ERR_ADDSTACK) {
8413                 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8414                 retcode = JIM_ERR;
8415             }
8416         } else {
8417             retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8418             if (retcode == JIM_ERR) {
8419                 JimAppendStackTrace(interp,
8420                     Jim_GetString(objv[0], NULL), "", 1);
8421             }
8422         }
8423     }
8424     /* Decr refcount of arguments and return the retcode */
8425     for (i = 0; i < objc; i++)
8426         Jim_DecrRefCount(interp, objv[i]);
8427     return retcode;
8428 }
8429
8430 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8431  * via *objPtrPtr. This function is only called by Jim_EvalObj().
8432  * The returned object has refcount = 0. */
8433 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8434         int tokens, Jim_Obj **objPtrPtr)
8435 {
8436     int totlen = 0, i, retcode;
8437     Jim_Obj **intv;
8438     Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8439     Jim_Obj *objPtr;
8440     char *s;
8441
8442     if (tokens <= JIM_EVAL_SINTV_LEN)
8443         intv = sintv;
8444     else
8445         intv = Jim_Alloc(sizeof(Jim_Obj*)*
8446                 tokens);
8447     /* Compute every token forming the argument
8448      * in the intv objects vector. */
8449     for (i = 0; i < tokens; i++) {
8450         switch(token[i].type) {
8451         case JIM_TT_ESC:
8452         case JIM_TT_STR:
8453             intv[i] = token[i].objPtr;
8454             break;
8455         case JIM_TT_VAR:
8456             intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8457             if (!intv[i]) {
8458                 retcode = JIM_ERR;
8459                 goto err;
8460             }
8461             break;
8462         case JIM_TT_DICTSUGAR:
8463             intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8464             if (!intv[i]) {
8465                 retcode = JIM_ERR;
8466                 goto err;
8467             }
8468             break;
8469         case JIM_TT_CMD:
8470             retcode = Jim_EvalObj(interp, token[i].objPtr);
8471             if (retcode != JIM_OK)
8472                 goto err;
8473             intv[i] = Jim_GetResult(interp);
8474             break;
8475         default:
8476             Jim_Panic(interp,
8477               "default token type reached "
8478               "in Jim_InterpolateTokens().");
8479             break;
8480         }
8481         Jim_IncrRefCount(intv[i]);
8482         /* Make sure there is a valid
8483          * string rep, and add the string
8484          * length to the total legnth. */
8485         Jim_GetString(intv[i], NULL);
8486         totlen += intv[i]->length;
8487     }
8488     /* Concatenate every token in an unique
8489      * object. */
8490     objPtr = Jim_NewStringObjNoAlloc(interp,
8491             NULL, 0);
8492     s = objPtr->bytes = Jim_Alloc(totlen+1);
8493     objPtr->length = totlen;
8494     for (i = 0; i < tokens; i++) {
8495         memcpy(s, intv[i]->bytes, intv[i]->length);
8496         s += intv[i]->length;
8497         Jim_DecrRefCount(interp, intv[i]);
8498     }
8499     objPtr->bytes[totlen] = '\0';
8500     /* Free the intv vector if not static. */
8501     if (tokens > JIM_EVAL_SINTV_LEN)
8502         Jim_Free(intv);
8503     *objPtrPtr = objPtr;
8504     return JIM_OK;
8505 err:
8506     i--;
8507     for (; i >= 0; i--)
8508         Jim_DecrRefCount(interp, intv[i]);
8509     if (tokens > JIM_EVAL_SINTV_LEN)
8510         Jim_Free(intv);
8511     return retcode;
8512 }
8513
8514 /* Helper of Jim_EvalObj() to perform argument expansion.
8515  * Basically this function append an argument to 'argv'
8516  * (and increments argc by reference accordingly), performing
8517  * expansion of the list object if 'expand' is non-zero, or
8518  * just adding objPtr to argv if 'expand' is zero. */
8519 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8520         int *argcPtr, int expand, Jim_Obj *objPtr)
8521 {
8522     if (!expand) {
8523         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8524         /* refcount of objPtr not incremented because
8525          * we are actually transfering a reference from
8526          * the old 'argv' to the expanded one. */
8527         (*argv)[*argcPtr] = objPtr;
8528         (*argcPtr)++;
8529     } else {
8530         int len, i;
8531
8532         Jim_ListLength(interp, objPtr, &len);
8533         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8534         for (i = 0; i < len; i++) {
8535             (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8536             Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8537             (*argcPtr)++;
8538         }
8539         /* The original object reference is no longer needed,
8540          * after the expansion it is no longer present on
8541          * the argument vector, but the single elements are
8542          * in its place. */
8543         Jim_DecrRefCount(interp, objPtr);
8544     }
8545 }
8546
8547 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8548 {
8549     int i, j = 0, len;
8550     ScriptObj *script;
8551     ScriptToken *token;
8552     int *cs; /* command structure array */
8553     int retcode = JIM_OK;
8554     Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8555
8556     interp->errorFlag = 0;
8557
8558     /* If the object is of type "list" and there is no
8559      * string representation for this object, we can call
8560      * a specialized version of Jim_EvalObj() */
8561     if (scriptObjPtr->typePtr == &listObjType &&
8562         scriptObjPtr->internalRep.listValue.len &&
8563         scriptObjPtr->bytes == NULL) {
8564         Jim_IncrRefCount(scriptObjPtr);
8565         retcode = Jim_EvalObjVector(interp,
8566                 scriptObjPtr->internalRep.listValue.len,
8567                 scriptObjPtr->internalRep.listValue.ele);
8568         Jim_DecrRefCount(interp, scriptObjPtr);
8569         return retcode;
8570     }
8571
8572     Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8573     script = Jim_GetScript(interp, scriptObjPtr);
8574     /* Now we have to make sure the internal repr will not be
8575      * freed on shimmering.
8576      *
8577      * Think for example to this:
8578      *
8579      * set x {llength $x; ... some more code ...}; eval $x
8580      *
8581      * In order to preserve the internal rep, we increment the
8582      * inUse field of the script internal rep structure. */
8583     script->inUse++;
8584
8585     token = script->token;
8586     len = script->len;
8587     cs = script->cmdStruct;
8588     i = 0; /* 'i' is the current token index. */
8589
8590     /* Reset the interpreter result. This is useful to
8591      * return the emtpy result in the case of empty program. */
8592     Jim_SetEmptyResult(interp);
8593
8594     /* Execute every command sequentially, returns on
8595      * error (i.e. if a command does not return JIM_OK) */
8596     while (i < len) {
8597         int expand = 0;
8598         int argc = *cs++; /* Get the number of arguments */
8599         Jim_Cmd *cmd;
8600
8601         /* Set the expand flag if needed. */
8602         if (argc == -1) {
8603             expand++;
8604             argc = *cs++;
8605         }
8606         /* Allocate the arguments vector */
8607         if (argc <= JIM_EVAL_SARGV_LEN)
8608             argv = sargv;
8609         else
8610             argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8611         /* Populate the arguments objects. */
8612         for (j = 0; j < argc; j++) {
8613             int tokens = *cs++;
8614
8615             /* tokens is negative if expansion is needed.
8616              * for this argument. */
8617             if (tokens < 0) {
8618                 tokens = (-tokens)-1;
8619                 i++;
8620             }
8621             if (tokens == 1) {
8622                 /* Fast path if the token does not
8623                  * need interpolation */
8624                 switch(token[i].type) {
8625                 case JIM_TT_ESC:
8626                 case JIM_TT_STR:
8627                     argv[j] = token[i].objPtr;
8628                     break;
8629                 case JIM_TT_VAR:
8630                     tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8631                             JIM_ERRMSG);
8632                     if (!tmpObjPtr) {
8633                         retcode = JIM_ERR;
8634                         goto err;
8635                     }
8636                     argv[j] = tmpObjPtr;
8637                     break;
8638                 case JIM_TT_DICTSUGAR:
8639                     tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8640                     if (!tmpObjPtr) {
8641                         retcode = JIM_ERR;
8642                         goto err;
8643                     }
8644                     argv[j] = tmpObjPtr;
8645                     break;
8646                 case JIM_TT_CMD:
8647                     retcode = Jim_EvalObj(interp, token[i].objPtr);
8648                     if (retcode != JIM_OK)
8649                         goto err;
8650                     argv[j] = Jim_GetResult(interp);
8651                     break;
8652                 default:
8653                     Jim_Panic(interp,
8654                       "default token type reached "
8655                       "in Jim_EvalObj().");
8656                     break;
8657                 }
8658                 Jim_IncrRefCount(argv[j]);
8659                 i += 2;
8660             } else {
8661                 /* For interpolation we call an helper
8662                  * function doing the work for us. */
8663                 if ((retcode = Jim_InterpolateTokens(interp,
8664                         token+i, tokens, &tmpObjPtr)) != JIM_OK)
8665                 {
8666                     goto err;
8667                 }
8668                 argv[j] = tmpObjPtr;
8669                 Jim_IncrRefCount(argv[j]);
8670                 i += tokens+1;
8671             }
8672         }
8673         /* Handle {expand} expansion */
8674         if (expand) {
8675             int *ecs = cs - argc;
8676             int eargc = 0;
8677             Jim_Obj **eargv = NULL;
8678
8679             for (j = 0; j < argc; j++) {
8680                 Jim_ExpandArgument( interp, &eargv, &eargc,
8681                         ecs[j] < 0, argv[j]);
8682             }
8683             if (argv != sargv)
8684                 Jim_Free(argv);
8685             argc = eargc;
8686             argv = eargv;
8687             j = argc;
8688             if (argc == 0) {
8689                 /* Nothing to do with zero args. */
8690                 Jim_Free(eargv);
8691                 continue;
8692             }
8693         }
8694         /* Lookup the command to call */
8695         cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8696         if (cmd != NULL) {
8697             /* Call it -- Make sure result is an empty object. */
8698             Jim_SetEmptyResult(interp);
8699             if (cmd->cmdProc) {
8700                 interp->cmdPrivData = cmd->privData;
8701                 retcode = cmd->cmdProc(interp, argc, argv);
8702                 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8703                     JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8704                     retcode = JIM_ERR;
8705                 }
8706             } else {
8707                 retcode = JimCallProcedure(interp, cmd, argc, argv);
8708                 if (retcode == JIM_ERR) {
8709                     JimAppendStackTrace(interp,
8710                         Jim_GetString(argv[0], NULL), script->fileName,
8711                         token[i-argc*2].linenr);
8712                 }
8713             }
8714         } else {
8715             /* Call [unknown] */
8716             retcode = JimUnknown(interp, argc, argv);
8717             if (retcode == JIM_ERR) {
8718                 JimAppendStackTrace(interp,
8719                     "", script->fileName,
8720                     token[i-argc*2].linenr);
8721             }
8722         }
8723         if (retcode != JIM_OK) {
8724             i -= argc*2; /* point to the command name. */
8725             goto err;
8726         }
8727         /* Decrement the arguments count */
8728         for (j = 0; j < argc; j++) {
8729             Jim_DecrRefCount(interp, argv[j]);
8730         }
8731
8732         if (argv != sargv) {
8733             Jim_Free(argv);
8734             argv = NULL;
8735         }
8736     }
8737     /* Note that we don't have to decrement inUse, because the
8738      * following code transfers our use of the reference again to
8739      * the script object. */
8740     j = 0; /* on normal termination, the argv array is already
8741           Jim_DecrRefCount-ed. */
8742 err:
8743     /* Handle errors. */
8744     if (retcode == JIM_ERR && !interp->errorFlag) {
8745         interp->errorFlag = 1;
8746         JimSetErrorFileName(interp, script->fileName);
8747         JimSetErrorLineNumber(interp, token[i].linenr);
8748         JimResetStackTrace(interp);
8749     }
8750     Jim_FreeIntRep(interp, scriptObjPtr);
8751     scriptObjPtr->typePtr = &scriptObjType;
8752     Jim_SetIntRepPtr(scriptObjPtr, script);
8753     Jim_DecrRefCount(interp, scriptObjPtr);
8754     for (i = 0; i < j; i++) {
8755         Jim_DecrRefCount(interp, argv[i]);
8756     }
8757     if (argv != sargv)
8758         Jim_Free(argv);
8759     return retcode;
8760 }
8761
8762 /* Call a procedure implemented in Tcl.
8763  * It's possible to speed-up a lot this function, currently
8764  * the callframes are not cached, but allocated and
8765  * destroied every time. What is expecially costly is
8766  * to create/destroy the local vars hash table every time.
8767  *
8768  * This can be fixed just implementing callframes caching
8769  * in JimCreateCallFrame() and JimFreeCallFrame(). */
8770 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8771         Jim_Obj *const *argv)
8772 {
8773     int i, retcode;
8774     Jim_CallFrame *callFramePtr;
8775     int num_args;
8776
8777     /* Check arity */
8778     if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8779         argc > cmd->arityMax)) {
8780         Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8781         Jim_AppendStrings(interp, objPtr,
8782             "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8783             (cmd->arityMin > 1) ? " " : "",
8784             Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8785         Jim_SetResult(interp, objPtr);
8786         return JIM_ERR;
8787     }
8788     /* Check if there are too nested calls */
8789     if (interp->numLevels == interp->maxNestingDepth) {
8790         Jim_SetResultString(interp,
8791             "Too many nested calls. Infinite recursion?", -1);
8792         return JIM_ERR;
8793     }
8794     /* Create a new callframe */
8795     callFramePtr = JimCreateCallFrame(interp);
8796     callFramePtr->parentCallFrame = interp->framePtr;
8797     callFramePtr->argv = argv;
8798     callFramePtr->argc = argc;
8799     callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8800     callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8801     callFramePtr->staticVars = cmd->staticVars;
8802     Jim_IncrRefCount(cmd->argListObjPtr);
8803     Jim_IncrRefCount(cmd->bodyObjPtr);
8804     interp->framePtr = callFramePtr;
8805     interp->numLevels ++;
8806
8807     /* Set arguments */
8808     Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8809
8810     /* If last argument is 'args', don't set it here */
8811     if (cmd->arityMax == -1) {
8812         num_args--;
8813     }
8814
8815     for (i = 0; i < num_args; i++) {
8816         Jim_Obj *argObjPtr;
8817         Jim_Obj *nameObjPtr;
8818         Jim_Obj *valueObjPtr;
8819
8820         Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8821         if (i + 1 >= cmd->arityMin) {
8822             /* The name is the first element of the list */
8823             Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8824         }
8825         else {
8826             /* The element arg is the name */
8827             nameObjPtr = argObjPtr;
8828         }
8829
8830         if (i + 1 >= argc) {
8831             /* No more values, so use default */
8832             /* The value is the second element of the list */
8833             Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8834         }
8835         else {
8836             valueObjPtr = argv[i+1];
8837         }
8838         Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8839     }
8840     /* Set optional arguments */
8841     if (cmd->arityMax == -1) {
8842         Jim_Obj *listObjPtr, *objPtr;
8843
8844         i++;
8845         listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8846         Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8847         Jim_SetVariable(interp, objPtr, listObjPtr);
8848     }
8849     /* Eval the body */
8850     retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8851
8852     /* Destroy the callframe */
8853     interp->numLevels --;
8854     interp->framePtr = interp->framePtr->parentCallFrame;
8855     if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8856         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8857     } else {
8858         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8859     }
8860     /* Handle the JIM_EVAL return code */
8861     if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8862         int savedLevel = interp->evalRetcodeLevel;
8863
8864         interp->evalRetcodeLevel = interp->numLevels;
8865         while (retcode == JIM_EVAL) {
8866             Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8867             Jim_IncrRefCount(resultScriptObjPtr);
8868             retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8869             Jim_DecrRefCount(interp, resultScriptObjPtr);
8870         }
8871         interp->evalRetcodeLevel = savedLevel;
8872     }
8873     /* Handle the JIM_RETURN return code */
8874     if (retcode == JIM_RETURN) {
8875         retcode = interp->returnCode;
8876         interp->returnCode = JIM_OK;
8877     }
8878     return retcode;
8879 }
8880
8881 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8882 {
8883     int retval;
8884     Jim_Obj *scriptObjPtr;
8885
8886         scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8887     Jim_IncrRefCount(scriptObjPtr);
8888
8889
8890         if( filename ){
8891                 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8892         }
8893
8894     retval = Jim_EvalObj(interp, scriptObjPtr);
8895     Jim_DecrRefCount(interp, scriptObjPtr);
8896     return retval;
8897 }
8898
8899 int Jim_Eval(Jim_Interp *interp, const char *script)
8900 {
8901         return Jim_Eval_Named( interp, script, NULL, 0 );
8902 }
8903
8904
8905
8906 /* Execute script in the scope of the global level */
8907 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8908 {
8909     Jim_CallFrame *savedFramePtr;
8910     int retval;
8911
8912     savedFramePtr = interp->framePtr;
8913     interp->framePtr = interp->topFramePtr;
8914     retval = Jim_Eval(interp, script);
8915     interp->framePtr = savedFramePtr;
8916     return retval;
8917 }
8918
8919 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8920 {
8921     Jim_CallFrame *savedFramePtr;
8922     int retval;
8923
8924     savedFramePtr = interp->framePtr;
8925     interp->framePtr = interp->topFramePtr;
8926     retval = Jim_EvalObj(interp, scriptObjPtr);
8927     interp->framePtr = savedFramePtr;
8928     /* Try to report the error (if any) via the bgerror proc */
8929     if (retval != JIM_OK) {
8930         Jim_Obj *objv[2];
8931
8932         objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8933         objv[1] = Jim_GetResult(interp);
8934         Jim_IncrRefCount(objv[0]);
8935         Jim_IncrRefCount(objv[1]);
8936         if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8937             /* Report the error to stderr. */
8938             Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8939             Jim_PrintErrorMessage(interp);
8940         }
8941         Jim_DecrRefCount(interp, objv[0]);
8942         Jim_DecrRefCount(interp, objv[1]);
8943     }
8944     return retval;
8945 }
8946
8947 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8948 {
8949     char *prg = NULL;
8950     FILE *fp;
8951     int nread, totread, maxlen, buflen;
8952     int retval;
8953     Jim_Obj *scriptObjPtr;
8954     
8955     if ((fp = fopen(filename, "r")) == NULL) {
8956         const int cwd_len=2048;
8957                 char *cwd=malloc(cwd_len);
8958         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8959         if (!getcwd( cwd, cwd_len )) strcpy(cwd, "unknown");
8960         Jim_AppendStrings(interp, Jim_GetResult(interp),
8961         "Error loading script \"", filename, "\"",
8962             " cwd: ", cwd,
8963             " err: ", strerror(errno), NULL);
8964             free(cwd);
8965         return JIM_ERR;
8966     }
8967     buflen = 1024;
8968     maxlen = totread = 0;
8969     while (1) {
8970         if (maxlen < totread+buflen+1) {
8971             maxlen = totread+buflen+1;
8972             prg = Jim_Realloc(prg, maxlen);
8973         }
8974                 /* do not use Jim_fread() - this is really a file */
8975         if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8976         totread += nread;
8977     }
8978     prg[totread] = '\0';
8979         /* do not use Jim_fclose() - this is really a file */
8980     fclose(fp);
8981
8982     scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8983     JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8984     Jim_IncrRefCount(scriptObjPtr);
8985     retval = Jim_EvalObj(interp, scriptObjPtr);
8986     Jim_DecrRefCount(interp, scriptObjPtr);
8987     return retval;
8988 }
8989
8990 /* -----------------------------------------------------------------------------
8991  * Subst
8992  * ---------------------------------------------------------------------------*/
8993 static int JimParseSubstStr(struct JimParserCtx *pc)
8994 {
8995     pc->tstart = pc->p;
8996     pc->tline = pc->linenr;
8997     while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8998         pc->p++; pc->len--;
8999     }
9000     pc->tend = pc->p-1;
9001     pc->tt = JIM_TT_ESC;
9002     return JIM_OK;
9003 }
9004
9005 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9006 {
9007     int retval;
9008
9009     if (pc->len == 0) {
9010         pc->tstart = pc->tend = pc->p;
9011         pc->tline = pc->linenr;
9012         pc->tt = JIM_TT_EOL;
9013         pc->eof = 1;
9014         return JIM_OK;
9015     }
9016     switch(*pc->p) {
9017     case '[':
9018         retval = JimParseCmd(pc);
9019         if (flags & JIM_SUBST_NOCMD) {
9020             pc->tstart--;
9021             pc->tend++;
9022             pc->tt = (flags & JIM_SUBST_NOESC) ?
9023                 JIM_TT_STR : JIM_TT_ESC;
9024         }
9025         return retval;
9026         break;
9027     case '$':
9028         if (JimParseVar(pc) == JIM_ERR) {
9029             pc->tstart = pc->tend = pc->p++; pc->len--;
9030             pc->tline = pc->linenr;
9031             pc->tt = JIM_TT_STR;
9032         } else {
9033             if (flags & JIM_SUBST_NOVAR) {
9034                 pc->tstart--;
9035                 if (flags & JIM_SUBST_NOESC)
9036                     pc->tt = JIM_TT_STR;
9037                 else
9038                     pc->tt = JIM_TT_ESC;
9039                 if (*pc->tstart == '{') {
9040                     pc->tstart--;
9041                     if (*(pc->tend+1))
9042                         pc->tend++;
9043                 }
9044             }
9045         }
9046         break;
9047     default:
9048         retval = JimParseSubstStr(pc);
9049         if (flags & JIM_SUBST_NOESC)
9050             pc->tt = JIM_TT_STR;
9051         return retval;
9052         break;
9053     }
9054     return JIM_OK;
9055 }
9056
9057 /* The subst object type reuses most of the data structures and functions
9058  * of the script object. Script's data structures are a bit more complex
9059  * for what is needed for [subst]itution tasks, but the reuse helps to
9060  * deal with a single data structure at the cost of some more memory
9061  * usage for substitutions. */
9062 static Jim_ObjType substObjType = {
9063     "subst",
9064     FreeScriptInternalRep,
9065     DupScriptInternalRep,
9066     NULL,
9067     JIM_TYPE_REFERENCES,
9068 };
9069
9070 /* This method takes the string representation of an object
9071  * as a Tcl string where to perform [subst]itution, and generates
9072  * the pre-parsed internal representation. */
9073 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9074 {
9075     int scriptTextLen;
9076     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9077     struct JimParserCtx parser;
9078     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9079
9080     script->len = 0;
9081     script->csLen = 0;
9082     script->commands = 0;
9083     script->token = NULL;
9084     script->cmdStruct = NULL;
9085     script->inUse = 1;
9086     script->substFlags = flags;
9087     script->fileName = NULL;
9088
9089     JimParserInit(&parser, scriptText, scriptTextLen, 1);
9090     while(1) {
9091         char *token;
9092         int len, type, linenr;
9093
9094         JimParseSubst(&parser, flags);
9095         if (JimParserEof(&parser)) break;
9096         token = JimParserGetToken(&parser, &len, &type, &linenr);
9097         ScriptObjAddToken(interp, script, token, len, type,
9098                 NULL, linenr);
9099     }
9100     /* Free the old internal rep and set the new one. */
9101     Jim_FreeIntRep(interp, objPtr);
9102     Jim_SetIntRepPtr(objPtr, script);
9103     objPtr->typePtr = &scriptObjType;
9104     return JIM_OK;
9105 }
9106
9107 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9108 {
9109     struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9110
9111     if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9112         SetSubstFromAny(interp, objPtr, flags);
9113     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9114 }
9115
9116 /* Performs commands,variables,blackslashes substitution,
9117  * storing the result object (with refcount 0) into
9118  * resObjPtrPtr. */
9119 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9120         Jim_Obj **resObjPtrPtr, int flags)
9121 {
9122     ScriptObj *script;
9123     ScriptToken *token;
9124     int i, len, retcode = JIM_OK;
9125     Jim_Obj *resObjPtr, *savedResultObjPtr;
9126
9127     script = Jim_GetSubst(interp, substObjPtr, flags);
9128 #ifdef JIM_OPTIMIZATION
9129     /* Fast path for a very common case with array-alike syntax,
9130      * that's: $foo($bar) */
9131     if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9132         Jim_Obj *varObjPtr = script->token[0].objPtr;
9133         
9134         Jim_IncrRefCount(varObjPtr);
9135         resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9136         if (resObjPtr == NULL) {
9137             Jim_DecrRefCount(interp, varObjPtr);
9138             return JIM_ERR;
9139         }
9140         Jim_DecrRefCount(interp, varObjPtr);
9141         *resObjPtrPtr = resObjPtr;
9142         return JIM_OK;
9143     }
9144 #endif
9145
9146     Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9147     /* In order to preserve the internal rep, we increment the
9148      * inUse field of the script internal rep structure. */
9149     script->inUse++;
9150
9151     token = script->token;
9152     len = script->len;
9153
9154     /* Save the interp old result, to set it again before
9155      * to return. */
9156     savedResultObjPtr = interp->result;
9157     Jim_IncrRefCount(savedResultObjPtr);
9158     
9159     /* Perform the substitution. Starts with an empty object
9160      * and adds every token (performing the appropriate
9161      * var/command/escape substitution). */
9162     resObjPtr = Jim_NewStringObj(interp, "", 0);
9163     for (i = 0; i < len; i++) {
9164         Jim_Obj *objPtr;
9165
9166         switch(token[i].type) {
9167         case JIM_TT_STR:
9168         case JIM_TT_ESC:
9169             Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9170             break;
9171         case JIM_TT_VAR:
9172             objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9173             if (objPtr == NULL) goto err;
9174             Jim_IncrRefCount(objPtr);
9175             Jim_AppendObj(interp, resObjPtr, objPtr);
9176             Jim_DecrRefCount(interp, objPtr);
9177             break;
9178         case JIM_TT_DICTSUGAR:
9179             objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9180             if (!objPtr) {
9181                 retcode = JIM_ERR;
9182                 goto err;
9183             }
9184             break;
9185         case JIM_TT_CMD:
9186             if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9187                 goto err;
9188             Jim_AppendObj(interp, resObjPtr, interp->result);
9189             break;
9190         default:
9191             Jim_Panic(interp,
9192               "default token type (%d) reached "
9193               "in Jim_SubstObj().", token[i].type);
9194             break;
9195         }
9196     }
9197 ok:
9198     if (retcode == JIM_OK)
9199         Jim_SetResult(interp, savedResultObjPtr);
9200     Jim_DecrRefCount(interp, savedResultObjPtr);
9201     /* Note that we don't have to decrement inUse, because the
9202      * following code transfers our use of the reference again to
9203      * the script object. */
9204     Jim_FreeIntRep(interp, substObjPtr);
9205     substObjPtr->typePtr = &scriptObjType;
9206     Jim_SetIntRepPtr(substObjPtr, script);
9207     Jim_DecrRefCount(interp, substObjPtr);
9208     *resObjPtrPtr = resObjPtr;
9209     return retcode;
9210 err:
9211     Jim_FreeNewObj(interp, resObjPtr);
9212     retcode = JIM_ERR;
9213     goto ok;
9214 }
9215
9216 /* -----------------------------------------------------------------------------
9217  * API Input/Export functions
9218  * ---------------------------------------------------------------------------*/
9219
9220 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9221 {
9222     Jim_HashEntry *he;
9223
9224     he = Jim_FindHashEntry(&interp->stub, funcname);
9225     if (!he)
9226         return JIM_ERR;
9227     memcpy(targetPtrPtr, &he->val, sizeof(void*));
9228     return JIM_OK;
9229 }
9230
9231 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9232 {
9233     return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9234 }
9235
9236 #define JIM_REGISTER_API(name) \
9237     Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9238
9239 void JimRegisterCoreApi(Jim_Interp *interp)
9240 {
9241   interp->getApiFuncPtr = Jim_GetApi;
9242   JIM_REGISTER_API(Alloc);
9243   JIM_REGISTER_API(Free);
9244   JIM_REGISTER_API(Eval);
9245   JIM_REGISTER_API(Eval_Named);
9246   JIM_REGISTER_API(EvalGlobal);
9247   JIM_REGISTER_API(EvalFile);
9248   JIM_REGISTER_API(EvalObj);
9249   JIM_REGISTER_API(EvalObjBackground);
9250   JIM_REGISTER_API(EvalObjVector);
9251   JIM_REGISTER_API(InitHashTable);
9252   JIM_REGISTER_API(ExpandHashTable);
9253   JIM_REGISTER_API(AddHashEntry);
9254   JIM_REGISTER_API(ReplaceHashEntry);
9255   JIM_REGISTER_API(DeleteHashEntry);
9256   JIM_REGISTER_API(FreeHashTable);
9257   JIM_REGISTER_API(FindHashEntry);
9258   JIM_REGISTER_API(ResizeHashTable);
9259   JIM_REGISTER_API(GetHashTableIterator);
9260   JIM_REGISTER_API(NextHashEntry);
9261   JIM_REGISTER_API(NewObj);
9262   JIM_REGISTER_API(FreeObj);
9263   JIM_REGISTER_API(InvalidateStringRep);
9264   JIM_REGISTER_API(InitStringRep);
9265   JIM_REGISTER_API(DuplicateObj);
9266   JIM_REGISTER_API(GetString);
9267   JIM_REGISTER_API(Length);
9268   JIM_REGISTER_API(InvalidateStringRep);
9269   JIM_REGISTER_API(NewStringObj);
9270   JIM_REGISTER_API(NewStringObjNoAlloc);
9271   JIM_REGISTER_API(AppendString);
9272   JIM_REGISTER_API(AppendString_sprintf);
9273   JIM_REGISTER_API(AppendObj);
9274   JIM_REGISTER_API(AppendStrings);
9275   JIM_REGISTER_API(StringEqObj);
9276   JIM_REGISTER_API(StringMatchObj);
9277   JIM_REGISTER_API(StringRangeObj);
9278   JIM_REGISTER_API(FormatString);
9279   JIM_REGISTER_API(CompareStringImmediate);
9280   JIM_REGISTER_API(NewReference);
9281   JIM_REGISTER_API(GetReference);
9282   JIM_REGISTER_API(SetFinalizer);
9283   JIM_REGISTER_API(GetFinalizer);
9284   JIM_REGISTER_API(CreateInterp);
9285   JIM_REGISTER_API(FreeInterp);
9286   JIM_REGISTER_API(GetExitCode);
9287   JIM_REGISTER_API(SetStdin);
9288   JIM_REGISTER_API(SetStdout);
9289   JIM_REGISTER_API(SetStderr);
9290   JIM_REGISTER_API(CreateCommand);
9291   JIM_REGISTER_API(CreateProcedure);
9292   JIM_REGISTER_API(DeleteCommand);
9293   JIM_REGISTER_API(RenameCommand);
9294   JIM_REGISTER_API(GetCommand);
9295   JIM_REGISTER_API(SetVariable);
9296   JIM_REGISTER_API(SetVariableStr);
9297   JIM_REGISTER_API(SetGlobalVariableStr);
9298   JIM_REGISTER_API(SetVariableStrWithStr);
9299   JIM_REGISTER_API(SetVariableLink);
9300   JIM_REGISTER_API(GetVariable);
9301   JIM_REGISTER_API(GetCallFrameByLevel);
9302   JIM_REGISTER_API(Collect);
9303   JIM_REGISTER_API(CollectIfNeeded);
9304   JIM_REGISTER_API(GetIndex);
9305   JIM_REGISTER_API(NewListObj);
9306   JIM_REGISTER_API(ListAppendElement);
9307   JIM_REGISTER_API(ListAppendList);
9308   JIM_REGISTER_API(ListLength);
9309   JIM_REGISTER_API(ListIndex);
9310   JIM_REGISTER_API(SetListIndex);
9311   JIM_REGISTER_API(ConcatObj);
9312   JIM_REGISTER_API(NewDictObj);
9313   JIM_REGISTER_API(DictKey);
9314   JIM_REGISTER_API(DictKeysVector);
9315   JIM_REGISTER_API(GetIndex);
9316   JIM_REGISTER_API(GetReturnCode);
9317   JIM_REGISTER_API(EvalExpression);
9318   JIM_REGISTER_API(GetBoolFromExpr);
9319   JIM_REGISTER_API(GetWide);
9320   JIM_REGISTER_API(GetLong);
9321   JIM_REGISTER_API(SetWide);
9322   JIM_REGISTER_API(NewIntObj);
9323   JIM_REGISTER_API(GetDouble);
9324   JIM_REGISTER_API(SetDouble);
9325   JIM_REGISTER_API(NewDoubleObj);
9326   JIM_REGISTER_API(WrongNumArgs);
9327   JIM_REGISTER_API(SetDictKeysVector);
9328   JIM_REGISTER_API(SubstObj);
9329   JIM_REGISTER_API(RegisterApi);
9330   JIM_REGISTER_API(PrintErrorMessage);
9331   JIM_REGISTER_API(InteractivePrompt);
9332   JIM_REGISTER_API(RegisterCoreCommands);
9333   JIM_REGISTER_API(GetSharedString);
9334   JIM_REGISTER_API(ReleaseSharedString);
9335   JIM_REGISTER_API(Panic);
9336   JIM_REGISTER_API(StrDup);
9337   JIM_REGISTER_API(UnsetVariable);
9338   JIM_REGISTER_API(GetVariableStr);
9339   JIM_REGISTER_API(GetGlobalVariable);
9340   JIM_REGISTER_API(GetGlobalVariableStr);
9341   JIM_REGISTER_API(GetAssocData);
9342   JIM_REGISTER_API(SetAssocData);
9343   JIM_REGISTER_API(DeleteAssocData);
9344   JIM_REGISTER_API(GetEnum);
9345   JIM_REGISTER_API(ScriptIsComplete);
9346   JIM_REGISTER_API(PackageRequire);
9347   JIM_REGISTER_API(PackageProvide);
9348   JIM_REGISTER_API(InitStack);
9349   JIM_REGISTER_API(FreeStack);
9350   JIM_REGISTER_API(StackLen);
9351   JIM_REGISTER_API(StackPush);
9352   JIM_REGISTER_API(StackPop);
9353   JIM_REGISTER_API(StackPeek);
9354   JIM_REGISTER_API(FreeStackElements);
9355   JIM_REGISTER_API(fprintf  );
9356   JIM_REGISTER_API(vfprintf );
9357   JIM_REGISTER_API(fwrite   );
9358   JIM_REGISTER_API(fread    );
9359   JIM_REGISTER_API(fflush   );
9360   JIM_REGISTER_API(fgets    );
9361   JIM_REGISTER_API(GetNvp);
9362   JIM_REGISTER_API(Nvp_name2value);
9363   JIM_REGISTER_API(Nvp_name2value_simple);
9364   JIM_REGISTER_API(Nvp_name2value_obj);
9365   JIM_REGISTER_API(Nvp_name2value_nocase);
9366   JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9367
9368   JIM_REGISTER_API(Nvp_value2name);
9369   JIM_REGISTER_API(Nvp_value2name_simple);
9370   JIM_REGISTER_API(Nvp_value2name_obj);
9371
9372   JIM_REGISTER_API(GetOpt_Setup);
9373   JIM_REGISTER_API(GetOpt_Debug);
9374   JIM_REGISTER_API(GetOpt_Obj);
9375   JIM_REGISTER_API(GetOpt_String);
9376   JIM_REGISTER_API(GetOpt_Double);
9377   JIM_REGISTER_API(GetOpt_Wide);
9378   JIM_REGISTER_API(GetOpt_Nvp);
9379   JIM_REGISTER_API(GetOpt_NvpUnknown);
9380   JIM_REGISTER_API(GetOpt_Enum);
9381   
9382   JIM_REGISTER_API(Debug_ArgvString);
9383   JIM_REGISTER_API(SetResult_sprintf);
9384   JIM_REGISTER_API(SetResult_NvpUnknown);
9385
9386 }
9387
9388 /* -----------------------------------------------------------------------------
9389  * Core commands utility functions
9390  * ---------------------------------------------------------------------------*/
9391 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, 
9392         const char *msg)
9393 {
9394     int i;
9395     Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9396
9397     Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9398     for (i = 0; i < argc; i++) {
9399         Jim_AppendObj(interp, objPtr, argv[i]);
9400         if (!(i+1 == argc && msg[0] == '\0'))
9401             Jim_AppendString(interp, objPtr, " ", 1);
9402     }
9403     Jim_AppendString(interp, objPtr, msg, -1);
9404     Jim_AppendString(interp, objPtr, "\"", 1);
9405     Jim_SetResult(interp, objPtr);
9406 }
9407
9408 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9409 {
9410     Jim_HashTableIterator *htiter;
9411     Jim_HashEntry *he;
9412     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9413     const char *pattern;
9414     int patternLen;
9415     
9416     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9417     htiter = Jim_GetHashTableIterator(&interp->commands);
9418     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9419         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9420                     strlen((const char*)he->key), 0))
9421             continue;
9422         Jim_ListAppendElement(interp, listObjPtr,
9423                 Jim_NewStringObj(interp, he->key, -1));
9424     }
9425     Jim_FreeHashTableIterator(htiter);
9426     return listObjPtr;
9427 }
9428
9429 #define JIM_VARLIST_GLOBALS 0
9430 #define JIM_VARLIST_LOCALS 1
9431 #define JIM_VARLIST_VARS 2
9432
9433 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9434         int mode)
9435 {
9436     Jim_HashTableIterator *htiter;
9437     Jim_HashEntry *he;
9438     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9439     const char *pattern;
9440     int patternLen;
9441     
9442     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9443     if (mode == JIM_VARLIST_GLOBALS) {
9444         htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9445     } else {
9446         /* For [info locals], if we are at top level an emtpy list
9447          * is returned. I don't agree, but we aim at compatibility (SS) */
9448         if (mode == JIM_VARLIST_LOCALS &&
9449             interp->framePtr == interp->topFramePtr)
9450             return listObjPtr;
9451         htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9452     }
9453     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9454         Jim_Var *varPtr = (Jim_Var*) he->val;
9455         if (mode == JIM_VARLIST_LOCALS) {
9456             if (varPtr->linkFramePtr != NULL)
9457                 continue;
9458         }
9459         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9460                     strlen((const char*)he->key), 0))
9461             continue;
9462         Jim_ListAppendElement(interp, listObjPtr,
9463                 Jim_NewStringObj(interp, he->key, -1));
9464     }
9465     Jim_FreeHashTableIterator(htiter);
9466     return listObjPtr;
9467 }
9468
9469 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9470         Jim_Obj **objPtrPtr)
9471 {
9472     Jim_CallFrame *targetCallFrame;
9473
9474     if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9475             != JIM_OK)
9476         return JIM_ERR;
9477     /* No proc call at toplevel callframe */
9478     if (targetCallFrame == interp->topFramePtr) {
9479         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9480         Jim_AppendStrings(interp, Jim_GetResult(interp),
9481                 "bad level \"",
9482                 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9483         return JIM_ERR;
9484     }
9485     *objPtrPtr = Jim_NewListObj(interp,
9486             targetCallFrame->argv,
9487             targetCallFrame->argc);
9488     return JIM_OK;
9489 }
9490
9491 /* -----------------------------------------------------------------------------
9492  * Core commands
9493  * ---------------------------------------------------------------------------*/
9494
9495 /* fake [puts] -- not the real puts, just for debugging. */
9496 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9497         Jim_Obj *const *argv)
9498 {
9499     const char *str;
9500     int len, nonewline = 0;
9501     
9502     if (argc != 2 && argc != 3) {
9503         Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9504         return JIM_ERR;
9505     }
9506     if (argc == 3) {
9507         if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9508         {
9509             Jim_SetResultString(interp, "The second argument must "
9510                     "be -nonewline", -1);
9511             return JIM_OK;
9512         } else {
9513             nonewline = 1;
9514             argv++;
9515         }
9516     }
9517     str = Jim_GetString(argv[1], &len);
9518     Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9519     if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9520     return JIM_OK;
9521 }
9522
9523 /* Helper for [+] and [*] */
9524 static int Jim_AddMulHelper(Jim_Interp *interp, int argc, 
9525         Jim_Obj *const *argv, int op)
9526 {
9527     jim_wide wideValue, res;
9528     double doubleValue, doubleRes;
9529     int i;
9530
9531     res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9532     
9533     for (i = 1; i < argc; i++) {
9534         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9535             goto trydouble;
9536         if (op == JIM_EXPROP_ADD)
9537             res += wideValue;
9538         else
9539             res *= wideValue;
9540     }
9541     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9542     return JIM_OK;
9543 trydouble:
9544     doubleRes = (double) res;
9545     for (;i < argc; i++) {
9546         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9547             return JIM_ERR;
9548         if (op == JIM_EXPROP_ADD)
9549             doubleRes += doubleValue;
9550         else
9551             doubleRes *= doubleValue;
9552     }
9553     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9554     return JIM_OK;
9555 }
9556
9557 /* Helper for [-] and [/] */
9558 static int Jim_SubDivHelper(Jim_Interp *interp, int argc, 
9559         Jim_Obj *const *argv, int op)
9560 {
9561     jim_wide wideValue, res = 0;
9562     double doubleValue, doubleRes = 0;
9563     int i = 2;
9564
9565     if (argc < 2) {
9566         Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9567         return JIM_ERR;
9568     } else if (argc == 2) {
9569         /* The arity = 2 case is different. For [- x] returns -x,
9570          * while [/ x] returns 1/x. */
9571         if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9572             if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9573                     JIM_OK)
9574             {
9575                 return JIM_ERR;
9576             } else {
9577                 if (op == JIM_EXPROP_SUB)
9578                     doubleRes = -doubleValue;
9579                 else
9580                     doubleRes = 1.0/doubleValue;
9581                 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9582                             doubleRes));
9583                 return JIM_OK;
9584             }
9585         }
9586         if (op == JIM_EXPROP_SUB) {
9587             res = -wideValue;
9588             Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9589         } else {
9590             doubleRes = 1.0/wideValue;
9591             Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9592                         doubleRes));
9593         }
9594         return JIM_OK;
9595     } else {
9596         if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9597             if (Jim_GetDouble(interp, argv[1], &doubleRes)
9598                     != JIM_OK) {
9599                 return JIM_ERR;
9600             } else {
9601                 goto trydouble;
9602             }
9603         }
9604     }
9605     for (i = 2; i < argc; i++) {
9606         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9607             doubleRes = (double) res;
9608             goto trydouble;
9609         }
9610         if (op == JIM_EXPROP_SUB)
9611             res -= wideValue;
9612         else
9613             res /= wideValue;
9614     }
9615     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9616     return JIM_OK;
9617 trydouble:
9618     for (;i < argc; i++) {
9619         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9620             return JIM_ERR;
9621         if (op == JIM_EXPROP_SUB)
9622             doubleRes -= doubleValue;
9623         else
9624             doubleRes /= doubleValue;
9625     }
9626     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9627     return JIM_OK;
9628 }
9629
9630
9631 /* [+] */
9632 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9633         Jim_Obj *const *argv)
9634 {
9635     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9636 }
9637
9638 /* [*] */
9639 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9640         Jim_Obj *const *argv)
9641 {
9642     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9643 }
9644
9645 /* [-] */
9646 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9647         Jim_Obj *const *argv)
9648 {
9649     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9650 }
9651
9652 /* [/] */
9653 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9654         Jim_Obj *const *argv)
9655 {
9656     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9657 }
9658
9659 /* [set] */
9660 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9661         Jim_Obj *const *argv)
9662 {
9663     if (argc != 2 && argc != 3) {
9664         Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9665         return JIM_ERR;
9666     }
9667     if (argc == 2) {
9668         Jim_Obj *objPtr;
9669         objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9670         if (!objPtr)
9671             return JIM_ERR;
9672         Jim_SetResult(interp, objPtr);
9673         return JIM_OK;
9674     }
9675     /* argc == 3 case. */
9676     if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9677         return JIM_ERR;
9678     Jim_SetResult(interp, argv[2]);
9679     return JIM_OK;
9680 }
9681
9682 /* [unset] */
9683 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, 
9684         Jim_Obj *const *argv)
9685 {
9686     int i;
9687
9688     if (argc < 2) {
9689         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9690         return JIM_ERR;
9691     }
9692     for (i = 1; i < argc; i++) {
9693         if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9694             return JIM_ERR;
9695     }
9696     return JIM_OK;
9697 }
9698
9699 /* [incr] */
9700 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, 
9701         Jim_Obj *const *argv)
9702 {
9703     jim_wide wideValue, increment = 1;
9704     Jim_Obj *intObjPtr;
9705
9706     if (argc != 2 && argc != 3) {
9707         Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9708         return JIM_ERR;
9709     }
9710     if (argc == 3) {
9711         if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9712             return JIM_ERR;
9713     }
9714     intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9715     if (!intObjPtr) return JIM_ERR;
9716     if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9717         return JIM_ERR;
9718     if (Jim_IsShared(intObjPtr)) {
9719         intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9720         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9721             Jim_FreeNewObj(interp, intObjPtr);
9722             return JIM_ERR;
9723         }
9724     } else {
9725         Jim_SetWide(interp, intObjPtr, wideValue+increment);
9726         /* The following step is required in order to invalidate the
9727          * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9728         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9729             return JIM_ERR;
9730         }
9731     }
9732     Jim_SetResult(interp, intObjPtr);
9733     return JIM_OK;
9734 }
9735
9736 /* [while] */
9737 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, 
9738         Jim_Obj *const *argv)
9739 {
9740     if (argc != 3) {
9741         Jim_WrongNumArgs(interp, 1, argv, "condition body");
9742         return JIM_ERR;
9743     }
9744     /* Try to run a specialized version of while if the expression
9745      * is in one of the following forms:
9746      *
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
9752      *   $a == CONST, $a == $b
9753      *   $a
9754      *   !$a
9755      *   CONST
9756      */
9757
9758 #ifdef JIM_OPTIMIZATION
9759     {
9760         ExprByteCode *expr;
9761         Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9762         int exprLen, retval;
9763
9764         /* STEP 1 -- Check if there are the conditions to run the specialized
9765          * version of while */
9766         
9767         if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9768         if (expr->len <= 0 || expr->len > 3) goto noopt;
9769         switch(expr->len) {
9770         case 1:
9771             if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9772                 expr->opcode[0] != JIM_EXPROP_NUMBER)
9773                 goto noopt;
9774             break;
9775         case 2:
9776             if (expr->opcode[1] != JIM_EXPROP_NOT ||
9777                 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9778                 goto noopt;
9779             break;
9780         case 3:
9781             if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9782                 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9783                  expr->opcode[1] != JIM_EXPROP_VARIABLE))
9784                 goto noopt;
9785             switch(expr->opcode[2]) {
9786             case JIM_EXPROP_LT:
9787             case JIM_EXPROP_LTE:
9788             case JIM_EXPROP_GT:
9789             case JIM_EXPROP_GTE:
9790             case JIM_EXPROP_NUMEQ:
9791             case JIM_EXPROP_NUMNE:
9792                 /* nothing to do */
9793                 break;
9794             default:
9795                 goto noopt;
9796             }
9797             break;
9798         default:
9799             Jim_Panic(interp,
9800                 "Unexpected default reached in Jim_WhileCoreCommand()");
9801             break;
9802         }
9803
9804         /* STEP 2 -- conditions meet. Initialization. Take different
9805          * branches for different expression lengths. */
9806         exprLen = expr->len;
9807
9808         if (exprLen == 1) {
9809             jim_wide wideValue;
9810
9811             if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9812                 varAObjPtr = expr->obj[0];
9813                 Jim_IncrRefCount(varAObjPtr);
9814             } else {
9815                 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9816                     goto noopt;
9817             }
9818             while (1) {
9819                 if (varAObjPtr) {
9820                     if (!(objPtr =
9821                                Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9822                         Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9823                     {
9824                         Jim_DecrRefCount(interp, varAObjPtr);
9825                         goto noopt;
9826                     }
9827                 }
9828                 if (!wideValue) break;
9829                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9830                     switch(retval) {
9831                     case JIM_BREAK:
9832                         if (varAObjPtr)
9833                             Jim_DecrRefCount(interp, varAObjPtr);
9834                         goto out;
9835                         break;
9836                     case JIM_CONTINUE:
9837                         continue;
9838                         break;
9839                     default:
9840                         if (varAObjPtr)
9841                             Jim_DecrRefCount(interp, varAObjPtr);
9842                         return retval;
9843                     }
9844                 }
9845             }
9846             if (varAObjPtr)
9847                 Jim_DecrRefCount(interp, varAObjPtr);
9848         } else if (exprLen == 3) {
9849             jim_wide wideValueA, wideValueB, cmpRes = 0;
9850             int cmpType = expr->opcode[2];
9851
9852             varAObjPtr = expr->obj[0];
9853             Jim_IncrRefCount(varAObjPtr);
9854             if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9855                 varBObjPtr = expr->obj[1];
9856                 Jim_IncrRefCount(varBObjPtr);
9857             } else {
9858                 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9859                     goto noopt;
9860             }
9861             while (1) {
9862                 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9863                     Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9864                 {
9865                     Jim_DecrRefCount(interp, varAObjPtr);
9866                     if (varBObjPtr)
9867                         Jim_DecrRefCount(interp, varBObjPtr);
9868                     goto noopt;
9869                 }
9870                 if (varBObjPtr) {
9871                     if (!(objPtr =
9872                                Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9873                         Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9874                     {
9875                         Jim_DecrRefCount(interp, varAObjPtr);
9876                         if (varBObjPtr)
9877                             Jim_DecrRefCount(interp, varBObjPtr);
9878                         goto noopt;
9879                     }
9880                 }
9881                 switch(cmpType) {
9882                 case JIM_EXPROP_LT:
9883                     cmpRes = wideValueA < wideValueB; break;
9884                 case JIM_EXPROP_LTE:
9885                     cmpRes = wideValueA <= wideValueB; break;
9886                 case JIM_EXPROP_GT:
9887                     cmpRes = wideValueA > wideValueB; break;
9888                 case JIM_EXPROP_GTE:
9889                     cmpRes = wideValueA >= wideValueB; break;
9890                 case JIM_EXPROP_NUMEQ:
9891                     cmpRes = wideValueA == wideValueB; break;
9892                 case JIM_EXPROP_NUMNE:
9893                     cmpRes = wideValueA != wideValueB; break;
9894                 }
9895                 if (!cmpRes) break;
9896                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9897                     switch(retval) {
9898                     case JIM_BREAK:
9899                         Jim_DecrRefCount(interp, varAObjPtr);
9900                         if (varBObjPtr)
9901                             Jim_DecrRefCount(interp, varBObjPtr);
9902                         goto out;
9903                         break;
9904                     case JIM_CONTINUE:
9905                         continue;
9906                         break;
9907                     default:
9908                         Jim_DecrRefCount(interp, varAObjPtr);
9909                         if (varBObjPtr)
9910                             Jim_DecrRefCount(interp, varBObjPtr);
9911                         return retval;
9912                     }
9913                 }
9914             }
9915             Jim_DecrRefCount(interp, varAObjPtr);
9916             if (varBObjPtr)
9917                 Jim_DecrRefCount(interp, varBObjPtr);
9918         } else {
9919             /* TODO: case for len == 2 */
9920             goto noopt;
9921         }
9922         Jim_SetEmptyResult(interp);
9923         return JIM_OK;
9924     }
9925 noopt:
9926 #endif
9927
9928     /* The general purpose implementation of while starts here */
9929     while (1) {
9930         int boolean, retval;
9931
9932         if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9933                         &boolean)) != JIM_OK)
9934             return retval;
9935         if (!boolean) break;
9936         if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9937             switch(retval) {
9938             case JIM_BREAK:
9939                 goto out;
9940                 break;
9941             case JIM_CONTINUE:
9942                 continue;
9943                 break;
9944             default:
9945                 return retval;
9946             }
9947         }
9948     }
9949 out:
9950     Jim_SetEmptyResult(interp);
9951     return JIM_OK;
9952 }
9953
9954 /* [for] */
9955 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, 
9956         Jim_Obj *const *argv)
9957 {
9958     int retval;
9959
9960     if (argc != 5) {
9961         Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9962         return JIM_ERR;
9963     }
9964     /* Check if the for is on the form:
9965      *      for {set i CONST} {$i < CONST} {incr i}
9966      *      for {set i CONST} {$i < $j} {incr i}
9967      *      for {set i CONST} {$i <= CONST} {incr i}
9968      *      for {set i CONST} {$i <= $j} {incr i}
9969      * XXX: NOTE: if variable traces are implemented, this optimization
9970      * need to be modified to check for the proc epoch at every variable
9971      * update. */
9972 #ifdef JIM_OPTIMIZATION
9973     {
9974         ScriptObj *initScript, *incrScript;
9975         ExprByteCode *expr;
9976         jim_wide start, stop, currentVal;
9977         unsigned jim_wide procEpoch = interp->procEpoch;
9978         Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9979         int cmpType;
9980         struct Jim_Cmd *cmdPtr;
9981
9982         /* Do it only if there aren't shared arguments */
9983         if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9984             goto evalstart;
9985         initScript = Jim_GetScript(interp, argv[1]);
9986         expr = Jim_GetExpression(interp, argv[2]);
9987         incrScript = Jim_GetScript(interp, argv[3]);
9988
9989         /* Ensure proper lengths to start */
9990         if (initScript->len != 6) goto evalstart;
9991         if (incrScript->len != 4) goto evalstart;
9992         if (expr->len != 3) goto evalstart;
9993         /* Ensure proper token types. */
9994         if (initScript->token[2].type != JIM_TT_ESC ||
9995             initScript->token[4].type != JIM_TT_ESC ||
9996             incrScript->token[2].type != JIM_TT_ESC ||
9997             expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9998             (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9999              expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10000             (expr->opcode[2] != JIM_EXPROP_LT &&
10001              expr->opcode[2] != JIM_EXPROP_LTE))
10002             goto evalstart;
10003         cmpType = expr->opcode[2];
10004         /* Initialization command must be [set] */
10005         cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10006         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10007             goto evalstart;
10008         /* Update command must be incr */
10009         cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10010         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10011             goto evalstart;
10012         /* set, incr, expression must be about the same variable */
10013         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10014                             incrScript->token[2].objPtr, 0))
10015             goto evalstart;
10016         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10017                             expr->obj[0], 0))
10018             goto evalstart;
10019         /* Check that the initialization and comparison are valid integers */
10020         if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10021             goto evalstart;
10022         if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10023             Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10024         {
10025             goto evalstart;
10026         }
10027
10028         /* Initialization */
10029         varNamePtr = expr->obj[0];
10030         if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10031             stopVarNamePtr = expr->obj[1];
10032             Jim_IncrRefCount(stopVarNamePtr);
10033         }
10034         Jim_IncrRefCount(varNamePtr);
10035
10036         /* --- OPTIMIZED FOR --- */
10037         /* Start to loop */
10038         objPtr = Jim_NewIntObj(interp, start);
10039         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10040             Jim_DecrRefCount(interp, varNamePtr);
10041             if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10042             Jim_FreeNewObj(interp, objPtr);
10043             goto evalstart;
10044         }
10045         while (1) {
10046             /* === Check condition === */
10047             /* Common code: */
10048             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10049             if (objPtr == NULL ||
10050                 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10051             {
10052                 Jim_DecrRefCount(interp, varNamePtr);
10053                 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10054                 goto testcond;
10055             }
10056             /* Immediate or Variable? get the 'stop' value if the latter. */
10057             if (stopVarNamePtr) {
10058                 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10059                 if (objPtr == NULL ||
10060                     Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10061                 {
10062                     Jim_DecrRefCount(interp, varNamePtr);
10063                     Jim_DecrRefCount(interp, stopVarNamePtr);
10064                     goto testcond;
10065                 }
10066             }
10067             if (cmpType == JIM_EXPROP_LT) {
10068                 if (currentVal >= stop) break;
10069             } else {
10070                 if (currentVal > stop) break;
10071             }
10072             /* Eval body */
10073             if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10074                 switch(retval) {
10075                 case JIM_BREAK:
10076                     if (stopVarNamePtr)
10077                         Jim_DecrRefCount(interp, stopVarNamePtr);
10078                     Jim_DecrRefCount(interp, varNamePtr);
10079                     goto out;
10080                 case JIM_CONTINUE:
10081                     /* nothing to do */
10082                     break;
10083                 default:
10084                     if (stopVarNamePtr)
10085                         Jim_DecrRefCount(interp, stopVarNamePtr);
10086                     Jim_DecrRefCount(interp, varNamePtr);
10087                     return retval;
10088                 }
10089             }
10090             /* If there was a change in procedures/command continue
10091              * with the usual [for] command implementation */
10092             if (procEpoch != interp->procEpoch) {
10093                 if (stopVarNamePtr)
10094                     Jim_DecrRefCount(interp, stopVarNamePtr);
10095                 Jim_DecrRefCount(interp, varNamePtr);
10096                 goto evalnext;
10097             }
10098             /* Increment */
10099             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10100             if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10101                 objPtr->internalRep.wideValue ++;
10102                 Jim_InvalidateStringRep(objPtr);
10103             } else {
10104                 Jim_Obj *auxObjPtr;
10105
10106                 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10107                     if (stopVarNamePtr)
10108                         Jim_DecrRefCount(interp, stopVarNamePtr);
10109                     Jim_DecrRefCount(interp, varNamePtr);
10110                     goto evalnext;
10111                 }
10112                 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10113                 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10114                     if (stopVarNamePtr)
10115                         Jim_DecrRefCount(interp, stopVarNamePtr);
10116                     Jim_DecrRefCount(interp, varNamePtr);
10117                     Jim_FreeNewObj(interp, auxObjPtr);
10118                     goto evalnext;
10119                 }
10120             }
10121         }
10122         if (stopVarNamePtr)
10123             Jim_DecrRefCount(interp, stopVarNamePtr);
10124         Jim_DecrRefCount(interp, varNamePtr);
10125         Jim_SetEmptyResult(interp);
10126         return JIM_OK;
10127     }
10128 #endif
10129 evalstart:
10130     /* Eval start */
10131     if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10132         return retval;
10133     while (1) {
10134         int boolean;
10135 testcond:
10136         /* Test the condition */
10137         if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10138                 != JIM_OK)
10139             return retval;
10140         if (!boolean) break;
10141         /* Eval body */
10142         if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10143             switch(retval) {
10144             case JIM_BREAK:
10145                 goto out;
10146                 break;
10147             case JIM_CONTINUE:
10148                 /* Nothing to do */
10149                 break;
10150             default:
10151                 return retval;
10152             }
10153         }
10154 evalnext:
10155         /* Eval next */
10156         if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10157             switch(retval) {
10158             case JIM_BREAK:
10159                 goto out;
10160                 break;
10161             case JIM_CONTINUE:
10162                 continue;
10163                 break;
10164             default:
10165                 return retval;
10166             }
10167         }
10168     }
10169 out:
10170     Jim_SetEmptyResult(interp);
10171     return JIM_OK;
10172 }
10173
10174 /* foreach + lmap implementation. */
10175 static int JimForeachMapHelper(Jim_Interp *interp, int argc, 
10176         Jim_Obj *const *argv, int doMap)
10177 {
10178     int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10179     int nbrOfLoops = 0;
10180     Jim_Obj *emptyStr, *script, *mapRes = NULL;
10181
10182     if (argc < 4 || argc % 2 != 0) {
10183         Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10184         return JIM_ERR;
10185     }
10186     if (doMap) {
10187         mapRes = Jim_NewListObj(interp, NULL, 0);
10188         Jim_IncrRefCount(mapRes);
10189     }
10190     emptyStr = Jim_NewEmptyStringObj(interp);
10191     Jim_IncrRefCount(emptyStr);
10192     script = argv[argc-1];            /* Last argument is a script */
10193     nbrOfLists = (argc - 1 - 1) / 2;  /* argc - 'foreach' - script */
10194     listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10195     listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10196     /* Initialize iterators and remember max nbr elements each list */
10197     memset(listsIdx, 0, nbrOfLists * sizeof(int));
10198     /* Remember lengths of all lists and calculate how much rounds to loop */
10199     for (i=0; i < nbrOfLists*2; i += 2) {
10200         div_t cnt;
10201         int count;
10202         Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10203         Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10204         if (listsEnd[i] == 0) {
10205             Jim_SetResultString(interp, "foreach varlist is empty", -1);
10206             goto err;
10207         }
10208         cnt = div(listsEnd[i+1], listsEnd[i]);
10209         count = cnt.quot + (cnt.rem ? 1 : 0);
10210         if (count > nbrOfLoops)
10211             nbrOfLoops = count;
10212     }
10213     for (; nbrOfLoops-- > 0; ) {
10214         for (i=0; i < nbrOfLists; ++i) {
10215             int varIdx = 0, var = i * 2;
10216             while (varIdx < listsEnd[var]) {
10217                 Jim_Obj *varName, *ele;
10218                 int lst = i * 2 + 1;
10219                 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10220                         != JIM_OK)
10221                         goto err;
10222                 if (listsIdx[i] < listsEnd[lst]) {
10223                     if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10224                         != JIM_OK)
10225                         goto err;
10226                     if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10227                         Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10228                         goto err;
10229                     }
10230                     ++listsIdx[i];  /* Remember next iterator of current list */ 
10231                 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10232                     Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10233                     goto err;
10234                 }
10235                 ++varIdx;  /* Next variable */
10236             }
10237         }
10238         switch (result = Jim_EvalObj(interp, script)) {
10239             case JIM_OK:
10240                 if (doMap)
10241                     Jim_ListAppendElement(interp, mapRes, interp->result);
10242                 break;
10243             case JIM_CONTINUE:
10244                 break;
10245             case JIM_BREAK:
10246                 goto out;
10247                 break;
10248             default:
10249                 goto err;
10250         }
10251     }
10252 out:
10253     result = JIM_OK;
10254     if (doMap)
10255         Jim_SetResult(interp, mapRes);
10256     else
10257         Jim_SetEmptyResult(interp);
10258 err:
10259     if (doMap)
10260         Jim_DecrRefCount(interp, mapRes);
10261     Jim_DecrRefCount(interp, emptyStr);
10262     Jim_Free(listsIdx);
10263     Jim_Free(listsEnd);
10264     return result;
10265 }
10266
10267 /* [foreach] */
10268 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, 
10269         Jim_Obj *const *argv)
10270 {
10271     return JimForeachMapHelper(interp, argc, argv, 0);
10272 }
10273
10274 /* [lmap] */
10275 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, 
10276         Jim_Obj *const *argv)
10277 {
10278     return JimForeachMapHelper(interp, argc, argv, 1);
10279 }
10280
10281 /* [if] */
10282 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, 
10283         Jim_Obj *const *argv)
10284 {
10285     int boolean, retval, current = 1, falsebody = 0;
10286     if (argc >= 3) {
10287         while (1) {
10288             /* Far not enough arguments given! */
10289             if (current >= argc) goto err;
10290             if ((retval = Jim_GetBoolFromExpr(interp,
10291                         argv[current++], &boolean))
10292                     != JIM_OK)
10293                 return retval;
10294             /* There lacks something, isn't it? */
10295             if (current >= argc) goto err;
10296             if (Jim_CompareStringImmediate(interp, argv[current],
10297                         "then")) current++;
10298             /* Tsk tsk, no then-clause? */
10299             if (current >= argc) goto err;
10300             if (boolean)
10301                 return Jim_EvalObj(interp, argv[current]);
10302              /* Ok: no else-clause follows */
10303             if (++current >= argc) {
10304                 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));                   
10305                 return JIM_OK;
10306             }
10307             falsebody = current++;
10308             if (Jim_CompareStringImmediate(interp, argv[falsebody],
10309                         "else")) {
10310                 /* IIICKS - else-clause isn't last cmd? */
10311                 if (current != argc-1) goto err;
10312                 return Jim_EvalObj(interp, argv[current]);
10313             } else if (Jim_CompareStringImmediate(interp,
10314                         argv[falsebody], "elseif"))
10315                 /* Ok: elseif follows meaning all the stuff
10316                  * again (how boring...) */
10317                 continue;
10318             /* OOPS - else-clause is not last cmd?*/
10319             else if (falsebody != argc-1)
10320                 goto err;
10321             return Jim_EvalObj(interp, argv[falsebody]);
10322         }
10323         return JIM_OK;
10324     }
10325 err:
10326     Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10327     return JIM_ERR;
10328 }
10329
10330 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10331
10332 /* [switch] */
10333 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, 
10334         Jim_Obj *const *argv)
10335 {
10336     int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10337     Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10338     Jim_Obj *script = 0;
10339     if (argc < 3) goto wrongnumargs;
10340     for (opt=1; opt < argc; ++opt) {
10341         const char *option = Jim_GetString(argv[opt], 0);
10342         if (*option != '-') break;
10343         else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10344         else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10345         else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10346         else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10347         else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10348             if ((argc - opt) < 2) goto wrongnumargs;
10349             command = argv[++opt]; 
10350         } else {
10351             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10352             Jim_AppendStrings(interp, Jim_GetResult(interp),
10353                 "bad option \"", option, "\": must be -exact, -glob, "
10354                 "-regexp, -command procname or --", 0);
10355             goto err;            
10356         }
10357         if ((argc - opt) < 2) goto wrongnumargs;
10358     }
10359     strObj = argv[opt++];
10360     patCount = argc - opt;
10361     if (patCount == 1) {
10362         Jim_Obj **vector;
10363         JimListGetElements(interp, argv[opt], &patCount, &vector);
10364         caseList = vector;
10365     } else
10366         caseList = &argv[opt];
10367     if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10368     for (i=0; script == 0 && i < patCount; i += 2) {
10369         Jim_Obj *patObj = caseList[i];
10370         if (!Jim_CompareStringImmediate(interp, patObj, "default")
10371             || i < (patCount-2)) {
10372             switch (matchOpt) {
10373                 case SWITCH_EXACT:
10374                     if (Jim_StringEqObj(strObj, patObj, 0))
10375                         script = caseList[i+1];
10376                     break;
10377                 case SWITCH_GLOB:
10378                     if (Jim_StringMatchObj(patObj, strObj, 0))
10379                         script = caseList[i+1];
10380                     break;
10381                 case SWITCH_RE:
10382                     command = Jim_NewStringObj(interp, "regexp", -1);
10383                     /* Fall thru intentionally */
10384                 case SWITCH_CMD: {
10385                     Jim_Obj *parms[] = {command, patObj, strObj};
10386                     int rc = Jim_EvalObjVector(interp, 3, parms);
10387                     long matching;
10388                     /* After the execution of a command we need to
10389                      * make sure to reconvert the object into a list
10390                      * again. Only for the single-list style [switch]. */
10391                     if (argc-opt == 1) {
10392                         Jim_Obj **vector;
10393                         JimListGetElements(interp, argv[opt], &patCount,
10394                                 &vector);
10395                         caseList = vector;
10396                     }
10397                     /* command is here already decref'd */
10398                     if (rc != JIM_OK) {
10399                         retcode = rc;
10400                         goto err;
10401                     }
10402                     rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10403                     if (rc != JIM_OK) {
10404                         retcode = rc;
10405                         goto err;
10406                     }
10407                     if (matching)
10408                         script = caseList[i+1];
10409                     break;
10410                 }
10411                 default:
10412                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10413                     Jim_AppendStrings(interp, Jim_GetResult(interp),
10414                         "internal error: no such option implemented", 0);
10415                     goto err;
10416             }
10417         } else {
10418           script = caseList[i+1];
10419         }
10420     }
10421     for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10422         i += 2)
10423         script = caseList[i+1];
10424     if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10425         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10426         Jim_AppendStrings(interp, Jim_GetResult(interp),
10427             "no body specified for pattern \"",
10428             Jim_GetString(caseList[i-2], 0), "\"", 0);
10429         goto err;
10430     }
10431     retcode = JIM_OK;
10432     Jim_SetEmptyResult(interp);
10433     if (script != 0)
10434         retcode = Jim_EvalObj(interp, script);
10435     return retcode;
10436 wrongnumargs:
10437     Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10438         "pattern body ... ?default body?   or   "
10439         "{pattern body ?pattern body ...?}");
10440 err:
10441     return retcode;        
10442 }
10443
10444 /* [list] */
10445 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, 
10446         Jim_Obj *const *argv)
10447 {
10448     Jim_Obj *listObjPtr;
10449
10450     listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10451     Jim_SetResult(interp, listObjPtr);
10452     return JIM_OK;
10453 }
10454
10455 /* [lindex] */
10456 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, 
10457         Jim_Obj *const *argv)
10458 {
10459     Jim_Obj *objPtr, *listObjPtr;
10460     int i;
10461     int index;
10462
10463     if (argc < 3) {
10464         Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10465         return JIM_ERR;
10466     }
10467     objPtr = argv[1];
10468     Jim_IncrRefCount(objPtr);
10469     for (i = 2; i < argc; i++) {
10470         listObjPtr = objPtr;
10471         if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10472             Jim_DecrRefCount(interp, listObjPtr);
10473             return JIM_ERR;
10474         }
10475         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10476                     JIM_NONE) != JIM_OK) {
10477             /* Returns an empty object if the index
10478              * is out of range. */
10479             Jim_DecrRefCount(interp, listObjPtr);
10480             Jim_SetEmptyResult(interp);
10481             return JIM_OK;
10482         }
10483         Jim_IncrRefCount(objPtr);
10484         Jim_DecrRefCount(interp, listObjPtr);
10485     }
10486     Jim_SetResult(interp, objPtr);
10487     Jim_DecrRefCount(interp, objPtr);
10488     return JIM_OK;
10489 }
10490
10491 /* [llength] */
10492 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, 
10493         Jim_Obj *const *argv)
10494 {
10495     int len;
10496
10497     if (argc != 2) {
10498         Jim_WrongNumArgs(interp, 1, argv, "list");
10499         return JIM_ERR;
10500     }
10501     Jim_ListLength(interp, argv[1], &len);
10502     Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10503     return JIM_OK;
10504 }
10505
10506 /* [lappend] */
10507 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, 
10508         Jim_Obj *const *argv)
10509 {
10510     Jim_Obj *listObjPtr;
10511     int shared, i;
10512
10513     if (argc < 2) {
10514         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10515         return JIM_ERR;
10516     }
10517     listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10518     if (!listObjPtr) {
10519         /* Create the list if it does not exists */
10520         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10521         if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10522             Jim_FreeNewObj(interp, listObjPtr);
10523             return JIM_ERR;
10524         }
10525     }
10526     shared = Jim_IsShared(listObjPtr);
10527     if (shared)
10528         listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10529     for (i = 2; i < argc; i++)
10530         Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10531     if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10532         if (shared)
10533             Jim_FreeNewObj(interp, listObjPtr);
10534         return JIM_ERR;
10535     }
10536     Jim_SetResult(interp, listObjPtr);
10537     return JIM_OK;
10538 }
10539
10540 /* [linsert] */
10541 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, 
10542         Jim_Obj *const *argv)
10543 {
10544     int index, len;
10545     Jim_Obj *listPtr;
10546
10547     if (argc < 4) {
10548         Jim_WrongNumArgs(interp, 1, argv, "list index element "
10549             "?element ...?");
10550         return JIM_ERR;
10551     }
10552     listPtr = argv[1];
10553     if (Jim_IsShared(listPtr))
10554         listPtr = Jim_DuplicateObj(interp, listPtr);
10555     if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10556         goto err;
10557     Jim_ListLength(interp, listPtr, &len);
10558     if (index >= len)
10559         index = len;
10560     else if (index < 0)
10561         index = len + index + 1;
10562     Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10563     Jim_SetResult(interp, listPtr);
10564     return JIM_OK;
10565 err:
10566     if (listPtr != argv[1]) {
10567         Jim_FreeNewObj(interp, listPtr);
10568     }
10569     return JIM_ERR;
10570 }
10571
10572 /* [lset] */
10573 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, 
10574         Jim_Obj *const *argv)
10575 {
10576     if (argc < 3) {
10577         Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10578         return JIM_ERR;
10579     } else if (argc == 3) {
10580         if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10581             return JIM_ERR;
10582         Jim_SetResult(interp, argv[2]);
10583         return JIM_OK;
10584     }
10585     if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10586             == JIM_ERR) return JIM_ERR;
10587     return JIM_OK;
10588 }
10589
10590 /* [lsort] */
10591 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10592 {
10593     const char *options[] = {
10594         "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10595     };
10596     enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10597     Jim_Obj *resObj;
10598     int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10599     int decreasing = 0;
10600
10601     if (argc < 2) {
10602         Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10603         return JIM_ERR;
10604     }
10605     for (i = 1; i < (argc-1); i++) {
10606         int option;
10607
10608         if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10609                 != JIM_OK)
10610             return JIM_ERR;
10611         switch(option) {
10612         case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10613         case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10614         case OPT_INCREASING: decreasing = 0; break;
10615         case OPT_DECREASING: decreasing = 1; break;
10616         }
10617     }
10618     if (decreasing) {
10619         switch(lsortType) {
10620         case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10621         case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10622         }
10623     }
10624     resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10625     ListSortElements(interp, resObj, lsortType);
10626     Jim_SetResult(interp, resObj);
10627     return JIM_OK;
10628 }
10629
10630 /* [append] */
10631 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, 
10632         Jim_Obj *const *argv)
10633 {
10634     Jim_Obj *stringObjPtr;
10635     int shared, i;
10636
10637     if (argc < 2) {
10638         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10639         return JIM_ERR;
10640     }
10641     if (argc == 2) {
10642         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10643         if (!stringObjPtr) return JIM_ERR;
10644     } else {
10645         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10646         if (!stringObjPtr) {
10647             /* Create the string if it does not exists */
10648             stringObjPtr = Jim_NewEmptyStringObj(interp);
10649             if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10650                     != JIM_OK) {
10651                 Jim_FreeNewObj(interp, stringObjPtr);
10652                 return JIM_ERR;
10653             }
10654         }
10655     }
10656     shared = Jim_IsShared(stringObjPtr);
10657     if (shared)
10658         stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10659     for (i = 2; i < argc; i++)
10660         Jim_AppendObj(interp, stringObjPtr, argv[i]);
10661     if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10662         if (shared)
10663             Jim_FreeNewObj(interp, stringObjPtr);
10664         return JIM_ERR;
10665     }
10666     Jim_SetResult(interp, stringObjPtr);
10667     return JIM_OK;
10668 }
10669
10670 /* [debug] */
10671 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, 
10672         Jim_Obj *const *argv)
10673 {
10674     const char *options[] = {
10675         "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10676         "exprbc",
10677         NULL
10678     };
10679     enum {
10680         OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10681         OPT_EXPRLEN, OPT_EXPRBC
10682     };
10683     int option;
10684
10685     if (argc < 2) {
10686         Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10687         return JIM_ERR;
10688     }
10689     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10690                 JIM_ERRMSG) != JIM_OK)
10691         return JIM_ERR;
10692     if (option == OPT_REFCOUNT) {
10693         if (argc != 3) {
10694             Jim_WrongNumArgs(interp, 2, argv, "object");
10695             return JIM_ERR;
10696         }
10697         Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10698         return JIM_OK;
10699     } else if (option == OPT_OBJCOUNT) {
10700         int freeobj = 0, liveobj = 0;
10701         char buf[256];
10702         Jim_Obj *objPtr;
10703
10704         if (argc != 2) {
10705             Jim_WrongNumArgs(interp, 2, argv, "");
10706             return JIM_ERR;
10707         }
10708         /* Count the number of free objects. */
10709         objPtr = interp->freeList;
10710         while (objPtr) {
10711             freeobj++;
10712             objPtr = objPtr->nextObjPtr;
10713         }
10714         /* Count the number of live objects. */
10715         objPtr = interp->liveList;
10716         while (objPtr) {
10717             liveobj++;
10718             objPtr = objPtr->nextObjPtr;
10719         }
10720         /* Set the result string and return. */
10721         sprintf(buf, "free %d used %d", freeobj, liveobj);
10722         Jim_SetResultString(interp, buf, -1);
10723         return JIM_OK;
10724     } else if (option == OPT_OBJECTS) {
10725         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10726         /* Count the number of live objects. */
10727         objPtr = interp->liveList;
10728         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10729         while (objPtr) {
10730             char buf[128];
10731             const char *type = objPtr->typePtr ?
10732                 objPtr->typePtr->name : "";
10733             subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10734             sprintf(buf, "%p", objPtr);
10735             Jim_ListAppendElement(interp, subListObjPtr,
10736                 Jim_NewStringObj(interp, buf, -1));
10737             Jim_ListAppendElement(interp, subListObjPtr,
10738                 Jim_NewStringObj(interp, type, -1));
10739             Jim_ListAppendElement(interp, subListObjPtr,
10740                 Jim_NewIntObj(interp, objPtr->refCount));
10741             Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10742             Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10743             objPtr = objPtr->nextObjPtr;
10744         }
10745         Jim_SetResult(interp, listObjPtr);
10746         return JIM_OK;
10747     } else if (option == OPT_INVSTR) {
10748         Jim_Obj *objPtr;
10749
10750         if (argc != 3) {
10751             Jim_WrongNumArgs(interp, 2, argv, "object");
10752             return JIM_ERR;
10753         }
10754         objPtr = argv[2];
10755         if (objPtr->typePtr != NULL)
10756             Jim_InvalidateStringRep(objPtr);
10757         Jim_SetEmptyResult(interp);
10758         return JIM_OK;
10759     } else if (option == OPT_SCRIPTLEN) {
10760         ScriptObj *script;
10761         if (argc != 3) {
10762             Jim_WrongNumArgs(interp, 2, argv, "script");
10763             return JIM_ERR;
10764         }
10765         script = Jim_GetScript(interp, argv[2]);
10766         Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10767         return JIM_OK;
10768     } else if (option == OPT_EXPRLEN) {
10769         ExprByteCode *expr;
10770         if (argc != 3) {
10771             Jim_WrongNumArgs(interp, 2, argv, "expression");
10772             return JIM_ERR;
10773         }
10774         expr = Jim_GetExpression(interp, argv[2]);
10775         if (expr == NULL)
10776             return JIM_ERR;
10777         Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10778         return JIM_OK;
10779     } else if (option == OPT_EXPRBC) {
10780         Jim_Obj *objPtr;
10781         ExprByteCode *expr;
10782         int i;
10783
10784         if (argc != 3) {
10785             Jim_WrongNumArgs(interp, 2, argv, "expression");
10786             return JIM_ERR;
10787         }
10788         expr = Jim_GetExpression(interp, argv[2]);
10789         if (expr == NULL)
10790             return JIM_ERR;
10791         objPtr = Jim_NewListObj(interp, NULL, 0);
10792         for (i = 0; i < expr->len; i++) {
10793             const char *type;
10794             Jim_ExprOperator *op;
10795
10796             switch(expr->opcode[i]) {
10797             case JIM_EXPROP_NUMBER: type = "number"; break;
10798             case JIM_EXPROP_COMMAND: type = "command"; break;
10799             case JIM_EXPROP_VARIABLE: type = "variable"; break;
10800             case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10801             case JIM_EXPROP_SUBST: type = "subst"; break;
10802             case JIM_EXPROP_STRING: type = "string"; break;
10803             default:
10804                 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10805                 if (op == NULL) {
10806                     type = "private";
10807                 } else {
10808                     type = "operator";
10809                 }
10810                 break;
10811             }
10812             Jim_ListAppendElement(interp, objPtr,
10813                     Jim_NewStringObj(interp, type, -1));
10814             Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10815         }
10816         Jim_SetResult(interp, objPtr);
10817         return JIM_OK;
10818     } else {
10819         Jim_SetResultString(interp,
10820             "bad option. Valid options are refcount, "
10821             "objcount, objects, invstr", -1);
10822         return JIM_ERR;
10823     }
10824     return JIM_OK; /* unreached */
10825 }
10826
10827 /* [eval] */
10828 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, 
10829         Jim_Obj *const *argv)
10830 {
10831     if (argc == 2) {
10832         return Jim_EvalObj(interp, argv[1]);
10833     } else if (argc > 2) {
10834         Jim_Obj *objPtr;
10835         int retcode;
10836
10837         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10838         Jim_IncrRefCount(objPtr);
10839         retcode = Jim_EvalObj(interp, objPtr);
10840         Jim_DecrRefCount(interp, objPtr);
10841         return retcode;
10842     } else {
10843         Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10844         return JIM_ERR;
10845     }
10846 }
10847
10848 /* [uplevel] */
10849 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, 
10850         Jim_Obj *const *argv)
10851 {
10852     if (argc >= 2) {
10853         int retcode, newLevel, oldLevel;
10854         Jim_CallFrame *savedCallFrame, *targetCallFrame;
10855         Jim_Obj *objPtr;
10856         const char *str;
10857
10858         /* Save the old callframe pointer */
10859         savedCallFrame = interp->framePtr;
10860
10861         /* Lookup the target frame pointer */
10862         str = Jim_GetString(argv[1], NULL);
10863         if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10864         {
10865             if (Jim_GetCallFrameByLevel(interp, argv[1],
10866                         &targetCallFrame,
10867                         &newLevel) != JIM_OK)
10868                 return JIM_ERR;
10869             argc--;
10870             argv++;
10871         } else {
10872             if (Jim_GetCallFrameByLevel(interp, NULL,
10873                         &targetCallFrame,
10874                         &newLevel) != JIM_OK)
10875                 return JIM_ERR;
10876         }
10877         if (argc < 2) {
10878             argc++;
10879             argv--;
10880             Jim_WrongNumArgs(interp, 1, argv,
10881                     "?level? command ?arg ...?");
10882             return JIM_ERR;
10883         }
10884         /* Eval the code in the target callframe. */
10885         interp->framePtr = targetCallFrame;
10886         oldLevel = interp->numLevels;
10887         interp->numLevels = newLevel;
10888         if (argc == 2) {
10889             retcode = Jim_EvalObj(interp, argv[1]);
10890         } else {
10891             objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10892             Jim_IncrRefCount(objPtr);
10893             retcode = Jim_EvalObj(interp, objPtr);
10894             Jim_DecrRefCount(interp, objPtr);
10895         }
10896         interp->numLevels = oldLevel;
10897         interp->framePtr = savedCallFrame;
10898         return retcode;
10899     } else {
10900         Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10901         return JIM_ERR;
10902     }
10903 }
10904
10905 /* [expr] */
10906 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, 
10907         Jim_Obj *const *argv)
10908 {
10909     Jim_Obj *exprResultPtr;
10910     int retcode;
10911
10912     if (argc == 2) {
10913         retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10914     } else if (argc > 2) {
10915         Jim_Obj *objPtr;
10916
10917         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10918         Jim_IncrRefCount(objPtr);
10919         retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10920         Jim_DecrRefCount(interp, objPtr);
10921     } else {
10922         Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10923         return JIM_ERR;
10924     }
10925     if (retcode != JIM_OK) return retcode;
10926     Jim_SetResult(interp, exprResultPtr);
10927     Jim_DecrRefCount(interp, exprResultPtr);
10928     return JIM_OK;
10929 }
10930
10931 /* [break] */
10932 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, 
10933         Jim_Obj *const *argv)
10934 {
10935     if (argc != 1) {
10936         Jim_WrongNumArgs(interp, 1, argv, "");
10937         return JIM_ERR;
10938     }
10939     return JIM_BREAK;
10940 }
10941
10942 /* [continue] */
10943 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10944         Jim_Obj *const *argv)
10945 {
10946     if (argc != 1) {
10947         Jim_WrongNumArgs(interp, 1, argv, "");
10948         return JIM_ERR;
10949     }
10950     return JIM_CONTINUE;
10951 }
10952
10953 /* [return] */
10954 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, 
10955         Jim_Obj *const *argv)
10956 {
10957     if (argc == 1) {
10958         return JIM_RETURN;
10959     } else if (argc == 2) {
10960         Jim_SetResult(interp, argv[1]);
10961         interp->returnCode = JIM_OK;
10962         return JIM_RETURN;
10963     } else if (argc == 3 || argc == 4) {
10964         int returnCode;
10965         if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10966             return JIM_ERR;
10967         interp->returnCode = returnCode;
10968         if (argc == 4)
10969             Jim_SetResult(interp, argv[3]);
10970         return JIM_RETURN;
10971     } else {
10972         Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10973         return JIM_ERR;
10974     }
10975     return JIM_RETURN; /* unreached */
10976 }
10977
10978 /* [tailcall] */
10979 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10980         Jim_Obj *const *argv)
10981 {
10982     Jim_Obj *objPtr;
10983
10984     objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10985     Jim_SetResult(interp, objPtr);
10986     return JIM_EVAL;
10987 }
10988
10989 /* [proc] */
10990 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, 
10991         Jim_Obj *const *argv)
10992 {
10993     int argListLen;
10994     int arityMin, arityMax;
10995
10996     if (argc != 4 && argc != 5) {
10997         Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10998         return JIM_ERR;
10999     }
11000     Jim_ListLength(interp, argv[2], &argListLen);
11001     arityMin = arityMax = argListLen+1;
11002
11003     if (argListLen) {
11004         const char *str;
11005         int len;
11006         Jim_Obj *argPtr;
11007         
11008         /* Check for 'args' and adjust arityMin and arityMax if necessary */
11009         Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11010         str = Jim_GetString(argPtr, &len);
11011         if (len == 4 && memcmp(str, "args", 4) == 0) {
11012             arityMin--;
11013             arityMax = -1;
11014         }
11015
11016         /* Check for default arguments and reduce arityMin if necessary */
11017         while (arityMin > 1) {
11018             int len;
11019             Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11020             Jim_ListLength(interp, argPtr, &len);
11021             if (len != 2) {
11022                 /* No default argument */
11023                 break;
11024             }
11025             arityMin--;
11026         }
11027     }
11028     if (argc == 4) {
11029         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11030                 argv[2], NULL, argv[3], arityMin, arityMax);
11031     } else {
11032         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11033                 argv[2], argv[3], argv[4], arityMin, arityMax);
11034     }
11035 }
11036
11037 /* [concat] */
11038 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, 
11039         Jim_Obj *const *argv)
11040 {
11041     Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11042     return JIM_OK;
11043 }
11044
11045 /* [upvar] */
11046 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, 
11047         Jim_Obj *const *argv)
11048 {
11049     const char *str;
11050     int i;
11051     Jim_CallFrame *targetCallFrame;
11052
11053     /* Lookup the target frame pointer */
11054     str = Jim_GetString(argv[1], NULL);
11055     if (argc > 3 && 
11056         ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11057     {
11058         if (Jim_GetCallFrameByLevel(interp, argv[1],
11059                     &targetCallFrame, NULL) != JIM_OK)
11060             return JIM_ERR;
11061         argc--;
11062         argv++;
11063     } else {
11064         if (Jim_GetCallFrameByLevel(interp, NULL,
11065                     &targetCallFrame, NULL) != JIM_OK)
11066             return JIM_ERR;
11067     }
11068     /* Check for arity */
11069     if (argc < 3 || ((argc-1)%2) != 0) {
11070         Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11071         return JIM_ERR;
11072     }
11073     /* Now... for every other/local couple: */
11074     for (i = 1; i < argc; i += 2) {
11075         if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11076                 targetCallFrame) != JIM_OK) return JIM_ERR;
11077     }
11078     return JIM_OK;
11079 }
11080
11081 /* [global] */
11082 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, 
11083         Jim_Obj *const *argv)
11084 {
11085     int i;
11086
11087     if (argc < 2) {
11088         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11089         return JIM_ERR;
11090     }
11091     /* Link every var to the toplevel having the same name */
11092     if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11093     for (i = 1; i < argc; i++) {
11094         if (Jim_SetVariableLink(interp, argv[i], argv[i],
11095                 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11096     }
11097     return JIM_OK;
11098 }
11099
11100 /* does the [string map] operation. On error NULL is returned,
11101  * otherwise a new string object with the result, having refcount = 0,
11102  * is returned. */
11103 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11104         Jim_Obj *objPtr, int nocase)
11105 {
11106     int numMaps;
11107     const char **key, *str, *noMatchStart = NULL;
11108     Jim_Obj **value;
11109     int *keyLen, strLen, i;
11110     Jim_Obj *resultObjPtr;
11111     
11112     Jim_ListLength(interp, mapListObjPtr, &numMaps);
11113     if (numMaps % 2) {
11114         Jim_SetResultString(interp,
11115                 "list must contain an even number of elements", -1);
11116         return NULL;
11117     }
11118     /* Initialization */
11119     numMaps /= 2;
11120     key = Jim_Alloc(sizeof(char*)*numMaps);
11121     keyLen = Jim_Alloc(sizeof(int)*numMaps);
11122     value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11123     resultObjPtr = Jim_NewStringObj(interp, "", 0);
11124     for (i = 0; i < numMaps; i++) {
11125         Jim_Obj *eleObjPtr;
11126
11127         Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11128         key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11129         Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11130         value[i] = eleObjPtr;
11131     }
11132     str = Jim_GetString(objPtr, &strLen);
11133     /* Map it */
11134     while(strLen) {
11135         for (i = 0; i < numMaps; i++) {
11136             if (strLen >= keyLen[i] && keyLen[i]) {
11137                 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11138                             nocase))
11139                 {
11140                     if (noMatchStart) {
11141                         Jim_AppendString(interp, resultObjPtr,
11142                                 noMatchStart, str-noMatchStart);
11143                         noMatchStart = NULL;
11144                     }
11145                     Jim_AppendObj(interp, resultObjPtr, value[i]);
11146                     str += keyLen[i];
11147                     strLen -= keyLen[i];
11148                     break;
11149                 }
11150             }
11151         }
11152         if (i == numMaps) { /* no match */
11153             if (noMatchStart == NULL)
11154                 noMatchStart = str;
11155             str ++;
11156             strLen --;
11157         }
11158     }
11159     if (noMatchStart) {
11160         Jim_AppendString(interp, resultObjPtr,
11161             noMatchStart, str-noMatchStart);
11162     }
11163     Jim_Free((void*)key);
11164     Jim_Free(keyLen);
11165     Jim_Free(value);
11166     return resultObjPtr;
11167 }
11168
11169 /* [string] */
11170 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, 
11171         Jim_Obj *const *argv)
11172 {
11173     int option;
11174     const char *options[] = {
11175         "length", "compare", "match", "equal", "range", "map", "repeat",
11176         "index", "first", "tolower", "toupper", NULL
11177     };
11178     enum {
11179         OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11180         OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11181     };
11182
11183     if (argc < 2) {
11184         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11185         return JIM_ERR;
11186     }
11187     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11188                 JIM_ERRMSG) != JIM_OK)
11189         return JIM_ERR;
11190
11191     if (option == OPT_LENGTH) {
11192         int len;
11193
11194         if (argc != 3) {
11195             Jim_WrongNumArgs(interp, 2, argv, "string");
11196             return JIM_ERR;
11197         }
11198         Jim_GetString(argv[2], &len);
11199         Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11200         return JIM_OK;
11201     } else if (option == OPT_COMPARE) {
11202         int nocase = 0;
11203         if ((argc != 4 && argc != 5) ||
11204             (argc == 5 && Jim_CompareStringImmediate(interp,
11205                 argv[2], "-nocase") == 0)) {
11206             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11207             return JIM_ERR;
11208         }
11209         if (argc == 5) {
11210             nocase = 1;
11211             argv++;
11212         }
11213         Jim_SetResult(interp, Jim_NewIntObj(interp,
11214                     Jim_StringCompareObj(argv[2],
11215                             argv[3], nocase)));
11216         return JIM_OK;
11217     } else if (option == OPT_MATCH) {
11218         int nocase = 0;
11219         if ((argc != 4 && argc != 5) ||
11220             (argc == 5 && Jim_CompareStringImmediate(interp,
11221                 argv[2], "-nocase") == 0)) {
11222             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11223                     "string");
11224             return JIM_ERR;
11225         }
11226         if (argc == 5) {
11227             nocase = 1;
11228             argv++;
11229         }
11230         Jim_SetResult(interp,
11231             Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11232                     argv[3], nocase)));
11233         return JIM_OK;
11234     } else if (option == OPT_EQUAL) {
11235         if (argc != 4) {
11236             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11237             return JIM_ERR;
11238         }
11239         Jim_SetResult(interp,
11240             Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11241                     argv[3], 0)));
11242         return JIM_OK;
11243     } else if (option == OPT_RANGE) {
11244         Jim_Obj *objPtr;
11245
11246         if (argc != 5) {
11247             Jim_WrongNumArgs(interp, 2, argv, "string first last");
11248             return JIM_ERR;
11249         }
11250         objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11251         if (objPtr == NULL)
11252             return JIM_ERR;
11253         Jim_SetResult(interp, objPtr);
11254         return JIM_OK;
11255     } else if (option == OPT_MAP) {
11256         int nocase = 0;
11257         Jim_Obj *objPtr;
11258
11259         if ((argc != 4 && argc != 5) ||
11260             (argc == 5 && Jim_CompareStringImmediate(interp,
11261                 argv[2], "-nocase") == 0)) {
11262             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11263                     "string");
11264             return JIM_ERR;
11265         }
11266         if (argc == 5) {
11267             nocase = 1;
11268             argv++;
11269         }
11270         objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11271         if (objPtr == NULL)
11272             return JIM_ERR;
11273         Jim_SetResult(interp, objPtr);
11274         return JIM_OK;
11275     } else if (option == OPT_REPEAT) {
11276         Jim_Obj *objPtr;
11277         jim_wide count;
11278
11279         if (argc != 4) {
11280             Jim_WrongNumArgs(interp, 2, argv, "string count");
11281             return JIM_ERR;
11282         }
11283         if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11284             return JIM_ERR;
11285         objPtr = Jim_NewStringObj(interp, "", 0);
11286         while (count--) {
11287             Jim_AppendObj(interp, objPtr, argv[2]);
11288         }
11289         Jim_SetResult(interp, objPtr);
11290         return JIM_OK;
11291     } else if (option == OPT_INDEX) {
11292         int index, len;
11293         const char *str;
11294
11295         if (argc != 4) {
11296             Jim_WrongNumArgs(interp, 2, argv, "string index");
11297             return JIM_ERR;
11298         }
11299         if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11300             return JIM_ERR;
11301         str = Jim_GetString(argv[2], &len);
11302         if (index != INT_MIN && index != INT_MAX)
11303             index = JimRelToAbsIndex(len, index);
11304         if (index < 0 || index >= len) {
11305             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11306             return JIM_OK;
11307         } else {
11308             Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11309             return JIM_OK;
11310         }
11311     } else if (option == OPT_FIRST) {
11312         int index = 0, l1, l2;
11313         const char *s1, *s2;
11314
11315         if (argc != 4 && argc != 5) {
11316             Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11317             return JIM_ERR;
11318         }
11319         s1 = Jim_GetString(argv[2], &l1);
11320         s2 = Jim_GetString(argv[3], &l2);
11321         if (argc == 5) {
11322             if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11323                 return JIM_ERR;
11324             index = JimRelToAbsIndex(l2, index);
11325         }
11326         Jim_SetResult(interp, Jim_NewIntObj(interp,
11327                     JimStringFirst(s1, l1, s2, l2, index)));
11328         return JIM_OK;
11329     } else if (option == OPT_TOLOWER) {
11330         if (argc != 3) {
11331             Jim_WrongNumArgs(interp, 2, argv, "string");
11332             return JIM_ERR;
11333         }
11334         Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11335     } else if (option == OPT_TOUPPER) {
11336         if (argc != 3) {
11337             Jim_WrongNumArgs(interp, 2, argv, "string");
11338             return JIM_ERR;
11339         }
11340         Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11341     }
11342     return JIM_OK;
11343 }
11344
11345 /* [time] */
11346 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, 
11347         Jim_Obj *const *argv)
11348 {
11349     long i, count = 1;
11350     jim_wide start, elapsed;
11351     char buf [256];
11352     const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11353
11354     if (argc < 2) {
11355         Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11356         return JIM_ERR;
11357     }
11358     if (argc == 3) {
11359         if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11360             return JIM_ERR;
11361     }
11362     if (count < 0)
11363         return JIM_OK;
11364     i = count;
11365     start = JimClock();
11366     while (i-- > 0) {
11367         int retval;
11368
11369         if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11370             return retval;
11371     }
11372     elapsed = JimClock() - start;
11373     sprintf(buf, fmt, elapsed/count);
11374     Jim_SetResultString(interp, buf, -1);
11375     return JIM_OK;
11376 }
11377
11378 /* [exit] */
11379 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, 
11380         Jim_Obj *const *argv)
11381 {
11382     long exitCode = 0;
11383
11384     if (argc > 2) {
11385         Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11386         return JIM_ERR;
11387     }
11388     if (argc == 2) {
11389         if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11390             return JIM_ERR;
11391     }
11392     interp->exitCode = exitCode;
11393     return JIM_EXIT;
11394 }
11395
11396 /* [catch] */
11397 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, 
11398         Jim_Obj *const *argv)
11399 {
11400     int exitCode = 0;
11401
11402     if (argc != 2 && argc != 3) {
11403         Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11404         return JIM_ERR;
11405     }
11406     exitCode = Jim_EvalObj(interp, argv[1]);
11407     if (argc == 3) {
11408         if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11409                 != JIM_OK)
11410             return JIM_ERR;
11411     }
11412     Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11413     return JIM_OK;
11414 }
11415
11416 /* [ref] */
11417 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, 
11418         Jim_Obj *const *argv)
11419 {
11420     if (argc != 3 && argc != 4) {
11421         Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11422         return JIM_ERR;
11423     }
11424     if (argc == 3) {
11425         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11426     } else {
11427         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11428                     argv[3]));
11429     }
11430     return JIM_OK;
11431 }
11432
11433 /* [getref] */
11434 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, 
11435         Jim_Obj *const *argv)
11436 {
11437     Jim_Reference *refPtr;
11438
11439     if (argc != 2) {
11440         Jim_WrongNumArgs(interp, 1, argv, "reference");
11441         return JIM_ERR;
11442     }
11443     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11444         return JIM_ERR;
11445     Jim_SetResult(interp, refPtr->objPtr);
11446     return JIM_OK;
11447 }
11448
11449 /* [setref] */
11450 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, 
11451         Jim_Obj *const *argv)
11452 {
11453     Jim_Reference *refPtr;
11454
11455     if (argc != 3) {
11456         Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11457         return JIM_ERR;
11458     }
11459     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11460         return JIM_ERR;
11461     Jim_IncrRefCount(argv[2]);
11462     Jim_DecrRefCount(interp, refPtr->objPtr);
11463     refPtr->objPtr = argv[2];
11464     Jim_SetResult(interp, argv[2]);
11465     return JIM_OK;
11466 }
11467
11468 /* [collect] */
11469 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, 
11470         Jim_Obj *const *argv)
11471 {
11472     if (argc != 1) {
11473         Jim_WrongNumArgs(interp, 1, argv, "");
11474         return JIM_ERR;
11475     }
11476     Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11477     return JIM_OK;
11478 }
11479
11480 /* [finalize] reference ?newValue? */
11481 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, 
11482         Jim_Obj *const *argv)
11483 {
11484     if (argc != 2 && argc != 3) {
11485         Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11486         return JIM_ERR;
11487     }
11488     if (argc == 2) {
11489         Jim_Obj *cmdNamePtr;
11490
11491         if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11492             return JIM_ERR;
11493         if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11494             Jim_SetResult(interp, cmdNamePtr);
11495     } else {
11496         if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11497             return JIM_ERR;
11498         Jim_SetResult(interp, argv[2]);
11499     }
11500     return JIM_OK;
11501 }
11502
11503 /* TODO */
11504 /* [info references] (list of all the references/finalizers) */
11505
11506 /* [rename] */
11507 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, 
11508         Jim_Obj *const *argv)
11509 {
11510     const char *oldName, *newName;
11511
11512     if (argc != 3) {
11513         Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11514         return JIM_ERR;
11515     }
11516     oldName = Jim_GetString(argv[1], NULL);
11517     newName = Jim_GetString(argv[2], NULL);
11518     if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11519         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11520         Jim_AppendStrings(interp, Jim_GetResult(interp),
11521             "can't rename \"", oldName, "\": ",
11522             "command doesn't exist", NULL);
11523         return JIM_ERR;
11524     }
11525     return JIM_OK;
11526 }
11527
11528 /* [dict] */
11529 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, 
11530         Jim_Obj *const *argv)
11531 {
11532     int option;
11533     const char *options[] = {
11534         "create", "get", "set", "unset", "exists", NULL
11535     };
11536     enum {
11537         OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11538     };
11539
11540     if (argc < 2) {
11541         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11542         return JIM_ERR;
11543     }
11544
11545     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11546                 JIM_ERRMSG) != JIM_OK)
11547         return JIM_ERR;
11548
11549     if (option == OPT_CREATE) {
11550         Jim_Obj *objPtr;
11551
11552         if (argc % 2) {
11553             Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11554             return JIM_ERR;
11555         }
11556         objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11557         Jim_SetResult(interp, objPtr);
11558         return JIM_OK;
11559     } else if (option == OPT_GET) {
11560         Jim_Obj *objPtr;
11561
11562         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11563                 JIM_ERRMSG) != JIM_OK)
11564             return JIM_ERR;
11565         Jim_SetResult(interp, objPtr);
11566         return JIM_OK;
11567     } else if (option == OPT_SET) {
11568         if (argc < 5) {
11569             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11570             return JIM_ERR;
11571         }
11572         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11573                     argv[argc-1]);
11574     } else if (option == OPT_UNSET) {
11575         if (argc < 4) {
11576             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11577             return JIM_ERR;
11578         }
11579         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11580                     NULL);
11581     } else if (option == OPT_EXIST) {
11582         Jim_Obj *objPtr;
11583         int exists;
11584
11585         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11586                 JIM_ERRMSG) == JIM_OK)
11587             exists = 1;
11588         else
11589             exists = 0;
11590         Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11591         return JIM_OK;
11592     } else {
11593         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11594         Jim_AppendStrings(interp, Jim_GetResult(interp),
11595             "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11596             " must be create, get, set", NULL);
11597         return JIM_ERR;
11598     }
11599     return JIM_OK;
11600 }
11601
11602 /* [load] */
11603 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, 
11604         Jim_Obj *const *argv)
11605 {
11606     if (argc < 2) {
11607         Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11608         return JIM_ERR;
11609     }
11610     return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11611 }
11612
11613 /* [subst] */
11614 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, 
11615         Jim_Obj *const *argv)
11616 {
11617     int i, flags = 0;
11618     Jim_Obj *objPtr;
11619
11620     if (argc < 2) {
11621         Jim_WrongNumArgs(interp, 1, argv,
11622             "?-nobackslashes? ?-nocommands? ?-novariables? string");
11623         return JIM_ERR;
11624     }
11625     i = argc-2;
11626     while(i--) {
11627         if (Jim_CompareStringImmediate(interp, argv[i+1],
11628                     "-nobackslashes"))
11629             flags |= JIM_SUBST_NOESC;
11630         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11631                     "-novariables"))
11632             flags |= JIM_SUBST_NOVAR;
11633         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11634                     "-nocommands"))
11635             flags |= JIM_SUBST_NOCMD;
11636         else {
11637             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11638             Jim_AppendStrings(interp, Jim_GetResult(interp),
11639                 "bad option \"", Jim_GetString(argv[i+1], NULL),
11640                 "\": must be -nobackslashes, -nocommands, or "
11641                 "-novariables", NULL);
11642             return JIM_ERR;
11643         }
11644     }
11645     if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11646         return JIM_ERR;
11647     Jim_SetResult(interp, objPtr);
11648     return JIM_OK;
11649 }
11650
11651 /* [info] */
11652 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, 
11653         Jim_Obj *const *argv)
11654 {
11655     int cmd, result = JIM_OK;
11656     static const char *commands[] = {
11657         "body", "commands", "exists", "globals", "level", "locals",
11658         "vars", "version", "complete", "args", "hostname", NULL
11659     };
11660     enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11661           INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11662     
11663     if (argc < 2) {
11664         Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11665         return JIM_ERR;
11666     }
11667     if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11668         != JIM_OK) {
11669         return JIM_ERR;
11670     }
11671     
11672     if (cmd == INFO_COMMANDS) {
11673         if (argc != 2 && argc != 3) {
11674             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11675             return JIM_ERR;
11676         }
11677         if (argc == 3)
11678             Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11679         else
11680             Jim_SetResult(interp, JimCommandsList(interp, NULL));
11681     } else if (cmd == INFO_EXISTS) {
11682         Jim_Obj *exists;
11683         if (argc != 3) {
11684             Jim_WrongNumArgs(interp, 2, argv, "varName");
11685             return JIM_ERR;
11686         }
11687         exists = Jim_GetVariable(interp, argv[2], 0);
11688         Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11689     } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11690         int mode;
11691         switch (cmd) {
11692             case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11693             case INFO_LOCALS:  mode = JIM_VARLIST_LOCALS; break;
11694             case INFO_VARS:    mode = JIM_VARLIST_VARS; break;
11695             default: mode = 0; /* avoid warning */; break;
11696         }
11697         if (argc != 2 && argc != 3) {
11698             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11699             return JIM_ERR;
11700         }
11701         if (argc == 3)
11702             Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11703         else
11704             Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11705     } else if (cmd == INFO_LEVEL) {
11706         Jim_Obj *objPtr;
11707         switch (argc) {
11708             case 2:
11709                 Jim_SetResult(interp,
11710                               Jim_NewIntObj(interp, interp->numLevels));
11711                 break;
11712             case 3:
11713                 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11714                     return JIM_ERR;
11715                 Jim_SetResult(interp, objPtr);
11716                 break;
11717             default:
11718                 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11719                 return JIM_ERR;
11720         }
11721     } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11722         Jim_Cmd *cmdPtr;
11723
11724         if (argc != 3) {
11725             Jim_WrongNumArgs(interp, 2, argv, "procname");
11726             return JIM_ERR;
11727         }
11728         if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11729             return JIM_ERR;
11730         if (cmdPtr->cmdProc != NULL) {
11731             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11732             Jim_AppendStrings(interp, Jim_GetResult(interp),
11733                 "command \"", Jim_GetString(argv[2], NULL),
11734                 "\" is not a procedure", NULL);
11735             return JIM_ERR;
11736         }
11737         if (cmd == INFO_BODY)
11738             Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11739         else
11740             Jim_SetResult(interp, cmdPtr->argListObjPtr);
11741     } else if (cmd == INFO_VERSION) {
11742         char buf[(JIM_INTEGER_SPACE * 2) + 1];
11743         sprintf(buf, "%d.%d", 
11744                 JIM_VERSION / 100, JIM_VERSION % 100);
11745         Jim_SetResultString(interp, buf, -1);
11746     } else if (cmd == INFO_COMPLETE) {
11747         const char *s;
11748         int len;
11749
11750         if (argc != 3) {
11751             Jim_WrongNumArgs(interp, 2, argv, "script");
11752             return JIM_ERR;
11753         }
11754         s = Jim_GetString(argv[2], &len);
11755         Jim_SetResult(interp,
11756                 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11757     } else if (cmd == INFO_HOSTNAME) {
11758         /* Redirect to os.hostname if it exists */
11759         Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11760         result = Jim_EvalObjVector(interp, 1, &command);
11761     }
11762     return result;
11763 }
11764
11765 /* [split] */
11766 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, 
11767         Jim_Obj *const *argv)
11768 {
11769     const char *str, *splitChars, *noMatchStart;
11770     int splitLen, strLen, i;
11771     Jim_Obj *resObjPtr;
11772
11773     if (argc != 2 && argc != 3) {
11774         Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11775         return JIM_ERR;
11776     }
11777     /* Init */
11778     if (argc == 2) {
11779         splitChars = " \n\t\r";
11780         splitLen = 4;
11781     } else {
11782         splitChars = Jim_GetString(argv[2], &splitLen);
11783     }
11784     str = Jim_GetString(argv[1], &strLen);
11785     if (!strLen) return JIM_OK;
11786     noMatchStart = str;
11787     resObjPtr = Jim_NewListObj(interp, NULL, 0);
11788     /* Split */
11789     if (splitLen) {
11790         while (strLen) {
11791             for (i = 0; i < splitLen; i++) {
11792                 if (*str == splitChars[i]) {
11793                     Jim_Obj *objPtr;
11794
11795                     objPtr = Jim_NewStringObj(interp, noMatchStart,
11796                             (str-noMatchStart));
11797                     Jim_ListAppendElement(interp, resObjPtr, objPtr);
11798                     noMatchStart = str+1;
11799                     break;
11800                 }
11801             }
11802             str ++;
11803             strLen --;
11804         }
11805         Jim_ListAppendElement(interp, resObjPtr,
11806                 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11807     } else {
11808         /* This handles the special case of splitchars eq {}. This
11809          * is trivial but we want to perform object sharing as Tcl does. */
11810         Jim_Obj *objCache[256];
11811         const unsigned char *u = (unsigned char*) str;
11812         memset(objCache, 0, sizeof(objCache));
11813         for (i = 0; i < strLen; i++) {
11814             int c = u[i];
11815             
11816             if (objCache[c] == NULL)
11817                 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11818             Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11819         }
11820     }
11821     Jim_SetResult(interp, resObjPtr);
11822     return JIM_OK;
11823 }
11824
11825 /* [join] */
11826 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, 
11827         Jim_Obj *const *argv)
11828 {
11829     const char *joinStr;
11830     int joinStrLen, i, listLen;
11831     Jim_Obj *resObjPtr;
11832
11833     if (argc != 2 && argc != 3) {
11834         Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11835         return JIM_ERR;
11836     }
11837     /* Init */
11838     if (argc == 2) {
11839         joinStr = " ";
11840         joinStrLen = 1;
11841     } else {
11842         joinStr = Jim_GetString(argv[2], &joinStrLen);
11843     }
11844     Jim_ListLength(interp, argv[1], &listLen);
11845     resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11846     /* Split */
11847     for (i = 0; i < listLen; i++) {
11848         Jim_Obj *objPtr;
11849
11850         Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11851         Jim_AppendObj(interp, resObjPtr, objPtr);
11852         if (i+1 != listLen) {
11853             Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11854         }
11855     }
11856     Jim_SetResult(interp, resObjPtr);
11857     return JIM_OK;
11858 }
11859
11860 /* [format] */
11861 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11862         Jim_Obj *const *argv)
11863 {
11864     Jim_Obj *objPtr;
11865
11866     if (argc < 2) {
11867         Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11868         return JIM_ERR;
11869     }
11870     objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11871     if (objPtr == NULL)
11872         return JIM_ERR;
11873     Jim_SetResult(interp, objPtr);
11874     return JIM_OK;
11875 }
11876
11877 /* [scan] */
11878 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11879         Jim_Obj *const *argv)
11880 {
11881     Jim_Obj *listPtr, **outVec;
11882     int outc, i, count = 0;
11883
11884     if (argc < 3) {
11885         Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11886         return JIM_ERR;
11887     } 
11888     if (argv[2]->typePtr != &scanFmtStringObjType)
11889         SetScanFmtFromAny(interp, argv[2]);
11890     if (FormatGetError(argv[2]) != 0) {
11891         Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11892         return JIM_ERR;
11893     }
11894     if (argc > 3) {
11895         int maxPos = FormatGetMaxPos(argv[2]);
11896         int count = FormatGetCnvCount(argv[2]);
11897         if (maxPos > argc-3) {
11898             Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11899             return JIM_ERR;
11900         } else if (count != 0 && count < argc-3) {
11901             Jim_SetResultString(interp, "variable is not assigned by any "
11902                 "conversion specifiers", -1);
11903             return JIM_ERR;
11904         } else if (count > argc-3) {
11905             Jim_SetResultString(interp, "different numbers of variable names and "
11906                 "field specifiers", -1);
11907             return JIM_ERR;
11908         }
11909     } 
11910     listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11911     if (listPtr == 0)
11912         return JIM_ERR;
11913     if (argc > 3) {
11914         int len = 0;
11915         if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11916             Jim_ListLength(interp, listPtr, &len);
11917         if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11918             Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11919             return JIM_OK;
11920         }
11921         JimListGetElements(interp, listPtr, &outc, &outVec);
11922         for (i = 0; i < outc; ++i) {
11923             if (Jim_Length(outVec[i]) > 0) {
11924                 ++count;
11925                 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11926                     goto err;
11927             }
11928         }
11929         Jim_FreeNewObj(interp, listPtr);
11930         Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11931     } else {
11932         if (listPtr == (Jim_Obj*)EOF) {
11933             Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11934             return JIM_OK;
11935         }
11936         Jim_SetResult(interp, listPtr);
11937     }
11938     return JIM_OK;
11939 err:
11940     Jim_FreeNewObj(interp, listPtr);
11941     return JIM_ERR;
11942 }
11943
11944 /* [error] */
11945 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11946         Jim_Obj *const *argv)
11947 {
11948     if (argc != 2) {
11949         Jim_WrongNumArgs(interp, 1, argv, "message");
11950         return JIM_ERR;
11951     }
11952     Jim_SetResult(interp, argv[1]);
11953     return JIM_ERR;
11954 }
11955
11956 /* [lrange] */
11957 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11958         Jim_Obj *const *argv)
11959 {
11960     Jim_Obj *objPtr;
11961
11962     if (argc != 4) {
11963         Jim_WrongNumArgs(interp, 1, argv, "list first last");
11964         return JIM_ERR;
11965     }
11966     if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11967         return JIM_ERR;
11968     Jim_SetResult(interp, objPtr);
11969     return JIM_OK;
11970 }
11971
11972 /* [env] */
11973 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11974         Jim_Obj *const *argv)
11975 {
11976     const char *key;
11977     char *val;
11978
11979     if (argc == 1) {
11980
11981 #ifdef NEED_ENVIRON_EXTERN
11982         extern char **environ;
11983 #endif
11984
11985         int i;
11986         Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11987
11988         for (i = 0; environ[i]; i++) {
11989             const char *equals = strchr(environ[i], '=');
11990             if (equals) {
11991                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11992                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11993             }
11994         }
11995
11996         Jim_SetResult(interp, listObjPtr);
11997         return JIM_OK;
11998     }
11999
12000     if (argc != 2) {
12001         Jim_WrongNumArgs(interp, 1, argv, "varName");
12002         return JIM_ERR;
12003     }
12004     key = Jim_GetString(argv[1], NULL);
12005     val = getenv(key);
12006     if (val == NULL) {
12007         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12008         Jim_AppendStrings(interp, Jim_GetResult(interp),
12009                 "environment variable \"",
12010                 key, "\" does not exist", NULL);
12011         return JIM_ERR;
12012     }
12013     Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12014     return JIM_OK;
12015 }
12016
12017 /* [source] */
12018 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12019         Jim_Obj *const *argv)
12020 {
12021     int retval;
12022
12023     if (argc != 2) {
12024         Jim_WrongNumArgs(interp, 1, argv, "fileName");
12025         return JIM_ERR;
12026     }
12027     retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12028     if (retval == JIM_ERR) {
12029         return JIM_ERR_ADDSTACK;
12030     }
12031     if (retval == JIM_RETURN)
12032         return JIM_OK;
12033     return retval;
12034 }
12035
12036 /* [lreverse] */
12037 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12038         Jim_Obj *const *argv)
12039 {
12040     Jim_Obj *revObjPtr, **ele;
12041     int len;
12042
12043     if (argc != 2) {
12044         Jim_WrongNumArgs(interp, 1, argv, "list");
12045         return JIM_ERR;
12046     }
12047     JimListGetElements(interp, argv[1], &len, &ele);
12048     len--;
12049     revObjPtr = Jim_NewListObj(interp, NULL, 0);
12050     while (len >= 0)
12051         ListAppendElement(revObjPtr, ele[len--]);
12052     Jim_SetResult(interp, revObjPtr);
12053     return JIM_OK;
12054 }
12055
12056 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12057 {
12058     jim_wide len;
12059
12060     if (step == 0) return -1;
12061     if (start == end) return 0;
12062     else if (step > 0 && start > end) return -1;
12063     else if (step < 0 && end > start) return -1;
12064     len = end-start;
12065     if (len < 0) len = -len; /* abs(len) */
12066     if (step < 0) step = -step; /* abs(step) */
12067     len = 1 + ((len-1)/step);
12068     /* We can truncate safely to INT_MAX, the range command
12069      * will always return an error for a such long range
12070      * because Tcl lists can't be so long. */
12071     if (len > INT_MAX) len = INT_MAX;
12072     return (int)((len < 0) ? -1 : len);
12073 }
12074
12075 /* [range] */
12076 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12077         Jim_Obj *const *argv)
12078 {
12079     jim_wide start = 0, end, step = 1;
12080     int len, i;
12081     Jim_Obj *objPtr;
12082
12083     if (argc < 2 || argc > 4) {
12084         Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12085         return JIM_ERR;
12086     }
12087     if (argc == 2) {
12088         if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12089             return JIM_ERR;
12090     } else {
12091         if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12092             Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12093             return JIM_ERR;
12094         if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12095             return JIM_ERR;
12096     }
12097     if ((len = JimRangeLen(start, end, step)) == -1) {
12098         Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12099         return JIM_ERR;
12100     }
12101     objPtr = Jim_NewListObj(interp, NULL, 0);
12102     for (i = 0; i < len; i++)
12103         ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12104     Jim_SetResult(interp, objPtr);
12105     return JIM_OK;
12106 }
12107
12108 /* [rand] */
12109 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12110         Jim_Obj *const *argv)
12111 {
12112     jim_wide min = 0, max, len, maxMul;
12113
12114     if (argc < 1 || argc > 3) {
12115         Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12116         return JIM_ERR;
12117     }
12118     if (argc == 1) {
12119         max = JIM_WIDE_MAX;
12120     } else if (argc == 2) {
12121         if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12122             return JIM_ERR;
12123     } else if (argc == 3) {
12124         if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12125             Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12126             return JIM_ERR;
12127     }
12128     len = max-min;
12129     if (len < 0) {
12130         Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12131         return JIM_ERR;
12132     }
12133     maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12134     while (1) {
12135         jim_wide r;
12136
12137         JimRandomBytes(interp, &r, sizeof(jim_wide));
12138         if (r < 0 || r >= maxMul) continue;
12139         r = (len == 0) ? 0 : r%len;
12140         Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12141         return JIM_OK;
12142     }
12143 }
12144
12145 /* [package] */
12146 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc, 
12147         Jim_Obj *const *argv)
12148 {
12149     int option;
12150     const char *options[] = {
12151         "require", "provide", NULL
12152     };
12153     enum {OPT_REQUIRE, OPT_PROVIDE};
12154
12155     if (argc < 2) {
12156         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12157         return JIM_ERR;
12158     }
12159     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12160                 JIM_ERRMSG) != JIM_OK)
12161         return JIM_ERR;
12162
12163     if (option == OPT_REQUIRE) {
12164         int exact = 0;
12165         const char *ver;
12166
12167         if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12168             exact = 1;
12169             argv++;
12170             argc--;
12171         }
12172         if (argc != 3 && argc != 4) {
12173             Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12174             return JIM_ERR;
12175         }
12176         ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12177                 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12178                 JIM_ERRMSG);
12179         if (ver == NULL)
12180             return JIM_ERR_ADDSTACK;
12181         Jim_SetResultString(interp, ver, -1);
12182     } else if (option == OPT_PROVIDE) {
12183         if (argc != 4) {
12184             Jim_WrongNumArgs(interp, 2, argv, "package version");
12185             return JIM_ERR;
12186         }
12187         return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12188                     Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12189     }
12190     return JIM_OK;
12191 }
12192
12193 static struct {
12194     const char *name;
12195     Jim_CmdProc cmdProc;
12196 } Jim_CoreCommandsTable[] = {
12197     {"set", Jim_SetCoreCommand},
12198     {"unset", Jim_UnsetCoreCommand},
12199     {"puts", Jim_PutsCoreCommand},
12200     {"+", Jim_AddCoreCommand},
12201     {"*", Jim_MulCoreCommand},
12202     {"-", Jim_SubCoreCommand},
12203     {"/", Jim_DivCoreCommand},
12204     {"incr", Jim_IncrCoreCommand},
12205     {"while", Jim_WhileCoreCommand},
12206     {"for", Jim_ForCoreCommand},
12207     {"foreach", Jim_ForeachCoreCommand},
12208     {"lmap", Jim_LmapCoreCommand},
12209     {"if", Jim_IfCoreCommand},
12210     {"switch", Jim_SwitchCoreCommand},
12211     {"list", Jim_ListCoreCommand},
12212     {"lindex", Jim_LindexCoreCommand},
12213     {"lset", Jim_LsetCoreCommand},
12214     {"llength", Jim_LlengthCoreCommand},
12215     {"lappend", Jim_LappendCoreCommand},
12216     {"linsert", Jim_LinsertCoreCommand},
12217     {"lsort", Jim_LsortCoreCommand},
12218     {"append", Jim_AppendCoreCommand},
12219     {"debug", Jim_DebugCoreCommand},
12220     {"eval", Jim_EvalCoreCommand},
12221     {"uplevel", Jim_UplevelCoreCommand},
12222     {"expr", Jim_ExprCoreCommand},
12223     {"break", Jim_BreakCoreCommand},
12224     {"continue", Jim_ContinueCoreCommand},
12225     {"proc", Jim_ProcCoreCommand},
12226     {"concat", Jim_ConcatCoreCommand},
12227     {"return", Jim_ReturnCoreCommand},
12228     {"upvar", Jim_UpvarCoreCommand},
12229     {"global", Jim_GlobalCoreCommand},
12230     {"string", Jim_StringCoreCommand},
12231     {"time", Jim_TimeCoreCommand},
12232     {"exit", Jim_ExitCoreCommand},
12233     {"catch", Jim_CatchCoreCommand},
12234     {"ref", Jim_RefCoreCommand},
12235     {"getref", Jim_GetrefCoreCommand},
12236     {"setref", Jim_SetrefCoreCommand},
12237     {"finalize", Jim_FinalizeCoreCommand},
12238     {"collect", Jim_CollectCoreCommand},
12239     {"rename", Jim_RenameCoreCommand},
12240     {"dict", Jim_DictCoreCommand},
12241     {"load", Jim_LoadCoreCommand},
12242     {"subst", Jim_SubstCoreCommand},
12243     {"info", Jim_InfoCoreCommand},
12244     {"split", Jim_SplitCoreCommand},
12245     {"join", Jim_JoinCoreCommand},
12246     {"format", Jim_FormatCoreCommand},
12247     {"scan", Jim_ScanCoreCommand},
12248     {"error", Jim_ErrorCoreCommand},
12249     {"lrange", Jim_LrangeCoreCommand},
12250     {"env", Jim_EnvCoreCommand},
12251     {"source", Jim_SourceCoreCommand},
12252     {"lreverse", Jim_LreverseCoreCommand},
12253     {"range", Jim_RangeCoreCommand},
12254     {"rand", Jim_RandCoreCommand},
12255     {"package", Jim_PackageCoreCommand},
12256     {"tailcall", Jim_TailcallCoreCommand},
12257     {NULL, NULL},
12258 };
12259
12260 /* Some Jim core command is actually a procedure written in Jim itself. */
12261 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12262 {
12263     Jim_Eval(interp, (char*)
12264 "proc lambda {arglist args} {\n"
12265 "    set name [ref {} function lambdaFinalizer]\n"
12266 "    uplevel 1 [list proc $name $arglist {expand}$args]\n"
12267 "    return $name\n"
12268 "}\n"
12269 "proc lambdaFinalizer {name val} {\n"
12270 "    rename $name {}\n"
12271 "}\n"
12272     );
12273 }
12274
12275 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12276 {
12277     int i = 0;
12278
12279     while(Jim_CoreCommandsTable[i].name != NULL) {
12280         Jim_CreateCommand(interp, 
12281                 Jim_CoreCommandsTable[i].name,
12282                 Jim_CoreCommandsTable[i].cmdProc,
12283                 NULL, NULL);
12284         i++;
12285     }
12286     Jim_RegisterCoreProcedures(interp);
12287 }
12288
12289 /* -----------------------------------------------------------------------------
12290  * Interactive prompt
12291  * ---------------------------------------------------------------------------*/
12292 void Jim_PrintErrorMessage(Jim_Interp *interp)
12293 {
12294     int len, i;
12295
12296     if (*interp->errorFileName) {
12297         Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL "    ",
12298                                     interp->errorFileName, interp->errorLine);
12299     }
12300     Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12301             Jim_GetString(interp->result, NULL));
12302     Jim_ListLength(interp, interp->stackTrace, &len);
12303     for (i = len-3; i >= 0; i-= 3) {
12304         Jim_Obj *objPtr;
12305         const char *proc, *file, *line;
12306
12307         Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12308         proc = Jim_GetString(objPtr, NULL);
12309         Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12310                 JIM_NONE);
12311         file = Jim_GetString(objPtr, NULL);
12312         Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12313                 JIM_NONE);
12314         line = Jim_GetString(objPtr, NULL);
12315         if (*proc) {
12316             Jim_fprintf( interp, interp->cookie_stderr,
12317                     "in procedure '%s' ", proc);
12318         }
12319         if (*file) {
12320             Jim_fprintf( interp, interp->cookie_stderr,
12321                     "called at file \"%s\", line %s",
12322                     file, line);
12323         }
12324         if (*file || *proc) {
12325             Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12326         }
12327     }
12328 }
12329
12330 int Jim_InteractivePrompt(Jim_Interp *interp)
12331 {
12332     int retcode = JIM_OK;
12333     Jim_Obj *scriptObjPtr;
12334
12335     Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12336            "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12337            JIM_VERSION / 100, JIM_VERSION % 100);
12338      Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12339     while (1) {
12340         char buf[1024];
12341         const char *result;
12342         const char *retcodestr[] = {
12343             "ok", "error", "return", "break", "continue", "eval", "exit"
12344         };
12345         int reslen;
12346
12347         if (retcode != 0) {
12348             if (retcode >= 2 && retcode <= 6)
12349                 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12350             else
12351                 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12352         } else
12353             Jim_fprintf( interp, interp->cookie_stdout, ". ");
12354         Jim_fflush( interp, interp->cookie_stdout);
12355         scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12356         Jim_IncrRefCount(scriptObjPtr);
12357         while(1) {
12358             const char *str;
12359             char state;
12360             int len;
12361
12362             if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12363                 Jim_DecrRefCount(interp, scriptObjPtr);
12364                 goto out;
12365             }
12366             Jim_AppendString(interp, scriptObjPtr, buf, -1);
12367             str = Jim_GetString(scriptObjPtr, &len);
12368             if (Jim_ScriptIsComplete(str, len, &state))
12369                 break;
12370             Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12371             Jim_fflush( interp, interp->cookie_stdout);
12372         }
12373         retcode = Jim_EvalObj(interp, scriptObjPtr);
12374         Jim_DecrRefCount(interp, scriptObjPtr);
12375         result = Jim_GetString(Jim_GetResult(interp), &reslen);
12376         if (retcode == JIM_ERR) {
12377             Jim_PrintErrorMessage(interp);
12378         } else if (retcode == JIM_EXIT) {
12379             exit(Jim_GetExitCode(interp));
12380         } else {
12381             if (reslen) {
12382                                 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12383                                 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12384             }
12385         }
12386     }
12387 out:
12388     return 0;
12389 }
12390
12391 /* -----------------------------------------------------------------------------
12392  * Jim's idea of STDIO..
12393  * ---------------------------------------------------------------------------*/
12394
12395 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12396 {
12397         int r;
12398
12399         va_list ap;
12400         va_start(ap,fmt);
12401         r = Jim_vfprintf( interp, cookie, fmt,ap );
12402         va_end(ap);
12403         return r;
12404 }
12405
12406 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12407 {
12408         if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12409                 errno = ENOTSUP;
12410                 return -1;
12411         }
12412         return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12413 }
12414
12415 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12416 {
12417         if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12418                 errno = ENOTSUP;
12419                 return 0;
12420         }
12421         return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12422 }
12423
12424 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12425 {
12426         if( (interp == NULL) || (interp->cb_fread == NULL) ){
12427                 errno = ENOTSUP;
12428                 return 0;
12429         }
12430         return (*(interp->cb_fread))( ptr, size, n, cookie);
12431 }
12432
12433 int Jim_fflush( Jim_Interp *interp, void *cookie )
12434 {
12435         if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12436                 /* pretend all is well */
12437                 return 0;
12438         }
12439         return (*(interp->cb_fflush))( cookie );
12440 }
12441
12442 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12443 {
12444         if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12445                 errno = ENOTSUP;
12446                 return NULL;
12447         }
12448         return (*(interp->cb_fgets))( s, size, cookie );
12449 }
12450 Jim_Nvp *
12451 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12452 {
12453         while( p->name ){
12454                 if( 0 == strcmp( name, p->name ) ){
12455                         break;
12456                 }
12457                 p++;
12458         }
12459         return ((Jim_Nvp *)(p));
12460 }
12461
12462 Jim_Nvp *
12463 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12464 {
12465         while( p->name ){
12466                 if( 0 == strcasecmp( name, p->name ) ){
12467                         break;
12468                 }
12469                 p++;
12470         }
12471         return ((Jim_Nvp *)(p));
12472 }
12473
12474 int
12475 Jim_Nvp_name2value_obj( Jim_Interp *interp, 
12476                                                 const Jim_Nvp *p, 
12477                                                 Jim_Obj *o, 
12478                                                 Jim_Nvp **result )
12479 {
12480         return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12481 }
12482         
12483
12484 int 
12485 Jim_Nvp_name2value( Jim_Interp *interp, 
12486                                         const Jim_Nvp *_p, 
12487                                         const char *name, 
12488                                         Jim_Nvp **result)
12489 {
12490         const Jim_Nvp *p;
12491
12492         p = Jim_Nvp_name2value_simple( _p, name );
12493
12494         /* result */
12495         if( result ){
12496                 *result = (Jim_Nvp *)(p);
12497         }
12498         
12499         /* found? */
12500         if( p->name ){
12501                 return JIM_OK;
12502         } else {
12503                 return JIM_ERR;
12504         }
12505 }
12506
12507 int
12508 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12509 {
12510         return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12511 }
12512
12513 int
12514 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12515 {
12516         const Jim_Nvp *p;
12517
12518         p = Jim_Nvp_name2value_nocase_simple( _p, name );
12519
12520         if( puthere ){
12521                 *puthere = (Jim_Nvp *)(p);
12522         }
12523         /* found */
12524         if( p->name ){
12525                 return JIM_OK;
12526         } else {
12527                 return JIM_ERR;
12528         }
12529 }
12530
12531
12532 int 
12533 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12534 {
12535         int e;;
12536         jim_wide w;
12537
12538         e = Jim_GetWide( interp, o, &w );
12539         if( e != JIM_OK ){
12540                 return e;
12541         }
12542
12543         return Jim_Nvp_value2name( interp, p, w, result );
12544 }
12545
12546 Jim_Nvp *
12547 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12548 {
12549         while( p->name ){
12550                 if( value == p->value ){
12551                         break;
12552                 }
12553                 p++;
12554         }
12555         return ((Jim_Nvp *)(p));
12556 }
12557
12558
12559 int 
12560 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12561 {
12562         const Jim_Nvp *p;
12563
12564         p = Jim_Nvp_value2name_simple( _p, value );
12565
12566         if( result ){
12567                 *result = (Jim_Nvp *)(p);
12568         }
12569
12570         if( p->name ){
12571                 return JIM_OK;
12572         } else {
12573                 return JIM_ERR;
12574         }
12575 }
12576
12577
12578 int
12579 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const *  argv)
12580 {
12581         memset( p, 0, sizeof(*p) );
12582         p->interp = interp;
12583         p->argc   = argc;
12584         p->argv   = argv;
12585
12586         return JIM_OK;
12587 }
12588
12589 void
12590 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12591 {
12592         int x;
12593
12594         Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12595         for( x = 0 ; x < p->argc ; x++ ){
12596                 Jim_fprintf( p->interp, p->interp->cookie_stderr, 
12597                                          "%2d) %s\n", 
12598                                          x, 
12599                                          Jim_GetString( p->argv[x], NULL ) );
12600         }
12601         Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12602 }
12603
12604
12605 int
12606 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12607 {
12608         Jim_Obj *o;
12609         
12610         o = NULL; // failure 
12611         if( goi->argc ){
12612                 // success 
12613                 o = goi->argv[0];
12614                 goi->argc -= 1;
12615                 goi->argv += 1;
12616         }
12617         if( puthere ){
12618                 *puthere = o;
12619         }
12620         if( o != NULL ){
12621                 return JIM_OK;
12622         } else {
12623                 return JIM_ERR;
12624         }
12625 }
12626
12627 int
12628 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12629 {
12630         int r;
12631         Jim_Obj *o;
12632         const char *cp;
12633
12634
12635         r = Jim_GetOpt_Obj( goi, &o );
12636         if( r == JIM_OK ){
12637                 cp = Jim_GetString( o, len );
12638                 if( puthere ){
12639                         /* remove const */
12640                         *puthere = (char *)(cp);
12641                 }
12642         }
12643         return r;
12644 }
12645
12646 int
12647 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12648 {
12649         int r;
12650         Jim_Obj *o;
12651         double _safe;
12652         
12653         if( puthere == NULL ){
12654                 puthere = &_safe;
12655         }
12656
12657         r = Jim_GetOpt_Obj( goi, &o );
12658         if( r == JIM_OK ){
12659                 r = Jim_GetDouble( goi->interp, o, puthere );
12660                 if( r != JIM_OK ){
12661                         Jim_SetResult_sprintf( goi->interp,
12662                                                                    "not a number: %s", 
12663                                                                    Jim_GetString( o, NULL ) );
12664                 }
12665         }
12666         return r;
12667 }
12668
12669 int
12670 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12671 {
12672         int r;
12673         Jim_Obj *o;
12674         jim_wide _safe;
12675
12676         if( puthere == NULL ){
12677                 puthere = &_safe;
12678         }
12679
12680         r = Jim_GetOpt_Obj( goi, &o );
12681         if( r == JIM_OK ){
12682                 r = Jim_GetWide( goi->interp, o, puthere );
12683         }
12684         return r;
12685 }
12686
12687 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi, 
12688                                         const Jim_Nvp *nvp, 
12689                                         Jim_Nvp **puthere)
12690 {
12691         Jim_Nvp *_safe;
12692         Jim_Obj *o;
12693         int e;
12694
12695         if( puthere == NULL ){
12696                 puthere = &_safe;
12697         }
12698
12699         e = Jim_GetOpt_Obj( goi, &o );
12700         if( e == JIM_OK ){
12701                 e = Jim_Nvp_name2value_obj( goi->interp,
12702                                                                         nvp, 
12703                                                                         o,
12704                                                                         puthere );
12705         }
12706
12707         return e;
12708 }
12709
12710 void
12711 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12712                                            const Jim_Nvp *nvptable,
12713                                            int hadprefix )
12714 {
12715         if( hadprefix ){
12716                 Jim_SetResult_NvpUnknown( goi->interp,
12717                                                                   goi->argv[-2],
12718                                                                   goi->argv[-1],
12719                                                                   nvptable );
12720         } else {
12721                 Jim_SetResult_NvpUnknown( goi->interp,
12722                                                                   NULL,
12723                                                                   goi->argv[-1],
12724                                                                   nvptable );
12725         }
12726 }
12727                                            
12728
12729 int 
12730 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12731                                  const char * const *  lookup,
12732                                  int *puthere)
12733 {
12734         int _safe;
12735         Jim_Obj *o;
12736         int e;
12737
12738         if( puthere == NULL ){
12739                 puthere = &_safe;
12740         }
12741         e = Jim_GetOpt_Obj( goi, &o );
12742         if( e == JIM_OK ){
12743                 e = Jim_GetEnum( goi->interp,
12744                                                  o,
12745                                                  lookup,
12746                                                  puthere,
12747                                                  "option",
12748                                                  JIM_ERRMSG );
12749         }
12750         return e;
12751 }
12752         
12753
12754
12755 int
12756 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12757 {
12758         va_list ap;
12759         char *buf;
12760
12761         va_start(ap,fmt);
12762         buf = jim_vasprintf( fmt, ap );
12763         va_end(ap);
12764         if( buf ){
12765                 Jim_SetResultString( interp, buf, -1 );
12766                 jim_vasprintf_done(buf);
12767         }
12768         return JIM_OK;
12769 }
12770         
12771
12772 void
12773 Jim_SetResult_NvpUnknown( Jim_Interp *interp, 
12774                                                   Jim_Obj *param_name,
12775                                                   Jim_Obj *param_value,
12776                                                   const Jim_Nvp *nvp )
12777 {
12778         if( param_name ){
12779                 Jim_SetResult_sprintf( interp,
12780                                                            "%s: Unknown: %s, try one of: ",
12781                                                            Jim_GetString( param_name, NULL ),
12782                                                            Jim_GetString( param_value, NULL ) );
12783         } else {
12784                 Jim_SetResult_sprintf( interp,
12785                                                            "Unknown param: %s, try one of: ",
12786                                                            Jim_GetString( param_value, NULL ) );
12787         }
12788         while( nvp->name ){
12789                 const char *a;
12790                 const char *b;
12791
12792                 if( (nvp+1)->name ){
12793                         a = nvp->name;
12794                         b = ", ";
12795                 } else {
12796                         a = "or ";
12797                         b = nvp->name;
12798                 }
12799                 Jim_AppendStrings( interp,
12800                                                    Jim_GetResult(interp),
12801                                                    a, b, NULL );
12802                 nvp++;
12803         }
12804 }
12805                                                            
12806
12807 static Jim_Obj *debug_string_obj;
12808
12809 const char *
12810 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12811 {
12812         int x;
12813
12814         if( debug_string_obj ){
12815                 Jim_FreeObj( interp, debug_string_obj );
12816         }
12817
12818         debug_string_obj = Jim_NewEmptyStringObj( interp );
12819         for( x = 0 ; x < argc ; x++ ){
12820                 Jim_AppendStrings( interp,
12821                                                    debug_string_obj,
12822                                                    Jim_GetString( argv[x], NULL ),
12823                                                    " ",
12824                                                    NULL );
12825         }
12826
12827         return Jim_GetString( debug_string_obj, NULL );
12828 }
12829
12830         
12831
12832 /*
12833  * Local Variables: ***
12834  * c-basic-offset: 4 ***
12835  * tab-width: 4 ***
12836  * End: ***
12837  */