]> git.sur5r.net Git - openocd/blob - src/helper/jim.c
sync up to latest jim tcl
[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 #include <stdio.h>
53 #include <stdlib.h>
54 #include <string.h>
55 #include <stdarg.h>
56 #include <ctype.h>
57 #include <limits.h>
58 #include <assert.h>
59 #include <errno.h>
60 #include <time.h>
61 #if defined(WIN32)
62 /* sys/time - need is different */
63 #else
64 #include <sys/time.h> // for gettimeofday()
65 #endif
66
67 #include "replacements.h"
68
69 /* Include the platform dependent libraries for
70  * dynamic loading of libraries. */
71 #ifdef JIM_DYNLIB
72 #if defined(_WIN32) || defined(WIN32)
73 #ifndef WIN32
74 #define WIN32 1
75 #endif
76 #ifndef STRICT
77 #define STRICT
78 #endif
79 #define WIN32_LEAN_AND_MEAN
80 #include <windows.h>
81 #if _MSC_VER >= 1000
82 #pragma warning(disable:4146)
83 #endif /* _MSC_VER */
84 #else
85 #include <dlfcn.h>
86 #endif /* WIN32 */
87 #endif /* JIM_DYNLIB */
88
89 #ifndef WIN32
90 #include <unistd.h>
91 #endif
92
93 #ifdef __ECOS
94 #include <cyg/jimtcl/jim.h>
95 #else
96 #include "jim.h"
97 #endif
98
99 #ifdef HAVE_BACKTRACE
100 #include <execinfo.h>
101 #endif
102
103 /* -----------------------------------------------------------------------------
104  * Global variables
105  * ---------------------------------------------------------------------------*/
106
107 /* A shared empty string for the objects string representation.
108  * Jim_InvalidateStringRep knows about it and don't try to free. */
109 static char *JimEmptyStringRep = (char*) "";
110
111 /* -----------------------------------------------------------------------------
112  * Required prototypes of not exported functions
113  * ---------------------------------------------------------------------------*/
114 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
115 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
116 static void JimRegisterCoreApi(Jim_Interp *interp);
117
118 static Jim_HashTableType JimVariablesHashTableType;
119
120 /* -----------------------------------------------------------------------------
121  * Utility functions
122  * ---------------------------------------------------------------------------*/
123
124 static char *
125 jim_vasprintf( const char *fmt, va_list ap )
126 {
127 #ifndef HAVE_VASPRINTF
128         /* yucky way */
129 static char buf[2048];
130         vsnprintf( buf, sizeof(buf), fmt, ap );
131         /* garentee termination */
132         buf[sizeof(buf)-1] = 0;
133 #else
134         char *buf;
135         vasprintf( &buf, fmt, ap );
136 #endif
137         return buf;
138 }
139
140 static void
141 jim_vasprintf_done( void *buf )
142 {
143 #ifndef HAVE_VASPRINTF
144         (void)(buf);
145 #else
146         free(buf);
147 #endif
148 }
149         
150
151 /*
152  * Convert a string to a jim_wide INTEGER.
153  * This function originates from BSD.
154  *
155  * Ignores `locale' stuff.  Assumes that the upper and lower case
156  * alphabets and digits are each contiguous.
157  */
158 #ifdef HAVE_LONG_LONG
159 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
160 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
161 {
162     register const char *s;
163     register unsigned jim_wide acc;
164     register unsigned char c;
165     register unsigned jim_wide qbase, cutoff;
166     register int neg, any, cutlim;
167
168     /*
169      * Skip white space and pick up leading +/- sign if any.
170      * If base is 0, allow 0x for hex and 0 for octal, else
171      * assume decimal; if base is already 16, allow 0x.
172      */
173     s = nptr;
174     do {
175         c = *s++;
176     } while (isspace(c));
177     if (c == '-') {
178         neg = 1;
179         c = *s++;
180     } else {
181         neg = 0;
182         if (c == '+')
183             c = *s++;
184     }
185     if ((base == 0 || base == 16) &&
186         c == '0' && (*s == 'x' || *s == 'X')) {
187         c = s[1];
188         s += 2;
189         base = 16;
190     }
191     if (base == 0)
192         base = c == '0' ? 8 : 10;
193
194     /*
195      * Compute the cutoff value between legal numbers and illegal
196      * numbers.  That is the largest legal value, divided by the
197      * base.  An input number that is greater than this value, if
198      * followed by a legal input character, is too big.  One that
199      * is equal to this value may be valid or not; the limit
200      * between valid and invalid numbers is then based on the last
201      * digit.  For instance, if the range for quads is
202      * [-9223372036854775808..9223372036854775807] and the input base
203      * is 10, cutoff will be set to 922337203685477580 and cutlim to
204      * either 7 (neg==0) or 8 (neg==1), meaning that if we have
205      * accumulated a value > 922337203685477580, or equal but the
206      * next digit is > 7 (or 8), the number is too big, and we will
207      * return a range error.
208      *
209      * Set any if any `digits' consumed; make it negative to indicate
210      * overflow.
211      */
212     qbase = (unsigned)base;
213     cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
214         : LLONG_MAX;
215     cutlim = (int)(cutoff % qbase);
216     cutoff /= qbase;
217     for (acc = 0, any = 0;; c = *s++) {
218         if (!JimIsAscii(c))
219             break;
220         if (isdigit(c))
221             c -= '0';
222         else if (isalpha(c))
223             c -= isupper(c) ? 'A' - 10 : 'a' - 10;
224         else
225             break;
226         if (c >= base)
227             break;
228         if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
229             any = -1;
230         else {
231             any = 1;
232             acc *= qbase;
233             acc += c;
234         }
235     }
236     if (any < 0) {
237         acc = neg ? LLONG_MIN : LLONG_MAX;
238         errno = ERANGE;
239     } else if (neg)
240         acc = -acc;
241     if (endptr != 0)
242         *endptr = (char *)(any ? s - 1 : nptr);
243     return (acc);
244 }
245 #endif
246
247 /* Glob-style pattern matching. */
248 static int JimStringMatch(const char *pattern, int patternLen,
249         const char *string, int stringLen, int nocase)
250 {
251     while(patternLen) {
252         switch(pattern[0]) {
253         case '*':
254             while (pattern[1] == '*') {
255                 pattern++;
256                 patternLen--;
257             }
258             if (patternLen == 1)
259                 return 1; /* match */
260             while(stringLen) {
261                 if (JimStringMatch(pattern+1, patternLen-1,
262                             string, stringLen, nocase))
263                     return 1; /* match */
264                 string++;
265                 stringLen--;
266             }
267             return 0; /* no match */
268             break;
269         case '?':
270             if (stringLen == 0)
271                 return 0; /* no match */
272             string++;
273             stringLen--;
274             break;
275         case '[':
276         {
277             int not, match;
278
279             pattern++;
280             patternLen--;
281             not = pattern[0] == '^';
282             if (not) {
283                 pattern++;
284                 patternLen--;
285             }
286             match = 0;
287             while(1) {
288                 if (pattern[0] == '\\') {
289                     pattern++;
290                     patternLen--;
291                     if (pattern[0] == string[0])
292                         match = 1;
293                 } else if (pattern[0] == ']') {
294                     break;
295                 } else if (patternLen == 0) {
296                     pattern--;
297                     patternLen++;
298                     break;
299                 } else if (pattern[1] == '-' && patternLen >= 3) {
300                     int start = pattern[0];
301                     int end = pattern[2];
302                     int c = string[0];
303                     if (start > end) {
304                         int t = start;
305                         start = end;
306                         end = t;
307                     }
308                     if (nocase) {
309                         start = tolower(start);
310                         end = tolower(end);
311                         c = tolower(c);
312                     }
313                     pattern += 2;
314                     patternLen -= 2;
315                     if (c >= start && c <= end)
316                         match = 1;
317                 } else {
318                     if (!nocase) {
319                         if (pattern[0] == string[0])
320                             match = 1;
321                     } else {
322                         if (tolower((int)pattern[0]) == tolower((int)string[0]))
323                             match = 1;
324                     }
325                 }
326                 pattern++;
327                 patternLen--;
328             }
329             if (not)
330                 match = !match;
331             if (!match)
332                 return 0; /* no match */
333             string++;
334             stringLen--;
335             break;
336         }
337         case '\\':
338             if (patternLen >= 2) {
339                 pattern++;
340                 patternLen--;
341             }
342             /* fall through */
343         default:
344             if (!nocase) {
345                 if (pattern[0] != string[0])
346                     return 0; /* no match */
347             } else {
348                 if (tolower((int)pattern[0]) != tolower((int)string[0]))
349                     return 0; /* no match */
350             }
351             string++;
352             stringLen--;
353             break;
354         }
355         pattern++;
356         patternLen--;
357         if (stringLen == 0) {
358             while(*pattern == '*') {
359                 pattern++;
360                 patternLen--;
361             }
362             break;
363         }
364     }
365     if (patternLen == 0 && stringLen == 0)
366         return 1;
367     return 0;
368 }
369
370 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
371         int nocase)
372 {
373     unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
374
375     if (nocase == 0) {
376         while(l1 && l2) {
377             if (*u1 != *u2)
378                 return (int)*u1-*u2;
379             u1++; u2++; l1--; l2--;
380         }
381         if (!l1 && !l2) return 0;
382         return l1-l2;
383     } else {
384         while(l1 && l2) {
385             if (tolower((int)*u1) != tolower((int)*u2))
386                 return tolower((int)*u1)-tolower((int)*u2);
387             u1++; u2++; l1--; l2--;
388         }
389         if (!l1 && !l2) return 0;
390         return l1-l2;
391     }
392 }
393
394 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
395  * The index of the first occurrence of s1 in s2 is returned. 
396  * If s1 is not found inside s2, -1 is returned. */
397 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
398 {
399     int i;
400
401     if (!l1 || !l2 || l1 > l2) return -1;
402     if (index < 0) index = 0;
403     s2 += index;
404     for (i = index; i <= l2-l1; i++) {
405         if (memcmp(s2, s1, l1) == 0)
406             return i;
407         s2++;
408     }
409     return -1;
410 }
411
412 int Jim_WideToString(char *buf, jim_wide wideValue)
413 {
414     const char *fmt = "%" JIM_WIDE_MODIFIER;
415     return sprintf(buf, fmt, wideValue);
416 }
417
418 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
419 {
420     char *endptr;
421
422 #ifdef HAVE_LONG_LONG
423     *widePtr = JimStrtoll(str, &endptr, base);
424 #else
425     *widePtr = strtol(str, &endptr, base);
426 #endif
427     if ((str[0] == '\0') || (str == endptr) )
428         return JIM_ERR;
429     if (endptr[0] != '\0') {
430         while(*endptr) {
431             if (!isspace((int)*endptr))
432                 return JIM_ERR;
433             endptr++;
434         }
435     }
436     return JIM_OK;
437 }
438
439 int Jim_StringToIndex(const char *str, int *intPtr)
440 {
441     char *endptr;
442
443     *intPtr = strtol(str, &endptr, 10);
444     if ( (str[0] == '\0') || (str == endptr) )
445         return JIM_ERR;
446     if (endptr[0] != '\0') {
447         while(*endptr) {
448             if (!isspace((int)*endptr))
449                 return JIM_ERR;
450             endptr++;
451         }
452     }
453     return JIM_OK;
454 }
455
456 /* The string representation of references has two features in order
457  * to make the GC faster. The first is that every reference starts
458  * with a non common character '~', in order to make the string matching
459  * fater. The second is that the reference string rep his 32 characters
460  * in length, this allows to avoid to check every object with a string
461  * repr < 32, and usually there are many of this objects. */
462
463 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
464
465 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
466 {
467     const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
468     sprintf(buf, fmt, refPtr->tag, id);
469     return JIM_REFERENCE_SPACE;
470 }
471
472 int Jim_DoubleToString(char *buf, double doubleValue)
473 {
474     char *s;
475     int len;
476
477     len = sprintf(buf, "%.17g", doubleValue);
478     s = buf;
479     while(*s) {
480         if (*s == '.') return len;
481         s++;
482     }
483     /* Add a final ".0" if it's a number. But not
484      * for NaN or InF */
485     if (isdigit((int)buf[0])
486         || ((buf[0] == '-' || buf[0] == '+')
487             && isdigit((int)buf[1]))) {
488         s[0] = '.';
489         s[1] = '0';
490         s[2] = '\0';
491         return len+2;
492     }
493     return len;
494 }
495
496 int Jim_StringToDouble(const char *str, double *doublePtr)
497 {
498     char *endptr;
499
500     *doublePtr = strtod(str, &endptr);
501     if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
502         return JIM_ERR;
503     return JIM_OK;
504 }
505
506 static jim_wide JimPowWide(jim_wide b, jim_wide e)
507 {
508     jim_wide i, res = 1;
509     if ((b==0 && e!=0) || (e<0)) return 0;
510     for(i=0; i<e; i++) {res *= b;}
511     return res;
512 }
513
514 /* -----------------------------------------------------------------------------
515  * Special functions
516  * ---------------------------------------------------------------------------*/
517
518 /* Note that 'interp' may be NULL if not available in the
519  * context of the panic. It's only useful to get the error
520  * file descriptor, it will default to stderr otherwise. */
521 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
522 {
523     va_list ap;
524
525     va_start(ap, fmt);
526         /* 
527          * Send it here first.. Assuming STDIO still works
528          */
529     fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
530     vfprintf(stderr, fmt, ap);
531     fprintf(stderr, JIM_NL JIM_NL);
532     va_end(ap);
533
534 #ifdef HAVE_BACKTRACE
535     {
536         void *array[40];
537         int size, i;
538         char **strings;
539
540         size = backtrace(array, 40);
541         strings = backtrace_symbols(array, size);
542         for (i = 0; i < size; i++)
543             fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
544         fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
545         fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
546     }
547 #endif
548         
549         /* This may actually crash... we do it last */
550         if( interp && interp->cookie_stderr ){
551                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
552                 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
553                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL JIM_NL );
554         }
555     abort();
556 }
557
558 /* -----------------------------------------------------------------------------
559  * Memory allocation
560  * ---------------------------------------------------------------------------*/
561
562 /* Macro used for memory debugging.
563  * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
564  * and similary for Jim_Realloc and Jim_Free */
565 #if 0
566 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
567 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
568 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
569 #endif
570
571 void *Jim_Alloc(int size)
572 {
573         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
574         if (size==0)
575                 size=1;
576     void *p = malloc(size);
577     if (p == NULL)
578         Jim_Panic(NULL,"malloc: Out of memory");
579     return p;
580 }
581
582 void Jim_Free(void *ptr) {
583     free(ptr);
584 }
585
586 void *Jim_Realloc(void *ptr, int size)
587 {
588         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
589         if (size==0)
590                 size=1;
591     void *p = realloc(ptr, size);
592     if (p == NULL)
593         Jim_Panic(NULL,"realloc: Out of memory");
594     return p;
595 }
596
597 char *Jim_StrDup(const char *s)
598 {
599     int l = strlen(s);
600     char *copy = Jim_Alloc(l+1);
601
602     memcpy(copy, s, l+1);
603     return copy;
604 }
605
606 char *Jim_StrDupLen(const char *s, int l)
607 {
608     char *copy = Jim_Alloc(l+1);
609     
610     memcpy(copy, s, l+1);
611     copy[l] = 0;    /* Just to be sure, original could be substring */
612     return copy;
613 }
614
615 /* -----------------------------------------------------------------------------
616  * Time related functions
617  * ---------------------------------------------------------------------------*/
618 /* Returns microseconds of CPU used since start. */
619 static jim_wide JimClock(void)
620 {
621 #if (defined WIN32) && !(defined JIM_ANSIC)
622     LARGE_INTEGER t, f;
623     QueryPerformanceFrequency(&f);
624     QueryPerformanceCounter(&t);
625     return (long)((t.QuadPart * 1000000) / f.QuadPart);
626 #else /* !WIN32 */
627     clock_t clocks = clock();
628
629     return (long)(clocks*(1000000/CLOCKS_PER_SEC));
630 #endif /* WIN32 */
631 }
632
633 /* -----------------------------------------------------------------------------
634  * Hash Tables
635  * ---------------------------------------------------------------------------*/
636
637 /* -------------------------- private prototypes ---------------------------- */
638 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
639 static unsigned int JimHashTableNextPower(unsigned int size);
640 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
641
642 /* -------------------------- hash functions -------------------------------- */
643
644 /* Thomas Wang's 32 bit Mix Function */
645 unsigned int Jim_IntHashFunction(unsigned int key)
646 {
647     key += ~(key << 15);
648     key ^=  (key >> 10);
649     key +=  (key << 3);
650     key ^=  (key >> 6);
651     key += ~(key << 11);
652     key ^=  (key >> 16);
653     return key;
654 }
655
656 /* Identity hash function for integer keys */
657 unsigned int Jim_IdentityHashFunction(unsigned int key)
658 {
659     return key;
660 }
661
662 /* Generic hash function (we are using to multiply by 9 and add the byte
663  * as Tcl) */
664 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
665 {
666     unsigned int h = 0;
667     while(len--)
668         h += (h<<3)+*buf++;
669     return h;
670 }
671
672 /* ----------------------------- API implementation ------------------------- */
673 /* reset an hashtable already initialized with ht_init().
674  * NOTE: This function should only called by ht_destroy(). */
675 static void JimResetHashTable(Jim_HashTable *ht)
676 {
677     ht->table = NULL;
678     ht->size = 0;
679     ht->sizemask = 0;
680     ht->used = 0;
681     ht->collisions = 0;
682 }
683
684 /* Initialize the hash table */
685 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
686         void *privDataPtr)
687 {
688     JimResetHashTable(ht);
689     ht->type = type;
690     ht->privdata = privDataPtr;
691     return JIM_OK;
692 }
693
694 /* Resize the table to the minimal size that contains all the elements,
695  * but with the invariant of a USER/BUCKETS ration near to <= 1 */
696 int Jim_ResizeHashTable(Jim_HashTable *ht)
697 {
698     int minimal = ht->used;
699
700     if (minimal < JIM_HT_INITIAL_SIZE)
701         minimal = JIM_HT_INITIAL_SIZE;
702     return Jim_ExpandHashTable(ht, minimal);
703 }
704
705 /* Expand or create the hashtable */
706 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
707 {
708     Jim_HashTable n; /* the new hashtable */
709     unsigned int realsize = JimHashTableNextPower(size), i;
710
711     /* the size is invalid if it is smaller than the number of
712      * elements already inside the hashtable */
713     if (ht->used >= size)
714         return JIM_ERR;
715
716     Jim_InitHashTable(&n, ht->type, ht->privdata);
717     n.size = realsize;
718     n.sizemask = realsize-1;
719     n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
720
721     /* Initialize all the pointers to NULL */
722     memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
723
724     /* Copy all the elements from the old to the new table:
725      * note that if the old hash table is empty ht->size is zero,
726      * so Jim_ExpandHashTable just creates an hash table. */
727     n.used = ht->used;
728     for (i = 0; i < ht->size && ht->used > 0; i++) {
729         Jim_HashEntry *he, *nextHe;
730
731         if (ht->table[i] == NULL) continue;
732         
733         /* For each hash entry on this slot... */
734         he = ht->table[i];
735         while(he) {
736             unsigned int h;
737
738             nextHe = he->next;
739             /* Get the new element index */
740             h = Jim_HashKey(ht, he->key) & n.sizemask;
741             he->next = n.table[h];
742             n.table[h] = he;
743             ht->used--;
744             /* Pass to the next element */
745             he = nextHe;
746         }
747     }
748     assert(ht->used == 0);
749     Jim_Free(ht->table);
750
751     /* Remap the new hashtable in the old */
752     *ht = n;
753     return JIM_OK;
754 }
755
756 /* Add an element to the target hash table */
757 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
758 {
759     int index;
760     Jim_HashEntry *entry;
761
762     /* Get the index of the new element, or -1 if
763      * the element already exists. */
764     if ((index = JimInsertHashEntry(ht, key)) == -1)
765         return JIM_ERR;
766
767     /* Allocates the memory and stores key */
768     entry = Jim_Alloc(sizeof(*entry));
769     entry->next = ht->table[index];
770     ht->table[index] = entry;
771
772     /* Set the hash entry fields. */
773     Jim_SetHashKey(ht, entry, key);
774     Jim_SetHashVal(ht, entry, val);
775     ht->used++;
776     return JIM_OK;
777 }
778
779 /* Add an element, discarding the old if the key already exists */
780 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
781 {
782     Jim_HashEntry *entry;
783
784     /* Try to add the element. If the key
785      * does not exists Jim_AddHashEntry will suceed. */
786     if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
787         return JIM_OK;
788     /* It already exists, get the entry */
789     entry = Jim_FindHashEntry(ht, key);
790     /* Free the old value and set the new one */
791     Jim_FreeEntryVal(ht, entry);
792     Jim_SetHashVal(ht, entry, val);
793     return JIM_OK;
794 }
795
796 /* Search and remove an element */
797 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
798 {
799     unsigned int h;
800     Jim_HashEntry *he, *prevHe;
801
802     if (ht->size == 0)
803         return JIM_ERR;
804     h = Jim_HashKey(ht, key) & ht->sizemask;
805     he = ht->table[h];
806
807     prevHe = NULL;
808     while(he) {
809         if (Jim_CompareHashKeys(ht, key, he->key)) {
810             /* Unlink the element from the list */
811             if (prevHe)
812                 prevHe->next = he->next;
813             else
814                 ht->table[h] = he->next;
815             Jim_FreeEntryKey(ht, he);
816             Jim_FreeEntryVal(ht, he);
817             Jim_Free(he);
818             ht->used--;
819             return JIM_OK;
820         }
821         prevHe = he;
822         he = he->next;
823     }
824     return JIM_ERR; /* not found */
825 }
826
827 /* Destroy an entire hash table */
828 int Jim_FreeHashTable(Jim_HashTable *ht)
829 {
830     unsigned int i;
831
832     /* Free all the elements */
833     for (i = 0; i < ht->size && ht->used > 0; i++) {
834         Jim_HashEntry *he, *nextHe;
835
836         if ((he = ht->table[i]) == NULL) continue;
837         while(he) {
838             nextHe = he->next;
839             Jim_FreeEntryKey(ht, he);
840             Jim_FreeEntryVal(ht, he);
841             Jim_Free(he);
842             ht->used--;
843             he = nextHe;
844         }
845     }
846     /* Free the table and the allocated cache structure */
847     Jim_Free(ht->table);
848     /* Re-initialize the table */
849     JimResetHashTable(ht);
850     return JIM_OK; /* never fails */
851 }
852
853 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
854 {
855     Jim_HashEntry *he;
856     unsigned int h;
857
858     if (ht->size == 0) return NULL;
859     h = Jim_HashKey(ht, key) & ht->sizemask;
860     he = ht->table[h];
861     while(he) {
862         if (Jim_CompareHashKeys(ht, key, he->key))
863             return he;
864         he = he->next;
865     }
866     return NULL;
867 }
868
869 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
870 {
871     Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
872
873     iter->ht = ht;
874     iter->index = -1;
875     iter->entry = NULL;
876     iter->nextEntry = NULL;
877     return iter;
878 }
879
880 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
881 {
882     while (1) {
883         if (iter->entry == NULL) {
884             iter->index++;
885             if (iter->index >=
886                     (signed)iter->ht->size) break;
887             iter->entry = iter->ht->table[iter->index];
888         } else {
889             iter->entry = iter->nextEntry;
890         }
891         if (iter->entry) {
892             /* We need to save the 'next' here, the iterator user
893              * may delete the entry we are returning. */
894             iter->nextEntry = iter->entry->next;
895             return iter->entry;
896         }
897     }
898     return NULL;
899 }
900
901 /* ------------------------- private functions ------------------------------ */
902
903 /* Expand the hash table if needed */
904 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
905 {
906     /* If the hash table is empty expand it to the intial size,
907      * if the table is "full" dobule its size. */
908     if (ht->size == 0)
909         return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
910     if (ht->size == ht->used)
911         return Jim_ExpandHashTable(ht, ht->size*2);
912     return JIM_OK;
913 }
914
915 /* Our hash table capability is a power of two */
916 static unsigned int JimHashTableNextPower(unsigned int size)
917 {
918     unsigned int i = JIM_HT_INITIAL_SIZE;
919
920     if (size >= 2147483648U)
921         return 2147483648U;
922     while(1) {
923         if (i >= size)
924             return i;
925         i *= 2;
926     }
927 }
928
929 /* Returns the index of a free slot that can be populated with
930  * an hash entry for the given 'key'.
931  * If the key already exists, -1 is returned. */
932 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
933 {
934     unsigned int h;
935     Jim_HashEntry *he;
936
937     /* Expand the hashtable if needed */
938     if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
939         return -1;
940     /* Compute the key hash value */
941     h = Jim_HashKey(ht, key) & ht->sizemask;
942     /* Search if this slot does not already contain the given key */
943     he = ht->table[h];
944     while(he) {
945         if (Jim_CompareHashKeys(ht, key, he->key))
946             return -1;
947         he = he->next;
948     }
949     return h;
950 }
951
952 /* ----------------------- StringCopy Hash Table Type ------------------------*/
953
954 static unsigned int JimStringCopyHTHashFunction(const void *key)
955 {
956     return Jim_GenHashFunction(key, strlen(key));
957 }
958
959 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
960 {
961     int len = strlen(key);
962     char *copy = Jim_Alloc(len+1);
963     JIM_NOTUSED(privdata);
964
965     memcpy(copy, key, len);
966     copy[len] = '\0';
967     return copy;
968 }
969
970 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
971 {
972     int len = strlen(val);
973     char *copy = Jim_Alloc(len+1);
974     JIM_NOTUSED(privdata);
975
976     memcpy(copy, val, len);
977     copy[len] = '\0';
978     return copy;
979 }
980
981 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
982         const void *key2)
983 {
984     JIM_NOTUSED(privdata);
985
986     return strcmp(key1, key2) == 0;
987 }
988
989 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
990 {
991     JIM_NOTUSED(privdata);
992
993     Jim_Free((void*)key); /* ATTENTION: const cast */
994 }
995
996 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
997 {
998     JIM_NOTUSED(privdata);
999
1000     Jim_Free((void*)val); /* ATTENTION: const cast */
1001 }
1002
1003 static Jim_HashTableType JimStringCopyHashTableType = {
1004     JimStringCopyHTHashFunction,        /* hash function */
1005     JimStringCopyHTKeyDup,              /* key dup */
1006     NULL,                               /* val dup */
1007     JimStringCopyHTKeyCompare,          /* key compare */
1008     JimStringCopyHTKeyDestructor,       /* key destructor */
1009     NULL                                /* val destructor */
1010 };
1011
1012 /* This is like StringCopy but does not auto-duplicate the key.
1013  * It's used for intepreter's shared strings. */
1014 static Jim_HashTableType JimSharedStringsHashTableType = {
1015     JimStringCopyHTHashFunction,        /* hash function */
1016     NULL,                               /* key dup */
1017     NULL,                               /* val dup */
1018     JimStringCopyHTKeyCompare,          /* key compare */
1019     JimStringCopyHTKeyDestructor,       /* key destructor */
1020     NULL                                /* val destructor */
1021 };
1022
1023 /* This is like StringCopy but also automatically handle dynamic
1024  * allocated C strings as values. */
1025 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1026     JimStringCopyHTHashFunction,        /* hash function */
1027     JimStringCopyHTKeyDup,              /* key dup */
1028     JimStringKeyValCopyHTValDup,        /* val dup */
1029     JimStringCopyHTKeyCompare,          /* key compare */
1030     JimStringCopyHTKeyDestructor,       /* key destructor */
1031     JimStringKeyValCopyHTValDestructor, /* val destructor */
1032 };
1033
1034 typedef struct AssocDataValue {
1035     Jim_InterpDeleteProc *delProc;
1036     void *data;
1037 } AssocDataValue;
1038
1039 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1040 {
1041     AssocDataValue *assocPtr = (AssocDataValue *)data;
1042     if (assocPtr->delProc != NULL)
1043         assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1044     Jim_Free(data);
1045 }
1046
1047 static Jim_HashTableType JimAssocDataHashTableType = {
1048     JimStringCopyHTHashFunction,         /* hash function */
1049     JimStringCopyHTKeyDup,               /* key dup */
1050     NULL,                                /* val dup */
1051     JimStringCopyHTKeyCompare,           /* key compare */
1052     JimStringCopyHTKeyDestructor,        /* key destructor */
1053     JimAssocDataHashTableValueDestructor /* val destructor */
1054 };
1055
1056 /* -----------------------------------------------------------------------------
1057  * Stack - This is a simple generic stack implementation. It is used for
1058  * example in the 'expr' expression compiler.
1059  * ---------------------------------------------------------------------------*/
1060 void Jim_InitStack(Jim_Stack *stack)
1061 {
1062     stack->len = 0;
1063     stack->maxlen = 0;
1064     stack->vector = NULL;
1065 }
1066
1067 void Jim_FreeStack(Jim_Stack *stack)
1068 {
1069     Jim_Free(stack->vector);
1070 }
1071
1072 int Jim_StackLen(Jim_Stack *stack)
1073 {
1074     return stack->len;
1075 }
1076
1077 void Jim_StackPush(Jim_Stack *stack, void *element) {
1078     int neededLen = stack->len+1;
1079     if (neededLen > stack->maxlen) {
1080         stack->maxlen = neededLen*2;
1081         stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1082     }
1083     stack->vector[stack->len] = element;
1084     stack->len++;
1085 }
1086
1087 void *Jim_StackPop(Jim_Stack *stack)
1088 {
1089     if (stack->len == 0) return NULL;
1090     stack->len--;
1091     return stack->vector[stack->len];
1092 }
1093
1094 void *Jim_StackPeek(Jim_Stack *stack)
1095 {
1096     if (stack->len == 0) return NULL;
1097     return stack->vector[stack->len-1];
1098 }
1099
1100 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1101 {
1102     int i;
1103
1104     for (i = 0; i < stack->len; i++)
1105         freeFunc(stack->vector[i]);
1106 }
1107
1108 /* -----------------------------------------------------------------------------
1109  * Parser
1110  * ---------------------------------------------------------------------------*/
1111
1112 /* Token types */
1113 #define JIM_TT_NONE -1        /* No token returned */
1114 #define JIM_TT_STR 0        /* simple string */
1115 #define JIM_TT_ESC 1        /* string that needs escape chars conversion */
1116 #define JIM_TT_VAR 2        /* var substitution */
1117 #define JIM_TT_DICTSUGAR 3    /* Syntax sugar for [dict get], $foo(bar) */
1118 #define JIM_TT_CMD 4        /* command substitution */
1119 #define JIM_TT_SEP 5        /* word separator */
1120 #define JIM_TT_EOL 6        /* line separator */
1121
1122 /* Additional token types needed for expressions */
1123 #define JIM_TT_SUBEXPR_START 7
1124 #define JIM_TT_SUBEXPR_END 8
1125 #define JIM_TT_EXPR_NUMBER 9
1126 #define JIM_TT_EXPR_OPERATOR 10
1127
1128 /* Parser states */
1129 #define JIM_PS_DEF 0        /* Default state */
1130 #define JIM_PS_QUOTE 1        /* Inside "" */
1131
1132 /* Parser context structure. The same context is used both to parse
1133  * Tcl scripts and lists. */
1134 struct JimParserCtx {
1135     const char *prg;     /* Program text */
1136     const char *p;       /* Pointer to the point of the program we are parsing */
1137     int len;             /* Left length of 'prg' */
1138     int linenr;          /* Current line number */
1139     const char *tstart;
1140     const char *tend;    /* Returned token is at tstart-tend in 'prg'. */
1141     int tline;           /* Line number of the returned token */
1142     int tt;              /* Token type */
1143     int eof;             /* Non zero if EOF condition is true. */
1144     int state;           /* Parser state */
1145     int comment;         /* Non zero if the next chars may be a comment. */
1146 };
1147
1148 #define JimParserEof(c) ((c)->eof)
1149 #define JimParserTstart(c) ((c)->tstart)
1150 #define JimParserTend(c) ((c)->tend)
1151 #define JimParserTtype(c) ((c)->tt)
1152 #define JimParserTline(c) ((c)->tline)
1153
1154 static int JimParseScript(struct JimParserCtx *pc);
1155 static int JimParseSep(struct JimParserCtx *pc);
1156 static int JimParseEol(struct JimParserCtx *pc);
1157 static int JimParseCmd(struct JimParserCtx *pc);
1158 static int JimParseVar(struct JimParserCtx *pc);
1159 static int JimParseBrace(struct JimParserCtx *pc);
1160 static int JimParseStr(struct JimParserCtx *pc);
1161 static int JimParseComment(struct JimParserCtx *pc);
1162 static char *JimParserGetToken(struct JimParserCtx *pc,
1163         int *lenPtr, int *typePtr, int *linePtr);
1164
1165 /* Initialize a parser context.
1166  * 'prg' is a pointer to the program text, linenr is the line
1167  * number of the first line contained in the program. */
1168 void JimParserInit(struct JimParserCtx *pc, const char *prg, 
1169         int len, int linenr)
1170 {
1171     pc->prg = prg;
1172     pc->p = prg;
1173     pc->len = len;
1174     pc->tstart = NULL;
1175     pc->tend = NULL;
1176     pc->tline = 0;
1177     pc->tt = JIM_TT_NONE;
1178     pc->eof = 0;
1179     pc->state = JIM_PS_DEF;
1180     pc->linenr = linenr;
1181     pc->comment = 1;
1182 }
1183
1184 int JimParseScript(struct JimParserCtx *pc)
1185 {
1186     while(1) { /* the while is used to reiterate with continue if needed */
1187         if (!pc->len) {
1188             pc->tstart = pc->p;
1189             pc->tend = pc->p-1;
1190             pc->tline = pc->linenr;
1191             pc->tt = JIM_TT_EOL;
1192             pc->eof = 1;
1193             return JIM_OK;
1194         }
1195         switch(*(pc->p)) {
1196         case '\\':
1197             if (*(pc->p+1) == '\n')
1198                 return JimParseSep(pc);
1199             else {
1200                 pc->comment = 0;
1201                 return JimParseStr(pc);
1202             }
1203             break;
1204         case ' ':
1205         case '\t':
1206         case '\r':
1207             if (pc->state == JIM_PS_DEF)
1208                 return JimParseSep(pc);
1209             else {
1210                 pc->comment = 0;
1211                 return JimParseStr(pc);
1212             }
1213             break;
1214         case '\n':
1215         case ';':
1216             pc->comment = 1;
1217             if (pc->state == JIM_PS_DEF)
1218                 return JimParseEol(pc);
1219             else
1220                 return JimParseStr(pc);
1221             break;
1222         case '[':
1223             pc->comment = 0;
1224             return JimParseCmd(pc);
1225             break;
1226         case '$':
1227             pc->comment = 0;
1228             if (JimParseVar(pc) == JIM_ERR) {
1229                 pc->tstart = pc->tend = pc->p++; pc->len--;
1230                 pc->tline = pc->linenr;
1231                 pc->tt = JIM_TT_STR;
1232                 return JIM_OK;
1233             } else
1234                 return JIM_OK;
1235             break;
1236         case '#':
1237             if (pc->comment) {
1238                 JimParseComment(pc);
1239                 continue;
1240             } else {
1241                 return JimParseStr(pc);
1242             }
1243         default:
1244             pc->comment = 0;
1245             return JimParseStr(pc);
1246             break;
1247         }
1248         return JIM_OK;
1249     }
1250 }
1251
1252 int JimParseSep(struct JimParserCtx *pc)
1253 {
1254     pc->tstart = pc->p;
1255     pc->tline = pc->linenr;
1256     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1257            (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1258         if (*pc->p == '\\') {
1259             pc->p++; pc->len--;
1260             pc->linenr++;
1261         }
1262         pc->p++; pc->len--;
1263     }
1264     pc->tend = pc->p-1;
1265     pc->tt = JIM_TT_SEP;
1266     return JIM_OK;
1267 }
1268
1269 int JimParseEol(struct JimParserCtx *pc)
1270 {
1271     pc->tstart = pc->p;
1272     pc->tline = pc->linenr;
1273     while (*pc->p == ' ' || *pc->p == '\n' ||
1274            *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1275         if (*pc->p == '\n')
1276             pc->linenr++;
1277         pc->p++; pc->len--;
1278     }
1279     pc->tend = pc->p-1;
1280     pc->tt = JIM_TT_EOL;
1281     return JIM_OK;
1282 }
1283
1284 /* Todo. Don't stop if ']' appears inside {} or quoted.
1285  * Also should handle the case of puts [string length "]"] */
1286 int JimParseCmd(struct JimParserCtx *pc)
1287 {
1288     int level = 1;
1289     int blevel = 0;
1290
1291     pc->tstart = ++pc->p; pc->len--;
1292     pc->tline = pc->linenr;
1293     while (1) {
1294         if (pc->len == 0) {
1295             break;
1296         } else if (*pc->p == '[' && blevel == 0) {
1297             level++;
1298         } else if (*pc->p == ']' && blevel == 0) {
1299             level--;
1300             if (!level) break;
1301         } else if (*pc->p == '\\') {
1302             pc->p++; pc->len--;
1303         } else if (*pc->p == '{') {
1304             blevel++;
1305         } else if (*pc->p == '}') {
1306             if (blevel != 0)
1307                 blevel--;
1308         } else if (*pc->p == '\n')
1309             pc->linenr++;
1310         pc->p++; pc->len--;
1311     }
1312     pc->tend = pc->p-1;
1313     pc->tt = JIM_TT_CMD;
1314     if (*pc->p == ']') {
1315         pc->p++; pc->len--;
1316     }
1317     return JIM_OK;
1318 }
1319
1320 int JimParseVar(struct JimParserCtx *pc)
1321 {
1322     int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1323
1324     pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1325     pc->tline = pc->linenr;
1326     if (*pc->p == '{') {
1327         pc->tstart = ++pc->p; pc->len--;
1328         brace = 1;
1329     }
1330     if (brace) {
1331         while (!stop) {
1332             if (*pc->p == '}' || pc->len == 0) {
1333                 pc->tend = pc->p-1;
1334                 stop = 1;
1335                 if (pc->len == 0)
1336                     break;
1337             }
1338             else if (*pc->p == '\n')
1339                 pc->linenr++;
1340             pc->p++; pc->len--;
1341         }
1342     } else {
1343         /* Include leading colons */
1344         while (*pc->p == ':') {
1345             pc->p++;
1346             pc->len--;
1347         }
1348         while (!stop) {
1349             if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1350                 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1351                 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1352                 stop = 1;
1353             else {
1354                 pc->p++; pc->len--;
1355             }
1356         }
1357         /* Parse [dict get] syntax sugar. */
1358         if (*pc->p == '(') {
1359             while (*pc->p != ')' && pc->len) {
1360                 pc->p++; pc->len--;
1361                 if (*pc->p == '\\' && pc->len >= 2) {
1362                     pc->p += 2; pc->len -= 2;
1363                 }
1364             }
1365             if (*pc->p != '\0') {
1366                 pc->p++; pc->len--;
1367             }
1368             ttype = JIM_TT_DICTSUGAR;
1369         }
1370         pc->tend = pc->p-1;
1371     }
1372     /* Check if we parsed just the '$' character.
1373      * That's not a variable so an error is returned
1374      * to tell the state machine to consider this '$' just
1375      * a string. */
1376     if (pc->tstart == pc->p) {
1377         pc->p--; pc->len++;
1378         return JIM_ERR;
1379     }
1380     pc->tt = ttype;
1381     return JIM_OK;
1382 }
1383
1384 int JimParseBrace(struct JimParserCtx *pc)
1385 {
1386     int level = 1;
1387
1388     pc->tstart = ++pc->p; pc->len--;
1389     pc->tline = pc->linenr;
1390     while (1) {
1391         if (*pc->p == '\\' && pc->len >= 2) {
1392             pc->p++; pc->len--;
1393             if (*pc->p == '\n')
1394                 pc->linenr++;
1395         } else if (*pc->p == '{') {
1396             level++;
1397         } else if (pc->len == 0 || *pc->p == '}') {
1398             level--;
1399             if (pc->len == 0 || level == 0) {
1400                 pc->tend = pc->p-1;
1401                 if (pc->len != 0) {
1402                     pc->p++; pc->len--;
1403                 }
1404                 pc->tt = JIM_TT_STR;
1405                 return JIM_OK;
1406             }
1407         } else if (*pc->p == '\n') {
1408             pc->linenr++;
1409         }
1410         pc->p++; pc->len--;
1411     }
1412     return JIM_OK; /* unreached */
1413 }
1414
1415 int JimParseStr(struct JimParserCtx *pc)
1416 {
1417     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1418             pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1419     if (newword && *pc->p == '{') {
1420         return JimParseBrace(pc);
1421     } else if (newword && *pc->p == '"') {
1422         pc->state = JIM_PS_QUOTE;
1423         pc->p++; pc->len--;
1424     }
1425     pc->tstart = pc->p;
1426     pc->tline = pc->linenr;
1427     while (1) {
1428         if (pc->len == 0) {
1429             pc->tend = pc->p-1;
1430             pc->tt = JIM_TT_ESC;
1431             return JIM_OK;
1432         }
1433         switch(*pc->p) {
1434         case '\\':
1435             if (pc->state == JIM_PS_DEF &&
1436                 *(pc->p+1) == '\n') {
1437                 pc->tend = pc->p-1;
1438                 pc->tt = JIM_TT_ESC;
1439                 return JIM_OK;
1440             }
1441             if (pc->len >= 2) {
1442                 pc->p++; pc->len--;
1443             }
1444             break;
1445         case '$':
1446         case '[':
1447             pc->tend = pc->p-1;
1448             pc->tt = JIM_TT_ESC;
1449             return JIM_OK;
1450         case ' ':
1451         case '\t':
1452         case '\n':
1453         case '\r':
1454         case ';':
1455             if (pc->state == JIM_PS_DEF) {
1456                 pc->tend = pc->p-1;
1457                 pc->tt = JIM_TT_ESC;
1458                 return JIM_OK;
1459             } else if (*pc->p == '\n') {
1460                 pc->linenr++;
1461             }
1462             break;
1463         case '"':
1464             if (pc->state == JIM_PS_QUOTE) {
1465                 pc->tend = pc->p-1;
1466                 pc->tt = JIM_TT_ESC;
1467                 pc->p++; pc->len--;
1468                 pc->state = JIM_PS_DEF;
1469                 return JIM_OK;
1470             }
1471             break;
1472         }
1473         pc->p++; pc->len--;
1474     }
1475     return JIM_OK; /* unreached */
1476 }
1477
1478 int JimParseComment(struct JimParserCtx *pc)
1479 {
1480     while (*pc->p) {
1481         if (*pc->p == '\n') {
1482             pc->linenr++;
1483             if (*(pc->p-1) != '\\') {
1484                 pc->p++; pc->len--;
1485                 return JIM_OK;
1486             }
1487         }
1488         pc->p++; pc->len--;
1489     }
1490     return JIM_OK;
1491 }
1492
1493 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1494 static int xdigitval(int c)
1495 {
1496     if (c >= '0' && c <= '9') return c-'0';
1497     if (c >= 'a' && c <= 'f') return c-'a'+10;
1498     if (c >= 'A' && c <= 'F') return c-'A'+10;
1499     return -1;
1500 }
1501
1502 static int odigitval(int c)
1503 {
1504     if (c >= '0' && c <= '7') return c-'0';
1505     return -1;
1506 }
1507
1508 /* Perform Tcl escape substitution of 's', storing the result
1509  * string into 'dest'. The escaped string is guaranteed to
1510  * be the same length or shorted than the source string.
1511  * Slen is the length of the string at 's', if it's -1 the string
1512  * length will be calculated by the function.
1513  *
1514  * The function returns the length of the resulting string. */
1515 static int JimEscape(char *dest, const char *s, int slen)
1516 {
1517     char *p = dest;
1518     int i, len;
1519     
1520     if (slen == -1)
1521         slen = strlen(s);
1522
1523     for (i = 0; i < slen; i++) {
1524         switch(s[i]) {
1525         case '\\':
1526             switch(s[i+1]) {
1527             case 'a': *p++ = 0x7; i++; break;
1528             case 'b': *p++ = 0x8; i++; break;
1529             case 'f': *p++ = 0xc; i++; break;
1530             case 'n': *p++ = 0xa; i++; break;
1531             case 'r': *p++ = 0xd; i++; break;
1532             case 't': *p++ = 0x9; i++; break;
1533             case 'v': *p++ = 0xb; i++; break;
1534             case '\0': *p++ = '\\'; i++; break;
1535             case '\n': *p++ = ' '; i++; break;
1536             default:
1537                   if (s[i+1] == 'x') {
1538                     int val = 0;
1539                     int c = xdigitval(s[i+2]);
1540                     if (c == -1) {
1541                         *p++ = 'x';
1542                         i++;
1543                         break;
1544                     }
1545                     val = c;
1546                     c = xdigitval(s[i+3]);
1547                     if (c == -1) {
1548                         *p++ = val;
1549                         i += 2;
1550                         break;
1551                     }
1552                     val = (val*16)+c;
1553                     *p++ = val;
1554                     i += 3;
1555                     break;
1556                   } else if (s[i+1] >= '0' && s[i+1] <= '7')
1557                   {
1558                     int val = 0;
1559                     int c = odigitval(s[i+1]);
1560                     val = c;
1561                     c = odigitval(s[i+2]);
1562                     if (c == -1) {
1563                         *p++ = val;
1564                         i ++;
1565                         break;
1566                     }
1567                     val = (val*8)+c;
1568                     c = odigitval(s[i+3]);
1569                     if (c == -1) {
1570                         *p++ = val;
1571                         i += 2;
1572                         break;
1573                     }
1574                     val = (val*8)+c;
1575                     *p++ = val;
1576                     i += 3;
1577                   } else {
1578                     *p++ = s[i+1];
1579                     i++;
1580                   }
1581                   break;
1582             }
1583             break;
1584         default:
1585             *p++ = s[i];
1586             break;
1587         }
1588     }
1589     len = p-dest;
1590     *p++ = '\0';
1591     return len;
1592 }
1593
1594 /* Returns a dynamically allocated copy of the current token in the
1595  * parser context. The function perform conversion of escapes if
1596  * the token is of type JIM_TT_ESC.
1597  *
1598  * Note that after the conversion, tokens that are grouped with
1599  * braces in the source code, are always recognizable from the
1600  * identical string obtained in a different way from the type.
1601  *
1602  * For exmple the string:
1603  *
1604  * {expand}$a
1605  * 
1606  * will return as first token "expand", of type JIM_TT_STR
1607  *
1608  * While the string:
1609  *
1610  * expand$a
1611  *
1612  * will return as first token "expand", of type JIM_TT_ESC
1613  */
1614 char *JimParserGetToken(struct JimParserCtx *pc,
1615         int *lenPtr, int *typePtr, int *linePtr)
1616 {
1617     const char *start, *end;
1618     char *token;
1619     int len;
1620
1621     start = JimParserTstart(pc);
1622     end = JimParserTend(pc);
1623     if (start > end) {
1624         if (lenPtr) *lenPtr = 0;
1625         if (typePtr) *typePtr = JimParserTtype(pc);
1626         if (linePtr) *linePtr = JimParserTline(pc);
1627         token = Jim_Alloc(1);
1628         token[0] = '\0';
1629         return token;
1630     }
1631     len = (end-start)+1;
1632     token = Jim_Alloc(len+1);
1633     if (JimParserTtype(pc) != JIM_TT_ESC) {
1634         /* No escape conversion needed? Just copy it. */
1635         memcpy(token, start, len);
1636         token[len] = '\0';
1637     } else {
1638         /* Else convert the escape chars. */
1639         len = JimEscape(token, start, len);
1640     }
1641     if (lenPtr) *lenPtr = len;
1642     if (typePtr) *typePtr = JimParserTtype(pc);
1643     if (linePtr) *linePtr = JimParserTline(pc);
1644     return token;
1645 }
1646
1647 /* The following functin is not really part of the parsing engine of Jim,
1648  * but it somewhat related. Given an string and its length, it tries
1649  * to guess if the script is complete or there are instead " " or { }
1650  * open and not completed. This is useful for interactive shells
1651  * implementation and for [info complete].
1652  *
1653  * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1654  * '{' on scripts incomplete missing one or more '}' to be balanced.
1655  * '"' on scripts incomplete missing a '"' char.
1656  *
1657  * If the script is complete, 1 is returned, otherwise 0. */
1658 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1659 {
1660     int level = 0;
1661     int state = ' ';
1662
1663     while(len) {
1664         switch (*s) {
1665             case '\\':
1666                 if (len > 1)
1667                     s++;
1668                 break;
1669             case '"':
1670                 if (state == ' ') {
1671                     state = '"';
1672                 } else if (state == '"') {
1673                     state = ' ';
1674                 }
1675                 break;
1676             case '{':
1677                 if (state == '{') {
1678                     level++;
1679                 } else if (state == ' ') {
1680                     state = '{';
1681                     level++;
1682                 }
1683                 break;
1684             case '}':
1685                 if (state == '{') {
1686                     level--;
1687                     if (level == 0)
1688                         state = ' ';
1689                 }
1690                 break;
1691         }
1692         s++;
1693         len--;
1694     }
1695     if (stateCharPtr)
1696         *stateCharPtr = state;
1697     return state == ' ';
1698 }
1699
1700 /* -----------------------------------------------------------------------------
1701  * Tcl Lists parsing
1702  * ---------------------------------------------------------------------------*/
1703 static int JimParseListSep(struct JimParserCtx *pc);
1704 static int JimParseListStr(struct JimParserCtx *pc);
1705
1706 int JimParseList(struct JimParserCtx *pc)
1707 {
1708     if (pc->len == 0) {
1709         pc->tstart = pc->tend = pc->p;
1710         pc->tline = pc->linenr;
1711         pc->tt = JIM_TT_EOL;
1712         pc->eof = 1;
1713         return JIM_OK;
1714     }
1715     switch(*pc->p) {
1716     case ' ':
1717     case '\n':
1718     case '\t':
1719     case '\r':
1720         if (pc->state == JIM_PS_DEF)
1721             return JimParseListSep(pc);
1722         else
1723             return JimParseListStr(pc);
1724         break;
1725     default:
1726         return JimParseListStr(pc);
1727         break;
1728     }
1729     return JIM_OK;
1730 }
1731
1732 int JimParseListSep(struct JimParserCtx *pc)
1733 {
1734     pc->tstart = pc->p;
1735     pc->tline = pc->linenr;
1736     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1737     {
1738         pc->p++; pc->len--;
1739     }
1740     pc->tend = pc->p-1;
1741     pc->tt = JIM_TT_SEP;
1742     return JIM_OK;
1743 }
1744
1745 int JimParseListStr(struct JimParserCtx *pc)
1746 {
1747     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1748             pc->tt == JIM_TT_NONE);
1749     if (newword && *pc->p == '{') {
1750         return JimParseBrace(pc);
1751     } else if (newword && *pc->p == '"') {
1752         pc->state = JIM_PS_QUOTE;
1753         pc->p++; pc->len--;
1754     }
1755     pc->tstart = pc->p;
1756     pc->tline = pc->linenr;
1757     while (1) {
1758         if (pc->len == 0) {
1759             pc->tend = pc->p-1;
1760             pc->tt = JIM_TT_ESC;
1761             return JIM_OK;
1762         }
1763         switch(*pc->p) {
1764         case '\\':
1765             pc->p++; pc->len--;
1766             break;
1767         case ' ':
1768         case '\t':
1769         case '\n':
1770         case '\r':
1771             if (pc->state == JIM_PS_DEF) {
1772                 pc->tend = pc->p-1;
1773                 pc->tt = JIM_TT_ESC;
1774                 return JIM_OK;
1775             } else if (*pc->p == '\n') {
1776                 pc->linenr++;
1777             }
1778             break;
1779         case '"':
1780             if (pc->state == JIM_PS_QUOTE) {
1781                 pc->tend = pc->p-1;
1782                 pc->tt = JIM_TT_ESC;
1783                 pc->p++; pc->len--;
1784                 pc->state = JIM_PS_DEF;
1785                 return JIM_OK;
1786             }
1787             break;
1788         }
1789         pc->p++; pc->len--;
1790     }
1791     return JIM_OK; /* unreached */
1792 }
1793
1794 /* -----------------------------------------------------------------------------
1795  * Jim_Obj related functions
1796  * ---------------------------------------------------------------------------*/
1797
1798 /* Return a new initialized object. */
1799 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1800 {
1801     Jim_Obj *objPtr;
1802
1803     /* -- Check if there are objects in the free list -- */
1804     if (interp->freeList != NULL) {
1805         /* -- Unlink the object from the free list -- */
1806         objPtr = interp->freeList;
1807         interp->freeList = objPtr->nextObjPtr;
1808     } else {
1809         /* -- No ready to use objects: allocate a new one -- */
1810         objPtr = Jim_Alloc(sizeof(*objPtr));
1811     }
1812
1813     /* Object is returned with refCount of 0. Every
1814      * kind of GC implemented should take care to don't try
1815      * to scan objects with refCount == 0. */
1816     objPtr->refCount = 0;
1817     /* All the other fields are left not initialized to save time.
1818      * The caller will probably want set they to the right
1819      * value anyway. */
1820
1821     /* -- Put the object into the live list -- */
1822     objPtr->prevObjPtr = NULL;
1823     objPtr->nextObjPtr = interp->liveList;
1824     if (interp->liveList)
1825         interp->liveList->prevObjPtr = objPtr;
1826     interp->liveList = objPtr;
1827
1828     return objPtr;
1829 }
1830
1831 /* Free an object. Actually objects are never freed, but
1832  * just moved to the free objects list, where they will be
1833  * reused by Jim_NewObj(). */
1834 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1835 {
1836     /* Check if the object was already freed, panic. */
1837     if (objPtr->refCount != 0)  {
1838         Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1839                 objPtr->refCount);
1840     }
1841     /* Free the internal representation */
1842     Jim_FreeIntRep(interp, objPtr);
1843     /* Free the string representation */
1844     if (objPtr->bytes != NULL) {
1845         if (objPtr->bytes != JimEmptyStringRep)
1846             Jim_Free(objPtr->bytes);
1847     }
1848     /* Unlink the object from the live objects list */
1849     if (objPtr->prevObjPtr)
1850         objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1851     if (objPtr->nextObjPtr)
1852         objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1853     if (interp->liveList == objPtr)
1854         interp->liveList = objPtr->nextObjPtr;
1855     /* Link the object into the free objects list */
1856     objPtr->prevObjPtr = NULL;
1857     objPtr->nextObjPtr = interp->freeList;
1858     if (interp->freeList)
1859         interp->freeList->prevObjPtr = objPtr;
1860     interp->freeList = objPtr;
1861     objPtr->refCount = -1;
1862 }
1863
1864 /* Invalidate the string representation of an object. */
1865 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1866 {
1867     if (objPtr->bytes != NULL) {
1868         if (objPtr->bytes != JimEmptyStringRep)
1869             Jim_Free(objPtr->bytes);
1870     }
1871     objPtr->bytes = NULL;
1872 }
1873
1874 #define Jim_SetStringRep(o, b, l) \
1875     do { (o)->bytes = b; (o)->length = l; } while (0)
1876
1877 /* Set the initial string representation for an object.
1878  * Does not try to free an old one. */
1879 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1880 {
1881     if (length == 0) {
1882         objPtr->bytes = JimEmptyStringRep;
1883         objPtr->length = 0;
1884     } else {
1885         objPtr->bytes = Jim_Alloc(length+1);
1886         objPtr->length = length;
1887         memcpy(objPtr->bytes, bytes, length);
1888         objPtr->bytes[length] = '\0';
1889     }
1890 }
1891
1892 /* Duplicate an object. The returned object has refcount = 0. */
1893 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1894 {
1895     Jim_Obj *dupPtr;
1896
1897     dupPtr = Jim_NewObj(interp);
1898     if (objPtr->bytes == NULL) {
1899         /* Object does not have a valid string representation. */
1900         dupPtr->bytes = NULL;
1901     } else {
1902         Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1903     }
1904     if (objPtr->typePtr != NULL) {
1905         if (objPtr->typePtr->dupIntRepProc == NULL) {
1906             dupPtr->internalRep = objPtr->internalRep;
1907         } else {
1908             objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1909         }
1910         dupPtr->typePtr = objPtr->typePtr;
1911     } else {
1912         dupPtr->typePtr = NULL;
1913     }
1914     return dupPtr;
1915 }
1916
1917 /* Return the string representation for objPtr. If the object
1918  * string representation is invalid, calls the method to create
1919  * a new one starting from the internal representation of the object. */
1920 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1921 {
1922     if (objPtr->bytes == NULL) {
1923         /* Invalid string repr. Generate it. */
1924         if (objPtr->typePtr->updateStringProc == NULL) {
1925             Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1926                 objPtr->typePtr->name);
1927         }
1928         objPtr->typePtr->updateStringProc(objPtr);
1929     }
1930     if (lenPtr)
1931         *lenPtr = objPtr->length;
1932     return objPtr->bytes;
1933 }
1934
1935 /* Just returns the length of the object's string rep */
1936 int Jim_Length(Jim_Obj *objPtr)
1937 {
1938     int len;
1939
1940     Jim_GetString(objPtr, &len);
1941     return len;
1942 }
1943
1944 /* -----------------------------------------------------------------------------
1945  * String Object
1946  * ---------------------------------------------------------------------------*/
1947 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1948 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1949
1950 static Jim_ObjType stringObjType = {
1951     "string",
1952     NULL,
1953     DupStringInternalRep,
1954     NULL,
1955     JIM_TYPE_REFERENCES,
1956 };
1957
1958 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1959 {
1960     JIM_NOTUSED(interp);
1961
1962     /* This is a bit subtle: the only caller of this function
1963      * should be Jim_DuplicateObj(), that will copy the
1964      * string representaion. After the copy, the duplicated
1965      * object will not have more room in teh buffer than
1966      * srcPtr->length bytes. So we just set it to length. */
1967     dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1968 }
1969
1970 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1971 {
1972     /* Get a fresh string representation. */
1973     (void) Jim_GetString(objPtr, NULL);
1974     /* Free any other internal representation. */
1975     Jim_FreeIntRep(interp, objPtr);
1976     /* Set it as string, i.e. just set the maxLength field. */
1977     objPtr->typePtr = &stringObjType;
1978     objPtr->internalRep.strValue.maxLength = objPtr->length;
1979     return JIM_OK;
1980 }
1981
1982 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1983 {
1984     Jim_Obj *objPtr = Jim_NewObj(interp);
1985
1986     if (len == -1)
1987         len = strlen(s);
1988     /* Alloc/Set the string rep. */
1989     if (len == 0) {
1990         objPtr->bytes = JimEmptyStringRep;
1991         objPtr->length = 0;
1992     } else {
1993         objPtr->bytes = Jim_Alloc(len+1);
1994         objPtr->length = len;
1995         memcpy(objPtr->bytes, s, len);
1996         objPtr->bytes[len] = '\0';
1997     }
1998
1999     /* No typePtr field for the vanilla string object. */
2000     objPtr->typePtr = NULL;
2001     return objPtr;
2002 }
2003
2004 /* This version does not try to duplicate the 's' pointer, but
2005  * use it directly. */
2006 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2007 {
2008     Jim_Obj *objPtr = Jim_NewObj(interp);
2009
2010     if (len == -1)
2011         len = strlen(s);
2012     Jim_SetStringRep(objPtr, s, len);
2013     objPtr->typePtr = NULL;
2014     return objPtr;
2015 }
2016
2017 /* Low-level string append. Use it only against objects
2018  * of type "string". */
2019 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2020 {
2021     int needlen;
2022
2023     if (len == -1)
2024         len = strlen(str);
2025     needlen = objPtr->length + len;
2026     if (objPtr->internalRep.strValue.maxLength < needlen ||
2027         objPtr->internalRep.strValue.maxLength == 0) {
2028         if (objPtr->bytes == JimEmptyStringRep) {
2029             objPtr->bytes = Jim_Alloc((needlen*2)+1);
2030         } else {
2031             objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2032         }
2033         objPtr->internalRep.strValue.maxLength = needlen*2;
2034     }
2035     memcpy(objPtr->bytes + objPtr->length, str, len);
2036     objPtr->bytes[objPtr->length+len] = '\0';
2037     objPtr->length += len;
2038 }
2039
2040 /* Low-level wrapper to append an object. */
2041 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2042 {
2043     int len;
2044     const char *str;
2045
2046     str = Jim_GetString(appendObjPtr, &len);
2047     StringAppendString(objPtr, str, len);
2048 }
2049
2050 /* Higher level API to append strings to objects. */
2051 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2052         int len)
2053 {
2054     if (Jim_IsShared(objPtr))
2055         Jim_Panic(interp,"Jim_AppendString called with shared object");
2056     if (objPtr->typePtr != &stringObjType)
2057         SetStringFromAny(interp, objPtr);
2058     StringAppendString(objPtr, str, len);
2059 }
2060
2061 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2062 {
2063         char *buf;
2064         va_list ap;
2065
2066         va_start( ap, fmt );
2067         buf = jim_vasprintf( fmt, ap );
2068         va_end(ap);
2069
2070         if( buf ){
2071                 Jim_AppendString( interp, objPtr, buf, -1 );
2072                 jim_vasprintf_done(buf);
2073         }
2074 }
2075
2076
2077 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2078         Jim_Obj *appendObjPtr)
2079 {
2080     int len;
2081     const char *str;
2082
2083     str = Jim_GetString(appendObjPtr, &len);
2084     Jim_AppendString(interp, objPtr, str, len);
2085 }
2086
2087 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2088 {
2089     va_list ap;
2090
2091     if (objPtr->typePtr != &stringObjType)
2092         SetStringFromAny(interp, objPtr);
2093     va_start(ap, objPtr);
2094     while (1) {
2095         char *s = va_arg(ap, char*);
2096
2097         if (s == NULL) break;
2098         Jim_AppendString(interp, objPtr, s, -1);
2099     }
2100     va_end(ap);
2101 }
2102
2103 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2104 {
2105     const char *aStr, *bStr;
2106     int aLen, bLen, i;
2107
2108     if (aObjPtr == bObjPtr) return 1;
2109     aStr = Jim_GetString(aObjPtr, &aLen);
2110     bStr = Jim_GetString(bObjPtr, &bLen);
2111     if (aLen != bLen) return 0;
2112     if (nocase == 0)
2113         return memcmp(aStr, bStr, aLen) == 0;
2114     for (i = 0; i < aLen; i++) {
2115         if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2116             return 0;
2117     }
2118     return 1;
2119 }
2120
2121 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2122         int nocase)
2123 {
2124     const char *pattern, *string;
2125     int patternLen, stringLen;
2126
2127     pattern = Jim_GetString(patternObjPtr, &patternLen);
2128     string = Jim_GetString(objPtr, &stringLen);
2129     return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2130 }
2131
2132 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2133         Jim_Obj *secondObjPtr, int nocase)
2134 {
2135     const char *s1, *s2;
2136     int l1, l2;
2137
2138     s1 = Jim_GetString(firstObjPtr, &l1);
2139     s2 = Jim_GetString(secondObjPtr, &l2);
2140     return JimStringCompare(s1, l1, s2, l2, nocase);
2141 }
2142
2143 /* Convert a range, as returned by Jim_GetRange(), into
2144  * an absolute index into an object of the specified length.
2145  * This function may return negative values, or values
2146  * bigger or equal to the length of the list if the index
2147  * is out of range. */
2148 static int JimRelToAbsIndex(int len, int index)
2149 {
2150     if (index < 0)
2151         return len + index;
2152     return index;
2153 }
2154
2155 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2156  * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2157  * for implementation of commands like [string range] and [lrange].
2158  *
2159  * The resulting range is guaranteed to address valid elements of
2160  * the structure. */
2161 static void JimRelToAbsRange(int len, int first, int last,
2162         int *firstPtr, int *lastPtr, int *rangeLenPtr)
2163 {
2164     int rangeLen;
2165
2166     if (first > last) {
2167         rangeLen = 0;
2168     } else {
2169         rangeLen = last-first+1;
2170         if (rangeLen) {
2171             if (first < 0) {
2172                 rangeLen += first;
2173                 first = 0;
2174             }
2175             if (last >= len) {
2176                 rangeLen -= (last-(len-1));
2177                 last = len-1;
2178             }
2179         }
2180     }
2181     if (rangeLen < 0) rangeLen = 0;
2182
2183     *firstPtr = first;
2184     *lastPtr = last;
2185     *rangeLenPtr = rangeLen;
2186 }
2187
2188 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2189         Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2190 {
2191     int first, last;
2192     const char *str;
2193     int len, rangeLen;
2194
2195     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2196         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2197         return NULL;
2198     str = Jim_GetString(strObjPtr, &len);
2199     first = JimRelToAbsIndex(len, first);
2200     last = JimRelToAbsIndex(len, last);
2201     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2202     return Jim_NewStringObj(interp, str+first, rangeLen);
2203 }
2204
2205 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2206 {
2207     char *buf;
2208     int i;
2209     if (strObjPtr->typePtr != &stringObjType) {
2210         SetStringFromAny(interp, strObjPtr);
2211     }
2212
2213     buf = Jim_Alloc(strObjPtr->length+1);
2214
2215     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2216     for (i = 0; i < strObjPtr->length; i++)
2217         buf[i] = tolower(buf[i]);
2218     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2219 }
2220
2221 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2222 {
2223     char *buf;
2224     int i;
2225     if (strObjPtr->typePtr != &stringObjType) {
2226         SetStringFromAny(interp, strObjPtr);
2227     }
2228
2229     buf = Jim_Alloc(strObjPtr->length+1);
2230
2231     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2232     for (i = 0; i < strObjPtr->length; i++)
2233         buf[i] = toupper(buf[i]);
2234     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2235 }
2236
2237 /* This is the core of the [format] command.
2238  * TODO: Lots of things work - via a hack
2239  *       However, no format item can be >= JIM_MAX_FMT 
2240  */
2241 #define JIM_MAX_FMT 2048
2242 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2243         int objc, Jim_Obj *const *objv, char *sprintf_buf)
2244 {
2245     const char *fmt, *_fmt;
2246     int fmtLen;
2247     Jim_Obj *resObjPtr;
2248     
2249
2250     fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2251         _fmt = fmt;
2252     resObjPtr = Jim_NewStringObj(interp, "", 0);
2253     while (fmtLen) {
2254         const char *p = fmt;
2255         char spec[2], c;
2256         jim_wide wideValue;
2257                 double doubleValue;
2258                 /* we cheat and use Sprintf()! */
2259                 char fmt_str[100];
2260                 char *cp;
2261                 int width;
2262                 int ljust;
2263                 int zpad;
2264                 int spad;
2265                 int altfm;
2266                 int forceplus;
2267                 int prec;
2268                 int inprec;
2269                 int haveprec;
2270                 int accum;
2271
2272         while (*fmt != '%' && fmtLen) {
2273             fmt++; fmtLen--;
2274         }
2275         Jim_AppendString(interp, resObjPtr, p, fmt-p);
2276         if (fmtLen == 0)
2277             break;
2278         fmt++; fmtLen--; /* skip '%' */
2279                 zpad = 0;
2280                 spad = 0;
2281                 width = -1;
2282                 ljust = 0;
2283                 altfm = 0;
2284                 forceplus = 0;
2285                 inprec = 0;
2286                 haveprec = 0;
2287                 prec = -1; /* not found yet */
2288     next_fmt:
2289                 if( fmtLen <= 0 ){
2290                         break;
2291                 }
2292                 switch( *fmt ){
2293                         /* terminals */
2294         case 'b': /* binary - not all printfs() do this */
2295                 case 's': /* string */
2296                 case 'i': /* integer */
2297                 case 'd': /* decimal */
2298                 case 'x': /* hex */
2299                 case 'X': /* CAP hex */
2300                 case 'c': /* char */
2301                 case 'o': /* octal */
2302                 case 'u': /* unsigned */
2303                 case 'f': /* float */
2304                         break;
2305                         
2306                         /* non-terminals */
2307                 case '0': /* zero pad */
2308                         zpad = 1;
2309                         fmt++;  fmtLen--;
2310                         goto next_fmt;
2311                         break;
2312                 case '+':
2313                         forceplus = 1;
2314                         fmt++;  fmtLen--;
2315                         goto next_fmt;
2316                         break;
2317                 case ' ': /* sign space */
2318                         spad = 1;
2319                         fmt++;  fmtLen--;
2320                         goto next_fmt;
2321                         break;
2322                 case '-':
2323                         ljust = 1;
2324                         fmt++;  fmtLen--;
2325                         goto next_fmt;
2326                         break;
2327                 case '#':
2328                         altfm = 1;
2329                         fmt++; fmtLen--;
2330                         goto next_fmt;
2331                         
2332                 case '.':
2333                         inprec = 1;
2334                         fmt++; fmtLen--;
2335                         goto next_fmt;
2336                         break;
2337                 case '1':
2338                 case '2':
2339                 case '3':
2340                 case '4':
2341                 case '5':
2342                 case '6':
2343                 case '7':
2344                 case '8':
2345                 case '9':
2346                         accum = 0;
2347                         while( isdigit(*fmt) && (fmtLen > 0) ){
2348                                 accum = (accum * 10) + (*fmt - '0');
2349                                 fmt++;  fmtLen--;
2350                         }
2351                         if( inprec ){
2352                                 haveprec = 1;
2353                                 prec = accum;
2354                         } else {
2355                                 width = accum;
2356                         }
2357                         goto next_fmt;
2358                 case '*':
2359                         /* suck up the next item as an integer */
2360                         fmt++;  fmtLen--;
2361                         objc--;
2362                         if( objc <= 0 ){
2363                                 goto not_enough_args;
2364                         }
2365                         if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2366                                 Jim_FreeNewObj(interp, resObjPtr );
2367                                 return NULL;
2368                         }
2369                         if( inprec ){
2370                                 haveprec = 1;
2371                                 prec = wideValue;
2372                                 if( prec < 0 ){
2373                                         /* man 3 printf says */
2374                                         /* if prec is negative, it is zero */
2375                                         prec = 0;
2376                                 }
2377                         } else {
2378                         width = wideValue;
2379                         if( width < 0 ){
2380                                 ljust = 1;
2381                                 width = -width;
2382                         }
2383                         }
2384                         objv++;
2385                         goto next_fmt;
2386                         break;
2387                 }
2388                 
2389                 
2390                 if (*fmt != '%') {
2391             if (objc == 0) {
2392                         not_enough_args:
2393                 Jim_FreeNewObj(interp, resObjPtr);
2394                 Jim_SetResultString(interp,
2395                                                                         "not enough arguments for all format specifiers", -1);
2396                 return NULL;
2397             } else {
2398                 objc--;
2399             }
2400         }
2401                 
2402                 /*
2403                  * Create the formatter
2404                  * cause we cheat and use sprintf()
2405                  */
2406                 cp = fmt_str;
2407                 *cp++ = '%';
2408                 if( altfm ){
2409                         *cp++ = '#';
2410                 }
2411                 if( forceplus ){
2412                         *cp++ = '+';
2413                 } else if( spad ){
2414                         /* PLUS overrides */
2415                         *cp++ = ' ';
2416                 }
2417                 if( ljust ){
2418                         *cp++ = '-';
2419                 }
2420                 if( zpad  ){
2421                         *cp++ = '0';
2422                 }
2423                 if( width > 0 ){
2424                         sprintf( cp, "%d", width );
2425                         /* skip ahead */
2426                         cp = strchr(cp,0);
2427                 }
2428                 /* did we find a period? */
2429                 if( inprec ){
2430                         /* then add it */
2431                         *cp++ = '.';
2432                         /* did something occur after the period? */
2433                         if( haveprec ){
2434                                 sprintf( cp, "%d", prec );
2435                         }
2436                         cp = strchr(cp,0);
2437                 }
2438                 *cp = 0;
2439
2440                 /* here we do the work */
2441                 /* actually - we make sprintf() do it for us */
2442         switch(*fmt) {
2443         case 's':
2444                         *cp++ = 's';
2445                         *cp   = 0;
2446                         /* BUG: we do not handled embeded NULLs */
2447                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2448             break;
2449         case 'c':
2450                         *cp++ = 'c';
2451                         *cp   = 0;
2452             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2453                 Jim_FreeNewObj(interp, resObjPtr);
2454                 return NULL;
2455             }
2456             c = (char) wideValue;
2457                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2458             break;
2459                 case 'f':
2460                 case 'F':
2461                 case 'g':
2462                 case 'G':
2463                 case 'e':
2464                 case 'E':
2465                         *cp++ = *fmt;
2466                         *cp   = 0;
2467                         if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2468                                 Jim_FreeNewObj( interp, resObjPtr );
2469                                 return NULL;
2470                         }
2471                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2472                         break;
2473         case 'b':
2474         case 'd':
2475         case 'o':
2476                 case 'i':
2477                 case 'u':
2478                 case 'x':
2479                 case 'X':
2480                         /* jim widevaluse are 64bit */
2481                         if( sizeof(jim_wide) == sizeof(long long) ){
2482                                 *cp++ = 'l'; 
2483                                 *cp++ = 'l';
2484                         } else {
2485                                 *cp++ = 'l';
2486                         }
2487                         *cp++ = *fmt;
2488                         *cp   = 0;
2489             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2490                 Jim_FreeNewObj(interp, resObjPtr);
2491                 return NULL;
2492             }
2493                         snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2494             break;
2495         case '%':
2496                         sprintf_buf[0] = '%';
2497                         sprintf_buf[1] = 0;
2498                         objv--; /* undo the objv++ below */
2499             break;
2500         default:
2501             spec[0] = *fmt; spec[1] = '\0';
2502             Jim_FreeNewObj(interp, resObjPtr);
2503             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2504             Jim_AppendStrings(interp, Jim_GetResult(interp),
2505                     "bad field specifier \"",  spec, "\"", NULL);
2506             return NULL;
2507         }
2508                 /* force terminate */
2509 #if 0
2510                 printf("FMT was: %s\n", fmt_str );
2511                 printf("RES was: |%s|\n", sprintf_buf );
2512 #endif
2513                 
2514                 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2515                 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2516                 /* next obj */
2517                 objv++;
2518         fmt++;
2519         fmtLen--;
2520     }
2521     return resObjPtr;
2522 }
2523
2524 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2525         int objc, Jim_Obj *const *objv)
2526 {
2527         char *sprintf_buf=malloc(JIM_MAX_FMT);
2528         Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2529         free(sprintf_buf);
2530         return t; 
2531 }
2532
2533 /* -----------------------------------------------------------------------------
2534  * Compared String Object
2535  * ---------------------------------------------------------------------------*/
2536
2537 /* This is strange object that allows to compare a C literal string
2538  * with a Jim object in very short time if the same comparison is done
2539  * multiple times. For example every time the [if] command is executed,
2540  * Jim has to check if a given argument is "else". This comparions if
2541  * the code has no errors are true most of the times, so we can cache
2542  * inside the object the pointer of the string of the last matching
2543  * comparison. Because most C compilers perform literal sharing,
2544  * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2545  * this works pretty well even if comparisons are at different places
2546  * inside the C code. */
2547
2548 static Jim_ObjType comparedStringObjType = {
2549     "compared-string",
2550     NULL,
2551     NULL,
2552     NULL,
2553     JIM_TYPE_REFERENCES,
2554 };
2555
2556 /* The only way this object is exposed to the API is via the following
2557  * function. Returns true if the string and the object string repr.
2558  * are the same, otherwise zero is returned.
2559  *
2560  * Note: this isn't binary safe, but it hardly needs to be.*/
2561 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2562         const char *str)
2563 {
2564     if (objPtr->typePtr == &comparedStringObjType &&
2565         objPtr->internalRep.ptr == str)
2566         return 1;
2567     else {
2568         const char *objStr = Jim_GetString(objPtr, NULL);
2569         if (strcmp(str, objStr) != 0) return 0;
2570         if (objPtr->typePtr != &comparedStringObjType) {
2571             Jim_FreeIntRep(interp, objPtr);
2572             objPtr->typePtr = &comparedStringObjType;
2573         }
2574         objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2575         return 1;
2576     }
2577 }
2578
2579 int qsortCompareStringPointers(const void *a, const void *b)
2580 {
2581     char * const *sa = (char * const *)a;
2582     char * const *sb = (char * const *)b;
2583     return strcmp(*sa, *sb);
2584 }
2585
2586 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2587         const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2588 {
2589     const char * const *entryPtr = NULL;
2590     char **tablePtrSorted;
2591     int i, count = 0;
2592
2593     *indexPtr = -1;
2594     for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2595         if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2596             *indexPtr = i;
2597             return JIM_OK;
2598         }
2599         count++; /* If nothing matches, this will reach the len of tablePtr */
2600     }
2601     if (flags & JIM_ERRMSG) {
2602         if (name == NULL)
2603             name = "option";
2604         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2605         Jim_AppendStrings(interp, Jim_GetResult(interp),
2606             "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2607             NULL);
2608         tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2609         memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2610         qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2611         for (i = 0; i < count; i++) {
2612             if (i+1 == count && count > 1)
2613                 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2614             Jim_AppendString(interp, Jim_GetResult(interp),
2615                     tablePtrSorted[i], -1);
2616             if (i+1 != count)
2617                 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2618         }
2619         Jim_Free(tablePtrSorted);
2620     }
2621     return JIM_ERR;
2622 }
2623
2624 int Jim_GetNvp(Jim_Interp *interp, 
2625                            Jim_Obj *objPtr,
2626                            const Jim_Nvp *nvp_table, 
2627                            const Jim_Nvp ** result)
2628 {
2629         Jim_Nvp *n;
2630         int e;
2631
2632         e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2633         if( e == JIM_ERR ){
2634                 return e;
2635         }
2636
2637         /* Success? found? */
2638         if( n->name ){
2639                 /* remove const */
2640                 *result = (Jim_Nvp *)n;
2641                 return JIM_OK;
2642         } else {
2643                 return JIM_ERR;
2644         }
2645 }
2646
2647 /* -----------------------------------------------------------------------------
2648  * Source Object
2649  *
2650  * This object is just a string from the language point of view, but
2651  * in the internal representation it contains the filename and line number
2652  * where this given token was read. This information is used by
2653  * Jim_EvalObj() if the object passed happens to be of type "source".
2654  *
2655  * This allows to propagate the information about line numbers and file
2656  * names and give error messages with absolute line numbers.
2657  *
2658  * Note that this object uses shared strings for filenames, and the
2659  * pointer to the filename together with the line number is taken into
2660  * the space for the "inline" internal represenation of the Jim_Object,
2661  * so there is almost memory zero-overhead.
2662  *
2663  * Also the object will be converted to something else if the given
2664  * token it represents in the source file is not something to be
2665  * evaluated (not a script), and will be specialized in some other way,
2666  * so the time overhead is alzo null.
2667  * ---------------------------------------------------------------------------*/
2668
2669 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2670 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2671
2672 static Jim_ObjType sourceObjType = {
2673     "source",
2674     FreeSourceInternalRep,
2675     DupSourceInternalRep,
2676     NULL,
2677     JIM_TYPE_REFERENCES,
2678 };
2679
2680 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2681 {
2682     Jim_ReleaseSharedString(interp,
2683             objPtr->internalRep.sourceValue.fileName);
2684 }
2685
2686 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2687 {
2688     dupPtr->internalRep.sourceValue.fileName =
2689         Jim_GetSharedString(interp,
2690                 srcPtr->internalRep.sourceValue.fileName);
2691     dupPtr->internalRep.sourceValue.lineNumber =
2692         dupPtr->internalRep.sourceValue.lineNumber;
2693     dupPtr->typePtr = &sourceObjType;
2694 }
2695
2696 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2697         const char *fileName, int lineNumber)
2698 {
2699     if (Jim_IsShared(objPtr))
2700         Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2701     if (objPtr->typePtr != NULL)
2702         Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2703     objPtr->internalRep.sourceValue.fileName =
2704         Jim_GetSharedString(interp, fileName);
2705     objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2706     objPtr->typePtr = &sourceObjType;
2707 }
2708
2709 /* -----------------------------------------------------------------------------
2710  * Script Object
2711  * ---------------------------------------------------------------------------*/
2712
2713 #define JIM_CMDSTRUCT_EXPAND -1
2714
2715 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2716 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2717 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2718
2719 static Jim_ObjType scriptObjType = {
2720     "script",
2721     FreeScriptInternalRep,
2722     DupScriptInternalRep,
2723     NULL,
2724     JIM_TYPE_REFERENCES,
2725 };
2726
2727 /* The ScriptToken structure represents every token into a scriptObj.
2728  * Every token contains an associated Jim_Obj that can be specialized
2729  * by commands operating on it. */
2730 typedef struct ScriptToken {
2731     int type;
2732     Jim_Obj *objPtr;
2733     int linenr;
2734 } ScriptToken;
2735
2736 /* This is the script object internal representation. An array of
2737  * ScriptToken structures, with an associated command structure array.
2738  * The command structure is a pre-computed representation of the
2739  * command length and arguments structure as a simple liner array
2740  * of integers.
2741  * 
2742  * For example the script:
2743  *
2744  * puts hello
2745  * set $i $x$y [foo]BAR
2746  *
2747  * will produce a ScriptObj with the following Tokens:
2748  *
2749  * ESC puts
2750  * SEP
2751  * ESC hello
2752  * EOL
2753  * ESC set
2754  * EOL
2755  * VAR i
2756  * SEP
2757  * VAR x
2758  * VAR y
2759  * SEP
2760  * CMD foo
2761  * ESC BAR
2762  * EOL
2763  *
2764  * This is a description of the tokens, separators, and of lines.
2765  * The command structure instead represents the number of arguments
2766  * of every command, followed by the tokens of which every argument
2767  * is composed. So for the example script, the cmdstruct array will
2768  * contain:
2769  *
2770  * 2 1 1 4 1 1 2 2
2771  *
2772  * Because "puts hello" has two args (2), composed of single tokens (1 1)
2773  * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2774  * composed of single tokens (1 1) and the last two of double tokens
2775  * (2 2).
2776  *
2777  * The precomputation of the command structure makes Jim_Eval() faster,
2778  * and simpler because there aren't dynamic lengths / allocations.
2779  *
2780  * -- {expand} handling --
2781  *
2782  * Expand is handled in a special way. When a command
2783  * contains at least an argument with the {expand} prefix,
2784  * the command structure presents a -1 before the integer
2785  * describing the number of arguments. This is used in order
2786  * to send the command exection to a different path in case
2787  * of {expand} and guarantee a fast path for the more common
2788  * case. Also, the integers describing the number of tokens
2789  * are expressed with negative sign, to allow for fast check
2790  * of what's an {expand}-prefixed argument and what not.
2791  *
2792  * For example the command:
2793  *
2794  * list {expand}{1 2}
2795  *
2796  * Will produce the following cmdstruct array:
2797  *
2798  * -1 2 1 -2
2799  *
2800  * -- the substFlags field of the structure --
2801  *
2802  * The scriptObj structure is used to represent both "script" objects
2803  * and "subst" objects. In the second case, the cmdStruct related
2804  * fields are not used at all, but there is an additional field used
2805  * that is 'substFlags': this represents the flags used to turn
2806  * the string into the intenral representation used to perform the
2807  * substitution. If this flags are not what the application requires
2808  * the scriptObj is created again. For example the script:
2809  *
2810  * subst -nocommands $string
2811  * subst -novariables $string
2812  *
2813  * Will recreate the internal representation of the $string object
2814  * two times.
2815  */
2816 typedef struct ScriptObj {
2817     int len; /* Length as number of tokens. */
2818     int commands; /* number of top-level commands in script. */
2819     ScriptToken *token; /* Tokens array. */
2820     int *cmdStruct; /* commands structure */
2821     int csLen; /* length of the cmdStruct array. */
2822     int substFlags; /* flags used for the compilation of "subst" objects */
2823     int inUse; /* Used to share a ScriptObj. Currently
2824               only used by Jim_EvalObj() as protection against
2825               shimmering of the currently evaluated object. */
2826     char *fileName;
2827 } ScriptObj;
2828
2829 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2830 {
2831     int i;
2832     struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2833
2834     script->inUse--;
2835     if (script->inUse != 0) return;
2836     for (i = 0; i < script->len; i++) {
2837         if (script->token[i].objPtr != NULL)
2838             Jim_DecrRefCount(interp, script->token[i].objPtr);
2839     }
2840     Jim_Free(script->token);
2841     Jim_Free(script->cmdStruct);
2842     Jim_Free(script->fileName);
2843     Jim_Free(script);
2844 }
2845
2846 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2847 {
2848     JIM_NOTUSED(interp);
2849     JIM_NOTUSED(srcPtr);
2850
2851     /* Just returns an simple string. */
2852     dupPtr->typePtr = NULL;
2853 }
2854
2855 /* Add a new token to the internal repr of a script object */
2856 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2857         char *strtoken, int len, int type, char *filename, int linenr)
2858 {
2859     int prevtype;
2860     struct ScriptToken *token;
2861
2862     prevtype = (script->len == 0) ? JIM_TT_EOL : \
2863         script->token[script->len-1].type;
2864     /* Skip tokens without meaning, like words separators
2865      * following a word separator or an end of command and
2866      * so on. */
2867     if (prevtype == JIM_TT_EOL) {
2868         if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2869             Jim_Free(strtoken);
2870             return;
2871         }
2872     } else if (prevtype == JIM_TT_SEP) {
2873         if (type == JIM_TT_SEP) {
2874             Jim_Free(strtoken);
2875             return;
2876         } else if (type == JIM_TT_EOL) {
2877             /* If an EOL is following by a SEP, drop the previous
2878              * separator. */
2879             script->len--;
2880             Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2881         }
2882     } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2883             type == JIM_TT_ESC && len == 0)
2884     {
2885         /* Don't add empty tokens used in interpolation */
2886         Jim_Free(strtoken);
2887         return;
2888     }
2889     /* Make space for a new istruction */
2890     script->len++;
2891     script->token = Jim_Realloc(script->token,
2892             sizeof(ScriptToken)*script->len);
2893     /* Initialize the new token */
2894     token = script->token+(script->len-1);
2895     token->type = type;
2896     /* Every object is intially as a string, but the
2897      * internal type may be specialized during execution of the
2898      * script. */
2899     token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2900     /* To add source info to SEP and EOL tokens is useless because
2901      * they will never by called as arguments of Jim_EvalObj(). */
2902     if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2903         JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2904     Jim_IncrRefCount(token->objPtr);
2905     token->linenr = linenr;
2906 }
2907
2908 /* Add an integer into the command structure field of the script object. */
2909 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2910 {
2911     script->csLen++;
2912     script->cmdStruct = Jim_Realloc(script->cmdStruct,
2913                     sizeof(int)*script->csLen);
2914     script->cmdStruct[script->csLen-1] = val;
2915 }
2916
2917 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2918  * of objPtr. Search nested script objects recursively. */
2919 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2920         ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2921 {
2922     int i;
2923
2924     for (i = 0; i < script->len; i++) {
2925         if (script->token[i].objPtr != objPtr &&
2926             Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2927             return script->token[i].objPtr;
2928         }
2929         /* Enter recursively on scripts only if the object
2930          * is not the same as the one we are searching for
2931          * shared occurrences. */
2932         if (script->token[i].objPtr->typePtr == &scriptObjType &&
2933             script->token[i].objPtr != objPtr) {
2934             Jim_Obj *foundObjPtr;
2935
2936             ScriptObj *subScript =
2937                 script->token[i].objPtr->internalRep.ptr;
2938             /* Don't recursively enter the script we are trying
2939              * to make shared to avoid circular references. */
2940             if (subScript == scriptBarrier) continue;
2941             if (subScript != script) {
2942                 foundObjPtr =
2943                     ScriptSearchLiteral(interp, subScript,
2944                             scriptBarrier, objPtr);
2945                 if (foundObjPtr != NULL)
2946                     return foundObjPtr;
2947             }
2948         }
2949     }
2950     return NULL;
2951 }
2952
2953 /* Share literals of a script recursively sharing sub-scripts literals. */
2954 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2955         ScriptObj *topLevelScript)
2956 {
2957     int i, j;
2958
2959     return;
2960     /* Try to share with toplevel object. */
2961     if (topLevelScript != NULL) {
2962         for (i = 0; i < script->len; i++) {
2963             Jim_Obj *foundObjPtr;
2964             char *str = script->token[i].objPtr->bytes;
2965
2966             if (script->token[i].objPtr->refCount != 1) continue;
2967             if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2968             if (strchr(str, ' ') || strchr(str, '\n')) continue;
2969             foundObjPtr = ScriptSearchLiteral(interp,
2970                     topLevelScript,
2971                     script, /* barrier */
2972                     script->token[i].objPtr);
2973             if (foundObjPtr != NULL) {
2974                 Jim_IncrRefCount(foundObjPtr);
2975                 Jim_DecrRefCount(interp,
2976                         script->token[i].objPtr);
2977                 script->token[i].objPtr = foundObjPtr;
2978             }
2979         }
2980     }
2981     /* Try to share locally */
2982     for (i = 0; i < script->len; i++) {
2983         char *str = script->token[i].objPtr->bytes;
2984
2985         if (script->token[i].objPtr->refCount != 1) continue;
2986         if (strchr(str, ' ') || strchr(str, '\n')) continue;
2987         for (j = 0; j < script->len; j++) {
2988             if (script->token[i].objPtr !=
2989                     script->token[j].objPtr &&
2990                 Jim_StringEqObj(script->token[i].objPtr,
2991                             script->token[j].objPtr, 0))
2992             {
2993                 Jim_IncrRefCount(script->token[j].objPtr);
2994                 Jim_DecrRefCount(interp,
2995                         script->token[i].objPtr);
2996                 script->token[i].objPtr =
2997                     script->token[j].objPtr;
2998             }
2999         }
3000     }
3001 }
3002
3003 /* This method takes the string representation of an object
3004  * as a Tcl script, and generates the pre-parsed internal representation
3005  * of the script. */
3006 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3007 {
3008     int scriptTextLen;
3009     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3010     struct JimParserCtx parser;
3011     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3012     ScriptToken *token;
3013     int args, tokens, start, end, i;
3014     int initialLineNumber;
3015     int propagateSourceInfo = 0;
3016
3017     script->len = 0;
3018     script->csLen = 0;
3019     script->commands = 0;
3020     script->token = NULL;
3021     script->cmdStruct = NULL;
3022     script->inUse = 1;
3023     /* Try to get information about filename / line number */
3024     if (objPtr->typePtr == &sourceObjType) {
3025         script->fileName =
3026             Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3027         initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3028         propagateSourceInfo = 1;
3029     } else {
3030         script->fileName = Jim_StrDup("");
3031         initialLineNumber = 1;
3032     }
3033
3034     JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3035     while(!JimParserEof(&parser)) {
3036         char *token;
3037         int len, type, linenr;
3038
3039         JimParseScript(&parser);
3040         token = JimParserGetToken(&parser, &len, &type, &linenr);
3041         ScriptObjAddToken(interp, script, token, len, type,
3042                 propagateSourceInfo ? script->fileName : NULL,
3043                 linenr);
3044     }
3045     token = script->token;
3046
3047     /* Compute the command structure array
3048      * (see the ScriptObj struct definition for more info) */
3049     start = 0; /* Current command start token index */
3050     end = -1; /* Current command end token index */
3051     while (1) {
3052         int expand = 0; /* expand flag. set to 1 on {expand} form. */
3053         int interpolation = 0; /* set to 1 if there is at least one
3054                       argument of the command obtained via
3055                       interpolation of more tokens. */
3056         /* Search for the end of command, while
3057          * count the number of args. */
3058         start = ++end;
3059         if (start >= script->len) break;
3060         args = 1; /* Number of args in current command */
3061         while (token[end].type != JIM_TT_EOL) {
3062             if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3063                     token[end-1].type == JIM_TT_EOL)
3064             {
3065                 if (token[end].type == JIM_TT_STR &&
3066                     token[end+1].type != JIM_TT_SEP &&
3067                     token[end+1].type != JIM_TT_EOL &&
3068                     (!strcmp(token[end].objPtr->bytes, "expand") ||
3069                      !strcmp(token[end].objPtr->bytes, "*")))
3070                     expand++;
3071             }
3072             if (token[end].type == JIM_TT_SEP)
3073                 args++;
3074             end++;
3075         }
3076         interpolation = !((end-start+1) == args*2);
3077         /* Add the 'number of arguments' info into cmdstruct.
3078          * Negative value if there is list expansion involved. */
3079         if (expand)
3080             ScriptObjAddInt(script, -1);
3081         ScriptObjAddInt(script, args);
3082         /* Now add info about the number of tokens. */
3083         tokens = 0; /* Number of tokens in current argument. */
3084         expand = 0;
3085         for (i = start; i <= end; i++) {
3086             if (token[i].type == JIM_TT_SEP ||
3087                 token[i].type == JIM_TT_EOL)
3088             {
3089                 if (tokens == 1 && expand)
3090                     expand = 0;
3091                 ScriptObjAddInt(script,
3092                         expand ? -tokens : tokens);
3093
3094                 expand = 0;
3095                 tokens = 0;
3096                 continue;
3097             } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3098                    (!strcmp(token[i].objPtr->bytes, "expand") ||
3099                     !strcmp(token[i].objPtr->bytes, "*")))
3100             {
3101                 expand++;
3102             }
3103             tokens++;
3104         }
3105     }
3106     /* Perform literal sharing, but only for objects that appear
3107      * to be scripts written as literals inside the source code,
3108      * and not computed at runtime. Literal sharing is a costly
3109      * operation that should be done only against objects that
3110      * are likely to require compilation only the first time, and
3111      * then are executed multiple times. */
3112     if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3113         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3114         if (bodyObjPtr->typePtr == &scriptObjType) {
3115             ScriptObj *bodyScript =
3116                 bodyObjPtr->internalRep.ptr;
3117             ScriptShareLiterals(interp, script, bodyScript);
3118         }
3119     } else if (propagateSourceInfo) {
3120         ScriptShareLiterals(interp, script, NULL);
3121     }
3122     /* Free the old internal rep and set the new one. */
3123     Jim_FreeIntRep(interp, objPtr);
3124     Jim_SetIntRepPtr(objPtr, script);
3125     objPtr->typePtr = &scriptObjType;
3126     return JIM_OK;
3127 }
3128
3129 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3130 {
3131     if (objPtr->typePtr != &scriptObjType) {
3132         SetScriptFromAny(interp, objPtr);
3133     }
3134     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3135 }
3136
3137 /* -----------------------------------------------------------------------------
3138  * Commands
3139  * ---------------------------------------------------------------------------*/
3140
3141 /* Commands HashTable Type.
3142  *
3143  * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3144 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3145 {
3146     Jim_Cmd *cmdPtr = (void*) val;
3147
3148     if (cmdPtr->cmdProc == NULL) {
3149         Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3150         Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3151         if (cmdPtr->staticVars) {
3152             Jim_FreeHashTable(cmdPtr->staticVars);
3153             Jim_Free(cmdPtr->staticVars);
3154         }
3155     } else if (cmdPtr->delProc != NULL) {
3156             /* If it was a C coded command, call the delProc if any */
3157             cmdPtr->delProc(interp, cmdPtr->privData);
3158     }
3159     Jim_Free(val);
3160 }
3161
3162 static Jim_HashTableType JimCommandsHashTableType = {
3163     JimStringCopyHTHashFunction,        /* hash function */
3164     JimStringCopyHTKeyDup,        /* key dup */
3165     NULL,                    /* val dup */
3166     JimStringCopyHTKeyCompare,        /* key compare */
3167     JimStringCopyHTKeyDestructor,        /* key destructor */
3168     Jim_CommandsHT_ValDestructor        /* val destructor */
3169 };
3170
3171 /* ------------------------- Commands related functions --------------------- */
3172
3173 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3174         Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3175 {
3176     Jim_HashEntry *he;
3177     Jim_Cmd *cmdPtr;
3178
3179     he = Jim_FindHashEntry(&interp->commands, cmdName);
3180     if (he == NULL) { /* New command to create */
3181         cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3182         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3183     } else {
3184         Jim_InterpIncrProcEpoch(interp);
3185         /* Free the arglist/body objects if it was a Tcl procedure */
3186         cmdPtr = he->val;
3187         if (cmdPtr->cmdProc == NULL) {
3188             Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3189             Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3190             if (cmdPtr->staticVars) {
3191                 Jim_FreeHashTable(cmdPtr->staticVars);
3192                 Jim_Free(cmdPtr->staticVars);
3193             }
3194             cmdPtr->staticVars = NULL;
3195         } else if (cmdPtr->delProc != NULL) {
3196             /* If it was a C coded command, call the delProc if any */
3197             cmdPtr->delProc(interp, cmdPtr->privData);
3198         }
3199     }
3200
3201     /* Store the new details for this proc */
3202     cmdPtr->delProc = delProc;
3203     cmdPtr->cmdProc = cmdProc;
3204     cmdPtr->privData = privData;
3205
3206     /* There is no need to increment the 'proc epoch' because
3207      * creation of a new procedure can never affect existing
3208      * cached commands. We don't do negative caching. */
3209     return JIM_OK;
3210 }
3211
3212 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3213         Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3214         int arityMin, int arityMax)
3215 {
3216     Jim_Cmd *cmdPtr;
3217
3218     cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3219     cmdPtr->cmdProc = NULL; /* Not a C coded command */
3220     cmdPtr->argListObjPtr = argListObjPtr;
3221     cmdPtr->bodyObjPtr = bodyObjPtr;
3222     Jim_IncrRefCount(argListObjPtr);
3223     Jim_IncrRefCount(bodyObjPtr);
3224     cmdPtr->arityMin = arityMin;
3225     cmdPtr->arityMax = arityMax;
3226     cmdPtr->staticVars = NULL;
3227    
3228     /* Create the statics hash table. */
3229     if (staticsListObjPtr) {
3230         int len, i;
3231
3232         Jim_ListLength(interp, staticsListObjPtr, &len);
3233         if (len != 0) {
3234             cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3235             Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3236                     interp);
3237             for (i = 0; i < len; i++) {
3238                 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3239                 Jim_Var *varPtr;
3240                 int subLen;
3241
3242                 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3243                 /* Check if it's composed of two elements. */
3244                 Jim_ListLength(interp, objPtr, &subLen);
3245                 if (subLen == 1 || subLen == 2) {
3246                     /* Try to get the variable value from the current
3247                      * environment. */
3248                     Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3249                     if (subLen == 1) {
3250                         initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3251                                 JIM_NONE);
3252                         if (initObjPtr == NULL) {
3253                             Jim_SetResult(interp,
3254                                     Jim_NewEmptyStringObj(interp));
3255                             Jim_AppendStrings(interp, Jim_GetResult(interp),
3256                                 "variable for initialization of static \"",
3257                                 Jim_GetString(nameObjPtr, NULL),
3258                                 "\" not found in the local context",
3259                                 NULL);
3260                             goto err;
3261                         }
3262                     } else {
3263                         Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3264                     }
3265                     varPtr = Jim_Alloc(sizeof(*varPtr));
3266                     varPtr->objPtr = initObjPtr;
3267                     Jim_IncrRefCount(initObjPtr);
3268                     varPtr->linkFramePtr = NULL;
3269                     if (Jim_AddHashEntry(cmdPtr->staticVars,
3270                             Jim_GetString(nameObjPtr, NULL),
3271                             varPtr) != JIM_OK)
3272                     {
3273                         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274                         Jim_AppendStrings(interp, Jim_GetResult(interp),
3275                             "static variable name \"",
3276                             Jim_GetString(objPtr, NULL), "\"",
3277                             " duplicated in statics list", NULL);
3278                         Jim_DecrRefCount(interp, initObjPtr);
3279                         Jim_Free(varPtr);
3280                         goto err;
3281                     }
3282                 } else {
3283                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3284                     Jim_AppendStrings(interp, Jim_GetResult(interp),
3285                         "too many fields in static specifier \"",
3286                         objPtr, "\"", NULL);
3287                     goto err;
3288                 }
3289             }
3290         }
3291     }
3292
3293     /* Add the new command */
3294
3295     /* it may already exist, so we try to delete the old one */
3296     if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3297         /* There was an old procedure with the same name, this requires
3298          * a 'proc epoch' update. */
3299         Jim_InterpIncrProcEpoch(interp);
3300     }
3301     /* If a procedure with the same name didn't existed there is no need
3302      * to increment the 'proc epoch' because creation of a new procedure
3303      * can never affect existing cached commands. We don't do
3304      * negative caching. */
3305     Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3306     return JIM_OK;
3307
3308 err:
3309     Jim_FreeHashTable(cmdPtr->staticVars);
3310     Jim_Free(cmdPtr->staticVars);
3311     Jim_DecrRefCount(interp, argListObjPtr);
3312     Jim_DecrRefCount(interp, bodyObjPtr);
3313     Jim_Free(cmdPtr);
3314     return JIM_ERR;
3315 }
3316
3317 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3318 {
3319     if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3320         return JIM_ERR;
3321     Jim_InterpIncrProcEpoch(interp);
3322     return JIM_OK;
3323 }
3324
3325 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, 
3326         const char *newName)
3327 {
3328     Jim_Cmd *cmdPtr;
3329     Jim_HashEntry *he;
3330     Jim_Cmd *copyCmdPtr;
3331
3332     if (newName[0] == '\0') /* Delete! */
3333         return Jim_DeleteCommand(interp, oldName);
3334     /* Rename */
3335     he = Jim_FindHashEntry(&interp->commands, oldName);
3336     if (he == NULL)
3337         return JIM_ERR; /* Invalid command name */
3338     cmdPtr = he->val;
3339     copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3340     *copyCmdPtr = *cmdPtr;
3341     /* In order to avoid that a procedure will get arglist/body/statics
3342      * freed by the hash table methods, fake a C-coded command
3343      * setting cmdPtr->cmdProc as not NULL */
3344     cmdPtr->cmdProc = (void*)1;
3345     /* Also make sure delProc is NULL. */
3346     cmdPtr->delProc = NULL;
3347     /* Destroy the old command, and make sure the new is freed
3348      * as well. */
3349     Jim_DeleteHashEntry(&interp->commands, oldName);
3350     Jim_DeleteHashEntry(&interp->commands, newName);
3351     /* Now the new command. We are sure it can't fail because
3352      * the target name was already freed. */
3353     Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3354     /* Increment the epoch */
3355     Jim_InterpIncrProcEpoch(interp);
3356     return JIM_OK;
3357 }
3358
3359 /* -----------------------------------------------------------------------------
3360  * Command object
3361  * ---------------------------------------------------------------------------*/
3362
3363 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3364
3365 static Jim_ObjType commandObjType = {
3366     "command",
3367     NULL,
3368     NULL,
3369     NULL,
3370     JIM_TYPE_REFERENCES,
3371 };
3372
3373 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3374 {
3375     Jim_HashEntry *he;
3376     const char *cmdName;
3377
3378     /* Get the string representation */
3379     cmdName = Jim_GetString(objPtr, NULL);
3380     /* Lookup this name into the commands hash table */
3381     he = Jim_FindHashEntry(&interp->commands, cmdName);
3382     if (he == NULL)
3383         return JIM_ERR;
3384
3385     /* Free the old internal repr and set the new one. */
3386     Jim_FreeIntRep(interp, objPtr);
3387     objPtr->typePtr = &commandObjType;
3388     objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3389     objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3390     return JIM_OK;
3391 }
3392
3393 /* This function returns the command structure for the command name
3394  * stored in objPtr. It tries to specialize the objPtr to contain
3395  * a cached info instead to perform the lookup into the hash table
3396  * every time. The information cached may not be uptodate, in such
3397  * a case the lookup is performed and the cache updated. */
3398 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3399 {
3400     if ((objPtr->typePtr != &commandObjType ||
3401         objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3402         SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3403         if (flags & JIM_ERRMSG) {
3404             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3405             Jim_AppendStrings(interp, Jim_GetResult(interp),
3406                 "invalid command name \"", objPtr->bytes, "\"",
3407                 NULL);
3408         }
3409         return NULL;
3410     }
3411     return objPtr->internalRep.cmdValue.cmdPtr;
3412 }
3413
3414 /* -----------------------------------------------------------------------------
3415  * Variables
3416  * ---------------------------------------------------------------------------*/
3417
3418 /* Variables HashTable Type.
3419  *
3420  * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3421 static void JimVariablesHTValDestructor(void *interp, void *val)
3422 {
3423     Jim_Var *varPtr = (void*) val;
3424
3425     Jim_DecrRefCount(interp, varPtr->objPtr);
3426     Jim_Free(val);
3427 }
3428
3429 static Jim_HashTableType JimVariablesHashTableType = {
3430     JimStringCopyHTHashFunction,        /* hash function */
3431     JimStringCopyHTKeyDup,              /* key dup */
3432     NULL,                               /* val dup */
3433     JimStringCopyHTKeyCompare,        /* key compare */
3434     JimStringCopyHTKeyDestructor,     /* key destructor */
3435     JimVariablesHTValDestructor       /* val destructor */
3436 };
3437
3438 /* -----------------------------------------------------------------------------
3439  * Variable object
3440  * ---------------------------------------------------------------------------*/
3441
3442 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3443
3444 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3445
3446 static Jim_ObjType variableObjType = {
3447     "variable",
3448     NULL,
3449     NULL,
3450     NULL,
3451     JIM_TYPE_REFERENCES,
3452 };
3453
3454 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3455  * is in the form "varname(key)". */
3456 static int Jim_NameIsDictSugar(const char *str, int len)
3457 {
3458     if (len == -1)
3459         len = strlen(str);
3460     if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3461         return 1;
3462     return 0;
3463 }
3464
3465 /* This method should be called only by the variable API.
3466  * It returns JIM_OK on success (variable already exists),
3467  * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3468  * a variable name, but syntax glue for [dict] i.e. the last
3469  * character is ')' */
3470 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3471 {
3472     Jim_HashEntry *he;
3473     const char *varName;
3474     int len;
3475
3476     /* Check if the object is already an uptodate variable */
3477     if (objPtr->typePtr == &variableObjType &&
3478         objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3479         return JIM_OK; /* nothing to do */
3480     /* Get the string representation */
3481     varName = Jim_GetString(objPtr, &len);
3482     /* Make sure it's not syntax glue to get/set dict. */
3483     if (Jim_NameIsDictSugar(varName, len))
3484             return JIM_DICT_SUGAR;
3485     if (varName[0] == ':' && varName[1] == ':') {
3486         he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3487         if (he == NULL) {
3488             return JIM_ERR;
3489         }
3490     }
3491     else {
3492         /* Lookup this name into the variables hash table */
3493         he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3494         if (he == NULL) {
3495             /* Try with static vars. */
3496             if (interp->framePtr->staticVars == NULL)
3497                 return JIM_ERR;
3498             if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3499                 return JIM_ERR;
3500         }
3501     }
3502     /* Free the old internal repr and set the new one. */
3503     Jim_FreeIntRep(interp, objPtr);
3504     objPtr->typePtr = &variableObjType;
3505     objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3506     objPtr->internalRep.varValue.varPtr = (void*)he->val;
3507     return JIM_OK;
3508 }
3509
3510 /* -------------------- Variables related functions ------------------------- */
3511 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3512         Jim_Obj *valObjPtr);
3513 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3514
3515 /* For now that's dummy. Variables lookup should be optimized
3516  * in many ways, with caching of lookups, and possibly with
3517  * a table of pre-allocated vars in every CallFrame for local vars.
3518  * All the caching should also have an 'epoch' mechanism similar
3519  * to the one used by Tcl for procedures lookup caching. */
3520
3521 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3522 {
3523     const char *name;
3524     Jim_Var *var;
3525     int err;
3526
3527     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3528         /* Check for [dict] syntax sugar. */
3529         if (err == JIM_DICT_SUGAR)
3530             return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3531         /* New variable to create */
3532         name = Jim_GetString(nameObjPtr, NULL);
3533
3534         var = Jim_Alloc(sizeof(*var));
3535         var->objPtr = valObjPtr;
3536         Jim_IncrRefCount(valObjPtr);
3537         var->linkFramePtr = NULL;
3538         /* Insert the new variable */
3539         if (name[0] == ':' && name[1] == ':') {
3540             /* Into to the top evel frame */
3541             Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3542         }
3543         else {
3544             Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3545         }
3546         /* Make the object int rep a variable */
3547         Jim_FreeIntRep(interp, nameObjPtr);
3548         nameObjPtr->typePtr = &variableObjType;
3549         nameObjPtr->internalRep.varValue.callFrameId =
3550             interp->framePtr->id;
3551         nameObjPtr->internalRep.varValue.varPtr = var;
3552     } else {
3553         var = nameObjPtr->internalRep.varValue.varPtr;
3554         if (var->linkFramePtr == NULL) {
3555             Jim_IncrRefCount(valObjPtr);
3556             Jim_DecrRefCount(interp, var->objPtr);
3557             var->objPtr = valObjPtr;
3558         } else { /* Else handle the link */
3559             Jim_CallFrame *savedCallFrame;
3560
3561             savedCallFrame = interp->framePtr;
3562             interp->framePtr = var->linkFramePtr;
3563             err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3564             interp->framePtr = savedCallFrame;
3565             if (err != JIM_OK)
3566                 return err;
3567         }
3568     }
3569     return JIM_OK;
3570 }
3571
3572 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3573 {
3574     Jim_Obj *nameObjPtr;
3575     int result;
3576
3577     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3578     Jim_IncrRefCount(nameObjPtr);
3579     result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3580     Jim_DecrRefCount(interp, nameObjPtr);
3581     return result;
3582 }
3583
3584 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3585 {
3586     Jim_CallFrame *savedFramePtr;
3587     int result;
3588
3589     savedFramePtr = interp->framePtr;
3590     interp->framePtr = interp->topFramePtr;
3591     result = Jim_SetVariableStr(interp, name, objPtr);
3592     interp->framePtr = savedFramePtr;
3593     return result;
3594 }
3595
3596 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3597 {
3598     Jim_Obj *nameObjPtr, *valObjPtr;
3599     int result;
3600
3601     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3602     valObjPtr = Jim_NewStringObj(interp, val, -1);
3603     Jim_IncrRefCount(nameObjPtr);
3604     Jim_IncrRefCount(valObjPtr);
3605     result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3606     Jim_DecrRefCount(interp, nameObjPtr);
3607     Jim_DecrRefCount(interp, valObjPtr);
3608     return result;
3609 }
3610
3611 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3612         Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3613 {
3614     const char *varName;
3615     int len;
3616
3617     /* Check for cycles. */
3618     if (interp->framePtr == targetCallFrame) {
3619         Jim_Obj *objPtr = targetNameObjPtr;
3620         Jim_Var *varPtr;
3621         /* Cycles are only possible with 'uplevel 0' */
3622         while(1) {
3623             if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3624                 Jim_SetResultString(interp,
3625                     "can't upvar from variable to itself", -1);
3626                 return JIM_ERR;
3627             }
3628             if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3629                 break;
3630             varPtr = objPtr->internalRep.varValue.varPtr;
3631             if (varPtr->linkFramePtr != targetCallFrame) break;
3632             objPtr = varPtr->objPtr;
3633         }
3634     }
3635     varName = Jim_GetString(nameObjPtr, &len);
3636     if (Jim_NameIsDictSugar(varName, len)) {
3637         Jim_SetResultString(interp,
3638             "Dict key syntax invalid as link source", -1);
3639         return JIM_ERR;
3640     }
3641     /* Perform the binding */
3642     Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3643     /* We are now sure 'nameObjPtr' type is variableObjType */
3644     nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3645     return JIM_OK;
3646 }
3647
3648 /* Return the Jim_Obj pointer associated with a variable name,
3649  * or NULL if the variable was not found in the current context.
3650  * The same optimization discussed in the comment to the
3651  * 'SetVariable' function should apply here. */
3652 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3653 {
3654     int err;
3655
3656     /* All the rest is handled here */
3657     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3658         /* Check for [dict] syntax sugar. */
3659         if (err == JIM_DICT_SUGAR)
3660             return JimDictSugarGet(interp, nameObjPtr);
3661         if (flags & JIM_ERRMSG) {
3662             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3663             Jim_AppendStrings(interp, Jim_GetResult(interp),
3664                 "can't read \"", nameObjPtr->bytes,
3665                 "\": no such variable", NULL);
3666         }
3667         return NULL;
3668     } else {
3669         Jim_Var *varPtr;
3670         Jim_Obj *objPtr;
3671         Jim_CallFrame *savedCallFrame;
3672
3673         varPtr = nameObjPtr->internalRep.varValue.varPtr;
3674         if (varPtr->linkFramePtr == NULL)
3675             return varPtr->objPtr;
3676         /* The variable is a link? Resolve it. */
3677         savedCallFrame = interp->framePtr;
3678         interp->framePtr = varPtr->linkFramePtr;
3679         objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3680         if (objPtr == NULL && flags & JIM_ERRMSG) {
3681             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3682             Jim_AppendStrings(interp, Jim_GetResult(interp),
3683                 "can't read \"", nameObjPtr->bytes,
3684                 "\": no such variable", NULL);
3685         }
3686         interp->framePtr = savedCallFrame;
3687         return objPtr;
3688     }
3689 }
3690
3691 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3692         int flags)
3693 {
3694     Jim_CallFrame *savedFramePtr;
3695     Jim_Obj *objPtr;
3696
3697     savedFramePtr = interp->framePtr;
3698     interp->framePtr = interp->topFramePtr;
3699     objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3700     interp->framePtr = savedFramePtr;
3701
3702     return objPtr;
3703 }
3704
3705 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3706 {
3707     Jim_Obj *nameObjPtr, *varObjPtr;
3708
3709     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3710     Jim_IncrRefCount(nameObjPtr);
3711     varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3712     Jim_DecrRefCount(interp, nameObjPtr);
3713     return varObjPtr;
3714 }
3715
3716 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3717         int flags)
3718 {
3719     Jim_CallFrame *savedFramePtr;
3720     Jim_Obj *objPtr;
3721
3722     savedFramePtr = interp->framePtr;
3723     interp->framePtr = interp->topFramePtr;
3724     objPtr = Jim_GetVariableStr(interp, name, flags);
3725     interp->framePtr = savedFramePtr;
3726
3727     return objPtr;
3728 }
3729
3730 /* Unset a variable.
3731  * Note: On success unset invalidates all the variable objects created
3732  * in the current call frame incrementing. */
3733 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3734 {
3735     const char *name;
3736     Jim_Var *varPtr;
3737     int err;
3738     
3739     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3740         /* Check for [dict] syntax sugar. */
3741         if (err == JIM_DICT_SUGAR)
3742             return JimDictSugarSet(interp, nameObjPtr, NULL);
3743         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3744         Jim_AppendStrings(interp, Jim_GetResult(interp),
3745             "can't unset \"", nameObjPtr->bytes,
3746             "\": no such variable", NULL);
3747         return JIM_ERR; /* var not found */
3748     }
3749     varPtr = nameObjPtr->internalRep.varValue.varPtr;
3750     /* If it's a link call UnsetVariable recursively */
3751     if (varPtr->linkFramePtr) {
3752         int retval;
3753
3754         Jim_CallFrame *savedCallFrame;
3755
3756         savedCallFrame = interp->framePtr;
3757         interp->framePtr = varPtr->linkFramePtr;
3758         retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3759         interp->framePtr = savedCallFrame;
3760         if (retval != JIM_OK && flags & JIM_ERRMSG) {
3761             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3762             Jim_AppendStrings(interp, Jim_GetResult(interp),
3763                 "can't unset \"", nameObjPtr->bytes,
3764                 "\": no such variable", NULL);
3765         }
3766         return retval;
3767     } else {
3768         name = Jim_GetString(nameObjPtr, NULL);
3769         if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3770                 != JIM_OK) return JIM_ERR;
3771         /* Change the callframe id, invalidating var lookup caching */
3772         JimChangeCallFrameId(interp, interp->framePtr);
3773         return JIM_OK;
3774     }
3775 }
3776
3777 /* ----------  Dict syntax sugar (similar to array Tcl syntax) -------------- */
3778
3779 /* Given a variable name for [dict] operation syntax sugar,
3780  * this function returns two objects, the first with the name
3781  * of the variable to set, and the second with the rispective key.
3782  * For example "foo(bar)" will return objects with string repr. of
3783  * "foo" and "bar".
3784  *
3785  * The returned objects have refcount = 1. The function can't fail. */
3786 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3787         Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3788 {
3789     const char *str, *p;
3790     char *t;
3791     int len, keyLen, nameLen;
3792     Jim_Obj *varObjPtr, *keyObjPtr;
3793
3794     str = Jim_GetString(objPtr, &len);
3795     p = strchr(str, '(');
3796     p++;
3797     keyLen = len-((p-str)+1);
3798     nameLen = (p-str)-1;
3799     /* Create the objects with the variable name and key. */
3800     t = Jim_Alloc(nameLen+1);
3801     memcpy(t, str, nameLen);
3802     t[nameLen] = '\0';
3803     varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3804
3805     t = Jim_Alloc(keyLen+1);
3806     memcpy(t, p, keyLen);
3807     t[keyLen] = '\0';
3808     keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3809
3810     Jim_IncrRefCount(varObjPtr);
3811     Jim_IncrRefCount(keyObjPtr);
3812     *varPtrPtr = varObjPtr;
3813     *keyPtrPtr = keyObjPtr;
3814 }
3815
3816 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3817  * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3818 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3819         Jim_Obj *valObjPtr)
3820 {
3821     Jim_Obj *varObjPtr, *keyObjPtr;
3822     int err = JIM_OK;
3823
3824     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3825     err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3826             valObjPtr);
3827     Jim_DecrRefCount(interp, varObjPtr);
3828     Jim_DecrRefCount(interp, keyObjPtr);
3829     return err;
3830 }
3831
3832 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3833 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3834 {
3835     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3836
3837     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3838     dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3839     if (!dictObjPtr) {
3840         resObjPtr = NULL;
3841         goto err;
3842     }
3843     if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3844             != JIM_OK) {
3845         resObjPtr = NULL;
3846     }
3847 err:
3848     Jim_DecrRefCount(interp, varObjPtr);
3849     Jim_DecrRefCount(interp, keyObjPtr);
3850     return resObjPtr;
3851 }
3852
3853 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3854
3855 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3856 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3857         Jim_Obj *dupPtr);
3858
3859 static Jim_ObjType dictSubstObjType = {
3860     "dict-substitution",
3861     FreeDictSubstInternalRep,
3862     DupDictSubstInternalRep,
3863     NULL,
3864     JIM_TYPE_NONE,
3865 };
3866
3867 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3868 {
3869     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3870     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3871 }
3872
3873 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3874         Jim_Obj *dupPtr)
3875 {
3876     JIM_NOTUSED(interp);
3877
3878     dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3879         srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3880     dupPtr->internalRep.dictSubstValue.indexObjPtr =
3881         srcPtr->internalRep.dictSubstValue.indexObjPtr;
3882     dupPtr->typePtr = &dictSubstObjType;
3883 }
3884
3885 /* This function is used to expand [dict get] sugar in the form
3886  * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3887  * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3888  * object that is *guaranteed* to be in the form VARNAME(INDEX).
3889  * The 'index' part is [subst]ituted, and is used to lookup a key inside
3890  * the [dict]ionary contained in variable VARNAME. */
3891 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3892 {
3893     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3894     Jim_Obj *substKeyObjPtr = NULL;
3895
3896     if (objPtr->typePtr != &dictSubstObjType) {
3897         JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3898         Jim_FreeIntRep(interp, objPtr);
3899         objPtr->typePtr = &dictSubstObjType;
3900         objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3901         objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3902     }
3903     if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3904                 &substKeyObjPtr, JIM_NONE)
3905             != JIM_OK) {
3906         substKeyObjPtr = NULL;
3907         goto err;
3908     }
3909     Jim_IncrRefCount(substKeyObjPtr);
3910     dictObjPtr = Jim_GetVariable(interp,
3911             objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3912     if (!dictObjPtr) {
3913         resObjPtr = NULL;
3914         goto err;
3915     }
3916     if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3917             != JIM_OK) {
3918         resObjPtr = NULL;
3919         goto err;
3920     }
3921 err:
3922     if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3923     return resObjPtr;
3924 }
3925
3926 /* -----------------------------------------------------------------------------
3927  * CallFrame
3928  * ---------------------------------------------------------------------------*/
3929
3930 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3931 {
3932     Jim_CallFrame *cf;
3933     if (interp->freeFramesList) {
3934         cf = interp->freeFramesList;
3935         interp->freeFramesList = cf->nextFramePtr;
3936     } else {
3937         cf = Jim_Alloc(sizeof(*cf));
3938         cf->vars.table = NULL;
3939     }
3940
3941     cf->id = interp->callFrameEpoch++;
3942     cf->parentCallFrame = NULL;
3943     cf->argv = NULL;
3944     cf->argc = 0;
3945     cf->procArgsObjPtr = NULL;
3946     cf->procBodyObjPtr = NULL;
3947     cf->nextFramePtr = NULL;
3948     cf->staticVars = NULL;
3949     if (cf->vars.table == NULL)
3950         Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3951     return cf;
3952 }
3953
3954 /* Used to invalidate every caching related to callframe stability. */
3955 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3956 {
3957     cf->id = interp->callFrameEpoch++;
3958 }
3959
3960 #define JIM_FCF_NONE 0 /* no flags */
3961 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3962 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3963         int flags)
3964 {
3965     if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3966     if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3967     if (!(flags & JIM_FCF_NOHT))
3968         Jim_FreeHashTable(&cf->vars);
3969     else {
3970         int i;
3971         Jim_HashEntry **table = cf->vars.table, *he;
3972
3973         for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3974             he = table[i];
3975             while (he != NULL) {
3976                 Jim_HashEntry *nextEntry = he->next;
3977                 Jim_Var *varPtr = (void*) he->val;
3978
3979                 Jim_DecrRefCount(interp, varPtr->objPtr);
3980                 Jim_Free(he->val);
3981                 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3982                 Jim_Free(he);
3983                 table[i] = NULL;
3984                 he = nextEntry;
3985             }
3986         }
3987         cf->vars.used = 0;
3988     }
3989     cf->nextFramePtr = interp->freeFramesList;
3990     interp->freeFramesList = cf;
3991 }
3992
3993 /* -----------------------------------------------------------------------------
3994  * References
3995  * ---------------------------------------------------------------------------*/
3996
3997 /* References HashTable Type.
3998  *
3999  * Keys are jim_wide integers, dynamically allocated for now but in the
4000  * future it's worth to cache this 8 bytes objects. Values are poitners
4001  * to Jim_References. */
4002 static void JimReferencesHTValDestructor(void *interp, void *val)
4003 {
4004     Jim_Reference *refPtr = (void*) val;
4005
4006     Jim_DecrRefCount(interp, refPtr->objPtr);
4007     if (refPtr->finalizerCmdNamePtr != NULL) {
4008         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4009     }
4010     Jim_Free(val);
4011 }
4012
4013 unsigned int JimReferencesHTHashFunction(const void *key)
4014 {
4015     /* Only the least significant bits are used. */
4016     const jim_wide *widePtr = key;
4017     unsigned int intValue = (unsigned int) *widePtr;
4018     return Jim_IntHashFunction(intValue);
4019 }
4020
4021 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4022 {
4023     /* Only the least significant bits are used. */
4024     const jim_wide *widePtr = key;
4025     unsigned int intValue = (unsigned int) *widePtr;
4026     return intValue; /* identity function. */
4027 }
4028
4029 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4030 {
4031     void *copy = Jim_Alloc(sizeof(jim_wide));
4032     JIM_NOTUSED(privdata);
4033
4034     memcpy(copy, key, sizeof(jim_wide));
4035     return copy;
4036 }
4037
4038 int JimReferencesHTKeyCompare(void *privdata, const void *key1, 
4039         const void *key2)
4040 {
4041     JIM_NOTUSED(privdata);
4042
4043     return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4044 }
4045
4046 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4047 {
4048     JIM_NOTUSED(privdata);
4049
4050     Jim_Free((void*)key);
4051 }
4052
4053 static Jim_HashTableType JimReferencesHashTableType = {
4054     JimReferencesHTHashFunction,    /* hash function */
4055     JimReferencesHTKeyDup,          /* key dup */
4056     NULL,                           /* val dup */
4057     JimReferencesHTKeyCompare,      /* key compare */
4058     JimReferencesHTKeyDestructor,   /* key destructor */
4059     JimReferencesHTValDestructor    /* val destructor */
4060 };
4061
4062 /* -----------------------------------------------------------------------------
4063  * Reference object type and References API
4064  * ---------------------------------------------------------------------------*/
4065
4066 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4067
4068 static Jim_ObjType referenceObjType = {
4069     "reference",
4070     NULL,
4071     NULL,
4072     UpdateStringOfReference,
4073     JIM_TYPE_REFERENCES,
4074 };
4075
4076 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4077 {
4078     int len;
4079     char buf[JIM_REFERENCE_SPACE+1];
4080     Jim_Reference *refPtr;
4081
4082     refPtr = objPtr->internalRep.refValue.refPtr;
4083     len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4084     objPtr->bytes = Jim_Alloc(len+1);
4085     memcpy(objPtr->bytes, buf, len+1);
4086     objPtr->length = len;
4087 }
4088
4089 /* returns true if 'c' is a valid reference tag character.
4090  * i.e. inside the range [_a-zA-Z0-9] */
4091 static int isrefchar(int c)
4092 {
4093     if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4094         (c >= '0' && c <= '9')) return 1;
4095     return 0;
4096 }
4097
4098 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4099 {
4100     jim_wide wideValue;
4101     int i, len;
4102     const char *str, *start, *end;
4103     char refId[21];
4104     Jim_Reference *refPtr;
4105     Jim_HashEntry *he;
4106
4107     /* Get the string representation */
4108     str = Jim_GetString(objPtr, &len);
4109     /* Check if it looks like a reference */
4110     if (len < JIM_REFERENCE_SPACE) goto badformat;
4111     /* Trim spaces */
4112     start = str;
4113     end = str+len-1;
4114     while (*start == ' ') start++;
4115     while (*end == ' ' && end > start) end--;
4116     if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4117     /* <reference.<1234567>.%020> */
4118     if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4119     if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4120     /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4121     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4122         if (!isrefchar(start[12+i])) goto badformat;
4123     }
4124     /* Extract info from the refernece. */
4125     memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4126     refId[20] = '\0';
4127     /* Try to convert the ID into a jim_wide */
4128     if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4129     /* Check if the reference really exists! */
4130     he = Jim_FindHashEntry(&interp->references, &wideValue);
4131     if (he == NULL) {
4132         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4133         Jim_AppendStrings(interp, Jim_GetResult(interp),
4134                 "Invalid reference ID \"", str, "\"", NULL);
4135         return JIM_ERR;
4136     }
4137     refPtr = he->val;
4138     /* Free the old internal repr and set the new one. */
4139     Jim_FreeIntRep(interp, objPtr);
4140     objPtr->typePtr = &referenceObjType;
4141     objPtr->internalRep.refValue.id = wideValue;
4142     objPtr->internalRep.refValue.refPtr = refPtr;
4143     return JIM_OK;
4144
4145 badformat:
4146     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4147     Jim_AppendStrings(interp, Jim_GetResult(interp),
4148             "expected reference but got \"", str, "\"", NULL);
4149     return JIM_ERR;
4150 }
4151
4152 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4153  * as finalizer command (or NULL if there is no finalizer).
4154  * The returned reference object has refcount = 0. */
4155 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4156         Jim_Obj *cmdNamePtr)
4157 {
4158     struct Jim_Reference *refPtr;
4159     jim_wide wideValue = interp->referenceNextId;
4160     Jim_Obj *refObjPtr;
4161     const char *tag;
4162     int tagLen, i;
4163
4164     /* Perform the Garbage Collection if needed. */
4165     Jim_CollectIfNeeded(interp);
4166
4167     refPtr = Jim_Alloc(sizeof(*refPtr));
4168     refPtr->objPtr = objPtr;
4169     Jim_IncrRefCount(objPtr);
4170     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4171     if (cmdNamePtr)
4172         Jim_IncrRefCount(cmdNamePtr);
4173     Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4174     refObjPtr = Jim_NewObj(interp);
4175     refObjPtr->typePtr = &referenceObjType;
4176     refObjPtr->bytes = NULL;
4177     refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4178     refObjPtr->internalRep.refValue.refPtr = refPtr;
4179     interp->referenceNextId++;
4180     /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4181      * that does not pass the 'isrefchar' test is replaced with '_' */
4182     tag = Jim_GetString(tagPtr, &tagLen);
4183     if (tagLen > JIM_REFERENCE_TAGLEN)
4184         tagLen = JIM_REFERENCE_TAGLEN;
4185     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4186         if (i < tagLen)
4187             refPtr->tag[i] = tag[i];
4188         else
4189             refPtr->tag[i] = '_';
4190     }
4191     refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4192     return refObjPtr;
4193 }
4194
4195 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4196 {
4197     if (objPtr->typePtr != &referenceObjType &&
4198         SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4199         return NULL;
4200     return objPtr->internalRep.refValue.refPtr;
4201 }
4202
4203 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4204 {
4205     Jim_Reference *refPtr;
4206
4207     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4208         return JIM_ERR;
4209     Jim_IncrRefCount(cmdNamePtr);
4210     if (refPtr->finalizerCmdNamePtr)
4211         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4212     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4213     return JIM_OK;
4214 }
4215
4216 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4217 {
4218     Jim_Reference *refPtr;
4219
4220     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4221         return JIM_ERR;
4222     *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4223     return JIM_OK;
4224 }
4225
4226 /* -----------------------------------------------------------------------------
4227  * References Garbage Collection
4228  * ---------------------------------------------------------------------------*/
4229
4230 /* This the hash table type for the "MARK" phase of the GC */
4231 static Jim_HashTableType JimRefMarkHashTableType = {
4232     JimReferencesHTHashFunction,    /* hash function */
4233     JimReferencesHTKeyDup,          /* key dup */
4234     NULL,                           /* val dup */
4235     JimReferencesHTKeyCompare,      /* key compare */
4236     JimReferencesHTKeyDestructor,   /* key destructor */
4237     NULL                            /* val destructor */
4238 };
4239
4240 /* #define JIM_DEBUG_GC 1 */
4241
4242 /* Performs the garbage collection. */
4243 int Jim_Collect(Jim_Interp *interp)
4244 {
4245     Jim_HashTable marks;
4246     Jim_HashTableIterator *htiter;
4247     Jim_HashEntry *he;
4248     Jim_Obj *objPtr;
4249     int collected = 0;
4250
4251     /* Avoid recursive calls */
4252     if (interp->lastCollectId == -1) {
4253         /* Jim_Collect() already running. Return just now. */
4254         return 0;
4255     }
4256     interp->lastCollectId = -1;
4257
4258     /* Mark all the references found into the 'mark' hash table.
4259      * The references are searched in every live object that
4260      * is of a type that can contain references. */
4261     Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4262     objPtr = interp->liveList;
4263     while(objPtr) {
4264         if (objPtr->typePtr == NULL ||
4265             objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4266             const char *str, *p;
4267             int len;
4268
4269             /* If the object is of type reference, to get the
4270              * Id is simple... */
4271             if (objPtr->typePtr == &referenceObjType) {
4272                 Jim_AddHashEntry(&marks,
4273                     &objPtr->internalRep.refValue.id, NULL);
4274 #ifdef JIM_DEBUG_GC
4275                 Jim_fprintf(interp,interp->cookie_stdout,
4276                     "MARK (reference): %d refcount: %d" JIM_NL, 
4277                     (int) objPtr->internalRep.refValue.id,
4278                     objPtr->refCount);
4279 #endif
4280                 objPtr = objPtr->nextObjPtr;
4281                 continue;
4282             }
4283             /* Get the string repr of the object we want
4284              * to scan for references. */
4285             p = str = Jim_GetString(objPtr, &len);
4286             /* Skip objects too little to contain references. */
4287             if (len < JIM_REFERENCE_SPACE) {
4288                 objPtr = objPtr->nextObjPtr;
4289                 continue;
4290             }
4291             /* Extract references from the object string repr. */
4292             while(1) {
4293                 int i;
4294                 jim_wide id;
4295                 char buf[21];
4296
4297                 if ((p = strstr(p, "<reference.<")) == NULL)
4298                     break;
4299                 /* Check if it's a valid reference. */
4300                 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4301                 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4302                 for (i = 21; i <= 40; i++)
4303                     if (!isdigit((int)p[i]))
4304                         break;
4305                 /* Get the ID */
4306                 memcpy(buf, p+21, 20);
4307                 buf[20] = '\0';
4308                 Jim_StringToWide(buf, &id, 10);
4309
4310                 /* Ok, a reference for the given ID
4311                  * was found. Mark it. */
4312                 Jim_AddHashEntry(&marks, &id, NULL);
4313 #ifdef JIM_DEBUG_GC
4314                 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4315 #endif
4316                 p += JIM_REFERENCE_SPACE;
4317             }
4318         }
4319         objPtr = objPtr->nextObjPtr;
4320     }
4321
4322     /* Run the references hash table to destroy every reference that
4323      * is not referenced outside (not present in the mark HT). */
4324     htiter = Jim_GetHashTableIterator(&interp->references);
4325     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4326         const jim_wide *refId;
4327         Jim_Reference *refPtr;
4328
4329         refId = he->key;
4330         /* Check if in the mark phase we encountered
4331          * this reference. */
4332         if (Jim_FindHashEntry(&marks, refId) == NULL) {
4333 #ifdef JIM_DEBUG_GC
4334             Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4335 #endif
4336             collected++;
4337             /* Drop the reference, but call the
4338              * finalizer first if registered. */
4339             refPtr = he->val;
4340             if (refPtr->finalizerCmdNamePtr) {
4341                 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4342                 Jim_Obj *objv[3], *oldResult;
4343
4344                 JimFormatReference(refstr, refPtr, *refId);
4345
4346                 objv[0] = refPtr->finalizerCmdNamePtr;
4347                 objv[1] = Jim_NewStringObjNoAlloc(interp,
4348                         refstr, 32);
4349                 objv[2] = refPtr->objPtr;
4350                 Jim_IncrRefCount(objv[0]);
4351                 Jim_IncrRefCount(objv[1]);
4352                 Jim_IncrRefCount(objv[2]);
4353
4354                 /* Drop the reference itself */
4355                 Jim_DeleteHashEntry(&interp->references, refId);
4356
4357                 /* Call the finalizer. Errors ignored. */
4358                 oldResult = interp->result;
4359                 Jim_IncrRefCount(oldResult);
4360                 Jim_EvalObjVector(interp, 3, objv);
4361                 Jim_SetResult(interp, oldResult);
4362                 Jim_DecrRefCount(interp, oldResult);
4363
4364                 Jim_DecrRefCount(interp, objv[0]);
4365                 Jim_DecrRefCount(interp, objv[1]);
4366                 Jim_DecrRefCount(interp, objv[2]);
4367             } else {
4368                 Jim_DeleteHashEntry(&interp->references, refId);
4369             }
4370         }
4371     }
4372     Jim_FreeHashTableIterator(htiter);
4373     Jim_FreeHashTable(&marks);
4374     interp->lastCollectId = interp->referenceNextId;
4375     interp->lastCollectTime = time(NULL);
4376     return collected;
4377 }
4378
4379 #define JIM_COLLECT_ID_PERIOD 5000
4380 #define JIM_COLLECT_TIME_PERIOD 300
4381
4382 void Jim_CollectIfNeeded(Jim_Interp *interp)
4383 {
4384     jim_wide elapsedId;
4385     int elapsedTime;
4386     
4387     elapsedId = interp->referenceNextId - interp->lastCollectId;
4388     elapsedTime = time(NULL) - interp->lastCollectTime;
4389
4390
4391     if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4392         elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4393         Jim_Collect(interp);
4394     }
4395 }
4396
4397 /* -----------------------------------------------------------------------------
4398  * Interpreter related functions
4399  * ---------------------------------------------------------------------------*/
4400
4401 Jim_Interp *Jim_CreateInterp(void)
4402 {
4403     Jim_Interp *i = Jim_Alloc(sizeof(*i));
4404     Jim_Obj *pathPtr;
4405
4406     i->errorLine = 0;
4407     i->errorFileName = Jim_StrDup("");
4408     i->numLevels = 0;
4409     i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4410     i->returnCode = JIM_OK;
4411     i->exitCode = 0;
4412     i->procEpoch = 0;
4413     i->callFrameEpoch = 0;
4414     i->liveList = i->freeList = NULL;
4415     i->scriptFileName = Jim_StrDup("");
4416     i->referenceNextId = 0;
4417     i->lastCollectId = 0;
4418     i->lastCollectTime = time(NULL);
4419     i->freeFramesList = NULL;
4420     i->prngState = NULL;
4421     i->evalRetcodeLevel = -1;
4422     i->cookie_stdin = stdin;
4423     i->cookie_stdout = stdout;
4424     i->cookie_stderr = stderr;
4425         i->cb_fwrite   = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4426         i->cb_fread    = ((size_t (*)(       void *, size_t, size_t, void *))(fread));
4427         i->cb_vfprintf = ((int    (*)( void *, const char *fmt, va_list ))(vfprintf));
4428         i->cb_fflush   = ((int    (*)( void *))(fflush));
4429         i->cb_fgets    = ((char * (*)( char *, int, void *))(fgets));
4430
4431     /* Note that we can create objects only after the
4432      * interpreter liveList and freeList pointers are
4433      * initialized to NULL. */
4434     Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4435     Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4436     Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4437             NULL);
4438     Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4439     Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4440     Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4441     i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4442     i->emptyObj = Jim_NewEmptyStringObj(i);
4443     i->result = i->emptyObj;
4444     i->stackTrace = Jim_NewListObj(i, NULL, 0);
4445     i->unknown = Jim_NewStringObj(i, "unknown", -1);
4446     i->unknown_called = 0;
4447     Jim_IncrRefCount(i->emptyObj);
4448     Jim_IncrRefCount(i->result);
4449     Jim_IncrRefCount(i->stackTrace);
4450     Jim_IncrRefCount(i->unknown);
4451
4452     /* Initialize key variables every interpreter should contain */
4453     pathPtr = Jim_NewStringObj(i, "./", -1);
4454     Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4455     Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4456
4457     /* Export the core API to extensions */
4458     JimRegisterCoreApi(i);
4459     return i;
4460 }
4461
4462 /* This is the only function Jim exports directly without
4463  * to use the STUB system. It is only used by embedders
4464  * in order to get an interpreter with the Jim API pointers
4465  * registered. */
4466 Jim_Interp *ExportedJimCreateInterp(void)
4467 {
4468     return Jim_CreateInterp();
4469 }
4470
4471 void Jim_FreeInterp(Jim_Interp *i)
4472 {
4473     Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4474     Jim_Obj *objPtr, *nextObjPtr;
4475
4476     Jim_DecrRefCount(i, i->emptyObj);
4477     Jim_DecrRefCount(i, i->result);
4478     Jim_DecrRefCount(i, i->stackTrace);
4479     Jim_DecrRefCount(i, i->unknown);
4480     Jim_Free((void*)i->errorFileName);
4481     Jim_Free((void*)i->scriptFileName);
4482     Jim_FreeHashTable(&i->commands);
4483     Jim_FreeHashTable(&i->references);
4484     Jim_FreeHashTable(&i->stub);
4485     Jim_FreeHashTable(&i->assocData);
4486     Jim_FreeHashTable(&i->packages);
4487     Jim_Free(i->prngState);
4488     /* Free the call frames list */
4489     while(cf) {
4490         prevcf = cf->parentCallFrame;
4491         JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4492         cf = prevcf;
4493     }
4494     /* Check that the live object list is empty, otherwise
4495      * there is a memory leak. */
4496     if (i->liveList != NULL) {
4497         Jim_Obj *objPtr = i->liveList;
4498     
4499         Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4500         Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4501         while(objPtr) {
4502             const char *type = objPtr->typePtr ?
4503                 objPtr->typePtr->name : "";
4504             Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4505                     objPtr, type,
4506                     objPtr->bytes ? objPtr->bytes
4507                     : "(null)", objPtr->refCount);
4508             if (objPtr->typePtr == &sourceObjType) {
4509                 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4510                 objPtr->internalRep.sourceValue.fileName,
4511                 objPtr->internalRep.sourceValue.lineNumber);
4512             }
4513             objPtr = objPtr->nextObjPtr;
4514         }
4515         Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4516         Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4517     }
4518     /* Free all the freed objects. */
4519     objPtr = i->freeList;
4520     while (objPtr) {
4521         nextObjPtr = objPtr->nextObjPtr;
4522         Jim_Free(objPtr);
4523         objPtr = nextObjPtr;
4524     }
4525     /* Free cached CallFrame structures */
4526     cf = i->freeFramesList;
4527     while(cf) {
4528         nextcf = cf->nextFramePtr;
4529         if (cf->vars.table != NULL)
4530             Jim_Free(cf->vars.table);
4531         Jim_Free(cf);
4532         cf = nextcf;
4533     }
4534     /* Free the sharedString hash table. Make sure to free it
4535      * after every other Jim_Object was freed. */
4536     Jim_FreeHashTable(&i->sharedStrings);
4537     /* Free the interpreter structure. */
4538     Jim_Free(i);
4539 }
4540
4541 /* Store the call frame relative to the level represented by
4542  * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4543  * level is assumed to be '1'.
4544  *
4545  * If a newLevelptr int pointer is specified, the function stores
4546  * the absolute level integer value of the new target callframe into
4547  * *newLevelPtr. (this is used to adjust interp->numLevels
4548  * in the implementation of [uplevel], so that [info level] will
4549  * return a correct information).
4550  *
4551  * This function accepts the 'level' argument in the form
4552  * of the commands [uplevel] and [upvar].
4553  *
4554  * For a function accepting a relative integer as level suitable
4555  * for implementation of [info level ?level?] check the
4556  * GetCallFrameByInteger() function. */
4557 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4558         Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4559 {
4560     long level;
4561     const char *str;
4562     Jim_CallFrame *framePtr;
4563
4564     if (newLevelPtr) *newLevelPtr = interp->numLevels;
4565     if (levelObjPtr) {
4566         str = Jim_GetString(levelObjPtr, NULL);
4567         if (str[0] == '#') {
4568             char *endptr;
4569             /* speedup for the toplevel (level #0) */
4570             if (str[1] == '0' && str[2] == '\0') {
4571                 if (newLevelPtr) *newLevelPtr = 0;
4572                 *framePtrPtr = interp->topFramePtr;
4573                 return JIM_OK;
4574             }
4575
4576             level = strtol(str+1, &endptr, 0);
4577             if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4578                 goto badlevel;
4579             /* An 'absolute' level is converted into the
4580              * 'number of levels to go back' format. */
4581             level = interp->numLevels - level;
4582             if (level < 0) goto badlevel;
4583         } else {
4584             if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4585                 goto badlevel;
4586         }
4587     } else {
4588         str = "1"; /* Needed to format the error message. */
4589         level = 1;
4590     }
4591     /* Lookup */
4592     framePtr = interp->framePtr;
4593     if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4594     while (level--) {
4595         framePtr = framePtr->parentCallFrame;
4596         if (framePtr == NULL) goto badlevel;
4597     }
4598     *framePtrPtr = framePtr;
4599     return JIM_OK;
4600 badlevel:
4601     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4602     Jim_AppendStrings(interp, Jim_GetResult(interp),
4603             "bad level \"", str, "\"", NULL);
4604     return JIM_ERR;
4605 }
4606
4607 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4608  * as a relative integer like in the [info level ?level?] command. */
4609 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4610         Jim_CallFrame **framePtrPtr)
4611 {
4612     jim_wide level;
4613     jim_wide relLevel; /* level relative to the current one. */
4614     Jim_CallFrame *framePtr;
4615
4616     if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4617         goto badlevel;
4618     if (level > 0) {
4619         /* An 'absolute' level is converted into the
4620          * 'number of levels to go back' format. */
4621         relLevel = interp->numLevels - level;
4622     } else {
4623         relLevel = -level;
4624     }
4625     /* Lookup */
4626     framePtr = interp->framePtr;
4627     while (relLevel--) {
4628         framePtr = framePtr->parentCallFrame;
4629         if (framePtr == NULL) goto badlevel;
4630     }
4631     *framePtrPtr = framePtr;
4632     return JIM_OK;
4633 badlevel:
4634     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4635     Jim_AppendStrings(interp, Jim_GetResult(interp),
4636             "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4637     return JIM_ERR;
4638 }
4639
4640 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4641 {
4642     Jim_Free((void*)interp->errorFileName);
4643     interp->errorFileName = Jim_StrDup(filename);
4644 }
4645
4646 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4647 {
4648     interp->errorLine = linenr;
4649 }
4650
4651 static void JimResetStackTrace(Jim_Interp *interp)
4652 {
4653     Jim_DecrRefCount(interp, interp->stackTrace);
4654     interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4655     Jim_IncrRefCount(interp->stackTrace);
4656 }
4657
4658 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4659         const char *filename, int linenr)
4660 {
4661     /* No need to add this dummy entry to the stack trace */
4662     if (strcmp(procname, "unknown") == 0) {
4663         return;
4664     }
4665
4666     if (Jim_IsShared(interp->stackTrace)) {
4667         interp->stackTrace =
4668             Jim_DuplicateObj(interp, interp->stackTrace);
4669         Jim_IncrRefCount(interp->stackTrace);
4670     }
4671     Jim_ListAppendElement(interp, interp->stackTrace,
4672             Jim_NewStringObj(interp, procname, -1));
4673     Jim_ListAppendElement(interp, interp->stackTrace,
4674             Jim_NewStringObj(interp, filename, -1));
4675     Jim_ListAppendElement(interp, interp->stackTrace,
4676             Jim_NewIntObj(interp, linenr));
4677 }
4678
4679 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4680 {
4681     AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4682     assocEntryPtr->delProc = delProc;
4683     assocEntryPtr->data = data;
4684     return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4685 }
4686
4687 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4688 {
4689     Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4690     if (entryPtr != NULL) {
4691         AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4692         return assocEntryPtr->data;
4693     }
4694     return NULL;
4695 }
4696
4697 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4698 {
4699     return Jim_DeleteHashEntry(&interp->assocData, key);
4700 }
4701
4702 int Jim_GetExitCode(Jim_Interp *interp) {
4703     return interp->exitCode;
4704 }
4705
4706 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4707 {
4708     if (fp != NULL) interp->cookie_stdin = fp;
4709     return interp->cookie_stdin;
4710 }
4711
4712 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4713 {
4714     if (fp != NULL) interp->cookie_stdout = fp;
4715     return interp->cookie_stdout;
4716 }
4717
4718 void *Jim_SetStderr(Jim_Interp *interp, void  *fp)
4719 {
4720     if (fp != NULL) interp->cookie_stderr = fp;
4721     return interp->cookie_stderr;
4722 }
4723
4724 /* -----------------------------------------------------------------------------
4725  * Shared strings.
4726  * Every interpreter has an hash table where to put shared dynamically
4727  * allocate strings that are likely to be used a lot of times.
4728  * For example, in the 'source' object type, there is a pointer to
4729  * the filename associated with that object. Every script has a lot
4730  * of this objects with the identical file name, so it is wise to share
4731  * this info.
4732  *
4733  * The API is trivial: Jim_GetSharedString(interp, "foobar")
4734  * returns the pointer to the shared string. Every time a reference
4735  * to the string is no longer used, the user should call
4736  * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4737  * a given string, it is removed from the hash table.
4738  * ---------------------------------------------------------------------------*/
4739 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4740 {
4741     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4742
4743     if (he == NULL) {
4744         char *strCopy = Jim_StrDup(str);
4745
4746         Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4747         return strCopy;
4748     } else {
4749         long refCount = (long) he->val;
4750
4751         refCount++;
4752         he->val = (void*) refCount;
4753         return he->key;
4754     }
4755 }
4756
4757 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4758 {
4759     long refCount;
4760     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4761
4762     if (he == NULL)
4763         Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4764               "unknown shared string '%s'", str);
4765     refCount = (long) he->val;
4766     refCount--;
4767     if (refCount == 0) {
4768         Jim_DeleteHashEntry(&interp->sharedStrings, str);
4769     } else {
4770         he->val = (void*) refCount;
4771     }
4772 }
4773
4774 /* -----------------------------------------------------------------------------
4775  * Integer object
4776  * ---------------------------------------------------------------------------*/
4777 #define JIM_INTEGER_SPACE 24
4778
4779 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4780 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4781
4782 static Jim_ObjType intObjType = {
4783     "int",
4784     NULL,
4785     NULL,
4786     UpdateStringOfInt,
4787     JIM_TYPE_NONE,
4788 };
4789
4790 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4791 {
4792     int len;
4793     char buf[JIM_INTEGER_SPACE+1];
4794
4795     len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4796     objPtr->bytes = Jim_Alloc(len+1);
4797     memcpy(objPtr->bytes, buf, len+1);
4798     objPtr->length = len;
4799 }
4800
4801 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4802 {
4803     jim_wide wideValue;
4804     const char *str;
4805
4806     /* Get the string representation */
4807     str = Jim_GetString(objPtr, NULL);
4808     /* Try to convert into a jim_wide */
4809     if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4810         if (flags & JIM_ERRMSG) {
4811             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4812             Jim_AppendStrings(interp, Jim_GetResult(interp),
4813                     "expected integer but got \"", str, "\"", NULL);
4814         }
4815         return JIM_ERR;
4816     }
4817     if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4818         errno == ERANGE) {
4819         Jim_SetResultString(interp,
4820             "Integer value too big to be represented", -1);
4821         return JIM_ERR;
4822     }
4823     /* Free the old internal repr and set the new one. */
4824     Jim_FreeIntRep(interp, objPtr);
4825     objPtr->typePtr = &intObjType;
4826     objPtr->internalRep.wideValue = wideValue;
4827     return JIM_OK;
4828 }
4829
4830 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4831 {
4832     if (objPtr->typePtr != &intObjType &&
4833         SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4834         return JIM_ERR;
4835     *widePtr = objPtr->internalRep.wideValue;
4836     return JIM_OK;
4837 }
4838
4839 /* Get a wide but does not set an error if the format is bad. */
4840 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4841         jim_wide *widePtr)
4842 {
4843     if (objPtr->typePtr != &intObjType &&
4844         SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4845         return JIM_ERR;
4846     *widePtr = objPtr->internalRep.wideValue;
4847     return JIM_OK;
4848 }
4849
4850 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4851 {
4852     jim_wide wideValue;
4853     int retval;
4854
4855     retval = Jim_GetWide(interp, objPtr, &wideValue);
4856     if (retval == JIM_OK) {
4857         *longPtr = (long) wideValue;
4858         return JIM_OK;
4859     }
4860     return JIM_ERR;
4861 }
4862
4863 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4864 {
4865     if (Jim_IsShared(objPtr))
4866         Jim_Panic(interp,"Jim_SetWide called with shared object");
4867     if (objPtr->typePtr != &intObjType) {
4868         Jim_FreeIntRep(interp, objPtr);
4869         objPtr->typePtr = &intObjType;
4870     }
4871     Jim_InvalidateStringRep(objPtr);
4872     objPtr->internalRep.wideValue = wideValue;
4873 }
4874
4875 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4876 {
4877     Jim_Obj *objPtr;
4878
4879     objPtr = Jim_NewObj(interp);
4880     objPtr->typePtr = &intObjType;
4881     objPtr->bytes = NULL;
4882     objPtr->internalRep.wideValue = wideValue;
4883     return objPtr;
4884 }
4885
4886 /* -----------------------------------------------------------------------------
4887  * Double object
4888  * ---------------------------------------------------------------------------*/
4889 #define JIM_DOUBLE_SPACE 30
4890
4891 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4892 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4893
4894 static Jim_ObjType doubleObjType = {
4895     "double",
4896     NULL,
4897     NULL,
4898     UpdateStringOfDouble,
4899     JIM_TYPE_NONE,
4900 };
4901
4902 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4903 {
4904     int len;
4905     char buf[JIM_DOUBLE_SPACE+1];
4906
4907     len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4908     objPtr->bytes = Jim_Alloc(len+1);
4909     memcpy(objPtr->bytes, buf, len+1);
4910     objPtr->length = len;
4911 }
4912
4913 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4914 {
4915     double doubleValue;
4916     const char *str;
4917
4918     /* Get the string representation */
4919     str = Jim_GetString(objPtr, NULL);
4920     /* Try to convert into a double */
4921     if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4922         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4923         Jim_AppendStrings(interp, Jim_GetResult(interp),
4924                 "expected number but got '", str, "'", NULL);
4925         return JIM_ERR;
4926     }
4927     /* Free the old internal repr and set the new one. */
4928     Jim_FreeIntRep(interp, objPtr);
4929     objPtr->typePtr = &doubleObjType;
4930     objPtr->internalRep.doubleValue = doubleValue;
4931     return JIM_OK;
4932 }
4933
4934 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4935 {
4936     if (objPtr->typePtr != &doubleObjType &&
4937         SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4938         return JIM_ERR;
4939     *doublePtr = objPtr->internalRep.doubleValue;
4940     return JIM_OK;
4941 }
4942
4943 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4944 {
4945     if (Jim_IsShared(objPtr))
4946         Jim_Panic(interp,"Jim_SetDouble called with shared object");
4947     if (objPtr->typePtr != &doubleObjType) {
4948         Jim_FreeIntRep(interp, objPtr);
4949         objPtr->typePtr = &doubleObjType;
4950     }
4951     Jim_InvalidateStringRep(objPtr);
4952     objPtr->internalRep.doubleValue = doubleValue;
4953 }
4954
4955 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4956 {
4957     Jim_Obj *objPtr;
4958
4959     objPtr = Jim_NewObj(interp);
4960     objPtr->typePtr = &doubleObjType;
4961     objPtr->bytes = NULL;
4962     objPtr->internalRep.doubleValue = doubleValue;
4963     return objPtr;
4964 }
4965
4966 /* -----------------------------------------------------------------------------
4967  * List object
4968  * ---------------------------------------------------------------------------*/
4969 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4970 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4971 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4972 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4973 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4974
4975 /* Note that while the elements of the list may contain references,
4976  * the list object itself can't. This basically means that the
4977  * list object string representation as a whole can't contain references
4978  * that are not presents in the single elements. */
4979 static Jim_ObjType listObjType = {
4980     "list",
4981     FreeListInternalRep,
4982     DupListInternalRep,
4983     UpdateStringOfList,
4984     JIM_TYPE_NONE,
4985 };
4986
4987 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4988 {
4989     int i;
4990
4991     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4992         Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4993     }
4994     Jim_Free(objPtr->internalRep.listValue.ele);
4995 }
4996
4997 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4998 {
4999     int i;
5000     JIM_NOTUSED(interp);
5001
5002     dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5003     dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5004     dupPtr->internalRep.listValue.ele =
5005         Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5006     memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5007             sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5008     for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5009         Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5010     }
5011     dupPtr->typePtr = &listObjType;
5012 }
5013
5014 /* The following function checks if a given string can be encoded
5015  * into a list element without any kind of quoting, surrounded by braces,
5016  * or using escapes to quote. */
5017 #define JIM_ELESTR_SIMPLE 0
5018 #define JIM_ELESTR_BRACE 1
5019 #define JIM_ELESTR_QUOTE 2
5020 static int ListElementQuotingType(const char *s, int len)
5021 {
5022     int i, level, trySimple = 1;
5023
5024     /* Try with the SIMPLE case */
5025     if (len == 0) return JIM_ELESTR_BRACE;
5026     if (s[0] == '"' || s[0] == '{') {
5027         trySimple = 0;
5028         goto testbrace;
5029     }
5030     for (i = 0; i < len; i++) {
5031         switch(s[i]) {
5032         case ' ':
5033         case '$':
5034         case '"':
5035         case '[':
5036         case ']':
5037         case ';':
5038         case '\\':
5039         case '\r':
5040         case '\n':
5041         case '\t':
5042         case '\f':
5043         case '\v':
5044             trySimple = 0;
5045         case '{':
5046         case '}':
5047             goto testbrace;
5048         }
5049     }
5050     return JIM_ELESTR_SIMPLE;
5051
5052 testbrace:
5053     /* Test if it's possible to do with braces */
5054     if (s[len-1] == '\\' ||
5055         s[len-1] == ']') return JIM_ELESTR_QUOTE;
5056     level = 0;
5057     for (i = 0; i < len; i++) {
5058         switch(s[i]) {
5059         case '{': level++; break;
5060         case '}': level--;
5061               if (level < 0) return JIM_ELESTR_QUOTE;
5062               break;
5063         case '\\':
5064               if (s[i+1] == '\n')
5065                   return JIM_ELESTR_QUOTE;
5066               else
5067                   if (s[i+1] != '\0') i++;
5068               break;
5069         }
5070     }
5071     if (level == 0) {
5072         if (!trySimple) return JIM_ELESTR_BRACE;
5073         for (i = 0; i < len; i++) {
5074             switch(s[i]) {
5075             case ' ':
5076             case '$':
5077             case '"':
5078             case '[':
5079             case ']':
5080             case ';':
5081             case '\\':
5082             case '\r':
5083             case '\n':
5084             case '\t':
5085             case '\f':
5086             case '\v':
5087                 return JIM_ELESTR_BRACE;
5088                 break;
5089             }
5090         }
5091         return JIM_ELESTR_SIMPLE;
5092     }
5093     return JIM_ELESTR_QUOTE;
5094 }
5095
5096 /* Returns the malloc-ed representation of a string
5097  * using backslash to quote special chars. */
5098 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5099 {
5100     char *q = Jim_Alloc(len*2+1), *p;
5101
5102     p = q;
5103     while(*s) {
5104         switch (*s) {
5105         case ' ':
5106         case '$':
5107         case '"':
5108         case '[':
5109         case ']':
5110         case '{':
5111         case '}':
5112         case ';':
5113         case '\\':
5114             *p++ = '\\';
5115             *p++ = *s++;
5116             break;
5117         case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5118         case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5119         case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5120         case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5121         case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5122         default:
5123             *p++ = *s++;
5124             break;
5125         }
5126     }
5127     *p = '\0';
5128     *qlenPtr = p-q;
5129     return q;
5130 }
5131
5132 void UpdateStringOfList(struct Jim_Obj *objPtr)
5133 {
5134     int i, bufLen, realLength;
5135     const char *strRep;
5136     char *p;
5137     int *quotingType;
5138     Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5139
5140     /* (Over) Estimate the space needed. */
5141     quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5142     bufLen = 0;
5143     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5144         int len;
5145
5146         strRep = Jim_GetString(ele[i], &len);
5147         quotingType[i] = ListElementQuotingType(strRep, len);
5148         switch (quotingType[i]) {
5149         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5150         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5151         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5152         }
5153         bufLen++; /* elements separator. */
5154     }
5155     bufLen++;
5156
5157     /* Generate the string rep. */
5158     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5159     realLength = 0;
5160     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5161         int len, qlen;
5162         const char *strRep = Jim_GetString(ele[i], &len);
5163         char *q;
5164
5165         switch(quotingType[i]) {
5166         case JIM_ELESTR_SIMPLE:
5167             memcpy(p, strRep, len);
5168             p += len;
5169             realLength += len;
5170             break;
5171         case JIM_ELESTR_BRACE:
5172             *p++ = '{';
5173             memcpy(p, strRep, len);
5174             p += len;
5175             *p++ = '}';
5176             realLength += len+2;
5177             break;
5178         case JIM_ELESTR_QUOTE:
5179             q = BackslashQuoteString(strRep, len, &qlen);
5180             memcpy(p, q, qlen);
5181             Jim_Free(q);
5182             p += qlen;
5183             realLength += qlen;
5184             break;
5185         }
5186         /* Add a separating space */
5187         if (i+1 != objPtr->internalRep.listValue.len) {
5188             *p++ = ' ';
5189             realLength ++;
5190         }
5191     }
5192     *p = '\0'; /* nul term. */
5193     objPtr->length = realLength;
5194     Jim_Free(quotingType);
5195 }
5196
5197 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5198 {
5199     struct JimParserCtx parser;
5200     const char *str;
5201     int strLen;
5202
5203     /* Get the string representation */
5204     str = Jim_GetString(objPtr, &strLen);
5205
5206     /* Free the old internal repr just now and initialize the
5207      * new one just now. The string->list conversion can't fail. */
5208     Jim_FreeIntRep(interp, objPtr);
5209     objPtr->typePtr = &listObjType;
5210     objPtr->internalRep.listValue.len = 0;
5211     objPtr->internalRep.listValue.maxLen = 0;
5212     objPtr->internalRep.listValue.ele = NULL;
5213
5214     /* Convert into a list */
5215     JimParserInit(&parser, str, strLen, 1);
5216     while(!JimParserEof(&parser)) {
5217         char *token;
5218         int tokenLen, type;
5219         Jim_Obj *elementPtr;
5220
5221         JimParseList(&parser);
5222         if (JimParserTtype(&parser) != JIM_TT_STR &&
5223             JimParserTtype(&parser) != JIM_TT_ESC)
5224             continue;
5225         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5226         elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5227         ListAppendElement(objPtr, elementPtr);
5228     }
5229     return JIM_OK;
5230 }
5231
5232 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, 
5233         int len)
5234 {
5235     Jim_Obj *objPtr;
5236     int i;
5237
5238     objPtr = Jim_NewObj(interp);
5239     objPtr->typePtr = &listObjType;
5240     objPtr->bytes = NULL;
5241     objPtr->internalRep.listValue.ele = NULL;
5242     objPtr->internalRep.listValue.len = 0;
5243     objPtr->internalRep.listValue.maxLen = 0;
5244     for (i = 0; i < len; i++) {
5245         ListAppendElement(objPtr, elements[i]);
5246     }
5247     return objPtr;
5248 }
5249
5250 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5251  * length of the vector. Note that the user of this function should make
5252  * sure that the list object can't shimmer while the vector returned
5253  * is in use, this vector is the one stored inside the internal representation
5254  * of the list object. This function is not exported, extensions should
5255  * always access to the List object elements using Jim_ListIndex(). */
5256 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5257         Jim_Obj ***listVec)
5258 {
5259     Jim_ListLength(interp, listObj, argc);
5260     assert(listObj->typePtr == &listObjType);
5261     *listVec = listObj->internalRep.listValue.ele;
5262 }
5263
5264 /* ListSortElements type values */
5265 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5266       JIM_LSORT_NOCASE_DECR};
5267
5268 /* Sort the internal rep of a list. */
5269 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5270 {
5271     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5272 }
5273
5274 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5275 {
5276     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5277 }
5278
5279 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5280 {
5281     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5282 }
5283
5284 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5285 {
5286     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5287 }
5288
5289 /* Sort a list *in place*. MUST be called with non-shared objects. */
5290 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5291 {
5292     typedef int (qsort_comparator)(const void *, const void *);
5293     int (*fn)(Jim_Obj**, Jim_Obj**);
5294     Jim_Obj **vector;
5295     int len;
5296
5297     if (Jim_IsShared(listObjPtr))
5298         Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5299     if (listObjPtr->typePtr != &listObjType)
5300         SetListFromAny(interp, listObjPtr);
5301
5302     vector = listObjPtr->internalRep.listValue.ele;
5303     len = listObjPtr->internalRep.listValue.len;
5304     switch (type) {
5305         case JIM_LSORT_ASCII: fn = ListSortString;  break;
5306         case JIM_LSORT_NOCASE: fn = ListSortStringNoCase;  break;
5307         case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr;  break;
5308         case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr;  break;
5309         default:
5310             fn = NULL; /* avoid warning */
5311             Jim_Panic(interp,"ListSort called with invalid sort type");
5312     }
5313     qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5314     Jim_InvalidateStringRep(listObjPtr);
5315 }
5316
5317 /* This is the low-level function to append an element to a list.
5318  * The higher-level Jim_ListAppendElement() performs shared object
5319  * check and invalidate the string repr. This version is used
5320  * in the internals of the List Object and is not exported.
5321  *
5322  * NOTE: this function can be called only against objects
5323  * with internal type of List. */
5324 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5325 {
5326     int requiredLen = listPtr->internalRep.listValue.len + 1;
5327
5328     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5329         int maxLen = requiredLen * 2;
5330
5331         listPtr->internalRep.listValue.ele =
5332             Jim_Realloc(listPtr->internalRep.listValue.ele,
5333                     sizeof(Jim_Obj*)*maxLen);
5334         listPtr->internalRep.listValue.maxLen = maxLen;
5335     }
5336     listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5337         objPtr;
5338     listPtr->internalRep.listValue.len ++;
5339     Jim_IncrRefCount(objPtr);
5340 }
5341
5342 /* This is the low-level function to insert elements into a list.
5343  * The higher-level Jim_ListInsertElements() performs shared object
5344  * check and invalidate the string repr. This version is used
5345  * in the internals of the List Object and is not exported.
5346  *
5347  * NOTE: this function can be called only against objects
5348  * with internal type of List. */
5349 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5350         Jim_Obj *const *elemVec)
5351 {
5352     int currentLen = listPtr->internalRep.listValue.len;
5353     int requiredLen = currentLen + elemc;
5354     int i;
5355     Jim_Obj **point;
5356
5357     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5358         int maxLen = requiredLen * 2;
5359
5360         listPtr->internalRep.listValue.ele =
5361             Jim_Realloc(listPtr->internalRep.listValue.ele,
5362                     sizeof(Jim_Obj*)*maxLen);
5363         listPtr->internalRep.listValue.maxLen = maxLen;
5364     }
5365     point = listPtr->internalRep.listValue.ele + index;
5366     memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5367     for (i=0; i < elemc; ++i) {
5368         point[i] = elemVec[i];
5369         Jim_IncrRefCount(point[i]);
5370     }
5371     listPtr->internalRep.listValue.len += elemc;
5372 }
5373
5374 /* Appends every element of appendListPtr into listPtr.
5375  * Both have to be of the list type. */
5376 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5377 {
5378     int i, oldLen = listPtr->internalRep.listValue.len;
5379     int appendLen = appendListPtr->internalRep.listValue.len;
5380     int requiredLen = oldLen + appendLen;
5381
5382     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5383         int maxLen = requiredLen * 2;
5384
5385         listPtr->internalRep.listValue.ele =
5386             Jim_Realloc(listPtr->internalRep.listValue.ele,
5387                     sizeof(Jim_Obj*)*maxLen);
5388         listPtr->internalRep.listValue.maxLen = maxLen;
5389     }
5390     for (i = 0; i < appendLen; i++) {
5391         Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5392         listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5393         Jim_IncrRefCount(objPtr);
5394     }
5395     listPtr->internalRep.listValue.len += appendLen;
5396 }
5397
5398 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5399 {
5400     if (Jim_IsShared(listPtr))
5401         Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5402     if (listPtr->typePtr != &listObjType)
5403         SetListFromAny(interp, listPtr);
5404     Jim_InvalidateStringRep(listPtr);
5405     ListAppendElement(listPtr, objPtr);
5406 }
5407
5408 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5409 {
5410     if (Jim_IsShared(listPtr))
5411         Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5412     if (listPtr->typePtr != &listObjType)
5413         SetListFromAny(interp, listPtr);
5414     Jim_InvalidateStringRep(listPtr);
5415     ListAppendList(listPtr, appendListPtr);
5416 }
5417
5418 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5419 {
5420     if (listPtr->typePtr != &listObjType)
5421         SetListFromAny(interp, listPtr);
5422     *intPtr = listPtr->internalRep.listValue.len;
5423 }
5424
5425 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5426         int objc, Jim_Obj *const *objVec)
5427 {
5428     if (Jim_IsShared(listPtr))
5429         Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5430     if (listPtr->typePtr != &listObjType)
5431         SetListFromAny(interp, listPtr);
5432     if (index >= 0 && index > listPtr->internalRep.listValue.len)
5433         index = listPtr->internalRep.listValue.len;
5434     else if (index < 0 ) 
5435         index = 0;
5436     Jim_InvalidateStringRep(listPtr);
5437     ListInsertElements(listPtr, index, objc, objVec);
5438 }
5439
5440 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5441         Jim_Obj **objPtrPtr, int flags)
5442 {
5443     if (listPtr->typePtr != &listObjType)
5444         SetListFromAny(interp, listPtr);
5445     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5446         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5447         if (flags & JIM_ERRMSG) {
5448             Jim_SetResultString(interp,
5449                 "list index out of range", -1);
5450         }
5451         return JIM_ERR;
5452     }
5453     if (index < 0)
5454         index = listPtr->internalRep.listValue.len+index;
5455     *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5456     return JIM_OK;
5457 }
5458
5459 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5460         Jim_Obj *newObjPtr, int flags)
5461 {
5462     if (listPtr->typePtr != &listObjType)
5463         SetListFromAny(interp, listPtr);
5464     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5465         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5466         if (flags & JIM_ERRMSG) {
5467             Jim_SetResultString(interp,
5468                 "list index out of range", -1);
5469         }
5470         return JIM_ERR;
5471     }
5472     if (index < 0)
5473         index = listPtr->internalRep.listValue.len+index;
5474     Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5475     listPtr->internalRep.listValue.ele[index] = newObjPtr;
5476     Jim_IncrRefCount(newObjPtr);
5477     return JIM_OK;
5478 }
5479
5480 /* Modify the list stored into the variable named 'varNamePtr'
5481  * setting the element specified by the 'indexc' indexes objects in 'indexv',
5482  * with the new element 'newObjptr'. */
5483 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5484         Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5485 {
5486     Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5487     int shared, i, index;
5488
5489     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5490     if (objPtr == NULL)
5491         return JIM_ERR;
5492     if ((shared = Jim_IsShared(objPtr)))
5493         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5494     for (i = 0; i < indexc-1; i++) {
5495         listObjPtr = objPtr;
5496         if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5497             goto err;
5498         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5499                     JIM_ERRMSG) != JIM_OK) {
5500             goto err;
5501         }
5502         if (Jim_IsShared(objPtr)) {
5503             objPtr = Jim_DuplicateObj(interp, objPtr);
5504             ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5505         }
5506         Jim_InvalidateStringRep(listObjPtr);
5507     }
5508     if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5509         goto err;
5510     if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5511         goto err;
5512     Jim_InvalidateStringRep(objPtr);
5513     Jim_InvalidateStringRep(varObjPtr);
5514     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5515         goto err;
5516     Jim_SetResult(interp, varObjPtr);
5517     return JIM_OK;
5518 err:
5519     if (shared) {
5520         Jim_FreeNewObj(interp, varObjPtr);
5521     }
5522     return JIM_ERR;
5523 }
5524
5525 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5526 {
5527     int i;
5528
5529     /* If all the objects in objv are lists without string rep.
5530      * it's possible to return a list as result, that's the
5531      * concatenation of all the lists. */
5532     for (i = 0; i < objc; i++) {
5533         if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5534             break;
5535     }
5536     if (i == objc) {
5537         Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5538         for (i = 0; i < objc; i++)
5539             Jim_ListAppendList(interp, objPtr, objv[i]);
5540         return objPtr;
5541     } else {
5542         /* Else... we have to glue strings together */
5543         int len = 0, objLen;
5544         char *bytes, *p;
5545
5546         /* Compute the length */
5547         for (i = 0; i < objc; i++) {
5548             Jim_GetString(objv[i], &objLen);
5549             len += objLen;
5550         }
5551         if (objc) len += objc-1;
5552         /* Create the string rep, and a stinrg object holding it. */
5553         p = bytes = Jim_Alloc(len+1);
5554         for (i = 0; i < objc; i++) {
5555             const char *s = Jim_GetString(objv[i], &objLen);
5556             while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5557             {
5558                 s++; objLen--; len--;
5559             }
5560             while (objLen && (s[objLen-1] == ' ' ||
5561                 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5562                 objLen--; len--;
5563             }
5564             memcpy(p, s, objLen);
5565             p += objLen;
5566             if (objLen && i+1 != objc) {
5567                 *p++ = ' ';
5568             } else if (i+1 != objc) {
5569                 /* Drop the space calcuated for this
5570                  * element that is instead null. */
5571                 len--;
5572             }
5573         }
5574         *p = '\0';
5575         return Jim_NewStringObjNoAlloc(interp, bytes, len);
5576     }
5577 }
5578
5579 /* Returns a list composed of the elements in the specified range.
5580  * first and start are directly accepted as Jim_Objects and
5581  * processed for the end?-index? case. */
5582 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5583 {
5584     int first, last;
5585     int len, rangeLen;
5586
5587     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5588         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5589         return NULL;
5590     Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5591     first = JimRelToAbsIndex(len, first);
5592     last = JimRelToAbsIndex(len, last);
5593     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5594     return Jim_NewListObj(interp,
5595             listObjPtr->internalRep.listValue.ele+first, rangeLen);
5596 }
5597
5598 /* -----------------------------------------------------------------------------
5599  * Dict object
5600  * ---------------------------------------------------------------------------*/
5601 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5602 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5603 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5604 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5605
5606 /* Dict HashTable Type.
5607  *
5608  * Keys and Values are Jim objects. */
5609
5610 unsigned int JimObjectHTHashFunction(const void *key)
5611 {
5612     const char *str;
5613     Jim_Obj *objPtr = (Jim_Obj*) key;
5614     int len, h;
5615
5616     str = Jim_GetString(objPtr, &len);
5617     h = Jim_GenHashFunction((unsigned char*)str, len);
5618     return h;
5619 }
5620
5621 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5622 {
5623     JIM_NOTUSED(privdata);
5624
5625     return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5626 }
5627
5628 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5629 {
5630     Jim_Obj *objPtr = val;
5631
5632     Jim_DecrRefCount(interp, objPtr);
5633 }
5634
5635 static Jim_HashTableType JimDictHashTableType = {
5636     JimObjectHTHashFunction,            /* hash function */
5637     NULL,                               /* key dup */
5638     NULL,                               /* val dup */
5639     JimObjectHTKeyCompare,              /* key compare */
5640     (void(*)(void*, const void*))       /* ATTENTION: const cast */
5641         JimObjectHTKeyValDestructor,    /* key destructor */
5642     JimObjectHTKeyValDestructor         /* val destructor */
5643 };
5644
5645 /* Note that while the elements of the dict may contain references,
5646  * the list object itself can't. This basically means that the
5647  * dict object string representation as a whole can't contain references
5648  * that are not presents in the single elements. */
5649 static Jim_ObjType dictObjType = {
5650     "dict",
5651     FreeDictInternalRep,
5652     DupDictInternalRep,
5653     UpdateStringOfDict,
5654     JIM_TYPE_NONE,
5655 };
5656
5657 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5658 {
5659     JIM_NOTUSED(interp);
5660
5661     Jim_FreeHashTable(objPtr->internalRep.ptr);
5662     Jim_Free(objPtr->internalRep.ptr);
5663 }
5664
5665 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5666 {
5667     Jim_HashTable *ht, *dupHt;
5668     Jim_HashTableIterator *htiter;
5669     Jim_HashEntry *he;
5670
5671     /* Create a new hash table */
5672     ht = srcPtr->internalRep.ptr;
5673     dupHt = Jim_Alloc(sizeof(*dupHt));
5674     Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5675     if (ht->size != 0)
5676         Jim_ExpandHashTable(dupHt, ht->size);
5677     /* Copy every element from the source to the dup hash table */
5678     htiter = Jim_GetHashTableIterator(ht);
5679     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5680         const Jim_Obj *keyObjPtr = he->key;
5681         Jim_Obj *valObjPtr = he->val;
5682
5683         Jim_IncrRefCount((Jim_Obj*)keyObjPtr);  /* ATTENTION: const cast */
5684         Jim_IncrRefCount(valObjPtr);
5685         Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5686     }
5687     Jim_FreeHashTableIterator(htiter);
5688
5689     dupPtr->internalRep.ptr = dupHt;
5690     dupPtr->typePtr = &dictObjType;
5691 }
5692
5693 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5694 {
5695     int i, bufLen, realLength;
5696     const char *strRep;
5697     char *p;
5698     int *quotingType, objc;
5699     Jim_HashTable *ht;
5700     Jim_HashTableIterator *htiter;
5701     Jim_HashEntry *he;
5702     Jim_Obj **objv;
5703
5704     /* Trun the hash table into a flat vector of Jim_Objects. */
5705     ht = objPtr->internalRep.ptr;
5706     objc = ht->used*2;
5707     objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5708     htiter = Jim_GetHashTableIterator(ht);
5709     i = 0;
5710     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5711         objv[i++] = (Jim_Obj*)he->key;  /* ATTENTION: const cast */
5712         objv[i++] = he->val;
5713     }
5714     Jim_FreeHashTableIterator(htiter);
5715     /* (Over) Estimate the space needed. */
5716     quotingType = Jim_Alloc(sizeof(int)*objc);
5717     bufLen = 0;
5718     for (i = 0; i < objc; i++) {
5719         int len;
5720
5721         strRep = Jim_GetString(objv[i], &len);
5722         quotingType[i] = ListElementQuotingType(strRep, len);
5723         switch (quotingType[i]) {
5724         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5725         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5726         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5727         }
5728         bufLen++; /* elements separator. */
5729     }
5730     bufLen++;
5731
5732     /* Generate the string rep. */
5733     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5734     realLength = 0;
5735     for (i = 0; i < objc; i++) {
5736         int len, qlen;
5737         const char *strRep = Jim_GetString(objv[i], &len);
5738         char *q;
5739
5740         switch(quotingType[i]) {
5741         case JIM_ELESTR_SIMPLE:
5742             memcpy(p, strRep, len);
5743             p += len;
5744             realLength += len;
5745             break;
5746         case JIM_ELESTR_BRACE:
5747             *p++ = '{';
5748             memcpy(p, strRep, len);
5749             p += len;
5750             *p++ = '}';
5751             realLength += len+2;
5752             break;
5753         case JIM_ELESTR_QUOTE:
5754             q = BackslashQuoteString(strRep, len, &qlen);
5755             memcpy(p, q, qlen);
5756             Jim_Free(q);
5757             p += qlen;
5758             realLength += qlen;
5759             break;
5760         }
5761         /* Add a separating space */
5762         if (i+1 != objc) {
5763             *p++ = ' ';
5764             realLength ++;
5765         }
5766     }
5767     *p = '\0'; /* nul term. */
5768     objPtr->length = realLength;
5769     Jim_Free(quotingType);
5770     Jim_Free(objv);
5771 }
5772
5773 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5774 {
5775     struct JimParserCtx parser;
5776     Jim_HashTable *ht;
5777     Jim_Obj *objv[2];
5778     const char *str;
5779     int i, strLen;
5780
5781     /* Get the string representation */
5782     str = Jim_GetString(objPtr, &strLen);
5783
5784     /* Free the old internal repr just now and initialize the
5785      * new one just now. The string->list conversion can't fail. */
5786     Jim_FreeIntRep(interp, objPtr);
5787     ht = Jim_Alloc(sizeof(*ht));
5788     Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5789     objPtr->typePtr = &dictObjType;
5790     objPtr->internalRep.ptr = ht;
5791
5792     /* Convert into a dict */
5793     JimParserInit(&parser, str, strLen, 1);
5794     i = 0;
5795     while(!JimParserEof(&parser)) {
5796         char *token;
5797         int tokenLen, type;
5798
5799         JimParseList(&parser);
5800         if (JimParserTtype(&parser) != JIM_TT_STR &&
5801             JimParserTtype(&parser) != JIM_TT_ESC)
5802             continue;
5803         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5804         objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5805         if (i == 2) {
5806             i = 0;
5807             Jim_IncrRefCount(objv[0]);
5808             Jim_IncrRefCount(objv[1]);
5809             if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5810                 Jim_HashEntry *he;
5811                 he = Jim_FindHashEntry(ht, objv[0]);
5812                 Jim_DecrRefCount(interp, objv[0]);
5813                 /* ATTENTION: const cast */
5814                 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5815                 he->val = objv[1];
5816             }
5817         }
5818     }
5819     if (i) {
5820         Jim_FreeNewObj(interp, objv[0]);
5821         objPtr->typePtr = NULL;
5822         Jim_FreeHashTable(ht);
5823         Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5824         return JIM_ERR;
5825     }
5826     return JIM_OK;
5827 }
5828
5829 /* Dict object API */
5830
5831 /* Add an element to a dict. objPtr must be of the "dict" type.
5832  * The higer-level exported function is Jim_DictAddElement().
5833  * If an element with the specified key already exists, the value
5834  * associated is replaced with the new one.
5835  *
5836  * if valueObjPtr == NULL, the key is instead removed if it exists. */
5837 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5838         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5839 {
5840     Jim_HashTable *ht = objPtr->internalRep.ptr;
5841
5842     if (valueObjPtr == NULL) { /* unset */
5843         Jim_DeleteHashEntry(ht, keyObjPtr);
5844         return;
5845     }
5846     Jim_IncrRefCount(keyObjPtr);
5847     Jim_IncrRefCount(valueObjPtr);
5848     if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5849         Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5850         Jim_DecrRefCount(interp, keyObjPtr);
5851         /* ATTENTION: const cast */
5852         Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5853         he->val = valueObjPtr;
5854     }
5855 }
5856
5857 /* Add an element, higher-level interface for DictAddElement().
5858  * If valueObjPtr == NULL, the key is removed if it exists. */
5859 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5860         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5861 {
5862     if (Jim_IsShared(objPtr))
5863         Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5864     if (objPtr->typePtr != &dictObjType) {
5865         if (SetDictFromAny(interp, objPtr) != JIM_OK)
5866             return JIM_ERR;
5867     }
5868     DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5869     Jim_InvalidateStringRep(objPtr);
5870     return JIM_OK;
5871 }
5872
5873 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5874 {
5875     Jim_Obj *objPtr;
5876     int i;
5877
5878     if (len % 2)
5879         Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5880
5881     objPtr = Jim_NewObj(interp);
5882     objPtr->typePtr = &dictObjType;
5883     objPtr->bytes = NULL;
5884     objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5885     Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5886     for (i = 0; i < len; i += 2)
5887         DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5888     return objPtr;
5889 }
5890
5891 /* Return the value associated to the specified dict key */
5892 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5893         Jim_Obj **objPtrPtr, int flags)
5894 {
5895     Jim_HashEntry *he;
5896     Jim_HashTable *ht;
5897
5898     if (dictPtr->typePtr != &dictObjType) {
5899         if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5900             return JIM_ERR;
5901     }
5902     ht = dictPtr->internalRep.ptr;
5903     if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5904         if (flags & JIM_ERRMSG) {
5905             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5906             Jim_AppendStrings(interp, Jim_GetResult(interp),
5907                     "key \"", Jim_GetString(keyPtr, NULL),
5908                     "\" not found in dictionary", NULL);
5909         }
5910         return JIM_ERR;
5911     }
5912     *objPtrPtr = he->val;
5913     return JIM_OK;
5914 }
5915
5916 /* Return the value associated to the specified dict keys */
5917 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5918         Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5919 {
5920     Jim_Obj *objPtr;
5921     int i;
5922
5923     if (keyc == 0) {
5924         *objPtrPtr = dictPtr;
5925         return JIM_OK;
5926     }
5927
5928     for (i = 0; i < keyc; i++) {
5929         if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5930                 != JIM_OK)
5931             return JIM_ERR;
5932         dictPtr = objPtr;
5933     }
5934     *objPtrPtr = objPtr;
5935     return JIM_OK;
5936 }
5937
5938 /* Modify the dict stored into the variable named 'varNamePtr'
5939  * setting the element specified by the 'keyc' keys objects in 'keyv',
5940  * with the new value of the element 'newObjPtr'.
5941  *
5942  * If newObjPtr == NULL the operation is to remove the given key
5943  * from the dictionary. */
5944 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5945         Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5946 {
5947     Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5948     int shared, i;
5949
5950     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5951     if (objPtr == NULL) {
5952         if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5953             return JIM_ERR;
5954         varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5955         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5956             Jim_FreeNewObj(interp, varObjPtr);
5957             return JIM_ERR;
5958         }
5959     }
5960     if ((shared = Jim_IsShared(objPtr)))
5961         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5962     for (i = 0; i < keyc-1; i++) {
5963         dictObjPtr = objPtr;
5964
5965         /* Check if it's a valid dictionary */
5966         if (dictObjPtr->typePtr != &dictObjType) {
5967             if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5968                 goto err;
5969         }
5970         /* Check if the given key exists. */
5971         Jim_InvalidateStringRep(dictObjPtr);
5972         if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5973             newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5974         {
5975             /* This key exists at the current level.
5976              * Make sure it's not shared!. */
5977             if (Jim_IsShared(objPtr)) {
5978                 objPtr = Jim_DuplicateObj(interp, objPtr);
5979                 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5980             }
5981         } else {
5982             /* Key not found. If it's an [unset] operation
5983              * this is an error. Only the last key may not
5984              * exist. */
5985             if (newObjPtr == NULL)
5986                 goto err;
5987             /* Otherwise set an empty dictionary
5988              * as key's value. */
5989             objPtr = Jim_NewDictObj(interp, NULL, 0);
5990             DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5991         }
5992     }
5993     if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5994             != JIM_OK)
5995         goto err;
5996     Jim_InvalidateStringRep(objPtr);
5997     Jim_InvalidateStringRep(varObjPtr);
5998     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5999         goto err;
6000     Jim_SetResult(interp, varObjPtr);
6001     return JIM_OK;
6002 err:
6003     if (shared) {
6004         Jim_FreeNewObj(interp, varObjPtr);
6005     }
6006     return JIM_ERR;
6007 }
6008
6009 /* -----------------------------------------------------------------------------
6010  * Index object
6011  * ---------------------------------------------------------------------------*/
6012 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6013 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6014
6015 static Jim_ObjType indexObjType = {
6016     "index",
6017     NULL,
6018     NULL,
6019     UpdateStringOfIndex,
6020     JIM_TYPE_NONE,
6021 };
6022
6023 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6024 {
6025     int len;
6026     char buf[JIM_INTEGER_SPACE+1];
6027
6028     if (objPtr->internalRep.indexValue >= 0)
6029         len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6030     else if (objPtr->internalRep.indexValue == -1)
6031         len = sprintf(buf, "end");
6032     else {
6033         len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6034     }
6035     objPtr->bytes = Jim_Alloc(len+1);
6036     memcpy(objPtr->bytes, buf, len+1);
6037     objPtr->length = len;
6038 }
6039
6040 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6041 {
6042     int index, end = 0;
6043     const char *str;
6044
6045     /* Get the string representation */
6046     str = Jim_GetString(objPtr, NULL);
6047     /* Try to convert into an index */
6048     if (!strcmp(str, "end")) {
6049         index = 0;
6050         end = 1;
6051     } else {
6052         if (!strncmp(str, "end-", 4)) {
6053             str += 4;
6054             end = 1;
6055         }
6056         if (Jim_StringToIndex(str, &index) != JIM_OK) {
6057             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6058             Jim_AppendStrings(interp, Jim_GetResult(interp),
6059                     "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6060                     "must be integer or end?-integer?", NULL);
6061             return JIM_ERR;
6062         }
6063     }
6064     if (end) {
6065         if (index < 0)
6066             index = INT_MAX;
6067         else
6068             index = -(index+1);
6069     } else if (!end && index < 0)
6070         index = -INT_MAX;
6071     /* Free the old internal repr and set the new one. */
6072     Jim_FreeIntRep(interp, objPtr);
6073     objPtr->typePtr = &indexObjType;
6074     objPtr->internalRep.indexValue = index;
6075     return JIM_OK;
6076 }
6077
6078 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6079 {
6080     /* Avoid shimmering if the object is an integer. */
6081     if (objPtr->typePtr == &intObjType) {
6082         jim_wide val = objPtr->internalRep.wideValue;
6083         if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6084             *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6085             return JIM_OK;
6086         }
6087     }
6088     if (objPtr->typePtr != &indexObjType &&
6089         SetIndexFromAny(interp, objPtr) == JIM_ERR)
6090         return JIM_ERR;
6091     *indexPtr = objPtr->internalRep.indexValue;
6092     return JIM_OK;
6093 }
6094
6095 /* -----------------------------------------------------------------------------
6096  * Return Code Object.
6097  * ---------------------------------------------------------------------------*/
6098
6099 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6100
6101 static Jim_ObjType returnCodeObjType = {
6102     "return-code",
6103     NULL,
6104     NULL,
6105     NULL,
6106     JIM_TYPE_NONE,
6107 };
6108
6109 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6110 {
6111     const char *str;
6112     int strLen, returnCode;
6113     jim_wide wideValue;
6114
6115     /* Get the string representation */
6116     str = Jim_GetString(objPtr, &strLen);
6117     /* Try to convert into an integer */
6118     if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6119         returnCode = (int) wideValue;
6120     else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6121         returnCode = JIM_OK;
6122     else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6123         returnCode = JIM_ERR;
6124     else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6125         returnCode = JIM_RETURN;
6126     else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6127         returnCode = JIM_BREAK;
6128     else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6129         returnCode = JIM_CONTINUE;
6130     else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6131         returnCode = JIM_EVAL;
6132     else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6133         returnCode = JIM_EXIT;
6134     else {
6135         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6136         Jim_AppendStrings(interp, Jim_GetResult(interp),
6137                 "expected return code but got '", str, "'",
6138                 NULL);
6139         return JIM_ERR;
6140     }
6141     /* Free the old internal repr and set the new one. */
6142     Jim_FreeIntRep(interp, objPtr);
6143     objPtr->typePtr = &returnCodeObjType;
6144     objPtr->internalRep.returnCode = returnCode;
6145     return JIM_OK;
6146 }
6147
6148 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6149 {
6150     if (objPtr->typePtr != &returnCodeObjType &&
6151         SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6152         return JIM_ERR;
6153     *intPtr = objPtr->internalRep.returnCode;
6154     return JIM_OK;
6155 }
6156
6157 /* -----------------------------------------------------------------------------
6158  * Expression Parsing
6159  * ---------------------------------------------------------------------------*/
6160 static int JimParseExprOperator(struct JimParserCtx *pc);
6161 static int JimParseExprNumber(struct JimParserCtx *pc);
6162 static int JimParseExprIrrational(struct JimParserCtx *pc);
6163
6164 /* Exrp's Stack machine operators opcodes. */
6165
6166 /* Binary operators (numbers) */
6167 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6168 #define JIM_EXPROP_MUL 0
6169 #define JIM_EXPROP_DIV 1
6170 #define JIM_EXPROP_MOD 2
6171 #define JIM_EXPROP_SUB 3
6172 #define JIM_EXPROP_ADD 4
6173 #define JIM_EXPROP_LSHIFT 5
6174 #define JIM_EXPROP_RSHIFT 6
6175 #define JIM_EXPROP_ROTL 7
6176 #define JIM_EXPROP_ROTR 8
6177 #define JIM_EXPROP_LT 9
6178 #define JIM_EXPROP_GT 10
6179 #define JIM_EXPROP_LTE 11
6180 #define JIM_EXPROP_GTE 12
6181 #define JIM_EXPROP_NUMEQ 13
6182 #define JIM_EXPROP_NUMNE 14
6183 #define JIM_EXPROP_BITAND 15
6184 #define JIM_EXPROP_BITXOR 16
6185 #define JIM_EXPROP_BITOR 17
6186 #define JIM_EXPROP_LOGICAND 18
6187 #define JIM_EXPROP_LOGICOR 19
6188 #define JIM_EXPROP_LOGICAND_LEFT 20
6189 #define JIM_EXPROP_LOGICOR_LEFT 21
6190 #define JIM_EXPROP_POW 22
6191 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6192
6193 /* Binary operators (strings) */
6194 #define JIM_EXPROP_STREQ 23
6195 #define JIM_EXPROP_STRNE 24
6196
6197 /* Unary operators (numbers) */
6198 #define JIM_EXPROP_NOT 25
6199 #define JIM_EXPROP_BITNOT 26
6200 #define JIM_EXPROP_UNARYMINUS 27
6201 #define JIM_EXPROP_UNARYPLUS 28
6202 #define JIM_EXPROP_LOGICAND_RIGHT 29
6203 #define JIM_EXPROP_LOGICOR_RIGHT 30
6204
6205 /* Ternary operators */
6206 #define JIM_EXPROP_TERNARY 31
6207
6208 /* Operands */
6209 #define JIM_EXPROP_NUMBER 32
6210 #define JIM_EXPROP_COMMAND 33
6211 #define JIM_EXPROP_VARIABLE 34
6212 #define JIM_EXPROP_DICTSUGAR 35
6213 #define JIM_EXPROP_SUBST 36
6214 #define JIM_EXPROP_STRING 37
6215
6216 /* Operators table */
6217 typedef struct Jim_ExprOperator {
6218     const char *name;
6219     int precedence;
6220     int arity;
6221     int opcode;
6222 } Jim_ExprOperator;
6223
6224 /* name - precedence - arity - opcode */
6225 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6226     {"!", 300, 1, JIM_EXPROP_NOT},
6227     {"~", 300, 1, JIM_EXPROP_BITNOT},
6228     {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6229     {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6230
6231     {"**", 250, 2, JIM_EXPROP_POW},
6232
6233     {"*", 200, 2, JIM_EXPROP_MUL},
6234     {"/", 200, 2, JIM_EXPROP_DIV},
6235     {"%", 200, 2, JIM_EXPROP_MOD},
6236
6237     {"-", 100, 2, JIM_EXPROP_SUB},
6238     {"+", 100, 2, JIM_EXPROP_ADD},
6239
6240     {"<<<", 90, 3, JIM_EXPROP_ROTL},
6241     {">>>", 90, 3, JIM_EXPROP_ROTR},
6242     {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6243     {">>", 90, 2, JIM_EXPROP_RSHIFT},
6244
6245     {"<",  80, 2, JIM_EXPROP_LT},
6246     {">",  80, 2, JIM_EXPROP_GT},
6247     {"<=", 80, 2, JIM_EXPROP_LTE},
6248     {">=", 80, 2, JIM_EXPROP_GTE},
6249
6250     {"==", 70, 2, JIM_EXPROP_NUMEQ},
6251     {"!=", 70, 2, JIM_EXPROP_NUMNE},
6252
6253     {"eq", 60, 2, JIM_EXPROP_STREQ},
6254     {"ne", 60, 2, JIM_EXPROP_STRNE},
6255
6256     {"&", 50, 2, JIM_EXPROP_BITAND},
6257     {"^", 49, 2, JIM_EXPROP_BITXOR},
6258     {"|", 48, 2, JIM_EXPROP_BITOR},
6259
6260     {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6261     {"||", 10, 2, JIM_EXPROP_LOGICOR},
6262
6263     {"?", 5, 3, JIM_EXPROP_TERNARY},
6264     /* private operators */
6265     {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6266     {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6267     {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6268     {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6269 };
6270
6271 #define JIM_EXPR_OPERATORS_NUM \
6272     (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6273
6274 int JimParseExpression(struct JimParserCtx *pc)
6275 {
6276     /* Discard spaces and quoted newline */
6277     while(*(pc->p) == ' ' ||
6278           *(pc->p) == '\t' ||
6279           *(pc->p) == '\r' ||
6280           *(pc->p) == '\n' ||
6281             (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6282         pc->p++; pc->len--;
6283     }
6284
6285     if (pc->len == 0) {
6286         pc->tstart = pc->tend = pc->p;
6287         pc->tline = pc->linenr;
6288         pc->tt = JIM_TT_EOL;
6289         pc->eof = 1;
6290         return JIM_OK;
6291     }
6292     switch(*(pc->p)) {
6293     case '(':
6294         pc->tstart = pc->tend = pc->p;
6295         pc->tline = pc->linenr;
6296         pc->tt = JIM_TT_SUBEXPR_START;
6297         pc->p++; pc->len--;
6298         break;
6299     case ')':
6300         pc->tstart = pc->tend = pc->p;
6301         pc->tline = pc->linenr;
6302         pc->tt = JIM_TT_SUBEXPR_END;
6303         pc->p++; pc->len--;
6304         break;
6305     case '[':
6306         return JimParseCmd(pc);
6307         break;
6308     case '$':
6309         if (JimParseVar(pc) == JIM_ERR)
6310             return JimParseExprOperator(pc);
6311         else
6312             return JIM_OK;
6313         break;
6314     case '-':
6315         if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6316             isdigit((int)*(pc->p+1)))
6317             return JimParseExprNumber(pc);
6318         else
6319             return JimParseExprOperator(pc);
6320         break;
6321     case '0': case '1': case '2': case '3': case '4':
6322     case '5': case '6': case '7': case '8': case '9': case '.':
6323         return JimParseExprNumber(pc);
6324         break;
6325     case '"':
6326     case '{':
6327         /* Here it's possible to reuse the List String parsing. */
6328         pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6329         return JimParseListStr(pc);
6330         break;
6331     case 'N': case 'I':
6332     case 'n': case 'i':
6333         if (JimParseExprIrrational(pc) == JIM_ERR)
6334             return JimParseExprOperator(pc);
6335         break;
6336     default:
6337         return JimParseExprOperator(pc);
6338         break;
6339     }
6340     return JIM_OK;
6341 }
6342
6343 int JimParseExprNumber(struct JimParserCtx *pc)
6344 {
6345     int allowdot = 1;
6346     int allowhex = 0;
6347
6348     pc->tstart = pc->p;
6349     pc->tline = pc->linenr;
6350     if (*pc->p == '-') {
6351         pc->p++; pc->len--;
6352     }
6353     while (  isdigit((int)*pc->p) 
6354           || (allowhex && isxdigit((int)*pc->p) )
6355           || (allowdot && *pc->p == '.') 
6356           || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6357               (*pc->p == 'x' || *pc->p == 'X'))
6358           )
6359     {
6360         if ((*pc->p == 'x') || (*pc->p == 'X')) {
6361             allowhex = 1;
6362             allowdot = 0;
6363                 }
6364         if (*pc->p == '.')
6365             allowdot = 0;
6366         pc->p++; pc->len--;
6367         if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6368             pc->p += 2; pc->len -= 2;
6369         }
6370     }
6371     pc->tend = pc->p-1;
6372     pc->tt = JIM_TT_EXPR_NUMBER;
6373     return JIM_OK;
6374 }
6375
6376 int JimParseExprIrrational(struct JimParserCtx *pc)
6377 {
6378     const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6379     const char **token;
6380     for (token = Tokens; *token != NULL; token++) {
6381         int len = strlen(*token);
6382         if (strncmp(*token, pc->p, len) == 0) {
6383             pc->tstart = pc->p;
6384             pc->tend = pc->p + len - 1;
6385             pc->p += len; pc->len -= len;
6386             pc->tline = pc->linenr;
6387             pc->tt = JIM_TT_EXPR_NUMBER;
6388             return JIM_OK;
6389         }
6390     }
6391     return JIM_ERR;
6392 }
6393
6394 int JimParseExprOperator(struct JimParserCtx *pc)
6395 {
6396     int i;
6397     int bestIdx = -1, bestLen = 0;
6398
6399     /* Try to get the longest match. */
6400     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6401         const char *opname;
6402         int oplen;
6403
6404         opname = Jim_ExprOperators[i].name;
6405         if (opname == NULL) continue;
6406         oplen = strlen(opname);
6407
6408         if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6409             bestIdx = i;
6410             bestLen = oplen;
6411         }
6412     }
6413     if (bestIdx == -1) return JIM_ERR;
6414     pc->tstart = pc->p;
6415     pc->tend = pc->p + bestLen - 1;
6416     pc->p += bestLen; pc->len -= bestLen;
6417     pc->tline = pc->linenr;
6418     pc->tt = JIM_TT_EXPR_OPERATOR;
6419     return JIM_OK;
6420 }
6421
6422 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6423 {
6424     int i;
6425     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6426         if (Jim_ExprOperators[i].name &&
6427             strcmp(opname, Jim_ExprOperators[i].name) == 0)
6428             return &Jim_ExprOperators[i];
6429     return NULL;
6430 }
6431
6432 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6433 {
6434     int i;
6435     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6436         if (Jim_ExprOperators[i].opcode == opcode)
6437             return &Jim_ExprOperators[i];
6438     return NULL;
6439 }
6440
6441 /* -----------------------------------------------------------------------------
6442  * Expression Object
6443  * ---------------------------------------------------------------------------*/
6444 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6445 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6446 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6447
6448 static Jim_ObjType exprObjType = {
6449     "expression",
6450     FreeExprInternalRep,
6451     DupExprInternalRep,
6452     NULL,
6453     JIM_TYPE_REFERENCES,
6454 };
6455
6456 /* Expr bytecode structure */
6457 typedef struct ExprByteCode {
6458     int *opcode;        /* Integer array of opcodes. */
6459     Jim_Obj **obj;      /* Array of associated Jim Objects. */
6460     int len;            /* Bytecode length */
6461     int inUse;          /* Used for sharing. */
6462 } ExprByteCode;
6463
6464 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6465 {
6466     int i;
6467     ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6468
6469     expr->inUse--;
6470     if (expr->inUse != 0) return;
6471     for (i = 0; i < expr->len; i++)
6472         Jim_DecrRefCount(interp, expr->obj[i]);
6473     Jim_Free(expr->opcode);
6474     Jim_Free(expr->obj);
6475     Jim_Free(expr);
6476 }
6477
6478 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6479 {
6480     JIM_NOTUSED(interp);
6481     JIM_NOTUSED(srcPtr);
6482
6483     /* Just returns an simple string. */
6484     dupPtr->typePtr = NULL;
6485 }
6486
6487 /* Add a new instruction to an expression bytecode structure. */
6488 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6489         int opcode, char *str, int len)
6490 {
6491     expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6492     expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6493     expr->opcode[expr->len] = opcode;
6494     expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6495     Jim_IncrRefCount(expr->obj[expr->len]);
6496     expr->len++;
6497 }
6498
6499 /* Check if an expr program looks correct. */
6500 static int ExprCheckCorrectness(ExprByteCode *expr)
6501 {
6502     int i;
6503     int stacklen = 0;
6504
6505     /* Try to check if there are stack underflows,
6506      * and make sure at the end of the program there is
6507      * a single result on the stack. */
6508     for (i = 0; i < expr->len; i++) {
6509         switch(expr->opcode[i]) {
6510         case JIM_EXPROP_NUMBER:
6511         case JIM_EXPROP_STRING:
6512         case JIM_EXPROP_SUBST:
6513         case JIM_EXPROP_VARIABLE:
6514         case JIM_EXPROP_DICTSUGAR:
6515         case JIM_EXPROP_COMMAND:
6516             stacklen++;
6517             break;
6518         case JIM_EXPROP_NOT:
6519         case JIM_EXPROP_BITNOT:
6520         case JIM_EXPROP_UNARYMINUS:
6521         case JIM_EXPROP_UNARYPLUS:
6522             /* Unary operations */
6523             if (stacklen < 1) return JIM_ERR;
6524             break;
6525         case JIM_EXPROP_ADD:
6526         case JIM_EXPROP_SUB:
6527         case JIM_EXPROP_MUL:
6528         case JIM_EXPROP_DIV:
6529         case JIM_EXPROP_MOD:
6530         case JIM_EXPROP_LT:
6531         case JIM_EXPROP_GT:
6532         case JIM_EXPROP_LTE:
6533         case JIM_EXPROP_GTE:
6534         case JIM_EXPROP_ROTL:
6535         case JIM_EXPROP_ROTR:
6536         case JIM_EXPROP_LSHIFT:
6537         case JIM_EXPROP_RSHIFT:
6538         case JIM_EXPROP_NUMEQ:
6539         case JIM_EXPROP_NUMNE:
6540         case JIM_EXPROP_STREQ:
6541         case JIM_EXPROP_STRNE:
6542         case JIM_EXPROP_BITAND:
6543         case JIM_EXPROP_BITXOR:
6544         case JIM_EXPROP_BITOR:
6545         case JIM_EXPROP_LOGICAND:
6546         case JIM_EXPROP_LOGICOR:
6547         case JIM_EXPROP_POW:
6548             /* binary operations */
6549             if (stacklen < 2) return JIM_ERR;
6550             stacklen--;
6551             break;
6552         default:
6553             Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6554             break;
6555         }
6556     }
6557     if (stacklen != 1) return JIM_ERR;
6558     return JIM_OK;
6559 }
6560
6561 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6562         ScriptObj *topLevelScript)
6563 {
6564     int i;
6565
6566     return;
6567     for (i = 0; i < expr->len; i++) {
6568         Jim_Obj *foundObjPtr;
6569
6570         if (expr->obj[i] == NULL) continue;
6571         foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6572                 NULL, expr->obj[i]);
6573         if (foundObjPtr != NULL) {
6574             Jim_IncrRefCount(foundObjPtr);
6575             Jim_DecrRefCount(interp, expr->obj[i]);
6576             expr->obj[i] = foundObjPtr;
6577         }
6578     }
6579 }
6580
6581 /* This procedure converts every occurrence of || and && opereators
6582  * in lazy unary versions.
6583  *
6584  * a b || is converted into:
6585  *
6586  * a <offset> |L b |R
6587  *
6588  * a b && is converted into:
6589  *
6590  * a <offset> &L b &R
6591  *
6592  * "|L" checks if 'a' is true:
6593  *   1) if it is true pushes 1 and skips <offset> istructions to reach
6594  *      the opcode just after |R.
6595  *   2) if it is false does nothing.
6596  * "|R" checks if 'b' is true:
6597  *   1) if it is true pushes 1, otherwise pushes 0.
6598  *
6599  * "&L" checks if 'a' is true:
6600  *   1) if it is true does nothing.
6601  *   2) If it is false pushes 0 and skips <offset> istructions to reach
6602  *      the opcode just after &R
6603  * "&R" checks if 'a' is true:
6604  *      if it is true pushes 1, otherwise pushes 0.
6605  */
6606 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6607 {
6608     while (1) {
6609         int index = -1, leftindex, arity, i, offset;
6610         Jim_ExprOperator *op;
6611
6612         /* Search for || or && */
6613         for (i = 0; i < expr->len; i++) {
6614             if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6615                 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6616                 index = i;
6617                 break;
6618             }
6619         }
6620         if (index == -1) return;
6621         /* Search for the end of the first operator */
6622         leftindex = index-1;
6623         arity = 1;
6624         while(arity) {
6625             switch(expr->opcode[leftindex]) {
6626             case JIM_EXPROP_NUMBER:
6627             case JIM_EXPROP_COMMAND:
6628             case JIM_EXPROP_VARIABLE:
6629             case JIM_EXPROP_DICTSUGAR:
6630             case JIM_EXPROP_SUBST:
6631             case JIM_EXPROP_STRING:
6632                 break;
6633             default:
6634                 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6635                 if (op == NULL) {
6636                     Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6637                 }
6638                 arity += op->arity;
6639                 break;
6640             }
6641             arity--;
6642             leftindex--;
6643         }
6644         leftindex++;
6645         expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6646         expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6647         memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6648                 sizeof(int)*(expr->len-leftindex));
6649         memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6650                 sizeof(Jim_Obj*)*(expr->len-leftindex));
6651         expr->len += 2;
6652         index += 2;
6653         offset = (index-leftindex)-1;
6654         Jim_DecrRefCount(interp, expr->obj[index]);
6655         if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6656             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6657             expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6658             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6659             expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6660         } else {
6661             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6662             expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6663             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6664             expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6665         }
6666         expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6667         expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6668         Jim_IncrRefCount(expr->obj[index]);
6669         Jim_IncrRefCount(expr->obj[leftindex]);
6670         Jim_IncrRefCount(expr->obj[leftindex+1]);
6671     }
6672 }
6673
6674 /* This method takes the string representation of an expression
6675  * and generates a program for the Expr's stack-based VM. */
6676 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6677 {
6678     int exprTextLen;
6679     const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6680     struct JimParserCtx parser;
6681     int i, shareLiterals;
6682     ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6683     Jim_Stack stack;
6684     Jim_ExprOperator *op;
6685
6686     /* Perform literal sharing with the current procedure
6687      * running only if this expression appears to be not generated
6688      * at runtime. */
6689     shareLiterals = objPtr->typePtr == &sourceObjType;
6690
6691     expr->opcode = NULL;
6692     expr->obj = NULL;
6693     expr->len = 0;
6694     expr->inUse = 1;
6695
6696     Jim_InitStack(&stack);
6697     JimParserInit(&parser, exprText, exprTextLen, 1);
6698     while(!JimParserEof(&parser)) {
6699         char *token;
6700         int len, type;
6701
6702         if (JimParseExpression(&parser) != JIM_OK) {
6703             Jim_SetResultString(interp, "Syntax error in expression", -1);
6704             goto err;
6705         }
6706         token = JimParserGetToken(&parser, &len, &type, NULL);
6707         if (type == JIM_TT_EOL) {
6708             Jim_Free(token);
6709             break;
6710         }
6711         switch(type) {
6712         case JIM_TT_STR:
6713             ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6714             break;
6715         case JIM_TT_ESC:
6716             ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6717             break;
6718         case JIM_TT_VAR:
6719             ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6720             break;
6721         case JIM_TT_DICTSUGAR:
6722             ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6723             break;
6724         case JIM_TT_CMD:
6725             ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6726             break;
6727         case JIM_TT_EXPR_NUMBER:
6728             ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6729             break;
6730         case JIM_TT_EXPR_OPERATOR:
6731             op = JimExprOperatorInfo(token);
6732             while(1) {
6733                 Jim_ExprOperator *stackTopOp;
6734
6735                 if (Jim_StackPeek(&stack) != NULL) {
6736                     stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6737                 } else {
6738                     stackTopOp = NULL;
6739                 }
6740                 if (Jim_StackLen(&stack) && op->arity != 1 &&
6741                     stackTopOp && stackTopOp->precedence >= op->precedence)
6742                 {
6743                     ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6744                         Jim_StackPeek(&stack), -1);
6745                     Jim_StackPop(&stack);
6746                 } else {
6747                     break;
6748                 }
6749             }
6750             Jim_StackPush(&stack, token);
6751             break;
6752         case JIM_TT_SUBEXPR_START:
6753             Jim_StackPush(&stack, Jim_StrDup("("));
6754             Jim_Free(token);
6755             break;
6756         case JIM_TT_SUBEXPR_END:
6757             {
6758                 int found = 0;
6759                 while(Jim_StackLen(&stack)) {
6760                     char *opstr = Jim_StackPop(&stack);
6761                     if (!strcmp(opstr, "(")) {
6762                         Jim_Free(opstr);
6763                         found = 1;
6764                         break;
6765                     }
6766                     op = JimExprOperatorInfo(opstr);
6767                     ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6768                 }
6769                 if (!found) {
6770                     Jim_SetResultString(interp,
6771                         "Unexpected close parenthesis", -1);
6772                     goto err;
6773                 }
6774             }
6775             Jim_Free(token);
6776             break;
6777         default:
6778             Jim_Panic(interp,"Default reached in SetExprFromAny()");
6779             break;
6780         }
6781     }
6782     while (Jim_StackLen(&stack)) {
6783         char *opstr = Jim_StackPop(&stack);
6784         op = JimExprOperatorInfo(opstr);
6785         if (op == NULL && !strcmp(opstr, "(")) {
6786             Jim_Free(opstr);
6787             Jim_SetResultString(interp, "Missing close parenthesis", -1);
6788             goto err;
6789         }
6790         ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6791     }
6792     /* Check program correctness. */
6793     if (ExprCheckCorrectness(expr) != JIM_OK) {
6794         Jim_SetResultString(interp, "Invalid expression", -1);
6795         goto err;
6796     }
6797
6798     /* Free the stack used for the compilation. */
6799     Jim_FreeStackElements(&stack, Jim_Free);
6800     Jim_FreeStack(&stack);
6801
6802     /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6803     ExprMakeLazy(interp, expr);
6804
6805     /* Perform literal sharing */
6806     if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6807         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6808         if (bodyObjPtr->typePtr == &scriptObjType) {
6809             ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6810             ExprShareLiterals(interp, expr, bodyScript);
6811         }
6812     }
6813
6814     /* Free the old internal rep and set the new one. */
6815     Jim_FreeIntRep(interp, objPtr);
6816     Jim_SetIntRepPtr(objPtr, expr);
6817     objPtr->typePtr = &exprObjType;
6818     return JIM_OK;
6819
6820 err:    /* we jump here on syntax/compile errors. */
6821     Jim_FreeStackElements(&stack, Jim_Free);
6822     Jim_FreeStack(&stack);
6823     Jim_Free(expr->opcode);
6824     for (i = 0; i < expr->len; i++) {
6825         Jim_DecrRefCount(interp,expr->obj[i]);
6826     }
6827     Jim_Free(expr->obj);
6828     Jim_Free(expr);
6829     return JIM_ERR;
6830 }
6831
6832 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6833 {
6834     if (objPtr->typePtr != &exprObjType) {
6835         if (SetExprFromAny(interp, objPtr) != JIM_OK)
6836             return NULL;
6837     }
6838     return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6839 }
6840
6841 /* -----------------------------------------------------------------------------
6842  * Expressions evaluation.
6843  * Jim uses a specialized stack-based virtual machine for expressions,
6844  * that takes advantage of the fact that expr's operators
6845  * can't be redefined.
6846  *
6847  * Jim_EvalExpression() uses the bytecode compiled by
6848  * SetExprFromAny() method of the "expression" object.
6849  *
6850  * On success a Tcl Object containing the result of the evaluation
6851  * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6852  * returned.
6853  * On error the function returns a retcode != to JIM_OK and set a suitable
6854  * error on the interp.
6855  * ---------------------------------------------------------------------------*/
6856 #define JIM_EE_STATICSTACK_LEN 10
6857
6858 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6859         Jim_Obj **exprResultPtrPtr)
6860 {
6861     ExprByteCode *expr;
6862     Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6863     int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6864
6865     Jim_IncrRefCount(exprObjPtr);
6866     expr = Jim_GetExpression(interp, exprObjPtr);
6867     if (!expr) {
6868         Jim_DecrRefCount(interp, exprObjPtr);
6869         return JIM_ERR; /* error in expression. */
6870     }
6871     /* In order to avoid that the internal repr gets freed due to
6872      * shimmering of the exprObjPtr's object, we make the internal rep
6873      * shared. */
6874     expr->inUse++;
6875
6876     /* The stack-based expr VM itself */
6877
6878     /* Stack allocation. Expr programs have the feature that
6879      * a program of length N can't require a stack longer than
6880      * N. */
6881     if (expr->len > JIM_EE_STATICSTACK_LEN)
6882         stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6883     else
6884         stack = staticStack;
6885
6886     /* Execute every istruction */
6887     for (i = 0; i < expr->len; i++) {
6888         Jim_Obj *A, *B, *objPtr;
6889         jim_wide wA, wB, wC;
6890         double dA, dB, dC;
6891         const char *sA, *sB;
6892         int Alen, Blen, retcode;
6893         int opcode = expr->opcode[i];
6894
6895         if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6896             stack[stacklen++] = expr->obj[i];
6897             Jim_IncrRefCount(expr->obj[i]);
6898         } else if (opcode == JIM_EXPROP_VARIABLE) {
6899             objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6900             if (objPtr == NULL) {
6901                 error = 1;
6902                 goto err;
6903             }
6904             stack[stacklen++] = objPtr;
6905             Jim_IncrRefCount(objPtr);
6906         } else if (opcode == JIM_EXPROP_SUBST) {
6907             if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6908                         &objPtr, JIM_NONE)) != JIM_OK)
6909             {
6910                 error = 1;
6911                 errRetCode = retcode;
6912                 goto err;
6913             }
6914             stack[stacklen++] = objPtr;
6915             Jim_IncrRefCount(objPtr);
6916         } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6917             objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6918             if (objPtr == NULL) {
6919                 error = 1;
6920                 goto err;
6921             }
6922             stack[stacklen++] = objPtr;
6923             Jim_IncrRefCount(objPtr);
6924         } else if (opcode == JIM_EXPROP_COMMAND) {
6925             if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6926                 error = 1;
6927                 errRetCode = retcode;
6928                 goto err;
6929             }
6930             stack[stacklen++] = interp->result;
6931             Jim_IncrRefCount(interp->result);
6932         } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6933                    opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6934         {
6935             /* Note that there isn't to increment the
6936              * refcount of objects. the references are moved
6937              * from stack to A and B. */
6938             B = stack[--stacklen];
6939             A = stack[--stacklen];
6940
6941             /* --- Integer --- */
6942             if ((A->typePtr == &doubleObjType && !A->bytes) ||
6943                 (B->typePtr == &doubleObjType && !B->bytes) ||
6944                 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6945                 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6946                 goto trydouble;
6947             }
6948             Jim_DecrRefCount(interp, A);
6949             Jim_DecrRefCount(interp, B);
6950             switch(expr->opcode[i]) {
6951             case JIM_EXPROP_ADD: wC = wA+wB; break;
6952             case JIM_EXPROP_SUB: wC = wA-wB; break;
6953             case JIM_EXPROP_MUL: wC = wA*wB; break;
6954             case JIM_EXPROP_LT: wC = wA<wB; break;
6955             case JIM_EXPROP_GT: wC = wA>wB; break;
6956             case JIM_EXPROP_LTE: wC = wA<=wB; break;
6957             case JIM_EXPROP_GTE: wC = wA>=wB; break;
6958             case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6959             case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6960             case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6961             case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6962             case JIM_EXPROP_BITAND: wC = wA&wB; break;
6963             case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6964             case JIM_EXPROP_BITOR: wC = wA|wB; break;
6965             case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6966             case JIM_EXPROP_LOGICAND_LEFT:
6967                 if (wA == 0) {
6968                     i += (int)wB;
6969                     wC = 0;
6970                 } else {
6971                     continue;
6972                 }
6973                 break;
6974             case JIM_EXPROP_LOGICOR_LEFT:
6975                 if (wA != 0) {
6976                     i += (int)wB;
6977                     wC = 1;
6978                 } else {
6979                     continue;
6980                 }
6981                 break;
6982             case JIM_EXPROP_DIV:
6983                 if (wB == 0) goto divbyzero;
6984                 wC = wA/wB;
6985                 break;
6986             case JIM_EXPROP_MOD:
6987                 if (wB == 0) goto divbyzero;
6988                 wC = wA%wB;
6989                 break;
6990             case JIM_EXPROP_ROTL: {
6991                 /* uint32_t would be better. But not everyone has inttypes.h?*/
6992                 unsigned long uA = (unsigned long)wA;
6993 #ifdef _MSC_VER
6994                 wC = _rotl(uA,(unsigned long)wB);
6995 #else
6996                 const unsigned int S = sizeof(unsigned long) * 8;
6997                 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6998 #endif
6999                 break;
7000             }
7001             case JIM_EXPROP_ROTR: {
7002                 unsigned long uA = (unsigned long)wA;
7003 #ifdef _MSC_VER
7004                 wC = _rotr(uA,(unsigned long)wB);
7005 #else
7006                 const unsigned int S = sizeof(unsigned long) * 8;
7007                 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7008 #endif
7009                 break;
7010             }
7011
7012             default:
7013                 wC = 0; /* avoid gcc warning */
7014                 break;
7015             }
7016             stack[stacklen] = Jim_NewIntObj(interp, wC);
7017             Jim_IncrRefCount(stack[stacklen]);
7018             stacklen++;
7019             continue;
7020 trydouble:
7021             /* --- Double --- */
7022             if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7023                 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7024
7025                 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7026                 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7027                     opcode = JIM_EXPROP_STRNE;
7028                     goto retry_as_string;
7029                 }
7030                 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7031                     opcode = JIM_EXPROP_STREQ;
7032                     goto retry_as_string;
7033                 }
7034                 Jim_DecrRefCount(interp, A);
7035                 Jim_DecrRefCount(interp, B);
7036                 error = 1;
7037                 goto err;
7038             }
7039             Jim_DecrRefCount(interp, A);
7040             Jim_DecrRefCount(interp, B);
7041             switch(expr->opcode[i]) {
7042             case JIM_EXPROP_ROTL:
7043             case JIM_EXPROP_ROTR:
7044             case JIM_EXPROP_LSHIFT:
7045             case JIM_EXPROP_RSHIFT:
7046             case JIM_EXPROP_BITAND:
7047             case JIM_EXPROP_BITXOR:
7048             case JIM_EXPROP_BITOR:
7049             case JIM_EXPROP_MOD:
7050             case JIM_EXPROP_POW:
7051                 Jim_SetResultString(interp,
7052                     "Got floating-point value where integer was expected", -1);
7053                 error = 1;
7054                 goto err;
7055                 break;
7056             case JIM_EXPROP_ADD: dC = dA+dB; break;
7057             case JIM_EXPROP_SUB: dC = dA-dB; break;
7058             case JIM_EXPROP_MUL: dC = dA*dB; break;
7059             case JIM_EXPROP_LT: dC = dA<dB; break;
7060             case JIM_EXPROP_GT: dC = dA>dB; break;
7061             case JIM_EXPROP_LTE: dC = dA<=dB; break;
7062             case JIM_EXPROP_GTE: dC = dA>=dB; break;
7063             case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7064             case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7065             case JIM_EXPROP_LOGICAND_LEFT:
7066                 if (dA == 0) {
7067                     i += (int)dB;
7068                     dC = 0;
7069                 } else {
7070                     continue;
7071                 }
7072                 break;
7073             case JIM_EXPROP_LOGICOR_LEFT:
7074                 if (dA != 0) {
7075                     i += (int)dB;
7076                     dC = 1;
7077                 } else {
7078                     continue;
7079                 }
7080                 break;
7081             case JIM_EXPROP_DIV:
7082                 if (dB == 0) goto divbyzero;
7083                 dC = dA/dB;
7084                 break;
7085             default:
7086                 dC = 0; /* avoid gcc warning */
7087                 break;
7088             }
7089             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7090             Jim_IncrRefCount(stack[stacklen]);
7091             stacklen++;
7092         } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7093             B = stack[--stacklen];
7094             A = stack[--stacklen];
7095 retry_as_string:
7096             sA = Jim_GetString(A, &Alen);
7097             sB = Jim_GetString(B, &Blen);
7098             switch(opcode) {
7099             case JIM_EXPROP_STREQ:
7100                 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7101                     wC = 1;
7102                 else
7103                     wC = 0;
7104                 break;
7105             case JIM_EXPROP_STRNE:
7106                 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7107                     wC = 1;
7108                 else
7109                     wC = 0;
7110                 break;
7111             default:
7112                 wC = 0; /* avoid gcc warning */
7113                 break;
7114             }
7115             Jim_DecrRefCount(interp, A);
7116             Jim_DecrRefCount(interp, B);
7117             stack[stacklen] = Jim_NewIntObj(interp, wC);
7118             Jim_IncrRefCount(stack[stacklen]);
7119             stacklen++;
7120         } else if (opcode == JIM_EXPROP_NOT ||
7121                    opcode == JIM_EXPROP_BITNOT ||
7122                    opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7123                    opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7124             /* Note that there isn't to increment the
7125              * refcount of objects. the references are moved
7126              * from stack to A and B. */
7127             A = stack[--stacklen];
7128
7129             /* --- Integer --- */
7130             if ((A->typePtr == &doubleObjType && !A->bytes) ||
7131                 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7132                 goto trydouble_unary;
7133             }
7134             Jim_DecrRefCount(interp, A);
7135             switch(expr->opcode[i]) {
7136             case JIM_EXPROP_NOT: wC = !wA; break;
7137             case JIM_EXPROP_BITNOT: wC = ~wA; break;
7138             case JIM_EXPROP_LOGICAND_RIGHT:
7139             case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7140             default:
7141                 wC = 0; /* avoid gcc warning */
7142                 break;
7143             }
7144             stack[stacklen] = Jim_NewIntObj(interp, wC);
7145             Jim_IncrRefCount(stack[stacklen]);
7146             stacklen++;
7147             continue;
7148 trydouble_unary:
7149             /* --- Double --- */
7150             if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7151                 Jim_DecrRefCount(interp, A);
7152                 error = 1;
7153                 goto err;
7154             }
7155             Jim_DecrRefCount(interp, A);
7156             switch(expr->opcode[i]) {
7157             case JIM_EXPROP_NOT: dC = !dA; break;
7158             case JIM_EXPROP_LOGICAND_RIGHT:
7159             case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7160             case JIM_EXPROP_BITNOT:
7161                 Jim_SetResultString(interp,
7162                     "Got floating-point value where integer was expected", -1);
7163                 error = 1;
7164                 goto err;
7165                 break;
7166             default:
7167                 dC = 0; /* avoid gcc warning */
7168                 break;
7169             }
7170             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7171             Jim_IncrRefCount(stack[stacklen]);
7172             stacklen++;
7173         } else {
7174             Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7175         }
7176     }
7177 err:
7178     /* There is no need to decerement the inUse field because
7179      * this reference is transfered back into the exprObjPtr. */
7180     Jim_FreeIntRep(interp, exprObjPtr);
7181     exprObjPtr->typePtr = &exprObjType;
7182     Jim_SetIntRepPtr(exprObjPtr, expr);
7183     Jim_DecrRefCount(interp, exprObjPtr);
7184     if (!error) {
7185         *exprResultPtrPtr = stack[0];
7186         Jim_IncrRefCount(stack[0]);
7187         errRetCode = JIM_OK;
7188     }
7189     for (i = 0; i < stacklen; i++) {
7190         Jim_DecrRefCount(interp, stack[i]);
7191     }
7192     if (stack != staticStack)
7193         Jim_Free(stack);
7194     return errRetCode;
7195 divbyzero:
7196     error = 1;
7197     Jim_SetResultString(interp, "Division by zero", -1);
7198     goto err;
7199 }
7200
7201 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7202 {
7203     int retcode;
7204     jim_wide wideValue;
7205     double doubleValue;
7206     Jim_Obj *exprResultPtr;
7207
7208     retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7209     if (retcode != JIM_OK)
7210         return retcode;
7211     if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7212         if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7213         {
7214             Jim_DecrRefCount(interp, exprResultPtr);
7215             return JIM_ERR;
7216         } else {
7217             Jim_DecrRefCount(interp, exprResultPtr);
7218             *boolPtr = doubleValue != 0;
7219             return JIM_OK;
7220         }
7221     }
7222     Jim_DecrRefCount(interp, exprResultPtr);
7223     *boolPtr = wideValue != 0;
7224     return JIM_OK;
7225 }
7226
7227 /* -----------------------------------------------------------------------------
7228  * ScanFormat String Object
7229  * ---------------------------------------------------------------------------*/
7230
7231 /* This Jim_Obj will held a parsed representation of a format string passed to
7232  * the Jim_ScanString command. For error diagnostics, the scanformat string has
7233  * to be parsed in its entirely first and then, if correct, can be used for
7234  * scanning. To avoid endless re-parsing, the parsed representation will be
7235  * stored in an internal representation and re-used for performance reason. */
7236  
7237 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7238  * scanformat string. This part will later be used to extract information
7239  * out from the string to be parsed by Jim_ScanString */
7240  
7241 typedef struct ScanFmtPartDescr {
7242     char type;         /* Type of conversion (e.g. c, d, f) */
7243     char modifier;     /* Modify type (e.g. l - long, h - short */
7244     size_t  width;     /* Maximal width of input to be converted */
7245     int  pos;          /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */ 
7246     char *arg;         /* Specification of a CHARSET conversion */
7247     char *prefix;      /* Prefix to be scanned literally before conversion */
7248 } ScanFmtPartDescr;
7249
7250 /* The ScanFmtStringObj will held the internal representation of a scanformat
7251  * string parsed and separated in part descriptions. Furthermore it contains
7252  * the original string representation of the scanformat string to allow for
7253  * fast update of the Jim_Obj's string representation part.
7254  *
7255  * As add-on the internal object representation add some scratch pad area
7256  * for usage by Jim_ScanString to avoid endless allocating and freeing of
7257  * memory for purpose of string scanning.
7258  *
7259  * The error member points to a static allocated string in case of a mal-
7260  * formed scanformat string or it contains '0' (NULL) in case of a valid
7261  * parse representation.
7262  *
7263  * The whole memory of the internal representation is allocated as a single
7264  * area of memory that will be internally separated. So freeing and duplicating
7265  * of such an object is cheap */
7266
7267 typedef struct ScanFmtStringObj {
7268     jim_wide        size;         /* Size of internal repr in bytes */
7269     char            *stringRep;   /* Original string representation */
7270     size_t          count;        /* Number of ScanFmtPartDescr contained */
7271     size_t          convCount;    /* Number of conversions that will assign */
7272     size_t          maxPos;       /* Max position index if XPG3 is used */
7273     const char      *error;       /* Ptr to error text (NULL if no error */
7274     char            *scratch;     /* Some scratch pad used by Jim_ScanString */
7275     ScanFmtPartDescr descr[1];    /* The vector of partial descriptions */
7276 } ScanFmtStringObj;
7277
7278
7279 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7280 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7281 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7282
7283 static Jim_ObjType scanFmtStringObjType = {
7284     "scanformatstring",
7285     FreeScanFmtInternalRep,
7286     DupScanFmtInternalRep,
7287     UpdateStringOfScanFmt,
7288     JIM_TYPE_NONE,
7289 };
7290
7291 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7292 {
7293     JIM_NOTUSED(interp);
7294     Jim_Free((char*)objPtr->internalRep.ptr);
7295     objPtr->internalRep.ptr = 0;
7296 }
7297
7298 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7299 {
7300     size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7301     ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7302
7303     JIM_NOTUSED(interp);
7304     memcpy(newVec, srcPtr->internalRep.ptr, size);
7305     dupPtr->internalRep.ptr = newVec;
7306     dupPtr->typePtr = &scanFmtStringObjType;
7307 }
7308
7309 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7310 {
7311     char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7312
7313     objPtr->bytes = Jim_StrDup(bytes);
7314     objPtr->length = strlen(bytes);
7315 }
7316
7317 /* SetScanFmtFromAny will parse a given string and create the internal
7318  * representation of the format specification. In case of an error
7319  * the error data member of the internal representation will be set
7320  * to an descriptive error text and the function will be left with
7321  * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7322  * specification */
7323
7324 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7325 {
7326     ScanFmtStringObj *fmtObj;
7327     char *buffer;
7328     int maxCount, i, approxSize, lastPos = -1;
7329     const char *fmt = objPtr->bytes;
7330     int maxFmtLen = objPtr->length;
7331     const char *fmtEnd = fmt + maxFmtLen;
7332     int curr;
7333
7334     Jim_FreeIntRep(interp, objPtr);
7335     /* Count how many conversions could take place maximally */
7336     for (i=0, maxCount=0; i < maxFmtLen; ++i)
7337         if (fmt[i] == '%')
7338             ++maxCount;
7339     /* Calculate an approximation of the memory necessary */
7340     approxSize = sizeof(ScanFmtStringObj)           /* Size of the container */
7341         + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7342         + maxFmtLen * sizeof(char) + 3 + 1          /* Scratch + "%n" + '\0' */
7343         + maxFmtLen * sizeof(char) + 1              /* Original stringrep */
7344         + maxFmtLen * sizeof(char)                  /* Arg for CHARSETs */
7345         + (maxCount +1) * sizeof(char)              /* '\0' for every partial */
7346         + 1;                                        /* safety byte */
7347     fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7348     memset(fmtObj, 0, approxSize);
7349     fmtObj->size = approxSize;
7350     fmtObj->maxPos = 0;
7351     fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7352     fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7353     memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7354     buffer = fmtObj->stringRep + maxFmtLen + 1;
7355     objPtr->internalRep.ptr = fmtObj;
7356     objPtr->typePtr = &scanFmtStringObjType;
7357     for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7358         int width=0, skip;
7359         ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7360         fmtObj->count++;
7361         descr->width = 0;                   /* Assume width unspecified */ 
7362         /* Overread and store any "literal" prefix */
7363         if (*fmt != '%' || fmt[1] == '%') {
7364             descr->type = 0;
7365             descr->prefix = &buffer[i];
7366             for (; fmt < fmtEnd; ++fmt) {
7367                 if (*fmt == '%') {
7368                     if (fmt[1] != '%') break;
7369                     ++fmt;
7370                 }
7371                 buffer[i++] = *fmt;
7372             }
7373             buffer[i++] = 0;
7374         } 
7375         /* Skip the conversion introducing '%' sign */
7376         ++fmt;      
7377         /* End reached due to non-conversion literal only? */
7378         if (fmt >= fmtEnd)
7379             goto done;
7380         descr->pos = 0;                     /* Assume "natural" positioning */
7381         if (*fmt == '*') {
7382             descr->pos = -1;       /* Okay, conversion will not be assigned */
7383             ++fmt;
7384         } else
7385             fmtObj->convCount++;    /* Otherwise count as assign-conversion */
7386         /* Check if next token is a number (could be width or pos */
7387         if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7388             fmt += skip;
7389             /* Was the number a XPG3 position specifier? */
7390             if (descr->pos != -1 && *fmt == '$') {
7391                 int prev;
7392                 ++fmt;
7393                 descr->pos = width;
7394                 width = 0;
7395                 /* Look if "natural" postioning and XPG3 one was mixed */
7396                 if ((lastPos == 0 && descr->pos > 0)
7397                         || (lastPos > 0 && descr->pos == 0)) {
7398                     fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7399                     return JIM_ERR;
7400                 }
7401                 /* Look if this position was already used */
7402                 for (prev=0; prev < curr; ++prev) {
7403                     if (fmtObj->descr[prev].pos == -1) continue;
7404                     if (fmtObj->descr[prev].pos == descr->pos) {
7405                         fmtObj->error = "same \"%n$\" conversion specifier "
7406                             "used more than once";
7407                         return JIM_ERR;
7408                     }
7409                 }
7410                 /* Try to find a width after the XPG3 specifier */
7411                 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7412                     descr->width = width;
7413                     fmt += skip;
7414                 }
7415                 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7416                     fmtObj->maxPos = descr->pos;
7417             } else {
7418                 /* Number was not a XPG3, so it has to be a width */
7419                 descr->width = width;
7420             }
7421         }
7422         /* If positioning mode was undetermined yet, fix this */
7423         if (lastPos == -1)
7424             lastPos = descr->pos;
7425         /* Handle CHARSET conversion type ... */
7426         if (*fmt == '[') {
7427             int swapped = 1, beg = i, end, j;
7428             descr->type = '[';
7429             descr->arg = &buffer[i];
7430             ++fmt;
7431             if (*fmt == '^') buffer[i++] = *fmt++;
7432             if (*fmt == ']') buffer[i++] = *fmt++;
7433             while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7434             if (*fmt != ']') {
7435                 fmtObj->error = "unmatched [ in format string";
7436                 return JIM_ERR;
7437             } 
7438             end = i;
7439             buffer[i++] = 0;
7440             /* In case a range fence was given "backwards", swap it */
7441             while (swapped) {
7442                 swapped = 0;
7443                 for (j=beg+1; j < end-1; ++j) {
7444                     if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7445                         char tmp = buffer[j-1];
7446                         buffer[j-1] = buffer[j+1];
7447                         buffer[j+1] = tmp;
7448                         swapped = 1;
7449                     }
7450                 }
7451             }
7452         } else {
7453             /* Remember any valid modifier if given */
7454             if (strchr("hlL", *fmt) != 0)
7455                 descr->modifier = tolower((int)*fmt++);
7456             
7457             descr->type = *fmt;
7458             if (strchr("efgcsndoxui", *fmt) == 0) {
7459                 fmtObj->error = "bad scan conversion character";
7460                 return JIM_ERR;
7461             } else if (*fmt == 'c' && descr->width != 0) {
7462                 fmtObj->error = "field width may not be specified in %c "
7463                     "conversion";
7464                 return JIM_ERR;
7465             } else if (*fmt == 'u' && descr->modifier == 'l') {
7466                 fmtObj->error = "unsigned wide not supported";
7467                 return JIM_ERR;
7468             }
7469         }
7470         curr++;
7471     }
7472 done:
7473     if (fmtObj->convCount == 0) {
7474         fmtObj->error = "no any conversion specifier given";
7475         return JIM_ERR;
7476     }
7477     return JIM_OK;
7478 }
7479
7480 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7481
7482 #define FormatGetCnvCount(_fo_) \
7483     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7484 #define FormatGetMaxPos(_fo_) \
7485     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7486 #define FormatGetError(_fo_) \
7487     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7488
7489 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7490  * charsets ([a-z123]) within scanning. Later on perhaps a base for a 
7491  * bitvector implementation in Jim? */ 
7492
7493 static int JimTestBit(const char *bitvec, char ch)
7494 {
7495     div_t pos = div(ch-1, 8);
7496     return bitvec[pos.quot] & (1 << pos.rem);
7497 }
7498
7499 static void JimSetBit(char *bitvec, char ch)
7500 {
7501     div_t pos = div(ch-1, 8);
7502     bitvec[pos.quot] |= (1 << pos.rem);
7503 }
7504
7505 #if 0 /* currently not used */
7506 static void JimClearBit(char *bitvec, char ch)
7507 {
7508     div_t pos = div(ch-1, 8);
7509     bitvec[pos.quot] &= ~(1 << pos.rem);
7510 }
7511 #endif
7512
7513 /* JimScanAString is used to scan an unspecified string that ends with
7514  * next WS, or a string that is specified via a charset. The charset
7515  * is currently implemented in a way to only allow for usage with
7516  * ASCII. Whenever we will switch to UNICODE, another idea has to
7517  * be born :-/
7518  *
7519  * FIXME: Works only with ASCII */
7520
7521 static Jim_Obj *
7522 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7523 {
7524     size_t i;
7525     Jim_Obj *result;
7526     char charset[256/8+1];  /* A Charset may contain max 256 chars */
7527     char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7528
7529     /* First init charset to nothing or all, depending if a specified
7530      * or an unspecified string has to be parsed */
7531     memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7532     if (sdescr) {
7533         /* There was a set description given, that means we are parsing
7534          * a specified string. So we have to build a corresponding 
7535          * charset reflecting the description */
7536         int notFlag = 0;
7537         /* Should the set be negated at the end? */
7538         if (*sdescr == '^') {
7539             notFlag = 1;
7540             ++sdescr;
7541         }
7542         /* Here '-' is meant literally and not to define a range */
7543         if (*sdescr == '-') {
7544             JimSetBit(charset, '-');
7545             ++sdescr;
7546         }
7547         while (*sdescr) {
7548             if (sdescr[1] == '-' && sdescr[2] != 0) {
7549                 /* Handle range definitions */
7550                 int i;
7551                 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7552                     JimSetBit(charset, (char)i);
7553                 sdescr += 3;
7554             } else {
7555                 /* Handle verbatim character definitions */
7556                 JimSetBit(charset, *sdescr++);
7557             }
7558         }
7559         /* Negate the charset if there was a NOT given */
7560         for (i=0; notFlag && i < sizeof(charset); ++i)
7561             charset[i] = ~charset[i];
7562     } 
7563     /* And after all the mess above, the real work begin ... */
7564     while (str && *str) {
7565         if (!sdescr && isspace((int)*str))
7566             break; /* EOS via WS if unspecified */
7567         if (JimTestBit(charset, *str)) *buffer++ = *str++;
7568         else break;             /* EOS via mismatch if specified scanning */
7569     }
7570     *buffer = 0;                /* Close the string properly ... */
7571     result = Jim_NewStringObj(interp, anchor, -1);
7572     Jim_Free(anchor);           /* ... and free it afer usage */
7573     return result;
7574 }
7575
7576 /* ScanOneEntry will scan one entry out of the string passed as argument.
7577  * It use the sscanf() function for this task. After extracting and
7578  * converting of the value, the count of scanned characters will be
7579  * returned of -1 in case of no conversion tool place and string was
7580  * already scanned thru */
7581
7582 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7583         ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7584 {
7585 #   define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7586         ? sizeof(jim_wide)                             \
7587         : sizeof(double))
7588     char buffer[MAX_SIZE];
7589     char *value = buffer;
7590     const char *tok;
7591     const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7592     size_t sLen = strlen(&str[pos]), scanned = 0;
7593     size_t anchor = pos;
7594     int i;
7595
7596     /* First pessimiticly assume, we will not scan anything :-) */
7597     *valObjPtr = 0;
7598     if (descr->prefix) {
7599         /* There was a prefix given before the conversion, skip it and adjust
7600          * the string-to-be-parsed accordingly */
7601         for (i=0; str[pos] && descr->prefix[i]; ++i) {
7602             /* If prefix require, skip WS */
7603             if (isspace((int)descr->prefix[i]))
7604                 while (str[pos] && isspace((int)str[pos])) ++pos;
7605             else if (descr->prefix[i] != str[pos]) 
7606                 break;  /* Prefix do not match here, leave the loop */
7607             else
7608                 ++pos;  /* Prefix matched so far, next round */
7609         }
7610         if (str[pos] == 0)
7611             return -1;  /* All of str consumed: EOF condition */
7612         else if (descr->prefix[i] != 0)
7613             return 0;   /* Not whole prefix consumed, no conversion possible */
7614     }
7615     /* For all but following conversion, skip leading WS */
7616     if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7617         while (isspace((int)str[pos])) ++pos;
7618     /* Determine how much skipped/scanned so far */
7619     scanned = pos - anchor;
7620     if (descr->type == 'n') {
7621         /* Return pseudo conversion means: how much scanned so far? */
7622         *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7623     } else if (str[pos] == 0) {
7624         /* Cannot scan anything, as str is totally consumed */
7625         return -1;
7626     } else {
7627         /* Processing of conversions follows ... */
7628         if (descr->width > 0) {
7629             /* Do not try to scan as fas as possible but only the given width.
7630              * To ensure this, we copy the part that should be scanned. */
7631             size_t tLen = descr->width > sLen ? sLen : descr->width;
7632             tok = Jim_StrDupLen(&str[pos], tLen);
7633         } else {
7634             /* As no width was given, simply refer to the original string */
7635             tok = &str[pos];
7636         }
7637         switch (descr->type) {
7638             case 'c':
7639                 *valObjPtr = Jim_NewIntObj(interp, *tok);
7640                 scanned += 1;
7641                 break;
7642             case 'd': case 'o': case 'x': case 'u': case 'i': {
7643                 char *endp;  /* Position where the number finished */
7644                 int base = descr->type == 'o' ? 8
7645                     : descr->type == 'x' ? 16
7646                     : descr->type == 'i' ? 0
7647                     : 10;
7648                     
7649                 do {
7650                     /* Try to scan a number with the given base */
7651                     if (descr->modifier == 'l')
7652 #ifdef HAVE_LONG_LONG
7653                       *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7654 #else
7655                       *(jim_wide*)value = strtol(tok, &endp, base);
7656 #endif
7657                     else
7658                       if (descr->type == 'u')
7659                         *(long*)value = strtoul(tok, &endp, base);
7660                       else
7661                         *(long*)value = strtol(tok, &endp, base);
7662                     /* If scanning failed, and base was undetermined, simply
7663                      * put it to 10 and try once more. This should catch the
7664                      * case where %i begin to parse a number prefix (e.g. 
7665                      * '0x' but no further digits follows. This will be
7666                      * handled as a ZERO followed by a char 'x' by Tcl */
7667                     if (endp == tok && base == 0) base = 10;
7668                     else break;
7669                 } while (1);
7670                 if (endp != tok) {
7671                     /* There was some number sucessfully scanned! */
7672                     if (descr->modifier == 'l')
7673                         *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7674                     else
7675                         *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7676                     /* Adjust the number-of-chars scanned so far */
7677                     scanned += endp - tok;
7678                 } else {
7679                     /* Nothing was scanned. We have to determine if this
7680                      * happened due to e.g. prefix mismatch or input str
7681                      * exhausted */
7682                     scanned = *tok ? 0 : -1;
7683                 }
7684                 break;
7685             }
7686             case 's': case '[': {
7687                 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7688                 scanned += Jim_Length(*valObjPtr);
7689                 break;
7690             }
7691             case 'e': case 'f': case 'g': {
7692                 char *endp;
7693
7694                 *(double*)value = strtod(tok, &endp);
7695                 if (endp != tok) {
7696                     /* There was some number sucessfully scanned! */
7697                     *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7698                     /* Adjust the number-of-chars scanned so far */
7699                     scanned += endp - tok;
7700                 } else {
7701                     /* Nothing was scanned. We have to determine if this
7702                      * happened due to e.g. prefix mismatch or input str
7703                      * exhausted */
7704                     scanned = *tok ? 0 : -1;
7705                 }
7706                 break;
7707             }
7708         }
7709         /* If a substring was allocated (due to pre-defined width) do not
7710          * forget to free it */
7711         if (tok != &str[pos])
7712             Jim_Free((char*)tok);
7713     }
7714     return scanned;
7715 }
7716
7717 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7718  * string and returns all converted (and not ignored) values in a list back
7719  * to the caller. If an error occured, a NULL pointer will be returned */
7720
7721 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7722         Jim_Obj *fmtObjPtr, int flags)
7723 {
7724     size_t i, pos;
7725     int scanned = 1;
7726     const char *str = Jim_GetString(strObjPtr, 0);
7727     Jim_Obj *resultList = 0;
7728     Jim_Obj **resultVec;
7729     int resultc;
7730     Jim_Obj *emptyStr = 0;
7731     ScanFmtStringObj *fmtObj;
7732
7733     /* If format specification is not an object, convert it! */
7734     if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7735         SetScanFmtFromAny(interp, fmtObjPtr);
7736     fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7737     /* Check if format specification was valid */
7738     if (fmtObj->error != 0) {
7739         if (flags & JIM_ERRMSG)
7740             Jim_SetResultString(interp, fmtObj->error, -1);
7741         return 0;
7742     }
7743     /* Allocate a new "shared" empty string for all unassigned conversions */
7744     emptyStr = Jim_NewEmptyStringObj(interp);
7745     Jim_IncrRefCount(emptyStr);
7746     /* Create a list and fill it with empty strings up to max specified XPG3 */
7747     resultList = Jim_NewListObj(interp, 0, 0);
7748     if (fmtObj->maxPos > 0) {
7749         for (i=0; i < fmtObj->maxPos; ++i)
7750             Jim_ListAppendElement(interp, resultList, emptyStr);
7751         JimListGetElements(interp, resultList, &resultc, &resultVec);
7752     }
7753     /* Now handle every partial format description */
7754     for (i=0, pos=0; i < fmtObj->count; ++i) {
7755         ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7756         Jim_Obj *value = 0;
7757         /* Only last type may be "literal" w/o conversion - skip it! */
7758         if (descr->type == 0) continue;
7759         /* As long as any conversion could be done, we will proceed */
7760         if (scanned > 0)
7761             scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7762         /* In case our first try results in EOF, we will leave */
7763         if (scanned == -1 && i == 0)
7764             goto eof;
7765         /* Advance next pos-to-be-scanned for the amount scanned already */
7766         pos += scanned;
7767         /* value == 0 means no conversion took place so take empty string */
7768         if (value == 0)
7769             value = Jim_NewEmptyStringObj(interp);
7770         /* If value is a non-assignable one, skip it */
7771         if (descr->pos == -1) {
7772             Jim_FreeNewObj(interp, value);
7773         } else if (descr->pos == 0)
7774             /* Otherwise append it to the result list if no XPG3 was given */
7775             Jim_ListAppendElement(interp, resultList, value);
7776         else if (resultVec[descr->pos-1] == emptyStr) {
7777             /* But due to given XPG3, put the value into the corr. slot */
7778             Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7779             Jim_IncrRefCount(value);
7780             resultVec[descr->pos-1] = value;
7781         } else {
7782             /* Otherwise, the slot was already used - free obj and ERROR */
7783             Jim_FreeNewObj(interp, value);
7784             goto err;
7785         }
7786     }
7787     Jim_DecrRefCount(interp, emptyStr);
7788     return resultList;
7789 eof:
7790     Jim_DecrRefCount(interp, emptyStr);
7791     Jim_FreeNewObj(interp, resultList);
7792     return (Jim_Obj*)EOF;
7793 err:
7794     Jim_DecrRefCount(interp, emptyStr);
7795     Jim_FreeNewObj(interp, resultList);
7796     return 0;
7797 }
7798
7799 /* -----------------------------------------------------------------------------
7800  * Pseudo Random Number Generation
7801  * ---------------------------------------------------------------------------*/
7802 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7803         int seedLen);
7804
7805 /* Initialize the sbox with the numbers from 0 to 255 */
7806 static void JimPrngInit(Jim_Interp *interp)
7807 {
7808     int i;
7809     unsigned int seed[256];
7810
7811     interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7812     for (i = 0; i < 256; i++)
7813         seed[i] = (rand() ^ time(NULL) ^ clock());
7814     JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7815 }
7816
7817 /* Generates N bytes of random data */
7818 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7819 {
7820     Jim_PrngState *prng;
7821     unsigned char *destByte = (unsigned char*) dest;
7822     unsigned int si, sj, x;
7823
7824     /* initialization, only needed the first time */
7825     if (interp->prngState == NULL)
7826         JimPrngInit(interp);
7827     prng = interp->prngState;
7828     /* generates 'len' bytes of pseudo-random numbers */
7829     for (x = 0; x < len; x++) {
7830         prng->i = (prng->i+1) & 0xff;
7831         si = prng->sbox[prng->i];
7832         prng->j = (prng->j + si) & 0xff;
7833         sj = prng->sbox[prng->j];
7834         prng->sbox[prng->i] = sj;
7835         prng->sbox[prng->j] = si;
7836         *destByte++ = prng->sbox[(si+sj)&0xff];
7837     }
7838 }
7839
7840 /* Re-seed the generator with user-provided bytes */
7841 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7842         int seedLen)
7843 {
7844     int i;
7845     unsigned char buf[256];
7846     Jim_PrngState *prng;
7847
7848     /* initialization, only needed the first time */
7849     if (interp->prngState == NULL)
7850         JimPrngInit(interp);
7851     prng = interp->prngState;
7852
7853     /* Set the sbox[i] with i */
7854     for (i = 0; i < 256; i++)
7855         prng->sbox[i] = i;
7856     /* Now use the seed to perform a random permutation of the sbox */
7857     for (i = 0; i < seedLen; i++) {
7858         unsigned char t;
7859
7860         t = prng->sbox[i&0xFF];
7861         prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7862         prng->sbox[seed[i]] = t;
7863     }
7864     prng->i = prng->j = 0;
7865     /* discard the first 256 bytes of stream. */
7866     JimRandomBytes(interp, buf, 256);
7867 }
7868
7869 /* -----------------------------------------------------------------------------
7870  * Dynamic libraries support (WIN32 not supported)
7871  * ---------------------------------------------------------------------------*/
7872
7873 #ifdef JIM_DYNLIB
7874 #ifdef WIN32
7875 #define RTLD_LAZY 0
7876 void * dlopen(const char *path, int mode) 
7877 {
7878     JIM_NOTUSED(mode);
7879
7880     return (void *)LoadLibraryA(path);
7881 }
7882 int dlclose(void *handle)
7883 {
7884     FreeLibrary((HANDLE)handle);
7885     return 0;
7886 }
7887 void *dlsym(void *handle, const char *symbol)
7888 {
7889     return GetProcAddress((HMODULE)handle, symbol);
7890 }
7891 static char win32_dlerror_string[121];
7892 const char *dlerror(void)
7893 {
7894     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7895                    LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7896     return win32_dlerror_string;
7897 }
7898 #endif /* WIN32 */
7899
7900 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7901 {
7902     Jim_Obj *libPathObjPtr;
7903     int prefixc, i;
7904     void *handle;
7905     int (*onload)(Jim_Interp *interp);
7906
7907     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7908     if (libPathObjPtr == NULL) {
7909         prefixc = 0;
7910         libPathObjPtr = NULL;
7911     } else {
7912         Jim_IncrRefCount(libPathObjPtr);
7913         Jim_ListLength(interp, libPathObjPtr, &prefixc);
7914     }
7915
7916     for (i = -1; i < prefixc; i++) {
7917         if (i < 0) {
7918             handle = dlopen(pathName, RTLD_LAZY);
7919         } else {
7920             FILE *fp;
7921             char buf[JIM_PATH_LEN];
7922             const char *prefix;
7923             int prefixlen;
7924             Jim_Obj *prefixObjPtr;
7925             
7926             buf[0] = '\0';
7927             if (Jim_ListIndex(interp, libPathObjPtr, i,
7928                     &prefixObjPtr, JIM_NONE) != JIM_OK)
7929                 continue;
7930             prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7931             if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7932                 continue;
7933             if (*pathName == '/') {
7934                 strcpy(buf, pathName);
7935             }    
7936             else if (prefixlen && prefix[prefixlen-1] == '/')
7937                 sprintf(buf, "%s%s", prefix, pathName);
7938             else
7939                 sprintf(buf, "%s/%s", prefix, pathName);
7940             fp = fopen(buf, "r");
7941             if (fp == NULL)
7942                 continue;
7943             fclose(fp);
7944             handle = dlopen(buf, RTLD_LAZY);
7945         }
7946         if (handle == NULL) {
7947             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7948             Jim_AppendStrings(interp, Jim_GetResult(interp),
7949                 "error loading extension \"", pathName,
7950                 "\": ", dlerror(), NULL);
7951             if (i < 0)
7952                 continue;
7953             goto err;
7954         }
7955         if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7956             Jim_SetResultString(interp,
7957                     "No Jim_OnLoad symbol found on extension", -1);
7958             goto err;
7959         }
7960         if (onload(interp) == JIM_ERR) {
7961             dlclose(handle);
7962             goto err;
7963         }
7964         Jim_SetEmptyResult(interp);
7965         if (libPathObjPtr != NULL)
7966             Jim_DecrRefCount(interp, libPathObjPtr);
7967         return JIM_OK;
7968     }
7969 err:
7970     if (libPathObjPtr != NULL)
7971         Jim_DecrRefCount(interp, libPathObjPtr);
7972     return JIM_ERR;
7973 }
7974 #else /* JIM_DYNLIB */
7975 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7976 {
7977     JIM_NOTUSED(interp);
7978     JIM_NOTUSED(pathName);
7979
7980     Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7981     return JIM_ERR;
7982 }
7983 #endif/* JIM_DYNLIB */
7984
7985 /* -----------------------------------------------------------------------------
7986  * Packages handling
7987  * ---------------------------------------------------------------------------*/
7988
7989 #define JIM_PKG_ANY_VERSION -1
7990
7991 /* Convert a string of the type "1.2" into an integer.
7992  * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted 
7993  * to the integer with value 102 */
7994 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7995         int *intPtr, int flags)
7996 {
7997     char *copy;
7998     jim_wide major, minor;
7999     char *majorStr, *minorStr, *p;
8000
8001     if (v[0] == '\0') {
8002         *intPtr = JIM_PKG_ANY_VERSION;
8003         return JIM_OK;
8004     }
8005
8006     copy = Jim_StrDup(v);
8007     p = strchr(copy, '.');
8008     if (p == NULL) goto badfmt;
8009     *p = '\0';
8010     majorStr = copy;
8011     minorStr = p+1;
8012
8013     if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8014         Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8015         goto badfmt;
8016     *intPtr = (int)(major*100+minor);
8017     Jim_Free(copy);
8018     return JIM_OK;
8019
8020 badfmt:
8021     Jim_Free(copy);
8022     if (flags & JIM_ERRMSG) {
8023         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8024         Jim_AppendStrings(interp, Jim_GetResult(interp),
8025                 "invalid package version '", v, "'", NULL);
8026     }
8027     return JIM_ERR;
8028 }
8029
8030 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8031 static int JimPackageMatchVersion(int needed, int actual, int flags)
8032 {
8033     if (needed == JIM_PKG_ANY_VERSION) return 1;
8034     if (flags & JIM_MATCHVER_EXACT) {
8035         return needed == actual;
8036     } else {
8037         return needed/100 == actual/100 && (needed <= actual);
8038     }
8039 }
8040
8041 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8042         int flags)
8043 {
8044     int intVersion;
8045     /* Check if the version format is ok */
8046     if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8047         return JIM_ERR;
8048     /* If the package was already provided returns an error. */
8049     if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8050         if (flags & JIM_ERRMSG) {
8051             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8052             Jim_AppendStrings(interp, Jim_GetResult(interp),
8053                     "package '", name, "' was already provided", NULL);
8054         }
8055         return JIM_ERR;
8056     }
8057     Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8058     return JIM_OK;
8059 }
8060
8061 #ifndef JIM_ANSIC
8062
8063 #ifndef WIN32
8064 # include <sys/types.h>
8065 # include <dirent.h>
8066 #else
8067 # include <io.h>
8068 /* Posix dirent.h compatiblity layer for WIN32.
8069  * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8070  * Copyright Salvatore Sanfilippo ,2005.
8071  *
8072  * Permission to use, copy, modify, and distribute this software and its
8073  * documentation for any purpose is hereby granted without fee, provided
8074  * that this copyright and permissions notice appear in all copies and
8075  * derivatives.
8076  *
8077  * This software is supplied "as is" without express or implied warranty.
8078  * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8079  */
8080
8081 struct dirent {
8082     char *d_name;
8083 };
8084
8085 typedef struct DIR {
8086     long                handle; /* -1 for failed rewind */
8087     struct _finddata_t  info;
8088     struct dirent       result; /* d_name null iff first time */
8089     char                *name;  /* null-terminated char string */
8090 } DIR;
8091
8092 DIR *opendir(const char *name)
8093 {
8094     DIR *dir = 0;
8095
8096     if(name && name[0]) {
8097         size_t base_length = strlen(name);
8098         const char *all = /* search pattern must end with suitable wildcard */
8099             strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8100
8101         if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8102            (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8103         {
8104             strcat(strcpy(dir->name, name), all);
8105
8106             if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8107                 dir->result.d_name = 0;
8108             else { /* rollback */
8109                 Jim_Free(dir->name);
8110                 Jim_Free(dir);
8111                 dir = 0;
8112             }
8113         } else { /* rollback */
8114             Jim_Free(dir);
8115             dir   = 0;
8116             errno = ENOMEM;
8117         }
8118     } else {
8119         errno = EINVAL;
8120     }
8121     return dir;
8122 }
8123
8124 int closedir(DIR *dir)
8125 {
8126     int result = -1;
8127
8128     if(dir) {
8129         if(dir->handle != -1)
8130             result = _findclose(dir->handle);
8131         Jim_Free(dir->name);
8132         Jim_Free(dir);
8133     }
8134     if(result == -1) /* map all errors to EBADF */
8135         errno = EBADF;
8136     return result;
8137 }
8138
8139 struct dirent *readdir(DIR *dir)
8140 {
8141     struct dirent *result = 0;
8142
8143     if(dir && dir->handle != -1) {
8144         if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8145             result         = &dir->result;
8146             result->d_name = dir->info.name;
8147         }
8148     } else {
8149         errno = EBADF;
8150     }
8151     return result;
8152 }
8153
8154 #endif /* WIN32 */
8155
8156 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8157         int prefixc, const char *pkgName, int pkgVer, int flags)
8158 {
8159     int bestVer = -1, i;
8160     int pkgNameLen = strlen(pkgName);
8161     char *bestPackage = NULL;
8162     struct dirent *de;
8163
8164     for (i = 0; i < prefixc; i++) {
8165         DIR *dir;
8166         char buf[JIM_PATH_LEN];
8167         int prefixLen;
8168
8169         if (prefixes[i] == NULL) continue;
8170         strncpy(buf, prefixes[i], JIM_PATH_LEN);
8171         buf[JIM_PATH_LEN-1] = '\0';
8172         prefixLen = strlen(buf);
8173         if (prefixLen && buf[prefixLen-1] == '/')
8174             buf[prefixLen-1] = '\0';
8175
8176         if ((dir = opendir(buf)) == NULL) continue;
8177         while ((de = readdir(dir)) != NULL) {
8178             char *fileName = de->d_name;
8179             int fileNameLen = strlen(fileName);
8180
8181             if (strncmp(fileName, "jim-", 4) == 0 &&
8182                 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8183                 *(fileName+4+pkgNameLen) == '-' &&
8184                 fileNameLen > 4 && /* note that this is not really useful */
8185                 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8186                  strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8187                  strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8188             {
8189                 char ver[6]; /* xx.yy<nulterm> */
8190                 char *p = strrchr(fileName, '.');
8191                 int verLen, fileVer;
8192
8193                 verLen = p - (fileName+4+pkgNameLen+1);
8194                 if (verLen < 3 || verLen > 5) continue;
8195                 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8196                 ver[verLen] = '\0';
8197                 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8198                         != JIM_OK) continue;
8199                 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8200                     (bestVer == -1 || bestVer < fileVer))
8201                 {
8202                     bestVer = fileVer;
8203                     Jim_Free(bestPackage);
8204                     bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8205                     sprintf(bestPackage, "%s/%s", buf, fileName);
8206                 }
8207             }
8208         }
8209         closedir(dir);
8210     }
8211     return bestPackage;
8212 }
8213
8214 #else /* JIM_ANSIC */
8215
8216 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8217         int prefixc, const char *pkgName, int pkgVer, int flags)
8218 {
8219     JIM_NOTUSED(interp);
8220     JIM_NOTUSED(prefixes);
8221     JIM_NOTUSED(prefixc);
8222     JIM_NOTUSED(pkgName);
8223     JIM_NOTUSED(pkgVer);
8224     JIM_NOTUSED(flags);
8225     return NULL;
8226 }
8227
8228 #endif /* JIM_ANSIC */
8229
8230 /* Search for a suitable package under every dir specified by jim_libpath
8231  * and load it if possible. If a suitable package was loaded with success
8232  * JIM_OK is returned, otherwise JIM_ERR is returned. */
8233 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8234         int flags)
8235 {
8236     Jim_Obj *libPathObjPtr;
8237     char **prefixes, *best;
8238     int prefixc, i, retCode = JIM_OK;
8239
8240     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8241     if (libPathObjPtr == NULL) {
8242         prefixc = 0;
8243         libPathObjPtr = NULL;
8244     } else {
8245         Jim_IncrRefCount(libPathObjPtr);
8246         Jim_ListLength(interp, libPathObjPtr, &prefixc);
8247     }
8248
8249     prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8250     for (i = 0; i < prefixc; i++) {
8251             Jim_Obj *prefixObjPtr;
8252             if (Jim_ListIndex(interp, libPathObjPtr, i,
8253                     &prefixObjPtr, JIM_NONE) != JIM_OK)
8254             {
8255                 prefixes[i] = NULL;
8256                 continue;
8257             }
8258             prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8259     }
8260     /* Scan every directory to find the "best" package. */
8261     best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8262     if (best != NULL) {
8263         char *p = strrchr(best, '.');
8264         /* Try to load/source it */
8265         if (p && strcmp(p, ".tcl") == 0) {
8266             retCode = Jim_EvalFile(interp, best);
8267         } else {
8268             retCode = Jim_LoadLibrary(interp, best);
8269         }
8270     } else {
8271         retCode = JIM_ERR;
8272     }
8273     Jim_Free(best);
8274     for (i = 0; i < prefixc; i++)
8275         Jim_Free(prefixes[i]);
8276     Jim_Free(prefixes);
8277     if (libPathObjPtr)
8278         Jim_DecrRefCount(interp, libPathObjPtr);
8279     return retCode;
8280 }
8281
8282 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8283         const char *ver, int flags)
8284 {
8285     Jim_HashEntry *he;
8286     int requiredVer;
8287
8288     /* Start with an empty error string */
8289     Jim_SetResultString(interp, "", 0);
8290
8291     if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8292         return NULL;
8293     he = Jim_FindHashEntry(&interp->packages, name);
8294     if (he == NULL) {
8295         /* Try to load the package. */
8296         if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8297             he = Jim_FindHashEntry(&interp->packages, name);
8298             if (he == NULL) {
8299                 return "?";
8300             }
8301             return he->val;
8302         }
8303         /* No way... return an error. */
8304         if (flags & JIM_ERRMSG) {
8305             int len;
8306             Jim_GetString(Jim_GetResult(interp), &len);
8307             Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8308                     "Can't find package '", name, "'", NULL);
8309         }
8310         return NULL;
8311     } else {
8312         int actualVer;
8313         if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8314                 != JIM_OK)
8315         {
8316             return NULL;
8317         }
8318         /* Check if version matches. */
8319         if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8320             Jim_AppendStrings(interp, Jim_GetResult(interp),
8321                     "Package '", name, "' already loaded, but with version ",
8322                     he->val, NULL);
8323             return NULL;
8324         }
8325         return he->val;
8326     }
8327 }
8328
8329 /* -----------------------------------------------------------------------------
8330  * Eval
8331  * ---------------------------------------------------------------------------*/
8332 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8333 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8334
8335 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8336         Jim_Obj *const *argv);
8337
8338 /* Handle calls to the [unknown] command */
8339 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8340 {
8341     Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8342     int retCode;
8343
8344     /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8345      * done here
8346      */
8347     if (interp->unknown_called) {
8348         return JIM_ERR;
8349     }
8350
8351     /* If the [unknown] command does not exists returns
8352      * just now */
8353     if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8354         return JIM_ERR;
8355
8356     /* The object interp->unknown just contains
8357      * the "unknown" string, it is used in order to
8358      * avoid to lookup the unknown command every time
8359      * but instread to cache the result. */
8360     if (argc+1 <= JIM_EVAL_SARGV_LEN)
8361         v = sv;
8362     else
8363         v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8364     /* Make a copy of the arguments vector, but shifted on
8365      * the right of one position. The command name of the
8366      * command will be instead the first argument of the
8367      * [unknonw] call. */
8368     memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8369     v[0] = interp->unknown;
8370     /* Call it */
8371     interp->unknown_called++;
8372     retCode = Jim_EvalObjVector(interp, argc+1, v);
8373     interp->unknown_called--;
8374
8375     /* Clean up */
8376     if (v != sv)
8377         Jim_Free(v);
8378     return retCode;
8379 }
8380
8381 /* Eval the object vector 'objv' composed of 'objc' elements.
8382  * Every element is used as single argument.
8383  * Jim_EvalObj() will call this function every time its object
8384  * argument is of "list" type, with no string representation.
8385  *
8386  * This is possible because the string representation of a
8387  * list object generated by the UpdateStringOfList is made
8388  * in a way that ensures that every list element is a different
8389  * command argument. */
8390 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8391 {
8392     int i, retcode;
8393     Jim_Cmd *cmdPtr;
8394
8395     /* Incr refcount of arguments. */
8396     for (i = 0; i < objc; i++)
8397         Jim_IncrRefCount(objv[i]);
8398     /* Command lookup */
8399     cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8400     if (cmdPtr == NULL) {
8401         retcode = JimUnknown(interp, objc, objv);
8402     } else {
8403         /* Call it -- Make sure result is an empty object. */
8404         Jim_SetEmptyResult(interp);
8405         if (cmdPtr->cmdProc) {
8406             interp->cmdPrivData = cmdPtr->privData;
8407             retcode = cmdPtr->cmdProc(interp, objc, objv);
8408             if (retcode == JIM_ERR_ADDSTACK) {
8409                 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8410                 retcode = JIM_ERR;
8411             }
8412         } else {
8413             retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8414             if (retcode == JIM_ERR) {
8415                 JimAppendStackTrace(interp,
8416                     Jim_GetString(objv[0], NULL), "", 1);
8417             }
8418         }
8419     }
8420     /* Decr refcount of arguments and return the retcode */
8421     for (i = 0; i < objc; i++)
8422         Jim_DecrRefCount(interp, objv[i]);
8423     return retcode;
8424 }
8425
8426 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8427  * via *objPtrPtr. This function is only called by Jim_EvalObj().
8428  * The returned object has refcount = 0. */
8429 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8430         int tokens, Jim_Obj **objPtrPtr)
8431 {
8432     int totlen = 0, i, retcode;
8433     Jim_Obj **intv;
8434     Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8435     Jim_Obj *objPtr;
8436     char *s;
8437
8438     if (tokens <= JIM_EVAL_SINTV_LEN)
8439         intv = sintv;
8440     else
8441         intv = Jim_Alloc(sizeof(Jim_Obj*)*
8442                 tokens);
8443     /* Compute every token forming the argument
8444      * in the intv objects vector. */
8445     for (i = 0; i < tokens; i++) {
8446         switch(token[i].type) {
8447         case JIM_TT_ESC:
8448         case JIM_TT_STR:
8449             intv[i] = token[i].objPtr;
8450             break;
8451         case JIM_TT_VAR:
8452             intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8453             if (!intv[i]) {
8454                 retcode = JIM_ERR;
8455                 goto err;
8456             }
8457             break;
8458         case JIM_TT_DICTSUGAR:
8459             intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8460             if (!intv[i]) {
8461                 retcode = JIM_ERR;
8462                 goto err;
8463             }
8464             break;
8465         case JIM_TT_CMD:
8466             retcode = Jim_EvalObj(interp, token[i].objPtr);
8467             if (retcode != JIM_OK)
8468                 goto err;
8469             intv[i] = Jim_GetResult(interp);
8470             break;
8471         default:
8472             Jim_Panic(interp,
8473               "default token type reached "
8474               "in Jim_InterpolateTokens().");
8475             break;
8476         }
8477         Jim_IncrRefCount(intv[i]);
8478         /* Make sure there is a valid
8479          * string rep, and add the string
8480          * length to the total legnth. */
8481         Jim_GetString(intv[i], NULL);
8482         totlen += intv[i]->length;
8483     }
8484     /* Concatenate every token in an unique
8485      * object. */
8486     objPtr = Jim_NewStringObjNoAlloc(interp,
8487             NULL, 0);
8488     s = objPtr->bytes = Jim_Alloc(totlen+1);
8489     objPtr->length = totlen;
8490     for (i = 0; i < tokens; i++) {
8491         memcpy(s, intv[i]->bytes, intv[i]->length);
8492         s += intv[i]->length;
8493         Jim_DecrRefCount(interp, intv[i]);
8494     }
8495     objPtr->bytes[totlen] = '\0';
8496     /* Free the intv vector if not static. */
8497     if (tokens > JIM_EVAL_SINTV_LEN)
8498         Jim_Free(intv);
8499     *objPtrPtr = objPtr;
8500     return JIM_OK;
8501 err:
8502     i--;
8503     for (; i >= 0; i--)
8504         Jim_DecrRefCount(interp, intv[i]);
8505     if (tokens > JIM_EVAL_SINTV_LEN)
8506         Jim_Free(intv);
8507     return retcode;
8508 }
8509
8510 /* Helper of Jim_EvalObj() to perform argument expansion.
8511  * Basically this function append an argument to 'argv'
8512  * (and increments argc by reference accordingly), performing
8513  * expansion of the list object if 'expand' is non-zero, or
8514  * just adding objPtr to argv if 'expand' is zero. */
8515 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8516         int *argcPtr, int expand, Jim_Obj *objPtr)
8517 {
8518     if (!expand) {
8519         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8520         /* refcount of objPtr not incremented because
8521          * we are actually transfering a reference from
8522          * the old 'argv' to the expanded one. */
8523         (*argv)[*argcPtr] = objPtr;
8524         (*argcPtr)++;
8525     } else {
8526         int len, i;
8527
8528         Jim_ListLength(interp, objPtr, &len);
8529         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8530         for (i = 0; i < len; i++) {
8531             (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8532             Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8533             (*argcPtr)++;
8534         }
8535         /* The original object reference is no longer needed,
8536          * after the expansion it is no longer present on
8537          * the argument vector, but the single elements are
8538          * in its place. */
8539         Jim_DecrRefCount(interp, objPtr);
8540     }
8541 }
8542
8543 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8544 {
8545     int i, j = 0, len;
8546     ScriptObj *script;
8547     ScriptToken *token;
8548     int *cs; /* command structure array */
8549     int retcode = JIM_OK;
8550     Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8551
8552     interp->errorFlag = 0;
8553
8554     /* If the object is of type "list" and there is no
8555      * string representation for this object, we can call
8556      * a specialized version of Jim_EvalObj() */
8557     if (scriptObjPtr->typePtr == &listObjType &&
8558         scriptObjPtr->internalRep.listValue.len &&
8559         scriptObjPtr->bytes == NULL) {
8560         Jim_IncrRefCount(scriptObjPtr);
8561         retcode = Jim_EvalObjVector(interp,
8562                 scriptObjPtr->internalRep.listValue.len,
8563                 scriptObjPtr->internalRep.listValue.ele);
8564         Jim_DecrRefCount(interp, scriptObjPtr);
8565         return retcode;
8566     }
8567
8568     Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8569     script = Jim_GetScript(interp, scriptObjPtr);
8570     /* Now we have to make sure the internal repr will not be
8571      * freed on shimmering.
8572      *
8573      * Think for example to this:
8574      *
8575      * set x {llength $x; ... some more code ...}; eval $x
8576      *
8577      * In order to preserve the internal rep, we increment the
8578      * inUse field of the script internal rep structure. */
8579     script->inUse++;
8580
8581     token = script->token;
8582     len = script->len;
8583     cs = script->cmdStruct;
8584     i = 0; /* 'i' is the current token index. */
8585
8586     /* Reset the interpreter result. This is useful to
8587      * return the emtpy result in the case of empty program. */
8588     Jim_SetEmptyResult(interp);
8589
8590     /* Execute every command sequentially, returns on
8591      * error (i.e. if a command does not return JIM_OK) */
8592     while (i < len) {
8593         int expand = 0;
8594         int argc = *cs++; /* Get the number of arguments */
8595         Jim_Cmd *cmd;
8596
8597         /* Set the expand flag if needed. */
8598         if (argc == -1) {
8599             expand++;
8600             argc = *cs++;
8601         }
8602         /* Allocate the arguments vector */
8603         if (argc <= JIM_EVAL_SARGV_LEN)
8604             argv = sargv;
8605         else
8606             argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8607         /* Populate the arguments objects. */
8608         for (j = 0; j < argc; j++) {
8609             int tokens = *cs++;
8610
8611             /* tokens is negative if expansion is needed.
8612              * for this argument. */
8613             if (tokens < 0) {
8614                 tokens = (-tokens)-1;
8615                 i++;
8616             }
8617             if (tokens == 1) {
8618                 /* Fast path if the token does not
8619                  * need interpolation */
8620                 switch(token[i].type) {
8621                 case JIM_TT_ESC:
8622                 case JIM_TT_STR:
8623                     argv[j] = token[i].objPtr;
8624                     break;
8625                 case JIM_TT_VAR:
8626                     tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8627                             JIM_ERRMSG);
8628                     if (!tmpObjPtr) {
8629                         retcode = JIM_ERR;
8630                         goto err;
8631                     }
8632                     argv[j] = tmpObjPtr;
8633                     break;
8634                 case JIM_TT_DICTSUGAR:
8635                     tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8636                     if (!tmpObjPtr) {
8637                         retcode = JIM_ERR;
8638                         goto err;
8639                     }
8640                     argv[j] = tmpObjPtr;
8641                     break;
8642                 case JIM_TT_CMD:
8643                     retcode = Jim_EvalObj(interp, token[i].objPtr);
8644                     if (retcode != JIM_OK)
8645                         goto err;
8646                     argv[j] = Jim_GetResult(interp);
8647                     break;
8648                 default:
8649                     Jim_Panic(interp,
8650                       "default token type reached "
8651                       "in Jim_EvalObj().");
8652                     break;
8653                 }
8654                 Jim_IncrRefCount(argv[j]);
8655                 i += 2;
8656             } else {
8657                 /* For interpolation we call an helper
8658                  * function doing the work for us. */
8659                 if ((retcode = Jim_InterpolateTokens(interp,
8660                         token+i, tokens, &tmpObjPtr)) != JIM_OK)
8661                 {
8662                     goto err;
8663                 }
8664                 argv[j] = tmpObjPtr;
8665                 Jim_IncrRefCount(argv[j]);
8666                 i += tokens+1;
8667             }
8668         }
8669         /* Handle {expand} expansion */
8670         if (expand) {
8671             int *ecs = cs - argc;
8672             int eargc = 0;
8673             Jim_Obj **eargv = NULL;
8674
8675             for (j = 0; j < argc; j++) {
8676                 Jim_ExpandArgument( interp, &eargv, &eargc,
8677                         ecs[j] < 0, argv[j]);
8678             }
8679             if (argv != sargv)
8680                 Jim_Free(argv);
8681             argc = eargc;
8682             argv = eargv;
8683             j = argc;
8684             if (argc == 0) {
8685                 /* Nothing to do with zero args. */
8686                 Jim_Free(eargv);
8687                 continue;
8688             }
8689         }
8690         /* Lookup the command to call */
8691         cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8692         if (cmd != NULL) {
8693             /* Call it -- Make sure result is an empty object. */
8694             Jim_SetEmptyResult(interp);
8695             if (cmd->cmdProc) {
8696                 interp->cmdPrivData = cmd->privData;
8697                 retcode = cmd->cmdProc(interp, argc, argv);
8698                 if (retcode == JIM_ERR_ADDSTACK) {
8699                     JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8700                     retcode = JIM_ERR;
8701                 }
8702             } else {
8703                 retcode = JimCallProcedure(interp, cmd, argc, argv);
8704                 if (retcode == JIM_ERR) {
8705                     JimAppendStackTrace(interp,
8706                         Jim_GetString(argv[0], NULL), script->fileName,
8707                         token[i-argc*2].linenr);
8708                 }
8709             }
8710         } else {
8711             /* Call [unknown] */
8712             retcode = JimUnknown(interp, argc, argv);
8713             if (retcode == JIM_ERR) {
8714                 JimAppendStackTrace(interp,
8715                     "", script->fileName,
8716                     token[i-argc*2].linenr);
8717             }
8718         }
8719         if (retcode != JIM_OK) {
8720             i -= argc*2; /* point to the command name. */
8721             goto err;
8722         }
8723         /* Decrement the arguments count */
8724         for (j = 0; j < argc; j++) {
8725             Jim_DecrRefCount(interp, argv[j]);
8726         }
8727
8728         if (argv != sargv) {
8729             Jim_Free(argv);
8730             argv = NULL;
8731         }
8732     }
8733     /* Note that we don't have to decrement inUse, because the
8734      * following code transfers our use of the reference again to
8735      * the script object. */
8736     j = 0; /* on normal termination, the argv array is already
8737           Jim_DecrRefCount-ed. */
8738 err:
8739     /* Handle errors. */
8740     if (retcode == JIM_ERR && !interp->errorFlag) {
8741         interp->errorFlag = 1;
8742         JimSetErrorFileName(interp, script->fileName);
8743         JimSetErrorLineNumber(interp, token[i].linenr);
8744         JimResetStackTrace(interp);
8745     }
8746     Jim_FreeIntRep(interp, scriptObjPtr);
8747     scriptObjPtr->typePtr = &scriptObjType;
8748     Jim_SetIntRepPtr(scriptObjPtr, script);
8749     Jim_DecrRefCount(interp, scriptObjPtr);
8750     for (i = 0; i < j; i++) {
8751         Jim_DecrRefCount(interp, argv[i]);
8752     }
8753     if (argv != sargv)
8754         Jim_Free(argv);
8755     return retcode;
8756 }
8757
8758 /* Call a procedure implemented in Tcl.
8759  * It's possible to speed-up a lot this function, currently
8760  * the callframes are not cached, but allocated and
8761  * destroied every time. What is expecially costly is
8762  * to create/destroy the local vars hash table every time.
8763  *
8764  * This can be fixed just implementing callframes caching
8765  * in JimCreateCallFrame() and JimFreeCallFrame(). */
8766 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8767         Jim_Obj *const *argv)
8768 {
8769     int i, retcode;
8770     Jim_CallFrame *callFramePtr;
8771     int num_args;
8772
8773     /* Check arity */
8774     if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8775         argc > cmd->arityMax)) {
8776         Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8777         Jim_AppendStrings(interp, objPtr,
8778             "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8779             (cmd->arityMin > 1) ? " " : "",
8780             Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8781         Jim_SetResult(interp, objPtr);
8782         return JIM_ERR;
8783     }
8784     /* Check if there are too nested calls */
8785     if (interp->numLevels == interp->maxNestingDepth) {
8786         Jim_SetResultString(interp,
8787             "Too many nested calls. Infinite recursion?", -1);
8788         return JIM_ERR;
8789     }
8790     /* Create a new callframe */
8791     callFramePtr = JimCreateCallFrame(interp);
8792     callFramePtr->parentCallFrame = interp->framePtr;
8793     callFramePtr->argv = argv;
8794     callFramePtr->argc = argc;
8795     callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8796     callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8797     callFramePtr->staticVars = cmd->staticVars;
8798     Jim_IncrRefCount(cmd->argListObjPtr);
8799     Jim_IncrRefCount(cmd->bodyObjPtr);
8800     interp->framePtr = callFramePtr;
8801     interp->numLevels ++;
8802
8803     /* Set arguments */
8804     Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8805
8806     /* If last argument is 'args', don't set it here */
8807     if (cmd->arityMax == -1) {
8808         num_args--;
8809     }
8810
8811     for (i = 0; i < num_args; i++) {
8812         Jim_Obj *argObjPtr;
8813         Jim_Obj *nameObjPtr;
8814         Jim_Obj *valueObjPtr;
8815
8816         Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8817         if (i + 1 >= cmd->arityMin) {
8818             /* The name is the first element of the list */
8819             Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8820         }
8821         else {
8822             /* The element arg is the name */
8823             nameObjPtr = argObjPtr;
8824         }
8825
8826         if (i + 1 >= argc) {
8827             /* No more values, so use default */
8828             /* The value is the second element of the list */
8829             Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8830         }
8831         else {
8832             valueObjPtr = argv[i+1];
8833         }
8834         Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8835     }
8836     /* Set optional arguments */
8837     if (cmd->arityMax == -1) {
8838         Jim_Obj *listObjPtr, *objPtr;
8839
8840         i++;
8841         listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8842         Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8843         Jim_SetVariable(interp, objPtr, listObjPtr);
8844     }
8845     /* Eval the body */
8846     retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8847
8848     /* Destroy the callframe */
8849     interp->numLevels --;
8850     interp->framePtr = interp->framePtr->parentCallFrame;
8851     if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8852         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8853     } else {
8854         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8855     }
8856     /* Handle the JIM_EVAL return code */
8857     if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8858         int savedLevel = interp->evalRetcodeLevel;
8859
8860         interp->evalRetcodeLevel = interp->numLevels;
8861         while (retcode == JIM_EVAL) {
8862             Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8863             Jim_IncrRefCount(resultScriptObjPtr);
8864             retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8865             Jim_DecrRefCount(interp, resultScriptObjPtr);
8866         }
8867         interp->evalRetcodeLevel = savedLevel;
8868     }
8869     /* Handle the JIM_RETURN return code */
8870     if (retcode == JIM_RETURN) {
8871         retcode = interp->returnCode;
8872         interp->returnCode = JIM_OK;
8873     }
8874     return retcode;
8875 }
8876
8877 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8878 {
8879     int retval;
8880     Jim_Obj *scriptObjPtr;
8881
8882         scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8883     Jim_IncrRefCount(scriptObjPtr);
8884
8885
8886         if( filename ){
8887                 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8888         }
8889
8890     retval = Jim_EvalObj(interp, scriptObjPtr);
8891     Jim_DecrRefCount(interp, scriptObjPtr);
8892     return retval;
8893 }
8894
8895 int Jim_Eval(Jim_Interp *interp, const char *script)
8896 {
8897         return Jim_Eval_Named( interp, script, NULL, 0 );
8898 }
8899
8900
8901
8902 /* Execute script in the scope of the global level */
8903 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8904 {
8905     Jim_CallFrame *savedFramePtr;
8906     int retval;
8907
8908     savedFramePtr = interp->framePtr;
8909     interp->framePtr = interp->topFramePtr;
8910     retval = Jim_Eval(interp, script);
8911     interp->framePtr = savedFramePtr;
8912     return retval;
8913 }
8914
8915 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8916 {
8917     Jim_CallFrame *savedFramePtr;
8918     int retval;
8919
8920     savedFramePtr = interp->framePtr;
8921     interp->framePtr = interp->topFramePtr;
8922     retval = Jim_EvalObj(interp, scriptObjPtr);
8923     interp->framePtr = savedFramePtr;
8924     /* Try to report the error (if any) via the bgerror proc */
8925     if (retval != JIM_OK) {
8926         Jim_Obj *objv[2];
8927
8928         objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8929         objv[1] = Jim_GetResult(interp);
8930         Jim_IncrRefCount(objv[0]);
8931         Jim_IncrRefCount(objv[1]);
8932         if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8933             /* Report the error to stderr. */
8934             Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8935             Jim_PrintErrorMessage(interp);
8936         }
8937         Jim_DecrRefCount(interp, objv[0]);
8938         Jim_DecrRefCount(interp, objv[1]);
8939     }
8940     return retval;
8941 }
8942
8943 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8944 {
8945     char *prg = NULL;
8946     FILE *fp;
8947     int nread, totread, maxlen, buflen;
8948     int retval;
8949     Jim_Obj *scriptObjPtr;
8950     
8951     if ((fp = fopen(filename, "r")) == NULL) {
8952         const int cwd_len=2048;
8953                 char *cwd=malloc(cwd_len);
8954         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8955         getcwd( cwd, cwd_len );
8956         Jim_AppendStrings(interp, Jim_GetResult(interp),
8957         "Error loading script \"", filename, "\"",
8958             " cwd: ", cwd,
8959             " err: ", strerror(errno), NULL);
8960             free(cwd);
8961         return JIM_ERR;
8962     }
8963     buflen = 1024;
8964     maxlen = totread = 0;
8965     while (1) {
8966         if (maxlen < totread+buflen+1) {
8967             maxlen = totread+buflen+1;
8968             prg = Jim_Realloc(prg, maxlen);
8969         }
8970                 /* do not use Jim_fread() - this is really a file */
8971         if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8972         totread += nread;
8973     }
8974     prg[totread] = '\0';
8975         /* do not use Jim_fclose() - this is really a file */
8976     fclose(fp);
8977
8978     scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8979     JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8980     Jim_IncrRefCount(scriptObjPtr);
8981     retval = Jim_EvalObj(interp, scriptObjPtr);
8982     Jim_DecrRefCount(interp, scriptObjPtr);
8983     return retval;
8984 }
8985
8986 /* -----------------------------------------------------------------------------
8987  * Subst
8988  * ---------------------------------------------------------------------------*/
8989 static int JimParseSubstStr(struct JimParserCtx *pc)
8990 {
8991     pc->tstart = pc->p;
8992     pc->tline = pc->linenr;
8993     while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8994         pc->p++; pc->len--;
8995     }
8996     pc->tend = pc->p-1;
8997     pc->tt = JIM_TT_ESC;
8998     return JIM_OK;
8999 }
9000
9001 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9002 {
9003     int retval;
9004
9005     if (pc->len == 0) {
9006         pc->tstart = pc->tend = pc->p;
9007         pc->tline = pc->linenr;
9008         pc->tt = JIM_TT_EOL;
9009         pc->eof = 1;
9010         return JIM_OK;
9011     }
9012     switch(*pc->p) {
9013     case '[':
9014         retval = JimParseCmd(pc);
9015         if (flags & JIM_SUBST_NOCMD) {
9016             pc->tstart--;
9017             pc->tend++;
9018             pc->tt = (flags & JIM_SUBST_NOESC) ?
9019                 JIM_TT_STR : JIM_TT_ESC;
9020         }
9021         return retval;
9022         break;
9023     case '$':
9024         if (JimParseVar(pc) == JIM_ERR) {
9025             pc->tstart = pc->tend = pc->p++; pc->len--;
9026             pc->tline = pc->linenr;
9027             pc->tt = JIM_TT_STR;
9028         } else {
9029             if (flags & JIM_SUBST_NOVAR) {
9030                 pc->tstart--;
9031                 if (flags & JIM_SUBST_NOESC)
9032                     pc->tt = JIM_TT_STR;
9033                 else
9034                     pc->tt = JIM_TT_ESC;
9035                 if (*pc->tstart == '{') {
9036                     pc->tstart--;
9037                     if (*(pc->tend+1))
9038                         pc->tend++;
9039                 }
9040             }
9041         }
9042         break;
9043     default:
9044         retval = JimParseSubstStr(pc);
9045         if (flags & JIM_SUBST_NOESC)
9046             pc->tt = JIM_TT_STR;
9047         return retval;
9048         break;
9049     }
9050     return JIM_OK;
9051 }
9052
9053 /* The subst object type reuses most of the data structures and functions
9054  * of the script object. Script's data structures are a bit more complex
9055  * for what is needed for [subst]itution tasks, but the reuse helps to
9056  * deal with a single data structure at the cost of some more memory
9057  * usage for substitutions. */
9058 static Jim_ObjType substObjType = {
9059     "subst",
9060     FreeScriptInternalRep,
9061     DupScriptInternalRep,
9062     NULL,
9063     JIM_TYPE_REFERENCES,
9064 };
9065
9066 /* This method takes the string representation of an object
9067  * as a Tcl string where to perform [subst]itution, and generates
9068  * the pre-parsed internal representation. */
9069 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9070 {
9071     int scriptTextLen;
9072     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9073     struct JimParserCtx parser;
9074     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9075
9076     script->len = 0;
9077     script->csLen = 0;
9078     script->commands = 0;
9079     script->token = NULL;
9080     script->cmdStruct = NULL;
9081     script->inUse = 1;
9082     script->substFlags = flags;
9083     script->fileName = NULL;
9084
9085     JimParserInit(&parser, scriptText, scriptTextLen, 1);
9086     while(1) {
9087         char *token;
9088         int len, type, linenr;
9089
9090         JimParseSubst(&parser, flags);
9091         if (JimParserEof(&parser)) break;
9092         token = JimParserGetToken(&parser, &len, &type, &linenr);
9093         ScriptObjAddToken(interp, script, token, len, type,
9094                 NULL, linenr);
9095     }
9096     /* Free the old internal rep and set the new one. */
9097     Jim_FreeIntRep(interp, objPtr);
9098     Jim_SetIntRepPtr(objPtr, script);
9099     objPtr->typePtr = &scriptObjType;
9100     return JIM_OK;
9101 }
9102
9103 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9104 {
9105     struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9106
9107     if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9108         SetSubstFromAny(interp, objPtr, flags);
9109     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9110 }
9111
9112 /* Performs commands,variables,blackslashes substitution,
9113  * storing the result object (with refcount 0) into
9114  * resObjPtrPtr. */
9115 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9116         Jim_Obj **resObjPtrPtr, int flags)
9117 {
9118     ScriptObj *script;
9119     ScriptToken *token;
9120     int i, len, retcode = JIM_OK;
9121     Jim_Obj *resObjPtr, *savedResultObjPtr;
9122
9123     script = Jim_GetSubst(interp, substObjPtr, flags);
9124 #ifdef JIM_OPTIMIZATION
9125     /* Fast path for a very common case with array-alike syntax,
9126      * that's: $foo($bar) */
9127     if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9128         Jim_Obj *varObjPtr = script->token[0].objPtr;
9129         
9130         Jim_IncrRefCount(varObjPtr);
9131         resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9132         if (resObjPtr == NULL) {
9133             Jim_DecrRefCount(interp, varObjPtr);
9134             return JIM_ERR;
9135         }
9136         Jim_DecrRefCount(interp, varObjPtr);
9137         *resObjPtrPtr = resObjPtr;
9138         return JIM_OK;
9139     }
9140 #endif
9141
9142     Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9143     /* In order to preserve the internal rep, we increment the
9144      * inUse field of the script internal rep structure. */
9145     script->inUse++;
9146
9147     token = script->token;
9148     len = script->len;
9149
9150     /* Save the interp old result, to set it again before
9151      * to return. */
9152     savedResultObjPtr = interp->result;
9153     Jim_IncrRefCount(savedResultObjPtr);
9154     
9155     /* Perform the substitution. Starts with an empty object
9156      * and adds every token (performing the appropriate
9157      * var/command/escape substitution). */
9158     resObjPtr = Jim_NewStringObj(interp, "", 0);
9159     for (i = 0; i < len; i++) {
9160         Jim_Obj *objPtr;
9161
9162         switch(token[i].type) {
9163         case JIM_TT_STR:
9164         case JIM_TT_ESC:
9165             Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9166             break;
9167         case JIM_TT_VAR:
9168             objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9169             if (objPtr == NULL) goto err;
9170             Jim_IncrRefCount(objPtr);
9171             Jim_AppendObj(interp, resObjPtr, objPtr);
9172             Jim_DecrRefCount(interp, objPtr);
9173             break;
9174         case JIM_TT_DICTSUGAR:
9175             objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9176             if (!objPtr) {
9177                 retcode = JIM_ERR;
9178                 goto err;
9179             }
9180             break;
9181         case JIM_TT_CMD:
9182             if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9183                 goto err;
9184             Jim_AppendObj(interp, resObjPtr, interp->result);
9185             break;
9186         default:
9187             Jim_Panic(interp,
9188               "default token type (%d) reached "
9189               "in Jim_SubstObj().", token[i].type);
9190             break;
9191         }
9192     }
9193 ok:
9194     if (retcode == JIM_OK)
9195         Jim_SetResult(interp, savedResultObjPtr);
9196     Jim_DecrRefCount(interp, savedResultObjPtr);
9197     /* Note that we don't have to decrement inUse, because the
9198      * following code transfers our use of the reference again to
9199      * the script object. */
9200     Jim_FreeIntRep(interp, substObjPtr);
9201     substObjPtr->typePtr = &scriptObjType;
9202     Jim_SetIntRepPtr(substObjPtr, script);
9203     Jim_DecrRefCount(interp, substObjPtr);
9204     *resObjPtrPtr = resObjPtr;
9205     return retcode;
9206 err:
9207     Jim_FreeNewObj(interp, resObjPtr);
9208     retcode = JIM_ERR;
9209     goto ok;
9210 }
9211
9212 /* -----------------------------------------------------------------------------
9213  * API Input/Export functions
9214  * ---------------------------------------------------------------------------*/
9215
9216 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9217 {
9218     Jim_HashEntry *he;
9219
9220     he = Jim_FindHashEntry(&interp->stub, funcname);
9221     if (!he)
9222         return JIM_ERR;
9223     memcpy(targetPtrPtr, &he->val, sizeof(void*));
9224     return JIM_OK;
9225 }
9226
9227 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9228 {
9229     return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9230 }
9231
9232 #define JIM_REGISTER_API(name) \
9233     Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9234
9235 void JimRegisterCoreApi(Jim_Interp *interp)
9236 {
9237   interp->getApiFuncPtr = Jim_GetApi;
9238   JIM_REGISTER_API(Alloc);
9239   JIM_REGISTER_API(Free);
9240   JIM_REGISTER_API(Eval);
9241   JIM_REGISTER_API(Eval_Named);
9242   JIM_REGISTER_API(EvalGlobal);
9243   JIM_REGISTER_API(EvalFile);
9244   JIM_REGISTER_API(EvalObj);
9245   JIM_REGISTER_API(EvalObjBackground);
9246   JIM_REGISTER_API(EvalObjVector);
9247   JIM_REGISTER_API(InitHashTable);
9248   JIM_REGISTER_API(ExpandHashTable);
9249   JIM_REGISTER_API(AddHashEntry);
9250   JIM_REGISTER_API(ReplaceHashEntry);
9251   JIM_REGISTER_API(DeleteHashEntry);
9252   JIM_REGISTER_API(FreeHashTable);
9253   JIM_REGISTER_API(FindHashEntry);
9254   JIM_REGISTER_API(ResizeHashTable);
9255   JIM_REGISTER_API(GetHashTableIterator);
9256   JIM_REGISTER_API(NextHashEntry);
9257   JIM_REGISTER_API(NewObj);
9258   JIM_REGISTER_API(FreeObj);
9259   JIM_REGISTER_API(InvalidateStringRep);
9260   JIM_REGISTER_API(InitStringRep);
9261   JIM_REGISTER_API(DuplicateObj);
9262   JIM_REGISTER_API(GetString);
9263   JIM_REGISTER_API(Length);
9264   JIM_REGISTER_API(InvalidateStringRep);
9265   JIM_REGISTER_API(NewStringObj);
9266   JIM_REGISTER_API(NewStringObjNoAlloc);
9267   JIM_REGISTER_API(AppendString);
9268   JIM_REGISTER_API(AppendString_sprintf);
9269   JIM_REGISTER_API(AppendObj);
9270   JIM_REGISTER_API(AppendStrings);
9271   JIM_REGISTER_API(StringEqObj);
9272   JIM_REGISTER_API(StringMatchObj);
9273   JIM_REGISTER_API(StringRangeObj);
9274   JIM_REGISTER_API(FormatString);
9275   JIM_REGISTER_API(CompareStringImmediate);
9276   JIM_REGISTER_API(NewReference);
9277   JIM_REGISTER_API(GetReference);
9278   JIM_REGISTER_API(SetFinalizer);
9279   JIM_REGISTER_API(GetFinalizer);
9280   JIM_REGISTER_API(CreateInterp);
9281   JIM_REGISTER_API(FreeInterp);
9282   JIM_REGISTER_API(GetExitCode);
9283   JIM_REGISTER_API(SetStdin);
9284   JIM_REGISTER_API(SetStdout);
9285   JIM_REGISTER_API(SetStderr);
9286   JIM_REGISTER_API(CreateCommand);
9287   JIM_REGISTER_API(CreateProcedure);
9288   JIM_REGISTER_API(DeleteCommand);
9289   JIM_REGISTER_API(RenameCommand);
9290   JIM_REGISTER_API(GetCommand);
9291   JIM_REGISTER_API(SetVariable);
9292   JIM_REGISTER_API(SetVariableStr);
9293   JIM_REGISTER_API(SetGlobalVariableStr);
9294   JIM_REGISTER_API(SetVariableStrWithStr);
9295   JIM_REGISTER_API(SetVariableLink);
9296   JIM_REGISTER_API(GetVariable);
9297   JIM_REGISTER_API(GetCallFrameByLevel);
9298   JIM_REGISTER_API(Collect);
9299   JIM_REGISTER_API(CollectIfNeeded);
9300   JIM_REGISTER_API(GetIndex);
9301   JIM_REGISTER_API(NewListObj);
9302   JIM_REGISTER_API(ListAppendElement);
9303   JIM_REGISTER_API(ListAppendList);
9304   JIM_REGISTER_API(ListLength);
9305   JIM_REGISTER_API(ListIndex);
9306   JIM_REGISTER_API(SetListIndex);
9307   JIM_REGISTER_API(ConcatObj);
9308   JIM_REGISTER_API(NewDictObj);
9309   JIM_REGISTER_API(DictKey);
9310   JIM_REGISTER_API(DictKeysVector);
9311   JIM_REGISTER_API(GetIndex);
9312   JIM_REGISTER_API(GetReturnCode);
9313   JIM_REGISTER_API(EvalExpression);
9314   JIM_REGISTER_API(GetBoolFromExpr);
9315   JIM_REGISTER_API(GetWide);
9316   JIM_REGISTER_API(GetLong);
9317   JIM_REGISTER_API(SetWide);
9318   JIM_REGISTER_API(NewIntObj);
9319   JIM_REGISTER_API(GetDouble);
9320   JIM_REGISTER_API(SetDouble);
9321   JIM_REGISTER_API(NewDoubleObj);
9322   JIM_REGISTER_API(WrongNumArgs);
9323   JIM_REGISTER_API(SetDictKeysVector);
9324   JIM_REGISTER_API(SubstObj);
9325   JIM_REGISTER_API(RegisterApi);
9326   JIM_REGISTER_API(PrintErrorMessage);
9327   JIM_REGISTER_API(InteractivePrompt);
9328   JIM_REGISTER_API(RegisterCoreCommands);
9329   JIM_REGISTER_API(GetSharedString);
9330   JIM_REGISTER_API(ReleaseSharedString);
9331   JIM_REGISTER_API(Panic);
9332   JIM_REGISTER_API(StrDup);
9333   JIM_REGISTER_API(UnsetVariable);
9334   JIM_REGISTER_API(GetVariableStr);
9335   JIM_REGISTER_API(GetGlobalVariable);
9336   JIM_REGISTER_API(GetGlobalVariableStr);
9337   JIM_REGISTER_API(GetAssocData);
9338   JIM_REGISTER_API(SetAssocData);
9339   JIM_REGISTER_API(DeleteAssocData);
9340   JIM_REGISTER_API(GetEnum);
9341   JIM_REGISTER_API(ScriptIsComplete);
9342   JIM_REGISTER_API(PackageRequire);
9343   JIM_REGISTER_API(PackageProvide);
9344   JIM_REGISTER_API(InitStack);
9345   JIM_REGISTER_API(FreeStack);
9346   JIM_REGISTER_API(StackLen);
9347   JIM_REGISTER_API(StackPush);
9348   JIM_REGISTER_API(StackPop);
9349   JIM_REGISTER_API(StackPeek);
9350   JIM_REGISTER_API(FreeStackElements);
9351   JIM_REGISTER_API(fprintf  );
9352   JIM_REGISTER_API(vfprintf );
9353   JIM_REGISTER_API(fwrite   );
9354   JIM_REGISTER_API(fread    );
9355   JIM_REGISTER_API(fflush   );
9356   JIM_REGISTER_API(fgets    );
9357   JIM_REGISTER_API(GetNvp);
9358   JIM_REGISTER_API(Nvp_name2value);
9359   JIM_REGISTER_API(Nvp_name2value_simple);
9360   JIM_REGISTER_API(Nvp_name2value_obj);
9361   JIM_REGISTER_API(Nvp_name2value_nocase);
9362   JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9363
9364   JIM_REGISTER_API(Nvp_value2name);
9365   JIM_REGISTER_API(Nvp_value2name_simple);
9366   JIM_REGISTER_API(Nvp_value2name_obj);
9367
9368   JIM_REGISTER_API(GetOpt_Setup);
9369   JIM_REGISTER_API(GetOpt_Debug);
9370   JIM_REGISTER_API(GetOpt_Obj);
9371   JIM_REGISTER_API(GetOpt_String);
9372   JIM_REGISTER_API(GetOpt_Double);
9373   JIM_REGISTER_API(GetOpt_Wide);
9374   JIM_REGISTER_API(GetOpt_Nvp);
9375   JIM_REGISTER_API(GetOpt_NvpUnknown);
9376   JIM_REGISTER_API(GetOpt_Enum);
9377   
9378   JIM_REGISTER_API(Debug_ArgvString);
9379   JIM_REGISTER_API(SetResult_sprintf);
9380   JIM_REGISTER_API(SetResult_NvpUnknown);
9381
9382 }
9383
9384 /* -----------------------------------------------------------------------------
9385  * Core commands utility functions
9386  * ---------------------------------------------------------------------------*/
9387 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, 
9388         const char *msg)
9389 {
9390     int i;
9391     Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9392
9393     Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9394     for (i = 0; i < argc; i++) {
9395         Jim_AppendObj(interp, objPtr, argv[i]);
9396         if (!(i+1 == argc && msg[0] == '\0'))
9397             Jim_AppendString(interp, objPtr, " ", 1);
9398     }
9399     Jim_AppendString(interp, objPtr, msg, -1);
9400     Jim_AppendString(interp, objPtr, "\"", 1);
9401     Jim_SetResult(interp, objPtr);
9402 }
9403
9404 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9405 {
9406     Jim_HashTableIterator *htiter;
9407     Jim_HashEntry *he;
9408     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9409     const char *pattern;
9410     int patternLen;
9411     
9412     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9413     htiter = Jim_GetHashTableIterator(&interp->commands);
9414     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9415         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9416                     strlen((const char*)he->key), 0))
9417             continue;
9418         Jim_ListAppendElement(interp, listObjPtr,
9419                 Jim_NewStringObj(interp, he->key, -1));
9420     }
9421     Jim_FreeHashTableIterator(htiter);
9422     return listObjPtr;
9423 }
9424
9425 #define JIM_VARLIST_GLOBALS 0
9426 #define JIM_VARLIST_LOCALS 1
9427 #define JIM_VARLIST_VARS 2
9428
9429 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9430         int mode)
9431 {
9432     Jim_HashTableIterator *htiter;
9433     Jim_HashEntry *he;
9434     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9435     const char *pattern;
9436     int patternLen;
9437     
9438     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9439     if (mode == JIM_VARLIST_GLOBALS) {
9440         htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9441     } else {
9442         /* For [info locals], if we are at top level an emtpy list
9443          * is returned. I don't agree, but we aim at compatibility (SS) */
9444         if (mode == JIM_VARLIST_LOCALS &&
9445             interp->framePtr == interp->topFramePtr)
9446             return listObjPtr;
9447         htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9448     }
9449     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9450         Jim_Var *varPtr = (Jim_Var*) he->val;
9451         if (mode == JIM_VARLIST_LOCALS) {
9452             if (varPtr->linkFramePtr != NULL)
9453                 continue;
9454         }
9455         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9456                     strlen((const char*)he->key), 0))
9457             continue;
9458         Jim_ListAppendElement(interp, listObjPtr,
9459                 Jim_NewStringObj(interp, he->key, -1));
9460     }
9461     Jim_FreeHashTableIterator(htiter);
9462     return listObjPtr;
9463 }
9464
9465 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9466         Jim_Obj **objPtrPtr)
9467 {
9468     Jim_CallFrame *targetCallFrame;
9469
9470     if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9471             != JIM_OK)
9472         return JIM_ERR;
9473     /* No proc call at toplevel callframe */
9474     if (targetCallFrame == interp->topFramePtr) {
9475         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9476         Jim_AppendStrings(interp, Jim_GetResult(interp),
9477                 "bad level \"",
9478                 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9479         return JIM_ERR;
9480     }
9481     *objPtrPtr = Jim_NewListObj(interp,
9482             targetCallFrame->argv,
9483             targetCallFrame->argc);
9484     return JIM_OK;
9485 }
9486
9487 /* -----------------------------------------------------------------------------
9488  * Core commands
9489  * ---------------------------------------------------------------------------*/
9490
9491 /* fake [puts] -- not the real puts, just for debugging. */
9492 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9493         Jim_Obj *const *argv)
9494 {
9495     const char *str;
9496     int len, nonewline = 0;
9497     
9498     if (argc != 2 && argc != 3) {
9499         Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9500         return JIM_ERR;
9501     }
9502     if (argc == 3) {
9503         if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9504         {
9505             Jim_SetResultString(interp, "The second argument must "
9506                     "be -nonewline", -1);
9507             return JIM_OK;
9508         } else {
9509             nonewline = 1;
9510             argv++;
9511         }
9512     }
9513     str = Jim_GetString(argv[1], &len);
9514     Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9515     if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9516     return JIM_OK;
9517 }
9518
9519 /* Helper for [+] and [*] */
9520 static int Jim_AddMulHelper(Jim_Interp *interp, int argc, 
9521         Jim_Obj *const *argv, int op)
9522 {
9523     jim_wide wideValue, res;
9524     double doubleValue, doubleRes;
9525     int i;
9526
9527     res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9528     
9529     for (i = 1; i < argc; i++) {
9530         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9531             goto trydouble;
9532         if (op == JIM_EXPROP_ADD)
9533             res += wideValue;
9534         else
9535             res *= wideValue;
9536     }
9537     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9538     return JIM_OK;
9539 trydouble:
9540     doubleRes = (double) res;
9541     for (;i < argc; i++) {
9542         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9543             return JIM_ERR;
9544         if (op == JIM_EXPROP_ADD)
9545             doubleRes += doubleValue;
9546         else
9547             doubleRes *= doubleValue;
9548     }
9549     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9550     return JIM_OK;
9551 }
9552
9553 /* Helper for [-] and [/] */
9554 static int Jim_SubDivHelper(Jim_Interp *interp, int argc, 
9555         Jim_Obj *const *argv, int op)
9556 {
9557     jim_wide wideValue, res = 0;
9558     double doubleValue, doubleRes = 0;
9559     int i = 2;
9560
9561     if (argc < 2) {
9562         Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9563         return JIM_ERR;
9564     } else if (argc == 2) {
9565         /* The arity = 2 case is different. For [- x] returns -x,
9566          * while [/ x] returns 1/x. */
9567         if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9568             if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9569                     JIM_OK)
9570             {
9571                 return JIM_ERR;
9572             } else {
9573                 if (op == JIM_EXPROP_SUB)
9574                     doubleRes = -doubleValue;
9575                 else
9576                     doubleRes = 1.0/doubleValue;
9577                 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9578                             doubleRes));
9579                 return JIM_OK;
9580             }
9581         }
9582         if (op == JIM_EXPROP_SUB) {
9583             res = -wideValue;
9584             Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9585         } else {
9586             doubleRes = 1.0/wideValue;
9587             Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9588                         doubleRes));
9589         }
9590         return JIM_OK;
9591     } else {
9592         if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9593             if (Jim_GetDouble(interp, argv[1], &doubleRes)
9594                     != JIM_OK) {
9595                 return JIM_ERR;
9596             } else {
9597                 goto trydouble;
9598             }
9599         }
9600     }
9601     for (i = 2; i < argc; i++) {
9602         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9603             doubleRes = (double) res;
9604             goto trydouble;
9605         }
9606         if (op == JIM_EXPROP_SUB)
9607             res -= wideValue;
9608         else
9609             res /= wideValue;
9610     }
9611     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9612     return JIM_OK;
9613 trydouble:
9614     for (;i < argc; i++) {
9615         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9616             return JIM_ERR;
9617         if (op == JIM_EXPROP_SUB)
9618             doubleRes -= doubleValue;
9619         else
9620             doubleRes /= doubleValue;
9621     }
9622     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9623     return JIM_OK;
9624 }
9625
9626
9627 /* [+] */
9628 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9629         Jim_Obj *const *argv)
9630 {
9631     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9632 }
9633
9634 /* [*] */
9635 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9636         Jim_Obj *const *argv)
9637 {
9638     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9639 }
9640
9641 /* [-] */
9642 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9643         Jim_Obj *const *argv)
9644 {
9645     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9646 }
9647
9648 /* [/] */
9649 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9650         Jim_Obj *const *argv)
9651 {
9652     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9653 }
9654
9655 /* [set] */
9656 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9657         Jim_Obj *const *argv)
9658 {
9659     if (argc != 2 && argc != 3) {
9660         Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9661         return JIM_ERR;
9662     }
9663     if (argc == 2) {
9664         Jim_Obj *objPtr;
9665         objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9666         if (!objPtr)
9667             return JIM_ERR;
9668         Jim_SetResult(interp, objPtr);
9669         return JIM_OK;
9670     }
9671     /* argc == 3 case. */
9672     if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9673         return JIM_ERR;
9674     Jim_SetResult(interp, argv[2]);
9675     return JIM_OK;
9676 }
9677
9678 /* [unset] */
9679 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, 
9680         Jim_Obj *const *argv)
9681 {
9682     int i;
9683
9684     if (argc < 2) {
9685         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9686         return JIM_ERR;
9687     }
9688     for (i = 1; i < argc; i++) {
9689         if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9690             return JIM_ERR;
9691     }
9692     return JIM_OK;
9693 }
9694
9695 /* [incr] */
9696 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, 
9697         Jim_Obj *const *argv)
9698 {
9699     jim_wide wideValue, increment = 1;
9700     Jim_Obj *intObjPtr;
9701
9702     if (argc != 2 && argc != 3) {
9703         Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9704         return JIM_ERR;
9705     }
9706     if (argc == 3) {
9707         if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9708             return JIM_ERR;
9709     }
9710     intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9711     if (!intObjPtr) return JIM_ERR;
9712     if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9713         return JIM_ERR;
9714     if (Jim_IsShared(intObjPtr)) {
9715         intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9716         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9717             Jim_FreeNewObj(interp, intObjPtr);
9718             return JIM_ERR;
9719         }
9720     } else {
9721         Jim_SetWide(interp, intObjPtr, wideValue+increment);
9722         /* The following step is required in order to invalidate the
9723          * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9724         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9725             return JIM_ERR;
9726         }
9727     }
9728     Jim_SetResult(interp, intObjPtr);
9729     return JIM_OK;
9730 }
9731
9732 /* [while] */
9733 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, 
9734         Jim_Obj *const *argv)
9735 {
9736     if (argc != 3) {
9737         Jim_WrongNumArgs(interp, 1, argv, "condition body");
9738         return JIM_ERR;
9739     }
9740     /* Try to run a specialized version of while if the expression
9741      * is in one of the following forms:
9742      *
9743      *   $a < CONST, $a < $b
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
9750      *   !$a
9751      *   CONST
9752      */
9753
9754 #ifdef JIM_OPTIMIZATION
9755     {
9756         ExprByteCode *expr;
9757         Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9758         int exprLen, retval;
9759
9760         /* STEP 1 -- Check if there are the conditions to run the specialized
9761          * version of while */
9762         
9763         if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9764         if (expr->len <= 0 || expr->len > 3) goto noopt;
9765         switch(expr->len) {
9766         case 1:
9767             if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9768                 expr->opcode[0] != JIM_EXPROP_NUMBER)
9769                 goto noopt;
9770             break;
9771         case 2:
9772             if (expr->opcode[1] != JIM_EXPROP_NOT ||
9773                 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9774                 goto noopt;
9775             break;
9776         case 3:
9777             if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9778                 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9779                  expr->opcode[1] != JIM_EXPROP_VARIABLE))
9780                 goto noopt;
9781             switch(expr->opcode[2]) {
9782             case JIM_EXPROP_LT:
9783             case JIM_EXPROP_LTE:
9784             case JIM_EXPROP_GT:
9785             case JIM_EXPROP_GTE:
9786             case JIM_EXPROP_NUMEQ:
9787             case JIM_EXPROP_NUMNE:
9788                 /* nothing to do */
9789                 break;
9790             default:
9791                 goto noopt;
9792             }
9793             break;
9794         default:
9795             Jim_Panic(interp,
9796                 "Unexpected default reached in Jim_WhileCoreCommand()");
9797             break;
9798         }
9799
9800         /* STEP 2 -- conditions meet. Initialization. Take different
9801          * branches for different expression lengths. */
9802         exprLen = expr->len;
9803
9804         if (exprLen == 1) {
9805             jim_wide wideValue;
9806
9807             if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9808                 varAObjPtr = expr->obj[0];
9809                 Jim_IncrRefCount(varAObjPtr);
9810             } else {
9811                 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9812                     goto noopt;
9813             }
9814             while (1) {
9815                 if (varAObjPtr) {
9816                     if (!(objPtr =
9817                                Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9818                         Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9819                     {
9820                         Jim_DecrRefCount(interp, varAObjPtr);
9821                         goto noopt;
9822                     }
9823                 }
9824                 if (!wideValue) break;
9825                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9826                     switch(retval) {
9827                     case JIM_BREAK:
9828                         if (varAObjPtr)
9829                             Jim_DecrRefCount(interp, varAObjPtr);
9830                         goto out;
9831                         break;
9832                     case JIM_CONTINUE:
9833                         continue;
9834                         break;
9835                     default:
9836                         if (varAObjPtr)
9837                             Jim_DecrRefCount(interp, varAObjPtr);
9838                         return retval;
9839                     }
9840                 }
9841             }
9842             if (varAObjPtr)
9843                 Jim_DecrRefCount(interp, varAObjPtr);
9844         } else if (exprLen == 3) {
9845             jim_wide wideValueA, wideValueB, cmpRes = 0;
9846             int cmpType = expr->opcode[2];
9847
9848             varAObjPtr = expr->obj[0];
9849             Jim_IncrRefCount(varAObjPtr);
9850             if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9851                 varBObjPtr = expr->obj[1];
9852                 Jim_IncrRefCount(varBObjPtr);
9853             } else {
9854                 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9855                     goto noopt;
9856             }
9857             while (1) {
9858                 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9859                     Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9860                 {
9861                     Jim_DecrRefCount(interp, varAObjPtr);
9862                     if (varBObjPtr)
9863                         Jim_DecrRefCount(interp, varBObjPtr);
9864                     goto noopt;
9865                 }
9866                 if (varBObjPtr) {
9867                     if (!(objPtr =
9868                                Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9869                         Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9870                     {
9871                         Jim_DecrRefCount(interp, varAObjPtr);
9872                         if (varBObjPtr)
9873                             Jim_DecrRefCount(interp, varBObjPtr);
9874                         goto noopt;
9875                     }
9876                 }
9877                 switch(cmpType) {
9878                 case JIM_EXPROP_LT:
9879                     cmpRes = wideValueA < wideValueB; break;
9880                 case JIM_EXPROP_LTE:
9881                     cmpRes = wideValueA <= wideValueB; break;
9882                 case JIM_EXPROP_GT:
9883                     cmpRes = wideValueA > wideValueB; break;
9884                 case JIM_EXPROP_GTE:
9885                     cmpRes = wideValueA >= wideValueB; break;
9886                 case JIM_EXPROP_NUMEQ:
9887                     cmpRes = wideValueA == wideValueB; break;
9888                 case JIM_EXPROP_NUMNE:
9889                     cmpRes = wideValueA != wideValueB; break;
9890                 }
9891                 if (!cmpRes) break;
9892                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9893                     switch(retval) {
9894                     case JIM_BREAK:
9895                         Jim_DecrRefCount(interp, varAObjPtr);
9896                         if (varBObjPtr)
9897                             Jim_DecrRefCount(interp, varBObjPtr);
9898                         goto out;
9899                         break;
9900                     case JIM_CONTINUE:
9901                         continue;
9902                         break;
9903                     default:
9904                         Jim_DecrRefCount(interp, varAObjPtr);
9905                         if (varBObjPtr)
9906                             Jim_DecrRefCount(interp, varBObjPtr);
9907                         return retval;
9908                     }
9909                 }
9910             }
9911             Jim_DecrRefCount(interp, varAObjPtr);
9912             if (varBObjPtr)
9913                 Jim_DecrRefCount(interp, varBObjPtr);
9914         } else {
9915             /* TODO: case for len == 2 */
9916             goto noopt;
9917         }
9918         Jim_SetEmptyResult(interp);
9919         return JIM_OK;
9920     }
9921 noopt:
9922 #endif
9923
9924     /* The general purpose implementation of while starts here */
9925     while (1) {
9926         int boolean, retval;
9927
9928         if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9929                         &boolean)) != JIM_OK)
9930             return retval;
9931         if (!boolean) break;
9932         if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9933             switch(retval) {
9934             case JIM_BREAK:
9935                 goto out;
9936                 break;
9937             case JIM_CONTINUE:
9938                 continue;
9939                 break;
9940             default:
9941                 return retval;
9942             }
9943         }
9944     }
9945 out:
9946     Jim_SetEmptyResult(interp);
9947     return JIM_OK;
9948 }
9949
9950 /* [for] */
9951 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, 
9952         Jim_Obj *const *argv)
9953 {
9954     int retval;
9955
9956     if (argc != 5) {
9957         Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9958         return JIM_ERR;
9959     }
9960     /* Check if the for is on the form:
9961      *      for {set i CONST} {$i < CONST} {incr i}
9962      *      for {set i CONST} {$i < $j} {incr i}
9963      *      for {set i CONST} {$i <= CONST} {incr i}
9964      *      for {set i CONST} {$i <= $j} {incr i}
9965      * XXX: NOTE: if variable traces are implemented, this optimization
9966      * need to be modified to check for the proc epoch at every variable
9967      * update. */
9968 #ifdef JIM_OPTIMIZATION
9969     {
9970         ScriptObj *initScript, *incrScript;
9971         ExprByteCode *expr;
9972         jim_wide start, stop, currentVal;
9973         unsigned jim_wide procEpoch = interp->procEpoch;
9974         Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9975         int cmpType;
9976         struct Jim_Cmd *cmdPtr;
9977
9978         /* Do it only if there aren't shared arguments */
9979         if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9980             goto evalstart;
9981         initScript = Jim_GetScript(interp, argv[1]);
9982         expr = Jim_GetExpression(interp, argv[2]);
9983         incrScript = Jim_GetScript(interp, argv[3]);
9984
9985         /* Ensure proper lengths to start */
9986         if (initScript->len != 6) goto evalstart;
9987         if (incrScript->len != 4) goto evalstart;
9988         if (expr->len != 3) goto evalstart;
9989         /* Ensure proper token types. */
9990         if (initScript->token[2].type != JIM_TT_ESC ||
9991             initScript->token[4].type != JIM_TT_ESC ||
9992             incrScript->token[2].type != JIM_TT_ESC ||
9993             expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9994             (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9995              expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9996             (expr->opcode[2] != JIM_EXPROP_LT &&
9997              expr->opcode[2] != JIM_EXPROP_LTE))
9998             goto evalstart;
9999         cmpType = expr->opcode[2];
10000         /* Initialization command must be [set] */
10001         cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10002         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10003             goto evalstart;
10004         /* Update command must be incr */
10005         cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10006         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10007             goto evalstart;
10008         /* set, incr, expression must be about the same variable */
10009         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10010                             incrScript->token[2].objPtr, 0))
10011             goto evalstart;
10012         if (!Jim_StringEqObj(initScript->token[2].objPtr,
10013                             expr->obj[0], 0))
10014             goto evalstart;
10015         /* Check that the initialization and comparison are valid integers */
10016         if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10017             goto evalstart;
10018         if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10019             Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10020         {
10021             goto evalstart;
10022         }
10023
10024         /* Initialization */
10025         varNamePtr = expr->obj[0];
10026         if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10027             stopVarNamePtr = expr->obj[1];
10028             Jim_IncrRefCount(stopVarNamePtr);
10029         }
10030         Jim_IncrRefCount(varNamePtr);
10031
10032         /* --- OPTIMIZED FOR --- */
10033         /* Start to loop */
10034         objPtr = Jim_NewIntObj(interp, start);
10035         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10036             Jim_DecrRefCount(interp, varNamePtr);
10037             if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10038             Jim_FreeNewObj(interp, objPtr);
10039             goto evalstart;
10040         }
10041         while (1) {
10042             /* === Check condition === */
10043             /* Common code: */
10044             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10045             if (objPtr == NULL ||
10046                 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10047             {
10048                 Jim_DecrRefCount(interp, varNamePtr);
10049                 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10050                 goto testcond;
10051             }
10052             /* Immediate or Variable? get the 'stop' value if the latter. */
10053             if (stopVarNamePtr) {
10054                 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10055                 if (objPtr == NULL ||
10056                     Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10057                 {
10058                     Jim_DecrRefCount(interp, varNamePtr);
10059                     Jim_DecrRefCount(interp, stopVarNamePtr);
10060                     goto testcond;
10061                 }
10062             }
10063             if (cmpType == JIM_EXPROP_LT) {
10064                 if (currentVal >= stop) break;
10065             } else {
10066                 if (currentVal > stop) break;
10067             }
10068             /* Eval body */
10069             if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10070                 switch(retval) {
10071                 case JIM_BREAK:
10072                     if (stopVarNamePtr)
10073                         Jim_DecrRefCount(interp, stopVarNamePtr);
10074                     Jim_DecrRefCount(interp, varNamePtr);
10075                     goto out;
10076                 case JIM_CONTINUE:
10077                     /* nothing to do */
10078                     break;
10079                 default:
10080                     if (stopVarNamePtr)
10081                         Jim_DecrRefCount(interp, stopVarNamePtr);
10082                     Jim_DecrRefCount(interp, varNamePtr);
10083                     return retval;
10084                 }
10085             }
10086             /* If there was a change in procedures/command continue
10087              * with the usual [for] command implementation */
10088             if (procEpoch != interp->procEpoch) {
10089                 if (stopVarNamePtr)
10090                     Jim_DecrRefCount(interp, stopVarNamePtr);
10091                 Jim_DecrRefCount(interp, varNamePtr);
10092                 goto evalnext;
10093             }
10094             /* Increment */
10095             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10096             if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10097                 objPtr->internalRep.wideValue ++;
10098                 Jim_InvalidateStringRep(objPtr);
10099             } else {
10100                 Jim_Obj *auxObjPtr;
10101
10102                 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10103                     if (stopVarNamePtr)
10104                         Jim_DecrRefCount(interp, stopVarNamePtr);
10105                     Jim_DecrRefCount(interp, varNamePtr);
10106                     goto evalnext;
10107                 }
10108                 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10109                 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10110                     if (stopVarNamePtr)
10111                         Jim_DecrRefCount(interp, stopVarNamePtr);
10112                     Jim_DecrRefCount(interp, varNamePtr);
10113                     Jim_FreeNewObj(interp, auxObjPtr);
10114                     goto evalnext;
10115                 }
10116             }
10117         }
10118         if (stopVarNamePtr)
10119             Jim_DecrRefCount(interp, stopVarNamePtr);
10120         Jim_DecrRefCount(interp, varNamePtr);
10121         Jim_SetEmptyResult(interp);
10122         return JIM_OK;
10123     }
10124 #endif
10125 evalstart:
10126     /* Eval start */
10127     if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10128         return retval;
10129     while (1) {
10130         int boolean;
10131 testcond:
10132         /* Test the condition */
10133         if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10134                 != JIM_OK)
10135             return retval;
10136         if (!boolean) break;
10137         /* Eval body */
10138         if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10139             switch(retval) {
10140             case JIM_BREAK:
10141                 goto out;
10142                 break;
10143             case JIM_CONTINUE:
10144                 /* Nothing to do */
10145                 break;
10146             default:
10147                 return retval;
10148             }
10149         }
10150 evalnext:
10151         /* Eval next */
10152         if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10153             switch(retval) {
10154             case JIM_BREAK:
10155                 goto out;
10156                 break;
10157             case JIM_CONTINUE:
10158                 continue;
10159                 break;
10160             default:
10161                 return retval;
10162             }
10163         }
10164     }
10165 out:
10166     Jim_SetEmptyResult(interp);
10167     return JIM_OK;
10168 }
10169
10170 /* foreach + lmap implementation. */
10171 static int JimForeachMapHelper(Jim_Interp *interp, int argc, 
10172         Jim_Obj *const *argv, int doMap)
10173 {
10174     int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10175     int nbrOfLoops = 0;
10176     Jim_Obj *emptyStr, *script, *mapRes = NULL;
10177
10178     if (argc < 4 || argc % 2 != 0) {
10179         Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10180         return JIM_ERR;
10181     }
10182     if (doMap) {
10183         mapRes = Jim_NewListObj(interp, NULL, 0);
10184         Jim_IncrRefCount(mapRes);
10185     }
10186     emptyStr = Jim_NewEmptyStringObj(interp);
10187     Jim_IncrRefCount(emptyStr);
10188     script = argv[argc-1];            /* Last argument is a script */
10189     nbrOfLists = (argc - 1 - 1) / 2;  /* argc - 'foreach' - script */
10190     listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10191     listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10192     /* Initialize iterators and remember max nbr elements each list */
10193     memset(listsIdx, 0, nbrOfLists * sizeof(int));
10194     /* Remember lengths of all lists and calculate how much rounds to loop */
10195     for (i=0; i < nbrOfLists*2; i += 2) {
10196         div_t cnt;
10197         int count;
10198         Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10199         Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10200         if (listsEnd[i] == 0) {
10201             Jim_SetResultString(interp, "foreach varlist is empty", -1);
10202             goto err;
10203         }
10204         cnt = div(listsEnd[i+1], listsEnd[i]);
10205         count = cnt.quot + (cnt.rem ? 1 : 0);
10206         if (count > nbrOfLoops)
10207             nbrOfLoops = count;
10208     }
10209     for (; nbrOfLoops-- > 0; ) {
10210         for (i=0; i < nbrOfLists; ++i) {
10211             int varIdx = 0, var = i * 2;
10212             while (varIdx < listsEnd[var]) {
10213                 Jim_Obj *varName, *ele;
10214                 int lst = i * 2 + 1;
10215                 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10216                         != JIM_OK)
10217                         goto err;
10218                 if (listsIdx[i] < listsEnd[lst]) {
10219                     if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10220                         != JIM_OK)
10221                         goto err;
10222                     if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10223                         Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10224                         goto err;
10225                     }
10226                     ++listsIdx[i];  /* Remember next iterator of current list */ 
10227                 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10228                     Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10229                     goto err;
10230                 }
10231                 ++varIdx;  /* Next variable */
10232             }
10233         }
10234         switch (result = Jim_EvalObj(interp, script)) {
10235             case JIM_OK:
10236                 if (doMap)
10237                     Jim_ListAppendElement(interp, mapRes, interp->result);
10238                 break;
10239             case JIM_CONTINUE:
10240                 break;
10241             case JIM_BREAK:
10242                 goto out;
10243                 break;
10244             default:
10245                 goto err;
10246         }
10247     }
10248 out:
10249     result = JIM_OK;
10250     if (doMap)
10251         Jim_SetResult(interp, mapRes);
10252     else
10253         Jim_SetEmptyResult(interp);
10254 err:
10255     if (doMap)
10256         Jim_DecrRefCount(interp, mapRes);
10257     Jim_DecrRefCount(interp, emptyStr);
10258     Jim_Free(listsIdx);
10259     Jim_Free(listsEnd);
10260     return result;
10261 }
10262
10263 /* [foreach] */
10264 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, 
10265         Jim_Obj *const *argv)
10266 {
10267     return JimForeachMapHelper(interp, argc, argv, 0);
10268 }
10269
10270 /* [lmap] */
10271 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, 
10272         Jim_Obj *const *argv)
10273 {
10274     return JimForeachMapHelper(interp, argc, argv, 1);
10275 }
10276
10277 /* [if] */
10278 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, 
10279         Jim_Obj *const *argv)
10280 {
10281     int boolean, retval, current = 1, falsebody = 0;
10282     if (argc >= 3) {
10283         while (1) {
10284             /* Far not enough arguments given! */
10285             if (current >= argc) goto err;
10286             if ((retval = Jim_GetBoolFromExpr(interp,
10287                         argv[current++], &boolean))
10288                     != JIM_OK)
10289                 return retval;
10290             /* There lacks something, isn't it? */
10291             if (current >= argc) goto err;
10292             if (Jim_CompareStringImmediate(interp, argv[current],
10293                         "then")) current++;
10294             /* Tsk tsk, no then-clause? */
10295             if (current >= argc) goto err;
10296             if (boolean)
10297                 return Jim_EvalObj(interp, argv[current]);
10298              /* Ok: no else-clause follows */
10299             if (++current >= argc) {
10300                 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));                   
10301                 return JIM_OK;
10302             }
10303             falsebody = current++;
10304             if (Jim_CompareStringImmediate(interp, argv[falsebody],
10305                         "else")) {
10306                 /* IIICKS - else-clause isn't last cmd? */
10307                 if (current != argc-1) goto err;
10308                 return Jim_EvalObj(interp, argv[current]);
10309             } else if (Jim_CompareStringImmediate(interp,
10310                         argv[falsebody], "elseif"))
10311                 /* Ok: elseif follows meaning all the stuff
10312                  * again (how boring...) */
10313                 continue;
10314             /* OOPS - else-clause is not last cmd?*/
10315             else if (falsebody != argc-1)
10316                 goto err;
10317             return Jim_EvalObj(interp, argv[falsebody]);
10318         }
10319         return JIM_OK;
10320     }
10321 err:
10322     Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10323     return JIM_ERR;
10324 }
10325
10326 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10327
10328 /* [switch] */
10329 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, 
10330         Jim_Obj *const *argv)
10331 {
10332     int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10333     Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10334     Jim_Obj *script = 0;
10335     if (argc < 3) goto wrongnumargs;
10336     for (opt=1; opt < argc; ++opt) {
10337         const char *option = Jim_GetString(argv[opt], 0);
10338         if (*option != '-') break;
10339         else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10340         else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10341         else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10342         else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10343         else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10344             if ((argc - opt) < 2) goto wrongnumargs;
10345             command = argv[++opt]; 
10346         } else {
10347             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10348             Jim_AppendStrings(interp, Jim_GetResult(interp),
10349                 "bad option \"", option, "\": must be -exact, -glob, "
10350                 "-regexp, -command procname or --", 0);
10351             goto err;            
10352         }
10353         if ((argc - opt) < 2) goto wrongnumargs;
10354     }
10355     strObj = argv[opt++];
10356     patCount = argc - opt;
10357     if (patCount == 1) {
10358         Jim_Obj **vector;
10359         JimListGetElements(interp, argv[opt], &patCount, &vector);
10360         caseList = vector;
10361     } else
10362         caseList = &argv[opt];
10363     if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10364     for (i=0; script == 0 && i < patCount; i += 2) {
10365         Jim_Obj *patObj = caseList[i];
10366         if (!Jim_CompareStringImmediate(interp, patObj, "default")
10367             || i < (patCount-2)) {
10368             switch (matchOpt) {
10369                 case SWITCH_EXACT:
10370                     if (Jim_StringEqObj(strObj, patObj, 0))
10371                         script = caseList[i+1];
10372                     break;
10373                 case SWITCH_GLOB:
10374                     if (Jim_StringMatchObj(patObj, strObj, 0))
10375                         script = caseList[i+1];
10376                     break;
10377                 case SWITCH_RE:
10378                     command = Jim_NewStringObj(interp, "regexp", -1);
10379                     /* Fall thru intentionally */
10380                 case SWITCH_CMD: {
10381                     Jim_Obj *parms[] = {command, patObj, strObj};
10382                     int rc = Jim_EvalObjVector(interp, 3, parms);
10383                     long matching;
10384                     /* After the execution of a command we need to
10385                      * make sure to reconvert the object into a list
10386                      * again. Only for the single-list style [switch]. */
10387                     if (argc-opt == 1) {
10388                         Jim_Obj **vector;
10389                         JimListGetElements(interp, argv[opt], &patCount,
10390                                 &vector);
10391                         caseList = vector;
10392                     }
10393                     /* command is here already decref'd */
10394                     if (rc != JIM_OK) {
10395                         retcode = rc;
10396                         goto err;
10397                     }
10398                     rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10399                     if (rc != JIM_OK) {
10400                         retcode = rc;
10401                         goto err;
10402                     }
10403                     if (matching)
10404                         script = caseList[i+1];
10405                     break;
10406                 }
10407                 default:
10408                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10409                     Jim_AppendStrings(interp, Jim_GetResult(interp),
10410                         "internal error: no such option implemented", 0);
10411                     goto err;
10412             }
10413         } else {
10414           script = caseList[i+1];
10415         }
10416     }
10417     for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10418         i += 2)
10419         script = caseList[i+1];
10420     if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10421         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10422         Jim_AppendStrings(interp, Jim_GetResult(interp),
10423             "no body specified for pattern \"",
10424             Jim_GetString(caseList[i-2], 0), "\"", 0);
10425         goto err;
10426     }
10427     retcode = JIM_OK;
10428     Jim_SetEmptyResult(interp);
10429     if (script != 0)
10430         retcode = Jim_EvalObj(interp, script);
10431     return retcode;
10432 wrongnumargs:
10433     Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10434         "pattern body ... ?default body?   or   "
10435         "{pattern body ?pattern body ...?}");
10436 err:
10437     return retcode;        
10438 }
10439
10440 /* [list] */
10441 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, 
10442         Jim_Obj *const *argv)
10443 {
10444     Jim_Obj *listObjPtr;
10445
10446     listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10447     Jim_SetResult(interp, listObjPtr);
10448     return JIM_OK;
10449 }
10450
10451 /* [lindex] */
10452 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, 
10453         Jim_Obj *const *argv)
10454 {
10455     Jim_Obj *objPtr, *listObjPtr;
10456     int i;
10457     int index;
10458
10459     if (argc < 3) {
10460         Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10461         return JIM_ERR;
10462     }
10463     objPtr = argv[1];
10464     Jim_IncrRefCount(objPtr);
10465     for (i = 2; i < argc; i++) {
10466         listObjPtr = objPtr;
10467         if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10468             Jim_DecrRefCount(interp, listObjPtr);
10469             return JIM_ERR;
10470         }
10471         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10472                     JIM_NONE) != JIM_OK) {
10473             /* Returns an empty object if the index
10474              * is out of range. */
10475             Jim_DecrRefCount(interp, listObjPtr);
10476             Jim_SetEmptyResult(interp);
10477             return JIM_OK;
10478         }
10479         Jim_IncrRefCount(objPtr);
10480         Jim_DecrRefCount(interp, listObjPtr);
10481     }
10482     Jim_SetResult(interp, objPtr);
10483     Jim_DecrRefCount(interp, objPtr);
10484     return JIM_OK;
10485 }
10486
10487 /* [llength] */
10488 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, 
10489         Jim_Obj *const *argv)
10490 {
10491     int len;
10492
10493     if (argc != 2) {
10494         Jim_WrongNumArgs(interp, 1, argv, "list");
10495         return JIM_ERR;
10496     }
10497     Jim_ListLength(interp, argv[1], &len);
10498     Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10499     return JIM_OK;
10500 }
10501
10502 /* [lappend] */
10503 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, 
10504         Jim_Obj *const *argv)
10505 {
10506     Jim_Obj *listObjPtr;
10507     int shared, i;
10508
10509     if (argc < 2) {
10510         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10511         return JIM_ERR;
10512     }
10513     listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10514     if (!listObjPtr) {
10515         /* Create the list if it does not exists */
10516         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10517         if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10518             Jim_FreeNewObj(interp, listObjPtr);
10519             return JIM_ERR;
10520         }
10521     }
10522     shared = Jim_IsShared(listObjPtr);
10523     if (shared)
10524         listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10525     for (i = 2; i < argc; i++)
10526         Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10527     if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10528         if (shared)
10529             Jim_FreeNewObj(interp, listObjPtr);
10530         return JIM_ERR;
10531     }
10532     Jim_SetResult(interp, listObjPtr);
10533     return JIM_OK;
10534 }
10535
10536 /* [linsert] */
10537 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, 
10538         Jim_Obj *const *argv)
10539 {
10540     int index, len;
10541     Jim_Obj *listPtr;
10542
10543     if (argc < 4) {
10544         Jim_WrongNumArgs(interp, 1, argv, "list index element "
10545             "?element ...?");
10546         return JIM_ERR;
10547     }
10548     listPtr = argv[1];
10549     if (Jim_IsShared(listPtr))
10550         listPtr = Jim_DuplicateObj(interp, listPtr);
10551     if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10552         goto err;
10553     Jim_ListLength(interp, listPtr, &len);
10554     if (index >= len)
10555         index = len;
10556     else if (index < 0)
10557         index = len + index + 1;
10558     Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10559     Jim_SetResult(interp, listPtr);
10560     return JIM_OK;
10561 err:
10562     if (listPtr != argv[1]) {
10563         Jim_FreeNewObj(interp, listPtr);
10564     }
10565     return JIM_ERR;
10566 }
10567
10568 /* [lset] */
10569 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, 
10570         Jim_Obj *const *argv)
10571 {
10572     if (argc < 3) {
10573         Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10574         return JIM_ERR;
10575     } else if (argc == 3) {
10576         if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10577             return JIM_ERR;
10578         Jim_SetResult(interp, argv[2]);
10579         return JIM_OK;
10580     }
10581     if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10582             == JIM_ERR) return JIM_ERR;
10583     return JIM_OK;
10584 }
10585
10586 /* [lsort] */
10587 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10588 {
10589     const char *options[] = {
10590         "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10591     };
10592     enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10593     Jim_Obj *resObj;
10594     int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10595     int decreasing = 0;
10596
10597     if (argc < 2) {
10598         Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10599         return JIM_ERR;
10600     }
10601     for (i = 1; i < (argc-1); i++) {
10602         int option;
10603
10604         if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10605                 != JIM_OK)
10606             return JIM_ERR;
10607         switch(option) {
10608         case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10609         case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10610         case OPT_INCREASING: decreasing = 0; break;
10611         case OPT_DECREASING: decreasing = 1; break;
10612         }
10613     }
10614     if (decreasing) {
10615         switch(lsortType) {
10616         case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10617         case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10618         }
10619     }
10620     resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10621     ListSortElements(interp, resObj, lsortType);
10622     Jim_SetResult(interp, resObj);
10623     return JIM_OK;
10624 }
10625
10626 /* [append] */
10627 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, 
10628         Jim_Obj *const *argv)
10629 {
10630     Jim_Obj *stringObjPtr;
10631     int shared, i;
10632
10633     if (argc < 2) {
10634         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10635         return JIM_ERR;
10636     }
10637     if (argc == 2) {
10638         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10639         if (!stringObjPtr) return JIM_ERR;
10640     } else {
10641         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10642         if (!stringObjPtr) {
10643             /* Create the string if it does not exists */
10644             stringObjPtr = Jim_NewEmptyStringObj(interp);
10645             if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10646                     != JIM_OK) {
10647                 Jim_FreeNewObj(interp, stringObjPtr);
10648                 return JIM_ERR;
10649             }
10650         }
10651     }
10652     shared = Jim_IsShared(stringObjPtr);
10653     if (shared)
10654         stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10655     for (i = 2; i < argc; i++)
10656         Jim_AppendObj(interp, stringObjPtr, argv[i]);
10657     if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10658         if (shared)
10659             Jim_FreeNewObj(interp, stringObjPtr);
10660         return JIM_ERR;
10661     }
10662     Jim_SetResult(interp, stringObjPtr);
10663     return JIM_OK;
10664 }
10665
10666 /* [debug] */
10667 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, 
10668         Jim_Obj *const *argv)
10669 {
10670     const char *options[] = {
10671         "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10672         "exprbc",
10673         NULL
10674     };
10675     enum {
10676         OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10677         OPT_EXPRLEN, OPT_EXPRBC
10678     };
10679     int option;
10680
10681     if (argc < 2) {
10682         Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10683         return JIM_ERR;
10684     }
10685     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10686                 JIM_ERRMSG) != JIM_OK)
10687         return JIM_ERR;
10688     if (option == OPT_REFCOUNT) {
10689         if (argc != 3) {
10690             Jim_WrongNumArgs(interp, 2, argv, "object");
10691             return JIM_ERR;
10692         }
10693         Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10694         return JIM_OK;
10695     } else if (option == OPT_OBJCOUNT) {
10696         int freeobj = 0, liveobj = 0;
10697         char buf[256];
10698         Jim_Obj *objPtr;
10699
10700         if (argc != 2) {
10701             Jim_WrongNumArgs(interp, 2, argv, "");
10702             return JIM_ERR;
10703         }
10704         /* Count the number of free objects. */
10705         objPtr = interp->freeList;
10706         while (objPtr) {
10707             freeobj++;
10708             objPtr = objPtr->nextObjPtr;
10709         }
10710         /* Count the number of live objects. */
10711         objPtr = interp->liveList;
10712         while (objPtr) {
10713             liveobj++;
10714             objPtr = objPtr->nextObjPtr;
10715         }
10716         /* Set the result string and return. */
10717         sprintf(buf, "free %d used %d", freeobj, liveobj);
10718         Jim_SetResultString(interp, buf, -1);
10719         return JIM_OK;
10720     } else if (option == OPT_OBJECTS) {
10721         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10722         /* Count the number of live objects. */
10723         objPtr = interp->liveList;
10724         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10725         while (objPtr) {
10726             char buf[128];
10727             const char *type = objPtr->typePtr ?
10728                 objPtr->typePtr->name : "";
10729             subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10730             sprintf(buf, "%p", objPtr);
10731             Jim_ListAppendElement(interp, subListObjPtr,
10732                 Jim_NewStringObj(interp, buf, -1));
10733             Jim_ListAppendElement(interp, subListObjPtr,
10734                 Jim_NewStringObj(interp, type, -1));
10735             Jim_ListAppendElement(interp, subListObjPtr,
10736                 Jim_NewIntObj(interp, objPtr->refCount));
10737             Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10738             Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10739             objPtr = objPtr->nextObjPtr;
10740         }
10741         Jim_SetResult(interp, listObjPtr);
10742         return JIM_OK;
10743     } else if (option == OPT_INVSTR) {
10744         Jim_Obj *objPtr;
10745
10746         if (argc != 3) {
10747             Jim_WrongNumArgs(interp, 2, argv, "object");
10748             return JIM_ERR;
10749         }
10750         objPtr = argv[2];
10751         if (objPtr->typePtr != NULL)
10752             Jim_InvalidateStringRep(objPtr);
10753         Jim_SetEmptyResult(interp);
10754         return JIM_OK;
10755     } else if (option == OPT_SCRIPTLEN) {
10756         ScriptObj *script;
10757         if (argc != 3) {
10758             Jim_WrongNumArgs(interp, 2, argv, "script");
10759             return JIM_ERR;
10760         }
10761         script = Jim_GetScript(interp, argv[2]);
10762         Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10763         return JIM_OK;
10764     } else if (option == OPT_EXPRLEN) {
10765         ExprByteCode *expr;
10766         if (argc != 3) {
10767             Jim_WrongNumArgs(interp, 2, argv, "expression");
10768             return JIM_ERR;
10769         }
10770         expr = Jim_GetExpression(interp, argv[2]);
10771         if (expr == NULL)
10772             return JIM_ERR;
10773         Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10774         return JIM_OK;
10775     } else if (option == OPT_EXPRBC) {
10776         Jim_Obj *objPtr;
10777         ExprByteCode *expr;
10778         int i;
10779
10780         if (argc != 3) {
10781             Jim_WrongNumArgs(interp, 2, argv, "expression");
10782             return JIM_ERR;
10783         }
10784         expr = Jim_GetExpression(interp, argv[2]);
10785         if (expr == NULL)
10786             return JIM_ERR;
10787         objPtr = Jim_NewListObj(interp, NULL, 0);
10788         for (i = 0; i < expr->len; i++) {
10789             const char *type;
10790             Jim_ExprOperator *op;
10791
10792             switch(expr->opcode[i]) {
10793             case JIM_EXPROP_NUMBER: type = "number"; break;
10794             case JIM_EXPROP_COMMAND: type = "command"; break;
10795             case JIM_EXPROP_VARIABLE: type = "variable"; break;
10796             case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10797             case JIM_EXPROP_SUBST: type = "subst"; break;
10798             case JIM_EXPROP_STRING: type = "string"; break;
10799             default:
10800                 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10801                 if (op == NULL) {
10802                     type = "private";
10803                 } else {
10804                     type = "operator";
10805                 }
10806                 break;
10807             }
10808             Jim_ListAppendElement(interp, objPtr,
10809                     Jim_NewStringObj(interp, type, -1));
10810             Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10811         }
10812         Jim_SetResult(interp, objPtr);
10813         return JIM_OK;
10814     } else {
10815         Jim_SetResultString(interp,
10816             "bad option. Valid options are refcount, "
10817             "objcount, objects, invstr", -1);
10818         return JIM_ERR;
10819     }
10820     return JIM_OK; /* unreached */
10821 }
10822
10823 /* [eval] */
10824 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, 
10825         Jim_Obj *const *argv)
10826 {
10827     if (argc == 2) {
10828         return Jim_EvalObj(interp, argv[1]);
10829     } else if (argc > 2) {
10830         Jim_Obj *objPtr;
10831         int retcode;
10832
10833         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10834         Jim_IncrRefCount(objPtr);
10835         retcode = Jim_EvalObj(interp, objPtr);
10836         Jim_DecrRefCount(interp, objPtr);
10837         return retcode;
10838     } else {
10839         Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10840         return JIM_ERR;
10841     }
10842 }
10843
10844 /* [uplevel] */
10845 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, 
10846         Jim_Obj *const *argv)
10847 {
10848     if (argc >= 2) {
10849         int retcode, newLevel, oldLevel;
10850         Jim_CallFrame *savedCallFrame, *targetCallFrame;
10851         Jim_Obj *objPtr;
10852         const char *str;
10853
10854         /* Save the old callframe pointer */
10855         savedCallFrame = interp->framePtr;
10856
10857         /* Lookup the target frame pointer */
10858         str = Jim_GetString(argv[1], NULL);
10859         if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10860         {
10861             if (Jim_GetCallFrameByLevel(interp, argv[1],
10862                         &targetCallFrame,
10863                         &newLevel) != JIM_OK)
10864                 return JIM_ERR;
10865             argc--;
10866             argv++;
10867         } else {
10868             if (Jim_GetCallFrameByLevel(interp, NULL,
10869                         &targetCallFrame,
10870                         &newLevel) != JIM_OK)
10871                 return JIM_ERR;
10872         }
10873         if (argc < 2) {
10874             argc++;
10875             argv--;
10876             Jim_WrongNumArgs(interp, 1, argv,
10877                     "?level? command ?arg ...?");
10878             return JIM_ERR;
10879         }
10880         /* Eval the code in the target callframe. */
10881         interp->framePtr = targetCallFrame;
10882         oldLevel = interp->numLevels;
10883         interp->numLevels = newLevel;
10884         if (argc == 2) {
10885             retcode = Jim_EvalObj(interp, argv[1]);
10886         } else {
10887             objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10888             Jim_IncrRefCount(objPtr);
10889             retcode = Jim_EvalObj(interp, objPtr);
10890             Jim_DecrRefCount(interp, objPtr);
10891         }
10892         interp->numLevels = oldLevel;
10893         interp->framePtr = savedCallFrame;
10894         return retcode;
10895     } else {
10896         Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10897         return JIM_ERR;
10898     }
10899 }
10900
10901 /* [expr] */
10902 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, 
10903         Jim_Obj *const *argv)
10904 {
10905     Jim_Obj *exprResultPtr;
10906     int retcode;
10907
10908     if (argc == 2) {
10909         retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10910     } else if (argc > 2) {
10911         Jim_Obj *objPtr;
10912
10913         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10914         Jim_IncrRefCount(objPtr);
10915         retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10916         Jim_DecrRefCount(interp, objPtr);
10917     } else {
10918         Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10919         return JIM_ERR;
10920     }
10921     if (retcode != JIM_OK) return retcode;
10922     Jim_SetResult(interp, exprResultPtr);
10923     Jim_DecrRefCount(interp, exprResultPtr);
10924     return JIM_OK;
10925 }
10926
10927 /* [break] */
10928 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, 
10929         Jim_Obj *const *argv)
10930 {
10931     if (argc != 1) {
10932         Jim_WrongNumArgs(interp, 1, argv, "");
10933         return JIM_ERR;
10934     }
10935     return JIM_BREAK;
10936 }
10937
10938 /* [continue] */
10939 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10940         Jim_Obj *const *argv)
10941 {
10942     if (argc != 1) {
10943         Jim_WrongNumArgs(interp, 1, argv, "");
10944         return JIM_ERR;
10945     }
10946     return JIM_CONTINUE;
10947 }
10948
10949 /* [return] */
10950 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, 
10951         Jim_Obj *const *argv)
10952 {
10953     if (argc == 1) {
10954         return JIM_RETURN;
10955     } else if (argc == 2) {
10956         Jim_SetResult(interp, argv[1]);
10957         interp->returnCode = JIM_OK;
10958         return JIM_RETURN;
10959     } else if (argc == 3 || argc == 4) {
10960         int returnCode;
10961         if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10962             return JIM_ERR;
10963         interp->returnCode = returnCode;
10964         if (argc == 4)
10965             Jim_SetResult(interp, argv[3]);
10966         return JIM_RETURN;
10967     } else {
10968         Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10969         return JIM_ERR;
10970     }
10971     return JIM_RETURN; /* unreached */
10972 }
10973
10974 /* [tailcall] */
10975 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10976         Jim_Obj *const *argv)
10977 {
10978     Jim_Obj *objPtr;
10979
10980     objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10981     Jim_SetResult(interp, objPtr);
10982     return JIM_EVAL;
10983 }
10984
10985 /* [proc] */
10986 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, 
10987         Jim_Obj *const *argv)
10988 {
10989     int argListLen;
10990     int arityMin, arityMax;
10991
10992     if (argc != 4 && argc != 5) {
10993         Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10994         return JIM_ERR;
10995     }
10996     Jim_ListLength(interp, argv[2], &argListLen);
10997     arityMin = arityMax = argListLen+1;
10998
10999     if (argListLen) {
11000         const char *str;
11001         int len;
11002         Jim_Obj *argPtr;
11003         
11004         /* Check for 'args' and adjust arityMin and arityMax if necessary */
11005         Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11006         str = Jim_GetString(argPtr, &len);
11007         if (len == 4 && memcmp(str, "args", 4) == 0) {
11008             arityMin--;
11009             arityMax = -1;
11010         }
11011
11012         /* Check for default arguments and reduce arityMin if necessary */
11013         while (arityMin > 1) {
11014             int len;
11015             Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11016             Jim_ListLength(interp, argPtr, &len);
11017             if (len != 2) {
11018                 /* No default argument */
11019                 break;
11020             }
11021             arityMin--;
11022         }
11023     }
11024     if (argc == 4) {
11025         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11026                 argv[2], NULL, argv[3], arityMin, arityMax);
11027     } else {
11028         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11029                 argv[2], argv[3], argv[4], arityMin, arityMax);
11030     }
11031 }
11032
11033 /* [concat] */
11034 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, 
11035         Jim_Obj *const *argv)
11036 {
11037     Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11038     return JIM_OK;
11039 }
11040
11041 /* [upvar] */
11042 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, 
11043         Jim_Obj *const *argv)
11044 {
11045     const char *str;
11046     int i;
11047     Jim_CallFrame *targetCallFrame;
11048
11049     /* Lookup the target frame pointer */
11050     str = Jim_GetString(argv[1], NULL);
11051     if (argc > 3 && 
11052         ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11053     {
11054         if (Jim_GetCallFrameByLevel(interp, argv[1],
11055                     &targetCallFrame, NULL) != JIM_OK)
11056             return JIM_ERR;
11057         argc--;
11058         argv++;
11059     } else {
11060         if (Jim_GetCallFrameByLevel(interp, NULL,
11061                     &targetCallFrame, NULL) != JIM_OK)
11062             return JIM_ERR;
11063     }
11064     /* Check for arity */
11065     if (argc < 3 || ((argc-1)%2) != 0) {
11066         Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11067         return JIM_ERR;
11068     }
11069     /* Now... for every other/local couple: */
11070     for (i = 1; i < argc; i += 2) {
11071         if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11072                 targetCallFrame) != JIM_OK) return JIM_ERR;
11073     }
11074     return JIM_OK;
11075 }
11076
11077 /* [global] */
11078 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, 
11079         Jim_Obj *const *argv)
11080 {
11081     int i;
11082
11083     if (argc < 2) {
11084         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11085         return JIM_ERR;
11086     }
11087     /* Link every var to the toplevel having the same name */
11088     if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11089     for (i = 1; i < argc; i++) {
11090         if (Jim_SetVariableLink(interp, argv[i], argv[i],
11091                 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11092     }
11093     return JIM_OK;
11094 }
11095
11096 /* does the [string map] operation. On error NULL is returned,
11097  * otherwise a new string object with the result, having refcount = 0,
11098  * is returned. */
11099 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11100         Jim_Obj *objPtr, int nocase)
11101 {
11102     int numMaps;
11103     const char **key, *str, *noMatchStart = NULL;
11104     Jim_Obj **value;
11105     int *keyLen, strLen, i;
11106     Jim_Obj *resultObjPtr;
11107     
11108     Jim_ListLength(interp, mapListObjPtr, &numMaps);
11109     if (numMaps % 2) {
11110         Jim_SetResultString(interp,
11111                 "list must contain an even number of elements", -1);
11112         return NULL;
11113     }
11114     /* Initialization */
11115     numMaps /= 2;
11116     key = Jim_Alloc(sizeof(char*)*numMaps);
11117     keyLen = Jim_Alloc(sizeof(int)*numMaps);
11118     value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11119     resultObjPtr = Jim_NewStringObj(interp, "", 0);
11120     for (i = 0; i < numMaps; i++) {
11121         Jim_Obj *eleObjPtr;
11122
11123         Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11124         key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11125         Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11126         value[i] = eleObjPtr;
11127     }
11128     str = Jim_GetString(objPtr, &strLen);
11129     /* Map it */
11130     while(strLen) {
11131         for (i = 0; i < numMaps; i++) {
11132             if (strLen >= keyLen[i] && keyLen[i]) {
11133                 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11134                             nocase))
11135                 {
11136                     if (noMatchStart) {
11137                         Jim_AppendString(interp, resultObjPtr,
11138                                 noMatchStart, str-noMatchStart);
11139                         noMatchStart = NULL;
11140                     }
11141                     Jim_AppendObj(interp, resultObjPtr, value[i]);
11142                     str += keyLen[i];
11143                     strLen -= keyLen[i];
11144                     break;
11145                 }
11146             }
11147         }
11148         if (i == numMaps) { /* no match */
11149             if (noMatchStart == NULL)
11150                 noMatchStart = str;
11151             str ++;
11152             strLen --;
11153         }
11154     }
11155     if (noMatchStart) {
11156         Jim_AppendString(interp, resultObjPtr,
11157             noMatchStart, str-noMatchStart);
11158     }
11159     Jim_Free((void*)key);
11160     Jim_Free(keyLen);
11161     Jim_Free(value);
11162     return resultObjPtr;
11163 }
11164
11165 /* [string] */
11166 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, 
11167         Jim_Obj *const *argv)
11168 {
11169     int option;
11170     const char *options[] = {
11171         "length", "compare", "match", "equal", "range", "map", "repeat",
11172         "index", "first", "tolower", "toupper", NULL
11173     };
11174     enum {
11175         OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11176         OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11177     };
11178
11179     if (argc < 2) {
11180         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11181         return JIM_ERR;
11182     }
11183     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11184                 JIM_ERRMSG) != JIM_OK)
11185         return JIM_ERR;
11186
11187     if (option == OPT_LENGTH) {
11188         int len;
11189
11190         if (argc != 3) {
11191             Jim_WrongNumArgs(interp, 2, argv, "string");
11192             return JIM_ERR;
11193         }
11194         Jim_GetString(argv[2], &len);
11195         Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11196         return JIM_OK;
11197     } else if (option == OPT_COMPARE) {
11198         int nocase = 0;
11199         if ((argc != 4 && argc != 5) ||
11200             (argc == 5 && Jim_CompareStringImmediate(interp,
11201                 argv[2], "-nocase") == 0)) {
11202             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11203             return JIM_ERR;
11204         }
11205         if (argc == 5) {
11206             nocase = 1;
11207             argv++;
11208         }
11209         Jim_SetResult(interp, Jim_NewIntObj(interp,
11210                     Jim_StringCompareObj(argv[2],
11211                             argv[3], nocase)));
11212         return JIM_OK;
11213     } else if (option == OPT_MATCH) {
11214         int nocase = 0;
11215         if ((argc != 4 && argc != 5) ||
11216             (argc == 5 && Jim_CompareStringImmediate(interp,
11217                 argv[2], "-nocase") == 0)) {
11218             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11219                     "string");
11220             return JIM_ERR;
11221         }
11222         if (argc == 5) {
11223             nocase = 1;
11224             argv++;
11225         }
11226         Jim_SetResult(interp,
11227             Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11228                     argv[3], nocase)));
11229         return JIM_OK;
11230     } else if (option == OPT_EQUAL) {
11231         if (argc != 4) {
11232             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11233             return JIM_ERR;
11234         }
11235         Jim_SetResult(interp,
11236             Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11237                     argv[3], 0)));
11238         return JIM_OK;
11239     } else if (option == OPT_RANGE) {
11240         Jim_Obj *objPtr;
11241
11242         if (argc != 5) {
11243             Jim_WrongNumArgs(interp, 2, argv, "string first last");
11244             return JIM_ERR;
11245         }
11246         objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11247         if (objPtr == NULL)
11248             return JIM_ERR;
11249         Jim_SetResult(interp, objPtr);
11250         return JIM_OK;
11251     } else if (option == OPT_MAP) {
11252         int nocase = 0;
11253         Jim_Obj *objPtr;
11254
11255         if ((argc != 4 && argc != 5) ||
11256             (argc == 5 && Jim_CompareStringImmediate(interp,
11257                 argv[2], "-nocase") == 0)) {
11258             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11259                     "string");
11260             return JIM_ERR;
11261         }
11262         if (argc == 5) {
11263             nocase = 1;
11264             argv++;
11265         }
11266         objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11267         if (objPtr == NULL)
11268             return JIM_ERR;
11269         Jim_SetResult(interp, objPtr);
11270         return JIM_OK;
11271     } else if (option == OPT_REPEAT) {
11272         Jim_Obj *objPtr;
11273         jim_wide count;
11274
11275         if (argc != 4) {
11276             Jim_WrongNumArgs(interp, 2, argv, "string count");
11277             return JIM_ERR;
11278         }
11279         if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11280             return JIM_ERR;
11281         objPtr = Jim_NewStringObj(interp, "", 0);
11282         while (count--) {
11283             Jim_AppendObj(interp, objPtr, argv[2]);
11284         }
11285         Jim_SetResult(interp, objPtr);
11286         return JIM_OK;
11287     } else if (option == OPT_INDEX) {
11288         int index, len;
11289         const char *str;
11290
11291         if (argc != 4) {
11292             Jim_WrongNumArgs(interp, 2, argv, "string index");
11293             return JIM_ERR;
11294         }
11295         if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11296             return JIM_ERR;
11297         str = Jim_GetString(argv[2], &len);
11298         if (index != INT_MIN && index != INT_MAX)
11299             index = JimRelToAbsIndex(len, index);
11300         if (index < 0 || index >= len) {
11301             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11302             return JIM_OK;
11303         } else {
11304             Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11305             return JIM_OK;
11306         }
11307     } else if (option == OPT_FIRST) {
11308         int index = 0, l1, l2;
11309         const char *s1, *s2;
11310
11311         if (argc != 4 && argc != 5) {
11312             Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11313             return JIM_ERR;
11314         }
11315         s1 = Jim_GetString(argv[2], &l1);
11316         s2 = Jim_GetString(argv[3], &l2);
11317         if (argc == 5) {
11318             if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11319                 return JIM_ERR;
11320             index = JimRelToAbsIndex(l2, index);
11321         }
11322         Jim_SetResult(interp, Jim_NewIntObj(interp,
11323                     JimStringFirst(s1, l1, s2, l2, index)));
11324         return JIM_OK;
11325     } else if (option == OPT_TOLOWER) {
11326         if (argc != 3) {
11327             Jim_WrongNumArgs(interp, 2, argv, "string");
11328             return JIM_ERR;
11329         }
11330         Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11331     } else if (option == OPT_TOUPPER) {
11332         if (argc != 3) {
11333             Jim_WrongNumArgs(interp, 2, argv, "string");
11334             return JIM_ERR;
11335         }
11336         Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11337     }
11338     return JIM_OK;
11339 }
11340
11341 /* [time] */
11342 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, 
11343         Jim_Obj *const *argv)
11344 {
11345     long i, count = 1;
11346     jim_wide start, elapsed;
11347     char buf [256];
11348     const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11349
11350     if (argc < 2) {
11351         Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11352         return JIM_ERR;
11353     }
11354     if (argc == 3) {
11355         if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11356             return JIM_ERR;
11357     }
11358     if (count < 0)
11359         return JIM_OK;
11360     i = count;
11361     start = JimClock();
11362     while (i-- > 0) {
11363         int retval;
11364
11365         if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11366             return retval;
11367     }
11368     elapsed = JimClock() - start;
11369     sprintf(buf, fmt, elapsed/count);
11370     Jim_SetResultString(interp, buf, -1);
11371     return JIM_OK;
11372 }
11373
11374 /* [exit] */
11375 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, 
11376         Jim_Obj *const *argv)
11377 {
11378     long exitCode = 0;
11379
11380     if (argc > 2) {
11381         Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11382         return JIM_ERR;
11383     }
11384     if (argc == 2) {
11385         if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11386             return JIM_ERR;
11387     }
11388     interp->exitCode = exitCode;
11389     return JIM_EXIT;
11390 }
11391
11392 /* [catch] */
11393 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, 
11394         Jim_Obj *const *argv)
11395 {
11396     int exitCode = 0;
11397
11398     if (argc != 2 && argc != 3) {
11399         Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11400         return JIM_ERR;
11401     }
11402     exitCode = Jim_EvalObj(interp, argv[1]);
11403     if (argc == 3) {
11404         if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11405                 != JIM_OK)
11406             return JIM_ERR;
11407     }
11408     Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11409     return JIM_OK;
11410 }
11411
11412 /* [ref] */
11413 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, 
11414         Jim_Obj *const *argv)
11415 {
11416     if (argc != 3 && argc != 4) {
11417         Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11418         return JIM_ERR;
11419     }
11420     if (argc == 3) {
11421         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11422     } else {
11423         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11424                     argv[3]));
11425     }
11426     return JIM_OK;
11427 }
11428
11429 /* [getref] */
11430 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, 
11431         Jim_Obj *const *argv)
11432 {
11433     Jim_Reference *refPtr;
11434
11435     if (argc != 2) {
11436         Jim_WrongNumArgs(interp, 1, argv, "reference");
11437         return JIM_ERR;
11438     }
11439     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11440         return JIM_ERR;
11441     Jim_SetResult(interp, refPtr->objPtr);
11442     return JIM_OK;
11443 }
11444
11445 /* [setref] */
11446 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, 
11447         Jim_Obj *const *argv)
11448 {
11449     Jim_Reference *refPtr;
11450
11451     if (argc != 3) {
11452         Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11453         return JIM_ERR;
11454     }
11455     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11456         return JIM_ERR;
11457     Jim_IncrRefCount(argv[2]);
11458     Jim_DecrRefCount(interp, refPtr->objPtr);
11459     refPtr->objPtr = argv[2];
11460     Jim_SetResult(interp, argv[2]);
11461     return JIM_OK;
11462 }
11463
11464 /* [collect] */
11465 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, 
11466         Jim_Obj *const *argv)
11467 {
11468     if (argc != 1) {
11469         Jim_WrongNumArgs(interp, 1, argv, "");
11470         return JIM_ERR;
11471     }
11472     Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11473     return JIM_OK;
11474 }
11475
11476 /* [finalize] reference ?newValue? */
11477 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, 
11478         Jim_Obj *const *argv)
11479 {
11480     if (argc != 2 && argc != 3) {
11481         Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11482         return JIM_ERR;
11483     }
11484     if (argc == 2) {
11485         Jim_Obj *cmdNamePtr;
11486
11487         if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11488             return JIM_ERR;
11489         if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11490             Jim_SetResult(interp, cmdNamePtr);
11491     } else {
11492         if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11493             return JIM_ERR;
11494         Jim_SetResult(interp, argv[2]);
11495     }
11496     return JIM_OK;
11497 }
11498
11499 /* TODO */
11500 /* [info references] (list of all the references/finalizers) */
11501
11502 /* [rename] */
11503 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, 
11504         Jim_Obj *const *argv)
11505 {
11506     const char *oldName, *newName;
11507
11508     if (argc != 3) {
11509         Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11510         return JIM_ERR;
11511     }
11512     oldName = Jim_GetString(argv[1], NULL);
11513     newName = Jim_GetString(argv[2], NULL);
11514     if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11515         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11516         Jim_AppendStrings(interp, Jim_GetResult(interp),
11517             "can't rename \"", oldName, "\": ",
11518             "command doesn't exist", NULL);
11519         return JIM_ERR;
11520     }
11521     return JIM_OK;
11522 }
11523
11524 /* [dict] */
11525 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, 
11526         Jim_Obj *const *argv)
11527 {
11528     int option;
11529     const char *options[] = {
11530         "create", "get", "set", "unset", "exists", NULL
11531     };
11532     enum {
11533         OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11534     };
11535
11536     if (argc < 2) {
11537         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11538         return JIM_ERR;
11539     }
11540
11541     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11542                 JIM_ERRMSG) != JIM_OK)
11543         return JIM_ERR;
11544
11545     if (option == OPT_CREATE) {
11546         Jim_Obj *objPtr;
11547
11548         if (argc % 2) {
11549             Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11550             return JIM_ERR;
11551         }
11552         objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11553         Jim_SetResult(interp, objPtr);
11554         return JIM_OK;
11555     } else if (option == OPT_GET) {
11556         Jim_Obj *objPtr;
11557
11558         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11559                 JIM_ERRMSG) != JIM_OK)
11560             return JIM_ERR;
11561         Jim_SetResult(interp, objPtr);
11562         return JIM_OK;
11563     } else if (option == OPT_SET) {
11564         if (argc < 5) {
11565             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11566             return JIM_ERR;
11567         }
11568         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11569                     argv[argc-1]);
11570     } else if (option == OPT_UNSET) {
11571         if (argc < 4) {
11572             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11573             return JIM_ERR;
11574         }
11575         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11576                     NULL);
11577     } else if (option == OPT_EXIST) {
11578         Jim_Obj *objPtr;
11579         int exists;
11580
11581         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11582                 JIM_ERRMSG) == JIM_OK)
11583             exists = 1;
11584         else
11585             exists = 0;
11586         Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11587         return JIM_OK;
11588     } else {
11589         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11590         Jim_AppendStrings(interp, Jim_GetResult(interp),
11591             "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11592             " must be create, get, set", NULL);
11593         return JIM_ERR;
11594     }
11595     return JIM_OK;
11596 }
11597
11598 /* [load] */
11599 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, 
11600         Jim_Obj *const *argv)
11601 {
11602     if (argc < 2) {
11603         Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11604         return JIM_ERR;
11605     }
11606     return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11607 }
11608
11609 /* [subst] */
11610 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, 
11611         Jim_Obj *const *argv)
11612 {
11613     int i, flags = 0;
11614     Jim_Obj *objPtr;
11615
11616     if (argc < 2) {
11617         Jim_WrongNumArgs(interp, 1, argv,
11618             "?-nobackslashes? ?-nocommands? ?-novariables? string");
11619         return JIM_ERR;
11620     }
11621     i = argc-2;
11622     while(i--) {
11623         if (Jim_CompareStringImmediate(interp, argv[i+1],
11624                     "-nobackslashes"))
11625             flags |= JIM_SUBST_NOESC;
11626         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11627                     "-novariables"))
11628             flags |= JIM_SUBST_NOVAR;
11629         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11630                     "-nocommands"))
11631             flags |= JIM_SUBST_NOCMD;
11632         else {
11633             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11634             Jim_AppendStrings(interp, Jim_GetResult(interp),
11635                 "bad option \"", Jim_GetString(argv[i+1], NULL),
11636                 "\": must be -nobackslashes, -nocommands, or "
11637                 "-novariables", NULL);
11638             return JIM_ERR;
11639         }
11640     }
11641     if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11642         return JIM_ERR;
11643     Jim_SetResult(interp, objPtr);
11644     return JIM_OK;
11645 }
11646
11647 /* [info] */
11648 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, 
11649         Jim_Obj *const *argv)
11650 {
11651     int cmd, result = JIM_OK;
11652     static const char *commands[] = {
11653         "body", "commands", "exists", "globals", "level", "locals",
11654         "vars", "version", "complete", "args", "hostname", NULL
11655     };
11656     enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11657           INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11658     
11659     if (argc < 2) {
11660         Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11661         return JIM_ERR;
11662     }
11663     if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11664         != JIM_OK) {
11665         return JIM_ERR;
11666     }
11667     
11668     if (cmd == INFO_COMMANDS) {
11669         if (argc != 2 && argc != 3) {
11670             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11671             return JIM_ERR;
11672         }
11673         if (argc == 3)
11674             Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11675         else
11676             Jim_SetResult(interp, JimCommandsList(interp, NULL));
11677     } else if (cmd == INFO_EXISTS) {
11678         Jim_Obj *exists;
11679         if (argc != 3) {
11680             Jim_WrongNumArgs(interp, 2, argv, "varName");
11681             return JIM_ERR;
11682         }
11683         exists = Jim_GetVariable(interp, argv[2], 0);
11684         Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11685     } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11686         int mode;
11687         switch (cmd) {
11688             case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11689             case INFO_LOCALS:  mode = JIM_VARLIST_LOCALS; break;
11690             case INFO_VARS:    mode = JIM_VARLIST_VARS; break;
11691             default: mode = 0; /* avoid warning */; break;
11692         }
11693         if (argc != 2 && argc != 3) {
11694             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11695             return JIM_ERR;
11696         }
11697         if (argc == 3)
11698             Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11699         else
11700             Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11701     } else if (cmd == INFO_LEVEL) {
11702         Jim_Obj *objPtr;
11703         switch (argc) {
11704             case 2:
11705                 Jim_SetResult(interp,
11706                               Jim_NewIntObj(interp, interp->numLevels));
11707                 break;
11708             case 3:
11709                 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11710                     return JIM_ERR;
11711                 Jim_SetResult(interp, objPtr);
11712                 break;
11713             default:
11714                 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11715                 return JIM_ERR;
11716         }
11717     } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11718         Jim_Cmd *cmdPtr;
11719
11720         if (argc != 3) {
11721             Jim_WrongNumArgs(interp, 2, argv, "procname");
11722             return JIM_ERR;
11723         }
11724         if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11725             return JIM_ERR;
11726         if (cmdPtr->cmdProc != NULL) {
11727             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11728             Jim_AppendStrings(interp, Jim_GetResult(interp),
11729                 "command \"", Jim_GetString(argv[2], NULL),
11730                 "\" is not a procedure", NULL);
11731             return JIM_ERR;
11732         }
11733         if (cmd == INFO_BODY)
11734             Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11735         else
11736             Jim_SetResult(interp, cmdPtr->argListObjPtr);
11737     } else if (cmd == INFO_VERSION) {
11738         char buf[(JIM_INTEGER_SPACE * 2) + 1];
11739         sprintf(buf, "%d.%d", 
11740                 JIM_VERSION / 100, JIM_VERSION % 100);
11741         Jim_SetResultString(interp, buf, -1);
11742     } else if (cmd == INFO_COMPLETE) {
11743         const char *s;
11744         int len;
11745
11746         if (argc != 3) {
11747             Jim_WrongNumArgs(interp, 2, argv, "script");
11748             return JIM_ERR;
11749         }
11750         s = Jim_GetString(argv[2], &len);
11751         Jim_SetResult(interp,
11752                 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11753     } else if (cmd == INFO_HOSTNAME) {
11754         /* Redirect to os.hostname if it exists */
11755         Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11756         result = Jim_EvalObjVector(interp, 1, &command);
11757     }
11758     return result;
11759 }
11760
11761 /* [split] */
11762 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, 
11763         Jim_Obj *const *argv)
11764 {
11765     const char *str, *splitChars, *noMatchStart;
11766     int splitLen, strLen, i;
11767     Jim_Obj *resObjPtr;
11768
11769     if (argc != 2 && argc != 3) {
11770         Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11771         return JIM_ERR;
11772     }
11773     /* Init */
11774     if (argc == 2) {
11775         splitChars = " \n\t\r";
11776         splitLen = 4;
11777     } else {
11778         splitChars = Jim_GetString(argv[2], &splitLen);
11779     }
11780     str = Jim_GetString(argv[1], &strLen);
11781     if (!strLen) return JIM_OK;
11782     noMatchStart = str;
11783     resObjPtr = Jim_NewListObj(interp, NULL, 0);
11784     /* Split */
11785     if (splitLen) {
11786         while (strLen) {
11787             for (i = 0; i < splitLen; i++) {
11788                 if (*str == splitChars[i]) {
11789                     Jim_Obj *objPtr;
11790
11791                     objPtr = Jim_NewStringObj(interp, noMatchStart,
11792                             (str-noMatchStart));
11793                     Jim_ListAppendElement(interp, resObjPtr, objPtr);
11794                     noMatchStart = str+1;
11795                     break;
11796                 }
11797             }
11798             str ++;
11799             strLen --;
11800         }
11801         Jim_ListAppendElement(interp, resObjPtr,
11802                 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11803     } else {
11804         /* This handles the special case of splitchars eq {}. This
11805          * is trivial but we want to perform object sharing as Tcl does. */
11806         Jim_Obj *objCache[256];
11807         const unsigned char *u = (unsigned char*) str;
11808         memset(objCache, 0, sizeof(objCache));
11809         for (i = 0; i < strLen; i++) {
11810             int c = u[i];
11811             
11812             if (objCache[c] == NULL)
11813                 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11814             Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11815         }
11816     }
11817     Jim_SetResult(interp, resObjPtr);
11818     return JIM_OK;
11819 }
11820
11821 /* [join] */
11822 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, 
11823         Jim_Obj *const *argv)
11824 {
11825     const char *joinStr;
11826     int joinStrLen, i, listLen;
11827     Jim_Obj *resObjPtr;
11828
11829     if (argc != 2 && argc != 3) {
11830         Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11831         return JIM_ERR;
11832     }
11833     /* Init */
11834     if (argc == 2) {
11835         joinStr = " ";
11836         joinStrLen = 1;
11837     } else {
11838         joinStr = Jim_GetString(argv[2], &joinStrLen);
11839     }
11840     Jim_ListLength(interp, argv[1], &listLen);
11841     resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11842     /* Split */
11843     for (i = 0; i < listLen; i++) {
11844         Jim_Obj *objPtr;
11845
11846         Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11847         Jim_AppendObj(interp, resObjPtr, objPtr);
11848         if (i+1 != listLen) {
11849             Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11850         }
11851     }
11852     Jim_SetResult(interp, resObjPtr);
11853     return JIM_OK;
11854 }
11855
11856 /* [format] */
11857 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11858         Jim_Obj *const *argv)
11859 {
11860     Jim_Obj *objPtr;
11861
11862     if (argc < 2) {
11863         Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11864         return JIM_ERR;
11865     }
11866     objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11867     if (objPtr == NULL)
11868         return JIM_ERR;
11869     Jim_SetResult(interp, objPtr);
11870     return JIM_OK;
11871 }
11872
11873 /* [scan] */
11874 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11875         Jim_Obj *const *argv)
11876 {
11877     Jim_Obj *listPtr, **outVec;
11878     int outc, i, count = 0;
11879
11880     if (argc < 3) {
11881         Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11882         return JIM_ERR;
11883     } 
11884     if (argv[2]->typePtr != &scanFmtStringObjType)
11885         SetScanFmtFromAny(interp, argv[2]);
11886     if (FormatGetError(argv[2]) != 0) {
11887         Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11888         return JIM_ERR;
11889     }
11890     if (argc > 3) {
11891         int maxPos = FormatGetMaxPos(argv[2]);
11892         int count = FormatGetCnvCount(argv[2]);
11893         if (maxPos > argc-3) {
11894             Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11895             return JIM_ERR;
11896         } else if (count != 0 && count < argc-3) {
11897             Jim_SetResultString(interp, "variable is not assigned by any "
11898                 "conversion specifiers", -1);
11899             return JIM_ERR;
11900         } else if (count > argc-3) {
11901             Jim_SetResultString(interp, "different numbers of variable names and "
11902                 "field specifiers", -1);
11903             return JIM_ERR;
11904         }
11905     } 
11906     listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11907     if (listPtr == 0)
11908         return JIM_ERR;
11909     if (argc > 3) {
11910         int len = 0;
11911         if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11912             Jim_ListLength(interp, listPtr, &len);
11913         if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11914             Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11915             return JIM_OK;
11916         }
11917         JimListGetElements(interp, listPtr, &outc, &outVec);
11918         for (i = 0; i < outc; ++i) {
11919             if (Jim_Length(outVec[i]) > 0) {
11920                 ++count;
11921                 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11922                     goto err;
11923             }
11924         }
11925         Jim_FreeNewObj(interp, listPtr);
11926         Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11927     } else {
11928         if (listPtr == (Jim_Obj*)EOF) {
11929             Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11930             return JIM_OK;
11931         }
11932         Jim_SetResult(interp, listPtr);
11933     }
11934     return JIM_OK;
11935 err:
11936     Jim_FreeNewObj(interp, listPtr);
11937     return JIM_ERR;
11938 }
11939
11940 /* [error] */
11941 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11942         Jim_Obj *const *argv)
11943 {
11944     if (argc != 2) {
11945         Jim_WrongNumArgs(interp, 1, argv, "message");
11946         return JIM_ERR;
11947     }
11948     Jim_SetResult(interp, argv[1]);
11949     return JIM_ERR;
11950 }
11951
11952 /* [lrange] */
11953 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11954         Jim_Obj *const *argv)
11955 {
11956     Jim_Obj *objPtr;
11957
11958     if (argc != 4) {
11959         Jim_WrongNumArgs(interp, 1, argv, "list first last");
11960         return JIM_ERR;
11961     }
11962     if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11963         return JIM_ERR;
11964     Jim_SetResult(interp, objPtr);
11965     return JIM_OK;
11966 }
11967
11968 /* [env] */
11969 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11970         Jim_Obj *const *argv)
11971 {
11972     const char *key;
11973     char *val;
11974
11975     if (argc == 1) {
11976         extern char **environ;
11977
11978         int i;
11979         Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11980
11981         for (i = 0; environ[i]; i++) {
11982             const char *equals = strchr(environ[i], '=');
11983             if (equals) {
11984                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11985                 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11986             }
11987         }
11988
11989         Jim_SetResult(interp, listObjPtr);
11990         return JIM_OK;
11991     }
11992
11993     if (argc != 2) {
11994         Jim_WrongNumArgs(interp, 1, argv, "varName");
11995         return JIM_ERR;
11996     }
11997     key = Jim_GetString(argv[1], NULL);
11998     val = getenv(key);
11999     if (val == NULL) {
12000         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12001         Jim_AppendStrings(interp, Jim_GetResult(interp),
12002                 "environment variable \"",
12003                 key, "\" does not exist", NULL);
12004         return JIM_ERR;
12005     }
12006     Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12007     return JIM_OK;
12008 }
12009
12010 /* [source] */
12011 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12012         Jim_Obj *const *argv)
12013 {
12014     int retval;
12015
12016     if (argc != 2) {
12017         Jim_WrongNumArgs(interp, 1, argv, "fileName");
12018         return JIM_ERR;
12019     }
12020     retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12021     if (retval == JIM_ERR) {
12022         return JIM_ERR_ADDSTACK;
12023     }
12024     if (retval == JIM_RETURN)
12025         return JIM_OK;
12026     return retval;
12027 }
12028
12029 /* [lreverse] */
12030 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12031         Jim_Obj *const *argv)
12032 {
12033     Jim_Obj *revObjPtr, **ele;
12034     int len;
12035
12036     if (argc != 2) {
12037         Jim_WrongNumArgs(interp, 1, argv, "list");
12038         return JIM_ERR;
12039     }
12040     JimListGetElements(interp, argv[1], &len, &ele);
12041     len--;
12042     revObjPtr = Jim_NewListObj(interp, NULL, 0);
12043     while (len >= 0)
12044         ListAppendElement(revObjPtr, ele[len--]);
12045     Jim_SetResult(interp, revObjPtr);
12046     return JIM_OK;
12047 }
12048
12049 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12050 {
12051     jim_wide len;
12052
12053     if (step == 0) return -1;
12054     if (start == end) return 0;
12055     else if (step > 0 && start > end) return -1;
12056     else if (step < 0 && end > start) return -1;
12057     len = end-start;
12058     if (len < 0) len = -len; /* abs(len) */
12059     if (step < 0) step = -step; /* abs(step) */
12060     len = 1 + ((len-1)/step);
12061     /* We can truncate safely to INT_MAX, the range command
12062      * will always return an error for a such long range
12063      * because Tcl lists can't be so long. */
12064     if (len > INT_MAX) len = INT_MAX;
12065     return (int)((len < 0) ? -1 : len);
12066 }
12067
12068 /* [range] */
12069 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12070         Jim_Obj *const *argv)
12071 {
12072     jim_wide start = 0, end, step = 1;
12073     int len, i;
12074     Jim_Obj *objPtr;
12075
12076     if (argc < 2 || argc > 4) {
12077         Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12078         return JIM_ERR;
12079     }
12080     if (argc == 2) {
12081         if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12082             return JIM_ERR;
12083     } else {
12084         if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12085             Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12086             return JIM_ERR;
12087         if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12088             return JIM_ERR;
12089     }
12090     if ((len = JimRangeLen(start, end, step)) == -1) {
12091         Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12092         return JIM_ERR;
12093     }
12094     objPtr = Jim_NewListObj(interp, NULL, 0);
12095     for (i = 0; i < len; i++)
12096         ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12097     Jim_SetResult(interp, objPtr);
12098     return JIM_OK;
12099 }
12100
12101 /* [rand] */
12102 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12103         Jim_Obj *const *argv)
12104 {
12105     jim_wide min = 0, max, len, maxMul;
12106
12107     if (argc < 1 || argc > 3) {
12108         Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12109         return JIM_ERR;
12110     }
12111     if (argc == 1) {
12112         max = JIM_WIDE_MAX;
12113     } else if (argc == 2) {
12114         if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12115             return JIM_ERR;
12116     } else if (argc == 3) {
12117         if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12118             Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12119             return JIM_ERR;
12120     }
12121     len = max-min;
12122     if (len < 0) {
12123         Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12124         return JIM_ERR;
12125     }
12126     maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12127     while (1) {
12128         jim_wide r;
12129
12130         JimRandomBytes(interp, &r, sizeof(jim_wide));
12131         if (r < 0 || r >= maxMul) continue;
12132         r = (len == 0) ? 0 : r%len;
12133         Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12134         return JIM_OK;
12135     }
12136 }
12137
12138 /* [package] */
12139 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc, 
12140         Jim_Obj *const *argv)
12141 {
12142     int option;
12143     const char *options[] = {
12144         "require", "provide", NULL
12145     };
12146     enum {OPT_REQUIRE, OPT_PROVIDE};
12147
12148     if (argc < 2) {
12149         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12150         return JIM_ERR;
12151     }
12152     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12153                 JIM_ERRMSG) != JIM_OK)
12154         return JIM_ERR;
12155
12156     if (option == OPT_REQUIRE) {
12157         int exact = 0;
12158         const char *ver;
12159
12160         if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12161             exact = 1;
12162             argv++;
12163             argc--;
12164         }
12165         if (argc != 3 && argc != 4) {
12166             Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12167             return JIM_ERR;
12168         }
12169         ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12170                 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12171                 JIM_ERRMSG);
12172         if (ver == NULL)
12173             return JIM_ERR_ADDSTACK;
12174         Jim_SetResultString(interp, ver, -1);
12175     } else if (option == OPT_PROVIDE) {
12176         if (argc != 4) {
12177             Jim_WrongNumArgs(interp, 2, argv, "package version");
12178             return JIM_ERR;
12179         }
12180         return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12181                     Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12182     }
12183     return JIM_OK;
12184 }
12185
12186 static struct {
12187     const char *name;
12188     Jim_CmdProc cmdProc;
12189 } Jim_CoreCommandsTable[] = {
12190     {"set", Jim_SetCoreCommand},
12191     {"unset", Jim_UnsetCoreCommand},
12192     {"puts", Jim_PutsCoreCommand},
12193     {"+", Jim_AddCoreCommand},
12194     {"*", Jim_MulCoreCommand},
12195     {"-", Jim_SubCoreCommand},
12196     {"/", Jim_DivCoreCommand},
12197     {"incr", Jim_IncrCoreCommand},
12198     {"while", Jim_WhileCoreCommand},
12199     {"for", Jim_ForCoreCommand},
12200     {"foreach", Jim_ForeachCoreCommand},
12201     {"lmap", Jim_LmapCoreCommand},
12202     {"if", Jim_IfCoreCommand},
12203     {"switch", Jim_SwitchCoreCommand},
12204     {"list", Jim_ListCoreCommand},
12205     {"lindex", Jim_LindexCoreCommand},
12206     {"lset", Jim_LsetCoreCommand},
12207     {"llength", Jim_LlengthCoreCommand},
12208     {"lappend", Jim_LappendCoreCommand},
12209     {"linsert", Jim_LinsertCoreCommand},
12210     {"lsort", Jim_LsortCoreCommand},
12211     {"append", Jim_AppendCoreCommand},
12212     {"debug", Jim_DebugCoreCommand},
12213     {"eval", Jim_EvalCoreCommand},
12214     {"uplevel", Jim_UplevelCoreCommand},
12215     {"expr", Jim_ExprCoreCommand},
12216     {"break", Jim_BreakCoreCommand},
12217     {"continue", Jim_ContinueCoreCommand},
12218     {"proc", Jim_ProcCoreCommand},
12219     {"concat", Jim_ConcatCoreCommand},
12220     {"return", Jim_ReturnCoreCommand},
12221     {"upvar", Jim_UpvarCoreCommand},
12222     {"global", Jim_GlobalCoreCommand},
12223     {"string", Jim_StringCoreCommand},
12224     {"time", Jim_TimeCoreCommand},
12225     {"exit", Jim_ExitCoreCommand},
12226     {"catch", Jim_CatchCoreCommand},
12227     {"ref", Jim_RefCoreCommand},
12228     {"getref", Jim_GetrefCoreCommand},
12229     {"setref", Jim_SetrefCoreCommand},
12230     {"finalize", Jim_FinalizeCoreCommand},
12231     {"collect", Jim_CollectCoreCommand},
12232     {"rename", Jim_RenameCoreCommand},
12233     {"dict", Jim_DictCoreCommand},
12234     {"load", Jim_LoadCoreCommand},
12235     {"subst", Jim_SubstCoreCommand},
12236     {"info", Jim_InfoCoreCommand},
12237     {"split", Jim_SplitCoreCommand},
12238     {"join", Jim_JoinCoreCommand},
12239     {"format", Jim_FormatCoreCommand},
12240     {"scan", Jim_ScanCoreCommand},
12241     {"error", Jim_ErrorCoreCommand},
12242     {"lrange", Jim_LrangeCoreCommand},
12243     {"env", Jim_EnvCoreCommand},
12244     {"source", Jim_SourceCoreCommand},
12245     {"lreverse", Jim_LreverseCoreCommand},
12246     {"range", Jim_RangeCoreCommand},
12247     {"rand", Jim_RandCoreCommand},
12248     {"package", Jim_PackageCoreCommand},
12249     {"tailcall", Jim_TailcallCoreCommand},
12250     {NULL, NULL},
12251 };
12252
12253 /* Some Jim core command is actually a procedure written in Jim itself. */
12254 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12255 {
12256     Jim_Eval(interp, (char*)
12257 "proc lambda {arglist args} {\n"
12258 "    set name [ref {} function lambdaFinalizer]\n"
12259 "    uplevel 1 [list proc $name $arglist {expand}$args]\n"
12260 "    return $name\n"
12261 "}\n"
12262 "proc lambdaFinalizer {name val} {\n"
12263 "    rename $name {}\n"
12264 "}\n"
12265     );
12266 }
12267
12268 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12269 {
12270     int i = 0;
12271
12272     while(Jim_CoreCommandsTable[i].name != NULL) {
12273         Jim_CreateCommand(interp, 
12274                 Jim_CoreCommandsTable[i].name,
12275                 Jim_CoreCommandsTable[i].cmdProc,
12276                 NULL, NULL);
12277         i++;
12278     }
12279     Jim_RegisterCoreProcedures(interp);
12280 }
12281
12282 /* -----------------------------------------------------------------------------
12283  * Interactive prompt
12284  * ---------------------------------------------------------------------------*/
12285 void Jim_PrintErrorMessage(Jim_Interp *interp)
12286 {
12287     int len, i;
12288
12289     if (*interp->errorFileName) {
12290         Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL "    ",
12291                                     interp->errorFileName, interp->errorLine);
12292     }
12293     Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12294             Jim_GetString(interp->result, NULL));
12295     Jim_ListLength(interp, interp->stackTrace, &len);
12296     for (i = len-3; i >= 0; i-= 3) {
12297         Jim_Obj *objPtr;
12298         const char *proc, *file, *line;
12299
12300         Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12301         proc = Jim_GetString(objPtr, NULL);
12302         Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12303                 JIM_NONE);
12304         file = Jim_GetString(objPtr, NULL);
12305         Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12306                 JIM_NONE);
12307         line = Jim_GetString(objPtr, NULL);
12308         if (*proc) {
12309             Jim_fprintf( interp, interp->cookie_stderr,
12310                     "in procedure '%s' ", proc);
12311         }
12312         if (*file) {
12313             Jim_fprintf( interp, interp->cookie_stderr,
12314                     "called at file \"%s\", line %s",
12315                     file, line);
12316         }
12317         if (*file || *proc) {
12318             Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12319         }
12320     }
12321 }
12322
12323 int Jim_InteractivePrompt(Jim_Interp *interp)
12324 {
12325     int retcode = JIM_OK;
12326     Jim_Obj *scriptObjPtr;
12327
12328     Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12329            "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12330            JIM_VERSION / 100, JIM_VERSION % 100);
12331      Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12332     while (1) {
12333         char buf[1024];
12334         const char *result;
12335         const char *retcodestr[] = {
12336             "ok", "error", "return", "break", "continue", "eval", "exit"
12337         };
12338         int reslen;
12339
12340         if (retcode != 0) {
12341             if (retcode >= 2 && retcode <= 6)
12342                 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12343             else
12344                 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12345         } else
12346             Jim_fprintf( interp, interp->cookie_stdout, ". ");
12347         Jim_fflush( interp, interp->cookie_stdout);
12348         scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12349         Jim_IncrRefCount(scriptObjPtr);
12350         while(1) {
12351             const char *str;
12352             char state;
12353             int len;
12354
12355             if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12356                 Jim_DecrRefCount(interp, scriptObjPtr);
12357                 goto out;
12358             }
12359             Jim_AppendString(interp, scriptObjPtr, buf, -1);
12360             str = Jim_GetString(scriptObjPtr, &len);
12361             if (Jim_ScriptIsComplete(str, len, &state))
12362                 break;
12363             Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12364             Jim_fflush( interp, interp->cookie_stdout);
12365         }
12366         retcode = Jim_EvalObj(interp, scriptObjPtr);
12367         Jim_DecrRefCount(interp, scriptObjPtr);
12368         result = Jim_GetString(Jim_GetResult(interp), &reslen);
12369         if (retcode == JIM_ERR) {
12370             Jim_PrintErrorMessage(interp);
12371         } else if (retcode == JIM_EXIT) {
12372             exit(Jim_GetExitCode(interp));
12373         } else {
12374             if (reslen) {
12375                                 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12376                                 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12377             }
12378         }
12379     }
12380 out:
12381     return 0;
12382 }
12383
12384 /* -----------------------------------------------------------------------------
12385  * Jim's idea of STDIO..
12386  * ---------------------------------------------------------------------------*/
12387
12388 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12389 {
12390         int r;
12391
12392         va_list ap;
12393         va_start(ap,fmt);
12394         r = Jim_vfprintf( interp, cookie, fmt,ap );
12395         va_end(ap);
12396         return r;
12397 }
12398
12399 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12400 {
12401         if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12402                 errno = ENOTSUP;
12403                 return -1;
12404         }
12405         return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12406 }
12407
12408 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12409 {
12410         if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12411                 errno = ENOTSUP;
12412                 return 0;
12413         }
12414         return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12415 }
12416
12417 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12418 {
12419         if( (interp == NULL) || (interp->cb_fread == NULL) ){
12420                 errno = ENOTSUP;
12421                 return 0;
12422         }
12423         return (*(interp->cb_fread))( ptr, size, n, cookie);
12424 }
12425
12426 int Jim_fflush( Jim_Interp *interp, void *cookie )
12427 {
12428         if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12429                 /* pretend all is well */
12430                 return 0;
12431         }
12432         return (*(interp->cb_fflush))( cookie );
12433 }
12434
12435 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12436 {
12437         if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12438                 errno = ENOTSUP;
12439                 return NULL;
12440         }
12441         return (*(interp->cb_fgets))( s, size, cookie );
12442 }
12443 Jim_Nvp *
12444 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12445 {
12446         while( p->name ){
12447                 if( 0 == strcmp( name, p->name ) ){
12448                         break;
12449                 }
12450                 p++;
12451         }
12452         return ((Jim_Nvp *)(p));
12453 }
12454
12455 Jim_Nvp *
12456 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12457 {
12458         while( p->name ){
12459                 if( 0 == strcasecmp( name, p->name ) ){
12460                         break;
12461                 }
12462                 p++;
12463         }
12464         return ((Jim_Nvp *)(p));
12465 }
12466
12467 int
12468 Jim_Nvp_name2value_obj( Jim_Interp *interp, 
12469                                                 const Jim_Nvp *p, 
12470                                                 Jim_Obj *o, 
12471                                                 Jim_Nvp **result )
12472 {
12473         return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12474 }
12475         
12476
12477 int 
12478 Jim_Nvp_name2value( Jim_Interp *interp, 
12479                                         const Jim_Nvp *_p, 
12480                                         const char *name, 
12481                                         Jim_Nvp **result)
12482 {
12483         const Jim_Nvp *p;
12484
12485         p = Jim_Nvp_name2value_simple( _p, name );
12486
12487         /* result */
12488         if( result ){
12489                 *result = (Jim_Nvp *)(p);
12490         }
12491         
12492         /* found? */
12493         if( p->name ){
12494                 return JIM_OK;
12495         } else {
12496                 return JIM_ERR;
12497         }
12498 }
12499
12500 int
12501 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12502 {
12503         return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12504 }
12505
12506 int
12507 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12508 {
12509         const Jim_Nvp *p;
12510
12511         p = Jim_Nvp_name2value_nocase_simple( _p, name );
12512
12513         if( puthere ){
12514                 *puthere = (Jim_Nvp *)(p);
12515         }
12516         /* found */
12517         if( p->name ){
12518                 return JIM_OK;
12519         } else {
12520                 return JIM_ERR;
12521         }
12522 }
12523
12524
12525 int 
12526 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12527 {
12528         int e;;
12529         jim_wide w;
12530
12531         e = Jim_GetWide( interp, o, &w );
12532         if( e != JIM_OK ){
12533                 return e;
12534         }
12535
12536         return Jim_Nvp_value2name( interp, p, w, result );
12537 }
12538
12539 Jim_Nvp *
12540 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12541 {
12542         while( p->name ){
12543                 if( value == p->value ){
12544                         break;
12545                 }
12546                 p++;
12547         }
12548         return ((Jim_Nvp *)(p));
12549 }
12550
12551
12552 int 
12553 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12554 {
12555         const Jim_Nvp *p;
12556
12557         p = Jim_Nvp_value2name_simple( _p, value );
12558
12559         if( result ){
12560                 *result = (Jim_Nvp *)(p);
12561         }
12562
12563         if( p->name ){
12564                 return JIM_OK;
12565         } else {
12566                 return JIM_ERR;
12567         }
12568 }
12569
12570
12571 int
12572 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const *  argv)
12573 {
12574         memset( p, 0, sizeof(*p) );
12575         p->interp = interp;
12576         p->argc   = argc;
12577         p->argv   = argv;
12578
12579         return JIM_OK;
12580 }
12581
12582 void
12583 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12584 {
12585         int x;
12586
12587         Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12588         for( x = 0 ; x < p->argc ; x++ ){
12589                 Jim_fprintf( p->interp, p->interp->cookie_stderr, 
12590                                          "%2d) %s\n", 
12591                                          x, 
12592                                          Jim_GetString( p->argv[x], NULL ) );
12593         }
12594         Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12595 }
12596
12597
12598 int
12599 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12600 {
12601         Jim_Obj *o;
12602         
12603         o = NULL; // failure 
12604         if( goi->argc ){
12605                 // success 
12606                 o = goi->argv[0];
12607                 goi->argc -= 1;
12608                 goi->argv += 1;
12609         }
12610         if( puthere ){
12611                 *puthere = o;
12612         }
12613         if( o != NULL ){
12614                 return JIM_OK;
12615         } else {
12616                 return JIM_ERR;
12617         }
12618 }
12619
12620 int
12621 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12622 {
12623         int r;
12624         Jim_Obj *o;
12625         const char *cp;
12626
12627
12628         r = Jim_GetOpt_Obj( goi, &o );
12629         if( r == JIM_OK ){
12630                 cp = Jim_GetString( o, len );
12631                 if( puthere ){
12632                         /* remove const */
12633                         *puthere = (char *)(cp);
12634                 }
12635         }
12636         return r;
12637 }
12638
12639 int
12640 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12641 {
12642         int r;
12643         Jim_Obj *o;
12644         double _safe;
12645         
12646         if( puthere == NULL ){
12647                 puthere = &_safe;
12648         }
12649
12650         r = Jim_GetOpt_Obj( goi, &o );
12651         if( r == JIM_OK ){
12652                 r = Jim_GetDouble( goi->interp, o, puthere );
12653                 if( r != JIM_OK ){
12654                         Jim_SetResult_sprintf( goi->interp,
12655                                                                    "not a number: %s", 
12656                                                                    Jim_GetString( o, NULL ) );
12657                 }
12658         }
12659         return r;
12660 }
12661
12662 int
12663 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12664 {
12665         int r;
12666         Jim_Obj *o;
12667         jim_wide _safe;
12668
12669         if( puthere == NULL ){
12670                 puthere = &_safe;
12671         }
12672
12673         r = Jim_GetOpt_Obj( goi, &o );
12674         if( r == JIM_OK ){
12675                 r = Jim_GetWide( goi->interp, o, puthere );
12676         }
12677         return r;
12678 }
12679
12680 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi, 
12681                                         const Jim_Nvp *nvp, 
12682                                         Jim_Nvp **puthere)
12683 {
12684         Jim_Nvp *_safe;
12685         Jim_Obj *o;
12686         int e;
12687
12688         if( puthere == NULL ){
12689                 puthere = &_safe;
12690         }
12691
12692         e = Jim_GetOpt_Obj( goi, &o );
12693         if( e == JIM_OK ){
12694                 e = Jim_Nvp_name2value_obj( goi->interp,
12695                                                                         nvp, 
12696                                                                         o,
12697                                                                         puthere );
12698         }
12699
12700         return e;
12701 }
12702
12703 void
12704 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12705                                            const Jim_Nvp *nvptable,
12706                                            int hadprefix )
12707 {
12708         if( hadprefix ){
12709                 Jim_SetResult_NvpUnknown( goi->interp,
12710                                                                   goi->argv[-2],
12711                                                                   goi->argv[-1],
12712                                                                   nvptable );
12713         } else {
12714                 Jim_SetResult_NvpUnknown( goi->interp,
12715                                                                   NULL,
12716                                                                   goi->argv[-1],
12717                                                                   nvptable );
12718         }
12719 }
12720                                            
12721
12722 int 
12723 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12724                                  const char * const *  lookup,
12725                                  int *puthere)
12726 {
12727         int _safe;
12728         Jim_Obj *o;
12729         int e;
12730
12731         if( puthere == NULL ){
12732                 puthere = &_safe;
12733         }
12734         e = Jim_GetOpt_Obj( goi, &o );
12735         if( e == JIM_OK ){
12736                 e = Jim_GetEnum( goi->interp,
12737                                                  o,
12738                                                  lookup,
12739                                                  puthere,
12740                                                  "option",
12741                                                  JIM_ERRMSG );
12742         }
12743         return e;
12744 }
12745         
12746
12747
12748 int
12749 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12750 {
12751         va_list ap;
12752         char *buf;
12753
12754         va_start(ap,fmt);
12755         buf = jim_vasprintf( fmt, ap );
12756         va_end(ap);
12757         if( buf ){
12758                 Jim_SetResultString( interp, buf, -1 );
12759                 jim_vasprintf_done(buf);
12760         }
12761         return JIM_OK;
12762 }
12763         
12764
12765 void
12766 Jim_SetResult_NvpUnknown( Jim_Interp *interp, 
12767                                                   Jim_Obj *param_name,
12768                                                   Jim_Obj *param_value,
12769                                                   const Jim_Nvp *nvp )
12770 {
12771         if( param_name ){
12772                 Jim_SetResult_sprintf( interp,
12773                                                            "%s: Unknown: %s, try one of: ",
12774                                                            Jim_GetString( param_name, NULL ),
12775                                                            Jim_GetString( param_value, NULL ) );
12776         } else {
12777                 Jim_SetResult_sprintf( interp,
12778                                                            "Unknown param: %s, try one of: ",
12779                                                            Jim_GetString( param_value, NULL ) );
12780         }
12781         while( nvp->name ){
12782                 const char *a;
12783                 const char *b;
12784
12785                 if( (nvp+1)->name ){
12786                         a = nvp->name;
12787                         b = ", ";
12788                 } else {
12789                         a = "or ";
12790                         b = nvp->name;
12791                 }
12792                 Jim_AppendStrings( interp,
12793                                                    Jim_GetResult(interp),
12794                                                    a, b, NULL );
12795                 nvp++;
12796         }
12797 }
12798                                                            
12799
12800 static Jim_Obj *debug_string_obj;
12801
12802 const char *
12803 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12804 {
12805         int x;
12806
12807         if( debug_string_obj ){
12808                 Jim_FreeObj( interp, debug_string_obj );
12809         }
12810
12811         debug_string_obj = Jim_NewEmptyStringObj( interp );
12812         for( x = 0 ; x < argc ; x++ ){
12813                 Jim_AppendStrings( interp,
12814                                                    debug_string_obj,
12815                                                    Jim_GetString( argv[x], NULL ),
12816                                                    " ",
12817                                                    NULL );
12818         }
12819
12820         return Jim_GetString( debug_string_obj, NULL );
12821 }
12822
12823         
12824
12825 /*
12826  * Local Variables: ***
12827  * c-basic-offset: 4 ***
12828  * tab-width: 4 ***
12829  * End: ***
12830  */