moved ioutil init to the right spot: before config scripts
[fw/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 #define __JIM_CORE__
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44
45 #ifdef __ECOS
46 #include <pkgconf/jimtcl.h>
47 #endif
48 #ifndef JIM_ANSIC
49 #define JIM_DYNLIB      /* Dynamic library support for UNIX and WIN32 */
50 #endif /* JIM_ANSIC */
51
52 #define _GNU_SOURCE     /* for vasprintf() */
53 #include <stdio.h>
54 #include <stdlib.h>
55 #include <string.h>
56 #include <stdarg.h>
57 #include <ctype.h>
58 #include <limits.h>
59 #include <assert.h>
60 #include <errno.h>
61 #include <time.h>
62 #if defined(WIN32)
63 /* sys/time - need is different */
64 #else
65 #include <sys/time.h> // for gettimeofday()
66 #endif
67
68 #include "replacements.h"
69
70 /* Include the platform dependent libraries for
71  * dynamic loading of libraries. */
72 #ifdef JIM_DYNLIB
73 #if defined(_WIN32) || defined(WIN32)
74 #ifndef WIN32
75 #define WIN32 1
76 #endif
77 #ifndef STRICT
78 #define STRICT
79 #endif
80 #define WIN32_LEAN_AND_MEAN
81 #include <windows.h>
82 #if _MSC_VER >= 1000
83 #pragma warning(disable:4146)
84 #endif /* _MSC_VER */
85 #else
86 #include <dlfcn.h>
87 #endif /* WIN32 */
88 #endif /* JIM_DYNLIB */
89
90 #ifndef WIN32
91 #include <unistd.h>
92 #endif
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105  * Global variables
106  * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109  * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113  * Required prototypes of not exported functions
114  * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType JimVariablesHashTableType;
120
121 /* -----------------------------------------------------------------------------
122  * Utility functions
123  * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf( const char *fmt, va_list ap )
127 {
128 #ifndef HAVE_VASPRINTF
129         /* yucky way */
130 static char buf[2048];
131         vsnprintf( buf, sizeof(buf), fmt, ap );
132         /* garentee termination */
133         buf[sizeof(buf)-1] = 0;
134 #else
135         char *buf;
136         vasprintf( &buf, fmt, ap );
137 #endif
138         return buf;
139 }
140
141 static void
142 jim_vasprintf_done( void *buf )
143 {
144 #ifndef HAVE_VASPRINTF
145         (void)(buf);
146 #else
147         free(buf);
148 #endif
149 }
150         
151
152 /*
153  * Convert a string to a jim_wide INTEGER.
154  * This function originates from BSD.
155  *
156  * Ignores `locale' stuff.  Assumes that the upper and lower case
157  * alphabets and digits are each contiguous.
158  */
159 #ifdef HAVE_LONG_LONG
160 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
161 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
162 {
163     register const char *s;
164     register unsigned jim_wide acc;
165     register unsigned char c;
166     register unsigned jim_wide qbase, cutoff;
167     register int neg, any, cutlim;
168
169     /*
170      * Skip white space and pick up leading +/- sign if any.
171      * If base is 0, allow 0x for hex and 0 for octal, else
172      * assume decimal; if base is already 16, allow 0x.
173      */
174     s = nptr;
175     do {
176         c = *s++;
177     } while (isspace(c));
178     if (c == '-') {
179         neg = 1;
180         c = *s++;
181     } else {
182         neg = 0;
183         if (c == '+')
184             c = *s++;
185     }
186     if ((base == 0 || base == 16) &&
187         c == '0' && (*s == 'x' || *s == 'X')) {
188         c = s[1];
189         s += 2;
190         base = 16;
191     }
192     if (base == 0)
193         base = c == '0' ? 8 : 10;
194
195     /*
196      * Compute the cutoff value between legal numbers and illegal
197      * numbers.  That is the largest legal value, divided by the
198      * base.  An input number that is greater than this value, if
199      * followed by a legal input character, is too big.  One that
200      * is equal to this value may be valid or not; the limit
201      * between valid and invalid numbers is then based on the last
202      * digit.  For instance, if the range for quads is
203      * [-9223372036854775808..9223372036854775807] and the input base
204      * is 10, cutoff will be set to 922337203685477580 and cutlim to
205      * either 7 (neg==0) or 8 (neg==1), meaning that if we have
206      * accumulated a value > 922337203685477580, or equal but the
207      * next digit is > 7 (or 8), the number is too big, and we will
208      * return a range error.
209      *
210      * Set any if any `digits' consumed; make it negative to indicate
211      * overflow.
212      */
213     qbase = (unsigned)base;
214     cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
215         : LLONG_MAX;
216     cutlim = (int)(cutoff % qbase);
217     cutoff /= qbase;
218     for (acc = 0, any = 0;; c = *s++) {
219         if (!JimIsAscii(c))
220             break;
221         if (isdigit(c))
222             c -= '0';
223         else if (isalpha(c))
224             c -= isupper(c) ? 'A' - 10 : 'a' - 10;
225         else
226             break;
227         if (c >= base)
228             break;
229         if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
230             any = -1;
231         else {
232             any = 1;
233             acc *= qbase;
234             acc += c;
235         }
236     }
237     if (any < 0) {
238         acc = neg ? LLONG_MIN : LLONG_MAX;
239         errno = ERANGE;
240     } else if (neg)
241         acc = -acc;
242     if (endptr != 0)
243         *endptr = (char *)(any ? s - 1 : nptr);
244     return (acc);
245 }
246 #endif
247
248 /* Glob-style pattern matching. */
249 static int JimStringMatch(const char *pattern, int patternLen,
250         const char *string, int stringLen, int nocase)
251 {
252     while(patternLen) {
253         switch(pattern[0]) {
254         case '*':
255             while (pattern[1] == '*') {
256                 pattern++;
257                 patternLen--;
258             }
259             if (patternLen == 1)
260                 return 1; /* match */
261             while(stringLen) {
262                 if (JimStringMatch(pattern+1, patternLen-1,
263                             string, stringLen, nocase))
264                     return 1; /* match */
265                 string++;
266                 stringLen--;
267             }
268             return 0; /* no match */
269             break;
270         case '?':
271             if (stringLen == 0)
272                 return 0; /* no match */
273             string++;
274             stringLen--;
275             break;
276         case '[':
277         {
278             int not, match;
279
280             pattern++;
281             patternLen--;
282             not = pattern[0] == '^';
283             if (not) {
284                 pattern++;
285                 patternLen--;
286             }
287             match = 0;
288             while(1) {
289                 if (pattern[0] == '\\') {
290                     pattern++;
291                     patternLen--;
292                     if (pattern[0] == string[0])
293                         match = 1;
294                 } else if (pattern[0] == ']') {
295                     break;
296                 } else if (patternLen == 0) {
297                     pattern--;
298                     patternLen++;
299                     break;
300                 } else if (pattern[1] == '-' && patternLen >= 3) {
301                     int start = pattern[0];
302                     int end = pattern[2];
303                     int c = string[0];
304                     if (start > end) {
305                         int t = start;
306                         start = end;
307                         end = t;
308                     }
309                     if (nocase) {
310                         start = tolower(start);
311                         end = tolower(end);
312                         c = tolower(c);
313                     }
314                     pattern += 2;
315                     patternLen -= 2;
316                     if (c >= start && c <= end)
317                         match = 1;
318                 } else {
319                     if (!nocase) {
320                         if (pattern[0] == string[0])
321                             match = 1;
322                     } else {
323                         if (tolower((int)pattern[0]) == tolower((int)string[0]))
324                             match = 1;
325                     }
326                 }
327                 pattern++;
328                 patternLen--;
329             }
330             if (not)
331                 match = !match;
332             if (!match)
333                 return 0; /* no match */
334             string++;
335             stringLen--;
336             break;
337         }
338         case '\\':
339             if (patternLen >= 2) {
340                 pattern++;
341                 patternLen--;
342             }
343             /* fall through */
344         default:
345             if (!nocase) {
346                 if (pattern[0] != string[0])
347                     return 0; /* no match */
348             } else {
349                 if (tolower((int)pattern[0]) != tolower((int)string[0]))
350                     return 0; /* no match */
351             }
352             string++;
353             stringLen--;
354             break;
355         }
356         pattern++;
357         patternLen--;
358         if (stringLen == 0) {
359             while(*pattern == '*') {
360                 pattern++;
361                 patternLen--;
362             }
363             break;
364         }
365     }
366     if (patternLen == 0 && stringLen == 0)
367         return 1;
368     return 0;
369 }
370
371 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
372         int nocase)
373 {
374     unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
375
376     if (nocase == 0) {
377         while(l1 && l2) {
378             if (*u1 != *u2)
379                 return (int)*u1-*u2;
380             u1++; u2++; l1--; l2--;
381         }
382         if (!l1 && !l2) return 0;
383         return l1-l2;
384     } else {
385         while(l1 && l2) {
386             if (tolower((int)*u1) != tolower((int)*u2))
387                 return tolower((int)*u1)-tolower((int)*u2);
388             u1++; u2++; l1--; l2--;
389         }
390         if (!l1 && !l2) return 0;
391         return l1-l2;
392     }
393 }
394
395 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
396  * The index of the first occurrence of s1 in s2 is returned. 
397  * If s1 is not found inside s2, -1 is returned. */
398 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
399 {
400     int i;
401
402     if (!l1 || !l2 || l1 > l2) return -1;
403     if (index < 0) index = 0;
404     s2 += index;
405     for (i = index; i <= l2-l1; i++) {
406         if (memcmp(s2, s1, l1) == 0)
407             return i;
408         s2++;
409     }
410     return -1;
411 }
412
413 int Jim_WideToString(char *buf, jim_wide wideValue)
414 {
415     const char *fmt = "%" JIM_WIDE_MODIFIER;
416     return sprintf(buf, fmt, wideValue);
417 }
418
419 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
420 {
421     char *endptr;
422
423 #ifdef HAVE_LONG_LONG
424     *widePtr = JimStrtoll(str, &endptr, base);
425 #else
426     *widePtr = strtol(str, &endptr, base);
427 #endif
428     if ((str[0] == '\0') || (str == endptr) )
429         return JIM_ERR;
430     if (endptr[0] != '\0') {
431         while(*endptr) {
432             if (!isspace((int)*endptr))
433                 return JIM_ERR;
434             endptr++;
435         }
436     }
437     return JIM_OK;
438 }
439
440 int Jim_StringToIndex(const char *str, int *intPtr)
441 {
442     char *endptr;
443
444     *intPtr = strtol(str, &endptr, 10);
445     if ( (str[0] == '\0') || (str == endptr) )
446         return JIM_ERR;
447     if (endptr[0] != '\0') {
448         while(*endptr) {
449             if (!isspace((int)*endptr))
450                 return JIM_ERR;
451             endptr++;
452         }
453     }
454     return JIM_OK;
455 }
456
457 /* The string representation of references has two features in order
458  * to make the GC faster. The first is that every reference starts
459  * with a non common character '~', in order to make the string matching
460  * fater. The second is that the reference string rep his 32 characters
461  * in length, this allows to avoid to check every object with a string
462  * repr < 32, and usually there are many of this objects. */
463
464 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
465
466 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
467 {
468     const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
469     sprintf(buf, fmt, refPtr->tag, id);
470     return JIM_REFERENCE_SPACE;
471 }
472
473 int Jim_DoubleToString(char *buf, double doubleValue)
474 {
475     char *s;
476     int len;
477
478     len = sprintf(buf, "%.17g", doubleValue);
479     s = buf;
480     while(*s) {
481         if (*s == '.') return len;
482         s++;
483     }
484     /* Add a final ".0" if it's a number. But not
485      * for NaN or InF */
486     if (isdigit((int)buf[0])
487         || ((buf[0] == '-' || buf[0] == '+')
488             && isdigit((int)buf[1]))) {
489         s[0] = '.';
490         s[1] = '0';
491         s[2] = '\0';
492         return len+2;
493     }
494     return len;
495 }
496
497 int Jim_StringToDouble(const char *str, double *doublePtr)
498 {
499     char *endptr;
500
501     *doublePtr = strtod(str, &endptr);
502     if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
503         return JIM_ERR;
504     return JIM_OK;
505 }
506
507 static jim_wide JimPowWide(jim_wide b, jim_wide e)
508 {
509     jim_wide i, res = 1;
510     if ((b==0 && e!=0) || (e<0)) return 0;
511     for(i=0; i<e; i++) {res *= b;}
512     return res;
513 }
514
515 /* -----------------------------------------------------------------------------
516  * Special functions
517  * ---------------------------------------------------------------------------*/
518
519 /* Note that 'interp' may be NULL if not available in the
520  * context of the panic. It's only useful to get the error
521  * file descriptor, it will default to stderr otherwise. */
522 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
523 {
524     va_list ap;
525
526     va_start(ap, fmt);
527         /* 
528          * Send it here first.. Assuming STDIO still works
529          */
530     fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
531     vfprintf(stderr, fmt, ap);
532     fprintf(stderr, JIM_NL JIM_NL);
533     va_end(ap);
534
535 #ifdef HAVE_BACKTRACE
536     {
537         void *array[40];
538         int size, i;
539         char **strings;
540
541         size = backtrace(array, 40);
542         strings = backtrace_symbols(array, size);
543         for (i = 0; i < size; i++)
544             fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
545         fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
546         fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
547     }
548 #endif
549         
550         /* This may actually crash... we do it last */
551         if( interp && interp->cookie_stderr ){
552                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
553                 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
554                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL JIM_NL );
555         }
556     abort();
557 }
558
559 /* -----------------------------------------------------------------------------
560  * Memory allocation
561  * ---------------------------------------------------------------------------*/
562
563 /* Macro used for memory debugging.
564  * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
565  * and similary for Jim_Realloc and Jim_Free */
566 #if 0
567 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
568 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
569 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
570 #endif
571
572 void *Jim_Alloc(int size)
573 {
574         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
575         if (size==0)
576                 size=1;
577     void *p = malloc(size);
578     if (p == NULL)
579         Jim_Panic(NULL,"malloc: Out of memory");
580     return p;
581 }
582
583 void Jim_Free(void *ptr) {
584     free(ptr);
585 }
586
587 void *Jim_Realloc(void *ptr, int size)
588 {
589         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
590         if (size==0)
591                 size=1;
592     void *p = realloc(ptr, size);
593     if (p == NULL)
594         Jim_Panic(NULL,"realloc: Out of memory");
595     return p;
596 }
597
598 char *Jim_StrDup(const char *s)
599 {
600     int l = strlen(s);
601     char *copy = Jim_Alloc(l+1);
602
603     memcpy(copy, s, l+1);
604     return copy;
605 }
606
607 char *Jim_StrDupLen(const char *s, int l)
608 {
609     char *copy = Jim_Alloc(l+1);
610     
611     memcpy(copy, s, l+1);
612     copy[l] = 0;    /* Just to be sure, original could be substring */
613     return copy;
614 }
615
616 /* -----------------------------------------------------------------------------
617  * Time related functions
618  * ---------------------------------------------------------------------------*/
619 /* Returns microseconds of CPU used since start. */
620 static jim_wide JimClock(void)
621 {
622 #if (defined WIN32) && !(defined JIM_ANSIC)
623     LARGE_INTEGER t, f;
624     QueryPerformanceFrequency(&f);
625     QueryPerformanceCounter(&t);
626     return (long)((t.QuadPart * 1000000) / f.QuadPart);
627 #else /* !WIN32 */
628     clock_t clocks = clock();
629
630     return (long)(clocks*(1000000/CLOCKS_PER_SEC));
631 #endif /* WIN32 */
632 }
633
634 /* -----------------------------------------------------------------------------
635  * Hash Tables
636  * ---------------------------------------------------------------------------*/
637
638 /* -------------------------- private prototypes ---------------------------- */
639 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
640 static unsigned int JimHashTableNextPower(unsigned int size);
641 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
642
643 /* -------------------------- hash functions -------------------------------- */
644
645 /* Thomas Wang's 32 bit Mix Function */
646 unsigned int Jim_IntHashFunction(unsigned int key)
647 {
648     key += ~(key << 15);
649     key ^=  (key >> 10);
650     key +=  (key << 3);
651     key ^=  (key >> 6);
652     key += ~(key << 11);
653     key ^=  (key >> 16);
654     return key;
655 }
656
657 /* Identity hash function for integer keys */
658 unsigned int Jim_IdentityHashFunction(unsigned int key)
659 {
660     return key;
661 }
662
663 /* Generic hash function (we are using to multiply by 9 and add the byte
664  * as Tcl) */
665 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
666 {
667     unsigned int h = 0;
668     while(len--)
669         h += (h<<3)+*buf++;
670     return h;
671 }
672
673 /* ----------------------------- API implementation ------------------------- */
674 /* reset an hashtable already initialized with ht_init().
675  * NOTE: This function should only called by ht_destroy(). */
676 static void JimResetHashTable(Jim_HashTable *ht)
677 {
678     ht->table = NULL;
679     ht->size = 0;
680     ht->sizemask = 0;
681     ht->used = 0;
682     ht->collisions = 0;
683 }
684
685 /* Initialize the hash table */
686 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
687         void *privDataPtr)
688 {
689     JimResetHashTable(ht);
690     ht->type = type;
691     ht->privdata = privDataPtr;
692     return JIM_OK;
693 }
694
695 /* Resize the table to the minimal size that contains all the elements,
696  * but with the invariant of a USER/BUCKETS ration near to <= 1 */
697 int Jim_ResizeHashTable(Jim_HashTable *ht)
698 {
699     int minimal = ht->used;
700
701     if (minimal < JIM_HT_INITIAL_SIZE)
702         minimal = JIM_HT_INITIAL_SIZE;
703     return Jim_ExpandHashTable(ht, minimal);
704 }
705
706 /* Expand or create the hashtable */
707 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
708 {
709     Jim_HashTable n; /* the new hashtable */
710     unsigned int realsize = JimHashTableNextPower(size), i;
711
712     /* the size is invalid if it is smaller than the number of
713      * elements already inside the hashtable */
714     if (ht->used >= size)
715         return JIM_ERR;
716
717     Jim_InitHashTable(&n, ht->type, ht->privdata);
718     n.size = realsize;
719     n.sizemask = realsize-1;
720     n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
721
722     /* Initialize all the pointers to NULL */
723     memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
724
725     /* Copy all the elements from the old to the new table:
726      * note that if the old hash table is empty ht->size is zero,
727      * so Jim_ExpandHashTable just creates an hash table. */
728     n.used = ht->used;
729     for (i = 0; i < ht->size && ht->used > 0; i++) {
730         Jim_HashEntry *he, *nextHe;
731
732         if (ht->table[i] == NULL) continue;
733         
734         /* For each hash entry on this slot... */
735         he = ht->table[i];
736         while(he) {
737             unsigned int h;
738
739             nextHe = he->next;
740             /* Get the new element index */
741             h = Jim_HashKey(ht, he->key) & n.sizemask;
742             he->next = n.table[h];
743             n.table[h] = he;
744             ht->used--;
745             /* Pass to the next element */
746             he = nextHe;
747         }
748     }
749     assert(ht->used == 0);
750     Jim_Free(ht->table);
751
752     /* Remap the new hashtable in the old */
753     *ht = n;
754     return JIM_OK;
755 }
756
757 /* Add an element to the target hash table */
758 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
759 {
760     int index;
761     Jim_HashEntry *entry;
762
763     /* Get the index of the new element, or -1 if
764      * the element already exists. */
765     if ((index = JimInsertHashEntry(ht, key)) == -1)
766         return JIM_ERR;
767
768     /* Allocates the memory and stores key */
769     entry = Jim_Alloc(sizeof(*entry));
770     entry->next = ht->table[index];
771     ht->table[index] = entry;
772
773     /* Set the hash entry fields. */
774     Jim_SetHashKey(ht, entry, key);
775     Jim_SetHashVal(ht, entry, val);
776     ht->used++;
777     return JIM_OK;
778 }
779
780 /* Add an element, discarding the old if the key already exists */
781 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
782 {
783     Jim_HashEntry *entry;
784
785     /* Try to add the element. If the key
786      * does not exists Jim_AddHashEntry will suceed. */
787     if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
788         return JIM_OK;
789     /* It already exists, get the entry */
790     entry = Jim_FindHashEntry(ht, key);
791     /* Free the old value and set the new one */
792     Jim_FreeEntryVal(ht, entry);
793     Jim_SetHashVal(ht, entry, val);
794     return JIM_OK;
795 }
796
797 /* Search and remove an element */
798 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
799 {
800     unsigned int h;
801     Jim_HashEntry *he, *prevHe;
802
803     if (ht->size == 0)
804         return JIM_ERR;
805     h = Jim_HashKey(ht, key) & ht->sizemask;
806     he = ht->table[h];
807
808     prevHe = NULL;
809     while(he) {
810         if (Jim_CompareHashKeys(ht, key, he->key)) {
811             /* Unlink the element from the list */
812             if (prevHe)
813                 prevHe->next = he->next;
814             else
815                 ht->table[h] = he->next;
816             Jim_FreeEntryKey(ht, he);
817             Jim_FreeEntryVal(ht, he);
818             Jim_Free(he);
819             ht->used--;
820             return JIM_OK;
821         }
822         prevHe = he;
823         he = he->next;
824     }
825     return JIM_ERR; /* not found */
826 }
827
828 /* Destroy an entire hash table */
829 int Jim_FreeHashTable(Jim_HashTable *ht)
830 {
831     unsigned int i;
832
833     /* Free all the elements */
834     for (i = 0; i < ht->size && ht->used > 0; i++) {
835         Jim_HashEntry *he, *nextHe;
836
837         if ((he = ht->table[i]) == NULL) continue;
838         while(he) {
839             nextHe = he->next;
840             Jim_FreeEntryKey(ht, he);
841             Jim_FreeEntryVal(ht, he);
842             Jim_Free(he);
843             ht->used--;
844             he = nextHe;
845         }
846     }
847     /* Free the table and the allocated cache structure */
848     Jim_Free(ht->table);
849     /* Re-initialize the table */
850     JimResetHashTable(ht);
851     return JIM_OK; /* never fails */
852 }
853
854 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
855 {
856     Jim_HashEntry *he;
857     unsigned int h;
858
859     if (ht->size == 0) return NULL;
860     h = Jim_HashKey(ht, key) & ht->sizemask;
861     he = ht->table[h];
862     while(he) {
863         if (Jim_CompareHashKeys(ht, key, he->key))
864             return he;
865         he = he->next;
866     }
867     return NULL;
868 }
869
870 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
871 {
872     Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
873
874     iter->ht = ht;
875     iter->index = -1;
876     iter->entry = NULL;
877     iter->nextEntry = NULL;
878     return iter;
879 }
880
881 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
882 {
883     while (1) {
884         if (iter->entry == NULL) {
885             iter->index++;
886             if (iter->index >=
887                     (signed)iter->ht->size) break;
888             iter->entry = iter->ht->table[iter->index];
889         } else {
890             iter->entry = iter->nextEntry;
891         }
892         if (iter->entry) {
893             /* We need to save the 'next' here, the iterator user
894              * may delete the entry we are returning. */
895             iter->nextEntry = iter->entry->next;
896             return iter->entry;
897         }
898     }
899     return NULL;
900 }
901
902 /* ------------------------- private functions ------------------------------ */
903
904 /* Expand the hash table if needed */
905 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
906 {
907     /* If the hash table is empty expand it to the intial size,
908      * if the table is "full" dobule its size. */
909     if (ht->size == 0)
910         return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
911     if (ht->size == ht->used)
912         return Jim_ExpandHashTable(ht, ht->size*2);
913     return JIM_OK;
914 }
915
916 /* Our hash table capability is a power of two */
917 static unsigned int JimHashTableNextPower(unsigned int size)
918 {
919     unsigned int i = JIM_HT_INITIAL_SIZE;
920
921     if (size >= 2147483648U)
922         return 2147483648U;
923     while(1) {
924         if (i >= size)
925             return i;
926         i *= 2;
927     }
928 }
929
930 /* Returns the index of a free slot that can be populated with
931  * an hash entry for the given 'key'.
932  * If the key already exists, -1 is returned. */
933 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
934 {
935     unsigned int h;
936     Jim_HashEntry *he;
937
938     /* Expand the hashtable if needed */
939     if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
940         return -1;
941     /* Compute the key hash value */
942     h = Jim_HashKey(ht, key) & ht->sizemask;
943     /* Search if this slot does not already contain the given key */
944     he = ht->table[h];
945     while(he) {
946         if (Jim_CompareHashKeys(ht, key, he->key))
947             return -1;
948         he = he->next;
949     }
950     return h;
951 }
952
953 /* ----------------------- StringCopy Hash Table Type ------------------------*/
954
955 static unsigned int JimStringCopyHTHashFunction(const void *key)
956 {
957     return Jim_GenHashFunction(key, strlen(key));
958 }
959
960 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
961 {
962     int len = strlen(key);
963     char *copy = Jim_Alloc(len+1);
964     JIM_NOTUSED(privdata);
965
966     memcpy(copy, key, len);
967     copy[len] = '\0';
968     return copy;
969 }
970
971 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
972 {
973     int len = strlen(val);
974     char *copy = Jim_Alloc(len+1);
975     JIM_NOTUSED(privdata);
976
977     memcpy(copy, val, len);
978     copy[len] = '\0';
979     return copy;
980 }
981
982 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
983         const void *key2)
984 {
985     JIM_NOTUSED(privdata);
986
987     return strcmp(key1, key2) == 0;
988 }
989
990 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
991 {
992     JIM_NOTUSED(privdata);
993
994     Jim_Free((void*)key); /* ATTENTION: const cast */
995 }
996
997 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
998 {
999     JIM_NOTUSED(privdata);
1000
1001     Jim_Free((void*)val); /* ATTENTION: const cast */
1002 }
1003
1004 static Jim_HashTableType JimStringCopyHashTableType = {
1005     JimStringCopyHTHashFunction,        /* hash function */
1006     JimStringCopyHTKeyDup,              /* 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 does not auto-duplicate the key.
1014  * It's used for intepreter's shared strings. */
1015 static Jim_HashTableType JimSharedStringsHashTableType = {
1016     JimStringCopyHTHashFunction,        /* hash function */
1017     NULL,                               /* key dup */
1018     NULL,                               /* val dup */
1019     JimStringCopyHTKeyCompare,          /* key compare */
1020     JimStringCopyHTKeyDestructor,       /* key destructor */
1021     NULL                                /* val destructor */
1022 };
1023
1024 /* This is like StringCopy but also automatically handle dynamic
1025  * allocated C strings as values. */
1026 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1027     JimStringCopyHTHashFunction,        /* hash function */
1028     JimStringCopyHTKeyDup,              /* key dup */
1029     JimStringKeyValCopyHTValDup,        /* val dup */
1030     JimStringCopyHTKeyCompare,          /* key compare */
1031     JimStringCopyHTKeyDestructor,       /* key destructor */
1032     JimStringKeyValCopyHTValDestructor, /* val destructor */
1033 };
1034
1035 typedef struct AssocDataValue {
1036     Jim_InterpDeleteProc *delProc;
1037     void *data;
1038 } AssocDataValue;
1039
1040 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1041 {
1042     AssocDataValue *assocPtr = (AssocDataValue *)data;
1043     if (assocPtr->delProc != NULL)
1044         assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1045     Jim_Free(data);
1046 }
1047
1048 static Jim_HashTableType JimAssocDataHashTableType = {
1049     JimStringCopyHTHashFunction,         /* hash function */
1050     JimStringCopyHTKeyDup,               /* key dup */
1051     NULL,                                /* val dup */
1052     JimStringCopyHTKeyCompare,           /* key compare */
1053     JimStringCopyHTKeyDestructor,        /* key destructor */
1054     JimAssocDataHashTableValueDestructor /* val destructor */
1055 };
1056
1057 /* -----------------------------------------------------------------------------
1058  * Stack - This is a simple generic stack implementation. It is used for
1059  * example in the 'expr' expression compiler.
1060  * ---------------------------------------------------------------------------*/
1061 void Jim_InitStack(Jim_Stack *stack)
1062 {
1063     stack->len = 0;
1064     stack->maxlen = 0;
1065     stack->vector = NULL;
1066 }
1067
1068 void Jim_FreeStack(Jim_Stack *stack)
1069 {
1070     Jim_Free(stack->vector);
1071 }
1072
1073 int Jim_StackLen(Jim_Stack *stack)
1074 {
1075     return stack->len;
1076 }
1077
1078 void Jim_StackPush(Jim_Stack *stack, void *element) {
1079     int neededLen = stack->len+1;
1080     if (neededLen > stack->maxlen) {
1081         stack->maxlen = neededLen*2;
1082         stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1083     }
1084     stack->vector[stack->len] = element;
1085     stack->len++;
1086 }
1087
1088 void *Jim_StackPop(Jim_Stack *stack)
1089 {
1090     if (stack->len == 0) return NULL;
1091     stack->len--;
1092     return stack->vector[stack->len];
1093 }
1094
1095 void *Jim_StackPeek(Jim_Stack *stack)
1096 {
1097     if (stack->len == 0) return NULL;
1098     return stack->vector[stack->len-1];
1099 }
1100
1101 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1102 {
1103     int i;
1104
1105     for (i = 0; i < stack->len; i++)
1106         freeFunc(stack->vector[i]);
1107 }
1108
1109 /* -----------------------------------------------------------------------------
1110  * Parser
1111  * ---------------------------------------------------------------------------*/
1112
1113 /* Token types */
1114 #define JIM_TT_NONE -1        /* No token returned */
1115 #define JIM_TT_STR 0        /* simple string */
1116 #define JIM_TT_ESC 1        /* string that needs escape chars conversion */
1117 #define JIM_TT_VAR 2        /* var substitution */
1118 #define JIM_TT_DICTSUGAR 3    /* Syntax sugar for [dict get], $foo(bar) */
1119 #define JIM_TT_CMD 4        /* command substitution */
1120 #define JIM_TT_SEP 5        /* word separator */
1121 #define JIM_TT_EOL 6        /* line separator */
1122
1123 /* Additional token types needed for expressions */
1124 #define JIM_TT_SUBEXPR_START 7
1125 #define JIM_TT_SUBEXPR_END 8
1126 #define JIM_TT_EXPR_NUMBER 9
1127 #define JIM_TT_EXPR_OPERATOR 10
1128
1129 /* Parser states */
1130 #define JIM_PS_DEF 0        /* Default state */
1131 #define JIM_PS_QUOTE 1        /* Inside "" */
1132
1133 /* Parser context structure. The same context is used both to parse
1134  * Tcl scripts and lists. */
1135 struct JimParserCtx {
1136     const char *prg;     /* Program text */
1137     const char *p;       /* Pointer to the point of the program we are parsing */
1138     int len;             /* Left length of 'prg' */
1139     int linenr;          /* Current line number */
1140     const char *tstart;
1141     const char *tend;    /* Returned token is at tstart-tend in 'prg'. */
1142     int tline;           /* Line number of the returned token */
1143     int tt;              /* Token type */
1144     int eof;             /* Non zero if EOF condition is true. */
1145     int state;           /* Parser state */
1146     int comment;         /* Non zero if the next chars may be a comment. */
1147 };
1148
1149 #define JimParserEof(c) ((c)->eof)
1150 #define JimParserTstart(c) ((c)->tstart)
1151 #define JimParserTend(c) ((c)->tend)
1152 #define JimParserTtype(c) ((c)->tt)
1153 #define JimParserTline(c) ((c)->tline)
1154
1155 static int JimParseScript(struct JimParserCtx *pc);
1156 static int JimParseSep(struct JimParserCtx *pc);
1157 static int JimParseEol(struct JimParserCtx *pc);
1158 static int JimParseCmd(struct JimParserCtx *pc);
1159 static int JimParseVar(struct JimParserCtx *pc);
1160 static int JimParseBrace(struct JimParserCtx *pc);
1161 static int JimParseStr(struct JimParserCtx *pc);
1162 static int JimParseComment(struct JimParserCtx *pc);
1163 static char *JimParserGetToken(struct JimParserCtx *pc,
1164         int *lenPtr, int *typePtr, int *linePtr);
1165
1166 /* Initialize a parser context.
1167  * 'prg' is a pointer to the program text, linenr is the line
1168  * number of the first line contained in the program. */
1169 void JimParserInit(struct JimParserCtx *pc, const char *prg, 
1170         int len, int linenr)
1171 {
1172     pc->prg = prg;
1173     pc->p = prg;
1174     pc->len = len;
1175     pc->tstart = NULL;
1176     pc->tend = NULL;
1177     pc->tline = 0;
1178     pc->tt = JIM_TT_NONE;
1179     pc->eof = 0;
1180     pc->state = JIM_PS_DEF;
1181     pc->linenr = linenr;
1182     pc->comment = 1;
1183 }
1184
1185 int JimParseScript(struct JimParserCtx *pc)
1186 {
1187     while(1) { /* the while is used to reiterate with continue if needed */
1188         if (!pc->len) {
1189             pc->tstart = pc->p;
1190             pc->tend = pc->p-1;
1191             pc->tline = pc->linenr;
1192             pc->tt = JIM_TT_EOL;
1193             pc->eof = 1;
1194             return JIM_OK;
1195         }
1196         switch(*(pc->p)) {
1197         case '\\':
1198             if (*(pc->p+1) == '\n')
1199                 return JimParseSep(pc);
1200             else {
1201                 pc->comment = 0;
1202                 return JimParseStr(pc);
1203             }
1204             break;
1205         case ' ':
1206         case '\t':
1207         case '\r':
1208             if (pc->state == JIM_PS_DEF)
1209                 return JimParseSep(pc);
1210             else {
1211                 pc->comment = 0;
1212                 return JimParseStr(pc);
1213             }
1214             break;
1215         case '\n':
1216         case ';':
1217             pc->comment = 1;
1218             if (pc->state == JIM_PS_DEF)
1219                 return JimParseEol(pc);
1220             else
1221                 return JimParseStr(pc);
1222             break;
1223         case '[':
1224             pc->comment = 0;
1225             return JimParseCmd(pc);
1226             break;
1227         case '$':
1228             pc->comment = 0;
1229             if (JimParseVar(pc) == JIM_ERR) {
1230                 pc->tstart = pc->tend = pc->p++; pc->len--;
1231                 pc->tline = pc->linenr;
1232                 pc->tt = JIM_TT_STR;
1233                 return JIM_OK;
1234             } else
1235                 return JIM_OK;
1236             break;
1237         case '#':
1238             if (pc->comment) {
1239                 JimParseComment(pc);
1240                 continue;
1241             } else {
1242                 return JimParseStr(pc);
1243             }
1244         default:
1245             pc->comment = 0;
1246             return JimParseStr(pc);
1247             break;
1248         }
1249         return JIM_OK;
1250     }
1251 }
1252
1253 int JimParseSep(struct JimParserCtx *pc)
1254 {
1255     pc->tstart = pc->p;
1256     pc->tline = pc->linenr;
1257     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1258            (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1259         if (*pc->p == '\\') {
1260             pc->p++; pc->len--;
1261             pc->linenr++;
1262         }
1263         pc->p++; pc->len--;
1264     }
1265     pc->tend = pc->p-1;
1266     pc->tt = JIM_TT_SEP;
1267     return JIM_OK;
1268 }
1269
1270 int JimParseEol(struct JimParserCtx *pc)
1271 {
1272     pc->tstart = pc->p;
1273     pc->tline = pc->linenr;
1274     while (*pc->p == ' ' || *pc->p == '\n' ||
1275            *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1276         if (*pc->p == '\n')
1277             pc->linenr++;
1278         pc->p++; pc->len--;
1279     }
1280     pc->tend = pc->p-1;
1281     pc->tt = JIM_TT_EOL;
1282     return JIM_OK;
1283 }
1284
1285 /* Todo. Don't stop if ']' appears inside {} or quoted.
1286  * Also should handle the case of puts [string length "]"] */
1287 int JimParseCmd(struct JimParserCtx *pc)
1288 {
1289     int level = 1;
1290     int blevel = 0;
1291
1292     pc->tstart = ++pc->p; pc->len--;
1293     pc->tline = pc->linenr;
1294     while (1) {
1295         if (pc->len == 0) {
1296             break;
1297         } else if (*pc->p == '[' && blevel == 0) {
1298             level++;
1299         } else if (*pc->p == ']' && blevel == 0) {
1300             level--;
1301             if (!level) break;
1302         } else if (*pc->p == '\\') {
1303             pc->p++; pc->len--;
1304         } else if (*pc->p == '{') {
1305             blevel++;
1306         } else if (*pc->p == '}') {
1307             if (blevel != 0)
1308                 blevel--;
1309         } else if (*pc->p == '\n')
1310             pc->linenr++;
1311         pc->p++; pc->len--;
1312     }
1313     pc->tend = pc->p-1;
1314     pc->tt = JIM_TT_CMD;
1315     if (*pc->p == ']') {
1316         pc->p++; pc->len--;
1317     }
1318     return JIM_OK;
1319 }
1320
1321 int JimParseVar(struct JimParserCtx *pc)
1322 {
1323     int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1324
1325     pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1326     pc->tline = pc->linenr;
1327     if (*pc->p == '{') {
1328         pc->tstart = ++pc->p; pc->len--;
1329         brace = 1;
1330     }
1331     if (brace) {
1332         while (!stop) {
1333             if (*pc->p == '}' || pc->len == 0) {
1334                 pc->tend = pc->p-1;
1335                 stop = 1;
1336                 if (pc->len == 0)
1337                     break;
1338             }
1339             else if (*pc->p == '\n')
1340                 pc->linenr++;
1341             pc->p++; pc->len--;
1342         }
1343     } else {
1344         /* Include leading colons */
1345         while (*pc->p == ':') {
1346             pc->p++;
1347             pc->len--;
1348         }
1349         while (!stop) {
1350             if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1351                 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1352                 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1353                 stop = 1;
1354             else {
1355                 pc->p++; pc->len--;
1356             }
1357         }
1358         /* Parse [dict get] syntax sugar. */
1359         if (*pc->p == '(') {
1360             while (*pc->p != ')' && pc->len) {
1361                 pc->p++; pc->len--;
1362                 if (*pc->p == '\\' && pc->len >= 2) {
1363                     pc->p += 2; pc->len -= 2;
1364                 }
1365             }
1366             if (*pc->p != '\0') {
1367                 pc->p++; pc->len--;
1368             }
1369             ttype = JIM_TT_DICTSUGAR;
1370         }
1371         pc->tend = pc->p-1;
1372     }
1373     /* Check if we parsed just the '$' character.
1374      * That's not a variable so an error is returned
1375      * to tell the state machine to consider this '$' just
1376      * a string. */
1377     if (pc->tstart == pc->p) {
1378         pc->p--; pc->len++;
1379         return JIM_ERR;
1380     }
1381     pc->tt = ttype;
1382     return JIM_OK;
1383 }
1384
1385 int JimParseBrace(struct JimParserCtx *pc)
1386 {
1387     int level = 1;
1388
1389     pc->tstart = ++pc->p; pc->len--;
1390     pc->tline = pc->linenr;
1391     while (1) {
1392         if (*pc->p == '\\' && pc->len >= 2) {
1393             pc->p++; pc->len--;
1394             if (*pc->p == '\n')
1395                 pc->linenr++;
1396         } else if (*pc->p == '{') {
1397             level++;
1398         } else if (pc->len == 0 || *pc->p == '}') {
1399             level--;
1400             if (pc->len == 0 || level == 0) {
1401                 pc->tend = pc->p-1;
1402                 if (pc->len != 0) {
1403                     pc->p++; pc->len--;
1404                 }
1405                 pc->tt = JIM_TT_STR;
1406                 return JIM_OK;
1407             }
1408         } else if (*pc->p == '\n') {
1409             pc->linenr++;
1410         }
1411         pc->p++; pc->len--;
1412     }
1413     return JIM_OK; /* unreached */
1414 }
1415
1416 int JimParseStr(struct JimParserCtx *pc)
1417 {
1418     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1419             pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1420     if (newword && *pc->p == '{') {
1421         return JimParseBrace(pc);
1422     } else if (newword && *pc->p == '"') {
1423         pc->state = JIM_PS_QUOTE;
1424         pc->p++; pc->len--;
1425     }
1426     pc->tstart = pc->p;
1427     pc->tline = pc->linenr;
1428     while (1) {
1429         if (pc->len == 0) {
1430             pc->tend = pc->p-1;
1431             pc->tt = JIM_TT_ESC;
1432             return JIM_OK;
1433         }
1434         switch(*pc->p) {
1435         case '\\':
1436             if (pc->state == JIM_PS_DEF &&
1437                 *(pc->p+1) == '\n') {
1438                 pc->tend = pc->p-1;
1439                 pc->tt = JIM_TT_ESC;
1440                 return JIM_OK;
1441             }
1442             if (pc->len >= 2) {
1443                 pc->p++; pc->len--;
1444             }
1445             break;
1446         case '$':
1447         case '[':
1448             pc->tend = pc->p-1;
1449             pc->tt = JIM_TT_ESC;
1450             return JIM_OK;
1451         case ' ':
1452         case '\t':
1453         case '\n':
1454         case '\r':
1455         case ';':
1456             if (pc->state == JIM_PS_DEF) {
1457                 pc->tend = pc->p-1;
1458                 pc->tt = JIM_TT_ESC;
1459                 return JIM_OK;
1460             } else if (*pc->p == '\n') {
1461                 pc->linenr++;
1462             }
1463             break;
1464         case '"':
1465             if (pc->state == JIM_PS_QUOTE) {
1466                 pc->tend = pc->p-1;
1467                 pc->tt = JIM_TT_ESC;
1468                 pc->p++; pc->len--;
1469                 pc->state = JIM_PS_DEF;
1470                 return JIM_OK;
1471             }
1472             break;
1473         }
1474         pc->p++; pc->len--;
1475     }
1476     return JIM_OK; /* unreached */
1477 }
1478
1479 int JimParseComment(struct JimParserCtx *pc)
1480 {
1481     while (*pc->p) {
1482         if (*pc->p == '\n') {
1483             pc->linenr++;
1484             if (*(pc->p-1) != '\\') {
1485                 pc->p++; pc->len--;
1486                 return JIM_OK;
1487             }
1488         }
1489         pc->p++; pc->len--;
1490     }
1491     return JIM_OK;
1492 }
1493
1494 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1495 static int xdigitval(int c)
1496 {
1497     if (c >= '0' && c <= '9') return c-'0';
1498     if (c >= 'a' && c <= 'f') return c-'a'+10;
1499     if (c >= 'A' && c <= 'F') return c-'A'+10;
1500     return -1;
1501 }
1502
1503 static int odigitval(int c)
1504 {
1505     if (c >= '0' && c <= '7') return c-'0';
1506     return -1;
1507 }
1508
1509 /* Perform Tcl escape substitution of 's', storing the result
1510  * string into 'dest'. The escaped string is guaranteed to
1511  * be the same length or shorted than the source string.
1512  * Slen is the length of the string at 's', if it's -1 the string
1513  * length will be calculated by the function.
1514  *
1515  * The function returns the length of the resulting string. */
1516 static int JimEscape(char *dest, const char *s, int slen)
1517 {
1518     char *p = dest;
1519     int i, len;
1520     
1521     if (slen == -1)
1522         slen = strlen(s);
1523
1524     for (i = 0; i < slen; i++) {
1525         switch(s[i]) {
1526         case '\\':
1527             switch(s[i+1]) {
1528             case 'a': *p++ = 0x7; i++; break;
1529             case 'b': *p++ = 0x8; i++; break;
1530             case 'f': *p++ = 0xc; i++; break;
1531             case 'n': *p++ = 0xa; i++; break;
1532             case 'r': *p++ = 0xd; i++; break;
1533             case 't': *p++ = 0x9; i++; break;
1534             case 'v': *p++ = 0xb; i++; break;
1535             case '\0': *p++ = '\\'; i++; break;
1536             case '\n': *p++ = ' '; i++; break;
1537             default:
1538                   if (s[i+1] == 'x') {
1539                     int val = 0;
1540                     int c = xdigitval(s[i+2]);
1541                     if (c == -1) {
1542                         *p++ = 'x';
1543                         i++;
1544                         break;
1545                     }
1546                     val = c;
1547                     c = xdigitval(s[i+3]);
1548                     if (c == -1) {
1549                         *p++ = val;
1550                         i += 2;
1551                         break;
1552                     }
1553                     val = (val*16)+c;
1554                     *p++ = val;
1555                     i += 3;
1556                     break;
1557                   } else if (s[i+1] >= '0' && s[i+1] <= '7')
1558                   {
1559                     int val = 0;
1560                     int c = odigitval(s[i+1]);
1561                     val = c;
1562                     c = odigitval(s[i+2]);
1563                     if (c == -1) {
1564                         *p++ = val;
1565                         i ++;
1566                         break;
1567                     }
1568                     val = (val*8)+c;
1569                     c = odigitval(s[i+3]);
1570                     if (c == -1) {
1571                         *p++ = val;
1572                         i += 2;
1573                         break;
1574                     }
1575                     val = (val*8)+c;
1576                     *p++ = val;
1577                     i += 3;
1578                   } else {
1579                     *p++ = s[i+1];
1580                     i++;
1581                   }
1582                   break;
1583             }
1584             break;
1585         default:
1586             *p++ = s[i];
1587             break;
1588         }
1589     }
1590     len = p-dest;
1591     *p++ = '\0';
1592     return len;
1593 }
1594
1595 /* Returns a dynamically allocated copy of the current token in the
1596  * parser context. The function perform conversion of escapes if
1597  * the token is of type JIM_TT_ESC.
1598  *
1599  * Note that after the conversion, tokens that are grouped with
1600  * braces in the source code, are always recognizable from the
1601  * identical string obtained in a different way from the type.
1602  *
1603  * For exmple the string:
1604  *
1605  * {expand}$a
1606  * 
1607  * will return as first token "expand", of type JIM_TT_STR
1608  *
1609  * While the string:
1610  *
1611  * expand$a
1612  *
1613  * will return as first token "expand", of type JIM_TT_ESC
1614  */
1615 char *JimParserGetToken(struct JimParserCtx *pc,
1616         int *lenPtr, int *typePtr, int *linePtr)
1617 {
1618     const char *start, *end;
1619     char *token;
1620     int len;
1621
1622     start = JimParserTstart(pc);
1623     end = JimParserTend(pc);
1624     if (start > end) {
1625         if (lenPtr) *lenPtr = 0;
1626         if (typePtr) *typePtr = JimParserTtype(pc);
1627         if (linePtr) *linePtr = JimParserTline(pc);
1628         token = Jim_Alloc(1);
1629         token[0] = '\0';
1630         return token;
1631     }
1632     len = (end-start)+1;
1633     token = Jim_Alloc(len+1);
1634     if (JimParserTtype(pc) != JIM_TT_ESC) {
1635         /* No escape conversion needed? Just copy it. */
1636         memcpy(token, start, len);
1637         token[len] = '\0';
1638     } else {
1639         /* Else convert the escape chars. */
1640         len = JimEscape(token, start, len);
1641     }
1642     if (lenPtr) *lenPtr = len;
1643     if (typePtr) *typePtr = JimParserTtype(pc);
1644     if (linePtr) *linePtr = JimParserTline(pc);
1645     return token;
1646 }
1647
1648 /* The following functin is not really part of the parsing engine of Jim,
1649  * but it somewhat related. Given an string and its length, it tries
1650  * to guess if the script is complete or there are instead " " or { }
1651  * open and not completed. This is useful for interactive shells
1652  * implementation and for [info complete].
1653  *
1654  * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1655  * '{' on scripts incomplete missing one or more '}' to be balanced.
1656  * '"' on scripts incomplete missing a '"' char.
1657  *
1658  * If the script is complete, 1 is returned, otherwise 0. */
1659 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1660 {
1661     int level = 0;
1662     int state = ' ';
1663
1664     while(len) {
1665         switch (*s) {
1666             case '\\':
1667                 if (len > 1)
1668                     s++;
1669                 break;
1670             case '"':
1671                 if (state == ' ') {
1672                     state = '"';
1673                 } else if (state == '"') {
1674                     state = ' ';
1675                 }
1676                 break;
1677             case '{':
1678                 if (state == '{') {
1679                     level++;
1680                 } else if (state == ' ') {
1681                     state = '{';
1682                     level++;
1683                 }
1684                 break;
1685             case '}':
1686                 if (state == '{') {
1687                     level--;
1688                     if (level == 0)
1689                         state = ' ';
1690                 }
1691                 break;
1692         }
1693         s++;
1694         len--;
1695     }
1696     if (stateCharPtr)
1697         *stateCharPtr = state;
1698     return state == ' ';
1699 }
1700
1701 /* -----------------------------------------------------------------------------
1702  * Tcl Lists parsing
1703  * ---------------------------------------------------------------------------*/
1704 static int JimParseListSep(struct JimParserCtx *pc);
1705 static int JimParseListStr(struct JimParserCtx *pc);
1706
1707 int JimParseList(struct JimParserCtx *pc)
1708 {
1709     if (pc->len == 0) {
1710         pc->tstart = pc->tend = pc->p;
1711         pc->tline = pc->linenr;
1712         pc->tt = JIM_TT_EOL;
1713         pc->eof = 1;
1714         return JIM_OK;
1715     }
1716     switch(*pc->p) {
1717     case ' ':
1718     case '\n':
1719     case '\t':
1720     case '\r':
1721         if (pc->state == JIM_PS_DEF)
1722             return JimParseListSep(pc);
1723         else
1724             return JimParseListStr(pc);
1725         break;
1726     default:
1727         return JimParseListStr(pc);
1728         break;
1729     }
1730     return JIM_OK;
1731 }
1732
1733 int JimParseListSep(struct JimParserCtx *pc)
1734 {
1735     pc->tstart = pc->p;
1736     pc->tline = pc->linenr;
1737     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1738     {
1739         pc->p++; pc->len--;
1740     }
1741     pc->tend = pc->p-1;
1742     pc->tt = JIM_TT_SEP;
1743     return JIM_OK;
1744 }
1745
1746 int JimParseListStr(struct JimParserCtx *pc)
1747 {
1748     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1749             pc->tt == JIM_TT_NONE);
1750     if (newword && *pc->p == '{') {
1751         return JimParseBrace(pc);
1752     } else if (newword && *pc->p == '"') {
1753         pc->state = JIM_PS_QUOTE;
1754         pc->p++; pc->len--;
1755     }
1756     pc->tstart = pc->p;
1757     pc->tline = pc->linenr;
1758     while (1) {
1759         if (pc->len == 0) {
1760             pc->tend = pc->p-1;
1761             pc->tt = JIM_TT_ESC;
1762             return JIM_OK;
1763         }
1764         switch(*pc->p) {
1765         case '\\':
1766             pc->p++; pc->len--;
1767             break;
1768         case ' ':
1769         case '\t':
1770         case '\n':
1771         case '\r':
1772             if (pc->state == JIM_PS_DEF) {
1773                 pc->tend = pc->p-1;
1774                 pc->tt = JIM_TT_ESC;
1775                 return JIM_OK;
1776             } else if (*pc->p == '\n') {
1777                 pc->linenr++;
1778             }
1779             break;
1780         case '"':
1781             if (pc->state == JIM_PS_QUOTE) {
1782                 pc->tend = pc->p-1;
1783                 pc->tt = JIM_TT_ESC;
1784                 pc->p++; pc->len--;
1785                 pc->state = JIM_PS_DEF;
1786                 return JIM_OK;
1787             }
1788             break;
1789         }
1790         pc->p++; pc->len--;
1791     }
1792     return JIM_OK; /* unreached */
1793 }
1794
1795 /* -----------------------------------------------------------------------------
1796  * Jim_Obj related functions
1797  * ---------------------------------------------------------------------------*/
1798
1799 /* Return a new initialized object. */
1800 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1801 {
1802     Jim_Obj *objPtr;
1803
1804     /* -- Check if there are objects in the free list -- */
1805     if (interp->freeList != NULL) {
1806         /* -- Unlink the object from the free list -- */
1807         objPtr = interp->freeList;
1808         interp->freeList = objPtr->nextObjPtr;
1809     } else {
1810         /* -- No ready to use objects: allocate a new one -- */
1811         objPtr = Jim_Alloc(sizeof(*objPtr));
1812     }
1813
1814     /* Object is returned with refCount of 0. Every
1815      * kind of GC implemented should take care to don't try
1816      * to scan objects with refCount == 0. */
1817     objPtr->refCount = 0;
1818     /* All the other fields are left not initialized to save time.
1819      * The caller will probably want set they to the right
1820      * value anyway. */
1821
1822     /* -- Put the object into the live list -- */
1823     objPtr->prevObjPtr = NULL;
1824     objPtr->nextObjPtr = interp->liveList;
1825     if (interp->liveList)
1826         interp->liveList->prevObjPtr = objPtr;
1827     interp->liveList = objPtr;
1828
1829     return objPtr;
1830 }
1831
1832 /* Free an object. Actually objects are never freed, but
1833  * just moved to the free objects list, where they will be
1834  * reused by Jim_NewObj(). */
1835 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1836 {
1837     /* Check if the object was already freed, panic. */
1838     if (objPtr->refCount != 0)  {
1839         Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1840                 objPtr->refCount);
1841     }
1842     /* Free the internal representation */
1843     Jim_FreeIntRep(interp, objPtr);
1844     /* Free the string representation */
1845     if (objPtr->bytes != NULL) {
1846         if (objPtr->bytes != JimEmptyStringRep)
1847             Jim_Free(objPtr->bytes);
1848     }
1849     /* Unlink the object from the live objects list */
1850     if (objPtr->prevObjPtr)
1851         objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1852     if (objPtr->nextObjPtr)
1853         objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1854     if (interp->liveList == objPtr)
1855         interp->liveList = objPtr->nextObjPtr;
1856     /* Link the object into the free objects list */
1857     objPtr->prevObjPtr = NULL;
1858     objPtr->nextObjPtr = interp->freeList;
1859     if (interp->freeList)
1860         interp->freeList->prevObjPtr = objPtr;
1861     interp->freeList = objPtr;
1862     objPtr->refCount = -1;
1863 }
1864
1865 /* Invalidate the string representation of an object. */
1866 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1867 {
1868     if (objPtr->bytes != NULL) {
1869         if (objPtr->bytes != JimEmptyStringRep)
1870             Jim_Free(objPtr->bytes);
1871     }
1872     objPtr->bytes = NULL;
1873 }
1874
1875 #define Jim_SetStringRep(o, b, l) \
1876     do { (o)->bytes = b; (o)->length = l; } while (0)
1877
1878 /* Set the initial string representation for an object.
1879  * Does not try to free an old one. */
1880 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1881 {
1882     if (length == 0) {
1883         objPtr->bytes = JimEmptyStringRep;
1884         objPtr->length = 0;
1885     } else {
1886         objPtr->bytes = Jim_Alloc(length+1);
1887         objPtr->length = length;
1888         memcpy(objPtr->bytes, bytes, length);
1889         objPtr->bytes[length] = '\0';
1890     }
1891 }
1892
1893 /* Duplicate an object. The returned object has refcount = 0. */
1894 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1895 {
1896     Jim_Obj *dupPtr;
1897
1898     dupPtr = Jim_NewObj(interp);
1899     if (objPtr->bytes == NULL) {
1900         /* Object does not have a valid string representation. */
1901         dupPtr->bytes = NULL;
1902     } else {
1903         Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1904     }
1905     if (objPtr->typePtr != NULL) {
1906         if (objPtr->typePtr->dupIntRepProc == NULL) {
1907             dupPtr->internalRep = objPtr->internalRep;
1908         } else {
1909             objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1910         }
1911         dupPtr->typePtr = objPtr->typePtr;
1912     } else {
1913         dupPtr->typePtr = NULL;
1914     }
1915     return dupPtr;
1916 }
1917
1918 /* Return the string representation for objPtr. If the object
1919  * string representation is invalid, calls the method to create
1920  * a new one starting from the internal representation of the object. */
1921 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1922 {
1923     if (objPtr->bytes == NULL) {
1924         /* Invalid string repr. Generate it. */
1925         if (objPtr->typePtr->updateStringProc == NULL) {
1926             Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1927                 objPtr->typePtr->name);
1928         }
1929         objPtr->typePtr->updateStringProc(objPtr);
1930     }
1931     if (lenPtr)
1932         *lenPtr = objPtr->length;
1933     return objPtr->bytes;
1934 }
1935
1936 /* Just returns the length of the object's string rep */
1937 int Jim_Length(Jim_Obj *objPtr)
1938 {
1939     int len;
1940
1941     Jim_GetString(objPtr, &len);
1942     return len;
1943 }
1944
1945 /* -----------------------------------------------------------------------------
1946  * String Object
1947  * ---------------------------------------------------------------------------*/
1948 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1949 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1950
1951 static Jim_ObjType stringObjType = {
1952     "string",
1953     NULL,
1954     DupStringInternalRep,
1955     NULL,
1956     JIM_TYPE_REFERENCES,
1957 };
1958
1959 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1960 {
1961     JIM_NOTUSED(interp);
1962
1963     /* This is a bit subtle: the only caller of this function
1964      * should be Jim_DuplicateObj(), that will copy the
1965      * string representaion. After the copy, the duplicated
1966      * object will not have more room in teh buffer than
1967      * srcPtr->length bytes. So we just set it to length. */
1968     dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1969 }
1970
1971 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1972 {
1973     /* Get a fresh string representation. */
1974     (void) Jim_GetString(objPtr, NULL);
1975     /* Free any other internal representation. */
1976     Jim_FreeIntRep(interp, objPtr);
1977     /* Set it as string, i.e. just set the maxLength field. */
1978     objPtr->typePtr = &stringObjType;
1979     objPtr->internalRep.strValue.maxLength = objPtr->length;
1980     return JIM_OK;
1981 }
1982
1983 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1984 {
1985     Jim_Obj *objPtr = Jim_NewObj(interp);
1986
1987     if (len == -1)
1988         len = strlen(s);
1989     /* Alloc/Set the string rep. */
1990     if (len == 0) {
1991         objPtr->bytes = JimEmptyStringRep;
1992         objPtr->length = 0;
1993     } else {
1994         objPtr->bytes = Jim_Alloc(len+1);
1995         objPtr->length = len;
1996         memcpy(objPtr->bytes, s, len);
1997         objPtr->bytes[len] = '\0';
1998     }
1999
2000     /* No typePtr field for the vanilla string object. */
2001     objPtr->typePtr = NULL;
2002     return objPtr;
2003 }
2004
2005 /* This version does not try to duplicate the 's' pointer, but
2006  * use it directly. */
2007 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2008 {
2009     Jim_Obj *objPtr = Jim_NewObj(interp);
2010
2011     if (len == -1)
2012         len = strlen(s);
2013     Jim_SetStringRep(objPtr, s, len);
2014     objPtr->typePtr = NULL;
2015     return objPtr;
2016 }
2017
2018 /* Low-level string append. Use it only against objects
2019  * of type "string". */
2020 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2021 {
2022     int needlen;
2023
2024     if (len == -1)
2025         len = strlen(str);
2026     needlen = objPtr->length + len;
2027     if (objPtr->internalRep.strValue.maxLength < needlen ||
2028         objPtr->internalRep.strValue.maxLength == 0) {
2029         if (objPtr->bytes == JimEmptyStringRep) {
2030             objPtr->bytes = Jim_Alloc((needlen*2)+1);
2031         } else {
2032             objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2033         }
2034         objPtr->internalRep.strValue.maxLength = needlen*2;
2035     }
2036     memcpy(objPtr->bytes + objPtr->length, str, len);
2037     objPtr->bytes[objPtr->length+len] = '\0';
2038     objPtr->length += len;
2039 }
2040
2041 /* Low-level wrapper to append an object. */
2042 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2043 {
2044     int len;
2045     const char *str;
2046
2047     str = Jim_GetString(appendObjPtr, &len);
2048     StringAppendString(objPtr, str, len);
2049 }
2050
2051 /* Higher level API to append strings to objects. */
2052 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2053         int len)
2054 {
2055     if (Jim_IsShared(objPtr))
2056         Jim_Panic(interp,"Jim_AppendString called with shared object");
2057     if (objPtr->typePtr != &stringObjType)
2058         SetStringFromAny(interp, objPtr);
2059     StringAppendString(objPtr, str, len);
2060 }
2061
2062 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2063 {
2064         char *buf;
2065         va_list ap;
2066
2067         va_start( ap, fmt );
2068         buf = jim_vasprintf( fmt, ap );
2069         va_end(ap);
2070
2071         if( buf ){
2072                 Jim_AppendString( interp, objPtr, buf, -1 );
2073                 jim_vasprintf_done(buf);
2074         }
2075 }
2076
2077
2078 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2079         Jim_Obj *appendObjPtr)
2080 {
2081     int len;
2082     const char *str;
2083
2084     str = Jim_GetString(appendObjPtr, &len);
2085     Jim_AppendString(interp, objPtr, str, len);
2086 }
2087
2088 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2089 {
2090     va_list ap;
2091
2092     if (objPtr->typePtr != &stringObjType)
2093         SetStringFromAny(interp, objPtr);
2094     va_start(ap, objPtr);
2095     while (1) {
2096         char *s = va_arg(ap, char*);
2097
2098         if (s == NULL) break;
2099         Jim_AppendString(interp, objPtr, s, -1);
2100     }
2101     va_end(ap);
2102 }
2103
2104 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2105 {
2106     const char *aStr, *bStr;
2107     int aLen, bLen, i;
2108
2109     if (aObjPtr == bObjPtr) return 1;
2110     aStr = Jim_GetString(aObjPtr, &aLen);
2111     bStr = Jim_GetString(bObjPtr, &bLen);
2112     if (aLen != bLen) return 0;
2113     if (nocase == 0)
2114         return memcmp(aStr, bStr, aLen) == 0;
2115     for (i = 0; i < aLen; i++) {
2116         if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2117             return 0;
2118     }
2119     return 1;
2120 }
2121
2122 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2123         int nocase)
2124 {
2125     const char *pattern, *string;
2126     int patternLen, stringLen;
2127
2128     pattern = Jim_GetString(patternObjPtr, &patternLen);
2129     string = Jim_GetString(objPtr, &stringLen);
2130     return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2131 }
2132
2133 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2134         Jim_Obj *secondObjPtr, int nocase)
2135 {
2136     const char *s1, *s2;
2137     int l1, l2;
2138
2139     s1 = Jim_GetString(firstObjPtr, &l1);
2140     s2 = Jim_GetString(secondObjPtr, &l2);
2141     return JimStringCompare(s1, l1, s2, l2, nocase);
2142 }
2143
2144 /* Convert a range, as returned by Jim_GetRange(), into
2145  * an absolute index into an object of the specified length.
2146  * This function may return negative values, or values
2147  * bigger or equal to the length of the list if the index
2148  * is out of range. */
2149 static int JimRelToAbsIndex(int len, int index)
2150 {
2151     if (index < 0)
2152         return len + index;
2153     return index;
2154 }
2155
2156 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2157  * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2158  * for implementation of commands like [string range] and [lrange].
2159  *
2160  * The resulting range is guaranteed to address valid elements of
2161  * the structure. */
2162 static void JimRelToAbsRange(int len, int first, int last,
2163         int *firstPtr, int *lastPtr, int *rangeLenPtr)
2164 {
2165     int rangeLen;
2166
2167     if (first > last) {
2168         rangeLen = 0;
2169     } else {
2170         rangeLen = last-first+1;
2171         if (rangeLen) {
2172             if (first < 0) {
2173                 rangeLen += first;
2174                 first = 0;
2175             }
2176             if (last >= len) {
2177                 rangeLen -= (last-(len-1));
2178                 last = len-1;
2179             }
2180         }
2181     }
2182     if (rangeLen < 0) rangeLen = 0;
2183
2184     *firstPtr = first;
2185     *lastPtr = last;
2186     *rangeLenPtr = rangeLen;
2187 }
2188
2189 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2190         Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2191 {
2192     int first, last;
2193     const char *str;
2194     int len, rangeLen;
2195
2196     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2197         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2198         return NULL;
2199     str = Jim_GetString(strObjPtr, &len);
2200     first = JimRelToAbsIndex(len, first);
2201     last = JimRelToAbsIndex(len, last);
2202     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2203     return Jim_NewStringObj(interp, str+first, rangeLen);
2204 }
2205
2206 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2207 {
2208     char *buf;
2209     int i;
2210     if (strObjPtr->typePtr != &stringObjType) {
2211         SetStringFromAny(interp, strObjPtr);
2212     }
2213
2214     buf = Jim_Alloc(strObjPtr->length+1);
2215
2216     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2217     for (i = 0; i < strObjPtr->length; i++)
2218         buf[i] = tolower(buf[i]);
2219     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2220 }
2221
2222 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2223 {
2224     char *buf;
2225     int i;
2226     if (strObjPtr->typePtr != &stringObjType) {
2227         SetStringFromAny(interp, strObjPtr);
2228     }
2229
2230     buf = Jim_Alloc(strObjPtr->length+1);
2231
2232     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2233     for (i = 0; i < strObjPtr->length; i++)
2234         buf[i] = toupper(buf[i]);
2235     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2236 }
2237
2238 /* This is the core of the [format] command.
2239  * TODO: Lots of things work - via a hack
2240  *       However, no format item can be >= JIM_MAX_FMT 
2241  */
2242 #define JIM_MAX_FMT 2048
2243 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2244         int objc, Jim_Obj *const *objv, char *sprintf_buf)
2245 {
2246     const char *fmt, *_fmt;
2247     int fmtLen;
2248     Jim_Obj *resObjPtr;
2249     
2250
2251     fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2252         _fmt = fmt;
2253     resObjPtr = Jim_NewStringObj(interp, "", 0);
2254     while (fmtLen) {
2255         const char *p = fmt;
2256         char spec[2], c;
2257         jim_wide wideValue;
2258                 double doubleValue;
2259                 /* we cheat and use Sprintf()! */
2260                 char fmt_str[100];
2261                 char *cp;
2262                 int width;
2263                 int ljust;
2264                 int zpad;
2265                 int spad;
2266                 int altfm;
2267                 int forceplus;
2268                 int prec;
2269                 int inprec;
2270                 int haveprec;
2271                 int accum;
2272
2273         while (*fmt != '%' && fmtLen) {
2274             fmt++; fmtLen--;
2275         }
2276         Jim_AppendString(interp, resObjPtr, p, fmt-p);
2277         if (fmtLen == 0)
2278             break;
2279         fmt++; fmtLen--; /* skip '%' */
2280                 zpad = 0;
2281                 spad = 0;
2282                 width = -1;
2283                 ljust = 0;
2284                 altfm = 0;
2285                 forceplus = 0;
2286                 inprec = 0;
2287                 haveprec = 0;
2288                 prec = -1; /* not found yet */
2289     next_fmt:
2290                 if( fmtLen <= 0 ){
2291                         break;
2292                 }
2293                 switch( *fmt ){
2294                         /* terminals */
2295         case 'b': /* binary - not all printfs() do this */
2296                 case 's': /* string */
2297                 case 'i': /* integer */
2298                 case 'd': /* decimal */
2299                 case 'x': /* hex */
2300                 case 'X': /* CAP hex */
2301                 case 'c': /* char */
2302                 case 'o': /* octal */
2303                 case 'u': /* unsigned */
2304                 case 'f': /* float */
2305                         break;
2306                         
2307                         /* non-terminals */
2308                 case '0': /* zero pad */
2309                         zpad = 1;
2310                         fmt++;  fmtLen--;
2311                         goto next_fmt;
2312                         break;
2313                 case '+':
2314                         forceplus = 1;
2315                         fmt++;  fmtLen--;
2316                         goto next_fmt;
2317                         break;
2318                 case ' ': /* sign space */
2319                         spad = 1;
2320                         fmt++;  fmtLen--;
2321                         goto next_fmt;
2322                         break;
2323                 case '-':
2324                         ljust = 1;
2325                         fmt++;  fmtLen--;
2326                         goto next_fmt;
2327                         break;
2328                 case '#':
2329                         altfm = 1;
2330                         fmt++; fmtLen--;
2331                         goto next_fmt;
2332                         
2333                 case '.':
2334                         inprec = 1;
2335                         fmt++; fmtLen--;
2336                         goto next_fmt;
2337                         break;
2338                 case '1':
2339                 case '2':
2340                 case '3':
2341                 case '4':
2342                 case '5':
2343                 case '6':
2344                 case '7':
2345                 case '8':
2346                 case '9':
2347                         accum = 0;
2348                         while( isdigit(*fmt) && (fmtLen > 0) ){
2349                                 accum = (accum * 10) + (*fmt - '0');
2350                                 fmt++;  fmtLen--;
2351                         }
2352                         if( inprec ){
2353                                 haveprec = 1;
2354                                 prec = accum;
2355                         } else {
2356                                 width = accum;
2357                         }
2358                         goto next_fmt;
2359                 case '*':
2360                         /* suck up the next item as an integer */
2361                         fmt++;  fmtLen--;
2362                         objc--;
2363                         if( objc <= 0 ){
2364                                 goto not_enough_args;
2365                         }
2366                         if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2367                                 Jim_FreeNewObj(interp, resObjPtr );
2368                                 return NULL;
2369                         }
2370                         if( inprec ){
2371                                 haveprec = 1;
2372                                 prec = wideValue;
2373                                 if( prec < 0 ){
2374                                         /* man 3 printf says */
2375                                         /* if prec is negative, it is zero */
2376                                         prec = 0;
2377                                 }
2378                         } else {
2379                         width = wideValue;
2380                         if( width < 0 ){
2381                                 ljust = 1;
2382                                 width = -width;
2383                         }
2384                         }
2385                         objv++;
2386                         goto next_fmt;
2387                         break;
2388                 }
2389                 
2390                 
2391                 if (*fmt != '%') {
2392             if (objc == 0) {
2393                         not_enough_args:
2394                 Jim_FreeNewObj(interp, resObjPtr);
2395                 Jim_SetResultString(interp,
2396                                                                         "not enough arguments for all format specifiers", -1);
2397                 return NULL;
2398             } else {
2399                 objc--;
2400             }
2401         }
2402                 
2403                 /*
2404                  * Create the formatter
2405                  * cause we cheat and use sprintf()
2406                  */
2407                 cp = fmt_str;
2408                 *cp++ = '%';
2409                 if( altfm ){
2410                         *cp++ = '#';
2411                 }
2412                 if( forceplus ){
2413                         *cp++ = '+';
2414                 } else if( spad ){
2415                         /* PLUS overrides */
2416                         *cp++ = ' ';
2417                 }
2418                 if( ljust ){
2419                         *cp++ = '-';
2420                 }
2421                 if( zpad  ){
2422                         *cp++ = '0';
2423                 }
2424                 if( width > 0 ){
2425                         sprintf( cp, "%d", width );
2426                         /* skip ahead */
2427                         cp = strchr(cp,0);
2428                 }
2429                 /* did we find a period? */
2430                 if( inprec ){
2431                         /* then add it */
2432                         *cp++ = '.';
2433                         /* did something occur after the period? */
2434                         if( haveprec ){
2435                                 sprintf( cp, "%d", prec );
2436                         }
2437                         cp = strchr(cp,0);
2438                 }
2439                 *cp = 0;
2440
2441                 /* here we do the work */
2442                 /* actually - we make sprintf() do it for us */
2443         switch(*fmt) {
2444         case 's':
2445                         *cp++ = 's';
2446                         *cp   = 0;
2447                         /* BUG: we do not handled embeded NULLs */
2448                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2449             break;
2450         case 'c':
2451                         *cp++ = 'c';
2452                         *cp   = 0;
2453             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2454                 Jim_FreeNewObj(interp, resObjPtr);
2455                 return NULL;
2456             }
2457             c = (char) wideValue;
2458                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2459             break;
2460                 case 'f':
2461                 case 'F':
2462                 case 'g':
2463                 case 'G':
2464                 case 'e':
2465                 case 'E':
2466                         *cp++ = *fmt;
2467                         *cp   = 0;
2468                         if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2469                                 Jim_FreeNewObj( interp, resObjPtr );
2470                                 return NULL;
2471                         }
2472                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2473                         break;
2474         case 'b':
2475         case 'd':
2476         case 'o':
2477                 case 'i':
2478                 case 'u':
2479                 case 'x':
2480                 case 'X':
2481                         /* jim widevaluse are 64bit */
2482                         if( sizeof(jim_wide) == sizeof(long long) ){
2483                                 *cp++ = 'l'; 
2484                                 *cp++ = 'l';
2485                         } else {
2486                                 *cp++ = 'l';
2487                         }
2488                         *cp++ = *fmt;
2489                         *cp   = 0;
2490             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2491                 Jim_FreeNewObj(interp, resObjPtr);
2492                 return NULL;
2493             }
2494                         snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2495             break;
2496         case '%':
2497                         sprintf_buf[0] = '%';
2498                         sprintf_buf[1] = 0;
2499                         objv--; /* undo the objv++ below */
2500             break;
2501         default:
2502             spec[0] = *fmt; spec[1] = '\0';
2503             Jim_FreeNewObj(interp, resObjPtr);
2504             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2505             Jim_AppendStrings(interp, Jim_GetResult(interp),
2506                     "bad field specifier \"",  spec, "\"", NULL);
2507             return NULL;
2508         }
2509                 /* force terminate */
2510 #if 0
2511                 printf("FMT was: %s\n", fmt_str );
2512                 printf("RES was: |%s|\n", sprintf_buf );
2513 #endif
2514                 
2515                 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2516                 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2517                 /* next obj */
2518                 objv++;
2519         fmt++;
2520         fmtLen--;
2521     }
2522     return resObjPtr;
2523 }
2524
2525 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2526         int objc, Jim_Obj *const *objv)
2527 {
2528         char *sprintf_buf=malloc(JIM_MAX_FMT);
2529         Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2530         free(sprintf_buf);
2531         return t; 
2532 }
2533
2534 /* -----------------------------------------------------------------------------
2535  * Compared String Object
2536  * ---------------------------------------------------------------------------*/
2537
2538 /* This is strange object that allows to compare a C literal string
2539  * with a Jim object in very short time if the same comparison is done
2540  * multiple times. For example every time the [if] command is executed,
2541  * Jim has to check if a given argument is "else". This comparions if
2542  * the code has no errors are true most of the times, so we can cache
2543  * inside the object the pointer of the string of the last matching
2544  * comparison. Because most C compilers perform literal sharing,
2545  * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2546  * this works pretty well even if comparisons are at different places
2547  * inside the C code. */
2548
2549 static Jim_ObjType comparedStringObjType = {
2550     "compared-string",
2551     NULL,
2552     NULL,
2553     NULL,
2554     JIM_TYPE_REFERENCES,
2555 };
2556
2557 /* The only way this object is exposed to the API is via the following
2558  * function. Returns true if the string and the object string repr.
2559  * are the same, otherwise zero is returned.
2560  *
2561  * Note: this isn't binary safe, but it hardly needs to be.*/
2562 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2563         const char *str)
2564 {
2565     if (objPtr->typePtr == &comparedStringObjType &&
2566         objPtr->internalRep.ptr == str)
2567         return 1;
2568     else {
2569         const char *objStr = Jim_GetString(objPtr, NULL);
2570         if (strcmp(str, objStr) != 0) return 0;
2571         if (objPtr->typePtr != &comparedStringObjType) {
2572             Jim_FreeIntRep(interp, objPtr);
2573             objPtr->typePtr = &comparedStringObjType;
2574         }
2575         objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2576         return 1;
2577     }
2578 }
2579
2580 int qsortCompareStringPointers(const void *a, const void *b)
2581 {
2582     char * const *sa = (char * const *)a;
2583     char * const *sb = (char * const *)b;
2584     return strcmp(*sa, *sb);
2585 }
2586
2587 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2588         const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2589 {
2590     const char * const *entryPtr = NULL;
2591     char **tablePtrSorted;
2592     int i, count = 0;
2593
2594     *indexPtr = -1;
2595     for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2596         if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2597             *indexPtr = i;
2598             return JIM_OK;
2599         }
2600         count++; /* If nothing matches, this will reach the len of tablePtr */
2601     }
2602     if (flags & JIM_ERRMSG) {
2603         if (name == NULL)
2604             name = "option";
2605         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2606         Jim_AppendStrings(interp, Jim_GetResult(interp),
2607             "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2608             NULL);
2609         tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2610         memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2611         qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2612         for (i = 0; i < count; i++) {
2613             if (i+1 == count && count > 1)
2614                 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2615             Jim_AppendString(interp, Jim_GetResult(interp),
2616                     tablePtrSorted[i], -1);
2617             if (i+1 != count)
2618                 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2619         }
2620         Jim_Free(tablePtrSorted);
2621     }
2622     return JIM_ERR;
2623 }
2624
2625 int Jim_GetNvp(Jim_Interp *interp, 
2626                            Jim_Obj *objPtr,
2627                            const Jim_Nvp *nvp_table, 
2628                            const Jim_Nvp ** result)
2629 {
2630         Jim_Nvp *n;
2631         int e;
2632
2633         e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2634         if( e == JIM_ERR ){
2635                 return e;
2636         }
2637
2638         /* Success? found? */
2639         if( n->name ){
2640                 /* remove const */
2641                 *result = (Jim_Nvp *)n;
2642                 return JIM_OK;
2643         } else {
2644                 return JIM_ERR;
2645         }
2646 }
2647
2648 /* -----------------------------------------------------------------------------
2649  * Source Object
2650  *
2651  * This object is just a string from the language point of view, but
2652  * in the internal representation it contains the filename and line number
2653  * where this given token was read. This information is used by
2654  * Jim_EvalObj() if the object passed happens to be of type "source".
2655  *
2656  * This allows to propagate the information about line numbers and file
2657  * names and give error messages with absolute line numbers.
2658  *
2659  * Note that this object uses shared strings for filenames, and the
2660  * pointer to the filename together with the line number is taken into
2661  * the space for the "inline" internal represenation of the Jim_Object,
2662  * so there is almost memory zero-overhead.
2663  *
2664  * Also the object will be converted to something else if the given
2665  * token it represents in the source file is not something to be
2666  * evaluated (not a script), and will be specialized in some other way,
2667  * so the time overhead is alzo null.
2668  * ---------------------------------------------------------------------------*/
2669
2670 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2671 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2672
2673 static Jim_ObjType sourceObjType = {
2674     "source",
2675     FreeSourceInternalRep,
2676     DupSourceInternalRep,
2677     NULL,
2678     JIM_TYPE_REFERENCES,
2679 };
2680
2681 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2682 {
2683     Jim_ReleaseSharedString(interp,
2684             objPtr->internalRep.sourceValue.fileName);
2685 }
2686
2687 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2688 {
2689     dupPtr->internalRep.sourceValue.fileName =
2690         Jim_GetSharedString(interp,
2691                 srcPtr->internalRep.sourceValue.fileName);
2692     dupPtr->internalRep.sourceValue.lineNumber =
2693         dupPtr->internalRep.sourceValue.lineNumber;
2694     dupPtr->typePtr = &sourceObjType;
2695 }
2696
2697 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2698         const char *fileName, int lineNumber)
2699 {
2700     if (Jim_IsShared(objPtr))
2701         Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2702     if (objPtr->typePtr != NULL)
2703         Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2704     objPtr->internalRep.sourceValue.fileName =
2705         Jim_GetSharedString(interp, fileName);
2706     objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2707     objPtr->typePtr = &sourceObjType;
2708 }
2709
2710 /* -----------------------------------------------------------------------------
2711  * Script Object
2712  * ---------------------------------------------------------------------------*/
2713
2714 #define JIM_CMDSTRUCT_EXPAND -1
2715
2716 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2717 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2718 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2719
2720 static Jim_ObjType scriptObjType = {
2721     "script",
2722     FreeScriptInternalRep,
2723     DupScriptInternalRep,
2724     NULL,
2725     JIM_TYPE_REFERENCES,
2726 };
2727
2728 /* The ScriptToken structure represents every token into a scriptObj.
2729  * Every token contains an associated Jim_Obj that can be specialized
2730  * by commands operating on it. */
2731 typedef struct ScriptToken {
2732     int type;
2733     Jim_Obj *objPtr;
2734     int linenr;
2735 } ScriptToken;
2736
2737 /* This is the script object internal representation. An array of
2738  * ScriptToken structures, with an associated command structure array.
2739  * The command structure is a pre-computed representation of the
2740  * command length and arguments structure as a simple liner array
2741  * of integers.
2742  * 
2743  * For example the script:
2744  *
2745  * puts hello
2746  * set $i $x$y [foo]BAR
2747  *
2748  * will produce a ScriptObj with the following Tokens:
2749  *
2750  * ESC puts
2751  * SEP
2752  * ESC hello
2753  * EOL
2754  * ESC set
2755  * EOL
2756  * VAR i
2757  * SEP
2758  * VAR x
2759  * VAR y
2760  * SEP
2761  * CMD foo
2762  * ESC BAR
2763  * EOL
2764  *
2765  * This is a description of the tokens, separators, and of lines.
2766  * The command structure instead represents the number of arguments
2767  * of every command, followed by the tokens of which every argument
2768  * is composed. So for the example script, the cmdstruct array will
2769  * contain:
2770  *
2771  * 2 1 1 4 1 1 2 2
2772  *
2773  * Because "puts hello" has two args (2), composed of single tokens (1 1)
2774  * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2775  * composed of single tokens (1 1) and the last two of double tokens
2776  * (2 2).
2777  *
2778  * The precomputation of the command structure makes Jim_Eval() faster,
2779  * and simpler because there aren't dynamic lengths / allocations.
2780  *
2781  * -- {expand} handling --
2782  *
2783  * Expand is handled in a special way. When a command
2784  * contains at least an argument with the {expand} prefix,
2785  * the command structure presents a -1 before the integer
2786  * describing the number of arguments. This is used in order
2787  * to send the command exection to a different path in case
2788  * of {expand} and guarantee a fast path for the more common
2789  * case. Also, the integers describing the number of tokens
2790  * are expressed with negative sign, to allow for fast check
2791  * of what's an {expand}-prefixed argument and what not.
2792  *
2793  * For example the command:
2794  *
2795  * list {expand}{1 2}
2796  *
2797  * Will produce the following cmdstruct array:
2798  *
2799  * -1 2 1 -2
2800  *
2801  * -- the substFlags field of the structure --
2802  *
2803  * The scriptObj structure is used to represent both "script" objects
2804  * and "subst" objects. In the second case, the cmdStruct related
2805  * fields are not used at all, but there is an additional field used
2806  * that is 'substFlags': this represents the flags used to turn
2807  * the string into the intenral representation used to perform the
2808  * substitution. If this flags are not what the application requires
2809  * the scriptObj is created again. For example the script:
2810  *
2811  * subst -nocommands $string
2812  * subst -novariables $string
2813  *
2814  * Will recreate the internal representation of the $string object
2815  * two times.
2816  */
2817 typedef struct ScriptObj {
2818     int len; /* Length as number of tokens. */
2819     int commands; /* number of top-level commands in script. */
2820     ScriptToken *token; /* Tokens array. */
2821     int *cmdStruct; /* commands structure */
2822     int csLen; /* length of the cmdStruct array. */
2823     int substFlags; /* flags used for the compilation of "subst" objects */
2824     int inUse; /* Used to share a ScriptObj. Currently
2825               only used by Jim_EvalObj() as protection against
2826               shimmering of the currently evaluated object. */
2827     char *fileName;
2828 } ScriptObj;
2829
2830 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2831 {
2832     int i;
2833     struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2834
2835     script->inUse--;
2836     if (script->inUse != 0) return;
2837     for (i = 0; i < script->len; i++) {
2838         if (script->token[i].objPtr != NULL)
2839             Jim_DecrRefCount(interp, script->token[i].objPtr);
2840     }
2841     Jim_Free(script->token);
2842     Jim_Free(script->cmdStruct);
2843     Jim_Free(script->fileName);
2844     Jim_Free(script);
2845 }
2846
2847 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2848 {
2849     JIM_NOTUSED(interp);
2850     JIM_NOTUSED(srcPtr);
2851
2852     /* Just returns an simple string. */
2853     dupPtr->typePtr = NULL;
2854 }
2855
2856 /* Add a new token to the internal repr of a script object */
2857 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2858         char *strtoken, int len, int type, char *filename, int linenr)
2859 {
2860     int prevtype;
2861     struct ScriptToken *token;
2862
2863     prevtype = (script->len == 0) ? JIM_TT_EOL : \
2864         script->token[script->len-1].type;
2865     /* Skip tokens without meaning, like words separators
2866      * following a word separator or an end of command and
2867      * so on. */
2868     if (prevtype == JIM_TT_EOL) {
2869         if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2870             Jim_Free(strtoken);
2871             return;
2872         }
2873     } else if (prevtype == JIM_TT_SEP) {
2874         if (type == JIM_TT_SEP) {
2875             Jim_Free(strtoken);
2876             return;
2877         } else if (type == JIM_TT_EOL) {
2878             /* If an EOL is following by a SEP, drop the previous
2879              * separator. */
2880             script->len--;
2881             Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2882         }
2883     } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2884             type == JIM_TT_ESC && len == 0)
2885     {
2886         /* Don't add empty tokens used in interpolation */
2887         Jim_Free(strtoken);
2888         return;
2889     }
2890     /* Make space for a new istruction */
2891     script->len++;
2892     script->token = Jim_Realloc(script->token,
2893             sizeof(ScriptToken)*script->len);
2894     /* Initialize the new token */
2895     token = script->token+(script->len-1);
2896     token->type = type;
2897     /* Every object is intially as a string, but the
2898      * internal type may be specialized during execution of the
2899      * script. */
2900     token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2901     /* To add source info to SEP and EOL tokens is useless because
2902      * they will never by called as arguments of Jim_EvalObj(). */
2903     if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2904         JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2905     Jim_IncrRefCount(token->objPtr);
2906     token->linenr = linenr;
2907 }
2908
2909 /* Add an integer into the command structure field of the script object. */
2910 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2911 {
2912     script->csLen++;
2913     script->cmdStruct = Jim_Realloc(script->cmdStruct,
2914                     sizeof(int)*script->csLen);
2915     script->cmdStruct[script->csLen-1] = val;
2916 }
2917
2918 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2919  * of objPtr. Search nested script objects recursively. */
2920 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2921         ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2922 {
2923     int i;
2924
2925     for (i = 0; i < script->len; i++) {
2926         if (script->token[i].objPtr != objPtr &&
2927             Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2928             return script->token[i].objPtr;
2929         }
2930         /* Enter recursively on scripts only if the object
2931          * is not the same as the one we are searching for
2932          * shared occurrences. */
2933         if (script->token[i].objPtr->typePtr == &scriptObjType &&
2934             script->token[i].objPtr != objPtr) {
2935             Jim_Obj *foundObjPtr;
2936
2937             ScriptObj *subScript =
2938                 script->token[i].objPtr->internalRep.ptr;
2939             /* Don't recursively enter the script we are trying
2940              * to make shared to avoid circular references. */
2941             if (subScript == scriptBarrier) continue;
2942             if (subScript != script) {
2943                 foundObjPtr =
2944                     ScriptSearchLiteral(interp, subScript,
2945                             scriptBarrier, objPtr);
2946                 if (foundObjPtr != NULL)
2947                     return foundObjPtr;
2948             }
2949         }
2950     }
2951     return NULL;
2952 }
2953
2954 /* Share literals of a script recursively sharing sub-scripts literals. */
2955 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2956         ScriptObj *topLevelScript)
2957 {
2958     int i, j;
2959
2960     return;
2961     /* Try to share with toplevel object. */
2962     if (topLevelScript != NULL) {
2963         for (i = 0; i < script->len; i++) {
2964             Jim_Obj *foundObjPtr;
2965             char *str = script->token[i].objPtr->bytes;
2966
2967             if (script->token[i].objPtr->refCount != 1) continue;
2968             if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2969             if (strchr(str, ' ') || strchr(str, '\n')) continue;
2970             foundObjPtr = ScriptSearchLiteral(interp,
2971                     topLevelScript,
2972                     script, /* barrier */
2973                     script->token[i].objPtr);
2974             if (foundObjPtr != NULL) {
2975                 Jim_IncrRefCount(foundObjPtr);
2976                 Jim_DecrRefCount(interp,
2977                         script->token[i].objPtr);
2978                 script->token[i].objPtr = foundObjPtr;
2979             }
2980         }
2981     }
2982     /* Try to share locally */
2983     for (i = 0; i < script->len; i++) {
2984         char *str = script->token[i].objPtr->bytes;
2985
2986         if (script->token[i].objPtr->refCount != 1) continue;
2987         if (strchr(str, ' ') || strchr(str, '\n')) continue;
2988         for (j = 0; j < script->len; j++) {
2989             if (script->token[i].objPtr !=
2990                     script->token[j].objPtr &&
2991                 Jim_StringEqObj(script->token[i].objPtr,
2992                             script->token[j].objPtr, 0))
2993             {
2994                 Jim_IncrRefCount(script->token[j].objPtr);
2995                 Jim_DecrRefCount(interp,
2996                         script->token[i].objPtr);
2997                 script->token[i].objPtr =
2998                     script->token[j].objPtr;
2999             }
3000         }
3001     }
3002 }
3003
3004 /* This method takes the string representation of an object
3005  * as a Tcl script, and generates the pre-parsed internal representation
3006  * of the script. */
3007 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3008 {
3009     int scriptTextLen;
3010     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3011     struct JimParserCtx parser;
3012     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3013     ScriptToken *token;
3014     int args, tokens, start, end, i;
3015     int initialLineNumber;
3016     int propagateSourceInfo = 0;
3017
3018     script->len = 0;
3019     script->csLen = 0;
3020     script->commands = 0;
3021     script->token = NULL;
3022     script->cmdStruct = NULL;
3023     script->inUse = 1;
3024     /* Try to get information about filename / line number */
3025     if (objPtr->typePtr == &sourceObjType) {
3026         script->fileName =
3027             Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3028         initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3029         propagateSourceInfo = 1;
3030     } else {
3031         script->fileName = Jim_StrDup("");
3032         initialLineNumber = 1;
3033     }
3034
3035     JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3036     while(!JimParserEof(&parser)) {
3037         char *token;
3038         int len, type, linenr;
3039
3040         JimParseScript(&parser);
3041         token = JimParserGetToken(&parser, &len, &type, &linenr);
3042         ScriptObjAddToken(interp, script, token, len, type,
3043                 propagateSourceInfo ? script->fileName : NULL,
3044                 linenr);
3045     }
3046     token = script->token;
3047
3048     /* Compute the command structure array
3049      * (see the ScriptObj struct definition for more info) */
3050     start = 0; /* Current command start token index */
3051     end = -1; /* Current command end token index */
3052     while (1) {
3053         int expand = 0; /* expand flag. set to 1 on {expand} form. */
3054         int interpolation = 0; /* set to 1 if there is at least one
3055                       argument of the command obtained via
3056                       interpolation of more tokens. */
3057         /* Search for the end of command, while
3058          * count the number of args. */
3059         start = ++end;
3060         if (start >= script->len) break;
3061         args = 1; /* Number of args in current command */
3062         while (token[end].type != JIM_TT_EOL) {
3063             if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3064                     token[end-1].type == JIM_TT_EOL)
3065             {
3066                 if (token[end].type == JIM_TT_STR &&
3067                     token[end+1].type != JIM_TT_SEP &&
3068                     token[end+1].type != JIM_TT_EOL &&
3069                     (!strcmp(token[end].objPtr->bytes, "expand") ||
3070                      !strcmp(token[end].objPtr->bytes, "*")))
3071                     expand++;
3072             }
3073             if (token[end].type == JIM_TT_SEP)
3074                 args++;
3075             end++;
3076         }
3077         interpolation = !((end-start+1) == args*2);
3078         /* Add the 'number of arguments' info into cmdstruct.
3079          * Negative value if there is list expansion involved. */
3080         if (expand)
3081             ScriptObjAddInt(script, -1);
3082         ScriptObjAddInt(script, args);
3083         /* Now add info about the number of tokens. */
3084         tokens = 0; /* Number of tokens in current argument. */
3085         expand = 0;
3086         for (i = start; i <= end; i++) {
3087             if (token[i].type == JIM_TT_SEP ||
3088                 token[i].type == JIM_TT_EOL)
3089             {
3090                 if (tokens == 1 && expand)
3091                     expand = 0;
3092                 ScriptObjAddInt(script,
3093                         expand ? -tokens : tokens);
3094
3095                 expand = 0;
3096                 tokens = 0;
3097                 continue;
3098             } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3099                    (!strcmp(token[i].objPtr->bytes, "expand") ||
3100                     !strcmp(token[i].objPtr->bytes, "*")))
3101             {
3102                 expand++;
3103             }
3104             tokens++;
3105         }
3106     }
3107     /* Perform literal sharing, but only for objects that appear
3108      * to be scripts written as literals inside the source code,
3109      * and not computed at runtime. Literal sharing is a costly
3110      * operation that should be done only against objects that
3111      * are likely to require compilation only the first time, and
3112      * then are executed multiple times. */
3113     if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3114         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3115         if (bodyObjPtr->typePtr == &scriptObjType) {
3116             ScriptObj *bodyScript =
3117                 bodyObjPtr->internalRep.ptr;
3118             ScriptShareLiterals(interp, script, bodyScript);
3119         }
3120     } else if (propagateSourceInfo) {
3121         ScriptShareLiterals(interp, script, NULL);
3122     }
3123     /* Free the old internal rep and set the new one. */
3124     Jim_FreeIntRep(interp, objPtr);
3125     Jim_SetIntRepPtr(objPtr, script);
3126     objPtr->typePtr = &scriptObjType;
3127     return JIM_OK;
3128 }
3129
3130 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3131 {
3132     if (objPtr->typePtr != &scriptObjType) {
3133         SetScriptFromAny(interp, objPtr);
3134     }
3135     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3136 }
3137
3138 /* -----------------------------------------------------------------------------
3139  * Commands
3140  * ---------------------------------------------------------------------------*/
3141
3142 /* Commands HashTable Type.
3143  *
3144  * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3145 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3146 {
3147     Jim_Cmd *cmdPtr = (void*) val;
3148
3149     if (cmdPtr->cmdProc == NULL) {
3150         Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3151         Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3152         if (cmdPtr->staticVars) {
3153             Jim_FreeHashTable(cmdPtr->staticVars);
3154             Jim_Free(cmdPtr->staticVars);
3155         }
3156     } else if (cmdPtr->delProc != NULL) {
3157             /* If it was a C coded command, call the delProc if any */
3158             cmdPtr->delProc(interp, cmdPtr->privData);
3159     }
3160     Jim_Free(val);
3161 }
3162
3163 static Jim_HashTableType JimCommandsHashTableType = {
3164     JimStringCopyHTHashFunction,        /* hash function */
3165     JimStringCopyHTKeyDup,        /* key dup */
3166     NULL,                    /* val dup */
3167     JimStringCopyHTKeyCompare,        /* key compare */
3168     JimStringCopyHTKeyDestructor,        /* key destructor */
3169     Jim_CommandsHT_ValDestructor        /* val destructor */
3170 };
3171
3172 /* ------------------------- Commands related functions --------------------- */
3173
3174 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3175         Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3176 {
3177     Jim_HashEntry *he;
3178     Jim_Cmd *cmdPtr;
3179
3180     he = Jim_FindHashEntry(&interp->commands, cmdName);
3181     if (he == NULL) { /* New command to create */
3182         cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3183         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3184     } else {
3185         Jim_InterpIncrProcEpoch(interp);
3186         /* Free the arglist/body objects if it was a Tcl procedure */
3187         cmdPtr = he->val;
3188         if (cmdPtr->cmdProc == NULL) {
3189             Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3190             Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3191             if (cmdPtr->staticVars) {
3192                 Jim_FreeHashTable(cmdPtr->staticVars);
3193                 Jim_Free(cmdPtr->staticVars);
3194             }
3195             cmdPtr->staticVars = NULL;
3196         } else if (cmdPtr->delProc != NULL) {
3197             /* If it was a C coded command, call the delProc if any */
3198             cmdPtr->delProc(interp, cmdPtr->privData);
3199         }
3200     }
3201
3202     /* Store the new details for this proc */
3203     cmdPtr->delProc = delProc;
3204     cmdPtr->cmdProc = cmdProc;
3205     cmdPtr->privData = privData;
3206
3207     /* There is no need to increment the 'proc epoch' because
3208      * creation of a new procedure can never affect existing
3209      * cached commands. We don't do negative caching. */
3210     return JIM_OK;
3211 }
3212
3213 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3214         Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3215         int arityMin, int arityMax)
3216 {
3217     Jim_Cmd *cmdPtr;
3218
3219     cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3220     cmdPtr->cmdProc = NULL; /* Not a C coded command */
3221     cmdPtr->argListObjPtr = argListObjPtr;
3222     cmdPtr->bodyObjPtr = bodyObjPtr;
3223     Jim_IncrRefCount(argListObjPtr);
3224     Jim_IncrRefCount(bodyObjPtr);
3225     cmdPtr->arityMin = arityMin;
3226     cmdPtr->arityMax = arityMax;
3227     cmdPtr->staticVars = NULL;
3228    
3229     /* Create the statics hash table. */
3230     if (staticsListObjPtr) {
3231         int len, i;
3232
3233         Jim_ListLength(interp, staticsListObjPtr, &len);
3234         if (len != 0) {
3235             cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3236             Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3237                     interp);
3238             for (i = 0; i < len; i++) {
3239                 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3240                 Jim_Var *varPtr;
3241                 int subLen;
3242
3243                 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3244                 /* Check if it's composed of two elements. */
3245                 Jim_ListLength(interp, objPtr, &subLen);
3246                 if (subLen == 1 || subLen == 2) {
3247                     /* Try to get the variable value from the current
3248                      * environment. */
3249                     Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3250                     if (subLen == 1) {
3251                         initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3252                                 JIM_NONE);
3253                         if (initObjPtr == NULL) {
3254                             Jim_SetResult(interp,
3255                                     Jim_NewEmptyStringObj(interp));
3256                             Jim_AppendStrings(interp, Jim_GetResult(interp),
3257                                 "variable for initialization of static \"",
3258                                 Jim_GetString(nameObjPtr, NULL),
3259                                 "\" not found in the local context",
3260                                 NULL);
3261                             goto err;
3262                         }
3263                     } else {
3264                         Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3265                     }
3266                     varPtr = Jim_Alloc(sizeof(*varPtr));
3267                     varPtr->objPtr = initObjPtr;
3268                     Jim_IncrRefCount(initObjPtr);
3269                     varPtr->linkFramePtr = NULL;
3270                     if (Jim_AddHashEntry(cmdPtr->staticVars,
3271                             Jim_GetString(nameObjPtr, NULL),
3272                             varPtr) != JIM_OK)
3273                     {
3274                         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3275                         Jim_AppendStrings(interp, Jim_GetResult(interp),
3276                             "static variable name \"",
3277                             Jim_GetString(objPtr, NULL), "\"",
3278                             " duplicated in statics list", NULL);
3279                         Jim_DecrRefCount(interp, initObjPtr);
3280                         Jim_Free(varPtr);
3281                         goto err;
3282                     }
3283                 } else {
3284                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3285                     Jim_AppendStrings(interp, Jim_GetResult(interp),
3286                         "too many fields in static specifier \"",
3287                         objPtr, "\"", NULL);
3288                     goto err;
3289                 }
3290             }
3291         }
3292     }
3293
3294     /* Add the new command */
3295
3296     /* it may already exist, so we try to delete the old one */
3297     if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3298         /* There was an old procedure with the same name, this requires
3299          * a 'proc epoch' update. */
3300         Jim_InterpIncrProcEpoch(interp);
3301     }
3302     /* If a procedure with the same name didn't existed there is no need
3303      * to increment the 'proc epoch' because creation of a new procedure
3304      * can never affect existing cached commands. We don't do
3305      * negative caching. */
3306     Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3307     return JIM_OK;
3308
3309 err:
3310     Jim_FreeHashTable(cmdPtr->staticVars);
3311     Jim_Free(cmdPtr->staticVars);
3312     Jim_DecrRefCount(interp, argListObjPtr);
3313     Jim_DecrRefCount(interp, bodyObjPtr);
3314     Jim_Free(cmdPtr);
3315     return JIM_ERR;
3316 }
3317
3318 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3319 {
3320     if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3321         return JIM_ERR;
3322     Jim_InterpIncrProcEpoch(interp);
3323     return JIM_OK;
3324 }
3325
3326 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, 
3327         const char *newName)
3328 {
3329     Jim_Cmd *cmdPtr;
3330     Jim_HashEntry *he;
3331     Jim_Cmd *copyCmdPtr;
3332
3333     if (newName[0] == '\0') /* Delete! */
3334         return Jim_DeleteCommand(interp, oldName);
3335     /* Rename */
3336     he = Jim_FindHashEntry(&interp->commands, oldName);
3337     if (he == NULL)
3338         return JIM_ERR; /* Invalid command name */
3339     cmdPtr = he->val;
3340     copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3341     *copyCmdPtr = *cmdPtr;
3342     /* In order to avoid that a procedure will get arglist/body/statics
3343      * freed by the hash table methods, fake a C-coded command
3344      * setting cmdPtr->cmdProc as not NULL */
3345     cmdPtr->cmdProc = (void*)1;
3346     /* Also make sure delProc is NULL. */
3347     cmdPtr->delProc = NULL;
3348     /* Destroy the old command, and make sure the new is freed
3349      * as well. */
3350     Jim_DeleteHashEntry(&interp->commands, oldName);
3351     Jim_DeleteHashEntry(&interp->commands, newName);
3352     /* Now the new command. We are sure it can't fail because
3353      * the target name was already freed. */
3354     Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3355     /* Increment the epoch */
3356     Jim_InterpIncrProcEpoch(interp);
3357     return JIM_OK;
3358 }
3359
3360 /* -----------------------------------------------------------------------------
3361  * Command object
3362  * ---------------------------------------------------------------------------*/
3363
3364 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3365
3366 static Jim_ObjType commandObjType = {
3367     "command",
3368     NULL,
3369     NULL,
3370     NULL,
3371     JIM_TYPE_REFERENCES,
3372 };
3373
3374 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3375 {
3376     Jim_HashEntry *he;
3377     const char *cmdName;
3378
3379     /* Get the string representation */
3380     cmdName = Jim_GetString(objPtr, NULL);
3381     /* Lookup this name into the commands hash table */
3382     he = Jim_FindHashEntry(&interp->commands, cmdName);
3383     if (he == NULL)
3384         return JIM_ERR;
3385
3386     /* Free the old internal repr and set the new one. */
3387     Jim_FreeIntRep(interp, objPtr);
3388     objPtr->typePtr = &commandObjType;
3389     objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3390     objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3391     return JIM_OK;
3392 }
3393
3394 /* This function returns the command structure for the command name
3395  * stored in objPtr. It tries to specialize the objPtr to contain
3396  * a cached info instead to perform the lookup into the hash table
3397  * every time. The information cached may not be uptodate, in such
3398  * a case the lookup is performed and the cache updated. */
3399 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3400 {
3401     if ((objPtr->typePtr != &commandObjType ||
3402         objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3403         SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3404         if (flags & JIM_ERRMSG) {
3405             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3406             Jim_AppendStrings(interp, Jim_GetResult(interp),
3407                 "invalid command name \"", objPtr->bytes, "\"",
3408                 NULL);
3409         }
3410         return NULL;
3411     }
3412     return objPtr->internalRep.cmdValue.cmdPtr;
3413 }
3414
3415 /* -----------------------------------------------------------------------------
3416  * Variables
3417  * ---------------------------------------------------------------------------*/
3418
3419 /* Variables HashTable Type.
3420  *
3421  * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3422 static void JimVariablesHTValDestructor(void *interp, void *val)
3423 {
3424     Jim_Var *varPtr = (void*) val;
3425
3426     Jim_DecrRefCount(interp, varPtr->objPtr);
3427     Jim_Free(val);
3428 }
3429
3430 static Jim_HashTableType JimVariablesHashTableType = {
3431     JimStringCopyHTHashFunction,        /* hash function */
3432     JimStringCopyHTKeyDup,              /* key dup */
3433     NULL,                               /* val dup */
3434     JimStringCopyHTKeyCompare,        /* key compare */
3435     JimStringCopyHTKeyDestructor,     /* key destructor */
3436     JimVariablesHTValDestructor       /* val destructor */
3437 };
3438
3439 /* -----------------------------------------------------------------------------
3440  * Variable object
3441  * ---------------------------------------------------------------------------*/
3442
3443 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3444
3445 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3446
3447 static Jim_ObjType variableObjType = {
3448     "variable",
3449     NULL,
3450     NULL,
3451     NULL,
3452     JIM_TYPE_REFERENCES,
3453 };
3454
3455 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3456  * is in the form "varname(key)". */
3457 static int Jim_NameIsDictSugar(const char *str, int len)
3458 {
3459     if (len == -1)
3460         len = strlen(str);
3461     if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3462         return 1;
3463     return 0;
3464 }
3465
3466 /* This method should be called only by the variable API.
3467  * It returns JIM_OK on success (variable already exists),
3468  * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3469  * a variable name, but syntax glue for [dict] i.e. the last
3470  * character is ')' */
3471 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3472 {
3473     Jim_HashEntry *he;
3474     const char *varName;
3475     int len;
3476
3477     /* Check if the object is already an uptodate variable */
3478     if (objPtr->typePtr == &variableObjType &&
3479         objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3480         return JIM_OK; /* nothing to do */
3481     /* Get the string representation */
3482     varName = Jim_GetString(objPtr, &len);
3483     /* Make sure it's not syntax glue to get/set dict. */
3484     if (Jim_NameIsDictSugar(varName, len))
3485             return JIM_DICT_SUGAR;
3486     if (varName[0] == ':' && varName[1] == ':') {
3487         he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3488         if (he == NULL) {
3489             return JIM_ERR;
3490         }
3491     }
3492     else {
3493         /* Lookup this name into the variables hash table */
3494         he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3495         if (he == NULL) {
3496             /* Try with static vars. */
3497             if (interp->framePtr->staticVars == NULL)
3498                 return JIM_ERR;
3499             if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3500                 return JIM_ERR;
3501         }
3502     }
3503     /* Free the old internal repr and set the new one. */
3504     Jim_FreeIntRep(interp, objPtr);
3505     objPtr->typePtr = &variableObjType;
3506     objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3507     objPtr->internalRep.varValue.varPtr = (void*)he->val;
3508     return JIM_OK;
3509 }
3510
3511 /* -------------------- Variables related functions ------------------------- */
3512 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3513         Jim_Obj *valObjPtr);
3514 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3515
3516 /* For now that's dummy. Variables lookup should be optimized
3517  * in many ways, with caching of lookups, and possibly with
3518  * a table of pre-allocated vars in every CallFrame for local vars.
3519  * All the caching should also have an 'epoch' mechanism similar
3520  * to the one used by Tcl for procedures lookup caching. */
3521
3522 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3523 {
3524     const char *name;
3525     Jim_Var *var;
3526     int err;
3527
3528     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3529         /* Check for [dict] syntax sugar. */
3530         if (err == JIM_DICT_SUGAR)
3531             return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3532         /* New variable to create */
3533         name = Jim_GetString(nameObjPtr, NULL);
3534
3535         var = Jim_Alloc(sizeof(*var));
3536         var->objPtr = valObjPtr;
3537         Jim_IncrRefCount(valObjPtr);
3538         var->linkFramePtr = NULL;
3539         /* Insert the new variable */
3540         if (name[0] == ':' && name[1] == ':') {
3541             /* Into to the top evel frame */
3542             Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3543         }
3544         else {
3545             Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3546         }
3547         /* Make the object int rep a variable */
3548         Jim_FreeIntRep(interp, nameObjPtr);
3549         nameObjPtr->typePtr = &variableObjType;
3550         nameObjPtr->internalRep.varValue.callFrameId =
3551             interp->framePtr->id;
3552         nameObjPtr->internalRep.varValue.varPtr = var;
3553     } else {
3554         var = nameObjPtr->internalRep.varValue.varPtr;
3555         if (var->linkFramePtr == NULL) {
3556             Jim_IncrRefCount(valObjPtr);
3557             Jim_DecrRefCount(interp, var->objPtr);
3558             var->objPtr = valObjPtr;
3559         } else { /* Else handle the link */
3560             Jim_CallFrame *savedCallFrame;
3561
3562             savedCallFrame = interp->framePtr;
3563             interp->framePtr = var->linkFramePtr;
3564             err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3565             interp->framePtr = savedCallFrame;
3566             if (err != JIM_OK)
3567                 return err;
3568         }
3569     }
3570     return JIM_OK;
3571 }
3572
3573 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3574 {
3575     Jim_Obj *nameObjPtr;
3576     int result;
3577
3578     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3579     Jim_IncrRefCount(nameObjPtr);
3580     result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3581     Jim_DecrRefCount(interp, nameObjPtr);
3582     return result;
3583 }
3584
3585 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3586 {
3587     Jim_CallFrame *savedFramePtr;
3588     int result;
3589
3590     savedFramePtr = interp->framePtr;
3591     interp->framePtr = interp->topFramePtr;
3592     result = Jim_SetVariableStr(interp, name, objPtr);
3593     interp->framePtr = savedFramePtr;
3594     return result;
3595 }
3596
3597 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3598 {
3599     Jim_Obj *nameObjPtr, *valObjPtr;
3600     int result;
3601
3602     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3603     valObjPtr = Jim_NewStringObj(interp, val, -1);
3604     Jim_IncrRefCount(nameObjPtr);
3605     Jim_IncrRefCount(valObjPtr);
3606     result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3607     Jim_DecrRefCount(interp, nameObjPtr);
3608     Jim_DecrRefCount(interp, valObjPtr);
3609     return result;
3610 }
3611
3612 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3613         Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3614 {
3615     const char *varName;
3616     int len;
3617
3618     /* Check for cycles. */
3619     if (interp->framePtr == targetCallFrame) {
3620         Jim_Obj *objPtr = targetNameObjPtr;
3621         Jim_Var *varPtr;
3622         /* Cycles are only possible with 'uplevel 0' */
3623         while(1) {
3624             if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3625                 Jim_SetResultString(interp,
3626                     "can't upvar from variable to itself", -1);
3627                 return JIM_ERR;
3628             }
3629             if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3630                 break;
3631             varPtr = objPtr->internalRep.varValue.varPtr;
3632             if (varPtr->linkFramePtr != targetCallFrame) break;
3633             objPtr = varPtr->objPtr;
3634         }
3635     }
3636     varName = Jim_GetString(nameObjPtr, &len);
3637     if (Jim_NameIsDictSugar(varName, len)) {
3638         Jim_SetResultString(interp,
3639             "Dict key syntax invalid as link source", -1);
3640         return JIM_ERR;
3641     }
3642     /* Perform the binding */
3643     Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3644     /* We are now sure 'nameObjPtr' type is variableObjType */
3645     nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3646     return JIM_OK;
3647 }
3648
3649 /* Return the Jim_Obj pointer associated with a variable name,
3650  * or NULL if the variable was not found in the current context.
3651  * The same optimization discussed in the comment to the
3652  * 'SetVariable' function should apply here. */
3653 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3654 {
3655     int err;
3656
3657     /* All the rest is handled here */
3658     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3659         /* Check for [dict] syntax sugar. */
3660         if (err == JIM_DICT_SUGAR)
3661             return JimDictSugarGet(interp, nameObjPtr);
3662         if (flags & JIM_ERRMSG) {
3663             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3664             Jim_AppendStrings(interp, Jim_GetResult(interp),
3665                 "can't read \"", nameObjPtr->bytes,
3666                 "\": no such variable", NULL);
3667         }
3668         return NULL;
3669     } else {
3670         Jim_Var *varPtr;
3671         Jim_Obj *objPtr;
3672         Jim_CallFrame *savedCallFrame;
3673
3674         varPtr = nameObjPtr->internalRep.varValue.varPtr;
3675         if (varPtr->linkFramePtr == NULL)
3676             return varPtr->objPtr;
3677         /* The variable is a link? Resolve it. */
3678         savedCallFrame = interp->framePtr;
3679         interp->framePtr = varPtr->linkFramePtr;
3680         objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3681         if (objPtr == NULL && flags & JIM_ERRMSG) {
3682             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3683             Jim_AppendStrings(interp, Jim_GetResult(interp),
3684                 "can't read \"", nameObjPtr->bytes,
3685                 "\": no such variable", NULL);
3686         }
3687         interp->framePtr = savedCallFrame;
3688         return objPtr;
3689     }
3690 }
3691
3692 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3693         int flags)
3694 {
3695     Jim_CallFrame *savedFramePtr;
3696     Jim_Obj *objPtr;
3697
3698     savedFramePtr = interp->framePtr;
3699     interp->framePtr = interp->topFramePtr;
3700     objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3701     interp->framePtr = savedFramePtr;
3702
3703     return objPtr;
3704 }
3705
3706 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3707 {
3708     Jim_Obj *nameObjPtr, *varObjPtr;
3709
3710     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3711     Jim_IncrRefCount(nameObjPtr);
3712     varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3713     Jim_DecrRefCount(interp, nameObjPtr);
3714     return varObjPtr;
3715 }
3716
3717 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3718         int flags)
3719 {
3720     Jim_CallFrame *savedFramePtr;
3721     Jim_Obj *objPtr;
3722
3723     savedFramePtr = interp->framePtr;
3724     interp->framePtr = interp->topFramePtr;
3725     objPtr = Jim_GetVariableStr(interp, name, flags);
3726     interp->framePtr = savedFramePtr;
3727
3728     return objPtr;
3729 }
3730
3731 /* Unset a variable.
3732  * Note: On success unset invalidates all the variable objects created
3733  * in the current call frame incrementing. */
3734 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3735 {
3736     const char *name;
3737     Jim_Var *varPtr;
3738     int err;
3739     
3740     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3741         /* Check for [dict] syntax sugar. */
3742         if (err == JIM_DICT_SUGAR)
3743             return JimDictSugarSet(interp, nameObjPtr, NULL);
3744         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3745         Jim_AppendStrings(interp, Jim_GetResult(interp),
3746             "can't unset \"", nameObjPtr->bytes,
3747             "\": no such variable", NULL);
3748         return JIM_ERR; /* var not found */
3749     }
3750     varPtr = nameObjPtr->internalRep.varValue.varPtr;
3751     /* If it's a link call UnsetVariable recursively */
3752     if (varPtr->linkFramePtr) {
3753         int retval;
3754
3755         Jim_CallFrame *savedCallFrame;
3756
3757         savedCallFrame = interp->framePtr;
3758         interp->framePtr = varPtr->linkFramePtr;
3759         retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3760         interp->framePtr = savedCallFrame;
3761         if (retval != JIM_OK && flags & JIM_ERRMSG) {
3762             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3763             Jim_AppendStrings(interp, Jim_GetResult(interp),
3764                 "can't unset \"", nameObjPtr->bytes,
3765                 "\": no such variable", NULL);
3766         }
3767         return retval;
3768     } else {
3769         name = Jim_GetString(nameObjPtr, NULL);
3770         if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3771                 != JIM_OK) return JIM_ERR;
3772         /* Change the callframe id, invalidating var lookup caching */
3773         JimChangeCallFrameId(interp, interp->framePtr);
3774         return JIM_OK;
3775     }
3776 }
3777
3778 /* ----------  Dict syntax sugar (similar to array Tcl syntax) -------------- */
3779
3780 /* Given a variable name for [dict] operation syntax sugar,
3781  * this function returns two objects, the first with the name
3782  * of the variable to set, and the second with the rispective key.
3783  * For example "foo(bar)" will return objects with string repr. of
3784  * "foo" and "bar".
3785  *
3786  * The returned objects have refcount = 1. The function can't fail. */
3787 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3788         Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3789 {
3790     const char *str, *p;
3791     char *t;
3792     int len, keyLen, nameLen;
3793     Jim_Obj *varObjPtr, *keyObjPtr;
3794
3795     str = Jim_GetString(objPtr, &len);
3796     p = strchr(str, '(');
3797     p++;
3798     keyLen = len-((p-str)+1);
3799     nameLen = (p-str)-1;
3800     /* Create the objects with the variable name and key. */
3801     t = Jim_Alloc(nameLen+1);
3802     memcpy(t, str, nameLen);
3803     t[nameLen] = '\0';
3804     varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3805
3806     t = Jim_Alloc(keyLen+1);
3807     memcpy(t, p, keyLen);
3808     t[keyLen] = '\0';
3809     keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3810
3811     Jim_IncrRefCount(varObjPtr);
3812     Jim_IncrRefCount(keyObjPtr);
3813     *varPtrPtr = varObjPtr;
3814     *keyPtrPtr = keyObjPtr;
3815 }
3816
3817 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3818  * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3819 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3820         Jim_Obj *valObjPtr)
3821 {
3822     Jim_Obj *varObjPtr, *keyObjPtr;
3823     int err = JIM_OK;
3824
3825     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3826     err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3827             valObjPtr);
3828     Jim_DecrRefCount(interp, varObjPtr);
3829     Jim_DecrRefCount(interp, keyObjPtr);
3830     return err;
3831 }
3832
3833 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3834 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3835 {
3836     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3837
3838     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3839     dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3840     if (!dictObjPtr) {
3841         resObjPtr = NULL;
3842         goto err;
3843     }
3844     if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3845             != JIM_OK) {
3846         resObjPtr = NULL;
3847     }
3848 err:
3849     Jim_DecrRefCount(interp, varObjPtr);
3850     Jim_DecrRefCount(interp, keyObjPtr);
3851     return resObjPtr;
3852 }
3853
3854 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3855
3856 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3857 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3858         Jim_Obj *dupPtr);
3859
3860 static Jim_ObjType dictSubstObjType = {
3861     "dict-substitution",
3862     FreeDictSubstInternalRep,
3863     DupDictSubstInternalRep,
3864     NULL,
3865     JIM_TYPE_NONE,
3866 };
3867
3868 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3869 {
3870     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3871     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3872 }
3873
3874 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3875         Jim_Obj *dupPtr)
3876 {
3877     JIM_NOTUSED(interp);
3878
3879     dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3880         srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3881     dupPtr->internalRep.dictSubstValue.indexObjPtr =
3882         srcPtr->internalRep.dictSubstValue.indexObjPtr;
3883     dupPtr->typePtr = &dictSubstObjType;
3884 }
3885
3886 /* This function is used to expand [dict get] sugar in the form
3887  * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3888  * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3889  * object that is *guaranteed* to be in the form VARNAME(INDEX).
3890  * The 'index' part is [subst]ituted, and is used to lookup a key inside
3891  * the [dict]ionary contained in variable VARNAME. */
3892 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3893 {
3894     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3895     Jim_Obj *substKeyObjPtr = NULL;
3896
3897     if (objPtr->typePtr != &dictSubstObjType) {
3898         JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3899         Jim_FreeIntRep(interp, objPtr);
3900         objPtr->typePtr = &dictSubstObjType;
3901         objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3902         objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3903     }
3904     if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3905                 &substKeyObjPtr, JIM_NONE)
3906             != JIM_OK) {
3907         substKeyObjPtr = NULL;
3908         goto err;
3909     }
3910     Jim_IncrRefCount(substKeyObjPtr);
3911     dictObjPtr = Jim_GetVariable(interp,
3912             objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3913     if (!dictObjPtr) {
3914         resObjPtr = NULL;
3915         goto err;
3916     }
3917     if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3918             != JIM_OK) {
3919         resObjPtr = NULL;
3920         goto err;
3921     }
3922 err:
3923     if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3924     return resObjPtr;
3925 }
3926
3927 /* -----------------------------------------------------------------------------
3928  * CallFrame
3929  * ---------------------------------------------------------------------------*/
3930
3931 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3932 {
3933     Jim_CallFrame *cf;
3934     if (interp->freeFramesList) {
3935         cf = interp->freeFramesList;
3936         interp->freeFramesList = cf->nextFramePtr;
3937     } else {
3938         cf = Jim_Alloc(sizeof(*cf));
3939         cf->vars.table = NULL;
3940     }
3941
3942     cf->id = interp->callFrameEpoch++;
3943     cf->parentCallFrame = NULL;
3944     cf->argv = NULL;
3945     cf->argc = 0;
3946     cf->procArgsObjPtr = NULL;
3947     cf->procBodyObjPtr = NULL;
3948     cf->nextFramePtr = NULL;
3949     cf->staticVars = NULL;
3950     if (cf->vars.table == NULL)
3951         Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3952     return cf;
3953 }
3954
3955 /* Used to invalidate every caching related to callframe stability. */
3956 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3957 {
3958     cf->id = interp->callFrameEpoch++;
3959 }
3960
3961 #define JIM_FCF_NONE 0 /* no flags */
3962 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3963 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3964         int flags)
3965 {
3966     if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3967     if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3968     if (!(flags & JIM_FCF_NOHT))
3969         Jim_FreeHashTable(&cf->vars);
3970     else {
3971         int i;
3972         Jim_HashEntry **table = cf->vars.table, *he;
3973
3974         for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3975             he = table[i];
3976             while (he != NULL) {
3977                 Jim_HashEntry *nextEntry = he->next;
3978                 Jim_Var *varPtr = (void*) he->val;
3979
3980                 Jim_DecrRefCount(interp, varPtr->objPtr);
3981                 Jim_Free(he->val);
3982                 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3983                 Jim_Free(he);
3984                 table[i] = NULL;
3985                 he = nextEntry;
3986             }
3987         }
3988         cf->vars.used = 0;
3989     }
3990     cf->nextFramePtr = interp->freeFramesList;
3991     interp->freeFramesList = cf;
3992 }
3993
3994 /* -----------------------------------------------------------------------------
3995  * References
3996  * ---------------------------------------------------------------------------*/
3997
3998 /* References HashTable Type.
3999  *
4000  * Keys are jim_wide integers, dynamically allocated for now but in the
4001  * future it's worth to cache this 8 bytes objects. Values are poitners
4002  * to Jim_References. */
4003 static void JimReferencesHTValDestructor(void *interp, void *val)
4004 {
4005     Jim_Reference *refPtr = (void*) val;
4006
4007     Jim_DecrRefCount(interp, refPtr->objPtr);
4008     if (refPtr->finalizerCmdNamePtr != NULL) {
4009         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4010     }
4011     Jim_Free(val);
4012 }
4013
4014 unsigned int JimReferencesHTHashFunction(const void *key)
4015 {
4016     /* Only the least significant bits are used. */
4017     const jim_wide *widePtr = key;
4018     unsigned int intValue = (unsigned int) *widePtr;
4019     return Jim_IntHashFunction(intValue);
4020 }
4021
4022 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4023 {
4024     /* Only the least significant bits are used. */
4025     const jim_wide *widePtr = key;
4026     unsigned int intValue = (unsigned int) *widePtr;
4027     return intValue; /* identity function. */
4028 }
4029
4030 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4031 {
4032     void *copy = Jim_Alloc(sizeof(jim_wide));
4033     JIM_NOTUSED(privdata);
4034
4035     memcpy(copy, key, sizeof(jim_wide));
4036     return copy;
4037 }
4038
4039 int JimReferencesHTKeyCompare(void *privdata, const void *key1, 
4040         const void *key2)
4041 {
4042     JIM_NOTUSED(privdata);
4043
4044     return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4045 }
4046
4047 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4048 {
4049     JIM_NOTUSED(privdata);
4050
4051     Jim_Free((void*)key);
4052 }
4053
4054 static Jim_HashTableType JimReferencesHashTableType = {
4055     JimReferencesHTHashFunction,    /* hash function */
4056     JimReferencesHTKeyDup,          /* key dup */
4057     NULL,                           /* val dup */
4058     JimReferencesHTKeyCompare,      /* key compare */
4059     JimReferencesHTKeyDestructor,   /* key destructor */
4060     JimReferencesHTValDestructor    /* val destructor */
4061 };
4062
4063 /* -----------------------------------------------------------------------------
4064  * Reference object type and References API
4065  * ---------------------------------------------------------------------------*/
4066
4067 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4068
4069 static Jim_ObjType referenceObjType = {
4070     "reference",
4071     NULL,
4072     NULL,
4073     UpdateStringOfReference,
4074     JIM_TYPE_REFERENCES,
4075 };
4076
4077 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4078 {
4079     int len;
4080     char buf[JIM_REFERENCE_SPACE+1];
4081     Jim_Reference *refPtr;
4082
4083     refPtr = objPtr->internalRep.refValue.refPtr;
4084     len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4085     objPtr->bytes = Jim_Alloc(len+1);
4086     memcpy(objPtr->bytes, buf, len+1);
4087     objPtr->length = len;
4088 }
4089
4090 /* returns true if 'c' is a valid reference tag character.
4091  * i.e. inside the range [_a-zA-Z0-9] */
4092 static int isrefchar(int c)
4093 {
4094     if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4095         (c >= '0' && c <= '9')) return 1;
4096     return 0;
4097 }
4098
4099 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4100 {
4101     jim_wide wideValue;
4102     int i, len;
4103     const char *str, *start, *end;
4104     char refId[21];
4105     Jim_Reference *refPtr;
4106     Jim_HashEntry *he;
4107
4108     /* Get the string representation */
4109     str = Jim_GetString(objPtr, &len);
4110     /* Check if it looks like a reference */
4111     if (len < JIM_REFERENCE_SPACE) goto badformat;
4112     /* Trim spaces */
4113     start = str;
4114     end = str+len-1;
4115     while (*start == ' ') start++;
4116     while (*end == ' ' && end > start) end--;
4117     if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4118     /* <reference.<1234567>.%020> */
4119     if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4120     if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4121     /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4122     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4123         if (!isrefchar(start[12+i])) goto badformat;
4124     }
4125     /* Extract info from the refernece. */
4126     memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4127     refId[20] = '\0';
4128     /* Try to convert the ID into a jim_wide */
4129     if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4130     /* Check if the reference really exists! */
4131     he = Jim_FindHashEntry(&interp->references, &wideValue);
4132     if (he == NULL) {
4133         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4134         Jim_AppendStrings(interp, Jim_GetResult(interp),
4135                 "Invalid reference ID \"", str, "\"", NULL);
4136         return JIM_ERR;
4137     }
4138     refPtr = he->val;
4139     /* Free the old internal repr and set the new one. */
4140     Jim_FreeIntRep(interp, objPtr);
4141     objPtr->typePtr = &referenceObjType;
4142     objPtr->internalRep.refValue.id = wideValue;
4143     objPtr->internalRep.refValue.refPtr = refPtr;
4144     return JIM_OK;
4145
4146 badformat:
4147     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4148     Jim_AppendStrings(interp, Jim_GetResult(interp),
4149             "expected reference but got \"", str, "\"", NULL);
4150     return JIM_ERR;
4151 }
4152
4153 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4154  * as finalizer command (or NULL if there is no finalizer).
4155  * The returned reference object has refcount = 0. */
4156 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4157         Jim_Obj *cmdNamePtr)
4158 {
4159     struct Jim_Reference *refPtr;
4160     jim_wide wideValue = interp->referenceNextId;
4161     Jim_Obj *refObjPtr;
4162     const char *tag;
4163     int tagLen, i;
4164
4165     /* Perform the Garbage Collection if needed. */
4166     Jim_CollectIfNeeded(interp);
4167
4168     refPtr = Jim_Alloc(sizeof(*refPtr));
4169     refPtr->objPtr = objPtr;
4170     Jim_IncrRefCount(objPtr);
4171     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4172     if (cmdNamePtr)
4173         Jim_IncrRefCount(cmdNamePtr);
4174     Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4175     refObjPtr = Jim_NewObj(interp);
4176     refObjPtr->typePtr = &referenceObjType;
4177     refObjPtr->bytes = NULL;
4178     refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4179     refObjPtr->internalRep.refValue.refPtr = refPtr;
4180     interp->referenceNextId++;
4181     /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4182      * that does not pass the 'isrefchar' test is replaced with '_' */
4183     tag = Jim_GetString(tagPtr, &tagLen);
4184     if (tagLen > JIM_REFERENCE_TAGLEN)
4185         tagLen = JIM_REFERENCE_TAGLEN;
4186     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4187         if (i < tagLen)
4188             refPtr->tag[i] = tag[i];
4189         else
4190             refPtr->tag[i] = '_';
4191     }
4192     refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4193     return refObjPtr;
4194 }
4195
4196 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4197 {
4198     if (objPtr->typePtr != &referenceObjType &&
4199         SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4200         return NULL;
4201     return objPtr->internalRep.refValue.refPtr;
4202 }
4203
4204 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4205 {
4206     Jim_Reference *refPtr;
4207
4208     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4209         return JIM_ERR;
4210     Jim_IncrRefCount(cmdNamePtr);
4211     if (refPtr->finalizerCmdNamePtr)
4212         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4213     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4214     return JIM_OK;
4215 }
4216
4217 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4218 {
4219     Jim_Reference *refPtr;
4220
4221     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4222         return JIM_ERR;
4223     *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4224     return JIM_OK;
4225 }
4226
4227 /* -----------------------------------------------------------------------------
4228  * References Garbage Collection
4229  * ---------------------------------------------------------------------------*/
4230
4231 /* This the hash table type for the "MARK" phase of the GC */
4232 static Jim_HashTableType JimRefMarkHashTableType = {
4233     JimReferencesHTHashFunction,    /* hash function */
4234     JimReferencesHTKeyDup,          /* key dup */
4235     NULL,                           /* val dup */
4236     JimReferencesHTKeyCompare,      /* key compare */
4237     JimReferencesHTKeyDestructor,   /* key destructor */
4238     NULL                            /* val destructor */
4239 };
4240
4241 /* #define JIM_DEBUG_GC 1 */
4242
4243 /* Performs the garbage collection. */
4244 int Jim_Collect(Jim_Interp *interp)
4245 {
4246     Jim_HashTable marks;
4247     Jim_HashTableIterator *htiter;
4248     Jim_HashEntry *he;
4249     Jim_Obj *objPtr;
4250     int collected = 0;
4251
4252     /* Avoid recursive calls */
4253     if (interp->lastCollectId == -1) {
4254         /* Jim_Collect() already running. Return just now. */
4255         return 0;
4256     }
4257     interp->lastCollectId = -1;
4258
4259     /* Mark all the references found into the 'mark' hash table.
4260      * The references are searched in every live object that
4261      * is of a type that can contain references. */
4262     Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4263     objPtr = interp->liveList;
4264     while(objPtr) {
4265         if (objPtr->typePtr == NULL ||
4266             objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4267             const char *str, *p;
4268             int len;
4269
4270             /* If the object is of type reference, to get the
4271              * Id is simple... */
4272             if (objPtr->typePtr == &referenceObjType) {
4273                 Jim_AddHashEntry(&marks,
4274                     &objPtr->internalRep.refValue.id, NULL);
4275 #ifdef JIM_DEBUG_GC
4276                 Jim_fprintf(interp,interp->cookie_stdout,
4277                     "MARK (reference): %d refcount: %d" JIM_NL, 
4278                     (int) objPtr->internalRep.refValue.id,
4279                     objPtr->refCount);
4280 #endif
4281                 objPtr = objPtr->nextObjPtr;
4282                 continue;
4283             }
4284             /* Get the string repr of the object we want
4285              * to scan for references. */
4286             p = str = Jim_GetString(objPtr, &len);
4287             /* Skip objects too little to contain references. */
4288             if (len < JIM_REFERENCE_SPACE) {
4289                 objPtr = objPtr->nextObjPtr;
4290                 continue;
4291             }
4292             /* Extract references from the object string repr. */
4293             while(1) {
4294                 int i;
4295                 jim_wide id;
4296                 char buf[21];
4297
4298                 if ((p = strstr(p, "<reference.<")) == NULL)
4299                     break;
4300                 /* Check if it's a valid reference. */
4301                 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4302                 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4303                 for (i = 21; i <= 40; i++)
4304                     if (!isdigit((int)p[i]))
4305                         break;
4306                 /* Get the ID */
4307                 memcpy(buf, p+21, 20);
4308                 buf[20] = '\0';
4309                 Jim_StringToWide(buf, &id, 10);
4310
4311                 /* Ok, a reference for the given ID
4312                  * was found. Mark it. */
4313                 Jim_AddHashEntry(&marks, &id, NULL);
4314 #ifdef JIM_DEBUG_GC
4315                 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4316 #endif
4317                 p += JIM_REFERENCE_SPACE;
4318             }
4319         }
4320         objPtr = objPtr->nextObjPtr;
4321     }
4322
4323     /* Run the references hash table to destroy every reference that
4324      * is not referenced outside (not present in the mark HT). */
4325     htiter = Jim_GetHashTableIterator(&interp->references);
4326     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4327         const jim_wide *refId;
4328         Jim_Reference *refPtr;
4329
4330         refId = he->key;
4331         /* Check if in the mark phase we encountered
4332          * this reference. */
4333         if (Jim_FindHashEntry(&marks, refId) == NULL) {
4334 #ifdef JIM_DEBUG_GC
4335             Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4336 #endif
4337             collected++;
4338             /* Drop the reference, but call the
4339              * finalizer first if registered. */
4340             refPtr = he->val;
4341             if (refPtr->finalizerCmdNamePtr) {
4342                 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4343                 Jim_Obj *objv[3], *oldResult;
4344
4345                 JimFormatReference(refstr, refPtr, *refId);
4346
4347                 objv[0] = refPtr->finalizerCmdNamePtr;
4348                 objv[1] = Jim_NewStringObjNoAlloc(interp,
4349                         refstr, 32);
4350                 objv[2] = refPtr->objPtr;
4351                 Jim_IncrRefCount(objv[0]);
4352                 Jim_IncrRefCount(objv[1]);
4353                 Jim_IncrRefCount(objv[2]);
4354
4355                 /* Drop the reference itself */
4356                 Jim_DeleteHashEntry(&interp->references, refId);
4357
4358                 /* Call the finalizer. Errors ignored. */
4359                 oldResult = interp->result;
4360                 Jim_IncrRefCount(oldResult);
4361                 Jim_EvalObjVector(interp, 3, objv);
4362                 Jim_SetResult(interp, oldResult);
4363                 Jim_DecrRefCount(interp, oldResult);
4364
4365                 Jim_DecrRefCount(interp, objv[0]);
4366                 Jim_DecrRefCount(interp, objv[1]);
4367                 Jim_DecrRefCount(interp, objv[2]);
4368             } else {
4369                 Jim_DeleteHashEntry(&interp->references, refId);
4370             }
4371         }
4372     }
4373     Jim_FreeHashTableIterator(htiter);
4374     Jim_FreeHashTable(&marks);
4375     interp->lastCollectId = interp->referenceNextId;
4376     interp->lastCollectTime = time(NULL);
4377     return collected;
4378 }
4379
4380 #define JIM_COLLECT_ID_PERIOD 5000
4381 #define JIM_COLLECT_TIME_PERIOD 300
4382
4383 void Jim_CollectIfNeeded(Jim_Interp *interp)
4384 {
4385     jim_wide elapsedId;
4386     int elapsedTime;
4387     
4388     elapsedId = interp->referenceNextId - interp->lastCollectId;
4389     elapsedTime = time(NULL) - interp->lastCollectTime;
4390
4391
4392     if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4393         elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4394         Jim_Collect(interp);
4395     }
4396 }
4397
4398 /* -----------------------------------------------------------------------------
4399  * Interpreter related functions
4400  * ---------------------------------------------------------------------------*/
4401
4402 Jim_Interp *Jim_CreateInterp(void)
4403 {
4404     Jim_Interp *i = Jim_Alloc(sizeof(*i));
4405     Jim_Obj *pathPtr;
4406
4407     i->errorLine = 0;
4408     i->errorFileName = Jim_StrDup("");
4409     i->numLevels = 0;
4410     i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4411     i->returnCode = JIM_OK;
4412     i->exitCode = 0;
4413     i->procEpoch = 0;
4414     i->callFrameEpoch = 0;
4415     i->liveList = i->freeList = NULL;
4416     i->scriptFileName = Jim_StrDup("");
4417     i->referenceNextId = 0;
4418     i->lastCollectId = 0;
4419     i->lastCollectTime = time(NULL);
4420     i->freeFramesList = NULL;
4421     i->prngState = NULL;
4422     i->evalRetcodeLevel = -1;
4423     i->cookie_stdin = stdin;
4424     i->cookie_stdout = stdout;
4425     i->cookie_stderr = stderr;
4426         i->cb_fwrite   = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4427         i->cb_fread    = ((size_t (*)(       void *, size_t, size_t, void *))(fread));
4428         i->cb_vfprintf = ((int    (*)( void *, const char *fmt, va_list ))(vfprintf));
4429         i->cb_fflush   = ((int    (*)( void *))(fflush));
4430         i->cb_fgets    = ((char * (*)( char *, int, void *))(fgets));
4431
4432     /* Note that we can create objects only after the
4433      * interpreter liveList and freeList pointers are
4434      * initialized to NULL. */
4435     Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4436     Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4437     Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4438             NULL);
4439     Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4440     Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4441     Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4442     i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4443     i->emptyObj = Jim_NewEmptyStringObj(i);
4444     i->result = i->emptyObj;
4445     i->stackTrace = Jim_NewListObj(i, NULL, 0);
4446     i->unknown = Jim_NewStringObj(i, "unknown", -1);
4447     i->unknown_called = 0;
4448     Jim_IncrRefCount(i->emptyObj);
4449     Jim_IncrRefCount(i->result);
4450     Jim_IncrRefCount(i->stackTrace);
4451     Jim_IncrRefCount(i->unknown);
4452
4453     /* Initialize key variables every interpreter should contain */
4454     pathPtr = Jim_NewStringObj(i, "./", -1);
4455     Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4456     Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4457
4458     /* Export the core API to extensions */
4459     JimRegisterCoreApi(i);
4460     return i;
4461 }
4462
4463 /* This is the only function Jim exports directly without
4464  * to use the STUB system. It is only used by embedders
4465  * in order to get an interpreter with the Jim API pointers
4466  * registered. */
4467 Jim_Interp *ExportedJimCreateInterp(void)
4468 {
4469     return Jim_CreateInterp();
4470 }
4471
4472 void Jim_FreeInterp(Jim_Interp *i)
4473 {
4474     Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4475     Jim_Obj *objPtr, *nextObjPtr;
4476
4477     Jim_DecrRefCount(i, i->emptyObj);
4478     Jim_DecrRefCount(i, i->result);
4479     Jim_DecrRefCount(i, i->stackTrace);
4480     Jim_DecrRefCount(i, i->unknown);
4481     Jim_Free((void*)i->errorFileName);
4482     Jim_Free((void*)i->scriptFileName);
4483     Jim_FreeHashTable(&i->commands);
4484     Jim_FreeHashTable(&i->references);
4485     Jim_FreeHashTable(&i->stub);
4486     Jim_FreeHashTable(&i->assocData);
4487     Jim_FreeHashTable(&i->packages);
4488     Jim_Free(i->prngState);
4489     /* Free the call frames list */
4490     while(cf) {
4491         prevcf = cf->parentCallFrame;
4492         JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4493         cf = prevcf;
4494     }
4495     /* Check that the live object list is empty, otherwise
4496      * there is a memory leak. */
4497     if (i->liveList != NULL) {
4498         Jim_Obj *objPtr = i->liveList;
4499     
4500         Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4501         Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4502         while(objPtr) {
4503             const char *type = objPtr->typePtr ?
4504                 objPtr->typePtr->name : "";
4505             Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4506                     objPtr, type,
4507                     objPtr->bytes ? objPtr->bytes
4508                     : "(null)", objPtr->refCount);
4509             if (objPtr->typePtr == &sourceObjType) {
4510                 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4511                 objPtr->internalRep.sourceValue.fileName,
4512                 objPtr->internalRep.sourceValue.lineNumber);
4513             }
4514             objPtr = objPtr->nextObjPtr;
4515         }
4516         Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4517         Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4518     }
4519     /* Free all the freed objects. */
4520     objPtr = i->freeList;
4521     while (objPtr) {
4522         nextObjPtr = objPtr->nextObjPtr;
4523         Jim_Free(objPtr);
4524         objPtr = nextObjPtr;
4525     }
4526     /* Free cached CallFrame structures */
4527     cf = i->freeFramesList;
4528     while(cf) {
4529         nextcf = cf->nextFramePtr;
4530         if (cf->vars.table != NULL)
4531             Jim_Free(cf->vars.table);
4532         Jim_Free(cf);
4533         cf = nextcf;
4534     }
4535     /* Free the sharedString hash table. Make sure to free it
4536      * after every other Jim_Object was freed. */
4537     Jim_FreeHashTable(&i->sharedStrings);
4538     /* Free the interpreter structure. */
4539     Jim_Free(i);
4540 }
4541
4542 /* Store the call frame relative to the level represented by
4543  * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4544  * level is assumed to be '1'.
4545  *
4546  * If a newLevelptr int pointer is specified, the function stores
4547  * the absolute level integer value of the new target callframe into
4548  * *newLevelPtr. (this is used to adjust interp->numLevels
4549  * in the implementation of [uplevel], so that [info level] will
4550  * return a correct information).
4551  *
4552  * This function accepts the 'level' argument in the form
4553  * of the commands [uplevel] and [upvar].
4554  *
4555  * For a function accepting a relative integer as level suitable
4556  * for implementation of [info level ?level?] check the
4557  * GetCallFrameByInteger() function. */
4558 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4559         Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4560 {
4561     long level;
4562     const char *str;
4563     Jim_CallFrame *framePtr;
4564
4565     if (newLevelPtr) *newLevelPtr = interp->numLevels;
4566     if (levelObjPtr) {
4567         str = Jim_GetString(levelObjPtr, NULL);
4568         if (str[0] == '#') {
4569             char *endptr;
4570             /* speedup for the toplevel (level #0) */
4571             if (str[1] == '0' && str[2] == '\0') {
4572                 if (newLevelPtr) *newLevelPtr = 0;
4573                 *framePtrPtr = interp->topFramePtr;
4574                 return JIM_OK;
4575             }
4576
4577             level = strtol(str+1, &endptr, 0);
4578             if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4579                 goto badlevel;
4580             /* An 'absolute' level is converted into the
4581              * 'number of levels to go back' format. */
4582             level = interp->numLevels - level;
4583             if (level < 0) goto badlevel;
4584         } else {
4585             if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4586                 goto badlevel;
4587         }
4588     } else {
4589         str = "1"; /* Needed to format the error message. */
4590         level = 1;
4591     }
4592     /* Lookup */
4593     framePtr = interp->framePtr;
4594     if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4595     while (level--) {
4596         framePtr = framePtr->parentCallFrame;
4597         if (framePtr == NULL) goto badlevel;
4598     }
4599     *framePtrPtr = framePtr;
4600     return JIM_OK;
4601 badlevel:
4602     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4603     Jim_AppendStrings(interp, Jim_GetResult(interp),
4604             "bad level \"", str, "\"", NULL);
4605     return JIM_ERR;
4606 }
4607
4608 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4609  * as a relative integer like in the [info level ?level?] command. */
4610 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4611         Jim_CallFrame **framePtrPtr)
4612 {
4613     jim_wide level;
4614     jim_wide relLevel; /* level relative to the current one. */
4615     Jim_CallFrame *framePtr;
4616
4617     if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4618         goto badlevel;
4619     if (level > 0) {
4620         /* An 'absolute' level is converted into the
4621          * 'number of levels to go back' format. */
4622         relLevel = interp->numLevels - level;
4623     } else {
4624         relLevel = -level;
4625     }
4626     /* Lookup */
4627     framePtr = interp->framePtr;
4628     while (relLevel--) {
4629         framePtr = framePtr->parentCallFrame;
4630         if (framePtr == NULL) goto badlevel;
4631     }
4632     *framePtrPtr = framePtr;
4633     return JIM_OK;
4634 badlevel:
4635     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4636     Jim_AppendStrings(interp, Jim_GetResult(interp),
4637             "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4638     return JIM_ERR;
4639 }
4640
4641 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4642 {
4643     Jim_Free((void*)interp->errorFileName);
4644     interp->errorFileName = Jim_StrDup(filename);
4645 }
4646
4647 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4648 {
4649     interp->errorLine = linenr;
4650 }
4651
4652 static void JimResetStackTrace(Jim_Interp *interp)
4653 {
4654     Jim_DecrRefCount(interp, interp->stackTrace);
4655     interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4656     Jim_IncrRefCount(interp->stackTrace);
4657 }
4658
4659 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4660         const char *filename, int linenr)
4661 {
4662     /* No need to add this dummy entry to the stack trace */
4663     if (strcmp(procname, "unknown") == 0) {
4664         return;
4665     }
4666
4667     if (Jim_IsShared(interp->stackTrace)) {
4668         interp->stackTrace =
4669             Jim_DuplicateObj(interp, interp->stackTrace);
4670         Jim_IncrRefCount(interp->stackTrace);
4671     }
4672     Jim_ListAppendElement(interp, interp->stackTrace,
4673             Jim_NewStringObj(interp, procname, -1));
4674     Jim_ListAppendElement(interp, interp->stackTrace,
4675             Jim_NewStringObj(interp, filename, -1));
4676     Jim_ListAppendElement(interp, interp->stackTrace,
4677             Jim_NewIntObj(interp, linenr));
4678 }
4679
4680 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4681 {
4682     AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4683     assocEntryPtr->delProc = delProc;
4684     assocEntryPtr->data = data;
4685     return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4686 }
4687
4688 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4689 {
4690     Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4691     if (entryPtr != NULL) {
4692         AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4693         return assocEntryPtr->data;
4694     }
4695     return NULL;
4696 }
4697
4698 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4699 {
4700     return Jim_DeleteHashEntry(&interp->assocData, key);
4701 }
4702
4703 int Jim_GetExitCode(Jim_Interp *interp) {
4704     return interp->exitCode;
4705 }
4706
4707 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4708 {
4709     if (fp != NULL) interp->cookie_stdin = fp;
4710     return interp->cookie_stdin;
4711 }
4712
4713 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4714 {
4715     if (fp != NULL) interp->cookie_stdout = fp;
4716     return interp->cookie_stdout;
4717 }
4718
4719 void *Jim_SetStderr(Jim_Interp *interp, void  *fp)
4720 {
4721     if (fp != NULL) interp->cookie_stderr = fp;
4722     return interp->cookie_stderr;
4723 }
4724
4725 /* -----------------------------------------------------------------------------
4726  * Shared strings.
4727  * Every interpreter has an hash table where to put shared dynamically
4728  * allocate strings that are likely to be used a lot of times.
4729  * For example, in the 'source' object type, there is a pointer to
4730  * the filename associated with that object. Every script has a lot
4731  * of this objects with the identical file name, so it is wise to share
4732  * this info.
4733  *
4734  * The API is trivial: Jim_GetSharedString(interp, "foobar")
4735  * returns the pointer to the shared string. Every time a reference
4736  * to the string is no longer used, the user should call
4737  * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4738  * a given string, it is removed from the hash table.
4739  * ---------------------------------------------------------------------------*/
4740 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4741 {
4742     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4743
4744     if (he == NULL) {
4745         char *strCopy = Jim_StrDup(str);
4746
4747         Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4748         return strCopy;
4749     } else {
4750         long refCount = (long) he->val;
4751
4752         refCount++;
4753         he->val = (void*) refCount;
4754         return he->key;
4755     }
4756 }
4757
4758 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4759 {
4760     long refCount;
4761     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4762
4763     if (he == NULL)
4764         Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4765               "unknown shared string '%s'", str);
4766     refCount = (long) he->val;
4767     refCount--;
4768     if (refCount == 0) {
4769         Jim_DeleteHashEntry(&interp->sharedStrings, str);
4770     } else {
4771         he->val = (void*) refCount;
4772     }
4773 }
4774
4775 /* -----------------------------------------------------------------------------
4776  * Integer object
4777  * ---------------------------------------------------------------------------*/
4778 #define JIM_INTEGER_SPACE 24
4779
4780 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4781 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4782
4783 static Jim_ObjType intObjType = {
4784     "int",
4785     NULL,
4786     NULL,
4787     UpdateStringOfInt,
4788     JIM_TYPE_NONE,
4789 };
4790
4791 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4792 {
4793     int len;
4794     char buf[JIM_INTEGER_SPACE+1];
4795
4796     len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4797     objPtr->bytes = Jim_Alloc(len+1);
4798     memcpy(objPtr->bytes, buf, len+1);
4799     objPtr->length = len;
4800 }
4801
4802 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4803 {
4804     jim_wide wideValue;
4805     const char *str;
4806
4807     /* Get the string representation */
4808     str = Jim_GetString(objPtr, NULL);
4809     /* Try to convert into a jim_wide */
4810     if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4811         if (flags & JIM_ERRMSG) {
4812             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4813             Jim_AppendStrings(interp, Jim_GetResult(interp),
4814                     "expected integer but got \"", str, "\"", NULL);
4815         }
4816         return JIM_ERR;
4817     }
4818     if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4819         errno == ERANGE) {
4820         Jim_SetResultString(interp,
4821             "Integer value too big to be represented", -1);
4822         return JIM_ERR;
4823     }
4824     /* Free the old internal repr and set the new one. */
4825     Jim_FreeIntRep(interp, objPtr);
4826     objPtr->typePtr = &intObjType;
4827     objPtr->internalRep.wideValue = wideValue;
4828     return JIM_OK;
4829 }
4830
4831 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4832 {
4833     if (objPtr->typePtr != &intObjType &&
4834         SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4835         return JIM_ERR;
4836     *widePtr = objPtr->internalRep.wideValue;
4837     return JIM_OK;
4838 }
4839
4840 /* Get a wide but does not set an error if the format is bad. */
4841 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4842         jim_wide *widePtr)
4843 {
4844     if (objPtr->typePtr != &intObjType &&
4845         SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4846         return JIM_ERR;
4847     *widePtr = objPtr->internalRep.wideValue;
4848     return JIM_OK;
4849 }
4850
4851 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4852 {
4853     jim_wide wideValue;
4854     int retval;
4855
4856     retval = Jim_GetWide(interp, objPtr, &wideValue);
4857     if (retval == JIM_OK) {
4858         *longPtr = (long) wideValue;
4859         return JIM_OK;
4860     }
4861     return JIM_ERR;
4862 }
4863
4864 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4865 {
4866     if (Jim_IsShared(objPtr))
4867         Jim_Panic(interp,"Jim_SetWide called with shared object");
4868     if (objPtr->typePtr != &intObjType) {
4869         Jim_FreeIntRep(interp, objPtr);
4870         objPtr->typePtr = &intObjType;
4871     }
4872     Jim_InvalidateStringRep(objPtr);
4873     objPtr->internalRep.wideValue = wideValue;
4874 }
4875
4876 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4877 {
4878     Jim_Obj *objPtr;
4879
4880     objPtr = Jim_NewObj(interp);
4881     objPtr->typePtr = &intObjType;
4882     objPtr->bytes = NULL;
4883     objPtr->internalRep.wideValue = wideValue;
4884     return objPtr;
4885 }
4886
4887 /* -----------------------------------------------------------------------------
4888  * Double object
4889  * ---------------------------------------------------------------------------*/
4890 #define JIM_DOUBLE_SPACE 30
4891
4892 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4893 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4894
4895 static Jim_ObjType doubleObjType = {
4896     "double",
4897     NULL,
4898     NULL,
4899     UpdateStringOfDouble,
4900     JIM_TYPE_NONE,
4901 };
4902
4903 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4904 {
4905     int len;
4906     char buf[JIM_DOUBLE_SPACE+1];
4907
4908     len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4909     objPtr->bytes = Jim_Alloc(len+1);
4910     memcpy(objPtr->bytes, buf, len+1);
4911     objPtr->length = len;
4912 }
4913
4914 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4915 {
4916     double doubleValue;
4917     const char *str;
4918
4919     /* Get the string representation */
4920     str = Jim_GetString(objPtr, NULL);
4921     /* Try to convert into a double */
4922     if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4923         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4924         Jim_AppendStrings(interp, Jim_GetResult(interp),
4925                 "expected number but got '", str, "'", NULL);
4926         return JIM_ERR;
4927     }
4928     /* Free the old internal repr and set the new one. */
4929     Jim_FreeIntRep(interp, objPtr);
4930     objPtr->typePtr = &doubleObjType;
4931     objPtr->internalRep.doubleValue = doubleValue;
4932     return JIM_OK;
4933 }
4934
4935 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4936 {
4937     if (objPtr->typePtr != &doubleObjType &&
4938         SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4939         return JIM_ERR;
4940     *doublePtr = objPtr->internalRep.doubleValue;
4941     return JIM_OK;
4942 }
4943
4944 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4945 {
4946     if (Jim_IsShared(objPtr))
4947         Jim_Panic(interp,"Jim_SetDouble called with shared object");
4948     if (objPtr->typePtr != &doubleObjType) {
4949         Jim_FreeIntRep(interp, objPtr);
4950         objPtr->typePtr = &doubleObjType;
4951     }
4952     Jim_InvalidateStringRep(objPtr);
4953     objPtr->internalRep.doubleValue = doubleValue;
4954 }
4955
4956 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4957 {
4958     Jim_Obj *objPtr;
4959
4960     objPtr = Jim_NewObj(interp);
4961     objPtr->typePtr = &doubleObjType;
4962     objPtr->bytes = NULL;
4963     objPtr->internalRep.doubleValue = doubleValue;
4964     return objPtr;
4965 }
4966
4967 /* -----------------------------------------------------------------------------
4968  * List object
4969  * ---------------------------------------------------------------------------*/
4970 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4971 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4972 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4973 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4974 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4975
4976 /* Note that while the elements of the list may contain references,
4977  * the list object itself can't. This basically means that the
4978  * list object string representation as a whole can't contain references
4979  * that are not presents in the single elements. */
4980 static Jim_ObjType listObjType = {
4981     "list",
4982     FreeListInternalRep,
4983     DupListInternalRep,
4984     UpdateStringOfList,
4985     JIM_TYPE_NONE,
4986 };
4987
4988 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4989 {
4990     int i;
4991
4992     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4993         Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4994     }
4995     Jim_Free(objPtr->internalRep.listValue.ele);
4996 }
4997
4998 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4999 {
5000     int i;
5001     JIM_NOTUSED(interp);
5002
5003     dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5004     dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5005     dupPtr->internalRep.listValue.ele =
5006         Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5007     memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5008             sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5009     for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5010         Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5011     }
5012     dupPtr->typePtr = &listObjType;
5013 }
5014
5015 /* The following function checks if a given string can be encoded
5016  * into a list element without any kind of quoting, surrounded by braces,
5017  * or using escapes to quote. */
5018 #define JIM_ELESTR_SIMPLE 0
5019 #define JIM_ELESTR_BRACE 1
5020 #define JIM_ELESTR_QUOTE 2
5021 static int ListElementQuotingType(const char *s, int len)
5022 {
5023     int i, level, trySimple = 1;
5024
5025     /* Try with the SIMPLE case */
5026     if (len == 0) return JIM_ELESTR_BRACE;
5027     if (s[0] == '"' || s[0] == '{') {
5028         trySimple = 0;
5029         goto testbrace;
5030     }
5031     for (i = 0; i < len; i++) {
5032         switch(s[i]) {
5033         case ' ':
5034         case '$':
5035         case '"':
5036         case '[':
5037         case ']':
5038         case ';':
5039         case '\\':
5040         case '\r':
5041         case '\n':
5042         case '\t':
5043         case '\f':
5044         case '\v':
5045             trySimple = 0;
5046         case '{':
5047         case '}':
5048             goto testbrace;
5049         }
5050     }
5051     return JIM_ELESTR_SIMPLE;
5052
5053 testbrace:
5054     /* Test if it's possible to do with braces */
5055     if (s[len-1] == '\\' ||
5056         s[len-1] == ']') return JIM_ELESTR_QUOTE;
5057     level = 0;
5058     for (i = 0; i < len; i++) {
5059         switch(s[i]) {
5060         case '{': level++; break;
5061         case '}': level--;
5062               if (level < 0) return JIM_ELESTR_QUOTE;
5063               break;
5064         case '\\':
5065               if (s[i+1] == '\n')
5066                   return JIM_ELESTR_QUOTE;
5067               else
5068                   if (s[i+1] != '\0') i++;
5069               break;
5070         }
5071     }
5072     if (level == 0) {
5073         if (!trySimple) return JIM_ELESTR_BRACE;
5074         for (i = 0; i < len; i++) {
5075             switch(s[i]) {
5076             case ' ':
5077             case '$':
5078             case '"':
5079             case '[':
5080             case ']':
5081             case ';':
5082             case '\\':
5083             case '\r':
5084             case '\n':
5085             case '\t':
5086             case '\f':
5087             case '\v':
5088                 return JIM_ELESTR_BRACE;
5089                 break;
5090             }
5091         }
5092         return JIM_ELESTR_SIMPLE;
5093     }
5094     return JIM_ELESTR_QUOTE;
5095 }
5096
5097 /* Returns the malloc-ed representation of a string
5098  * using backslash to quote special chars. */
5099 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5100 {
5101     char *q = Jim_Alloc(len*2+1), *p;
5102
5103     p = q;
5104     while(*s) {
5105         switch (*s) {
5106         case ' ':
5107         case '$':
5108         case '"':
5109         case '[':
5110         case ']':
5111         case '{':
5112         case '}':
5113         case ';':
5114         case '\\':
5115             *p++ = '\\';
5116             *p++ = *s++;
5117             break;
5118         case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5119         case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5120         case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5121         case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5122         case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5123         default:
5124             *p++ = *s++;
5125             break;
5126         }
5127     }
5128     *p = '\0';
5129     *qlenPtr = p-q;
5130     return q;
5131 }
5132
5133 void UpdateStringOfList(struct Jim_Obj *objPtr)
5134 {
5135     int i, bufLen, realLength;
5136     const char *strRep;
5137     char *p;
5138     int *quotingType;
5139     Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5140
5141     /* (Over) Estimate the space needed. */
5142     quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5143     bufLen = 0;
5144     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5145         int len;
5146
5147         strRep = Jim_GetString(ele[i], &len);
5148         quotingType[i] = ListElementQuotingType(strRep, len);
5149         switch (quotingType[i]) {
5150         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5151         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5152         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5153         }
5154         bufLen++; /* elements separator. */
5155     }
5156     bufLen++;
5157
5158     /* Generate the string rep. */
5159     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5160     realLength = 0;
5161     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5162         int len, qlen;
5163         const char *strRep = Jim_GetString(ele[i], &len);
5164         char *q;
5165
5166         switch(quotingType[i]) {
5167         case JIM_ELESTR_SIMPLE:
5168             memcpy(p, strRep, len);
5169             p += len;
5170             realLength += len;
5171             break;
5172         case JIM_ELESTR_BRACE:
5173             *p++ = '{';
5174             memcpy(p, strRep, len);
5175             p += len;
5176             *p++ = '}';
5177             realLength += len+2;
5178             break;
5179         case JIM_ELESTR_QUOTE:
5180             q = BackslashQuoteString(strRep, len, &qlen);
5181             memcpy(p, q, qlen);
5182             Jim_Free(q);
5183             p += qlen;
5184             realLength += qlen;
5185             break;
5186         }
5187         /* Add a separating space */
5188         if (i+1 != objPtr->internalRep.listValue.len) {
5189             *p++ = ' ';
5190             realLength ++;
5191         }
5192     }
5193     *p = '\0'; /* nul term. */
5194     objPtr->length = realLength;
5195     Jim_Free(quotingType);
5196 }
5197
5198 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5199 {
5200     struct JimParserCtx parser;
5201     const char *str;
5202     int strLen;
5203
5204     /* Get the string representation */
5205     str = Jim_GetString(objPtr, &strLen);
5206
5207     /* Free the old internal repr just now and initialize the
5208      * new one just now. The string->list conversion can't fail. */
5209     Jim_FreeIntRep(interp, objPtr);
5210     objPtr->typePtr = &listObjType;
5211     objPtr->internalRep.listValue.len = 0;
5212     objPtr->internalRep.listValue.maxLen = 0;
5213     objPtr->internalRep.listValue.ele = NULL;
5214
5215     /* Convert into a list */
5216     JimParserInit(&parser, str, strLen, 1);
5217     while(!JimParserEof(&parser)) {
5218         char *token;
5219         int tokenLen, type;
5220         Jim_Obj *elementPtr;
5221
5222         JimParseList(&parser);
5223         if (JimParserTtype(&parser) != JIM_TT_STR &&
5224             JimParserTtype(&parser) != JIM_TT_ESC)
5225             continue;
5226         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5227         elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5228         ListAppendElement(objPtr, elementPtr);
5229     }
5230     return JIM_OK;
5231 }
5232
5233 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, 
5234         int len)
5235 {
5236     Jim_Obj *objPtr;
5237     int i;
5238
5239     objPtr = Jim_NewObj(interp);
5240     objPtr->typePtr = &listObjType;
5241     objPtr->bytes = NULL;
5242     objPtr->internalRep.listValue.ele = NULL;
5243     objPtr->internalRep.listValue.len = 0;
5244     objPtr->internalRep.listValue.maxLen = 0;
5245     for (i = 0; i < len; i++) {
5246         ListAppendElement(objPtr, elements[i]);
5247     }
5248     return objPtr;
5249 }
5250
5251 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5252  * length of the vector. Note that the user of this function should make
5253  * sure that the list object can't shimmer while the vector returned
5254  * is in use, this vector is the one stored inside the internal representation
5255  * of the list object. This function is not exported, extensions should
5256  * always access to the List object elements using Jim_ListIndex(). */
5257 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5258         Jim_Obj ***listVec)
5259 {
5260     Jim_ListLength(interp, listObj, argc);
5261     assert(listObj->typePtr == &listObjType);
5262     *listVec = listObj->internalRep.listValue.ele;
5263 }
5264
5265 /* ListSortElements type values */
5266 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5267       JIM_LSORT_NOCASE_DECR};
5268
5269 /* Sort the internal rep of a list. */
5270 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5271 {
5272     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5273 }
5274
5275 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5276 {
5277     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5278 }
5279
5280 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5281 {
5282     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5283 }
5284
5285 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5286 {
5287     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5288 }
5289
5290 /* Sort a list *in place*. MUST be called with non-shared objects. */
5291 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5292 {
5293     typedef int (qsort_comparator)(const void *, const void *);
5294     int (*fn)(Jim_Obj**, Jim_Obj**);
5295     Jim_Obj **vector;
5296     int len;
5297
5298     if (Jim_IsShared(listObjPtr))
5299         Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5300     if (listObjPtr->typePtr != &listObjType)
5301         SetListFromAny(interp, listObjPtr);
5302
5303     vector = listObjPtr->internalRep.listValue.ele;
5304     len = listObjPtr->internalRep.listValue.len;
5305     switch (type) {
5306         case JIM_LSORT_ASCII: fn = ListSortString;  break;
5307         case JIM_LSORT_NOCASE: fn = ListSortStringNoCase;  break;
5308         case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr;  break;
5309         case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr;  break;
5310         default:
5311             fn = NULL; /* avoid warning */
5312             Jim_Panic(interp,"ListSort called with invalid sort type");
5313     }
5314     qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5315     Jim_InvalidateStringRep(listObjPtr);
5316 }
5317
5318 /* This is the low-level function to append an element to a list.
5319  * The higher-level Jim_ListAppendElement() performs shared object
5320  * check and invalidate the string repr. This version is used
5321  * in the internals of the List Object and is not exported.
5322  *
5323  * NOTE: this function can be called only against objects
5324  * with internal type of List. */
5325 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5326 {
5327     int requiredLen = listPtr->internalRep.listValue.len + 1;
5328
5329     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5330         int maxLen = requiredLen * 2;
5331
5332         listPtr->internalRep.listValue.ele =
5333             Jim_Realloc(listPtr->internalRep.listValue.ele,
5334                     sizeof(Jim_Obj*)*maxLen);
5335         listPtr->internalRep.listValue.maxLen = maxLen;
5336     }
5337     listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5338         objPtr;
5339     listPtr->internalRep.listValue.len ++;
5340     Jim_IncrRefCount(objPtr);
5341 }
5342
5343 /* This is the low-level function to insert elements into a list.
5344  * The higher-level Jim_ListInsertElements() performs shared object
5345  * check and invalidate the string repr. This version is used
5346  * in the internals of the List Object and is not exported.
5347  *
5348  * NOTE: this function can be called only against objects
5349  * with internal type of List. */
5350 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5351         Jim_Obj *const *elemVec)
5352 {
5353     int currentLen = listPtr->internalRep.listValue.len;
5354     int requiredLen = currentLen + elemc;
5355     int i;
5356     Jim_Obj **point;
5357
5358     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5359         int maxLen = requiredLen * 2;
5360
5361         listPtr->internalRep.listValue.ele =
5362             Jim_Realloc(listPtr->internalRep.listValue.ele,
5363                     sizeof(Jim_Obj*)*maxLen);
5364         listPtr->internalRep.listValue.maxLen = maxLen;
5365     }
5366     point = listPtr->internalRep.listValue.ele + index;
5367     memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5368     for (i=0; i < elemc; ++i) {
5369         point[i] = elemVec[i];
5370         Jim_IncrRefCount(point[i]);
5371     }
5372     listPtr->internalRep.listValue.len += elemc;
5373 }
5374
5375 /* Appends every element of appendListPtr into listPtr.
5376  * Both have to be of the list type. */
5377 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5378 {
5379     int i, oldLen = listPtr->internalRep.listValue.len;
5380     int appendLen = appendListPtr->internalRep.listValue.len;
5381     int requiredLen = oldLen + appendLen;
5382
5383     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5384         int maxLen = requiredLen * 2;
5385
5386         listPtr->internalRep.listValue.ele =
5387             Jim_Realloc(listPtr->internalRep.listValue.ele,
5388                     sizeof(Jim_Obj*)*maxLen);
5389         listPtr->internalRep.listValue.maxLen = maxLen;
5390     }
5391     for (i = 0; i < appendLen; i++) {
5392         Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5393         listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5394         Jim_IncrRefCount(objPtr);
5395     }
5396     listPtr->internalRep.listValue.len += appendLen;
5397 }
5398
5399 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5400 {
5401     if (Jim_IsShared(listPtr))
5402         Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5403     if (listPtr->typePtr != &listObjType)
5404         SetListFromAny(interp, listPtr);
5405     Jim_InvalidateStringRep(listPtr);
5406     ListAppendElement(listPtr, objPtr);
5407 }
5408
5409 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5410 {
5411     if (Jim_IsShared(listPtr))
5412         Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5413     if (listPtr->typePtr != &listObjType)
5414         SetListFromAny(interp, listPtr);
5415     Jim_InvalidateStringRep(listPtr);
5416     ListAppendList(listPtr, appendListPtr);
5417 }
5418
5419 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5420 {
5421     if (listPtr->typePtr != &listObjType)
5422         SetListFromAny(interp, listPtr);
5423     *intPtr = listPtr->internalRep.listValue.len;
5424 }
5425
5426 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5427         int objc, Jim_Obj *const *objVec)
5428 {
5429     if (Jim_IsShared(listPtr))
5430         Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5431     if (listPtr->typePtr != &listObjType)
5432         SetListFromAny(interp, listPtr);
5433     if (index >= 0 && index > listPtr->internalRep.listValue.len)
5434         index = listPtr->internalRep.listValue.len;
5435     else if (index < 0 ) 
5436         index = 0;
5437     Jim_InvalidateStringRep(listPtr);
5438     ListInsertElements(listPtr, index, objc, objVec);
5439 }
5440
5441 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5442         Jim_Obj **objPtrPtr, int flags)
5443 {
5444     if (listPtr->typePtr != &listObjType)
5445         SetListFromAny(interp, listPtr);
5446     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5447         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5448         if (flags & JIM_ERRMSG) {
5449             Jim_SetResultString(interp,
5450                 "list index out of range", -1);
5451         }
5452         return JIM_ERR;
5453     }
5454     if (index < 0)
5455         index = listPtr->internalRep.listValue.len+index;
5456     *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5457     return JIM_OK;
5458 }
5459
5460 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5461         Jim_Obj *newObjPtr, int flags)
5462 {
5463     if (listPtr->typePtr != &listObjType)
5464         SetListFromAny(interp, listPtr);
5465     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5466         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5467         if (flags & JIM_ERRMSG) {
5468             Jim_SetResultString(interp,
5469                 "list index out of range", -1);
5470         }
5471         return JIM_ERR;
5472     }
5473     if (index < 0)
5474         index = listPtr->internalRep.listValue.len+index;
5475     Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5476     listPtr->internalRep.listValue.ele[index] = newObjPtr;
5477     Jim_IncrRefCount(newObjPtr);
5478     return JIM_OK;
5479 }
5480
5481 /* Modify the list stored into the variable named 'varNamePtr'
5482  * setting the element specified by the 'indexc' indexes objects in 'indexv',
5483  * with the new element 'newObjptr'. */
5484 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5485         Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5486 {
5487     Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5488     int shared, i, index;
5489
5490     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5491     if (objPtr == NULL)
5492         return JIM_ERR;
5493     if ((shared = Jim_IsShared(objPtr)))
5494         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5495     for (i = 0; i < indexc-1; i++) {
5496         listObjPtr = objPtr;
5497         if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5498             goto err;
5499         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5500                     JIM_ERRMSG) != JIM_OK) {
5501             goto err;
5502         }
5503         if (Jim_IsShared(objPtr)) {
5504             objPtr = Jim_DuplicateObj(interp, objPtr);
5505             ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5506         }
5507         Jim_InvalidateStringRep(listObjPtr);
5508     }
5509     if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5510         goto err;
5511     if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5512         goto err;
5513     Jim_InvalidateStringRep(objPtr);
5514     Jim_InvalidateStringRep(varObjPtr);
5515     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5516         goto err;
5517     Jim_SetResult(interp, varObjPtr);
5518     return JIM_OK;
5519 err:
5520     if (shared) {
5521         Jim_FreeNewObj(interp, varObjPtr);
5522     }
5523     return JIM_ERR;
5524 }
5525
5526 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5527 {
5528     int i;
5529
5530     /* If all the objects in objv are lists without string rep.
5531      * it's possible to return a list as result, that's the
5532      * concatenation of all the lists. */
5533     for (i = 0; i < objc; i++) {
5534         if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5535             break;
5536     }
5537     if (i == objc) {
5538         Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5539         for (i = 0; i < objc; i++)
5540             Jim_ListAppendList(interp, objPtr, objv[i]);
5541         return objPtr;
5542     } else {
5543         /* Else... we have to glue strings together */
5544         int len = 0, objLen;
5545         char *bytes, *p;
5546
5547         /* Compute the length */
5548         for (i = 0; i < objc; i++) {
5549             Jim_GetString(objv[i], &objLen);
5550             len += objLen;
5551         }
5552         if (objc) len += objc-1;
5553         /* Create the string rep, and a stinrg object holding it. */
5554         p = bytes = Jim_Alloc(len+1);
5555         for (i = 0; i < objc; i++) {
5556             const char *s = Jim_GetString(objv[i], &objLen);
5557             while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5558             {
5559                 s++; objLen--; len--;
5560             }
5561             while (objLen && (s[objLen-1] == ' ' ||
5562                 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5563                 objLen--; len--;
5564             }
5565             memcpy(p, s, objLen);
5566             p += objLen;
5567             if (objLen && i+1 != objc) {
5568                 *p++ = ' ';
5569             } else if (i+1 != objc) {
5570                 /* Drop the space calcuated for this
5571                  * element that is instead null. */
5572                 len--;
5573             }
5574         }
5575         *p = '\0';
5576         return Jim_NewStringObjNoAlloc(interp, bytes, len);
5577     }
5578 }
5579
5580 /* Returns a list composed of the elements in the specified range.
5581  * first and start are directly accepted as Jim_Objects and
5582  * processed for the end?-index? case. */
5583 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5584 {
5585     int first, last;
5586     int len, rangeLen;
5587
5588     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5589         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5590         return NULL;
5591     Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5592     first = JimRelToAbsIndex(len, first);
5593     last = JimRelToAbsIndex(len, last);
5594     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5595     return Jim_NewListObj(interp,
5596             listObjPtr->internalRep.listValue.ele+first, rangeLen);
5597 }
5598
5599 /* -----------------------------------------------------------------------------
5600  * Dict object
5601  * ---------------------------------------------------------------------------*/
5602 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5603 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5604 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5605 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5606
5607 /* Dict HashTable Type.
5608  *
5609  * Keys and Values are Jim objects. */
5610
5611 unsigned int JimObjectHTHashFunction(const void *key)
5612 {
5613     const char *str;
5614     Jim_Obj *objPtr = (Jim_Obj*) key;
5615     int len, h;
5616
5617     str = Jim_GetString(objPtr, &len);
5618     h = Jim_GenHashFunction((unsigned char*)str, len);
5619     return h;
5620 }
5621
5622 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5623 {
5624     JIM_NOTUSED(privdata);
5625
5626     return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5627 }
5628
5629 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5630 {
5631     Jim_Obj *objPtr = val;
5632
5633     Jim_DecrRefCount(interp, objPtr);
5634 }
5635
5636 static Jim_HashTableType JimDictHashTableType = {
5637     JimObjectHTHashFunction,            /* hash function */
5638     NULL,                               /* key dup */
5639     NULL,                               /* val dup */
5640     JimObjectHTKeyCompare,              /* key compare */
5641     (void(*)(void*, const void*))       /* ATTENTION: const cast */
5642         JimObjectHTKeyValDestructor,    /* key destructor */
5643     JimObjectHTKeyValDestructor         /* val destructor */
5644 };
5645
5646 /* Note that while the elements of the dict may contain references,
5647  * the list object itself can't. This basically means that the
5648  * dict object string representation as a whole can't contain references
5649  * that are not presents in the single elements. */
5650 static Jim_ObjType dictObjType = {
5651     "dict",
5652     FreeDictInternalRep,
5653     DupDictInternalRep,
5654     UpdateStringOfDict,
5655     JIM_TYPE_NONE,
5656 };
5657
5658 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5659 {
5660     JIM_NOTUSED(interp);
5661
5662     Jim_FreeHashTable(objPtr->internalRep.ptr);
5663     Jim_Free(objPtr->internalRep.ptr);
5664 }
5665
5666 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5667 {
5668     Jim_HashTable *ht, *dupHt;
5669     Jim_HashTableIterator *htiter;
5670     Jim_HashEntry *he;
5671
5672     /* Create a new hash table */
5673     ht = srcPtr->internalRep.ptr;
5674     dupHt = Jim_Alloc(sizeof(*dupHt));
5675     Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5676     if (ht->size != 0)
5677         Jim_ExpandHashTable(dupHt, ht->size);
5678     /* Copy every element from the source to the dup hash table */
5679     htiter = Jim_GetHashTableIterator(ht);
5680     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5681         const Jim_Obj *keyObjPtr = he->key;
5682         Jim_Obj *valObjPtr = he->val;
5683
5684         Jim_IncrRefCount((Jim_Obj*)keyObjPtr);  /* ATTENTION: const cast */
5685         Jim_IncrRefCount(valObjPtr);
5686         Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5687     }
5688     Jim_FreeHashTableIterator(htiter);
5689
5690     dupPtr->internalRep.ptr = dupHt;
5691     dupPtr->typePtr = &dictObjType;
5692 }
5693
5694 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5695 {
5696     int i, bufLen, realLength;
5697     const char *strRep;
5698     char *p;
5699     int *quotingType, objc;
5700     Jim_HashTable *ht;
5701     Jim_HashTableIterator *htiter;
5702     Jim_HashEntry *he;
5703     Jim_Obj **objv;
5704
5705     /* Trun the hash table into a flat vector of Jim_Objects. */
5706     ht = objPtr->internalRep.ptr;
5707     objc = ht->used*2;
5708     objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5709     htiter = Jim_GetHashTableIterator(ht);
5710     i = 0;
5711     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5712         objv[i++] = (Jim_Obj*)he->key;  /* ATTENTION: const cast */
5713         objv[i++] = he->val;
5714     }
5715     Jim_FreeHashTableIterator(htiter);
5716     /* (Over) Estimate the space needed. */
5717     quotingType = Jim_Alloc(sizeof(int)*objc);
5718     bufLen = 0;
5719     for (i = 0; i < objc; i++) {
5720         int len;
5721
5722         strRep = Jim_GetString(objv[i], &len);
5723         quotingType[i] = ListElementQuotingType(strRep, len);
5724         switch (quotingType[i]) {
5725         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5726         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5727         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5728         }
5729         bufLen++; /* elements separator. */
5730     }
5731     bufLen++;
5732
5733     /* Generate the string rep. */
5734     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5735     realLength = 0;
5736     for (i = 0; i < objc; i++) {
5737         int len, qlen;
5738         const char *strRep = Jim_GetString(objv[i], &len);
5739         char *q;
5740
5741         switch(quotingType[i]) {
5742         case JIM_ELESTR_SIMPLE:
5743             memcpy(p, strRep, len);
5744             p += len;
5745             realLength += len;
5746             break;
5747         case JIM_ELESTR_BRACE:
5748             *p++ = '{';
5749             memcpy(p, strRep, len);
5750             p += len;
5751             *p++ = '}';
5752             realLength += len+2;
5753             break;
5754         case JIM_ELESTR_QUOTE:
5755             q = BackslashQuoteString(strRep, len, &qlen);
5756             memcpy(p, q, qlen);
5757             Jim_Free(q);
5758             p += qlen;
5759             realLength += qlen;
5760             break;
5761         }
5762         /* Add a separating space */
5763         if (i+1 != objc) {
5764             *p++ = ' ';
5765             realLength ++;
5766         }
5767     }
5768     *p = '\0'; /* nul term. */
5769     objPtr->length = realLength;
5770     Jim_Free(quotingType);
5771     Jim_Free(objv);
5772 }
5773
5774 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5775 {
5776     struct JimParserCtx parser;
5777     Jim_HashTable *ht;
5778     Jim_Obj *objv[2];
5779     const char *str;
5780     int i, strLen;
5781
5782     /* Get the string representation */
5783     str = Jim_GetString(objPtr, &strLen);
5784
5785     /* Free the old internal repr just now and initialize the
5786      * new one just now. The string->list conversion can't fail. */
5787     Jim_FreeIntRep(interp, objPtr);
5788     ht = Jim_Alloc(sizeof(*ht));
5789     Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5790     objPtr->typePtr = &dictObjType;
5791     objPtr->internalRep.ptr = ht;
5792
5793     /* Convert into a dict */
5794     JimParserInit(&parser, str, strLen, 1);
5795     i = 0;
5796     while(!JimParserEof(&parser)) {
5797         char *token;
5798         int tokenLen, type;
5799
5800         JimParseList(&parser);
5801         if (JimParserTtype(&parser) != JIM_TT_STR &&
5802             JimParserTtype(&parser) != JIM_TT_ESC)
5803             continue;
5804         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5805         objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5806         if (i == 2) {
5807             i = 0;
5808             Jim_IncrRefCount(objv[0]);
5809             Jim_IncrRefCount(objv[1]);
5810             if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5811                 Jim_HashEntry *he;
5812                 he = Jim_FindHashEntry(ht, objv[0]);
5813                 Jim_DecrRefCount(interp, objv[0]);
5814                 /* ATTENTION: const cast */
5815                 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5816                 he->val = objv[1];
5817             }
5818         }
5819     }
5820     if (i) {
5821         Jim_FreeNewObj(interp, objv[0]);
5822         objPtr->typePtr = NULL;
5823         Jim_FreeHashTable(ht);
5824         Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5825         return JIM_ERR;
5826     }
5827     return JIM_OK;
5828 }
5829
5830 /* Dict object API */
5831
5832 /* Add an element to a dict. objPtr must be of the "dict" type.
5833  * The higer-level exported function is Jim_DictAddElement().
5834  * If an element with the specified key already exists, the value
5835  * associated is replaced with the new one.
5836  *
5837  * if valueObjPtr == NULL, the key is instead removed if it exists. */
5838 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5839         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5840 {
5841     Jim_HashTable *ht = objPtr->internalRep.ptr;
5842
5843     if (valueObjPtr == NULL) { /* unset */
5844         Jim_DeleteHashEntry(ht, keyObjPtr);
5845         return;
5846     }
5847     Jim_IncrRefCount(keyObjPtr);
5848     Jim_IncrRefCount(valueObjPtr);
5849     if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5850         Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5851         Jim_DecrRefCount(interp, keyObjPtr);
5852         /* ATTENTION: const cast */
5853         Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5854         he->val = valueObjPtr;
5855     }
5856 }
5857
5858 /* Add an element, higher-level interface for DictAddElement().
5859  * If valueObjPtr == NULL, the key is removed if it exists. */
5860 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5861         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5862 {
5863     if (Jim_IsShared(objPtr))
5864         Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5865     if (objPtr->typePtr != &dictObjType) {
5866         if (SetDictFromAny(interp, objPtr) != JIM_OK)
5867             return JIM_ERR;
5868     }
5869     DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5870     Jim_InvalidateStringRep(objPtr);
5871     return JIM_OK;
5872 }
5873
5874 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5875 {
5876     Jim_Obj *objPtr;
5877     int i;
5878
5879     if (len % 2)
5880         Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5881
5882     objPtr = Jim_NewObj(interp);
5883     objPtr->typePtr = &dictObjType;
5884     objPtr->bytes = NULL;
5885     objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5886     Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5887     for (i = 0; i < len; i += 2)
5888         DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5889     return objPtr;
5890 }
5891
5892 /* Return the value associated to the specified dict key */
5893 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5894         Jim_Obj **objPtrPtr, int flags)
5895 {
5896     Jim_HashEntry *he;
5897     Jim_HashTable *ht;
5898
5899     if (dictPtr->typePtr != &dictObjType) {
5900         if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5901             return JIM_ERR;
5902     }
5903     ht = dictPtr->internalRep.ptr;
5904     if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5905         if (flags & JIM_ERRMSG) {
5906             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5907             Jim_AppendStrings(interp, Jim_GetResult(interp),
5908                     "key \"", Jim_GetString(keyPtr, NULL),
5909                     "\" not found in dictionary", NULL);
5910         }
5911         return JIM_ERR;
5912     }
5913     *objPtrPtr = he->val;
5914     return JIM_OK;
5915 }
5916
5917 /* Return the value associated to the specified dict keys */
5918 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5919         Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5920 {
5921     Jim_Obj *objPtr;
5922     int i;
5923
5924     if (keyc == 0) {
5925         *objPtrPtr = dictPtr;
5926         return JIM_OK;
5927     }
5928
5929     for (i = 0; i < keyc; i++) {
5930         if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5931                 != JIM_OK)
5932             return JIM_ERR;
5933         dictPtr = objPtr;
5934     }
5935     *objPtrPtr = objPtr;
5936     return JIM_OK;
5937 }
5938
5939 /* Modify the dict stored into the variable named 'varNamePtr'
5940  * setting the element specified by the 'keyc' keys objects in 'keyv',
5941  * with the new value of the element 'newObjPtr'.
5942  *
5943  * If newObjPtr == NULL the operation is to remove the given key
5944  * from the dictionary. */
5945 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5946         Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5947 {
5948     Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5949     int shared, i;
5950
5951     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5952     if (objPtr == NULL) {
5953         if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5954             return JIM_ERR;
5955         varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5956         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5957             Jim_FreeNewObj(interp, varObjPtr);
5958             return JIM_ERR;
5959         }
5960     }
5961     if ((shared = Jim_IsShared(objPtr)))
5962         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5963     for (i = 0; i < keyc-1; i++) {
5964         dictObjPtr = objPtr;
5965
5966         /* Check if it's a valid dictionary */
5967         if (dictObjPtr->typePtr != &dictObjType) {
5968             if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5969                 goto err;
5970         }
5971         /* Check if the given key exists. */
5972         Jim_InvalidateStringRep(dictObjPtr);
5973         if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5974             newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5975         {
5976             /* This key exists at the current level.
5977              * Make sure it's not shared!. */
5978             if (Jim_IsShared(objPtr)) {
5979                 objPtr = Jim_DuplicateObj(interp, objPtr);
5980                 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5981             }
5982         } else {
5983             /* Key not found. If it's an [unset] operation
5984              * this is an error. Only the last key may not
5985              * exist. */
5986             if (newObjPtr == NULL)
5987                 goto err;
5988             /* Otherwise set an empty dictionary
5989              * as key's value. */
5990             objPtr = Jim_NewDictObj(interp, NULL, 0);
5991             DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5992         }
5993     }
5994     if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5995             != JIM_OK)
5996         goto err;
5997     Jim_InvalidateStringRep(objPtr);
5998     Jim_InvalidateStringRep(varObjPtr);
5999     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6000         goto err;
6001     Jim_SetResult(interp, varObjPtr);
6002     return JIM_OK;
6003 err:
6004     if (shared) {
6005         Jim_FreeNewObj(interp, varObjPtr);
6006     }
6007     return JIM_ERR;
6008 }
6009
6010 /* -----------------------------------------------------------------------------
6011  * Index object
6012  * ---------------------------------------------------------------------------*/
6013 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6014 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6015
6016 static Jim_ObjType indexObjType = {
6017     "index",
6018     NULL,
6019     NULL,
6020     UpdateStringOfIndex,
6021     JIM_TYPE_NONE,
6022 };
6023
6024 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6025 {
6026     int len;
6027     char buf[JIM_INTEGER_SPACE+1];
6028
6029     if (objPtr->internalRep.indexValue >= 0)
6030         len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6031     else if (objPtr->internalRep.indexValue == -1)
6032         len = sprintf(buf, "end");
6033     else {
6034         len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6035     }
6036     objPtr->bytes = Jim_Alloc(len+1);
6037     memcpy(objPtr->bytes, buf, len+1);
6038     objPtr->length = len;
6039 }
6040
6041 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6042 {
6043     int index, end = 0;
6044     const char *str;
6045
6046     /* Get the string representation */
6047     str = Jim_GetString(objPtr, NULL);
6048     /* Try to convert into an index */
6049     if (!strcmp(str, "end")) {
6050         index = 0;
6051         end = 1;
6052     } else {
6053         if (!strncmp(str, "end-", 4)) {
6054             str += 4;
6055             end = 1;
6056         }
6057         if (Jim_StringToIndex(str, &index) != JIM_OK) {
6058             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6059             Jim_AppendStrings(interp, Jim_GetResult(interp),
6060                     "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6061                     "must be integer or end?-integer?", NULL);
6062             return JIM_ERR;
6063         }
6064     }
6065     if (end) {
6066         if (index < 0)
6067             index = INT_MAX;
6068         else
6069             index = -(index+1);
6070     } else if (!end && index < 0)
6071         index = -INT_MAX;
6072     /* Free the old internal repr and set the new one. */
6073     Jim_FreeIntRep(interp, objPtr);
6074     objPtr->typePtr = &indexObjType;
6075     objPtr->internalRep.indexValue = index;
6076     return JIM_OK;
6077 }
6078
6079 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6080 {
6081     /* Avoid shimmering if the object is an integer. */
6082     if (objPtr->typePtr == &intObjType) {
6083         jim_wide val = objPtr->internalRep.wideValue;
6084         if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6085             *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6086             return JIM_OK;
6087         }
6088     }
6089     if (objPtr->typePtr != &indexObjType &&
6090         SetIndexFromAny(interp, objPtr) == JIM_ERR)
6091         return JIM_ERR;
6092     *indexPtr = objPtr->internalRep.indexValue;
6093     return JIM_OK;
6094 }
6095
6096 /* -----------------------------------------------------------------------------
6097  * Return Code Object.
6098  * ---------------------------------------------------------------------------*/
6099
6100 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6101
6102 static Jim_ObjType returnCodeObjType = {
6103     "return-code",
6104     NULL,
6105     NULL,
6106     NULL,
6107     JIM_TYPE_NONE,
6108 };
6109
6110 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6111 {
6112     const char *str;
6113     int strLen, returnCode;
6114     jim_wide wideValue;
6115
6116     /* Get the string representation */
6117     str = Jim_GetString(objPtr, &strLen);
6118     /* Try to convert into an integer */
6119     if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6120         returnCode = (int) wideValue;
6121     else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6122         returnCode = JIM_OK;
6123     else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6124         returnCode = JIM_ERR;
6125     else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6126         returnCode = JIM_RETURN;
6127     else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6128         returnCode = JIM_BREAK;
6129     else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6130         returnCode = JIM_CONTINUE;
6131     else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6132         returnCode = JIM_EVAL;
6133     else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6134         returnCode = JIM_EXIT;
6135     else {
6136         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6137         Jim_AppendStrings(interp, Jim_GetResult(interp),
6138                 "expected return code but got '", str, "'",
6139                 NULL);
6140         return JIM_ERR;
6141     }
6142     /* Free the old internal repr and set the new one. */
6143     Jim_FreeIntRep(interp, objPtr);
6144     objPtr->typePtr = &returnCodeObjType;
6145     objPtr->internalRep.returnCode = returnCode;
6146     return JIM_OK;
6147 }
6148
6149 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6150 {
6151     if (objPtr->typePtr != &returnCodeObjType &&
6152         SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6153         return JIM_ERR;
6154     *intPtr = objPtr->internalRep.returnCode;
6155     return JIM_OK;
6156 }
6157
6158 /* -----------------------------------------------------------------------------
6159  * Expression Parsing
6160  * ---------------------------------------------------------------------------*/
6161 static int JimParseExprOperator(struct JimParserCtx *pc);
6162 static int JimParseExprNumber(struct JimParserCtx *pc);
6163 static int JimParseExprIrrational(struct JimParserCtx *pc);
6164
6165 /* Exrp's Stack machine operators opcodes. */
6166
6167 /* Binary operators (numbers) */
6168 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6169 #define JIM_EXPROP_MUL 0
6170 #define JIM_EXPROP_DIV 1
6171 #define JIM_EXPROP_MOD 2
6172 #define JIM_EXPROP_SUB 3
6173 #define JIM_EXPROP_ADD 4
6174 #define JIM_EXPROP_LSHIFT 5
6175 #define JIM_EXPROP_RSHIFT 6
6176 #define JIM_EXPROP_ROTL 7
6177 #define JIM_EXPROP_ROTR 8
6178 #define JIM_EXPROP_LT 9
6179 #define JIM_EXPROP_GT 10
6180 #define JIM_EXPROP_LTE 11
6181 #define JIM_EXPROP_GTE 12
6182 #define JIM_EXPROP_NUMEQ 13
6183 #define JIM_EXPROP_NUMNE 14
6184 #define JIM_EXPROP_BITAND 15
6185 #define JIM_EXPROP_BITXOR 16
6186 #define JIM_EXPROP_BITOR 17
6187 #define JIM_EXPROP_LOGICAND 18
6188 #define JIM_EXPROP_LOGICOR 19
6189 #define JIM_EXPROP_LOGICAND_LEFT 20
6190 #define JIM_EXPROP_LOGICOR_LEFT 21
6191 #define JIM_EXPROP_POW 22
6192 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6193
6194 /* Binary operators (strings) */
6195 #define JIM_EXPROP_STREQ 23
6196 #define JIM_EXPROP_STRNE 24
6197
6198 /* Unary operators (numbers) */
6199 #define JIM_EXPROP_NOT 25
6200 #define JIM_EXPROP_BITNOT 26
6201 #define JIM_EXPROP_UNARYMINUS 27
6202 #define JIM_EXPROP_UNARYPLUS 28
6203 #define JIM_EXPROP_LOGICAND_RIGHT 29
6204 #define JIM_EXPROP_LOGICOR_RIGHT 30
6205
6206 /* Ternary operators */
6207 #define JIM_EXPROP_TERNARY 31
6208
6209 /* Operands */
6210 #define JIM_EXPROP_NUMBER 32
6211 #define JIM_EXPROP_COMMAND 33
6212 #define JIM_EXPROP_VARIABLE 34
6213 #define JIM_EXPROP_DICTSUGAR 35
6214 #define JIM_EXPROP_SUBST 36
6215 #define JIM_EXPROP_STRING 37
6216
6217 /* Operators table */
6218 typedef struct Jim_ExprOperator {
6219     const char *name;
6220     int precedence;
6221     int arity;
6222     int opcode;
6223 } Jim_ExprOperator;
6224
6225 /* name - precedence - arity - opcode */
6226 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6227     {"!", 300, 1, JIM_EXPROP_NOT},
6228     {"~", 300, 1, JIM_EXPROP_BITNOT},
6229     {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6230     {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6231
6232     {"**", 250, 2, JIM_EXPROP_POW},
6233
6234     {"*", 200, 2, JIM_EXPROP_MUL},
6235     {"/", 200, 2, JIM_EXPROP_DIV},
6236     {"%", 200, 2, JIM_EXPROP_MOD},
6237
6238     {"-", 100, 2, JIM_EXPROP_SUB},
6239     {"+", 100, 2, JIM_EXPROP_ADD},
6240
6241     {"<<<", 90, 3, JIM_EXPROP_ROTL},
6242     {">>>", 90, 3, JIM_EXPROP_ROTR},
6243     {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6244     {">>", 90, 2, JIM_EXPROP_RSHIFT},
6245
6246     {"<",  80, 2, JIM_EXPROP_LT},
6247     {">",  80, 2, JIM_EXPROP_GT},
6248     {"<=", 80, 2, JIM_EXPROP_LTE},
6249     {">=", 80, 2, JIM_EXPROP_GTE},
6250
6251     {"==", 70, 2, JIM_EXPROP_NUMEQ},
6252     {"!=", 70, 2, JIM_EXPROP_NUMNE},
6253
6254     {"eq", 60, 2, JIM_EXPROP_STREQ},
6255     {"ne", 60, 2, JIM_EXPROP_STRNE},
6256
6257     {"&", 50, 2, JIM_EXPROP_BITAND},
6258     {"^", 49, 2, JIM_EXPROP_BITXOR},
6259     {"|", 48, 2, JIM_EXPROP_BITOR},
6260
6261     {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6262     {"||", 10, 2, JIM_EXPROP_LOGICOR},
6263
6264     {"?", 5, 3, JIM_EXPROP_TERNARY},
6265     /* private operators */
6266     {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6267     {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6268     {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6269     {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6270 };
6271
6272 #define JIM_EXPR_OPERATORS_NUM \
6273     (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6274
6275 int JimParseExpression(struct JimParserCtx *pc)
6276 {
6277     /* Discard spaces and quoted newline */
6278     while(*(pc->p) == ' ' ||
6279           *(pc->p) == '\t' ||
6280           *(pc->p) == '\r' ||
6281           *(pc->p) == '\n' ||
6282             (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6283         pc->p++; pc->len--;
6284     }
6285
6286     if (pc->len == 0) {
6287         pc->tstart = pc->tend = pc->p;
6288         pc->tline = pc->linenr;
6289         pc->tt = JIM_TT_EOL;
6290         pc->eof = 1;
6291         return JIM_OK;
6292     }
6293     switch(*(pc->p)) {
6294     case '(':
6295         pc->tstart = pc->tend = pc->p;
6296         pc->tline = pc->linenr;
6297         pc->tt = JIM_TT_SUBEXPR_START;
6298         pc->p++; pc->len--;
6299         break;
6300     case ')':
6301         pc->tstart = pc->tend = pc->p;
6302         pc->tline = pc->linenr;
6303         pc->tt = JIM_TT_SUBEXPR_END;
6304         pc->p++; pc->len--;
6305         break;
6306     case '[':
6307         return JimParseCmd(pc);
6308         break;
6309     case '$':
6310         if (JimParseVar(pc) == JIM_ERR)
6311             return JimParseExprOperator(pc);
6312         else
6313             return JIM_OK;
6314         break;
6315     case '-':
6316         if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6317             isdigit((int)*(pc->p+1)))
6318             return JimParseExprNumber(pc);
6319         else
6320             return JimParseExprOperator(pc);
6321         break;
6322     case '0': case '1': case '2': case '3': case '4':
6323     case '5': case '6': case '7': case '8': case '9': case '.':
6324         return JimParseExprNumber(pc);
6325         break;
6326     case '"':
6327     case '{':
6328         /* Here it's possible to reuse the List String parsing. */
6329         pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6330         return JimParseListStr(pc);
6331         break;
6332     case 'N': case 'I':
6333     case 'n': case 'i':
6334         if (JimParseExprIrrational(pc) == JIM_ERR)
6335             return JimParseExprOperator(pc);
6336         break;
6337     default:
6338         return JimParseExprOperator(pc);
6339         break;
6340     }
6341     return JIM_OK;
6342 }
6343
6344 int JimParseExprNumber(struct JimParserCtx *pc)
6345 {
6346     int allowdot = 1;
6347     int allowhex = 0;
6348
6349     pc->tstart = pc->p;
6350     pc->tline = pc->linenr;
6351     if (*pc->p == '-') {
6352         pc->p++; pc->len--;
6353     }
6354     while (  isdigit((int)*pc->p) 
6355           || (allowhex && isxdigit((int)*pc->p) )
6356           || (allowdot && *pc->p == '.') 
6357           || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6358               (*pc->p == 'x' || *pc->p == 'X'))
6359           )
6360     {
6361         if ((*pc->p == 'x') || (*pc->p == 'X')) {
6362             allowhex = 1;
6363             allowdot = 0;
6364                 }
6365         if (*pc->p == '.')
6366             allowdot = 0;
6367         pc->p++; pc->len--;
6368         if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6369             pc->p += 2; pc->len -= 2;
6370         }
6371     }
6372     pc->tend = pc->p-1;
6373     pc->tt = JIM_TT_EXPR_NUMBER;
6374     return JIM_OK;
6375 }
6376
6377 int JimParseExprIrrational(struct JimParserCtx *pc)
6378 {
6379     const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6380     const char **token;
6381     for (token = Tokens; *token != NULL; token++) {
6382         int len = strlen(*token);
6383         if (strncmp(*token, pc->p, len) == 0) {
6384             pc->tstart = pc->p;
6385             pc->tend = pc->p + len - 1;
6386             pc->p += len; pc->len -= len;
6387             pc->tline = pc->linenr;
6388             pc->tt = JIM_TT_EXPR_NUMBER;
6389             return JIM_OK;
6390         }
6391     }
6392     return JIM_ERR;
6393 }
6394
6395 int JimParseExprOperator(struct JimParserCtx *pc)
6396 {
6397     int i;
6398     int bestIdx = -1, bestLen = 0;
6399
6400     /* Try to get the longest match. */
6401     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6402         const char *opname;
6403         int oplen;
6404
6405         opname = Jim_ExprOperators[i].name;
6406         if (opname == NULL) continue;
6407         oplen = strlen(opname);
6408
6409         if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6410             bestIdx = i;
6411             bestLen = oplen;
6412         }
6413     }
6414     if (bestIdx == -1) return JIM_ERR;
6415     pc->tstart = pc->p;
6416     pc->tend = pc->p + bestLen - 1;
6417     pc->p += bestLen; pc->len -= bestLen;
6418     pc->tline = pc->linenr;
6419     pc->tt = JIM_TT_EXPR_OPERATOR;
6420     return JIM_OK;
6421 }
6422
6423 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6424 {
6425     int i;
6426     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6427         if (Jim_ExprOperators[i].name &&
6428             strcmp(opname, Jim_ExprOperators[i].name) == 0)
6429             return &Jim_ExprOperators[i];
6430     return NULL;
6431 }
6432
6433 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6434 {
6435     int i;
6436     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6437         if (Jim_ExprOperators[i].opcode == opcode)
6438             return &Jim_ExprOperators[i];
6439     return NULL;
6440 }
6441
6442 /* -----------------------------------------------------------------------------
6443  * Expression Object
6444  * ---------------------------------------------------------------------------*/
6445 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6446 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6447 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6448
6449 static Jim_ObjType exprObjType = {
6450     "expression",
6451     FreeExprInternalRep,
6452     DupExprInternalRep,
6453     NULL,
6454     JIM_TYPE_REFERENCES,
6455 };
6456
6457 /* Expr bytecode structure */
6458 typedef struct ExprByteCode {
6459     int *opcode;        /* Integer array of opcodes. */
6460     Jim_Obj **obj;      /* Array of associated Jim Objects. */
6461     int len;            /* Bytecode length */
6462     int inUse;          /* Used for sharing. */
6463 } ExprByteCode;
6464
6465 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6466 {
6467     int i;
6468     ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6469
6470     expr->inUse--;
6471     if (expr->inUse != 0) return;
6472     for (i = 0; i < expr->len; i++)
6473         Jim_DecrRefCount(interp, expr->obj[i]);
6474     Jim_Free(expr->opcode);
6475     Jim_Free(expr->obj);
6476     Jim_Free(expr);
6477 }
6478
6479 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6480 {
6481     JIM_NOTUSED(interp);
6482     JIM_NOTUSED(srcPtr);
6483
6484     /* Just returns an simple string. */
6485     dupPtr->typePtr = NULL;
6486 }
6487
6488 /* Add a new instruction to an expression bytecode structure. */
6489 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6490         int opcode, char *str, int len)
6491 {
6492     expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6493     expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6494     expr->opcode[expr->len] = opcode;
6495     expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6496     Jim_IncrRefCount(expr->obj[expr->len]);
6497     expr->len++;
6498 }
6499
6500 /* Check if an expr program looks correct. */
6501 static int ExprCheckCorrectness(ExprByteCode *expr)
6502 {
6503     int i;
6504     int stacklen = 0;
6505
6506     /* Try to check if there are stack underflows,
6507      * and make sure at the end of the program there is
6508      * a single result on the stack. */
6509     for (i = 0; i < expr->len; i++) {
6510         switch(expr->opcode[i]) {
6511         case JIM_EXPROP_NUMBER:
6512         case JIM_EXPROP_STRING:
6513         case JIM_EXPROP_SUBST:
6514         case JIM_EXPROP_VARIABLE:
6515         case JIM_EXPROP_DICTSUGAR:
6516         case JIM_EXPROP_COMMAND:
6517             stacklen++;
6518             break;
6519         case JIM_EXPROP_NOT:
6520         case JIM_EXPROP_BITNOT:
6521         case JIM_EXPROP_UNARYMINUS:
6522         case JIM_EXPROP_UNARYPLUS:
6523             /* Unary operations */
6524             if (stacklen < 1) return JIM_ERR;
6525             break;
6526         case JIM_EXPROP_ADD:
6527         case JIM_EXPROP_SUB:
6528         case JIM_EXPROP_MUL:
6529         case JIM_EXPROP_DIV:
6530         case JIM_EXPROP_MOD:
6531         case JIM_EXPROP_LT:
6532         case JIM_EXPROP_GT:
6533         case JIM_EXPROP_LTE:
6534         case JIM_EXPROP_GTE:
6535         case JIM_EXPROP_ROTL:
6536         case JIM_EXPROP_ROTR:
6537         case JIM_EXPROP_LSHIFT:
6538         case JIM_EXPROP_RSHIFT:
6539         case JIM_EXPROP_NUMEQ:
6540         case JIM_EXPROP_NUMNE:
6541         case JIM_EXPROP_STREQ:
6542         case JIM_EXPROP_STRNE:
6543         case JIM_EXPROP_BITAND:
6544         case JIM_EXPROP_BITXOR:
6545         case JIM_EXPROP_BITOR:
6546         case JIM_EXPROP_LOGICAND:
6547         case JIM_EXPROP_LOGICOR:
6548         case JIM_EXPROP_POW:
6549             /* binary operations */
6550             if (stacklen < 2) return JIM_ERR;
6551             stacklen--;
6552             break;
6553         default:
6554             Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6555             break;
6556         }
6557     }
6558     if (stacklen != 1) return JIM_ERR;
6559     return JIM_OK;
6560 }
6561
6562 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6563         ScriptObj *topLevelScript)
6564 {
6565     int i;
6566
6567     return;
6568     for (i = 0; i < expr->len; i++) {
6569         Jim_Obj *foundObjPtr;
6570
6571         if (expr->obj[i] == NULL) continue;
6572         foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6573                 NULL, expr->obj[i]);
6574         if (foundObjPtr != NULL) {
6575             Jim_IncrRefCount(foundObjPtr);
6576             Jim_DecrRefCount(interp, expr->obj[i]);
6577             expr->obj[i] = foundObjPtr;
6578         }
6579     }
6580 }
6581
6582 /* This procedure converts every occurrence of || and && opereators
6583  * in lazy unary versions.
6584  *
6585  * a b || is converted into:
6586  *
6587  * a <offset> |L b |R
6588  *
6589  * a b && is converted into:
6590  *
6591  * a <offset> &L b &R
6592  *
6593  * "|L" checks if 'a' is true:
6594  *   1) if it is true pushes 1 and skips <offset> istructions to reach
6595  *      the opcode just after |R.
6596  *   2) if it is false does nothing.
6597  * "|R" checks if 'b' is true:
6598  *   1) if it is true pushes 1, otherwise pushes 0.
6599  *
6600  * "&L" checks if 'a' is true:
6601  *   1) if it is true does nothing.
6602  *   2) If it is false pushes 0 and skips <offset> istructions to reach
6603  *      the opcode just after &R
6604  * "&R" checks if 'a' is true:
6605  *      if it is true pushes 1, otherwise pushes 0.
6606  */
6607 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6608 {
6609     while (1) {
6610         int index = -1, leftindex, arity, i, offset;
6611         Jim_ExprOperator *op;
6612
6613         /* Search for || or && */
6614         for (i = 0; i < expr->len; i++) {
6615             if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6616                 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6617                 index = i;
6618                 break;
6619             }
6620         }
6621         if (index == -1) return;
6622         /* Search for the end of the first operator */
6623         leftindex = index-1;
6624         arity = 1;
6625         while(arity) {
6626             switch(expr->opcode[leftindex]) {
6627             case JIM_EXPROP_NUMBER:
6628             case JIM_EXPROP_COMMAND:
6629             case JIM_EXPROP_VARIABLE:
6630             case JIM_EXPROP_DICTSUGAR:
6631             case JIM_EXPROP_SUBST:
6632             case JIM_EXPROP_STRING:
6633                 break;
6634             default:
6635                 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6636                 if (op == NULL) {
6637                     Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6638                 }
6639                 arity += op->arity;
6640                 break;
6641             }
6642             arity--;
6643             leftindex--;
6644         }
6645         leftindex++;
6646         expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6647         expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6648         memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6649                 sizeof(int)*(expr->len-leftindex));
6650         memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6651                 sizeof(Jim_Obj*)*(expr->len-leftindex));
6652         expr->len += 2;
6653         index += 2;
6654         offset = (index-leftindex)-1;
6655         Jim_DecrRefCount(interp, expr->obj[index]);
6656         if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6657             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6658             expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6659             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6660             expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6661         } else {
6662             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6663             expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6664             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6665             expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6666         }
6667         expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6668         expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6669         Jim_IncrRefCount(expr->obj[index]);
6670         Jim_IncrRefCount(expr->obj[leftindex]);
6671         Jim_IncrRefCount(expr->obj[leftindex+1]);
6672     }
6673 }
6674
6675 /* This method takes the string representation of an expression
6676  * and generates a program for the Expr's stack-based VM. */
6677 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6678 {
6679     int exprTextLen;
6680     const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6681     struct JimParserCtx parser;
6682     int i, shareLiterals;
6683     ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6684     Jim_Stack stack;
6685     Jim_ExprOperator *op;
6686
6687     /* Perform literal sharing with the current procedure
6688      * running only if this expression appears to be not generated
6689      * at runtime. */
6690     shareLiterals = objPtr->typePtr == &sourceObjType;
6691
6692     expr->opcode = NULL;
6693     expr->obj = NULL;
6694     expr->len = 0;
6695     expr->inUse = 1;
6696
6697     Jim_InitStack(&stack);
6698     JimParserInit(&parser, exprText, exprTextLen, 1);
6699     while(!JimParserEof(&parser)) {
6700         char *token;
6701         int len, type;
6702
6703         if (JimParseExpression(&parser) != JIM_OK) {
6704             Jim_SetResultString(interp, "Syntax error in expression", -1);
6705             goto err;
6706         }
6707         token = JimParserGetToken(&parser, &len, &type, NULL);
6708         if (type == JIM_TT_EOL) {
6709             Jim_Free(token);
6710             break;
6711         }
6712         switch(type) {
6713         case JIM_TT_STR:
6714             ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6715             break;
6716         case JIM_TT_ESC:
6717             ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6718             break;
6719         case JIM_TT_VAR:
6720             ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6721             break;
6722         case JIM_TT_DICTSUGAR:
6723             ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6724             break;
6725         case JIM_TT_CMD:
6726             ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6727             break;
6728         case JIM_TT_EXPR_NUMBER:
6729             ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6730             break;
6731         case JIM_TT_EXPR_OPERATOR:
6732             op = JimExprOperatorInfo(token);
6733             while(1) {
6734                 Jim_ExprOperator *stackTopOp;
6735
6736                 if (Jim_StackPeek(&stack) != NULL) {
6737                     stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6738                 } else {
6739                     stackTopOp = NULL;
6740                 }
6741                 if (Jim_StackLen(&stack) && op->arity != 1 &&
6742                     stackTopOp && stackTopOp->precedence >= op->precedence)
6743                 {
6744                     ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6745                         Jim_StackPeek(&stack), -1);
6746                     Jim_StackPop(&stack);
6747                 } else {
6748                     break;
6749                 }
6750             }
6751             Jim_StackPush(&stack, token);
6752             break;
6753         case JIM_TT_SUBEXPR_START:
6754             Jim_StackPush(&stack, Jim_StrDup("("));
6755             Jim_Free(token);
6756             break;
6757         case JIM_TT_SUBEXPR_END:
6758             {
6759                 int found = 0;
6760                 while(Jim_StackLen(&stack)) {
6761                     char *opstr = Jim_StackPop(&stack);
6762                     if (!strcmp(opstr, "(")) {
6763                         Jim_Free(opstr);
6764                         found = 1;
6765                         break;
6766                     }
6767                     op = JimExprOperatorInfo(opstr);
6768                     ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6769                 }
6770                 if (!found) {
6771                     Jim_SetResultString(interp,
6772                         "Unexpected close parenthesis", -1);
6773                     goto err;
6774                 }
6775             }
6776             Jim_Free(token);
6777             break;
6778         default:
6779             Jim_Panic(interp,"Default reached in SetExprFromAny()");
6780             break;
6781         }
6782     }
6783     while (Jim_StackLen(&stack)) {
6784         char *opstr = Jim_StackPop(&stack);
6785         op = JimExprOperatorInfo(opstr);
6786         if (op == NULL && !strcmp(opstr, "(")) {
6787             Jim_Free(opstr);
6788             Jim_SetResultString(interp, "Missing close parenthesis", -1);
6789             goto err;
6790         }
6791         ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6792     }
6793     /* Check program correctness. */
6794     if (ExprCheckCorrectness(expr) != JIM_OK) {
6795         Jim_SetResultString(interp, "Invalid expression", -1);
6796         goto err;
6797     }
6798
6799     /* Free the stack used for the compilation. */
6800     Jim_FreeStackElements(&stack, Jim_Free);
6801     Jim_FreeStack(&stack);
6802
6803     /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6804     ExprMakeLazy(interp, expr);
6805
6806     /* Perform literal sharing */
6807     if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6808         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6809         if (bodyObjPtr->typePtr == &scriptObjType) {
6810             ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6811             ExprShareLiterals(interp, expr, bodyScript);
6812         }
6813     }
6814
6815     /* Free the old internal rep and set the new one. */
6816     Jim_FreeIntRep(interp, objPtr);
6817     Jim_SetIntRepPtr(objPtr, expr);
6818     objPtr->typePtr = &exprObjType;
6819     return JIM_OK;
6820
6821 err:    /* we jump here on syntax/compile errors. */
6822     Jim_FreeStackElements(&stack, Jim_Free);
6823     Jim_FreeStack(&stack);
6824     Jim_Free(expr->opcode);
6825     for (i = 0; i < expr->len; i++) {
6826         Jim_DecrRefCount(interp,expr->obj[i]);
6827     }
6828     Jim_Free(expr->obj);
6829     Jim_Free(expr);
6830     return JIM_ERR;
6831 }
6832
6833 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6834 {
6835     if (objPtr->typePtr != &exprObjType) {
6836         if (SetExprFromAny(interp, objPtr) != JIM_OK)
6837             return NULL;
6838     }
6839     return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6840 }
6841
6842 /* -----------------------------------------------------------------------------
6843  * Expressions evaluation.
6844  * Jim uses a specialized stack-based virtual machine for expressions,
6845  * that takes advantage of the fact that expr's operators
6846  * can't be redefined.
6847  *
6848  * Jim_EvalExpression() uses the bytecode compiled by
6849  * SetExprFromAny() method of the "expression" object.
6850  *
6851  * On success a Tcl Object containing the result of the evaluation
6852  * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6853  * returned.
6854  * On error the function returns a retcode != to JIM_OK and set a suitable
6855  * error on the interp.
6856  * ---------------------------------------------------------------------------*/
6857 #define JIM_EE_STATICSTACK_LEN 10
6858
6859 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6860         Jim_Obj **exprResultPtrPtr)
6861 {
6862     ExprByteCode *expr;
6863     Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6864     int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6865
6866     Jim_IncrRefCount(exprObjPtr);
6867     expr = Jim_GetExpression(interp, exprObjPtr);
6868     if (!expr) {
6869         Jim_DecrRefCount(interp, exprObjPtr);
6870         return JIM_ERR; /* error in expression. */
6871     }
6872     /* In order to avoid that the internal repr gets freed due to
6873      * shimmering of the exprObjPtr's object, we make the internal rep
6874      * shared. */
6875     expr->inUse++;
6876
6877     /* The stack-based expr VM itself */
6878
6879     /* Stack allocation. Expr programs have the feature that
6880      * a program of length N can't require a stack longer than
6881      * N. */
6882     if (expr->len > JIM_EE_STATICSTACK_LEN)
6883         stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6884     else
6885         stack = staticStack;
6886
6887     /* Execute every istruction */
6888     for (i = 0; i < expr->len; i++) {
6889         Jim_Obj *A, *B, *objPtr;
6890         jim_wide wA, wB, wC;
6891         double dA, dB, dC;
6892         const char *sA, *sB;
6893         int Alen, Blen, retcode;
6894         int opcode = expr->opcode[i];
6895
6896         if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6897             stack[stacklen++] = expr->obj[i];
6898             Jim_IncrRefCount(expr->obj[i]);
6899         } else if (opcode == JIM_EXPROP_VARIABLE) {
6900             objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6901             if (objPtr == NULL) {
6902                 error = 1;
6903                 goto err;
6904             }
6905             stack[stacklen++] = objPtr;
6906             Jim_IncrRefCount(objPtr);
6907         } else if (opcode == JIM_EXPROP_SUBST) {
6908             if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6909                         &objPtr, JIM_NONE)) != JIM_OK)
6910             {
6911                 error = 1;
6912                 errRetCode = retcode;
6913                 goto err;
6914             }
6915             stack[stacklen++] = objPtr;
6916             Jim_IncrRefCount(objPtr);
6917         } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6918             objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6919             if (objPtr == NULL) {
6920                 error = 1;
6921                 goto err;
6922             }
6923             stack[stacklen++] = objPtr;
6924             Jim_IncrRefCount(objPtr);
6925         } else if (opcode == JIM_EXPROP_COMMAND) {
6926             if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6927                 error = 1;
6928                 errRetCode = retcode;
6929                 goto err;
6930             }
6931             stack[stacklen++] = interp->result;
6932             Jim_IncrRefCount(interp->result);
6933         } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6934                    opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6935         {
6936             /* Note that there isn't to increment the
6937              * refcount of objects. the references are moved
6938              * from stack to A and B. */
6939             B = stack[--stacklen];
6940             A = stack[--stacklen];
6941
6942             /* --- Integer --- */
6943             if ((A->typePtr == &doubleObjType && !A->bytes) ||
6944                 (B->typePtr == &doubleObjType && !B->bytes) ||
6945                 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6946                 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6947                 goto trydouble;
6948             }
6949             Jim_DecrRefCount(interp, A);
6950             Jim_DecrRefCount(interp, B);
6951             switch(expr->opcode[i]) {
6952             case JIM_EXPROP_ADD: wC = wA+wB; break;
6953             case JIM_EXPROP_SUB: wC = wA-wB; break;
6954             case JIM_EXPROP_MUL: wC = wA*wB; break;
6955             case JIM_EXPROP_LT: wC = wA<wB; break;
6956             case JIM_EXPROP_GT: wC = wA>wB; break;
6957             case JIM_EXPROP_LTE: wC = wA<=wB; break;
6958             case JIM_EXPROP_GTE: wC = wA>=wB; break;
6959             case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6960             case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6961             case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6962             case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6963             case JIM_EXPROP_BITAND: wC = wA&wB; break;
6964             case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6965             case JIM_EXPROP_BITOR: wC = wA|wB; break;
6966             case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6967             case JIM_EXPROP_LOGICAND_LEFT:
6968                 if (wA == 0) {
6969                     i += (int)wB;
6970                     wC = 0;
6971                 } else {
6972                     continue;
6973                 }
6974                 break;
6975             case JIM_EXPROP_LOGICOR_LEFT:
6976                 if (wA != 0) {
6977                     i += (int)wB;
6978                     wC = 1;
6979                 } else {
6980                     continue;
6981                 }
6982                 break;
6983             case JIM_EXPROP_DIV:
6984                 if (wB == 0) goto divbyzero;
6985                 wC = wA/wB;
6986                 break;
6987             case JIM_EXPROP_MOD:
6988                 if (wB == 0) goto divbyzero;
6989                 wC = wA%wB;
6990                 break;
6991             case JIM_EXPROP_ROTL: {
6992                 /* uint32_t would be better. But not everyone has inttypes.h?*/
6993                 unsigned long uA = (unsigned long)wA;
6994 #ifdef _MSC_VER
6995                 wC = _rotl(uA,(unsigned long)wB);
6996 #else
6997                 const unsigned int S = sizeof(unsigned long) * 8;
6998                 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6999 #endif
7000                 break;
7001             }
7002             case JIM_EXPROP_ROTR: {
7003                 unsigned long uA = (unsigned long)wA;
7004 #ifdef _MSC_VER
7005                 wC = _rotr(uA,(unsigned long)wB);
7006 #else
7007                 const unsigned int S = sizeof(unsigned long) * 8;
7008                 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7009 #endif
7010                 break;
7011             }
7012
7013             default:
7014                 wC = 0; /* avoid gcc warning */
7015                 break;
7016             }
7017             stack[stacklen] = Jim_NewIntObj(interp, wC);
7018             Jim_IncrRefCount(stack[stacklen]);
7019             stacklen++;
7020             continue;
7021 trydouble:
7022             /* --- Double --- */
7023             if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7024                 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7025
7026                 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7027                 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7028                     opcode = JIM_EXPROP_STRNE;
7029                     goto retry_as_string;
7030                 }
7031                 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7032                     opcode = JIM_EXPROP_STREQ;
7033                     goto retry_as_string;
7034                 }
7035                 Jim_DecrRefCount(interp, A);
7036                 Jim_DecrRefCount(interp, B);
7037                 error = 1;
7038                 goto err;
7039             }
7040             Jim_DecrRefCount(interp, A);
7041             Jim_DecrRefCount(interp, B);
7042             switch(expr->opcode[i]) {
7043             case JIM_EXPROP_ROTL:
7044             case JIM_EXPROP_ROTR:
7045             case JIM_EXPROP_LSHIFT:
7046             case JIM_EXPROP_RSHIFT:
7047             case JIM_EXPROP_BITAND:
7048             case JIM_EXPROP_BITXOR:
7049             case JIM_EXPROP_BITOR:
7050             case JIM_EXPROP_MOD:
7051             case JIM_EXPROP_POW:
7052                 Jim_SetResultString(interp,
7053                     "Got floating-point value where integer was expected", -1);
7054                 error = 1;
7055                 goto err;
7056                 break;
7057             case JIM_EXPROP_ADD: dC = dA+dB; break;
7058             case JIM_EXPROP_SUB: dC = dA-dB; break;
7059             case JIM_EXPROP_MUL: dC = dA*dB; break;
7060             case JIM_EXPROP_LT: dC = dA<dB; break;
7061             case JIM_EXPROP_GT: dC = dA>dB; break;
7062             case JIM_EXPROP_LTE: dC = dA<=dB; break;
7063             case JIM_EXPROP_GTE: dC = dA>=dB; break;
7064             case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7065             case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7066             case JIM_EXPROP_LOGICAND_LEFT:
7067                 if (dA == 0) {
7068                     i += (int)dB;
7069                     dC = 0;
7070                 } else {
7071                     continue;
7072                 }
7073                 break;
7074             case JIM_EXPROP_LOGICOR_LEFT:
7075                 if (dA != 0) {
7076                     i += (int)dB;
7077                     dC = 1;
7078                 } else {
7079                     continue;
7080                 }
7081                 break;
7082             case JIM_EXPROP_DIV:
7083                 if (dB == 0) goto divbyzero;
7084                 dC = dA/dB;
7085                 break;
7086             default:
7087                 dC = 0; /* avoid gcc warning */
7088                 break;
7089             }
7090             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7091             Jim_IncrRefCount(stack[stacklen]);
7092             stacklen++;
7093         } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7094             B = stack[--stacklen];
7095             A = stack[--stacklen];
7096 retry_as_string:
7097             sA = Jim_GetString(A, &Alen);
7098             sB = Jim_GetString(B, &Blen);
7099             switch(opcode) {
7100             case JIM_EXPROP_STREQ:
7101                 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7102                     wC = 1;
7103                 else
7104                     wC = 0;
7105                 break;
7106             case JIM_EXPROP_STRNE:
7107                 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7108                     wC = 1;
7109                 else
7110                     wC = 0;
7111                 break;
7112             default:
7113                 wC = 0; /* avoid gcc warning */
7114                 break;
7115             }
7116             Jim_DecrRefCount(interp, A);
7117             Jim_DecrRefCount(interp, B);
7118             stack[stacklen] = Jim_NewIntObj(interp, wC);
7119             Jim_IncrRefCount(stack[stacklen]);
7120             stacklen++;
7121         } else if (opcode == JIM_EXPROP_NOT ||
7122                    opcode == JIM_EXPROP_BITNOT ||
7123                    opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7124                    opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7125             /* Note that there isn't to increment the
7126              * refcount of objects. the references are moved
7127              * from stack to A and B. */
7128             A = stack[--stacklen];
7129
7130             /* --- Integer --- */
7131             if ((A->typePtr == &doubleObjType && !A->bytes) ||
7132                 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7133                 goto trydouble_unary;
7134             }
7135             Jim_DecrRefCount(interp, A);
7136             switch(expr->opcode[i]) {
7137             case JIM_EXPROP_NOT: wC = !wA; break;
7138             case JIM_EXPROP_BITNOT: wC = ~wA; break;
7139             case JIM_EXPROP_LOGICAND_RIGHT:
7140             case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7141             default:
7142                 wC = 0; /* avoid gcc warning */
7143                 break;
7144             }
7145             stack[stacklen] = Jim_NewIntObj(interp, wC);
7146             Jim_IncrRefCount(stack[stacklen]);
7147             stacklen++;
7148             continue;
7149 trydouble_unary:
7150             /* --- Double --- */
7151             if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7152                 Jim_DecrRefCount(interp, A);
7153                 error = 1;
7154                 goto err;
7155             }
7156             Jim_DecrRefCount(interp, A);
7157             switch(expr->opcode[i]) {
7158             case JIM_EXPROP_NOT: dC = !dA; break;
7159             case JIM_EXPROP_LOGICAND_RIGHT:
7160             case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7161             case JIM_EXPROP_BITNOT:
7162                 Jim_SetResultString(interp,
7163                     "Got floating-point value where integer was expected", -1);
7164                 error = 1;
7165                 goto err;
7166                 break;
7167             default:
7168                 dC = 0; /* avoid gcc warning */
7169                 break;
7170             }
7171             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7172             Jim_IncrRefCount(stack[stacklen]);
7173             stacklen++;
7174         } else {
7175             Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7176         }
7177     }
7178 err:
7179     /* There is no need to decerement the inUse field because
7180      * this reference is transfered back into the exprObjPtr. */
7181     Jim_FreeIntRep(interp, exprObjPtr);
7182     exprObjPtr->typePtr = &exprObjType;
7183     Jim_SetIntRepPtr(exprObjPtr, expr);
7184     Jim_DecrRefCount(interp, exprObjPtr);
7185     if (!error) {
7186         *exprResultPtrPtr = stack[0];
7187         Jim_IncrRefCount(stack[0]);
7188         errRetCode = JIM_OK;
7189     }
7190     for (i = 0; i < stacklen; i++) {
7191         Jim_DecrRefCount(interp, stack[i]);
7192     }
7193     if (stack != staticStack)
7194         Jim_Free(stack);
7195     return errRetCode;
7196 divbyzero:
7197     error = 1;
7198     Jim_SetResultString(interp, "Division by zero", -1);
7199     goto err;
7200 }
7201
7202 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7203 {
7204     int retcode;
7205     jim_wide wideValue;
7206     double doubleValue;
7207     Jim_Obj *exprResultPtr;
7208
7209     retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7210     if (retcode != JIM_OK)
7211         return retcode;
7212     if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7213         if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7214         {
7215             Jim_DecrRefCount(interp, exprResultPtr);
7216             return JIM_ERR;
7217         } else {
7218             Jim_DecrRefCount(interp, exprResultPtr);
7219             *boolPtr = doubleValue != 0;
7220             return JIM_OK;
7221         }
7222     }
7223     Jim_DecrRefCount(interp, exprResultPtr);
7224     *boolPtr = wideValue != 0;
7225     return JIM_OK;
7226 }
7227
7228 /* -----------------------------------------------------------------------------
7229  * ScanFormat String Object
7230  * ---------------------------------------------------------------------------*/
7231
7232 /* This Jim_Obj will held a parsed representation of a format string passed to
7233  * the Jim_ScanString command. For error diagnostics, the scanformat string has
7234  * to be parsed in its entirely first and then, if correct, can be used for
7235  * scanning. To avoid endless re-parsing, the parsed representation will be
7236  * stored in an internal representation and re-used for performance reason. */
7237  
7238 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7239  * scanformat string. This part will later be used to extract information
7240  * out from the string to be parsed by Jim_ScanString */
7241  
7242 typedef struct ScanFmtPartDescr {
7243     char type;         /* Type of conversion (e.g. c, d, f) */
7244     char modifier;     /* Modify type (e.g. l - long, h - short */
7245     size_t  width;     /* Maximal width of input to be converted */
7246     int  pos;          /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */ 
7247     char *arg;         /* Specification of a CHARSET conversion */
7248     char *prefix;      /* Prefix to be scanned literally before conversion */
7249 } ScanFmtPartDescr;
7250
7251 /* The ScanFmtStringObj will held the internal representation of a scanformat
7252  * string parsed and separated in part descriptions. Furthermore it contains
7253  * the original string representation of the scanformat string to allow for
7254  * fast update of the Jim_Obj's string representation part.
7255  *
7256  * As add-on the internal object representation add some scratch pad area
7257  * for usage by Jim_ScanString to avoid endless allocating and freeing of
7258  * memory for purpose of string scanning.
7259  *
7260  * The error member points to a static allocated string in case of a mal-
7261  * formed scanformat string or it contains '0' (NULL) in case of a valid
7262  * parse representation.
7263  *
7264  * The whole memory of the internal representation is allocated as a single
7265  * area of memory that will be internally separated. So freeing and duplicating
7266  * of such an object is cheap */
7267
7268 typedef struct ScanFmtStringObj {
7269     jim_wide        size;         /* Size of internal repr in bytes */
7270     char            *stringRep;   /* Original string representation */
7271     size_t          count;        /* Number of ScanFmtPartDescr contained */
7272     size_t          convCount;    /* Number of conversions that will assign */
7273     size_t          maxPos;       /* Max position index if XPG3 is used */
7274     const char      *error;       /* Ptr to error text (NULL if no error */
7275     char            *scratch;     /* Some scratch pad used by Jim_ScanString */
7276     ScanFmtPartDescr descr[1];    /* The vector of partial descriptions */
7277 } ScanFmtStringObj;
7278
7279
7280 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7281 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7282 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7283
7284 static Jim_ObjType scanFmtStringObjType = {
7285     "scanformatstring",
7286     FreeScanFmtInternalRep,
7287     DupScanFmtInternalRep,
7288     UpdateStringOfScanFmt,
7289     JIM_TYPE_NONE,
7290 };
7291
7292 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7293 {
7294     JIM_NOTUSED(interp);
7295     Jim_Free((char*)objPtr->internalRep.ptr);
7296     objPtr->internalRep.ptr = 0;
7297 }
7298
7299 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7300 {
7301     size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7302     ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7303
7304     JIM_NOTUSED(interp);
7305     memcpy(newVec, srcPtr->internalRep.ptr, size);
7306     dupPtr->internalRep.ptr = newVec;
7307     dupPtr->typePtr = &scanFmtStringObjType;
7308 }
7309
7310 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7311 {
7312     char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7313
7314     objPtr->bytes = Jim_StrDup(bytes);
7315     objPtr->length = strlen(bytes);
7316 }
7317
7318 /* SetScanFmtFromAny will parse a given string and create the internal
7319  * representation of the format specification. In case of an error
7320  * the error data member of the internal representation will be set
7321  * to an descriptive error text and the function will be left with
7322  * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7323  * specification */
7324
7325 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7326 {
7327     ScanFmtStringObj *fmtObj;
7328     char *buffer;
7329     int maxCount, i, approxSize, lastPos = -1;
7330     const char *fmt = objPtr->bytes;
7331     int maxFmtLen = objPtr->length;
7332     const char *fmtEnd = fmt + maxFmtLen;
7333     int curr;
7334
7335     Jim_FreeIntRep(interp, objPtr);
7336     /* Count how many conversions could take place maximally */
7337     for (i=0, maxCount=0; i < maxFmtLen; ++i)
7338         if (fmt[i] == '%')
7339             ++maxCount;
7340     /* Calculate an approximation of the memory necessary */
7341     approxSize = sizeof(ScanFmtStringObj)           /* Size of the container */
7342         + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7343         + maxFmtLen * sizeof(char) + 3 + 1          /* Scratch + "%n" + '\0' */
7344         + maxFmtLen * sizeof(char) + 1              /* Original stringrep */
7345         + maxFmtLen * sizeof(char)                  /* Arg for CHARSETs */
7346         + (maxCount +1) * sizeof(char)              /* '\0' for every partial */
7347         + 1;                                        /* safety byte */
7348     fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7349     memset(fmtObj, 0, approxSize);
7350     fmtObj->size = approxSize;
7351     fmtObj->maxPos = 0;
7352     fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7353     fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7354     memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7355     buffer = fmtObj->stringRep + maxFmtLen + 1;
7356     objPtr->internalRep.ptr = fmtObj;
7357     objPtr->typePtr = &scanFmtStringObjType;
7358     for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7359         int width=0, skip;
7360         ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7361         fmtObj->count++;
7362         descr->width = 0;                   /* Assume width unspecified */ 
7363         /* Overread and store any "literal" prefix */
7364         if (*fmt != '%' || fmt[1] == '%') {
7365             descr->type = 0;
7366             descr->prefix = &buffer[i];
7367             for (; fmt < fmtEnd; ++fmt) {
7368                 if (*fmt == '%') {
7369                     if (fmt[1] != '%') break;
7370                     ++fmt;
7371                 }
7372                 buffer[i++] = *fmt;
7373             }
7374             buffer[i++] = 0;
7375         } 
7376         /* Skip the conversion introducing '%' sign */
7377         ++fmt;      
7378         /* End reached due to non-conversion literal only? */
7379         if (fmt >= fmtEnd)
7380             goto done;
7381         descr->pos = 0;                     /* Assume "natural" positioning */
7382         if (*fmt == '*') {
7383             descr->pos = -1;       /* Okay, conversion will not be assigned */
7384             ++fmt;
7385         } else
7386             fmtObj->convCount++;    /* Otherwise count as assign-conversion */
7387         /* Check if next token is a number (could be width or pos */
7388         if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7389             fmt += skip;
7390             /* Was the number a XPG3 position specifier? */
7391             if (descr->pos != -1 && *fmt == '$') {
7392                 int prev;
7393                 ++fmt;
7394                 descr->pos = width;
7395                 width = 0;
7396                 /* Look if "natural" postioning and XPG3 one was mixed */
7397                 if ((lastPos == 0 && descr->pos > 0)
7398                         || (lastPos > 0 && descr->pos == 0)) {
7399                     fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7400                     return JIM_ERR;
7401                 }
7402                 /* Look if this position was already used */
7403                 for (prev=0; prev < curr; ++prev) {
7404                     if (fmtObj->descr[prev].pos == -1) continue;
7405                     if (fmtObj->descr[prev].pos == descr->pos) {
7406                         fmtObj->error = "same \"%n$\" conversion specifier "
7407                             "used more than once";
7408                         return JIM_ERR;
7409                     }
7410                 }
7411                 /* Try to find a width after the XPG3 specifier */
7412                 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7413                     descr->width = width;
7414                     fmt += skip;
7415                 }
7416                 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7417                     fmtObj->maxPos = descr->pos;
7418             } else {
7419                 /* Number was not a XPG3, so it has to be a width */
7420                 descr->width = width;
7421             }
7422         }
7423         /* If positioning mode was undetermined yet, fix this */
7424         if (lastPos == -1)
7425             lastPos = descr->pos;
7426         /* Handle CHARSET conversion type ... */
7427         if (*fmt == '[') {
7428             int swapped = 1, beg = i, end, j;
7429             descr->type = '[';
7430             descr->arg = &buffer[i];
7431             ++fmt;
7432             if (*fmt == '^') buffer[i++] = *fmt++;
7433             if (*fmt == ']') buffer[i++] = *fmt++;
7434             while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7435             if (*fmt != ']') {
7436                 fmtObj->error = "unmatched [ in format string";
7437                 return JIM_ERR;
7438             } 
7439             end = i;
7440             buffer[i++] = 0;
7441             /* In case a range fence was given "backwards", swap it */
7442             while (swapped) {
7443                 swapped = 0;
7444                 for (j=beg+1; j < end-1; ++j) {
7445                     if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7446                         char tmp = buffer[j-1];
7447                         buffer[j-1] = buffer[j+1];
7448                         buffer[j+1] = tmp;
7449                         swapped = 1;
7450                     }
7451                 }
7452             }
7453         } else {
7454             /* Remember any valid modifier if given */
7455             if (strchr("hlL", *fmt) != 0)
7456                 descr->modifier = tolower((int)*fmt++);
7457             
7458             descr->type = *fmt;
7459             if (strchr("efgcsndoxui", *fmt) == 0) {
7460                 fmtObj->error = "bad scan conversion character";
7461                 return JIM_ERR;
7462             } else if (*fmt == 'c' && descr->width != 0) {
7463                 fmtObj->error = "field width may not be specified in %c "
7464                     "conversion";
7465                 return JIM_ERR;
7466             } else if (*fmt == 'u' && descr->modifier == 'l') {
7467                 fmtObj->error = "unsigned wide not supported";
7468                 return JIM_ERR;
7469             }
7470         }
7471         curr++;
7472     }
7473 done:
7474     if (fmtObj->convCount == 0) {
7475         fmtObj->error = "no any conversion specifier given";
7476         return JIM_ERR;
7477     }
7478     return JIM_OK;
7479 }
7480
7481 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7482
7483 #define FormatGetCnvCount(_fo_) \
7484     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7485 #define FormatGetMaxPos(_fo_) \
7486     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7487 #define FormatGetError(_fo_) \
7488     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7489
7490 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7491  * charsets ([a-z123]) within scanning. Later on perhaps a base for a 
7492  * bitvector implementation in Jim? */ 
7493
7494 static int JimTestBit(const char *bitvec, char ch)
7495 {
7496     div_t pos = div(ch-1, 8);
7497     return bitvec[pos.quot] & (1 << pos.rem);
7498 }
7499
7500 static void JimSetBit(char *bitvec, char ch)
7501 {
7502     div_t pos = div(ch-1, 8);
7503     bitvec[pos.quot] |= (1 << pos.rem);
7504 }
7505
7506 #if 0 /* currently not used */
7507 static void JimClearBit(char *bitvec, char ch)
7508 {
7509     div_t pos = div(ch-1, 8);
7510     bitvec[pos.quot] &= ~(1 << pos.rem);
7511 }
7512 #endif
7513
7514 /* JimScanAString is used to scan an unspecified string that ends with
7515  * next WS, or a string that is specified via a charset. The charset
7516  * is currently implemented in a way to only allow for usage with
7517  * ASCII. Whenever we will switch to UNICODE, another idea has to
7518  * be born :-/
7519  *
7520  * FIXME: Works only with ASCII */
7521
7522 static Jim_Obj *
7523 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7524 {
7525     size_t i;
7526     Jim_Obj *result;
7527     char charset[256/8+1];  /* A Charset may contain max 256 chars */
7528     char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7529
7530     /* First init charset to nothing or all, depending if a specified
7531      * or an unspecified string has to be parsed */
7532     memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7533     if (sdescr) {
7534         /* There was a set description given, that means we are parsing
7535          * a specified string. So we have to build a corresponding 
7536          * charset reflecting the description */
7537         int notFlag = 0;
7538         /* Should the set be negated at the end? */
7539         if (*sdescr == '^') {
7540             notFlag = 1;
7541             ++sdescr;
7542         }
7543         /* Here '-' is meant literally and not to define a range */
7544         if (*sdescr == '-') {
7545             JimSetBit(charset, '-');
7546             ++sdescr;
7547         }
7548         while (*sdescr) {
7549             if (sdescr[1] == '-' && sdescr[2] != 0) {
7550                 /* Handle range definitions */
7551                 int i;
7552                 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7553                     JimSetBit(charset, (char)i);
7554                 sdescr += 3;
7555             } else {
7556                 /* Handle verbatim character definitions */
7557                 JimSetBit(charset, *sdescr++);
7558             }
7559         }
7560         /* Negate the charset if there was a NOT given */
7561         for (i=0; notFlag && i < sizeof(charset); ++i)
7562             charset[i] = ~charset[i];
7563     } 
7564     /* And after all the mess above, the real work begin ... */
7565     while (str && *str) {
7566         if (!sdescr && isspace((int)*str))
7567             break; /* EOS via WS if unspecified */
7568         if (JimTestBit(charset, *str)) *buffer++ = *str++;
7569         else break;             /* EOS via mismatch if specified scanning */
7570     }
7571     *buffer = 0;                /* Close the string properly ... */
7572     result = Jim_NewStringObj(interp, anchor, -1);
7573     Jim_Free(anchor);           /* ... and free it afer usage */
7574     return result;
7575 }
7576
7577 /* ScanOneEntry will scan one entry out of the string passed as argument.
7578  * It use the sscanf() function for this task. After extracting and
7579  * converting of the value, the count of scanned characters will be
7580  * returned of -1 in case of no conversion tool place and string was
7581  * already scanned thru */
7582
7583 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7584         ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7585 {
7586 #   define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7587         ? sizeof(jim_wide)                             \
7588         : sizeof(double))
7589     char buffer[MAX_SIZE];
7590     char *value = buffer;
7591     const char *tok;
7592     const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7593     size_t sLen = strlen(&str[pos]), scanned = 0;
7594     size_t anchor = pos;
7595     int i;
7596
7597     /* First pessimiticly assume, we will not scan anything :-) */
7598     *valObjPtr = 0;
7599     if (descr->prefix) {
7600         /* There was a prefix given before the conversion, skip it and adjust
7601          * the string-to-be-parsed accordingly */
7602         for (i=0; str[pos] && descr->prefix[i]; ++i) {
7603             /* If prefix require, skip WS */
7604             if (isspace((int)descr->prefix[i]))
7605                 while (str[pos] && isspace((int)str[pos])) ++pos;
7606             else if (descr->prefix[i] != str[pos]) 
7607                 break;  /* Prefix do not match here, leave the loop */
7608             else
7609                 ++pos;  /* Prefix matched so far, next round */
7610         }
7611         if (str[pos] == 0)
7612             return -1;  /* All of str consumed: EOF condition */
7613         else if (descr->prefix[i] != 0)
7614             return 0;   /* Not whole prefix consumed, no conversion possible */
7615     }
7616     /* For all but following conversion, skip leading WS */
7617     if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7618         while (isspace((int)str[pos])) ++pos;
7619     /* Determine how much skipped/scanned so far */
7620     scanned = pos - anchor;
7621     if (descr->type == 'n') {
7622         /* Return pseudo conversion means: how much scanned so far? */
7623         *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7624     } else if (str[pos] == 0) {
7625         /* Cannot scan anything, as str is totally consumed */
7626         return -1;
7627     } else {
7628         /* Processing of conversions follows ... */
7629         if (descr->width > 0) {
7630             /* Do not try to scan as fas as possible but only the given width.
7631              * To ensure this, we copy the part that should be scanned. */
7632             size_t tLen = descr->width > sLen ? sLen : descr->width;
7633             tok = Jim_StrDupLen(&str[pos], tLen);
7634         } else {
7635             /* As no width was given, simply refer to the original string */
7636             tok = &str[pos];
7637         }
7638         switch (descr->type) {
7639             case 'c':
7640                 *valObjPtr = Jim_NewIntObj(interp, *tok);
7641                 scanned += 1;
7642                 break;
7643             case 'd': case 'o': case 'x': case 'u': case 'i': {
7644                 char *endp;  /* Position where the number finished */
7645                 int base = descr->type == 'o' ? 8
7646                     : descr->type == 'x' ? 16
7647                     : descr->type == 'i' ? 0
7648                     : 10;
7649                     
7650                 do {
7651                     /* Try to scan a number with the given base */
7652                     if (descr->modifier == 'l')
7653 #ifdef HAVE_LONG_LONG
7654                       *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7655 #else
7656                       *(jim_wide*)value = strtol(tok, &endp, base);
7657 #endif
7658                     else
7659                       if (descr->type == 'u')
7660                         *(long*)value = strtoul(tok, &endp, base);
7661                       else
7662                         *(long*)value = strtol(tok, &endp, base);
7663                     /* If scanning failed, and base was undetermined, simply
7664                      * put it to 10 and try once more. This should catch the
7665                      * case where %i begin to parse a number prefix (e.g. 
7666                      * '0x' but no further digits follows. This will be
7667                      * handled as a ZERO followed by a char 'x' by Tcl */
7668                     if (endp == tok && base == 0) base = 10;
7669                     else break;
7670                 } while (1);
7671                 if (endp != tok) {
7672                     /* There was some number sucessfully scanned! */
7673                     if (descr->modifier == 'l')
7674                         *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7675                     else
7676                         *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7677                     /* Adjust the number-of-chars scanned so far */
7678                     scanned += endp - tok;
7679                 } else {
7680                     /* Nothing was scanned. We have to determine if this
7681                      * happened due to e.g. prefix mismatch or input str
7682                      * exhausted */
7683                     scanned = *tok ? 0 : -1;
7684                 }
7685                 break;
7686             }
7687             case 's': case '[': {
7688                 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7689                 scanned += Jim_Length(*valObjPtr);
7690                 break;
7691             }
7692             case 'e': case 'f': case 'g': {
7693                 char *endp;
7694
7695                 *(double*)value = strtod(tok, &endp);
7696                 if (endp != tok) {
7697                     /* There was some number sucessfully scanned! */
7698                     *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7699                     /* Adjust the number-of-chars scanned so far */
7700                     scanned += endp - tok;
7701                 } else {
7702                     /* Nothing was scanned. We have to determine if this
7703                      * happened due to e.g. prefix mismatch or input str
7704                      * exhausted */
7705                     scanned = *tok ? 0 : -1;
7706                 }
7707                 break;
7708             }
7709         }
7710         /* If a substring was allocated (due to pre-defined width) do not
7711          * forget to free it */
7712         if (tok != &str[pos])
7713             Jim_Free((char*)tok);
7714     }
7715     return scanned;
7716 }
7717
7718 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7719  * string and returns all converted (and not ignored) values in a list back
7720  * to the caller. If an error occured, a NULL pointer will be returned */
7721
7722 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7723         Jim_Obj *fmtObjPtr, int flags)
7724 {
7725     size_t i, pos;
7726     int scanned = 1;
7727     const char *str = Jim_GetString(strObjPtr, 0);
7728     Jim_Obj *resultList = 0;
7729     Jim_Obj **resultVec;
7730     int resultc;
7731     Jim_Obj *emptyStr = 0;
7732     ScanFmtStringObj *fmtObj;
7733
7734     /* If format specification is not an object, convert it! */
7735     if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7736         SetScanFmtFromAny(interp, fmtObjPtr);
7737     fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7738     /* Check if format specification was valid */
7739     if (fmtObj->error != 0) {
7740         if (flags & JIM_ERRMSG)
7741             Jim_SetResultString(interp, fmtObj->error, -1);
7742         return 0;
7743     }
7744     /* Allocate a new "shared" empty string for all unassigned conversions */
7745     emptyStr = Jim_NewEmptyStringObj(interp);
7746     Jim_IncrRefCount(emptyStr);
7747     /* Create a list and fill it with empty strings up to max specified XPG3 */
7748     resultList = Jim_NewListObj(interp, 0, 0);
7749     if (fmtObj->maxPos > 0) {
7750         for (i=0; i < fmtObj->maxPos; ++i)
7751             Jim_ListAppendElement(interp, resultList, emptyStr);
7752         JimListGetElements(interp, resultList, &resultc, &resultVec);
7753     }
7754     /* Now handle every partial format description */
7755     for (i=0, pos=0; i < fmtObj->count; ++i) {
7756         ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7757         Jim_Obj *value = 0;
7758         /* Only last type may be "literal" w/o conversion - skip it! */
7759         if (descr->type == 0) continue;
7760         /* As long as any conversion could be done, we will proceed */
7761         if (scanned > 0)
7762             scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7763         /* In case our first try results in EOF, we will leave */
7764         if (scanned == -1 && i == 0)
7765             goto eof;
7766         /* Advance next pos-to-be-scanned for the amount scanned already */
7767         pos += scanned;
7768         /* value == 0 means no conversion took place so take empty string */
7769         if (value == 0)
7770             value = Jim_NewEmptyStringObj(interp);
7771         /* If value is a non-assignable one, skip it */
7772         if (descr->pos == -1) {
7773             Jim_FreeNewObj(interp, value);
7774         } else if (descr->pos == 0)
7775             /* Otherwise append it to the result list if no XPG3 was given */
7776             Jim_ListAppendElement(interp, resultList, value);
7777         else if (resultVec[descr->pos-1] == emptyStr) {
7778             /* But due to given XPG3, put the value into the corr. slot */
7779             Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7780             Jim_IncrRefCount(value);
7781             resultVec[descr->pos-1] = value;
7782         } else {
7783             /* Otherwise, the slot was already used - free obj and ERROR */
7784             Jim_FreeNewObj(interp, value);
7785             goto err;
7786         }
7787     }
7788     Jim_DecrRefCount(interp, emptyStr);
7789     return resultList;
7790 eof:
7791     Jim_DecrRefCount(interp, emptyStr);
7792     Jim_FreeNewObj(interp, resultList);
7793     return (Jim_Obj*)EOF;
7794 err:
7795     Jim_DecrRefCount(interp, emptyStr);
7796     Jim_FreeNewObj(interp, resultList);
7797     return 0;
7798 }
7799
7800 /* -----------------------------------------------------------------------------
7801  * Pseudo Random Number Generation
7802  * ---------------------------------------------------------------------------*/
7803 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7804         int seedLen);
7805
7806 /* Initialize the sbox with the numbers from 0 to 255 */
7807 static void JimPrngInit(Jim_Interp *interp)
7808 {
7809     int i;
7810     unsigned int seed[256];
7811
7812     interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7813     for (i = 0; i < 256; i++)
7814         seed[i] = (rand() ^ time(NULL) ^ clock());
7815     JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7816 }
7817
7818 /* Generates N bytes of random data */
7819 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7820 {
7821     Jim_PrngState *prng;
7822     unsigned char *destByte = (unsigned char*) dest;
7823     unsigned int si, sj, x;
7824
7825     /* initialization, only needed the first time */
7826     if (interp->prngState == NULL)
7827         JimPrngInit(interp);
7828     prng = interp->prngState;
7829     /* generates 'len' bytes of pseudo-random numbers */
7830     for (x = 0; x < len; x++) {
7831         prng->i = (prng->i+1) & 0xff;
7832         si = prng->sbox[prng->i];
7833         prng->j = (prng->j + si) & 0xff;
7834         sj = prng->sbox[prng->j];
7835         prng->sbox[prng->i] = sj;
7836         prng->sbox[prng->j] = si;
7837         *destByte++ = prng->sbox[(si+sj)&0xff];
7838     }
7839 }
7840
7841 /* Re-seed the generator with user-provided bytes */
7842 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7843         int seedLen)
7844 {
7845     int i;
7846     unsigned char buf[256];
7847     Jim_PrngState *prng;
7848
7849     /* initialization, only needed the first time */
7850     if (interp->prngState == NULL)
7851         JimPrngInit(interp);
7852     prng = interp->prngState;
7853
7854     /* Set the sbox[i] with i */
7855     for (i = 0; i < 256; i++)
7856         prng->sbox[i] = i;
7857     /* Now use the seed to perform a random permutation of the sbox */
7858     for (i = 0; i < seedLen; i++) {
7859         unsigned char t;
7860
7861         t = prng->sbox[i&0xFF];
7862         prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7863         prng->sbox[seed[i]] = t;
7864     }
7865     prng->i = prng->j = 0;
7866     /* discard the first 256 bytes of stream. */
7867     JimRandomBytes(interp, buf, 256);
7868 }
7869
7870 /* -----------------------------------------------------------------------------
7871  * Dynamic libraries support (WIN32 not supported)
7872  * ---------------------------------------------------------------------------*/
7873
7874 #ifdef JIM_DYNLIB
7875 #ifdef WIN32
7876 #define RTLD_LAZY 0
7877 void * dlopen(const char *path, int mode) 
7878 {
7879     JIM_NOTUSED(mode);
7880
7881     return (void *)LoadLibraryA(path);
7882 }
7883 int dlclose(void *handle)
7884 {
7885     FreeLibrary((HANDLE)handle);
7886     return 0;
7887 }
7888 void *dlsym(void *handle, const char *symbol)
7889 {
7890     return GetProcAddress((HMODULE)handle, symbol);
7891 }
7892 static char win32_dlerror_string[121];
7893 const char *dlerror(void)
7894 {
7895     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7896                    LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7897     return win32_dlerror_string;
7898 }
7899 #endif /* WIN32 */
7900
7901 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7902 {
7903     Jim_Obj *libPathObjPtr;
7904     int prefixc, i;
7905     void *handle;
7906     int (*onload)(Jim_Interp *interp);
7907
7908     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7909     if (libPathObjPtr == NULL) {
7910         prefixc = 0;
7911         libPathObjPtr = NULL;
7912     } else {
7913         Jim_IncrRefCount(libPathObjPtr);
7914         Jim_ListLength(interp, libPathObjPtr, &prefixc);
7915     }
7916
7917     for (i = -1; i < prefixc; i++) {
7918         if (i < 0) {
7919             handle = dlopen(pathName, RTLD_LAZY);
7920         } else {
7921             FILE *fp;
7922             char buf[JIM_PATH_LEN];
7923             const char *prefix;
7924             int prefixlen;
7925             Jim_Obj *prefixObjPtr;
7926             
7927             buf[0] = '\0';
7928             if (Jim_ListIndex(interp, libPathObjPtr, i,
7929                     &prefixObjPtr, JIM_NONE) != JIM_OK)
7930                 continue;
7931             prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7932             if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7933                 continue;
7934             if (*pathName == '/') {
7935                 strcpy(buf, pathName);
7936             }    
7937             else if (prefixlen && prefix[prefixlen-1] == '/')
7938                 sprintf(buf, "%s%s", prefix, pathName);
7939             else
7940                 sprintf(buf, "%s/%s", prefix, pathName);
7941             fp = fopen(buf, "r");
7942             if (fp == NULL)
7943                 continue;
7944             fclose(fp);
7945             handle = dlopen(buf, RTLD_LAZY);
7946         }
7947         if (handle == NULL) {
7948             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7949             Jim_AppendStrings(interp, Jim_GetResult(interp),
7950                 "error loading extension \"", pathName,
7951                 "\": ", dlerror(), NULL);
7952             if (i < 0)
7953                 continue;
7954             goto err;
7955         }
7956         if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7957             Jim_SetResultString(interp,
7958                     "No Jim_OnLoad symbol found on extension", -1);
7959             goto err;
7960         }
7961         if (onload(interp) == JIM_ERR) {
7962             dlclose(handle);
7963             goto err;
7964         }
7965         Jim_SetEmptyResult(interp);
7966         if (libPathObjPtr != NULL)
7967             Jim_DecrRefCount(interp, libPathObjPtr);
7968         return JIM_OK;
7969     }
7970 err:
7971     if (libPathObjPtr != NULL)
7972         Jim_DecrRefCount(interp, libPathObjPtr);
7973     return JIM_ERR;
7974 }
7975 #else /* JIM_DYNLIB */
7976 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7977 {
7978     JIM_NOTUSED(interp);
7979     JIM_NOTUSED(pathName);
7980
7981     Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7982     return JIM_ERR;
7983 }
7984 #endif/* JIM_DYNLIB */
7985
7986 /* -----------------------------------------------------------------------------
7987  * Packages handling
7988  * ---------------------------------------------------------------------------*/
7989
7990 #define JIM_PKG_ANY_VERSION -1
7991
7992 /* Convert a string of the type "1.2" into an integer.
7993  * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted 
7994  * to the integer with value 102 */
7995 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7996         int *intPtr, int flags)
7997 {
7998     char *copy;
7999     jim_wide major, minor;
8000     char *majorStr, *minorStr, *p;
8001
8002     if (v[0] == '\0') {
8003         *intPtr = JIM_PKG_ANY_VERSION;
8004         return JIM_OK;
8005     }
8006
8007     copy = Jim_StrDup(v);
8008     p = strchr(copy, '.');
8009     if (p == NULL) goto badfmt;
8010     *p = '\0';
8011     majorStr = copy;
8012     minorStr = p+1;
8013
8014     if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8015         Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8016         goto badfmt;
8017     *intPtr = (int)(major*100+minor);
8018     Jim_Free(copy);
8019     return JIM_OK;
8020
8021 badfmt:
8022     Jim_Free(copy);
8023     if (flags & JIM_ERRMSG) {
8024         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8025         Jim_AppendStrings(interp, Jim_GetResult(interp),
8026                 "invalid package version '", v, "'", NULL);
8027     }
8028     return JIM_ERR;
8029 }
8030
8031 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8032 static int JimPackageMatchVersion(int needed, int actual, int flags)
8033 {
8034     if (needed == JIM_PKG_ANY_VERSION) return 1;
8035     if (flags & JIM_MATCHVER_EXACT) {
8036         return needed == actual;
8037     } else {
8038         return needed/100 == actual/100 && (needed <= actual);
8039     }
8040 }
8041
8042 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8043         int flags)
8044 {
8045     int intVersion;
8046     /* Check if the version format is ok */
8047     if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8048         return JIM_ERR;
8049     /* If the package was already provided returns an error. */
8050     if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8051         if (flags & JIM_ERRMSG) {
8052             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8053             Jim_AppendStrings(interp, Jim_GetResult(interp),
8054                     "package '", name, "' was already provided", NULL);
8055         }
8056         return JIM_ERR;
8057     }
8058     Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8059     return JIM_OK;
8060 }
8061
8062 #ifndef JIM_ANSIC
8063
8064 #ifndef WIN32
8065 # include <sys/types.h>
8066 # include <dirent.h>
8067 #else
8068 # include <io.h>
8069 /* Posix dirent.h compatiblity layer for WIN32.
8070  * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8071  * Copyright Salvatore Sanfilippo ,2005.
8072  *
8073  * Permission to use, copy, modify, and distribute this software and its
8074  * documentation for any purpose is hereby granted without fee, provided
8075  * that this copyright and permissions notice appear in all copies and
8076  * derivatives.
8077  *
8078  * This software is supplied "as is" without express or implied warranty.
8079  * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8080  */
8081
8082 struct dirent {
8083     char *d_name;
8084 };
8085
8086 typedef struct DIR {
8087     long                handle; /* -1 for failed rewind */
8088     struct _finddata_t  info;
8089     struct dirent       result; /* d_name null iff first time */
8090     char                *name;  /* null-terminated char string */
8091 } DIR;
8092
8093 DIR *opendir(const char *name)
8094 {
8095     DIR *dir = 0;
8096
8097     if(name && name[0]) {
8098         size_t base_length = strlen(name);
8099         const char *all = /* search pattern must end with suitable wildcard */
8100             strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8101
8102         if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8103            (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8104         {
8105             strcat(strcpy(dir->name, name), all);
8106
8107             if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8108                 dir->result.d_name = 0;
8109             else { /* rollback */
8110                 Jim_Free(dir->name);
8111                 Jim_Free(dir);
8112                 dir = 0;
8113             }
8114         } else { /* rollback */
8115             Jim_Free(dir);
8116             dir   = 0;
8117             errno = ENOMEM;
8118         }
8119     } else {
8120         errno = EINVAL;
8121     }
8122     return dir;
8123 }
8124
8125 int closedir(DIR *dir)
8126 {
8127     int result = -1;
8128
8129     if(dir) {
8130         if(dir->handle != -1)
8131             result = _findclose(dir->handle);
8132         Jim_Free(dir->name);
8133         Jim_Free(dir);
8134     }
8135     if(result == -1) /* map all errors to EBADF */
8136         errno = EBADF;
8137     return result;
8138 }
8139
8140 struct dirent *readdir(DIR *dir)
8141 {
8142     struct dirent *result = 0;
8143
8144     if(dir && dir->handle != -1) {
8145         if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8146             result         = &dir->result;
8147             result->d_name = dir->info.name;
8148         }
8149     } else {
8150         errno = EBADF;
8151     }
8152     return result;
8153 }
8154
8155 #endif /* WIN32 */
8156
8157 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8158         int prefixc, const char *pkgName, int pkgVer, int flags)
8159 {
8160     int bestVer = -1, i;
8161     int pkgNameLen = strlen(pkgName);
8162     char *bestPackage = NULL;
8163     struct dirent *de;
8164
8165     for (i = 0; i < prefixc; i++) {
8166         DIR *dir;
8167         char buf[JIM_PATH_LEN];
8168         int prefixLen;
8169
8170         if (prefixes[i] == NULL) continue;
8171         strncpy(buf, prefixes[i], JIM_PATH_LEN);
8172         buf[JIM_PATH_LEN-1] = '\0';
8173         prefixLen = strlen(buf);
8174         if (prefixLen && buf[prefixLen-1] == '/')
8175             buf[prefixLen-1] = '\0';
8176
8177         if ((dir = opendir(buf)) == NULL) continue;
8178         while ((de = readdir(dir)) != NULL) {
8179             char *fileName = de->d_name;
8180             int fileNameLen = strlen(fileName);
8181
8182             if (strncmp(fileName, "jim-", 4) == 0 &&
8183                 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8184                 *(fileName+4+pkgNameLen) == '-' &&
8185                 fileNameLen > 4 && /* note that this is not really useful */
8186                 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8187                  strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8188                  strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8189             {
8190                 char ver[6]; /* xx.yy<nulterm> */
8191                 char *p = strrchr(fileName, '.');
8192                 int verLen, fileVer;
8193
8194                 verLen = p - (fileName+4+pkgNameLen+1);
8195                 if (verLen < 3 || verLen > 5) continue;
8196                 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8197                 ver[verLen] = '\0';
8198                 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8199                         != JIM_OK) continue;
8200                 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8201                     (bestVer == -1 || bestVer < fileVer))
8202                 {
8203                     bestVer = fileVer;
8204                     Jim_Free(bestPackage);
8205                     bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8206                     sprintf(bestPackage, "%s/%s", buf, fileName);
8207                 }
8208             }
8209         }
8210         closedir(dir);
8211     }
8212     return bestPackage;
8213 }
8214
8215 #else /* JIM_ANSIC */
8216
8217 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8218         int prefixc, const char *pkgName, int pkgVer, int flags)
8219 {
8220     JIM_NOTUSED(interp);
8221     JIM_NOTUSED(prefixes);
8222     JIM_NOTUSED(prefixc);
8223     JIM_NOTUSED(pkgName);
8224     JIM_NOTUSED(pkgVer);
8225     JIM_NOTUSED(flags);
8226     return NULL;
8227 }
8228
8229 #endif /* JIM_ANSIC */
8230
8231 /* Search for a suitable package under every dir specified by jim_libpath
8232  * and load it if possible. If a suitable package was loaded with success
8233  * JIM_OK is returned, otherwise JIM_ERR is returned. */
8234 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8235         int flags)
8236 {
8237     Jim_Obj *libPathObjPtr;
8238     char **prefixes, *best;
8239     int prefixc, i, retCode = JIM_OK;
8240
8241     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8242     if (libPathObjPtr == NULL) {
8243         prefixc = 0;
8244         libPathObjPtr = NULL;
8245     } else {
8246         Jim_IncrRefCount(libPathObjPtr);
8247         Jim_ListLength(interp, libPathObjPtr, &prefixc);
8248     }
8249
8250     prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8251     for (i = 0; i < prefixc; i++) {
8252             Jim_Obj *prefixObjPtr;
8253             if (Jim_ListIndex(interp, libPathObjPtr, i,
8254                     &prefixObjPtr, JIM_NONE) != JIM_OK)
8255             {
8256                 prefixes[i] = NULL;
8257                 continue;
8258             }
8259             prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8260     }
8261     /* Scan every directory to find the "best" package. */
8262     best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8263     if (best != NULL) {
8264         char *p = strrchr(best, '.');
8265         /* Try to load/source it */
8266         if (p && strcmp(p, ".tcl") == 0) {
8267             retCode = Jim_EvalFile(interp, best);
8268         } else {
8269             retCode = Jim_LoadLibrary(interp, best);
8270         }
8271     } else {
8272         retCode = JIM_ERR;
8273     }
8274     Jim_Free(best);
8275     for (i = 0; i < prefixc; i++)
8276         Jim_Free(prefixes[i]);
8277     Jim_Free(prefixes);
8278     if (libPathObjPtr)
8279         Jim_DecrRefCount(interp, libPathObjPtr);
8280     return retCode;
8281 }
8282
8283 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8284         const char *ver, int flags)
8285 {
8286     Jim_HashEntry *he;
8287     int requiredVer;
8288
8289     /* Start with an empty error string */
8290     Jim_SetResultString(interp, "", 0);
8291
8292     if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8293         return NULL;
8294     he = Jim_FindHashEntry(&interp->packages, name);
8295     if (he == NULL) {
8296         /* Try to load the package. */
8297         if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8298             he = Jim_FindHashEntry(&interp->packages, name);
8299             if (he == NULL) {
8300                 return "?";
8301             }
8302             return he->val;
8303         }
8304         /* No way... return an error. */
8305         if (flags & JIM_ERRMSG) {
8306             int len;
8307             Jim_GetString(Jim_GetResult(interp), &len);
8308             Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8309                     "Can't find package '", name, "'", NULL);
8310         }
8311         return NULL;
8312     } else {
8313         int actualVer;
8314         if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8315                 != JIM_OK)
8316         {
8317             return NULL;
8318         }
8319         /* Check if version matches. */
8320         if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8321             Jim_AppendStrings(interp, Jim_GetResult(interp),
8322                     "Package '", name, "' already loaded, but with version ",
8323                     he->val, NULL);
8324             return NULL;
8325         }
8326         return he->val;
8327     }
8328 }
8329
8330 /* -----------------------------------------------------------------------------
8331  * Eval
8332  * ---------------------------------------------------------------------------*/
8333 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8334 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8335
8336 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8337         Jim_Obj *const *argv);
8338
8339 /* Handle calls to the [unknown] command */
8340 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8341 {
8342     Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8343     int retCode;
8344
8345     /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8346      * done here
8347      */
8348     if (interp->unknown_called) {
8349         return JIM_ERR;
8350     }
8351
8352     /* If the [unknown] command does not exists returns
8353      * just now */
8354     if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8355         return JIM_ERR;
8356
8357     /* The object interp->unknown just contains
8358      * the "unknown" string, it is used in order to
8359      * avoid to lookup the unknown command every time
8360      * but instread to cache the result. */
8361     if (argc+1 <= JIM_EVAL_SARGV_LEN)
8362         v = sv;
8363     else
8364         v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8365     /* Make a copy of the arguments vector, but shifted on
8366      * the right of one position. The command name of the
8367      * command will be instead the first argument of the
8368      * [unknonw] call. */
8369     memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8370     v[0] = interp->unknown;
8371     /* Call it */
8372     interp->unknown_called++;
8373     retCode = Jim_EvalObjVector(interp, argc+1, v);
8374     interp->unknown_called--;
8375
8376     /* Clean up */
8377     if (v != sv)
8378         Jim_Free(v);
8379     return retCode;
8380 }
8381
8382 /* Eval the object vector 'objv' composed of 'objc' elements.
8383  * Every element is used as single argument.
8384  * Jim_EvalObj() will call this function every time its object
8385  * argument is of "list" type, with no string representation.
8386  *
8387  * This is possible because the string representation of a
8388  * list object generated by the UpdateStringOfList is made
8389  * in a way that ensures that every list element is a different
8390  * command argument. */
8391 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8392 {
8393     int i, retcode;
8394     Jim_Cmd *cmdPtr;
8395
8396     /* Incr refcount of arguments. */
8397     for (i = 0; i < objc; i++)
8398         Jim_IncrRefCount(objv[i]);
8399     /* Command lookup */
8400     cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8401     if (cmdPtr == NULL) {
8402         retcode = JimUnknown(interp, objc, objv);
8403     } else {
8404         /* Call it -- Make sure result is an empty object. */
8405         Jim_SetEmptyResult(interp);
8406         if (cmdPtr->cmdProc) {
8407             interp->cmdPrivData = cmdPtr->privData;
8408             retcode = cmdPtr->cmdProc(interp, objc, objv);
8409             if (retcode == JIM_ERR_ADDSTACK) {
8410                 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8411                 retcode = JIM_ERR;
8412             }
8413         } else {
8414             retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8415             if (retcode == JIM_ERR) {
8416                 JimAppendStackTrace(interp,
8417                     Jim_GetString(objv[0], NULL), "", 1);
8418             }
8419         }
8420     }
8421     /* Decr refcount of arguments and return the retcode */
8422     for (i = 0; i < objc; i++)
8423         Jim_DecrRefCount(interp, objv[i]);
8424     return retcode;
8425 }
8426
8427 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8428  * via *objPtrPtr. This function is only called by Jim_EvalObj().
8429  * The returned object has refcount = 0. */
8430 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8431         int tokens, Jim_Obj **objPtrPtr)
8432 {
8433     int totlen = 0, i, retcode;
8434     Jim_Obj **intv;
8435     Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8436     Jim_Obj *objPtr;
8437     char *s;
8438
8439     if (tokens <= JIM_EVAL_SINTV_LEN)
8440         intv = sintv;
8441     else
8442         intv = Jim_Alloc(sizeof(Jim_Obj*)*
8443                 tokens);
8444     /* Compute every token forming the argument
8445      * in the intv objects vector. */
8446     for (i = 0; i < tokens; i++) {
8447         switch(token[i].type) {
8448         case JIM_TT_ESC:
8449         case JIM_TT_STR:
8450             intv[i] = token[i].objPtr;
8451             break;
8452         case JIM_TT_VAR:
8453             intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8454             if (!intv[i]) {
8455                 retcode = JIM_ERR;
8456                 goto err;
8457             }
8458             break;
8459         case JIM_TT_DICTSUGAR:
8460             intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8461             if (!intv[i]) {
8462                 retcode = JIM_ERR;
8463                 goto err;
8464             }
8465             break;
8466         case JIM_TT_CMD:
8467             retcode = Jim_EvalObj(interp, token[i].objPtr);
8468             if (retcode != JIM_OK)
8469                 goto err;
8470             intv[i] = Jim_GetResult(interp);
8471             break;
8472         default:
8473             Jim_Panic(interp,
8474               "default token type reached "
8475               "in Jim_InterpolateTokens().");
8476             break;
8477         }
8478         Jim_IncrRefCount(intv[i]);
8479         /* Make sure there is a valid
8480          * string rep, and add the string
8481          * length to the total legnth. */
8482         Jim_GetString(intv[i], NULL);
8483         totlen += intv[i]->length;
8484     }
8485     /* Concatenate every token in an unique
8486      * object. */
8487     objPtr = Jim_NewStringObjNoAlloc(interp,
8488             NULL, 0);
8489     s = objPtr->bytes = Jim_Alloc(totlen+1);
8490     objPtr->length = totlen;
8491     for (i = 0; i < tokens; i++) {
8492         memcpy(s, intv[i]->bytes, intv[i]->length);
8493         s += intv[i]->length;
8494         Jim_DecrRefCount(interp, intv[i]);
8495     }
8496     objPtr->bytes[totlen] = '\0';
8497     /* Free the intv vector if not static. */
8498     if (tokens > JIM_EVAL_SINTV_LEN)
8499         Jim_Free(intv);
8500     *objPtrPtr = objPtr;
8501     return JIM_OK;
8502 err:
8503     i--;
8504     for (; i >= 0; i--)
8505         Jim_DecrRefCount(interp, intv[i]);
8506     if (tokens > JIM_EVAL_SINTV_LEN)
8507         Jim_Free(intv);
8508     return retcode;
8509 }
8510
8511 /* Helper of Jim_EvalObj() to perform argument expansion.
8512  * Basically this function append an argument to 'argv'
8513  * (and increments argc by reference accordingly), performing
8514  * expansion of the list object if 'expand' is non-zero, or
8515  * just adding objPtr to argv if 'expand' is zero. */
8516 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8517         int *argcPtr, int expand, Jim_Obj *objPtr)
8518 {
8519     if (!expand) {
8520         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8521         /* refcount of objPtr not incremented because
8522          * we are actually transfering a reference from
8523          * the old 'argv' to the expanded one. */
8524         (*argv)[*argcPtr] = objPtr;
8525         (*argcPtr)++;
8526     } else {
8527         int len, i;
8528
8529         Jim_ListLength(interp, objPtr, &len);
8530         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8531         for (i = 0; i < len; i++) {
8532             (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8533             Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8534             (*argcPtr)++;
8535         }
8536         /* The original object reference is no longer needed,
8537          * after the expansion it is no longer present on
8538          * the argument vector, but the single elements are
8539          * in its place. */
8540         Jim_DecrRefCount(interp, objPtr);
8541     }
8542 }
8543
8544 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8545 {
8546     int i, j = 0, len;
8547     ScriptObj *script;
8548     ScriptToken *token;
8549     int *cs; /* command structure array */
8550     int retcode = JIM_OK;
8551     Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8552
8553     interp->errorFlag = 0;
8554
8555     /* If the object is of type "list" and there is no
8556      * string representation for this object, we can call
8557      * a specialized version of Jim_EvalObj() */
8558     if (scriptObjPtr->typePtr == &listObjType &&
8559         scriptObjPtr->internalRep.listValue.len &&
8560         scriptObjPtr->bytes == NULL) {
8561         Jim_IncrRefCount(scriptObjPtr);
8562         retcode = Jim_EvalObjVector(interp,
8563                 scriptObjPtr->internalRep.listValue.len,
8564                 scriptObjPtr->internalRep.listValue.ele);
8565         Jim_DecrRefCount(interp, scriptObjPtr);
8566         return retcode;
8567     }
8568
8569     Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8570     script = Jim_GetScript(interp, scriptObjPtr);
8571     /* Now we have to make sure the internal repr will not be
8572      * freed on shimmering.
8573      *
8574      * Think for example to this:
8575      *
8576      * set x {llength $x; ... some more code ...}; eval $x
8577      *
8578      * In order to preserve the internal rep, we increment the
8579      * inUse field of the script internal rep structure. */
8580     script->inUse++;
8581
8582     token = script->token;
8583     len = script->len;
8584     cs = script->cmdStruct;
8585     i = 0; /* 'i' is the current token index. */
8586
8587     /* Reset the interpreter result. This is useful to
8588      * return the emtpy result in the case of empty program. */
8589     Jim_SetEmptyResult(interp);
8590
8591     /* Execute every command sequentially, returns on
8592      * error (i.e. if a command does not return JIM_OK) */
8593     while (i < len) {
8594         int expand = 0;
8595         int argc = *cs++; /* Get the number of arguments */
8596         Jim_Cmd *cmd;
8597
8598         /* Set the expand flag if needed. */
8599         if (argc == -1) {
8600             expand++;
8601             argc = *cs++;
8602         }
8603         /* Allocate the arguments vector */
8604         if (argc <= JIM_EVAL_SARGV_LEN)
8605             argv = sargv;
8606         else
8607             argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8608         /* Populate the arguments objects. */
8609         for (j = 0; j < argc; j++) {
8610             int tokens = *cs++;
8611
8612             /* tokens is negative if expansion is needed.
8613              * for this argument. */
8614             if (tokens < 0) {
8615                 tokens = (-tokens)-1;
8616                 i++;
8617             }
8618             if (tokens == 1) {
8619                 /* Fast path if the token does not
8620                  * need interpolation */
8621                 switch(token[i].type) {
8622                 case JIM_TT_ESC:
8623                 case JIM_TT_STR:
8624                     argv[j] = token[i].objPtr;
8625                     break;
8626                 case JIM_TT_VAR:
8627                     tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8628                             JIM_ERRMSG);
8629                     if (!tmpObjPtr) {
8630                         retcode = JIM_ERR;
8631                         goto err;
8632                     }
8633                     argv[j] = tmpObjPtr;
8634                     break;
8635                 case JIM_TT_DICTSUGAR:
8636                     tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8637                     if (!tmpObjPtr) {
8638                         retcode = JIM_ERR;
8639                         goto err;
8640                     }
8641                     argv[j] = tmpObjPtr;
8642                     break;
8643                 case JIM_TT_CMD:
8644                     retcode = Jim_EvalObj(interp, token[i].objPtr);
8645                     if (retcode != JIM_OK)
8646                         goto err;
8647                     argv[j] = Jim_GetResult(interp);
8648                     break;
8649                 default:
8650                     Jim_Panic(interp,
8651                       "default token type reached "
8652                       "in Jim_EvalObj().");
8653                     break;
8654                 }
8655                 Jim_IncrRefCount(argv[j]);
8656                 i += 2;
8657             } else {
8658                 /* For interpolation we call an helper
8659                  * function doing the work for us. */
8660                 if ((retcode = Jim_InterpolateTokens(interp,
8661                         token+i, tokens, &tmpObjPtr)) != JIM_OK)
8662                 {
8663                     goto err;
8664                 }
8665                 argv[j] = tmpObjPtr;
8666                 Jim_IncrRefCount(argv[j]);
8667                 i += tokens+1;
8668             }
8669         }
8670         /* Handle {expand} expansion */
8671         if (expand) {
8672             int *ecs = cs - argc;
8673             int eargc = 0;
8674             Jim_Obj **eargv = NULL;
8675
8676             for (j = 0; j < argc; j++) {
8677                 Jim_ExpandArgument( interp, &eargv, &eargc,
8678                         ecs[j] < 0, argv[j]);
8679             }
8680             if (argv != sargv)
8681                 Jim_Free(argv);
8682             argc = eargc;
8683             argv = eargv;
8684             j = argc;
8685             if (argc == 0) {
8686                 /* Nothing to do with zero args. */
8687                 Jim_Free(eargv);
8688                 continue;
8689             }
8690         }
8691         /* Lookup the command to call */
8692         cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8693         if (cmd != NULL) {
8694             /* Call it -- Make sure result is an empty object. */
8695             Jim_SetEmptyResult(interp);
8696             if (cmd->cmdProc) {
8697                 interp->cmdPrivData = cmd->privData;
8698                 retcode = cmd->cmdProc(interp, argc, argv);
8699                 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8700                     JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8701                     retcode = JIM_ERR;
8702                 }
8703             } else {
8704                 retcode = JimCallProcedure(interp, cmd, argc, argv);
8705                 if (retcode == JIM_ERR) {
8706                     JimAppendStackTrace(interp,
8707                         Jim_GetString(argv[0], NULL), script->fileName,
8708                         token[i-argc*2].linenr);
8709                 }
8710             }
8711         } else {
8712             /* Call [unknown] */
8713             retcode = JimUnknown(interp, argc, argv);
8714             if (retcode == JIM_ERR) {
8715                 JimAppendStackTrace(interp,
8716                     "", script->fileName,
8717                     token[i-argc*2].linenr);
8718             }
8719         }
8720         if (retcode != JIM_OK) {
8721             i -= argc*2; /* point to the command name. */
8722             goto err;
8723         }
8724         /* Decrement the arguments count */
8725         for (j = 0; j < argc; j++) {
8726             Jim_DecrRefCount(interp, argv[j]);
8727         }
8728
8729         if (argv != sargv) {
8730             Jim_Free(argv);
8731             argv = NULL;
8732         }
8733     }
8734     /* Note that we don't have to decrement inUse, because the
8735      * following code transfers our use of the reference again to
8736      * the script object. */
8737     j = 0; /* on normal termination, the argv array is already
8738           Jim_DecrRefCount-ed. */
8739 err:
8740     /* Handle errors. */
8741     if (retcode == JIM_ERR && !interp->errorFlag) {
8742         interp->errorFlag = 1;
8743         JimSetErrorFileName(interp, script->fileName);
8744         JimSetErrorLineNumber(interp, token[i].linenr);
8745         JimResetStackTrace(interp);
8746     }
8747     Jim_FreeIntRep(interp, scriptObjPtr);
8748     scriptObjPtr->typePtr = &scriptObjType;
8749     Jim_SetIntRepPtr(scriptObjPtr, script);
8750     Jim_DecrRefCount(interp, scriptObjPtr);
8751     for (i = 0; i < j; i++) {
8752         Jim_DecrRefCount(interp, argv[i]);
8753     }
8754     if (argv != sargv)
8755         Jim_Free(argv);
8756     return retcode;
8757 }
8758
8759 /* Call a procedure implemented in Tcl.
8760  * It's possible to speed-up a lot this function, currently
8761  * the callframes are not cached, but allocated and
8762  * destroied every time. What is expecially costly is
8763  * to create/destroy the local vars hash table every time.
8764  *
8765  * This can be fixed just implementing callframes caching
8766  * in JimCreateCallFrame() and JimFreeCallFrame(). */
8767 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8768         Jim_Obj *const *argv)
8769 {
8770     int i, retcode;
8771     Jim_CallFrame *callFramePtr;
8772     int num_args;
8773
8774     /* Check arity */
8775     if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8776         argc > cmd->arityMax)) {
8777         Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8778         Jim_AppendStrings(interp, objPtr,
8779             "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8780             (cmd->arityMin > 1) ? " " : "",
8781             Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8782         Jim_SetResult(interp, objPtr);
8783         return JIM_ERR;
8784     }
8785     /* Check if there are too nested calls */
8786     if (interp->numLevels == interp->maxNestingDepth) {
8787         Jim_SetResultString(interp,
8788             "Too many nested calls. Infinite recursion?", -1);
8789         return JIM_ERR;
8790     }
8791     /* Create a new callframe */
8792     callFramePtr = JimCreateCallFrame(interp);
8793     callFramePtr->parentCallFrame = interp->framePtr;
8794     callFramePtr->argv = argv;
8795     callFramePtr->argc = argc;
8796     callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8797     callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8798     callFramePtr->staticVars = cmd->staticVars;
8799     Jim_IncrRefCount(cmd->argListObjPtr);
8800     Jim_IncrRefCount(cmd->bodyObjPtr);
8801     interp->framePtr = callFramePtr;
8802     interp->numLevels ++;
8803
8804     /* Set arguments */
8805     Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8806
8807     /* If last argument is 'args', don't set it here */
8808     if (cmd->arityMax == -1) {
8809         num_args--;
8810     }
8811
8812     for (i = 0; i < num_args; i++) {
8813         Jim_Obj *argObjPtr;
8814         Jim_Obj *nameObjPtr;
8815         Jim_Obj *valueObjPtr;
8816
8817         Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8818         if (i + 1 >= cmd->arityMin) {
8819             /* The name is the first element of the list */
8820             Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8821         }
8822         else {
8823             /* The element arg is the name */
8824             nameObjPtr = argObjPtr;
8825         }
8826
8827         if (i + 1 >= argc) {
8828             /* No more values, so use default */
8829             /* The value is the second element of the list */
8830             Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8831         }
8832         else {
8833             valueObjPtr = argv[i+1];
8834         }
8835         Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8836     }
8837     /* Set optional arguments */
8838     if (cmd->arityMax == -1) {
8839         Jim_Obj *listObjPtr, *objPtr;
8840
8841         i++;
8842         listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8843         Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8844         Jim_SetVariable(interp, objPtr, listObjPtr);
8845     }
8846     /* Eval the body */
8847     retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8848
8849     /* Destroy the callframe */
8850     interp->numLevels --;
8851     interp->framePtr = interp->framePtr->parentCallFrame;
8852     if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8853         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8854     } else {
8855         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8856     }
8857     /* Handle the JIM_EVAL return code */
8858     if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8859         int savedLevel = interp->evalRetcodeLevel;
8860
8861         interp->evalRetcodeLevel = interp->numLevels;
8862         while (retcode == JIM_EVAL) {
8863             Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8864             Jim_IncrRefCount(resultScriptObjPtr);
8865             retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8866             Jim_DecrRefCount(interp, resultScriptObjPtr);
8867         }
8868         interp->evalRetcodeLevel = savedLevel;
8869     }
8870     /* Handle the JIM_RETURN return code */
8871     if (retcode == JIM_RETURN) {
8872         retcode = interp->returnCode;
8873         interp->returnCode = JIM_OK;
8874     }
8875     return retcode;
8876 }
8877
8878 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8879 {
8880     int retval;
8881     Jim_Obj *scriptObjPtr;
8882
8883         scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8884     Jim_IncrRefCount(scriptObjPtr);
8885
8886
8887         if( filename ){
8888                 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8889         }
8890
8891     retval = Jim_EvalObj(interp, scriptObjPtr);
8892     Jim_DecrRefCount(interp, scriptObjPtr);
8893     return retval;
8894 }
8895
8896 int Jim_Eval(Jim_Interp *interp, const char *script)
8897 {
8898         return Jim_Eval_Named( interp, script, NULL, 0 );
8899 }
8900
8901
8902
8903 /* Execute script in the scope of the global level */
8904 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8905 {
8906     Jim_CallFrame *savedFramePtr;
8907     int retval;
8908
8909     savedFramePtr = interp->framePtr;
8910     interp->framePtr = interp->topFramePtr;
8911     retval = Jim_Eval(interp, script);
8912     interp->framePtr = savedFramePtr;
8913     return retval;
8914 }
8915
8916 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8917 {
8918     Jim_CallFrame *savedFramePtr;
8919     int retval;
8920
8921     savedFramePtr = interp->framePtr;
8922     interp->framePtr = interp->topFramePtr;
8923     retval = Jim_EvalObj(interp, scriptObjPtr);
8924     interp->framePtr = savedFramePtr;
8925     /* Try to report the error (if any) via the bgerror proc */
8926     if (retval != JIM_OK) {
8927         Jim_Obj *objv[2];
8928
8929         objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8930         objv[1] = Jim_GetResult(interp);
8931         Jim_IncrRefCount(objv[0]);
8932         Jim_IncrRefCount(objv[1]);
8933         if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8934             /* Report the error to stderr. */
8935             Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8936             Jim_PrintErrorMessage(interp);
8937         }
8938         Jim_DecrRefCount(interp, objv[0]);
8939         Jim_DecrRefCount(interp, objv[1]);
8940     }
8941     return retval;
8942 }
8943
8944 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8945 {
8946     char *prg = NULL;
8947     FILE *fp;
8948     int nread, totread, maxlen, buflen;
8949     int retval;
8950     Jim_Obj *scriptObjPtr;
8951     
8952     if ((fp = fopen(filename, "r")) == NULL) {
8953         const int cwd_len=2048;
8954                 char *cwd=malloc(cwd_len);
8955         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8956         getcwd( cwd, cwd_len );
8957         Jim_AppendStrings(interp, Jim_GetResult(interp),
8958         "Error loading script \"", filename, "\"",
8959             " cwd: ", cwd,
8960             " err: ", strerror(errno), NULL);
8961             free(cwd);
8962         return JIM_ERR;
8963     }
8964     buflen = 1024;
8965     maxlen = totread = 0;
8966     while (1) {
8967         if (maxlen < totread+buflen+1) {
8968             maxlen = totread+buflen+1;
8969             prg = Jim_Realloc(prg, maxlen);
8970         }
8971                 /* do not use Jim_fread() - this is really a file */
8972         if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8973         totread += nread;
8974     }
8975     prg[totread] = '\0';
8976         /* do not use Jim_fclose() - this is really a file */
8977     fclose(fp);
8978
8979     scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8980     JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8981     Jim_IncrRefCount(scriptObjPtr);
8982     retval = Jim_EvalObj(interp, scriptObjPtr);
8983     Jim_DecrRefCount(interp, scriptObjPtr);
8984     return retval;
8985 }
8986
8987 /* -----------------------------------------------------------------------------
8988  * Subst
8989  * ---------------------------------------------------------------------------*/
8990 static int JimParseSubstStr(struct JimParserCtx *pc)
8991 {
8992     pc->tstart = pc->p;
8993     pc->tline = pc->linenr;
8994     while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8995         pc->p++; pc->len--;
8996     }
8997     pc->tend = pc->p-1;
8998     pc->tt = JIM_TT_ESC;
8999     return JIM_OK;
9000 }
9001
9002 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9003 {
9004     int retval;
9005
9006     if (pc->len == 0) {
9007         pc->tstart = pc->tend = pc->p;
9008         pc->tline = pc->linenr;
9009         pc->tt = JIM_TT_EOL;
9010         pc->eof = 1;
9011         return JIM_OK;
9012     }
9013     switch(*pc->p) {
9014     case '[':
9015         retval = JimParseCmd(pc);
9016         if (flags & JIM_SUBST_NOCMD) {
9017             pc->tstart--;
9018             pc->tend++;
9019             pc->tt = (flags & JIM_SUBST_NOESC) ?
9020                 JIM_TT_STR : JIM_TT_ESC;
9021         }
9022         return retval;
9023         break;
9024     case '$':
9025         if (JimParseVar(pc) == JIM_ERR) {
9026             pc->tstart = pc->tend = pc->p++; pc->len--;
9027             pc->tline = pc->linenr;
9028             pc->tt = JIM_TT_STR;
9029         } else {
9030             if (flags & JIM_SUBST_NOVAR) {
9031                 pc->tstart--;
9032                 if (flags & JIM_SUBST_NOESC)
9033                     pc->tt = JIM_TT_STR;
9034                 else
9035                     pc->tt = JIM_TT_ESC;
9036                 if (*pc->tstart == '{') {
9037                     pc->tstart--;
9038                     if (*(pc->tend+1))
9039                         pc->tend++;
9040                 }
9041             }
9042         }
9043         break;
9044     default:
9045         retval = JimParseSubstStr(pc);
9046         if (flags & JIM_SUBST_NOESC)
9047             pc->tt = JIM_TT_STR;
9048         return retval;
9049         break;
9050     }
9051     return JIM_OK;
9052 }
9053
9054 /* The subst object type reuses most of the data structures and functions
9055  * of the script object. Script's data structures are a bit more complex
9056  * for what is needed for [subst]itution tasks, but the reuse helps to
9057  * deal with a single data structure at the cost of some more memory
9058  * usage for substitutions. */
9059 static Jim_ObjType substObjType = {
9060     "subst",
9061     FreeScriptInternalRep,
9062     DupScriptInternalRep,
9063     NULL,
9064     JIM_TYPE_REFERENCES,
9065 };
9066
9067 /* This method takes the string representation of an object
9068  * as a Tcl string where to perform [subst]itution, and generates
9069  * the pre-parsed internal representation. */
9070 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9071 {
9072     int scriptTextLen;
9073     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9074     struct JimParserCtx parser;
9075     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9076
9077     script->len = 0;
9078     script->csLen = 0;
9079     script->commands = 0;
9080     script->token = NULL;
9081     script->cmdStruct = NULL;
9082     script->inUse = 1;
9083     script->substFlags = flags;
9084     script->fileName = NULL;
9085
9086     JimParserInit(&parser, scriptText, scriptTextLen, 1);
9087     while(1) {
9088         char *token;
9089         int len, type, linenr;
9090
9091         JimParseSubst(&parser, flags);
9092         if (JimParserEof(&parser)) break;
9093         token = JimParserGetToken(&parser, &len, &type, &linenr);
9094         ScriptObjAddToken(interp, script, token, len, type,
9095                 NULL, linenr);
9096     }
9097     /* Free the old internal rep and set the new one. */
9098     Jim_FreeIntRep(interp, objPtr);
9099     Jim_SetIntRepPtr(objPtr, script);
9100     objPtr->typePtr = &scriptObjType;
9101     return JIM_OK;
9102 }
9103
9104 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9105 {
9106     struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9107
9108     if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9109         SetSubstFromAny(interp, objPtr, flags);
9110     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9111 }
9112
9113 /* Performs commands,variables,blackslashes substitution,
9114  * storing the result object (with refcount 0) into
9115  * resObjPtrPtr. */
9116 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9117         Jim_Obj **resObjPtrPtr, int flags)
9118 {
9119     ScriptObj *script;
9120     ScriptToken *token;
9121     int i, len, retcode = JIM_OK;
9122     Jim_Obj *resObjPtr, *savedResultObjPtr;
9123
9124     script = Jim_GetSubst(interp, substObjPtr, flags);
9125 #ifdef JIM_OPTIMIZATION
9126     /* Fast path for a very common case with array-alike syntax,
9127      * that's: $foo($bar) */
9128     if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9129         Jim_Obj *varObjPtr = script->token[0].objPtr;
9130         
9131         Jim_IncrRefCount(varObjPtr);
9132         resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9133         if (resObjPtr == NULL) {
9134             Jim_DecrRefCount(interp, varObjPtr);
9135             return JIM_ERR;
9136         }
9137         Jim_DecrRefCount(interp, varObjPtr);
9138         *resObjPtrPtr = resObjPtr;
9139         return JIM_OK;
9140     }
9141 #endif
9142
9143     Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9144     /* In order to preserve the internal rep, we increment the
9145      * inUse field of the script internal rep structure. */
9146     script->inUse++;
9147
9148     token = script->token;
9149     len = script->len;
9150
9151     /* Save the interp old result, to set it again before
9152      * to return. */
9153     savedResultObjPtr = interp->result;
9154     Jim_IncrRefCount(savedResultObjPtr);
9155     
9156     /* Perform the substitution. Starts with an empty object
9157      * and adds every token (performing the appropriate
9158      * var/command/escape substitution). */
9159     resObjPtr = Jim_NewStringObj(interp, "", 0);
9160     for (i = 0; i < len; i++) {
9161         Jim_Obj *objPtr;
9162
9163         switch(token[i].type) {
9164         case JIM_TT_STR:
9165         case JIM_TT_ESC:
9166             Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9167             break;
9168         case JIM_TT_VAR:
9169             objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9170             if (objPtr == NULL) goto err;
9171             Jim_IncrRefCount(objPtr);
9172             Jim_AppendObj(interp, resObjPtr, objPtr);
9173             Jim_DecrRefCount(interp, objPtr);
9174             break;
9175         case JIM_TT_DICTSUGAR:
9176             objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9177             if (!objPtr) {
9178                 retcode = JIM_ERR;
9179                 goto err;
9180             }
9181             break;
9182         case JIM_TT_CMD:
9183             if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9184                 goto err;
9185             Jim_AppendObj(interp, resObjPtr, interp->result);
9186             break;
9187         default:
9188             Jim_Panic(interp,
9189               "default token type (%d) reached "
9190               "in Jim_SubstObj().", token[i].type);
9191             break;
9192         }
9193     }
9194 ok:
9195     if (retcode == JIM_OK)
9196         Jim_SetResult(interp, savedResultObjPtr);
9197     Jim_DecrRefCount(interp, savedResultObjPtr);
9198     /* Note that we don't have to decrement inUse, because the
9199      * following code transfers our use of the reference again to
9200      * the script object. */
9201     Jim_FreeIntRep(interp, substObjPtr);
9202     substObjPtr->typePtr = &scriptObjType;
9203     Jim_SetIntRepPtr(substObjPtr, script);
9204     Jim_DecrRefCount(interp, substObjPtr);
9205     *resObjPtrPtr = resObjPtr;
9206     return retcode;
9207 err:
9208     Jim_FreeNewObj(interp, resObjPtr);
9209     retcode = JIM_ERR;
9210     goto ok;
9211 }
9212
9213 /* -----------------------------------------------------------------------------
9214  * API Input/Export functions
9215  * ---------------------------------------------------------------------------*/
9216
9217 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9218 {
9219     Jim_HashEntry *he;
9220
9221     he = Jim_FindHashEntry(&interp->stub, funcname);
9222     if (!he)
9223         return JIM_ERR;
9224     memcpy(targetPtrPtr, &he->val, sizeof(void*));
9225     return JIM_OK;
9226 }
9227
9228 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9229 {
9230     return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9231 }
9232
9233 #define JIM_REGISTER_API(name) \
9234     Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9235
9236 void JimRegisterCoreApi(Jim_Interp *interp)
9237 {
9238   interp->getApiFuncPtr = Jim_GetApi;
9239   JIM_REGISTER_API(Alloc);
9240   JIM_REGISTER_API(Free);
9241   JIM_REGISTER_API(Eval);
9242   JIM_REGISTER_API(Eval_Named);
9243   JIM_REGISTER_API(EvalGlobal);
9244   JIM_REGISTER_API(EvalFile);
9245   JIM_REGISTER_API(EvalObj);
9246   JIM_REGISTER_API(EvalObjBackground);
9247   JIM_REGISTER_API(EvalObjVector);
9248   JIM_REGISTER_API(InitHashTable);
9249   JIM_REGISTER_API(ExpandHashTable);
9250   JIM_REGISTER_API(AddHashEntry);
9251   JIM_REGISTER_API(ReplaceHashEntry);
9252   JIM_REGISTER_API(DeleteHashEntry);
9253   JIM_REGISTER_API(FreeHashTable);
9254   JIM_REGISTER_API(FindHashEntry);
9255   JIM_REGISTER_API(ResizeHashTable);
9256   JIM_REGISTER_API(GetHashTableIterator);
9257   JIM_REGISTER_API(NextHashEntry);
9258   JIM_REGISTER_API(NewObj);
9259   JIM_REGISTER_API(FreeObj);
9260   JIM_REGISTER_API(InvalidateStringRep);
9261   JIM_REGISTER_API(InitStringRep);
9262   JIM_REGISTER_API(DuplicateObj);
9263   JIM_REGISTER_API(GetString);
9264   JIM_REGISTER_API(Length);
9265   JIM_REGISTER_API(InvalidateStringRep);
9266   JIM_REGISTER_API(NewStringObj);
9267   JIM_REGISTER_API(NewStringObjNoAlloc);
9268   JIM_REGISTER_API(AppendString);
9269   JIM_REGISTER_API(AppendString_sprintf);
9270   JIM_REGISTER_API(AppendObj);
9271   JIM_REGISTER_API(AppendStrings);
9272   JIM_REGISTER_API(StringEqObj);
9273   JIM_REGISTER_API(StringMatchObj);
9274   JIM_REGISTER_API(StringRangeObj);
9275   JIM_REGISTER_API(FormatString);
9276   JIM_REGISTER_API(CompareStringImmediate);
9277   JIM_REGISTER_API(NewReference);
9278   JIM_REGISTER_API(GetReference);
9279   JIM_REGISTER_API(SetFinalizer);
9280   JIM_REGISTER_API(GetFinalizer);
9281   JIM_REGISTER_API(CreateInterp);
9282   JIM_REGISTER_API(FreeInterp);
9283   JIM_REGISTER_API(GetExitCode);
9284   JIM_REGISTER_API(SetStdin);
9285   JIM_REGISTER_API(SetStdout);
9286   JIM_REGISTER_API(SetStderr);
9287   JIM_REGISTER_API(CreateCommand);
9288   JIM_REGISTER_API(CreateProcedure);
9289   JIM_REGISTER_API(DeleteCommand);
9290   JIM_REGISTER_API(RenameCommand);
9291   JIM_REGISTER_API(GetCommand);
9292   JIM_REGISTER_API(SetVariable);
9293   JIM_REGISTER_API(SetVariableStr);
9294   JIM_REGISTER_API(SetGlobalVariableStr);
9295   JIM_REGISTER_API(SetVariableStrWithStr);
9296   JIM_REGISTER_API(SetVariableLink);
9297   JIM_REGISTER_API(GetVariable);
9298   JIM_REGISTER_API(GetCallFrameByLevel);
9299   JIM_REGISTER_API(Collect);
9300   JIM_REGISTER_API(CollectIfNeeded);
9301   JIM_REGISTER_API(GetIndex);
9302   JIM_REGISTER_API(NewListObj);
9303   JIM_REGISTER_API(ListAppendElement);
9304   JIM_REGISTER_API(ListAppendList);
9305   JIM_REGISTER_API(ListLength);
9306   JIM_REGISTER_API(ListIndex);
9307   JIM_REGISTER_API(SetListIndex);
9308   JIM_REGISTER_API(ConcatObj);
9309   JIM_REGISTER_API(NewDictObj);
9310   JIM_REGISTER_API(DictKey);
9311   JIM_REGISTER_API(DictKeysVector);
9312   JIM_REGISTER_API(GetIndex);
9313   JIM_REGISTER_API(GetReturnCode);
9314   JIM_REGISTER_API(EvalExpression);
9315   JIM_REGISTER_API(GetBoolFromExpr);
9316   JIM_REGISTER_API(GetWide);
9317   JIM_REGISTER_API(GetLong);
9318   JIM_REGISTER_API(SetWide);
9319   JIM_REGISTER_API(NewIntObj);
9320   JIM_REGISTER_API(GetDouble);
9321   JIM_REGISTER_API(SetDouble);
9322   JIM_REGISTER_API(NewDoubleObj);
9323   JIM_REGISTER_API(WrongNumArgs);
9324   JIM_REGISTER_API(SetDictKeysVector);
9325   JIM_REGISTER_API(SubstObj);
9326   JIM_REGISTER_API(RegisterApi);
9327   JIM_REGISTER_API(PrintErrorMessage);
9328   JIM_REGISTER_API(InteractivePrompt);
9329   JIM_REGISTER_API(RegisterCoreCommands);
9330   JIM_REGISTER_API(GetSharedString);
9331   JIM_REGISTER_API(ReleaseSharedString);
9332   JIM_REGISTER_API(Panic);
9333   JIM_REGISTER_API(StrDup);
9334   JIM_REGISTER_API(UnsetVariable);
9335   JIM_REGISTER_API(GetVariableStr);
9336   JIM_REGISTER_API(GetGlobalVariable);
9337   JIM_REGISTER_API(GetGlobalVariableStr);
9338   JIM_REGISTER_API(GetAssocData);
9339   JIM_REGISTER_API(SetAssocData);
9340   JIM_REGISTER_API(DeleteAssocData);
9341   JIM_REGISTER_API(GetEnum);
9342   JIM_REGISTER_API(ScriptIsComplete);
9343   JIM_REGISTER_API(PackageRequire);
9344   JIM_REGISTER_API(PackageProvide);
9345   JIM_REGISTER_API(InitStack);
9346   JIM_REGISTER_API(FreeStack);
9347   JIM_REGISTER_API(StackLen);
9348   JIM_REGISTER_API(StackPush);
9349   JIM_REGISTER_API(StackPop);
9350   JIM_REGISTER_API(StackPeek);
9351   JIM_REGISTER_API(FreeStackElements);
9352   JIM_REGISTER_API(fprintf  );
9353   JIM_REGISTER_API(vfprintf );
9354   JIM_REGISTER_API(fwrite   );
9355   JIM_REGISTER_API(fread    );
9356   JIM_REGISTER_API(fflush   );
9357   JIM_REGISTER_API(fgets    );
9358   JIM_REGISTER_API(GetNvp);
9359   JIM_REGISTER_API(Nvp_name2value);
9360   JIM_REGISTER_API(Nvp_name2value_simple);
9361   JIM_REGISTER_API(Nvp_name2value_obj);
9362   JIM_REGISTER_API(Nvp_name2value_nocase);
9363   JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9364
9365   JIM_REGISTER_API(Nvp_value2name);
9366   JIM_REGISTER_API(Nvp_value2name_simple);
9367   JIM_REGISTER_API(Nvp_value2name_obj);
9368
9369   JIM_REGISTER_API(GetOpt_Setup);
9370   JIM_REGISTER_API(GetOpt_Debug);
9371   JIM_REGISTER_API(GetOpt_Obj);
9372   JIM_REGISTER_API(GetOpt_String);
9373   JIM_REGISTER_API(GetOpt_Double);
9374   JIM_REGISTER_API(GetOpt_Wide);
9375   JIM_REGISTER_API(GetOpt_Nvp);
9376   JIM_REGISTER_API(GetOpt_NvpUnknown);
9377   JIM_REGISTER_API(GetOpt_Enum);
9378   
9379   JIM_REGISTER_API(Debug_ArgvString);
9380   JIM_REGISTER_API(SetResult_sprintf);
9381   JIM_REGISTER_API(SetResult_NvpUnknown);
9382
9383 }
9384
9385 /* -----------------------------------------------------------------------------
9386  * Core commands utility functions
9387  * ---------------------------------------------------------------------------*/
9388 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, 
9389         const char *msg)
9390 {
9391     int i;
9392     Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9393
9394     Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9395     for (i = 0; i < argc; i++) {
9396         Jim_AppendObj(interp, objPtr, argv[i]);
9397         if (!(i+1 == argc && msg[0] == '\0'))
9398             Jim_AppendString(interp, objPtr, " ", 1);
9399     }
9400     Jim_AppendString(interp, objPtr, msg, -1);
9401     Jim_AppendString(interp, objPtr, "\"", 1);
9402     Jim_SetResult(interp, objPtr);
9403 }
9404
9405 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9406 {
9407     Jim_HashTableIterator *htiter;
9408     Jim_HashEntry *he;
9409     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9410     const char *pattern;
9411     int patternLen;
9412     
9413     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9414     htiter = Jim_GetHashTableIterator(&interp->commands);
9415     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9416         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9417                     strlen((const char*)he->key), 0))
9418             continue;
9419         Jim_ListAppendElement(interp, listObjPtr,
9420                 Jim_NewStringObj(interp, he->key, -1));
9421     }
9422     Jim_FreeHashTableIterator(htiter);
9423     return listObjPtr;
9424 }
9425
9426 #define JIM_VARLIST_GLOBALS 0
9427 #define JIM_VARLIST_LOCALS 1
9428 #define JIM_VARLIST_VARS 2
9429
9430 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9431         int mode)
9432 {
9433     Jim_HashTableIterator *htiter;
9434     Jim_HashEntry *he;
9435     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9436     const char *pattern;
9437     int patternLen;
9438     
9439     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9440     if (mode == JIM_VARLIST_GLOBALS) {
9441         htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9442     } else {
9443         /* For [info locals], if we are at top level an emtpy list
9444          * is returned. I don't agree, but we aim at compatibility (SS) */
9445         if (mode == JIM_VARLIST_LOCALS &&
9446             interp->framePtr == interp->topFramePtr)
9447             return listObjPtr;
9448         htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9449     }
9450     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9451         Jim_Var *varPtr = (Jim_Var*) he->val;
9452         if (mode == JIM_VARLIST_LOCALS) {
9453             if (varPtr->linkFramePtr != NULL)
9454                 continue;
9455         }
9456         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9457                     strlen((const char*)he->key), 0))
9458             continue;
9459         Jim_ListAppendElement(interp, listObjPtr,
9460                 Jim_NewStringObj(interp, he->key, -1));
9461     }
9462     Jim_FreeHashTableIterator(htiter);
9463     return listObjPtr;
9464 }
9465
9466 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9467         Jim_Obj **objPtrPtr)
9468 {
9469     Jim_CallFrame *targetCallFrame;
9470
9471     if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9472             != JIM_OK)
9473         return JIM_ERR;
9474     /* No proc call at toplevel callframe */
9475     if (targetCallFrame == interp->topFramePtr) {
9476         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9477         Jim_AppendStrings(interp, Jim_GetResult(interp),
9478                 "bad level \"",
9479                 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9480         return JIM_ERR;
9481     }
9482     *objPtrPtr = Jim_NewListObj(interp,
9483             targetCallFrame->argv,
9484             targetCallFrame->argc);
9485     return JIM_OK;
9486 }
9487
9488 /* -----------------------------------------------------------------------------
9489  * Core commands
9490  * ---------------------------------------------------------------------------*/
9491
9492 /* fake [puts] -- not the real puts, just for debugging. */
9493 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9494         Jim_Obj *const *argv)
9495 {
9496     const char *str;
9497     int len, nonewline = 0;
9498     
9499     if (argc != 2 && argc != 3) {
9500         Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9501         return JIM_ERR;
9502     }
9503     if (argc == 3) {
9504         if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9505         {
9506             Jim_SetResultString(interp, "The second argument must "
9507                     "be -nonewline", -1);
9508             return JIM_OK;
9509         } else {
9510             nonewline = 1;
9511             argv++;
9512         }
9513     }
9514     str = Jim_GetString(argv[1], &len);
9515     Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9516     if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9517     return JIM_OK;
9518 }
9519
9520 /* Helper for [+] and [*] */
9521 static int Jim_AddMulHelper(Jim_Interp *interp, int argc, 
9522         Jim_Obj *const *argv, int op)
9523 {
9524     jim_wide wideValue, res;
9525     double doubleValue, doubleRes;
9526     int i;
9527
9528     res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9529     
9530     for (i = 1; i < argc; i++) {
9531         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9532             goto trydouble;
9533         if (op == JIM_EXPROP_ADD)
9534             res += wideValue;
9535         else
9536             res *= wideValue;
9537     }
9538     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9539     return JIM_OK;
9540 trydouble:
9541     doubleRes = (double) res;
9542     for (;i < argc; i++) {
9543         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9544             return JIM_ERR;
9545         if (op == JIM_EXPROP_ADD)
9546             doubleRes += doubleValue;
9547         else
9548             doubleRes *= doubleValue;
9549     }
9550     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9551     return JIM_OK;
9552 }
9553
9554 /* Helper for [-] and [/] */
9555 static int Jim_SubDivHelper(Jim_Interp *interp, int argc, 
9556         Jim_Obj *const *argv, int op)
9557 {
9558     jim_wide wideValue, res = 0;
9559     double doubleValue, doubleRes = 0;
9560     int i = 2;
9561
9562     if (argc < 2) {
9563         Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9564         return JIM_ERR;
9565     } else if (argc == 2) {
9566         /* The arity = 2 case is different. For [- x] returns -x,
9567          * while [/ x] returns 1/x. */
9568         if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9569             if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9570                     JIM_OK)
9571             {
9572                 return JIM_ERR;
9573             } else {
9574                 if (op == JIM_EXPROP_SUB)
9575                     doubleRes = -doubleValue;
9576                 else
9577                     doubleRes = 1.0/doubleValue;
9578                 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9579                             doubleRes));
9580                 return JIM_OK;
9581             }
9582         }
9583         if (op == JIM_EXPROP_SUB) {
9584             res = -wideValue;
9585             Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9586         } else {
9587             doubleRes = 1.0/wideValue;
9588             Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9589                         doubleRes));
9590         }
9591         return JIM_OK;
9592     } else {
9593         if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9594             if (Jim_GetDouble(interp, argv[1], &doubleRes)
9595                     != JIM_OK) {
9596                 return JIM_ERR;
9597             } else {
9598                 goto trydouble;
9599             }
9600         }
9601     }
9602     for (i = 2; i < argc; i++) {
9603         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9604             doubleRes = (double) res;
9605             goto trydouble;
9606         }
9607         if (op == JIM_EXPROP_SUB)
9608             res -= wideValue;
9609         else
9610             res /= wideValue;
9611     }
9612     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9613     return JIM_OK;
9614 trydouble:
9615     for (;i < argc; i++) {
9616         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9617             return JIM_ERR;
9618         if (op == JIM_EXPROP_SUB)
9619             doubleRes -= doubleValue;
9620         else
9621             doubleRes /= doubleValue;
9622     }
9623     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9624     return JIM_OK;
9625 }
9626
9627
9628 /* [+] */
9629 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9630         Jim_Obj *const *argv)
9631 {
9632     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9633 }
9634
9635 /* [*] */
9636 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9637         Jim_Obj *const *argv)
9638 {
9639     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9640 }
9641
9642 /* [-] */
9643 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9644         Jim_Obj *const *argv)
9645 {
9646     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9647 }
9648
9649 /* [/] */
9650 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9651         Jim_Obj *const *argv)
9652 {
9653     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9654 }
9655
9656 /* [set] */
9657 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9658         Jim_Obj *const *argv)
9659 {
9660     if (argc != 2 && argc != 3) {
9661         Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9662         return JIM_ERR;
9663     }
9664     if (argc == 2) {
9665         Jim_Obj *objPtr;
9666         objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9667         if (!objPtr)
9668             return JIM_ERR;
9669         Jim_SetResult(interp, objPtr);
9670         return JIM_OK;
9671     }
9672     /* argc == 3 case. */
9673     if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9674         return JIM_ERR;
9675     Jim_SetResult(interp, argv[2]);
9676     return JIM_OK;
9677 }
9678
9679 /* [unset] */
9680 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, 
9681         Jim_Obj *const *argv)
9682 {
9683     int i;
9684
9685     if (argc < 2) {
9686         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9687         return JIM_ERR;
9688     }
9689     for (i = 1; i < argc; i++) {
9690         if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9691             return JIM_ERR;
9692     }
9693     return JIM_OK;
9694 }
9695
9696 /* [incr] */
9697 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, 
9698         Jim_Obj *const *argv)
9699 {
9700     jim_wide wideValue, increment = 1;
9701     Jim_Obj *intObjPtr;
9702
9703     if (argc != 2 && argc != 3) {
9704         Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9705         return JIM_ERR;
9706     }
9707     if (argc == 3) {
9708         if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9709             return JIM_ERR;
9710     }
9711     intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9712     if (!intObjPtr) return JIM_ERR;
9713     if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9714         return JIM_ERR;
9715     if (Jim_IsShared(intObjPtr)) {
9716         intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9717         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9718             Jim_FreeNewObj(interp, intObjPtr);
9719             return JIM_ERR;
9720         }
9721     } else {
9722         Jim_SetWide(interp, intObjPtr, wideValue+increment);
9723         /* The following step is required in order to invalidate the
9724          * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9725         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9726             return JIM_ERR;
9727         }
9728     }
9729     Jim_SetResult(interp, intObjPtr);
9730     return JIM_OK;
9731 }
9732
9733 /* [while] */
9734 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, 
9735         Jim_Obj *const *argv)
9736 {
9737     if (argc != 3) {
9738         Jim_WrongNumArgs(interp, 1, argv, "condition body");
9739         return JIM_ERR;
9740     }
9741     /* Try to run a specialized version of while if the expression
9742      * is in one of the following forms:
9743      *
9744      *   $a < CONST, $a < $b
9745      *   $a <= CONST, $a <= $b
9746      *   $a > CONST, $a > $b
9747      *   $a >= CONST, $a >= $b
9748      *   $a != CONST, $a != $b
9749      *   $a == CONST, $a == $b
9750      *   $a
9751      *   !$a
9752      *   CONST
9753      */
9754
9755 #ifdef JIM_OPTIMIZATION
9756     {
9757         ExprByteCode *expr;
9758         Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9759         int exprLen, retval;
9760
9761         /* STEP 1 -- Check if there are the conditions to run the specialized
9762          * version of while */
9763         
9764         if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9765         if (expr->len <= 0 || expr->len > 3) goto noopt;
9766         switch(expr->len) {
9767         case 1:
9768             if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9769                 expr->opcode[0] != JIM_EXPROP_NUMBER)
9770                 goto noopt;
9771             break;
9772         case 2:
9773             if (expr->opcode[1] != JIM_EXPROP_NOT ||
9774                 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9775                 goto noopt;
9776             break;
9777         case 3:
9778             if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9779                 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9780                  expr->opcode[1] != JIM_EXPROP_VARIABLE))
9781                 goto noopt;
9782             switch(expr->opcode[2]) {
9783             case JIM_EXPROP_LT:
9784             case JIM_EXPROP_LTE:
9785             case JIM_EXPROP_GT:
9786             case JIM_EXPROP_GTE:
9787             case JIM_EXPROP_NUMEQ:
9788             case JIM_EXPROP_NUMNE:
9789                 /* nothing to do */
9790                 break;
9791             default:
9792                 goto noopt;
9793             }
9794             break;
9795         default:
9796             Jim_Panic(interp,
9797                 "Unexpected default reached in Jim_WhileCoreCommand()");
9798             break;
9799         }
9800
9801         /* STEP 2 -- conditions meet. Initialization. Take different
9802          * branches for different expression lengths. */
9803         exprLen = expr->len;
9804
9805         if (exprLen == 1) {
9806             jim_wide wideValue;
9807
9808             if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9809                 varAObjPtr = expr->obj[0];
9810                 Jim_IncrRefCount(varAObjPtr);
9811             } else {
9812                 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9813                     goto noopt;
9814             }
9815             while (1) {
9816                 if (varAObjPtr) {
9817                     if (!(objPtr =
9818                                Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9819                         Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9820                     {
9821                         Jim_DecrRefCount(interp, varAObjPtr);
9822                         goto noopt;
9823                     }
9824                 }
9825                 if (!wideValue) break;
9826                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9827                     switch(retval) {
9828                     case JIM_BREAK:
9829                         if (varAObjPtr)
9830                             Jim_DecrRefCount(interp, varAObjPtr);
9831                         goto out;
9832                         break;
9833                     case JIM_CONTINUE:
9834                         continue;
9835                         break;
9836                     default:
9837                         if (varAObjPtr)
9838                             Jim_DecrRefCount(interp, varAObjPtr);
9839                         return retval;
9840                     }
9841                 }
9842             }
9843             if (varAObjPtr)
9844                 Jim_DecrRefCount(interp, varAObjPtr);
9845         } else if (exprLen == 3) {
9846             jim_wide wideValueA, wideValueB, cmpRes = 0;
9847             int cmpType = expr->opcode[2];
9848
9849             varAObjPtr = expr->obj[0];
9850             Jim_IncrRefCount(varAObjPtr);
9851             if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9852                 varBObjPtr = expr->obj[1];
9853                 Jim_IncrRefCount(varBObjPtr);
9854             } else {
9855                 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9856                     goto noopt;
9857             }
9858             while (1) {
9859                 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9860                     Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9861                 {
9862                     Jim_DecrRefCount(interp, varAObjPtr);
9863                     if (varBObjPtr)
9864                         Jim_DecrRefCount(interp, varBObjPtr);
9865                     goto noopt;
9866                 }
9867                 if (varBObjPtr) {
9868                     if (!(objPtr =
9869                                Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9870                         Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9871                     {
9872                         Jim_DecrRefCount(interp, varAObjPtr);
9873                         if (varBObjPtr)
9874                             Jim_DecrRefCount(interp, varBObjPtr);
9875                         goto noopt;
9876                     }
9877                 }
9878                 switch(cmpType) {
9879                 case JIM_EXPROP_LT:
9880                     cmpRes = wideValueA < wideValueB; break;
9881                 case JIM_EXPROP_LTE:
9882                     cmpRes = wideValueA <= wideValueB; break;
9883                 case JIM_EXPROP_GT:
9884                     cmpRes = wideValueA > wideValueB; break;
9885                 case JIM_EXPROP_GTE:
9886                     cmpRes = wideValueA >= wideValueB; break;
9887                 case JIM_EXPROP_NUMEQ:
9888                     cmpRes = wideValueA == wideValueB; break;
9889                 case JIM_EXPROP_NUMNE:
9890                     cmpRes = wideValueA != wideValueB; break;
9891                 }
9892                 if (!cmpRes) break;
9893                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9894                     switch(retval) {
9895                     case JIM_BREAK:
9896                         Jim_DecrRefCount(interp, varAObjPtr);
9897                         if (varBObjPtr)
9898                             Jim_DecrRefCount(interp, varBObjPtr);
9899                         goto out;
9900                         break;
9901                     case JIM_CONTINUE:
9902                         continue;
9903                         break;
9904                     default:
9905                         Jim_DecrRefCount(interp, varAObjPtr);
9906                         if (varBObjPtr)
9907                             Jim_DecrRefCount(interp, varBObjPtr);
9908                         return retval;
9909                     }
9910                 }
9911             }
9912             Jim_DecrRefCount(interp, varAObjPtr);
9913             if (varBObjPtr)
9914                 Jim_DecrRefCount(interp, varBObjPtr);
9915         } else {
9916             /* TODO: case for len == 2 */
9917             goto noopt;
9918         }
9919         Jim_SetEmptyResult(interp);
9920         return JIM_OK;
9921     }
9922 noopt:
9923 #endif
9924
9925     /* The general purpose implementation of while starts here */
9926     while (1) {
9927         int boolean, retval;
9928
9929         if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9930                         &boolean)) != JIM_OK)
9931             return retval;
9932         if (!boolean) break;
9933         if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9934             switch(retval) {
9935             case JIM_BREAK:
9936                 goto out;
9937                 break;
9938             case JIM_CONTINUE:
9939                 continue;
9940                 break;
9941             default:
9942                 return retval;
9943             }
9944         }
9945     }
9946 out:
9947     Jim_SetEmptyResult(interp);
9948     return JIM_OK;
9949 }
9950
9951 /* [for] */
9952 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, 
9953         Jim_Obj *const *argv)
9954 {
9955     int retval;
9956
9957     if (argc != 5) {
9958         Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9959         return JIM_ERR;
9960     }
9961     /* Check if the for is on the form:
9962      *      for {set i CONST} {$i < CONST} {incr i}
9963      *      for {set i CONST} {$i < $j} {incr i}
9964      *      for {set i CONST} {$i <= CONST} {incr i}
9965      *      for {set i CONST} {$i <= $j} {incr i}
9966      * XXX: NOTE: if variable traces are implemented, this optimization
9967      * need to be modified to check for the proc epoch at every variable
9968      * update. */
9969 #ifdef JIM_OPTIMIZATION
9970     {
9971         ScriptObj *initScript, *incrScript;
9972         ExprByteCode *expr;
9973         jim_wide start, stop, currentVal;
9974         unsigned jim_wide procEpoch = interp->procEpoch;
9975         Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9976         int cmpType;
9977         struct Jim_Cmd *cmdPtr;
9978
9979         /* Do it only if there aren't shared arguments */
9980         if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9981             goto evalstart;
9982         initScript = Jim_GetScript(interp, argv[1]);
9983         expr = Jim_GetExpression(interp, argv[2]);
9984         incrScript = Jim_GetScript(interp, argv[3]);
9985
9986         /* Ensure proper lengths to start */
9987         if (initScript->len != 6) goto evalstart;
9988         if (incrScript->len != 4) goto evalstart;
9989         if (expr->len != 3) goto evalstart;
9990         /* Ensure proper token types. */
9991         if (initScript->token[2].type != JIM_TT_ESC ||
9992             initScript->token[4].type != JIM_TT_ESC ||
9993             incrScript->token[2].type != JIM_TT_ESC ||
9994             expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9995             (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9996              expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9997             (expr->opcode[2] != JIM_EXPROP_LT &&
9998              expr->opcode[2] != JIM_EXPROP_LTE))
9999             goto evalstart;
10000         cmpType = expr->opcode[2];
10001         /* Initialization command must be [set] */
10002         cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10003         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10004             goto evalstart;
10005         /* Update command must be incr */
10006         cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10007         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10008             goto evalstart;
10009         /* set, incr, expression must be about the same variable */
10010         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10011                             incrScript->token[2].objPtr, 0))
10012             goto evalstart;
10013         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10014                             expr->obj[0], 0))
10015             goto evalstart;
10016         /* Check that the initialization and comparison are valid integers */
10017         if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10018             goto evalstart;
10019         if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10020             Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10021         {
10022             goto evalstart;
10023         }
10024
10025         /* Initialization */
10026         varNamePtr = expr->obj[0];
10027         if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10028             stopVarNamePtr = expr->obj[1];
10029             Jim_IncrRefCount(stopVarNamePtr);
10030         }
10031         Jim_IncrRefCount(varNamePtr);
10032
10033         /* --- OPTIMIZED FOR --- */
10034         /* Start to loop */
10035         objPtr = Jim_NewIntObj(interp, start);
10036         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10037             Jim_DecrRefCount(interp, varNamePtr);
10038             if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10039             Jim_FreeNewObj(interp, objPtr);
10040             goto evalstart;
10041         }
10042         while (1) {
10043             /* === Check condition === */
10044             /* Common code: */
10045             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10046             if (objPtr == NULL ||
10047                 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10048             {
10049                 Jim_DecrRefCount(interp, varNamePtr);
10050                 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10051                 goto testcond;
10052             }
10053             /* Immediate or Variable? get the 'stop' value if the latter. */
10054             if (stopVarNamePtr) {
10055                 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10056                 if (objPtr == NULL ||
10057                     Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10058                 {
10059                     Jim_DecrRefCount(interp, varNamePtr);
10060                     Jim_DecrRefCount(interp, stopVarNamePtr);
10061                     goto testcond;
10062                 }
10063             }
10064             if (cmpType == JIM_EXPROP_LT) {
10065                 if (currentVal >= stop) break;
10066             } else {
10067                 if (currentVal > stop) break;
10068             }
10069             /* Eval body */
10070             if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10071                 switch(retval) {
10072                 case JIM_BREAK:
10073                     if (stopVarNamePtr)
10074                         Jim_DecrRefCount(interp, stopVarNamePtr);
10075                     Jim_DecrRefCount(interp, varNamePtr);
10076                     goto out;
10077                 case JIM_CONTINUE:
10078                     /* nothing to do */
10079                     break;
10080                 default:
10081                     if (stopVarNamePtr)
10082                         Jim_DecrRefCount(interp, stopVarNamePtr);
10083                     Jim_DecrRefCount(interp, varNamePtr);
10084                     return retval;
10085                 }
10086             }
10087             /* If there was a change in procedures/command continue
10088              * with the usual [for] command implementation */
10089             if (procEpoch != interp->procEpoch) {
10090                 if (stopVarNamePtr)
10091                     Jim_DecrRefCount(interp, stopVarNamePtr);
10092                 Jim_DecrRefCount(interp, varNamePtr);
10093                 goto evalnext;
10094             }
10095             /* Increment */
10096             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10097             if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10098                 objPtr->internalRep.wideValue ++;
10099                 Jim_InvalidateStringRep(objPtr);
10100             } else {
10101                 Jim_Obj *auxObjPtr;
10102
10103                 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10104                     if (stopVarNamePtr)
10105                         Jim_DecrRefCount(interp, stopVarNamePtr);
10106                     Jim_DecrRefCount(interp, varNamePtr);
10107                     goto evalnext;
10108                 }
10109                 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10110                 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10111                     if (stopVarNamePtr)
10112                         Jim_DecrRefCount(interp, stopVarNamePtr);
10113                     Jim_DecrRefCount(interp, varNamePtr);
10114                     Jim_FreeNewObj(interp, auxObjPtr);
10115                     goto evalnext;
10116                 }
10117             }
10118         }
10119         if (stopVarNamePtr)
10120             Jim_DecrRefCount(interp, stopVarNamePtr);
10121         Jim_DecrRefCount(interp, varNamePtr);
10122         Jim_SetEmptyResult(interp);
10123         return JIM_OK;
10124     }
10125 #endif
10126 evalstart:
10127     /* Eval start */
10128     if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10129         return retval;
10130     while (1) {
10131         int boolean;
10132 testcond:
10133         /* Test the condition */
10134         if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10135                 != JIM_OK)
10136             return retval;
10137         if (!boolean) break;
10138         /* Eval body */
10139         if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10140             switch(retval) {
10141             case JIM_BREAK:
10142                 goto out;
10143                 break;
10144             case JIM_CONTINUE:
10145                 /* Nothing to do */
10146                 break;
10147             default:
10148                 return retval;
10149             }
10150         }
10151 evalnext:
10152         /* Eval next */
10153         if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10154             switch(retval) {
10155             case JIM_BREAK:
10156                 goto out;
10157                 break;
10158             case JIM_CONTINUE:
10159                 continue;
10160                 break;
10161             default:
10162                 return retval;
10163             }
10164         }
10165     }
10166 out:
10167     Jim_SetEmptyResult(interp);
10168     return JIM_OK;
10169 }
10170
10171 /* foreach + lmap implementation. */
10172 static int JimForeachMapHelper(Jim_Interp *interp, int argc, 
10173         Jim_Obj *const *argv, int doMap)
10174 {
10175     int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10176     int nbrOfLoops = 0;
10177     Jim_Obj *emptyStr, *script, *mapRes = NULL;
10178
10179     if (argc < 4 || argc % 2 != 0) {
10180         Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10181         return JIM_ERR;
10182     }
10183     if (doMap) {
10184         mapRes = Jim_NewListObj(interp, NULL, 0);
10185         Jim_IncrRefCount(mapRes);
10186     }
10187     emptyStr = Jim_NewEmptyStringObj(interp);
10188     Jim_IncrRefCount(emptyStr);
10189     script = argv[argc-1];            /* Last argument is a script */
10190     nbrOfLists = (argc - 1 - 1) / 2;  /* argc - 'foreach' - script */
10191     listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10192     listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10193     /* Initialize iterators and remember max nbr elements each list */
10194     memset(listsIdx, 0, nbrOfLists * sizeof(int));
10195     /* Remember lengths of all lists and calculate how much rounds to loop */
10196     for (i=0; i < nbrOfLists*2; i += 2) {
10197         div_t cnt;
10198         int count;
10199         Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10200         Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10201         if (listsEnd[i] == 0) {
10202             Jim_SetResultString(interp, "foreach varlist is empty", -1);
10203             goto err;
10204         }
10205         cnt = div(listsEnd[i+1], listsEnd[i]);
10206         count = cnt.quot + (cnt.rem ? 1 : 0);
10207         if (count > nbrOfLoops)
10208             nbrOfLoops = count;
10209     }
10210     for (; nbrOfLoops-- > 0; ) {
10211         for (i=0; i < nbrOfLists; ++i) {
10212             int varIdx = 0, var = i * 2;
10213             while (varIdx < listsEnd[var]) {
10214                 Jim_Obj *varName, *ele;
10215                 int lst = i * 2 + 1;
10216                 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10217                         != JIM_OK)
10218                         goto err;
10219                 if (listsIdx[i] < listsEnd[lst]) {
10220                     if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10221                         != JIM_OK)
10222                         goto err;
10223                     if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10224                         Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10225                         goto err;
10226                     }
10227                     ++listsIdx[i];  /* Remember next iterator of current list */ 
10228                 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10229                     Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10230                     goto err;
10231                 }
10232                 ++varIdx;  /* Next variable */
10233             }
10234         }
10235         switch (result = Jim_EvalObj(interp, script)) {
10236             case JIM_OK:
10237                 if (doMap)
10238                     Jim_ListAppendElement(interp, mapRes, interp->result);
10239                 break;
10240             case JIM_CONTINUE:
10241                 break;
10242             case JIM_BREAK:
10243                 goto out;
10244                 break;
10245             default:
10246                 goto err;
10247         }
10248     }
10249 out:
10250     result = JIM_OK;
10251     if (doMap)
10252         Jim_SetResult(interp, mapRes);
10253     else
10254         Jim_SetEmptyResult(interp);
10255 err:
10256     if (doMap)
10257         Jim_DecrRefCount(interp, mapRes);
10258     Jim_DecrRefCount(interp, emptyStr);
10259     Jim_Free(listsIdx);
10260     Jim_Free(listsEnd);
10261     return result;
10262 }
10263
10264 /* [foreach] */
10265 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, 
10266         Jim_Obj *const *argv)
10267 {
10268     return JimForeachMapHelper(interp, argc, argv, 0);
10269 }
10270
10271 /* [lmap] */
10272 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, 
10273         Jim_Obj *const *argv)
10274 {
10275     return JimForeachMapHelper(interp, argc, argv, 1);
10276 }
10277
10278 /* [if] */
10279 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, 
10280         Jim_Obj *const *argv)
10281 {
10282     int boolean, retval, current = 1, falsebody = 0;
10283     if (argc >= 3) {
10284         while (1) {
10285             /* Far not enough arguments given! */
10286             if (current >= argc) goto err;
10287             if ((retval = Jim_GetBoolFromExpr(interp,
10288                         argv[current++], &boolean))
10289                     != JIM_OK)
10290                 return retval;
10291             /* There lacks something, isn't it? */
10292             if (current >= argc) goto err;
10293             if (Jim_CompareStringImmediate(interp, argv[current],
10294                         "then")) current++;
10295             /* Tsk tsk, no then-clause? */
10296             if (current >= argc) goto err;
10297             if (boolean)
10298                 return Jim_EvalObj(interp, argv[current]);
10299              /* Ok: no else-clause follows */
10300             if (++current >= argc) {
10301                 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));                   
10302                 return JIM_OK;
10303             }
10304             falsebody = current++;
10305             if (Jim_CompareStringImmediate(interp, argv[falsebody],
10306                         "else")) {
10307                 /* IIICKS - else-clause isn't last cmd? */
10308                 if (current != argc-1) goto err;
10309                 return Jim_EvalObj(interp, argv[current]);
10310             } else if (Jim_CompareStringImmediate(interp,
10311                         argv[falsebody], "elseif"))
10312                 /* Ok: elseif follows meaning all the stuff
10313                  * again (how boring...) */
10314                 continue;
10315             /* OOPS - else-clause is not last cmd?*/
10316             else if (falsebody != argc-1)
10317                 goto err;
10318             return Jim_EvalObj(interp, argv[falsebody]);
10319         }
10320         return JIM_OK;
10321     }
10322 err:
10323     Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10324     return JIM_ERR;
10325 }
10326
10327 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10328
10329 /* [switch] */
10330 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, 
10331         Jim_Obj *const *argv)
10332 {
10333     int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10334     Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10335     Jim_Obj *script = 0;
10336     if (argc < 3) goto wrongnumargs;
10337     for (opt=1; opt < argc; ++opt) {
10338         const char *option = Jim_GetString(argv[opt], 0);
10339         if (*option != '-') break;
10340         else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10341         else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10342         else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10343         else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10344         else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10345             if ((argc - opt) < 2) goto wrongnumargs;
10346             command = argv[++opt]; 
10347         } else {
10348             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10349             Jim_AppendStrings(interp, Jim_GetResult(interp),
10350                 "bad option \"", option, "\": must be -exact, -glob, "
10351                 "-regexp, -command procname or --", 0);
10352             goto err;            
10353         }
10354         if ((argc - opt) < 2) goto wrongnumargs;
10355     }
10356     strObj = argv[opt++];
10357     patCount = argc - opt;
10358     if (patCount == 1) {
10359         Jim_Obj **vector;
10360         JimListGetElements(interp, argv[opt], &patCount, &vector);
10361         caseList = vector;
10362     } else
10363         caseList = &argv[opt];
10364     if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10365     for (i=0; script == 0 && i < patCount; i += 2) {
10366         Jim_Obj *patObj = caseList[i];
10367         if (!Jim_CompareStringImmediate(interp, patObj, "default")
10368             || i < (patCount-2)) {
10369             switch (matchOpt) {
10370                 case SWITCH_EXACT:
10371                     if (Jim_StringEqObj(strObj, patObj, 0))
10372                         script = caseList[i+1];
10373                     break;
10374                 case SWITCH_GLOB:
10375                     if (Jim_StringMatchObj(patObj, strObj, 0))
10376                         script = caseList[i+1];
10377                     break;
10378                 case SWITCH_RE:
10379                     command = Jim_NewStringObj(interp, "regexp", -1);
10380                     /* Fall thru intentionally */
10381                 case SWITCH_CMD: {
10382                     Jim_Obj *parms[] = {command, patObj, strObj};
10383                     int rc = Jim_EvalObjVector(interp, 3, parms);
10384                     long matching;
10385                     /* After the execution of a command we need to
10386                      * make sure to reconvert the object into a list
10387                      * again. Only for the single-list style [switch]. */
10388                     if (argc-opt == 1) {
10389                         Jim_Obj **vector;
10390                         JimListGetElements(interp, argv[opt], &patCount,
10391                                 &vector);
10392                         caseList = vector;
10393                     }
10394                     /* command is here already decref'd */
10395                     if (rc != JIM_OK) {
10396                         retcode = rc;
10397                         goto err;
10398                     }
10399                     rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10400                     if (rc != JIM_OK) {
10401                         retcode = rc;
10402                         goto err;
10403                     }
10404                     if (matching)
10405                         script = caseList[i+1];
10406                     break;
10407                 }
10408                 default:
10409                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10410                     Jim_AppendStrings(interp, Jim_GetResult(interp),
10411                         "internal error: no such option implemented", 0);
10412                     goto err;
10413             }
10414         } else {
10415           script = caseList[i+1];
10416         }
10417     }
10418     for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10419         i += 2)
10420         script = caseList[i+1];
10421     if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10422         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10423         Jim_AppendStrings(interp, Jim_GetResult(interp),
10424             "no body specified for pattern \"",
10425             Jim_GetString(caseList[i-2], 0), "\"", 0);
10426         goto err;
10427     }
10428     retcode = JIM_OK;
10429     Jim_SetEmptyResult(interp);
10430     if (script != 0)
10431         retcode = Jim_EvalObj(interp, script);
10432     return retcode;
10433 wrongnumargs:
10434     Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10435         "pattern body ... ?default body?   or   "
10436         "{pattern body ?pattern body ...?}");
10437 err:
10438     return retcode;        
10439 }
10440
10441 /* [list] */
10442 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, 
10443         Jim_Obj *const *argv)
10444 {
10445     Jim_Obj *listObjPtr;
10446
10447     listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10448     Jim_SetResult(interp, listObjPtr);
10449     return JIM_OK;
10450 }
10451
10452 /* [lindex] */
10453 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, 
10454         Jim_Obj *const *argv)
10455 {
10456     Jim_Obj *objPtr, *listObjPtr;
10457     int i;
10458     int index;
10459
10460     if (argc < 3) {
10461         Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10462         return JIM_ERR;
10463     }
10464     objPtr = argv[1];
10465     Jim_IncrRefCount(objPtr);
10466     for (i = 2; i < argc; i++) {
10467         listObjPtr = objPtr;
10468         if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10469             Jim_DecrRefCount(interp, listObjPtr);
10470             return JIM_ERR;
10471         }
10472         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10473                     JIM_NONE) != JIM_OK) {
10474             /* Returns an empty object if the index
10475              * is out of range. */
10476             Jim_DecrRefCount(interp, listObjPtr);
10477             Jim_SetEmptyResult(interp);
10478             return JIM_OK;
10479         }
10480         Jim_IncrRefCount(objPtr);
10481         Jim_DecrRefCount(interp, listObjPtr);
10482     }
10483     Jim_SetResult(interp, objPtr);
10484     Jim_DecrRefCount(interp, objPtr);
10485     return JIM_OK;
10486 }
10487
10488 /* [llength] */
10489 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, 
10490         Jim_Obj *const *argv)
10491 {
10492     int len;
10493
10494     if (argc != 2) {
10495         Jim_WrongNumArgs(interp, 1, argv, "list");
10496         return JIM_ERR;
10497     }
10498     Jim_ListLength(interp, argv[1], &len);
10499     Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10500     return JIM_OK;
10501 }
10502
10503 /* [lappend] */
10504 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, 
10505         Jim_Obj *const *argv)
10506 {
10507     Jim_Obj *listObjPtr;
10508     int shared, i;
10509
10510     if (argc < 2) {
10511         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10512         return JIM_ERR;
10513     }
10514     listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10515     if (!listObjPtr) {
10516         /* Create the list if it does not exists */
10517         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10518         if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10519             Jim_FreeNewObj(interp, listObjPtr);
10520             return JIM_ERR;
10521         }
10522     }
10523     shared = Jim_IsShared(listObjPtr);
10524     if (shared)
10525         listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10526     for (i = 2; i < argc; i++)
10527         Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10528     if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10529         if (shared)
10530             Jim_FreeNewObj(interp, listObjPtr);
10531         return JIM_ERR;
10532     }
10533     Jim_SetResult(interp, listObjPtr);
10534     return JIM_OK;
10535 }
10536
10537 /* [linsert] */
10538 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, 
10539         Jim_Obj *const *argv)
10540 {
10541     int index, len;
10542     Jim_Obj *listPtr;
10543
10544     if (argc < 4) {
10545         Jim_WrongNumArgs(interp, 1, argv, "list index element "
10546             "?element ...?");
10547         return JIM_ERR;
10548     }
10549     listPtr = argv[1];
10550     if (Jim_IsShared(listPtr))
10551         listPtr = Jim_DuplicateObj(interp, listPtr);
10552     if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10553         goto err;
10554     Jim_ListLength(interp, listPtr, &len);
10555     if (index >= len)
10556         index = len;
10557     else if (index < 0)
10558         index = len + index + 1;
10559     Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10560     Jim_SetResult(interp, listPtr);
10561     return JIM_OK;
10562 err:
10563     if (listPtr != argv[1]) {
10564         Jim_FreeNewObj(interp, listPtr);
10565     }
10566     return JIM_ERR;
10567 }
10568
10569 /* [lset] */
10570 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, 
10571         Jim_Obj *const *argv)
10572 {
10573     if (argc < 3) {
10574         Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10575         return JIM_ERR;
10576     } else if (argc == 3) {
10577         if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10578             return JIM_ERR;
10579         Jim_SetResult(interp, argv[2]);
10580         return JIM_OK;
10581     }
10582     if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10583             == JIM_ERR) return JIM_ERR;
10584     return JIM_OK;
10585 }
10586
10587 /* [lsort] */
10588 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10589 {
10590     const char *options[] = {
10591         "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10592     };
10593     enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10594     Jim_Obj *resObj;
10595     int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10596     int decreasing = 0;
10597
10598     if (argc < 2) {
10599         Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10600         return JIM_ERR;
10601     }
10602     for (i = 1; i < (argc-1); i++) {
10603         int option;
10604
10605         if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10606                 != JIM_OK)
10607             return JIM_ERR;
10608         switch(option) {
10609         case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10610         case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10611         case OPT_INCREASING: decreasing = 0; break;
10612         case OPT_DECREASING: decreasing = 1; break;
10613         }
10614     }
10615     if (decreasing) {
10616         switch(lsortType) {
10617         case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10618         case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10619         }
10620     }
10621     resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10622     ListSortElements(interp, resObj, lsortType);
10623     Jim_SetResult(interp, resObj);
10624     return JIM_OK;
10625 }
10626
10627 /* [append] */
10628 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, 
10629         Jim_Obj *const *argv)
10630 {
10631     Jim_Obj *stringObjPtr;
10632     int shared, i;
10633
10634     if (argc < 2) {
10635         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10636         return JIM_ERR;
10637     }
10638     if (argc == 2) {
10639         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10640         if (!stringObjPtr) return JIM_ERR;
10641     } else {
10642         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10643         if (!stringObjPtr) {
10644             /* Create the string if it does not exists */
10645             stringObjPtr = Jim_NewEmptyStringObj(interp);
10646             if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10647                     != JIM_OK) {
10648                 Jim_FreeNewObj(interp, stringObjPtr);
10649                 return JIM_ERR;
10650             }
10651         }
10652     }
10653     shared = Jim_IsShared(stringObjPtr);
10654     if (shared)
10655         stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10656     for (i = 2; i < argc; i++)
10657         Jim_AppendObj(interp, stringObjPtr, argv[i]);
10658     if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10659         if (shared)
10660             Jim_FreeNewObj(interp, stringObjPtr);
10661         return JIM_ERR;
10662     }
10663     Jim_SetResult(interp, stringObjPtr);
10664     return JIM_OK;
10665 }
10666
10667 /* [debug] */
10668 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, 
10669         Jim_Obj *const *argv)
10670 {
10671     const char *options[] = {
10672         "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10673         "exprbc",
10674         NULL
10675     };
10676     enum {
10677         OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10678         OPT_EXPRLEN, OPT_EXPRBC
10679     };
10680     int option;
10681
10682     if (argc < 2) {
10683         Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10684         return JIM_ERR;
10685     }
10686     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10687                 JIM_ERRMSG) != JIM_OK)
10688         return JIM_ERR;
10689     if (option == OPT_REFCOUNT) {
10690         if (argc != 3) {
10691             Jim_WrongNumArgs(interp, 2, argv, "object");
10692             return JIM_ERR;
10693         }
10694         Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10695         return JIM_OK;
10696     } else if (option == OPT_OBJCOUNT) {
10697         int freeobj = 0, liveobj = 0;
10698         char buf[256];
10699         Jim_Obj *objPtr;
10700
10701         if (argc != 2) {
10702             Jim_WrongNumArgs(interp, 2, argv, "");
10703             return JIM_ERR;
10704         }
10705         /* Count the number of free objects. */
10706         objPtr = interp->freeList;
10707         while (objPtr) {
10708             freeobj++;
10709             objPtr = objPtr->nextObjPtr;
10710         }
10711         /* Count the number of live objects. */
10712         objPtr = interp->liveList;
10713         while (objPtr) {
10714             liveobj++;
10715             objPtr = objPtr->nextObjPtr;
10716         }
10717         /* Set the result string and return. */
10718         sprintf(buf, "free %d used %d", freeobj, liveobj);
10719         Jim_SetResultString(interp, buf, -1);
10720         return JIM_OK;
10721     } else if (option == OPT_OBJECTS) {
10722         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10723         /* Count the number of live objects. */
10724         objPtr = interp->liveList;
10725         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10726         while (objPtr) {
10727             char buf[128];
10728             const char *type = objPtr->typePtr ?
10729                 objPtr->typePtr->name : "";
10730             subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10731             sprintf(buf, "%p", objPtr);
10732             Jim_ListAppendElement(interp, subListObjPtr,
10733                 Jim_NewStringObj(interp, buf, -1));
10734             Jim_ListAppendElement(interp, subListObjPtr,
10735                 Jim_NewStringObj(interp, type, -1));
10736             Jim_ListAppendElement(interp, subListObjPtr,
10737                 Jim_NewIntObj(interp, objPtr->refCount));
10738             Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10739             Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10740             objPtr = objPtr->nextObjPtr;
10741         }
10742         Jim_SetResult(interp, listObjPtr);
10743         return JIM_OK;
10744     } else if (option == OPT_INVSTR) {
10745         Jim_Obj *objPtr;
10746
10747         if (argc != 3) {
10748             Jim_WrongNumArgs(interp, 2, argv, "object");
10749             return JIM_ERR;
10750         }
10751         objPtr = argv[2];
10752         if (objPtr->typePtr != NULL)
10753             Jim_InvalidateStringRep(objPtr);
10754         Jim_SetEmptyResult(interp);
10755         return JIM_OK;
10756     } else if (option == OPT_SCRIPTLEN) {
10757         ScriptObj *script;
10758         if (argc != 3) {
10759             Jim_WrongNumArgs(interp, 2, argv, "script");
10760             return JIM_ERR;
10761         }
10762         script = Jim_GetScript(interp, argv[2]);
10763         Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10764         return JIM_OK;
10765     } else if (option == OPT_EXPRLEN) {
10766         ExprByteCode *expr;
10767         if (argc != 3) {
10768             Jim_WrongNumArgs(interp, 2, argv, "expression");
10769             return JIM_ERR;
10770         }
10771         expr = Jim_GetExpression(interp, argv[2]);
10772         if (expr == NULL)
10773             return JIM_ERR;
10774         Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10775         return JIM_OK;
10776     } else if (option == OPT_EXPRBC) {
10777         Jim_Obj *objPtr;
10778         ExprByteCode *expr;
10779         int i;
10780
10781         if (argc != 3) {
10782             Jim_WrongNumArgs(interp, 2, argv, "expression");
10783             return JIM_ERR;
10784         }
10785         expr = Jim_GetExpression(interp, argv[2]);
10786         if (expr == NULL)
10787             return JIM_ERR;
10788         objPtr = Jim_NewListObj(interp, NULL, 0);
10789         for (i = 0; i < expr->len; i++) {
10790             const char *type;
10791             Jim_ExprOperator *op;
10792
10793             switch(expr->opcode[i]) {
10794             case JIM_EXPROP_NUMBER: type = "number"; break;
10795             case JIM_EXPROP_COMMAND: type = "command"; break;
10796             case JIM_EXPROP_VARIABLE: type = "variable"; break;
10797             case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10798             case JIM_EXPROP_SUBST: type = "subst"; break;
10799             case JIM_EXPROP_STRING: type = "string"; break;
10800             default:
10801                 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10802                 if (op == NULL) {
10803                     type = "private";
10804                 } else {
10805                     type = "operator";
10806                 }
10807                 break;
10808             }
10809             Jim_ListAppendElement(interp, objPtr,
10810                     Jim_NewStringObj(interp, type, -1));
10811             Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10812         }
10813         Jim_SetResult(interp, objPtr);
10814         return JIM_OK;
10815     } else {
10816         Jim_SetResultString(interp,
10817             "bad option. Valid options are refcount, "
10818             "objcount, objects, invstr", -1);
10819         return JIM_ERR;
10820     }
10821     return JIM_OK; /* unreached */
10822 }
10823
10824 /* [eval] */
10825 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, 
10826         Jim_Obj *const *argv)
10827 {
10828     if (argc == 2) {
10829         return Jim_EvalObj(interp, argv[1]);
10830     } else if (argc > 2) {
10831         Jim_Obj *objPtr;
10832         int retcode;
10833
10834         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10835         Jim_IncrRefCount(objPtr);
10836         retcode = Jim_EvalObj(interp, objPtr);
10837         Jim_DecrRefCount(interp, objPtr);
10838         return retcode;
10839     } else {
10840         Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10841         return JIM_ERR;
10842     }
10843 }
10844
10845 /* [uplevel] */
10846 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, 
10847         Jim_Obj *const *argv)
10848 {
10849     if (argc >= 2) {
10850         int retcode, newLevel, oldLevel;
10851         Jim_CallFrame *savedCallFrame, *targetCallFrame;
10852         Jim_Obj *objPtr;
10853         const char *str;
10854
10855         /* Save the old callframe pointer */
10856         savedCallFrame = interp->framePtr;
10857
10858         /* Lookup the target frame pointer */
10859         str = Jim_GetString(argv[1], NULL);
10860         if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10861         {
10862             if (Jim_GetCallFrameByLevel(interp, argv[1],
10863                         &targetCallFrame,
10864                         &newLevel) != JIM_OK)
10865                 return JIM_ERR;
10866             argc--;
10867             argv++;
10868         } else {
10869             if (Jim_GetCallFrameByLevel(interp, NULL,
10870                         &targetCallFrame,
10871                         &newLevel) != JIM_OK)
10872                 return JIM_ERR;
10873         }
10874         if (argc < 2) {
10875             argc++;
10876             argv--;
10877             Jim_WrongNumArgs(interp, 1, argv,
10878                     "?level? command ?arg ...?");
10879             return JIM_ERR;
10880         }
10881         /* Eval the code in the target callframe. */
10882         interp->framePtr = targetCallFrame;
10883         oldLevel = interp->numLevels;
10884         interp->numLevels = newLevel;
10885         if (argc == 2) {
10886             retcode = Jim_EvalObj(interp, argv[1]);
10887         } else {
10888             objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10889             Jim_IncrRefCount(objPtr);
10890             retcode = Jim_EvalObj(interp, objPtr);
10891             Jim_DecrRefCount(interp, objPtr);
10892         }
10893         interp->numLevels = oldLevel;
10894         interp->framePtr = savedCallFrame;
10895         return retcode;
10896     } else {
10897         Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10898         return JIM_ERR;
10899     }
10900 }
10901
10902 /* [expr] */
10903 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, 
10904         Jim_Obj *const *argv)
10905 {
10906     Jim_Obj *exprResultPtr;
10907     int retcode;
10908
10909     if (argc == 2) {
10910         retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10911     } else if (argc > 2) {
10912         Jim_Obj *objPtr;
10913
10914         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10915         Jim_IncrRefCount(objPtr);
10916         retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10917         Jim_DecrRefCount(interp, objPtr);
10918     } else {
10919         Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10920         return JIM_ERR;
10921     }
10922     if (retcode != JIM_OK) return retcode;
10923     Jim_SetResult(interp, exprResultPtr);
10924     Jim_DecrRefCount(interp, exprResultPtr);
10925     return JIM_OK;
10926 }
10927
10928 /* [break] */
10929 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, 
10930         Jim_Obj *const *argv)
10931 {
10932     if (argc != 1) {
10933         Jim_WrongNumArgs(interp, 1, argv, "");
10934         return JIM_ERR;
10935     }
10936     return JIM_BREAK;
10937 }
10938
10939 /* [continue] */
10940 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10941         Jim_Obj *const *argv)
10942 {
10943     if (argc != 1) {
10944         Jim_WrongNumArgs(interp, 1, argv, "");
10945         return JIM_ERR;
10946     }
10947     return JIM_CONTINUE;
10948 }
10949
10950 /* [return] */
10951 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, 
10952         Jim_Obj *const *argv)
10953 {
10954     if (argc == 1) {
10955         return JIM_RETURN;
10956     } else if (argc == 2) {
10957         Jim_SetResult(interp, argv[1]);
10958         interp->returnCode = JIM_OK;
10959         return JIM_RETURN;
10960     } else if (argc == 3 || argc == 4) {
10961         int returnCode;
10962         if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10963             return JIM_ERR;
10964         interp->returnCode = returnCode;
10965         if (argc == 4)
10966             Jim_SetResult(interp, argv[3]);
10967         return JIM_RETURN;
10968     } else {
10969         Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10970         return JIM_ERR;
10971     }
10972     return JIM_RETURN; /* unreached */
10973 }
10974
10975 /* [tailcall] */
10976 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10977         Jim_Obj *const *argv)
10978 {
10979     Jim_Obj *objPtr;
10980
10981     objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10982     Jim_SetResult(interp, objPtr);
10983     return JIM_EVAL;
10984 }
10985
10986 /* [proc] */
10987 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, 
10988         Jim_Obj *const *argv)
10989 {
10990     int argListLen;
10991     int arityMin, arityMax;
10992
10993     if (argc != 4 && argc != 5) {
10994         Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10995         return JIM_ERR;
10996     }
10997     Jim_ListLength(interp, argv[2], &argListLen);
10998     arityMin = arityMax = argListLen+1;
10999
11000     if (argListLen) {
11001         const char *str;
11002         int len;
11003         Jim_Obj *argPtr;
11004         
11005         /* Check for 'args' and adjust arityMin and arityMax if necessary */
11006         Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11007         str = Jim_GetString(argPtr, &len);
11008         if (len == 4 && memcmp(str, "args", 4) == 0) {
11009             arityMin--;
11010             arityMax = -1;
11011         }
11012
11013         /* Check for default arguments and reduce arityMin if necessary */
11014         while (arityMin > 1) {
11015             int len;
11016             Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11017             Jim_ListLength(interp, argPtr, &len);
11018             if (len != 2) {
11019                 /* No default argument */
11020                 break;
11021             }
11022             arityMin--;
11023         }
11024     }
11025     if (argc == 4) {
11026         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11027                 argv[2], NULL, argv[3], arityMin, arityMax);
11028     } else {
11029         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11030                 argv[2], argv[3], argv[4], arityMin, arityMax);
11031     }
11032 }
11033
11034 /* [concat] */
11035 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, 
11036         Jim_Obj *const *argv)
11037 {
11038     Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11039     return JIM_OK;
11040 }
11041
11042 /* [upvar] */
11043 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, 
11044         Jim_Obj *const *argv)
11045 {
11046     const char *str;
11047     int i;
11048     Jim_CallFrame *targetCallFrame;
11049
11050     /* Lookup the target frame pointer */
11051     str = Jim_GetString(argv[1], NULL);
11052     if (argc > 3 && 
11053         ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11054     {
11055         if (Jim_GetCallFrameByLevel(interp, argv[1],
11056                     &targetCallFrame, NULL) != JIM_OK)
11057             return JIM_ERR;
11058         argc--;
11059         argv++;
11060     } else {
11061         if (Jim_GetCallFrameByLevel(interp, NULL,
11062                     &targetCallFrame, NULL) != JIM_OK)
11063             return JIM_ERR;
11064     }
11065     /* Check for arity */
11066     if (argc < 3 || ((argc-1)%2) != 0) {
11067         Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11068         return JIM_ERR;
11069     }
11070     /* Now... for every other/local couple: */
11071     for (i = 1; i < argc; i += 2) {
11072         if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11073                 targetCallFrame) != JIM_OK) return JIM_ERR;
11074     }
11075     return JIM_OK;
11076 }
11077
11078 /* [global] */
11079 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, 
11080         Jim_Obj *const *argv)
11081 {
11082     int i;
11083
11084     if (argc < 2) {
11085         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11086         return JIM_ERR;
11087     }
11088     /* Link every var to the toplevel having the same name */
11089     if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11090     for (i = 1; i < argc; i++) {
11091         if (Jim_SetVariableLink(interp, argv[i], argv[i],
11092                 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11093     }
11094     return JIM_OK;
11095 }
11096
11097 /* does the [string map] operation. On error NULL is returned,
11098  * otherwise a new string object with the result, having refcount = 0,
11099  * is returned. */
11100 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11101         Jim_Obj *objPtr, int nocase)
11102 {
11103     int numMaps;
11104     const char **key, *str, *noMatchStart = NULL;
11105     Jim_Obj **value;
11106     int *keyLen, strLen, i;
11107     Jim_Obj *resultObjPtr;
11108     
11109     Jim_ListLength(interp, mapListObjPtr, &numMaps);
11110     if (numMaps % 2) {
11111         Jim_SetResultString(interp,
11112                 "list must contain an even number of elements", -1);
11113         return NULL;
11114     }
11115     /* Initialization */
11116     numMaps /= 2;
11117     key = Jim_Alloc(sizeof(char*)*numMaps);
11118     keyLen = Jim_Alloc(sizeof(int)*numMaps);
11119     value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11120     resultObjPtr = Jim_NewStringObj(interp, "", 0);
11121     for (i = 0; i < numMaps; i++) {
11122         Jim_Obj *eleObjPtr;
11123
11124         Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11125         key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11126         Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11127         value[i] = eleObjPtr;
11128     }
11129     str = Jim_GetString(objPtr, &strLen);
11130     /* Map it */
11131     while(strLen) {
11132         for (i = 0; i < numMaps; i++) {
11133             if (strLen >= keyLen[i] && keyLen[i]) {
11134                 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11135                             nocase))
11136                 {
11137                     if (noMatchStart) {
11138                         Jim_AppendString(interp, resultObjPtr,
11139                                 noMatchStart, str-noMatchStart);
11140                         noMatchStart = NULL;
11141                     }
11142                     Jim_AppendObj(interp, resultObjPtr, value[i]);
11143                     str += keyLen[i];
11144                     strLen -= keyLen[i];
11145                     break;
11146                 }
11147             }
11148         }
11149         if (i == numMaps) { /* no match */
11150             if (noMatchStart == NULL)
11151                 noMatchStart = str;
11152             str ++;
11153             strLen --;
11154         }
11155     }
11156     if (noMatchStart) {
11157         Jim_AppendString(interp, resultObjPtr,
11158             noMatchStart, str-noMatchStart);
11159     }
11160     Jim_Free((void*)key);
11161     Jim_Free(keyLen);
11162     Jim_Free(value);
11163     return resultObjPtr;
11164 }
11165
11166 /* [string] */
11167 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, 
11168         Jim_Obj *const *argv)
11169 {
11170     int option;
11171     const char *options[] = {
11172         "length", "compare", "match", "equal", "range", "map", "repeat",
11173         "index", "first", "tolower", "toupper", NULL
11174     };
11175     enum {
11176         OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11177         OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11178     };
11179
11180     if (argc < 2) {
11181         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11182         return JIM_ERR;
11183     }
11184     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11185                 JIM_ERRMSG) != JIM_OK)
11186         return JIM_ERR;
11187
11188     if (option == OPT_LENGTH) {
11189         int len;
11190
11191         if (argc != 3) {
11192             Jim_WrongNumArgs(interp, 2, argv, "string");
11193             return JIM_ERR;
11194         }
11195         Jim_GetString(argv[2], &len);
11196         Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11197         return JIM_OK;
11198     } else if (option == OPT_COMPARE) {
11199         int nocase = 0;
11200         if ((argc != 4 && argc != 5) ||
11201             (argc == 5 && Jim_CompareStringImmediate(interp,
11202                 argv[2], "-nocase") == 0)) {
11203             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11204             return JIM_ERR;
11205         }
11206         if (argc == 5) {
11207             nocase = 1;
11208             argv++;
11209         }
11210         Jim_SetResult(interp, Jim_NewIntObj(interp,
11211                     Jim_StringCompareObj(argv[2],
11212                             argv[3], nocase)));
11213         return JIM_OK;
11214     } else if (option == OPT_MATCH) {
11215         int nocase = 0;
11216         if ((argc != 4 && argc != 5) ||
11217             (argc == 5 && Jim_CompareStringImmediate(interp,
11218                 argv[2], "-nocase") == 0)) {
11219             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11220                     "string");
11221             return JIM_ERR;
11222         }
11223         if (argc == 5) {
11224             nocase = 1;
11225             argv++;
11226         }
11227         Jim_SetResult(interp,
11228             Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11229                     argv[3], nocase)));
11230         return JIM_OK;
11231     } else if (option == OPT_EQUAL) {
11232         if (argc != 4) {
11233             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11234             return JIM_ERR;
11235         }
11236         Jim_SetResult(interp,
11237             Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11238                     argv[3], 0)));
11239         return JIM_OK;
11240     } else if (option == OPT_RANGE) {
11241         Jim_Obj *objPtr;
11242
11243         if (argc != 5) {
11244             Jim_WrongNumArgs(interp, 2, argv, "string first last");
11245             return JIM_ERR;
11246         }
11247         objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11248         if (objPtr == NULL)
11249             return JIM_ERR;
11250         Jim_SetResult(interp, objPtr);
11251         return JIM_OK;
11252     } else if (option == OPT_MAP) {
11253         int nocase = 0;
11254         Jim_Obj *objPtr;
11255
11256         if ((argc != 4 && argc != 5) ||
11257             (argc == 5 && Jim_CompareStringImmediate(interp,
11258                 argv[2], "-nocase") == 0)) {
11259             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11260                     "string");
11261             return JIM_ERR;
11262         }
11263         if (argc == 5) {
11264             nocase = 1;
11265             argv++;
11266         }
11267         objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11268         if (objPtr == NULL)
11269             return JIM_ERR;
11270         Jim_SetResult(interp, objPtr);
11271         return JIM_OK;
11272     } else if (option == OPT_REPEAT) {
11273         Jim_Obj *objPtr;
11274         jim_wide count;
11275
11276         if (argc != 4) {
11277             Jim_WrongNumArgs(interp, 2, argv, "string count");
11278             return JIM_ERR;
11279         }
11280         if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11281             return JIM_ERR;
11282         objPtr = Jim_NewStringObj(interp, "", 0);
11283         while (count--) {
11284             Jim_AppendObj(interp, objPtr, argv[2]);
11285         }
11286         Jim_SetResult(interp, objPtr);
11287         return JIM_OK;
11288     } else if (option == OPT_INDEX) {
11289         int index, len;
11290         const char *str;
11291
11292         if (argc != 4) {
11293             Jim_WrongNumArgs(interp, 2, argv, "string index");
11294             return JIM_ERR;
11295         }
11296         if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11297             return JIM_ERR;
11298         str = Jim_GetString(argv[2], &len);
11299         if (index != INT_MIN && index != INT_MAX)
11300             index = JimRelToAbsIndex(len, index);
11301         if (index < 0 || index >= len) {
11302             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11303             return JIM_OK;
11304         } else {
11305             Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11306             return JIM_OK;
11307         }
11308     } else if (option == OPT_FIRST) {
11309         int index = 0, l1, l2;
11310         const char *s1, *s2;
11311
11312         if (argc != 4 && argc != 5) {
11313             Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11314             return JIM_ERR;
11315         }
11316         s1 = Jim_GetString(argv[2], &l1);
11317         s2 = Jim_GetString(argv[3], &l2);
11318         if (argc == 5) {
11319             if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11320                 return JIM_ERR;
11321             index = JimRelToAbsIndex(l2, index);
11322         }
11323         Jim_SetResult(interp, Jim_NewIntObj(interp,
11324                     JimStringFirst(s1, l1, s2, l2, index)));
11325         return JIM_OK;
11326     } else if (option == OPT_TOLOWER) {
11327         if (argc != 3) {
11328             Jim_WrongNumArgs(interp, 2, argv, "string");
11329             return JIM_ERR;
11330         }
11331         Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11332     } else if (option == OPT_TOUPPER) {
11333         if (argc != 3) {
11334             Jim_WrongNumArgs(interp, 2, argv, "string");
11335             return JIM_ERR;
11336         }
11337         Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11338     }
11339     return JIM_OK;
11340 }
11341
11342 /* [time] */
11343 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, 
11344         Jim_Obj *const *argv)
11345 {
11346     long i, count = 1;
11347     jim_wide start, elapsed;
11348     char buf [256];
11349     const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11350
11351     if (argc < 2) {
11352         Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11353         return JIM_ERR;
11354     }
11355     if (argc == 3) {
11356         if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11357             return JIM_ERR;
11358     }
11359     if (count < 0)
11360         return JIM_OK;
11361     i = count;
11362     start = JimClock();
11363     while (i-- > 0) {
11364         int retval;
11365
11366         if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11367             return retval;
11368     }
11369     elapsed = JimClock() - start;
11370     sprintf(buf, fmt, elapsed/count);
11371     Jim_SetResultString(interp, buf, -1);
11372     return JIM_OK;
11373 }
11374
11375 /* [exit] */
11376 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, 
11377         Jim_Obj *const *argv)
11378 {
11379     long exitCode = 0;
11380
11381     if (argc > 2) {
11382         Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11383         return JIM_ERR;
11384     }
11385     if (argc == 2) {
11386         if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11387             return JIM_ERR;
11388     }
11389     interp->exitCode = exitCode;
11390     return JIM_EXIT;
11391 }
11392
11393 /* [catch] */
11394 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, 
11395         Jim_Obj *const *argv)
11396 {
11397     int exitCode = 0;
11398
11399     if (argc != 2 && argc != 3) {
11400         Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11401         return JIM_ERR;
11402     }
11403     exitCode = Jim_EvalObj(interp, argv[1]);
11404     if (argc == 3) {
11405         if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11406                 != JIM_OK)
11407             return JIM_ERR;
11408     }
11409     Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11410     return JIM_OK;
11411 }
11412
11413 /* [ref] */
11414 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, 
11415         Jim_Obj *const *argv)
11416 {
11417     if (argc != 3 && argc != 4) {
11418         Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11419         return JIM_ERR;
11420     }
11421     if (argc == 3) {
11422         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11423     } else {
11424         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11425                     argv[3]));
11426     }
11427     return JIM_OK;
11428 }
11429
11430 /* [getref] */
11431 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, 
11432         Jim_Obj *const *argv)
11433 {
11434     Jim_Reference *refPtr;
11435
11436     if (argc != 2) {
11437         Jim_WrongNumArgs(interp, 1, argv, "reference");
11438         return JIM_ERR;
11439     }
11440     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11441         return JIM_ERR;
11442     Jim_SetResult(interp, refPtr->objPtr);
11443     return JIM_OK;
11444 }
11445
11446 /* [setref] */
11447 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, 
11448         Jim_Obj *const *argv)
11449 {
11450     Jim_Reference *refPtr;
11451
11452     if (argc != 3) {
11453         Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11454         return JIM_ERR;
11455     }
11456     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11457         return JIM_ERR;
11458     Jim_IncrRefCount(argv[2]);
11459     Jim_DecrRefCount(interp, refPtr->objPtr);
11460     refPtr->objPtr = argv[2];
11461     Jim_SetResult(interp, argv[2]);
11462     return JIM_OK;
11463 }
11464
11465 /* [collect] */
11466 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, 
11467         Jim_Obj *const *argv)
11468 {
11469     if (argc != 1) {
11470         Jim_WrongNumArgs(interp, 1, argv, "");
11471         return JIM_ERR;
11472     }
11473     Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11474     return JIM_OK;
11475 }
11476
11477 /* [finalize] reference ?newValue? */
11478 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, 
11479         Jim_Obj *const *argv)
11480 {
11481     if (argc != 2 && argc != 3) {
11482         Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11483         return JIM_ERR;
11484     }
11485     if (argc == 2) {
11486         Jim_Obj *cmdNamePtr;
11487
11488         if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11489             return JIM_ERR;
11490         if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11491             Jim_SetResult(interp, cmdNamePtr);
11492     } else {
11493         if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11494             return JIM_ERR;
11495         Jim_SetResult(interp, argv[2]);
11496     }
11497     return JIM_OK;
11498 }
11499
11500 /* TODO */
11501 /* [info references] (list of all the references/finalizers) */
11502
11503 /* [rename] */
11504 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, 
11505         Jim_Obj *const *argv)
11506 {
11507     const char *oldName, *newName;
11508
11509     if (argc != 3) {
11510         Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11511         return JIM_ERR;
11512     }
11513     oldName = Jim_GetString(argv[1], NULL);
11514     newName = Jim_GetString(argv[2], NULL);
11515     if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11516         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11517         Jim_AppendStrings(interp, Jim_GetResult(interp),
11518             "can't rename \"", oldName, "\": ",
11519             "command doesn't exist", NULL);
11520         return JIM_ERR;
11521     }
11522     return JIM_OK;
11523 }
11524
11525 /* [dict] */
11526 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, 
11527         Jim_Obj *const *argv)
11528 {
11529     int option;
11530     const char *options[] = {
11531         "create", "get", "set", "unset", "exists", NULL
11532     };
11533     enum {
11534         OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11535     };
11536
11537     if (argc < 2) {
11538         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11539         return JIM_ERR;
11540     }
11541
11542     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11543                 JIM_ERRMSG) != JIM_OK)
11544         return JIM_ERR;
11545
11546     if (option == OPT_CREATE) {
11547         Jim_Obj *objPtr;
11548
11549         if (argc % 2) {
11550             Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11551             return JIM_ERR;
11552         }
11553         objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11554         Jim_SetResult(interp, objPtr);
11555         return JIM_OK;
11556     } else if (option == OPT_GET) {
11557         Jim_Obj *objPtr;
11558
11559         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11560                 JIM_ERRMSG) != JIM_OK)
11561             return JIM_ERR;
11562         Jim_SetResult(interp, objPtr);
11563         return JIM_OK;
11564     } else if (option == OPT_SET) {
11565         if (argc < 5) {
11566             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11567             return JIM_ERR;
11568         }
11569         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11570                     argv[argc-1]);
11571     } else if (option == OPT_UNSET) {
11572         if (argc < 4) {
11573             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11574             return JIM_ERR;
11575         }
11576         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11577                     NULL);
11578     } else if (option == OPT_EXIST) {
11579         Jim_Obj *objPtr;
11580         int exists;
11581
11582         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11583                 JIM_ERRMSG) == JIM_OK)
11584             exists = 1;
11585         else
11586             exists = 0;
11587         Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11588         return JIM_OK;
11589     } else {
11590         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11591         Jim_AppendStrings(interp, Jim_GetResult(interp),
11592             "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11593             " must be create, get, set", NULL);
11594         return JIM_ERR;
11595     }
11596     return JIM_OK;
11597 }
11598
11599 /* [load] */
11600 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, 
11601         Jim_Obj *const *argv)
11602 {
11603     if (argc < 2) {
11604         Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11605         return JIM_ERR;
11606     }
11607     return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11608 }
11609
11610 /* [subst] */
11611 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, 
11612         Jim_Obj *const *argv)
11613 {
11614     int i, flags = 0;
11615     Jim_Obj *objPtr;
11616
11617     if (argc < 2) {
11618         Jim_WrongNumArgs(interp, 1, argv,
11619             "?-nobackslashes? ?-nocommands? ?-novariables? string");
11620         return JIM_ERR;
11621     }
11622     i = argc-2;
11623     while(i--) {
11624         if (Jim_CompareStringImmediate(interp, argv[i+1],
11625                     "-nobackslashes"))
11626             flags |= JIM_SUBST_NOESC;
11627         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11628                     "-novariables"))
11629             flags |= JIM_SUBST_NOVAR;
11630         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11631                     "-nocommands"))
11632             flags |= JIM_SUBST_NOCMD;
11633         else {
11634             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11635             Jim_AppendStrings(interp, Jim_GetResult(interp),
11636                 "bad option \"", Jim_GetString(argv[i+1], NULL),
11637                 "\": must be -nobackslashes, -nocommands, or "
11638                 "-novariables", NULL);
11639             return JIM_ERR;
11640         }
11641     }
11642     if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11643         return JIM_ERR;
11644     Jim_SetResult(interp, objPtr);
11645     return JIM_OK;
11646 }
11647
11648 /* [info] */
11649 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, 
11650         Jim_Obj *const *argv)
11651 {
11652     int cmd, result = JIM_OK;
11653     static const char *commands[] = {
11654         "body", "commands", "exists", "globals", "level", "locals",
11655         "vars", "version", "complete", "args", "hostname", NULL
11656     };
11657     enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11658           INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11659     
11660     if (argc < 2) {
11661         Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11662         return JIM_ERR;
11663     }
11664     if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11665         != JIM_OK) {
11666         return JIM_ERR;
11667     }
11668     
11669     if (cmd == INFO_COMMANDS) {
11670         if (argc != 2 && argc != 3) {
11671             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11672             return JIM_ERR;
11673         }
11674         if (argc == 3)
11675             Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11676         else
11677             Jim_SetResult(interp, JimCommandsList(interp, NULL));
11678     } else if (cmd == INFO_EXISTS) {
11679         Jim_Obj *exists;
11680         if (argc != 3) {
11681             Jim_WrongNumArgs(interp, 2, argv, "varName");
11682             return JIM_ERR;
11683         }
11684         exists = Jim_GetVariable(interp, argv[2], 0);
11685         Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11686     } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11687         int mode;
11688         switch (cmd) {
11689             case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11690             case INFO_LOCALS:  mode = JIM_VARLIST_LOCALS; break;
11691             case INFO_VARS:    mode = JIM_VARLIST_VARS; break;
11692             default: mode = 0; /* avoid warning */; break;
11693         }
11694         if (argc != 2 && argc != 3) {
11695             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11696             return JIM_ERR;
11697         }
11698         if (argc == 3)
11699             Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11700         else
11701             Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11702     } else if (cmd == INFO_LEVEL) {
11703         Jim_Obj *objPtr;
11704         switch (argc) {
11705             case 2:
11706                 Jim_SetResult(interp,
11707                               Jim_NewIntObj(interp, interp->numLevels));
11708                 break;
11709             case 3:
11710                 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11711                     return JIM_ERR;
11712                 Jim_SetResult(interp, objPtr);
11713                 break;
11714             default:
11715                 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11716                 return JIM_ERR;
11717         }
11718     } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11719         Jim_Cmd *cmdPtr;
11720
11721         if (argc != 3) {
11722             Jim_WrongNumArgs(interp, 2, argv, "procname");
11723             return JIM_ERR;
11724         }
11725         if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11726             return JIM_ERR;
11727         if (cmdPtr->cmdProc != NULL) {
11728             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11729             Jim_AppendStrings(interp, Jim_GetResult(interp),
11730                 "command \"", Jim_GetString(argv[2], NULL),
11731                 "\" is not a procedure", NULL);
11732             return JIM_ERR;
11733         }
11734         if (cmd == INFO_BODY)
11735             Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11736         else
11737             Jim_SetResult(interp, cmdPtr->argListObjPtr);
11738     } else if (cmd == INFO_VERSION) {
11739         char buf[(JIM_INTEGER_SPACE * 2) + 1];
11740         sprintf(buf, "%d.%d", 
11741                 JIM_VERSION / 100, JIM_VERSION % 100);
11742         Jim_SetResultString(interp, buf, -1);
11743     } else if (cmd == INFO_COMPLETE) {
11744         const char *s;
11745         int len;
11746
11747         if (argc != 3) {
11748             Jim_WrongNumArgs(interp, 2, argv, "script");
11749             return JIM_ERR;
11750         }
11751         s = Jim_GetString(argv[2], &len);
11752         Jim_SetResult(interp,
11753                 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11754     } else if (cmd == INFO_HOSTNAME) {
11755         /* Redirect to os.hostname if it exists */
11756         Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11757         result = Jim_EvalObjVector(interp, 1, &command);
11758     }
11759     return result;
11760 }
11761
11762 /* [split] */
11763 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, 
11764         Jim_Obj *const *argv)
11765 {
11766     const char *str, *splitChars, *noMatchStart;
11767     int splitLen, strLen, i;
11768     Jim_Obj *resObjPtr;
11769
11770     if (argc != 2 && argc != 3) {
11771         Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11772         return JIM_ERR;
11773     }
11774     /* Init */
11775     if (argc == 2) {
11776         splitChars = " \n\t\r";
11777         splitLen = 4;
11778     } else {
11779         splitChars = Jim_GetString(argv[2], &splitLen);
11780     }
11781     str = Jim_GetString(argv[1], &strLen);
11782     if (!strLen) return JIM_OK;
11783     noMatchStart = str;
11784     resObjPtr = Jim_NewListObj(interp, NULL, 0);
11785     /* Split */
11786     if (splitLen) {
11787         while (strLen) {
11788             for (i = 0; i < splitLen; i++) {
11789                 if (*str == splitChars[i]) {
11790                     Jim_Obj *objPtr;
11791
11792                     objPtr = Jim_NewStringObj(interp, noMatchStart,
11793                             (str-noMatchStart));
11794                     Jim_ListAppendElement(interp, resObjPtr, objPtr);
11795                     noMatchStart = str+1;
11796                     break;
11797                 }
11798             }
11799             str ++;
11800             strLen --;
11801         }
11802         Jim_ListAppendElement(interp, resObjPtr,
11803                 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11804     } else {
11805         /* This handles the special case of splitchars eq {}. This
11806          * is trivial but we want to perform object sharing as Tcl does. */
11807         Jim_Obj *objCache[256];
11808         const unsigned char *u = (unsigned char*) str;
11809         memset(objCache, 0, sizeof(objCache));
11810         for (i = 0; i < strLen; i++) {
11811             int c = u[i];
11812             
11813             if (objCache[c] == NULL)
11814                 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11815             Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11816         }
11817     }
11818     Jim_SetResult(interp, resObjPtr);
11819     return JIM_OK;
11820 }
11821
11822 /* [join] */
11823 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, 
11824         Jim_Obj *const *argv)
11825 {
11826     const char *joinStr;
11827     int joinStrLen, i, listLen;
11828     Jim_Obj *resObjPtr;
11829
11830     if (argc != 2 && argc != 3) {
11831         Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11832         return JIM_ERR;
11833     }
11834     /* Init */
11835     if (argc == 2) {
11836         joinStr = " ";
11837         joinStrLen = 1;
11838     } else {
11839         joinStr = Jim_GetString(argv[2], &joinStrLen);
11840     }
11841     Jim_ListLength(interp, argv[1], &listLen);
11842     resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11843     /* Split */
11844     for (i = 0; i < listLen; i++) {
11845         Jim_Obj *objPtr;
11846
11847         Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11848         Jim_AppendObj(interp, resObjPtr, objPtr);
11849         if (i+1 != listLen) {
11850             Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11851         }
11852     }
11853     Jim_SetResult(interp, resObjPtr);
11854     return JIM_OK;
11855 }
11856
11857 /* [format] */
11858 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11859         Jim_Obj *const *argv)
11860 {
11861     Jim_Obj *objPtr;
11862
11863     if (argc < 2) {
11864         Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11865         return JIM_ERR;
11866     }
11867     objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11868     if (objPtr == NULL)
11869         return JIM_ERR;
11870     Jim_SetResult(interp, objPtr);
11871     return JIM_OK;
11872 }
11873
11874 /* [scan] */
11875 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11876         Jim_Obj *const *argv)
11877 {
11878     Jim_Obj *listPtr, **outVec;
11879     int outc, i, count = 0;
11880
11881     if (argc < 3) {
11882         Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11883         return JIM_ERR;
11884     } 
11885     if (argv[2]->typePtr != &scanFmtStringObjType)
11886         SetScanFmtFromAny(interp, argv[2]);
11887     if (FormatGetError(argv[2]) != 0) {
11888         Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11889         return JIM_ERR;
11890     }
11891     if (argc > 3) {
11892         int maxPos = FormatGetMaxPos(argv[2]);
11893         int count = FormatGetCnvCount(argv[2]);
11894         if (maxPos > argc-3) {
11895             Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11896             return JIM_ERR;
11897         } else if (count != 0 && count < argc-3) {
11898             Jim_SetResultString(interp, "variable is not assigned by any "
11899                 "conversion specifiers", -1);
11900             return JIM_ERR;
11901         } else if (count > argc-3) {
11902             Jim_SetResultString(interp, "different numbers of variable names and "
11903                 "field specifiers", -1);
11904             return JIM_ERR;
11905         }
11906     } 
11907     listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11908     if (listPtr == 0)
11909         return JIM_ERR;
11910     if (argc > 3) {
11911         int len = 0;
11912         if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11913             Jim_ListLength(interp, listPtr, &len);
11914         if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11915             Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11916             return JIM_OK;
11917         }
11918         JimListGetElements(interp, listPtr, &outc, &outVec);
11919         for (i = 0; i < outc; ++i) {
11920             if (Jim_Length(outVec[i]) > 0) {
11921                 ++count;
11922                 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11923                     goto err;
11924             }
11925         }
11926         Jim_FreeNewObj(interp, listPtr);
11927         Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11928     } else {
11929         if (listPtr == (Jim_Obj*)EOF) {
11930             Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11931             return JIM_OK;
11932         }
11933         Jim_SetResult(interp, listPtr);
11934     }
11935     return JIM_OK;
11936 err:
11937     Jim_FreeNewObj(interp, listPtr);
11938     return JIM_ERR;
11939 }
11940
11941 /* [error] */
11942 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11943         Jim_Obj *const *argv)
11944 {
11945     if (argc != 2) {
11946         Jim_WrongNumArgs(interp, 1, argv, "message");
11947         return JIM_ERR;
11948     }
11949     Jim_SetResult(interp, argv[1]);
11950     return JIM_ERR;
11951 }
11952
11953 /* [lrange] */
11954 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11955         Jim_Obj *const *argv)
11956 {
11957     Jim_Obj *objPtr;
11958
11959     if (argc != 4) {
11960         Jim_WrongNumArgs(interp, 1, argv, "list first last");
11961         return JIM_ERR;
11962     }
11963     if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11964         return JIM_ERR;
11965     Jim_SetResult(interp, objPtr);
11966     return JIM_OK;
11967 }
11968
11969 /* [env] */
11970 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11971         Jim_Obj *const *argv)
11972 {
11973     const char *key;
11974     char *val;
11975
11976     if (argc == 1) {
11977         extern char **environ;
11978
11979         int i;
11980         Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11981
11982         for (i = 0; environ[i]; i++) {
11983             const char *equals = strchr(environ[i], '=');
11984             if (equals) {
11985                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11986                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11987             }
11988         }
11989
11990         Jim_SetResult(interp, listObjPtr);
11991         return JIM_OK;
11992     }
11993
11994     if (argc != 2) {
11995         Jim_WrongNumArgs(interp, 1, argv, "varName");
11996         return JIM_ERR;
11997     }
11998     key = Jim_GetString(argv[1], NULL);
11999     val = getenv(key);
12000     if (val == NULL) {
12001         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12002         Jim_AppendStrings(interp, Jim_GetResult(interp),
12003                 "environment variable \"",
12004                 key, "\" does not exist", NULL);
12005         return JIM_ERR;
12006     }
12007     Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12008     return JIM_OK;
12009 }
12010
12011 /* [source] */
12012 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12013         Jim_Obj *const *argv)
12014 {
12015     int retval;
12016
12017     if (argc != 2) {
12018         Jim_WrongNumArgs(interp, 1, argv, "fileName");
12019         return JIM_ERR;
12020     }
12021     retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12022     if (retval == JIM_ERR) {
12023         return JIM_ERR_ADDSTACK;
12024     }
12025     if (retval == JIM_RETURN)
12026         return JIM_OK;
12027     return retval;
12028 }
12029
12030 /* [lreverse] */
12031 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12032         Jim_Obj *const *argv)
12033 {
12034     Jim_Obj *revObjPtr, **ele;
12035     int len;
12036
12037     if (argc != 2) {
12038         Jim_WrongNumArgs(interp, 1, argv, "list");
12039         return JIM_ERR;
12040     }
12041     JimListGetElements(interp, argv[1], &len, &ele);
12042     len--;
12043     revObjPtr = Jim_NewListObj(interp, NULL, 0);
12044     while (len >= 0)
12045         ListAppendElement(revObjPtr, ele[len--]);
12046     Jim_SetResult(interp, revObjPtr);
12047     return JIM_OK;
12048 }
12049
12050 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12051 {
12052     jim_wide len;
12053
12054     if (step == 0) return -1;
12055     if (start == end) return 0;
12056     else if (step > 0 && start > end) return -1;
12057     else if (step < 0 && end > start) return -1;
12058     len = end-start;
12059     if (len < 0) len = -len; /* abs(len) */
12060     if (step < 0) step = -step; /* abs(step) */
12061     len = 1 + ((len-1)/step);
12062     /* We can truncate safely to INT_MAX, the range command
12063      * will always return an error for a such long range
12064      * because Tcl lists can't be so long. */
12065     if (len > INT_MAX) len = INT_MAX;
12066     return (int)((len < 0) ? -1 : len);
12067 }
12068
12069 /* [range] */
12070 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12071         Jim_Obj *const *argv)
12072 {
12073     jim_wide start = 0, end, step = 1;
12074     int len, i;
12075     Jim_Obj *objPtr;
12076
12077     if (argc < 2 || argc > 4) {
12078         Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12079         return JIM_ERR;
12080     }
12081     if (argc == 2) {
12082         if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12083             return JIM_ERR;
12084     } else {
12085         if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12086             Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12087             return JIM_ERR;
12088         if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12089             return JIM_ERR;
12090     }
12091     if ((len = JimRangeLen(start, end, step)) == -1) {
12092         Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12093         return JIM_ERR;
12094     }
12095     objPtr = Jim_NewListObj(interp, NULL, 0);
12096     for (i = 0; i < len; i++)
12097         ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12098     Jim_SetResult(interp, objPtr);
12099     return JIM_OK;
12100 }
12101
12102 /* [rand] */
12103 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12104         Jim_Obj *const *argv)
12105 {
12106     jim_wide min = 0, max, len, maxMul;
12107
12108     if (argc < 1 || argc > 3) {
12109         Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12110         return JIM_ERR;
12111     }
12112     if (argc == 1) {
12113         max = JIM_WIDE_MAX;
12114     } else if (argc == 2) {
12115         if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12116             return JIM_ERR;
12117     } else if (argc == 3) {
12118         if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12119             Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12120             return JIM_ERR;
12121     }
12122     len = max-min;
12123     if (len < 0) {
12124         Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12125         return JIM_ERR;
12126     }
12127     maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12128     while (1) {
12129         jim_wide r;
12130
12131         JimRandomBytes(interp, &r, sizeof(jim_wide));
12132         if (r < 0 || r >= maxMul) continue;
12133         r = (len == 0) ? 0 : r%len;
12134         Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12135         return JIM_OK;
12136     }
12137 }
12138
12139 /* [package] */
12140 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc, 
12141         Jim_Obj *const *argv)
12142 {
12143     int option;
12144     const char *options[] = {
12145         "require", "provide", NULL
12146     };
12147     enum {OPT_REQUIRE, OPT_PROVIDE};
12148
12149     if (argc < 2) {
12150         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12151         return JIM_ERR;
12152     }
12153     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12154                 JIM_ERRMSG) != JIM_OK)
12155         return JIM_ERR;
12156
12157     if (option == OPT_REQUIRE) {
12158         int exact = 0;
12159         const char *ver;
12160
12161         if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12162             exact = 1;
12163             argv++;
12164             argc--;
12165         }
12166         if (argc != 3 && argc != 4) {
12167             Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12168             return JIM_ERR;
12169         }
12170         ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12171                 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12172                 JIM_ERRMSG);
12173         if (ver == NULL)
12174             return JIM_ERR_ADDSTACK;
12175         Jim_SetResultString(interp, ver, -1);
12176     } else if (option == OPT_PROVIDE) {
12177         if (argc != 4) {
12178             Jim_WrongNumArgs(interp, 2, argv, "package version");
12179             return JIM_ERR;
12180         }
12181         return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12182                     Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12183     }
12184     return JIM_OK;
12185 }
12186
12187 static struct {
12188     const char *name;
12189     Jim_CmdProc cmdProc;
12190 } Jim_CoreCommandsTable[] = {
12191     {"set", Jim_SetCoreCommand},
12192     {"unset", Jim_UnsetCoreCommand},
12193     {"puts", Jim_PutsCoreCommand},
12194     {"+", Jim_AddCoreCommand},
12195     {"*", Jim_MulCoreCommand},
12196     {"-", Jim_SubCoreCommand},
12197     {"/", Jim_DivCoreCommand},
12198     {"incr", Jim_IncrCoreCommand},
12199     {"while", Jim_WhileCoreCommand},
12200     {"for", Jim_ForCoreCommand},
12201     {"foreach", Jim_ForeachCoreCommand},
12202     {"lmap", Jim_LmapCoreCommand},
12203     {"if", Jim_IfCoreCommand},
12204     {"switch", Jim_SwitchCoreCommand},
12205     {"list", Jim_ListCoreCommand},
12206     {"lindex", Jim_LindexCoreCommand},
12207     {"lset", Jim_LsetCoreCommand},
12208     {"llength", Jim_LlengthCoreCommand},
12209     {"lappend", Jim_LappendCoreCommand},
12210     {"linsert", Jim_LinsertCoreCommand},
12211     {"lsort", Jim_LsortCoreCommand},
12212     {"append", Jim_AppendCoreCommand},
12213     {"debug", Jim_DebugCoreCommand},
12214     {"eval", Jim_EvalCoreCommand},
12215     {"uplevel", Jim_UplevelCoreCommand},
12216     {"expr", Jim_ExprCoreCommand},
12217     {"break", Jim_BreakCoreCommand},
12218     {"continue", Jim_ContinueCoreCommand},
12219     {"proc", Jim_ProcCoreCommand},
12220     {"concat", Jim_ConcatCoreCommand},
12221     {"return", Jim_ReturnCoreCommand},
12222     {"upvar", Jim_UpvarCoreCommand},
12223     {"global", Jim_GlobalCoreCommand},
12224     {"string", Jim_StringCoreCommand},
12225     {"time", Jim_TimeCoreCommand},
12226     {"exit", Jim_ExitCoreCommand},
12227     {"catch", Jim_CatchCoreCommand},
12228     {"ref", Jim_RefCoreCommand},
12229     {"getref", Jim_GetrefCoreCommand},
12230     {"setref", Jim_SetrefCoreCommand},
12231     {"finalize", Jim_FinalizeCoreCommand},
12232     {"collect", Jim_CollectCoreCommand},
12233     {"rename", Jim_RenameCoreCommand},
12234     {"dict", Jim_DictCoreCommand},
12235     {"load", Jim_LoadCoreCommand},
12236     {"subst", Jim_SubstCoreCommand},
12237     {"info", Jim_InfoCoreCommand},
12238     {"split", Jim_SplitCoreCommand},
12239     {"join", Jim_JoinCoreCommand},
12240     {"format", Jim_FormatCoreCommand},
12241     {"scan", Jim_ScanCoreCommand},
12242     {"error", Jim_ErrorCoreCommand},
12243     {"lrange", Jim_LrangeCoreCommand},
12244     {"env", Jim_EnvCoreCommand},
12245     {"source", Jim_SourceCoreCommand},
12246     {"lreverse", Jim_LreverseCoreCommand},
12247     {"range", Jim_RangeCoreCommand},
12248     {"rand", Jim_RandCoreCommand},
12249     {"package", Jim_PackageCoreCommand},
12250     {"tailcall", Jim_TailcallCoreCommand},
12251     {NULL, NULL},
12252 };
12253
12254 /* Some Jim core command is actually a procedure written in Jim itself. */
12255 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12256 {
12257     Jim_Eval(interp, (char*)
12258 "proc lambda {arglist args} {\n"
12259 "    set name [ref {} function lambdaFinalizer]\n"
12260 "    uplevel 1 [list proc $name $arglist {expand}$args]\n"
12261 "    return $name\n"
12262 "}\n"
12263 "proc lambdaFinalizer {name val} {\n"
12264 "    rename $name {}\n"
12265 "}\n"
12266     );
12267 }
12268
12269 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12270 {
12271     int i = 0;
12272
12273     while(Jim_CoreCommandsTable[i].name != NULL) {
12274         Jim_CreateCommand(interp, 
12275                 Jim_CoreCommandsTable[i].name,
12276                 Jim_CoreCommandsTable[i].cmdProc,
12277                 NULL, NULL);
12278         i++;
12279     }
12280     Jim_RegisterCoreProcedures(interp);
12281 }
12282
12283 /* -----------------------------------------------------------------------------
12284  * Interactive prompt
12285  * ---------------------------------------------------------------------------*/
12286 void Jim_PrintErrorMessage(Jim_Interp *interp)
12287 {
12288     int len, i;
12289
12290     if (*interp->errorFileName) {
12291         Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL "    ",
12292                                     interp->errorFileName, interp->errorLine);
12293     }
12294     Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12295             Jim_GetString(interp->result, NULL));
12296     Jim_ListLength(interp, interp->stackTrace, &len);
12297     for (i = len-3; i >= 0; i-= 3) {
12298         Jim_Obj *objPtr;
12299         const char *proc, *file, *line;
12300
12301         Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12302         proc = Jim_GetString(objPtr, NULL);
12303         Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12304                 JIM_NONE);
12305         file = Jim_GetString(objPtr, NULL);
12306         Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12307                 JIM_NONE);
12308         line = Jim_GetString(objPtr, NULL);
12309         if (*proc) {
12310             Jim_fprintf( interp, interp->cookie_stderr,
12311                     "in procedure '%s' ", proc);
12312         }
12313         if (*file) {
12314             Jim_fprintf( interp, interp->cookie_stderr,
12315                     "called at file \"%s\", line %s",
12316                     file, line);
12317         }
12318         if (*file || *proc) {
12319             Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12320         }
12321     }
12322 }
12323
12324 int Jim_InteractivePrompt(Jim_Interp *interp)
12325 {
12326     int retcode = JIM_OK;
12327     Jim_Obj *scriptObjPtr;
12328
12329     Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12330            "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12331            JIM_VERSION / 100, JIM_VERSION % 100);
12332      Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12333     while (1) {
12334         char buf[1024];
12335         const char *result;
12336         const char *retcodestr[] = {
12337             "ok", "error", "return", "break", "continue", "eval", "exit"
12338         };
12339         int reslen;
12340
12341         if (retcode != 0) {
12342             if (retcode >= 2 && retcode <= 6)
12343                 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12344             else
12345                 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12346         } else
12347             Jim_fprintf( interp, interp->cookie_stdout, ". ");
12348         Jim_fflush( interp, interp->cookie_stdout);
12349         scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12350         Jim_IncrRefCount(scriptObjPtr);
12351         while(1) {
12352             const char *str;
12353             char state;
12354             int len;
12355
12356             if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12357                 Jim_DecrRefCount(interp, scriptObjPtr);
12358                 goto out;
12359             }
12360             Jim_AppendString(interp, scriptObjPtr, buf, -1);
12361             str = Jim_GetString(scriptObjPtr, &len);
12362             if (Jim_ScriptIsComplete(str, len, &state))
12363                 break;
12364             Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12365             Jim_fflush( interp, interp->cookie_stdout);
12366         }
12367         retcode = Jim_EvalObj(interp, scriptObjPtr);
12368         Jim_DecrRefCount(interp, scriptObjPtr);
12369         result = Jim_GetString(Jim_GetResult(interp), &reslen);
12370         if (retcode == JIM_ERR) {
12371             Jim_PrintErrorMessage(interp);
12372         } else if (retcode == JIM_EXIT) {
12373             exit(Jim_GetExitCode(interp));
12374         } else {
12375             if (reslen) {
12376                                 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12377                                 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12378             }
12379         }
12380     }
12381 out:
12382     return 0;
12383 }
12384
12385 /* -----------------------------------------------------------------------------
12386  * Jim's idea of STDIO..
12387  * ---------------------------------------------------------------------------*/
12388
12389 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12390 {
12391         int r;
12392
12393         va_list ap;
12394         va_start(ap,fmt);
12395         r = Jim_vfprintf( interp, cookie, fmt,ap );
12396         va_end(ap);
12397         return r;
12398 }
12399
12400 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12401 {
12402         if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12403                 errno = ENOTSUP;
12404                 return -1;
12405         }
12406         return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12407 }
12408
12409 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12410 {
12411         if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12412                 errno = ENOTSUP;
12413                 return 0;
12414         }
12415         return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12416 }
12417
12418 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12419 {
12420         if( (interp == NULL) || (interp->cb_fread == NULL) ){
12421                 errno = ENOTSUP;
12422                 return 0;
12423         }
12424         return (*(interp->cb_fread))( ptr, size, n, cookie);
12425 }
12426
12427 int Jim_fflush( Jim_Interp *interp, void *cookie )
12428 {
12429         if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12430                 /* pretend all is well */
12431                 return 0;
12432         }
12433         return (*(interp->cb_fflush))( cookie );
12434 }
12435
12436 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12437 {
12438         if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12439                 errno = ENOTSUP;
12440                 return NULL;
12441         }
12442         return (*(interp->cb_fgets))( s, size, cookie );
12443 }
12444 Jim_Nvp *
12445 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12446 {
12447         while( p->name ){
12448                 if( 0 == strcmp( name, p->name ) ){
12449                         break;
12450                 }
12451                 p++;
12452         }
12453         return ((Jim_Nvp *)(p));
12454 }
12455
12456 Jim_Nvp *
12457 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12458 {
12459         while( p->name ){
12460                 if( 0 == strcasecmp( name, p->name ) ){
12461                         break;
12462                 }
12463                 p++;
12464         }
12465         return ((Jim_Nvp *)(p));
12466 }
12467
12468 int
12469 Jim_Nvp_name2value_obj( Jim_Interp *interp, 
12470                                                 const Jim_Nvp *p, 
12471                                                 Jim_Obj *o, 
12472                                                 Jim_Nvp **result )
12473 {
12474         return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12475 }
12476         
12477
12478 int 
12479 Jim_Nvp_name2value( Jim_Interp *interp, 
12480                                         const Jim_Nvp *_p, 
12481                                         const char *name, 
12482                                         Jim_Nvp **result)
12483 {
12484         const Jim_Nvp *p;
12485
12486         p = Jim_Nvp_name2value_simple( _p, name );
12487
12488         /* result */
12489         if( result ){
12490                 *result = (Jim_Nvp *)(p);
12491         }
12492         
12493         /* found? */
12494         if( p->name ){
12495                 return JIM_OK;
12496         } else {
12497                 return JIM_ERR;
12498         }
12499 }
12500
12501 int
12502 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12503 {
12504         return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12505 }
12506
12507 int
12508 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12509 {
12510         const Jim_Nvp *p;
12511
12512         p = Jim_Nvp_name2value_nocase_simple( _p, name );
12513
12514         if( puthere ){
12515                 *puthere = (Jim_Nvp *)(p);
12516         }
12517         /* found */
12518         if( p->name ){
12519                 return JIM_OK;
12520         } else {
12521                 return JIM_ERR;
12522         }
12523 }
12524
12525
12526 int 
12527 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12528 {
12529         int e;;
12530         jim_wide w;
12531
12532         e = Jim_GetWide( interp, o, &w );
12533         if( e != JIM_OK ){
12534                 return e;
12535         }
12536
12537         return Jim_Nvp_value2name( interp, p, w, result );
12538 }
12539
12540 Jim_Nvp *
12541 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12542 {
12543         while( p->name ){
12544                 if( value == p->value ){
12545                         break;
12546                 }
12547                 p++;
12548         }
12549         return ((Jim_Nvp *)(p));
12550 }
12551
12552
12553 int 
12554 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12555 {
12556         const Jim_Nvp *p;
12557
12558         p = Jim_Nvp_value2name_simple( _p, value );
12559
12560         if( result ){
12561                 *result = (Jim_Nvp *)(p);
12562         }
12563
12564         if( p->name ){
12565                 return JIM_OK;
12566         } else {
12567                 return JIM_ERR;
12568         }
12569 }
12570
12571
12572 int
12573 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const *  argv)
12574 {
12575         memset( p, 0, sizeof(*p) );
12576         p->interp = interp;
12577         p->argc   = argc;
12578         p->argv   = argv;
12579
12580         return JIM_OK;
12581 }
12582
12583 void
12584 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12585 {
12586         int x;
12587
12588         Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12589         for( x = 0 ; x < p->argc ; x++ ){
12590                 Jim_fprintf( p->interp, p->interp->cookie_stderr, 
12591                                          "%2d) %s\n", 
12592                                          x, 
12593                                          Jim_GetString( p->argv[x], NULL ) );
12594         }
12595         Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12596 }
12597
12598
12599 int
12600 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12601 {
12602         Jim_Obj *o;
12603         
12604         o = NULL; // failure 
12605         if( goi->argc ){
12606                 // success 
12607                 o = goi->argv[0];
12608                 goi->argc -= 1;
12609                 goi->argv += 1;
12610         }
12611         if( puthere ){
12612                 *puthere = o;
12613         }
12614         if( o != NULL ){
12615                 return JIM_OK;
12616         } else {
12617                 return JIM_ERR;
12618         }
12619 }
12620
12621 int
12622 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12623 {
12624         int r;
12625         Jim_Obj *o;
12626         const char *cp;
12627
12628
12629         r = Jim_GetOpt_Obj( goi, &o );
12630         if( r == JIM_OK ){
12631                 cp = Jim_GetString( o, len );
12632                 if( puthere ){
12633                         /* remove const */
12634                         *puthere = (char *)(cp);
12635                 }
12636         }
12637         return r;
12638 }
12639
12640 int
12641 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12642 {
12643         int r;
12644         Jim_Obj *o;
12645         double _safe;
12646         
12647         if( puthere == NULL ){
12648                 puthere = &_safe;
12649         }
12650
12651         r = Jim_GetOpt_Obj( goi, &o );
12652         if( r == JIM_OK ){
12653                 r = Jim_GetDouble( goi->interp, o, puthere );
12654                 if( r != JIM_OK ){
12655                         Jim_SetResult_sprintf( goi->interp,
12656                                                                    "not a number: %s", 
12657                                                                    Jim_GetString( o, NULL ) );
12658                 }
12659         }
12660         return r;
12661 }
12662
12663 int
12664 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12665 {
12666         int r;
12667         Jim_Obj *o;
12668         jim_wide _safe;
12669
12670         if( puthere == NULL ){
12671                 puthere = &_safe;
12672         }
12673
12674         r = Jim_GetOpt_Obj( goi, &o );
12675         if( r == JIM_OK ){
12676                 r = Jim_GetWide( goi->interp, o, puthere );
12677         }
12678         return r;
12679 }
12680
12681 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi, 
12682                                         const Jim_Nvp *nvp, 
12683                                         Jim_Nvp **puthere)
12684 {
12685         Jim_Nvp *_safe;
12686         Jim_Obj *o;
12687         int e;
12688
12689         if( puthere == NULL ){
12690                 puthere = &_safe;
12691         }
12692
12693         e = Jim_GetOpt_Obj( goi, &o );
12694         if( e == JIM_OK ){
12695                 e = Jim_Nvp_name2value_obj( goi->interp,
12696                                                                         nvp, 
12697                                                                         o,
12698                                                                         puthere );
12699         }
12700
12701         return e;
12702 }
12703
12704 void
12705 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12706                                            const Jim_Nvp *nvptable,
12707                                            int hadprefix )
12708 {
12709         if( hadprefix ){
12710                 Jim_SetResult_NvpUnknown( goi->interp,
12711                                                                   goi->argv[-2],
12712                                                                   goi->argv[-1],
12713                                                                   nvptable );
12714         } else {
12715                 Jim_SetResult_NvpUnknown( goi->interp,
12716                                                                   NULL,
12717                                                                   goi->argv[-1],
12718                                                                   nvptable );
12719         }
12720 }
12721                                            
12722
12723 int 
12724 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12725                                  const char * const *  lookup,
12726                                  int *puthere)
12727 {
12728         int _safe;
12729         Jim_Obj *o;
12730         int e;
12731
12732         if( puthere == NULL ){
12733                 puthere = &_safe;
12734         }
12735         e = Jim_GetOpt_Obj( goi, &o );
12736         if( e == JIM_OK ){
12737                 e = Jim_GetEnum( goi->interp,
12738                                                  o,
12739                                                  lookup,
12740                                                  puthere,
12741                                                  "option",
12742                                                  JIM_ERRMSG );
12743         }
12744         return e;
12745 }
12746         
12747
12748
12749 int
12750 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12751 {
12752         va_list ap;
12753         char *buf;
12754
12755         va_start(ap,fmt);
12756         buf = jim_vasprintf( fmt, ap );
12757         va_end(ap);
12758         if( buf ){
12759                 Jim_SetResultString( interp, buf, -1 );
12760                 jim_vasprintf_done(buf);
12761         }
12762         return JIM_OK;
12763 }
12764         
12765
12766 void
12767 Jim_SetResult_NvpUnknown( Jim_Interp *interp, 
12768                                                   Jim_Obj *param_name,
12769                                                   Jim_Obj *param_value,
12770                                                   const Jim_Nvp *nvp )
12771 {
12772         if( param_name ){
12773                 Jim_SetResult_sprintf( interp,
12774                                                            "%s: Unknown: %s, try one of: ",
12775                                                            Jim_GetString( param_name, NULL ),
12776                                                            Jim_GetString( param_value, NULL ) );
12777         } else {
12778                 Jim_SetResult_sprintf( interp,
12779                                                            "Unknown param: %s, try one of: ",
12780                                                            Jim_GetString( param_value, NULL ) );
12781         }
12782         while( nvp->name ){
12783                 const char *a;
12784                 const char *b;
12785
12786                 if( (nvp+1)->name ){
12787                         a = nvp->name;
12788                         b = ", ";
12789                 } else {
12790                         a = "or ";
12791                         b = nvp->name;
12792                 }
12793                 Jim_AppendStrings( interp,
12794                                                    Jim_GetResult(interp),
12795                                                    a, b, NULL );
12796                 nvp++;
12797         }
12798 }
12799                                                            
12800
12801 static Jim_Obj *debug_string_obj;
12802
12803 const char *
12804 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12805 {
12806         int x;
12807
12808         if( debug_string_obj ){
12809                 Jim_FreeObj( interp, debug_string_obj );
12810         }
12811
12812         debug_string_obj = Jim_NewEmptyStringObj( interp );
12813         for( x = 0 ; x < argc ; x++ ){
12814                 Jim_AppendStrings( interp,
12815                                                    debug_string_obj,
12816                                                    Jim_GetString( argv[x], NULL ),
12817                                                    " ",
12818                                                    NULL );
12819         }
12820
12821         return Jim_GetString( debug_string_obj, NULL );
12822 }
12823
12824         
12825
12826 /*
12827  * Local Variables: ***
12828  * c-basic-offset: 4 ***
12829  * tab-width: 4 ***
12830  * End: ***
12831  */