- added myself to copyright on files i remember adding large contributions for over...
[fw/openocd] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2  *
3  * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4  * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5  * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net> 
6  * Copyright 2008 oharboe - Ã˜yvind Harboe - oyvind.harboe@zylin.com
7  * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8  * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9  * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10  * 
11  * The FreeBSD license
12  * 
13  * Redistribution and use in source and binary forms, with or without
14  * modification, are permitted provided that the following conditions
15  * are met:
16  * 
17  * 1. Redistributions of source code must retain the above copyright
18  *    notice, this list of conditions and the following disclaimer.
19  * 2. Redistributions in binary form must reproduce the above
20  *    copyright notice, this list of conditions and the following
21  *    disclaimer in the documentation and/or other materials
22  *    provided with the distribution.
23  * 
24  * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
25  * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26  * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
27  * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
28  * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
29  * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
30  * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
31  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
32  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
33  * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
35  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36  * 
37  * The views and conclusions contained in the software and documentation
38  * are those of the authors and should not be interpreted as representing
39  * official policies, either expressed or implied, of the Jim Tcl Project.
40  **/
41 #define __JIM_CORE__
42 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
43
44 #ifdef __ECOS
45 #include <pkgconf/jimtcl.h>
46 #endif
47 #ifndef JIM_ANSIC
48 #define JIM_DYNLIB      /* Dynamic library support for UNIX and WIN32 */
49 #endif /* JIM_ANSIC */
50
51 #include <stdio.h>
52 #include <stdlib.h>
53 #include <string.h>
54 #include <stdarg.h>
55 #include <ctype.h>
56 #include <limits.h>
57 #include <assert.h>
58 #include <errno.h>
59 #include <time.h>
60 #if defined(WIN32)
61 /* sys/time - need is different */
62 #else
63 #include <sys/time.h> // for gettimeofday()
64 #endif
65
66 #include "replacements.h"
67
68 /* Include the platform dependent libraries for
69  * dynamic loading of libraries. */
70 #ifdef JIM_DYNLIB
71 #if defined(_WIN32) || defined(WIN32)
72 #ifndef WIN32
73 #define WIN32 1
74 #endif
75 #ifndef STRICT
76 #define STRICT
77 #endif
78 #define WIN32_LEAN_AND_MEAN
79 #include <windows.h>
80 #if _MSC_VER >= 1000
81 #pragma warning(disable:4146)
82 #endif /* _MSC_VER */
83 #else
84 #include <dlfcn.h>
85 #endif /* WIN32 */
86 #endif /* JIM_DYNLIB */
87
88 #ifdef __ECOS
89 #include <cyg/jimtcl/jim.h>
90 #else
91 #include "jim.h"
92 #endif
93
94 #ifdef HAVE_BACKTRACE
95 #include <execinfo.h>
96 #endif
97
98 /* -----------------------------------------------------------------------------
99  * Global variables
100  * ---------------------------------------------------------------------------*/
101
102 /* A shared empty string for the objects string representation.
103  * Jim_InvalidateStringRep knows about it and don't try to free. */
104 static char *JimEmptyStringRep = (char*) "";
105
106 /* -----------------------------------------------------------------------------
107  * Required prototypes of not exported functions
108  * ---------------------------------------------------------------------------*/
109 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
110 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
111 static void JimRegisterCoreApi(Jim_Interp *interp);
112
113 static Jim_HashTableType JimVariablesHashTableType;
114
115 /* -----------------------------------------------------------------------------
116  * Utility functions
117  * ---------------------------------------------------------------------------*/
118
119 static char *
120 jim_vasprintf( const char *fmt, va_list ap )
121 {
122 #ifndef HAVE_VASPRINTF
123         /* yucky way */
124 static char buf[2048];
125         vsnprintf( buf, sizeof(buf), fmt, ap );
126         /* garentee termination */
127         buf[sizeof(buf)-1] = 0;
128 #else
129         char *buf;
130         vasprintf( &buf, fmt, ap );
131 #endif
132         return buf;
133 }
134
135 static void
136 jim_vasprintf_done( void *buf )
137 {
138 #ifndef HAVE_VASPRINTF
139         (void)(buf);
140 #else
141         free(buf);
142 #endif
143 }
144         
145
146 /*
147  * Convert a string to a jim_wide INTEGER.
148  * This function originates from BSD.
149  *
150  * Ignores `locale' stuff.  Assumes that the upper and lower case
151  * alphabets and digits are each contiguous.
152  */
153 #ifdef HAVE_LONG_LONG
154 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
155 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
156 {
157     register const char *s;
158     register unsigned jim_wide acc;
159     register unsigned char c;
160     register unsigned jim_wide qbase, cutoff;
161     register int neg, any, cutlim;
162
163     /*
164      * Skip white space and pick up leading +/- sign if any.
165      * If base is 0, allow 0x for hex and 0 for octal, else
166      * assume decimal; if base is already 16, allow 0x.
167      */
168     s = nptr;
169     do {
170         c = *s++;
171     } while (isspace(c));
172     if (c == '-') {
173         neg = 1;
174         c = *s++;
175     } else {
176         neg = 0;
177         if (c == '+')
178             c = *s++;
179     }
180     if ((base == 0 || base == 16) &&
181         c == '0' && (*s == 'x' || *s == 'X')) {
182         c = s[1];
183         s += 2;
184         base = 16;
185     }
186     if (base == 0)
187         base = c == '0' ? 8 : 10;
188
189     /*
190      * Compute the cutoff value between legal numbers and illegal
191      * numbers.  That is the largest legal value, divided by the
192      * base.  An input number that is greater than this value, if
193      * followed by a legal input character, is too big.  One that
194      * is equal to this value may be valid or not; the limit
195      * between valid and invalid numbers is then based on the last
196      * digit.  For instance, if the range for quads is
197      * [-9223372036854775808..9223372036854775807] and the input base
198      * is 10, cutoff will be set to 922337203685477580 and cutlim to
199      * either 7 (neg==0) or 8 (neg==1), meaning that if we have
200      * accumulated a value > 922337203685477580, or equal but the
201      * next digit is > 7 (or 8), the number is too big, and we will
202      * return a range error.
203      *
204      * Set any if any `digits' consumed; make it negative to indicate
205      * overflow.
206      */
207     qbase = (unsigned)base;
208     cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
209         : LLONG_MAX;
210     cutlim = (int)(cutoff % qbase);
211     cutoff /= qbase;
212     for (acc = 0, any = 0;; c = *s++) {
213         if (!JimIsAscii(c))
214             break;
215         if (isdigit(c))
216             c -= '0';
217         else if (isalpha(c))
218             c -= isupper(c) ? 'A' - 10 : 'a' - 10;
219         else
220             break;
221         if (c >= base)
222             break;
223         if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
224             any = -1;
225         else {
226             any = 1;
227             acc *= qbase;
228             acc += c;
229         }
230     }
231     if (any < 0) {
232         acc = neg ? LLONG_MIN : LLONG_MAX;
233         errno = ERANGE;
234     } else if (neg)
235         acc = -acc;
236     if (endptr != 0)
237         *endptr = (char *)(any ? s - 1 : nptr);
238     return (acc);
239 }
240 #endif
241
242 /* Glob-style pattern matching. */
243 static int JimStringMatch(const char *pattern, int patternLen,
244         const char *string, int stringLen, int nocase)
245 {
246     while(patternLen) {
247         switch(pattern[0]) {
248         case '*':
249             while (pattern[1] == '*') {
250                 pattern++;
251                 patternLen--;
252             }
253             if (patternLen == 1)
254                 return 1; /* match */
255             while(stringLen) {
256                 if (JimStringMatch(pattern+1, patternLen-1,
257                             string, stringLen, nocase))
258                     return 1; /* match */
259                 string++;
260                 stringLen--;
261             }
262             return 0; /* no match */
263             break;
264         case '?':
265             if (stringLen == 0)
266                 return 0; /* no match */
267             string++;
268             stringLen--;
269             break;
270         case '[':
271         {
272             int not, match;
273
274             pattern++;
275             patternLen--;
276             not = pattern[0] == '^';
277             if (not) {
278                 pattern++;
279                 patternLen--;
280             }
281             match = 0;
282             while(1) {
283                 if (pattern[0] == '\\') {
284                     pattern++;
285                     patternLen--;
286                     if (pattern[0] == string[0])
287                         match = 1;
288                 } else if (pattern[0] == ']') {
289                     break;
290                 } else if (patternLen == 0) {
291                     pattern--;
292                     patternLen++;
293                     break;
294                 } else if (pattern[1] == '-' && patternLen >= 3) {
295                     int start = pattern[0];
296                     int end = pattern[2];
297                     int c = string[0];
298                     if (start > end) {
299                         int t = start;
300                         start = end;
301                         end = t;
302                     }
303                     if (nocase) {
304                         start = tolower(start);
305                         end = tolower(end);
306                         c = tolower(c);
307                     }
308                     pattern += 2;
309                     patternLen -= 2;
310                     if (c >= start && c <= end)
311                         match = 1;
312                 } else {
313                     if (!nocase) {
314                         if (pattern[0] == string[0])
315                             match = 1;
316                     } else {
317                         if (tolower((int)pattern[0]) == tolower((int)string[0]))
318                             match = 1;
319                     }
320                 }
321                 pattern++;
322                 patternLen--;
323             }
324             if (not)
325                 match = !match;
326             if (!match)
327                 return 0; /* no match */
328             string++;
329             stringLen--;
330             break;
331         }
332         case '\\':
333             if (patternLen >= 2) {
334                 pattern++;
335                 patternLen--;
336             }
337             /* fall through */
338         default:
339             if (!nocase) {
340                 if (pattern[0] != string[0])
341                     return 0; /* no match */
342             } else {
343                 if (tolower((int)pattern[0]) != tolower((int)string[0]))
344                     return 0; /* no match */
345             }
346             string++;
347             stringLen--;
348             break;
349         }
350         pattern++;
351         patternLen--;
352         if (stringLen == 0) {
353             while(*pattern == '*') {
354                 pattern++;
355                 patternLen--;
356             }
357             break;
358         }
359     }
360     if (patternLen == 0 && stringLen == 0)
361         return 1;
362     return 0;
363 }
364
365 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
366         int nocase)
367 {
368     unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
369
370     if (nocase == 0) {
371         while(l1 && l2) {
372             if (*u1 != *u2)
373                 return (int)*u1-*u2;
374             u1++; u2++; l1--; l2--;
375         }
376         if (!l1 && !l2) return 0;
377         return l1-l2;
378     } else {
379         while(l1 && l2) {
380             if (tolower((int)*u1) != tolower((int)*u2))
381                 return tolower((int)*u1)-tolower((int)*u2);
382             u1++; u2++; l1--; l2--;
383         }
384         if (!l1 && !l2) return 0;
385         return l1-l2;
386     }
387 }
388
389 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
390  * The index of the first occurrence of s1 in s2 is returned. 
391  * If s1 is not found inside s2, -1 is returned. */
392 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
393 {
394     int i;
395
396     if (!l1 || !l2 || l1 > l2) return -1;
397     if (index < 0) index = 0;
398     s2 += index;
399     for (i = index; i <= l2-l1; i++) {
400         if (memcmp(s2, s1, l1) == 0)
401             return i;
402         s2++;
403     }
404     return -1;
405 }
406
407 int Jim_WideToString(char *buf, jim_wide wideValue)
408 {
409     const char *fmt = "%" JIM_WIDE_MODIFIER;
410     return sprintf(buf, fmt, wideValue);
411 }
412
413 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
414 {
415     char *endptr;
416
417 #ifdef HAVE_LONG_LONG
418     *widePtr = JimStrtoll(str, &endptr, base);
419 #else
420     *widePtr = strtol(str, &endptr, base);
421 #endif
422     if ((str[0] == '\0') || (str == endptr) )
423         return JIM_ERR;
424     if (endptr[0] != '\0') {
425         while(*endptr) {
426             if (!isspace((int)*endptr))
427                 return JIM_ERR;
428             endptr++;
429         }
430     }
431     return JIM_OK;
432 }
433
434 int Jim_StringToIndex(const char *str, int *intPtr)
435 {
436     char *endptr;
437
438     *intPtr = strtol(str, &endptr, 10);
439     if ( (str[0] == '\0') || (str == endptr) )
440         return JIM_ERR;
441     if (endptr[0] != '\0') {
442         while(*endptr) {
443             if (!isspace((int)*endptr))
444                 return JIM_ERR;
445             endptr++;
446         }
447     }
448     return JIM_OK;
449 }
450
451 /* The string representation of references has two features in order
452  * to make the GC faster. The first is that every reference starts
453  * with a non common character '~', in order to make the string matching
454  * fater. The second is that the reference string rep his 32 characters
455  * in length, this allows to avoid to check every object with a string
456  * repr < 32, and usually there are many of this objects. */
457
458 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
459
460 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
461 {
462     const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
463     sprintf(buf, fmt, refPtr->tag, id);
464     return JIM_REFERENCE_SPACE;
465 }
466
467 int Jim_DoubleToString(char *buf, double doubleValue)
468 {
469     char *s;
470     int len;
471
472     len = sprintf(buf, "%.17g", doubleValue);
473     s = buf;
474     while(*s) {
475         if (*s == '.') return len;
476         s++;
477     }
478     /* Add a final ".0" if it's a number. But not
479      * for NaN or InF */
480     if (isdigit((int)buf[0])
481         || ((buf[0] == '-' || buf[0] == '+')
482             && isdigit((int)buf[1]))) {
483         s[0] = '.';
484         s[1] = '0';
485         s[2] = '\0';
486         return len+2;
487     }
488     return len;
489 }
490
491 int Jim_StringToDouble(const char *str, double *doublePtr)
492 {
493     char *endptr;
494
495     *doublePtr = strtod(str, &endptr);
496     if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
497         return JIM_ERR;
498     return JIM_OK;
499 }
500
501 static jim_wide JimPowWide(jim_wide b, jim_wide e)
502 {
503     jim_wide i, res = 1;
504     if ((b==0 && e!=0) || (e<0)) return 0;
505     for(i=0; i<e; i++) {res *= b;}
506     return res;
507 }
508
509 /* -----------------------------------------------------------------------------
510  * Special functions
511  * ---------------------------------------------------------------------------*/
512
513 /* Note that 'interp' may be NULL if not available in the
514  * context of the panic. It's only useful to get the error
515  * file descriptor, it will default to stderr otherwise. */
516 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
517 {
518     va_list ap;
519
520     va_start(ap, fmt);
521         /* 
522          * Send it here first.. Assuming STDIO still works
523          */
524     fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
525     vfprintf(stderr, fmt, ap);
526     fprintf(stderr, JIM_NL JIM_NL);
527     va_end(ap);
528
529 #ifdef HAVE_BACKTRACE
530     {
531         void *array[40];
532         int size, i;
533         char **strings;
534
535         size = backtrace(array, 40);
536         strings = backtrace_symbols(array, size);
537         for (i = 0; i < size; i++)
538             fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
539         fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
540         fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
541     }
542 #endif
543         
544         /* This may actually crash... we do it last */
545         if( interp && interp->cookie_stderr ){
546                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
547                 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
548                 Jim_fprintf(  interp, interp->cookie_stderr, JIM_NL JIM_NL );
549         }
550     abort();
551 }
552
553 /* -----------------------------------------------------------------------------
554  * Memory allocation
555  * ---------------------------------------------------------------------------*/
556
557 /* Macro used for memory debugging.
558  * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
559  * and similary for Jim_Realloc and Jim_Free */
560 #if 0
561 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
562 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
563 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
564 #endif
565
566 void *Jim_Alloc(int size)
567 {
568         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
569         if (size==0)
570                 size=1;
571     void *p = malloc(size);
572     if (p == NULL)
573         Jim_Panic(NULL,"malloc: Out of memory");
574     return p;
575 }
576
577 void Jim_Free(void *ptr) {
578     free(ptr);
579 }
580
581 void *Jim_Realloc(void *ptr, int size)
582 {
583         /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
584         if (size==0)
585                 size=1;
586     void *p = realloc(ptr, size);
587     if (p == NULL)
588         Jim_Panic(NULL,"realloc: Out of memory");
589     return p;
590 }
591
592 char *Jim_StrDup(const char *s)
593 {
594     int l = strlen(s);
595     char *copy = Jim_Alloc(l+1);
596
597     memcpy(copy, s, l+1);
598     return copy;
599 }
600
601 char *Jim_StrDupLen(const char *s, int l)
602 {
603     char *copy = Jim_Alloc(l+1);
604     
605     memcpy(copy, s, l+1);
606     copy[l] = 0;    /* Just to be sure, original could be substring */
607     return copy;
608 }
609
610 /* -----------------------------------------------------------------------------
611  * Time related functions
612  * ---------------------------------------------------------------------------*/
613 /* Returns microseconds of CPU used since start. */
614 static jim_wide JimClock(void)
615 {
616 #if (defined WIN32) && !(defined JIM_ANSIC)
617     LARGE_INTEGER t, f;
618     QueryPerformanceFrequency(&f);
619     QueryPerformanceCounter(&t);
620     return (long)((t.QuadPart * 1000000) / f.QuadPart);
621 #else /* !WIN32 */
622     clock_t clocks = clock();
623
624     return (long)(clocks*(1000000/CLOCKS_PER_SEC));
625 #endif /* WIN32 */
626 }
627
628 /* -----------------------------------------------------------------------------
629  * Hash Tables
630  * ---------------------------------------------------------------------------*/
631
632 /* -------------------------- private prototypes ---------------------------- */
633 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
634 static unsigned int JimHashTableNextPower(unsigned int size);
635 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
636
637 /* -------------------------- hash functions -------------------------------- */
638
639 /* Thomas Wang's 32 bit Mix Function */
640 unsigned int Jim_IntHashFunction(unsigned int key)
641 {
642     key += ~(key << 15);
643     key ^=  (key >> 10);
644     key +=  (key << 3);
645     key ^=  (key >> 6);
646     key += ~(key << 11);
647     key ^=  (key >> 16);
648     return key;
649 }
650
651 /* Identity hash function for integer keys */
652 unsigned int Jim_IdentityHashFunction(unsigned int key)
653 {
654     return key;
655 }
656
657 /* Generic hash function (we are using to multiply by 9 and add the byte
658  * as Tcl) */
659 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
660 {
661     unsigned int h = 0;
662     while(len--)
663         h += (h<<3)+*buf++;
664     return h;
665 }
666
667 /* ----------------------------- API implementation ------------------------- */
668 /* reset an hashtable already initialized with ht_init().
669  * NOTE: This function should only called by ht_destroy(). */
670 static void JimResetHashTable(Jim_HashTable *ht)
671 {
672     ht->table = NULL;
673     ht->size = 0;
674     ht->sizemask = 0;
675     ht->used = 0;
676     ht->collisions = 0;
677 }
678
679 /* Initialize the hash table */
680 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
681         void *privDataPtr)
682 {
683     JimResetHashTable(ht);
684     ht->type = type;
685     ht->privdata = privDataPtr;
686     return JIM_OK;
687 }
688
689 /* Resize the table to the minimal size that contains all the elements,
690  * but with the invariant of a USER/BUCKETS ration near to <= 1 */
691 int Jim_ResizeHashTable(Jim_HashTable *ht)
692 {
693     int minimal = ht->used;
694
695     if (minimal < JIM_HT_INITIAL_SIZE)
696         minimal = JIM_HT_INITIAL_SIZE;
697     return Jim_ExpandHashTable(ht, minimal);
698 }
699
700 /* Expand or create the hashtable */
701 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
702 {
703     Jim_HashTable n; /* the new hashtable */
704     unsigned int realsize = JimHashTableNextPower(size), i;
705
706     /* the size is invalid if it is smaller than the number of
707      * elements already inside the hashtable */
708     if (ht->used >= size)
709         return JIM_ERR;
710
711     Jim_InitHashTable(&n, ht->type, ht->privdata);
712     n.size = realsize;
713     n.sizemask = realsize-1;
714     n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
715
716     /* Initialize all the pointers to NULL */
717     memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
718
719     /* Copy all the elements from the old to the new table:
720      * note that if the old hash table is empty ht->size is zero,
721      * so Jim_ExpandHashTable just creates an hash table. */
722     n.used = ht->used;
723     for (i = 0; i < ht->size && ht->used > 0; i++) {
724         Jim_HashEntry *he, *nextHe;
725
726         if (ht->table[i] == NULL) continue;
727         
728         /* For each hash entry on this slot... */
729         he = ht->table[i];
730         while(he) {
731             unsigned int h;
732
733             nextHe = he->next;
734             /* Get the new element index */
735             h = Jim_HashKey(ht, he->key) & n.sizemask;
736             he->next = n.table[h];
737             n.table[h] = he;
738             ht->used--;
739             /* Pass to the next element */
740             he = nextHe;
741         }
742     }
743     assert(ht->used == 0);
744     Jim_Free(ht->table);
745
746     /* Remap the new hashtable in the old */
747     *ht = n;
748     return JIM_OK;
749 }
750
751 /* Add an element to the target hash table */
752 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
753 {
754     int index;
755     Jim_HashEntry *entry;
756
757     /* Get the index of the new element, or -1 if
758      * the element already exists. */
759     if ((index = JimInsertHashEntry(ht, key)) == -1)
760         return JIM_ERR;
761
762     /* Allocates the memory and stores key */
763     entry = Jim_Alloc(sizeof(*entry));
764     entry->next = ht->table[index];
765     ht->table[index] = entry;
766
767     /* Set the hash entry fields. */
768     Jim_SetHashKey(ht, entry, key);
769     Jim_SetHashVal(ht, entry, val);
770     ht->used++;
771     return JIM_OK;
772 }
773
774 /* Add an element, discarding the old if the key already exists */
775 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
776 {
777     Jim_HashEntry *entry;
778
779     /* Try to add the element. If the key
780      * does not exists Jim_AddHashEntry will suceed. */
781     if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
782         return JIM_OK;
783     /* It already exists, get the entry */
784     entry = Jim_FindHashEntry(ht, key);
785     /* Free the old value and set the new one */
786     Jim_FreeEntryVal(ht, entry);
787     Jim_SetHashVal(ht, entry, val);
788     return JIM_OK;
789 }
790
791 /* Search and remove an element */
792 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
793 {
794     unsigned int h;
795     Jim_HashEntry *he, *prevHe;
796
797     if (ht->size == 0)
798         return JIM_ERR;
799     h = Jim_HashKey(ht, key) & ht->sizemask;
800     he = ht->table[h];
801
802     prevHe = NULL;
803     while(he) {
804         if (Jim_CompareHashKeys(ht, key, he->key)) {
805             /* Unlink the element from the list */
806             if (prevHe)
807                 prevHe->next = he->next;
808             else
809                 ht->table[h] = he->next;
810             Jim_FreeEntryKey(ht, he);
811             Jim_FreeEntryVal(ht, he);
812             Jim_Free(he);
813             ht->used--;
814             return JIM_OK;
815         }
816         prevHe = he;
817         he = he->next;
818     }
819     return JIM_ERR; /* not found */
820 }
821
822 /* Destroy an entire hash table */
823 int Jim_FreeHashTable(Jim_HashTable *ht)
824 {
825     unsigned int i;
826
827     /* Free all the elements */
828     for (i = 0; i < ht->size && ht->used > 0; i++) {
829         Jim_HashEntry *he, *nextHe;
830
831         if ((he = ht->table[i]) == NULL) continue;
832         while(he) {
833             nextHe = he->next;
834             Jim_FreeEntryKey(ht, he);
835             Jim_FreeEntryVal(ht, he);
836             Jim_Free(he);
837             ht->used--;
838             he = nextHe;
839         }
840     }
841     /* Free the table and the allocated cache structure */
842     Jim_Free(ht->table);
843     /* Re-initialize the table */
844     JimResetHashTable(ht);
845     return JIM_OK; /* never fails */
846 }
847
848 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
849 {
850     Jim_HashEntry *he;
851     unsigned int h;
852
853     if (ht->size == 0) return NULL;
854     h = Jim_HashKey(ht, key) & ht->sizemask;
855     he = ht->table[h];
856     while(he) {
857         if (Jim_CompareHashKeys(ht, key, he->key))
858             return he;
859         he = he->next;
860     }
861     return NULL;
862 }
863
864 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
865 {
866     Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
867
868     iter->ht = ht;
869     iter->index = -1;
870     iter->entry = NULL;
871     iter->nextEntry = NULL;
872     return iter;
873 }
874
875 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
876 {
877     while (1) {
878         if (iter->entry == NULL) {
879             iter->index++;
880             if (iter->index >=
881                     (signed)iter->ht->size) break;
882             iter->entry = iter->ht->table[iter->index];
883         } else {
884             iter->entry = iter->nextEntry;
885         }
886         if (iter->entry) {
887             /* We need to save the 'next' here, the iterator user
888              * may delete the entry we are returning. */
889             iter->nextEntry = iter->entry->next;
890             return iter->entry;
891         }
892     }
893     return NULL;
894 }
895
896 /* ------------------------- private functions ------------------------------ */
897
898 /* Expand the hash table if needed */
899 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
900 {
901     /* If the hash table is empty expand it to the intial size,
902      * if the table is "full" dobule its size. */
903     if (ht->size == 0)
904         return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
905     if (ht->size == ht->used)
906         return Jim_ExpandHashTable(ht, ht->size*2);
907     return JIM_OK;
908 }
909
910 /* Our hash table capability is a power of two */
911 static unsigned int JimHashTableNextPower(unsigned int size)
912 {
913     unsigned int i = JIM_HT_INITIAL_SIZE;
914
915     if (size >= 2147483648U)
916         return 2147483648U;
917     while(1) {
918         if (i >= size)
919             return i;
920         i *= 2;
921     }
922 }
923
924 /* Returns the index of a free slot that can be populated with
925  * an hash entry for the given 'key'.
926  * If the key already exists, -1 is returned. */
927 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
928 {
929     unsigned int h;
930     Jim_HashEntry *he;
931
932     /* Expand the hashtable if needed */
933     if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
934         return -1;
935     /* Compute the key hash value */
936     h = Jim_HashKey(ht, key) & ht->sizemask;
937     /* Search if this slot does not already contain the given key */
938     he = ht->table[h];
939     while(he) {
940         if (Jim_CompareHashKeys(ht, key, he->key))
941             return -1;
942         he = he->next;
943     }
944     return h;
945 }
946
947 /* ----------------------- StringCopy Hash Table Type ------------------------*/
948
949 static unsigned int JimStringCopyHTHashFunction(const void *key)
950 {
951     return Jim_GenHashFunction(key, strlen(key));
952 }
953
954 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
955 {
956     int len = strlen(key);
957     char *copy = Jim_Alloc(len+1);
958     JIM_NOTUSED(privdata);
959
960     memcpy(copy, key, len);
961     copy[len] = '\0';
962     return copy;
963 }
964
965 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
966 {
967     int len = strlen(val);
968     char *copy = Jim_Alloc(len+1);
969     JIM_NOTUSED(privdata);
970
971     memcpy(copy, val, len);
972     copy[len] = '\0';
973     return copy;
974 }
975
976 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
977         const void *key2)
978 {
979     JIM_NOTUSED(privdata);
980
981     return strcmp(key1, key2) == 0;
982 }
983
984 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
985 {
986     JIM_NOTUSED(privdata);
987
988     Jim_Free((void*)key); /* ATTENTION: const cast */
989 }
990
991 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
992 {
993     JIM_NOTUSED(privdata);
994
995     Jim_Free((void*)val); /* ATTENTION: const cast */
996 }
997
998 static Jim_HashTableType JimStringCopyHashTableType = {
999     JimStringCopyHTHashFunction,        /* hash function */
1000     JimStringCopyHTKeyDup,              /* key dup */
1001     NULL,                               /* val dup */
1002     JimStringCopyHTKeyCompare,          /* key compare */
1003     JimStringCopyHTKeyDestructor,       /* key destructor */
1004     NULL                                /* val destructor */
1005 };
1006
1007 /* This is like StringCopy but does not auto-duplicate the key.
1008  * It's used for intepreter's shared strings. */
1009 static Jim_HashTableType JimSharedStringsHashTableType = {
1010     JimStringCopyHTHashFunction,        /* hash function */
1011     NULL,                               /* key dup */
1012     NULL,                               /* val dup */
1013     JimStringCopyHTKeyCompare,          /* key compare */
1014     JimStringCopyHTKeyDestructor,       /* key destructor */
1015     NULL                                /* val destructor */
1016 };
1017
1018 /* This is like StringCopy but also automatically handle dynamic
1019  * allocated C strings as values. */
1020 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1021     JimStringCopyHTHashFunction,        /* hash function */
1022     JimStringCopyHTKeyDup,              /* key dup */
1023     JimStringKeyValCopyHTValDup,        /* val dup */
1024     JimStringCopyHTKeyCompare,          /* key compare */
1025     JimStringCopyHTKeyDestructor,       /* key destructor */
1026     JimStringKeyValCopyHTValDestructor, /* val destructor */
1027 };
1028
1029 typedef struct AssocDataValue {
1030     Jim_InterpDeleteProc *delProc;
1031     void *data;
1032 } AssocDataValue;
1033
1034 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1035 {
1036     AssocDataValue *assocPtr = (AssocDataValue *)data;
1037     if (assocPtr->delProc != NULL)
1038         assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1039     Jim_Free(data);
1040 }
1041
1042 static Jim_HashTableType JimAssocDataHashTableType = {
1043     JimStringCopyHTHashFunction,         /* hash function */
1044     JimStringCopyHTKeyDup,               /* key dup */
1045     NULL,                                /* val dup */
1046     JimStringCopyHTKeyCompare,           /* key compare */
1047     JimStringCopyHTKeyDestructor,        /* key destructor */
1048     JimAssocDataHashTableValueDestructor /* val destructor */
1049 };
1050
1051 /* -----------------------------------------------------------------------------
1052  * Stack - This is a simple generic stack implementation. It is used for
1053  * example in the 'expr' expression compiler.
1054  * ---------------------------------------------------------------------------*/
1055 void Jim_InitStack(Jim_Stack *stack)
1056 {
1057     stack->len = 0;
1058     stack->maxlen = 0;
1059     stack->vector = NULL;
1060 }
1061
1062 void Jim_FreeStack(Jim_Stack *stack)
1063 {
1064     Jim_Free(stack->vector);
1065 }
1066
1067 int Jim_StackLen(Jim_Stack *stack)
1068 {
1069     return stack->len;
1070 }
1071
1072 void Jim_StackPush(Jim_Stack *stack, void *element) {
1073     int neededLen = stack->len+1;
1074     if (neededLen > stack->maxlen) {
1075         stack->maxlen = neededLen*2;
1076         stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1077     }
1078     stack->vector[stack->len] = element;
1079     stack->len++;
1080 }
1081
1082 void *Jim_StackPop(Jim_Stack *stack)
1083 {
1084     if (stack->len == 0) return NULL;
1085     stack->len--;
1086     return stack->vector[stack->len];
1087 }
1088
1089 void *Jim_StackPeek(Jim_Stack *stack)
1090 {
1091     if (stack->len == 0) return NULL;
1092     return stack->vector[stack->len-1];
1093 }
1094
1095 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1096 {
1097     int i;
1098
1099     for (i = 0; i < stack->len; i++)
1100         freeFunc(stack->vector[i]);
1101 }
1102
1103 /* -----------------------------------------------------------------------------
1104  * Parser
1105  * ---------------------------------------------------------------------------*/
1106
1107 /* Token types */
1108 #define JIM_TT_NONE -1        /* No token returned */
1109 #define JIM_TT_STR 0        /* simple string */
1110 #define JIM_TT_ESC 1        /* string that needs escape chars conversion */
1111 #define JIM_TT_VAR 2        /* var substitution */
1112 #define JIM_TT_DICTSUGAR 3    /* Syntax sugar for [dict get], $foo(bar) */
1113 #define JIM_TT_CMD 4        /* command substitution */
1114 #define JIM_TT_SEP 5        /* word separator */
1115 #define JIM_TT_EOL 6        /* line separator */
1116
1117 /* Additional token types needed for expressions */
1118 #define JIM_TT_SUBEXPR_START 7
1119 #define JIM_TT_SUBEXPR_END 8
1120 #define JIM_TT_EXPR_NUMBER 9
1121 #define JIM_TT_EXPR_OPERATOR 10
1122
1123 /* Parser states */
1124 #define JIM_PS_DEF 0        /* Default state */
1125 #define JIM_PS_QUOTE 1        /* Inside "" */
1126
1127 /* Parser context structure. The same context is used both to parse
1128  * Tcl scripts and lists. */
1129 struct JimParserCtx {
1130     const char *prg;     /* Program text */
1131     const char *p;       /* Pointer to the point of the program we are parsing */
1132     int len;             /* Left length of 'prg' */
1133     int linenr;          /* Current line number */
1134     const char *tstart;
1135     const char *tend;    /* Returned token is at tstart-tend in 'prg'. */
1136     int tline;           /* Line number of the returned token */
1137     int tt;              /* Token type */
1138     int eof;             /* Non zero if EOF condition is true. */
1139     int state;           /* Parser state */
1140     int comment;         /* Non zero if the next chars may be a comment. */
1141 };
1142
1143 #define JimParserEof(c) ((c)->eof)
1144 #define JimParserTstart(c) ((c)->tstart)
1145 #define JimParserTend(c) ((c)->tend)
1146 #define JimParserTtype(c) ((c)->tt)
1147 #define JimParserTline(c) ((c)->tline)
1148
1149 static int JimParseScript(struct JimParserCtx *pc);
1150 static int JimParseSep(struct JimParserCtx *pc);
1151 static int JimParseEol(struct JimParserCtx *pc);
1152 static int JimParseCmd(struct JimParserCtx *pc);
1153 static int JimParseVar(struct JimParserCtx *pc);
1154 static int JimParseBrace(struct JimParserCtx *pc);
1155 static int JimParseStr(struct JimParserCtx *pc);
1156 static int JimParseComment(struct JimParserCtx *pc);
1157 static char *JimParserGetToken(struct JimParserCtx *pc,
1158         int *lenPtr, int *typePtr, int *linePtr);
1159
1160 /* Initialize a parser context.
1161  * 'prg' is a pointer to the program text, linenr is the line
1162  * number of the first line contained in the program. */
1163 void JimParserInit(struct JimParserCtx *pc, const char *prg, 
1164         int len, int linenr)
1165 {
1166     pc->prg = prg;
1167     pc->p = prg;
1168     pc->len = len;
1169     pc->tstart = NULL;
1170     pc->tend = NULL;
1171     pc->tline = 0;
1172     pc->tt = JIM_TT_NONE;
1173     pc->eof = 0;
1174     pc->state = JIM_PS_DEF;
1175     pc->linenr = linenr;
1176     pc->comment = 1;
1177 }
1178
1179 int JimParseScript(struct JimParserCtx *pc)
1180 {
1181     while(1) { /* the while is used to reiterate with continue if needed */
1182         if (!pc->len) {
1183             pc->tstart = pc->p;
1184             pc->tend = pc->p-1;
1185             pc->tline = pc->linenr;
1186             pc->tt = JIM_TT_EOL;
1187             pc->eof = 1;
1188             return JIM_OK;
1189         }
1190         switch(*(pc->p)) {
1191         case '\\':
1192             if (*(pc->p+1) == '\n')
1193                 return JimParseSep(pc);
1194             else {
1195                 pc->comment = 0;
1196                 return JimParseStr(pc);
1197             }
1198             break;
1199         case ' ':
1200         case '\t':
1201         case '\r':
1202             if (pc->state == JIM_PS_DEF)
1203                 return JimParseSep(pc);
1204             else {
1205                 pc->comment = 0;
1206                 return JimParseStr(pc);
1207             }
1208             break;
1209         case '\n':
1210         case ';':
1211             pc->comment = 1;
1212             if (pc->state == JIM_PS_DEF)
1213                 return JimParseEol(pc);
1214             else
1215                 return JimParseStr(pc);
1216             break;
1217         case '[':
1218             pc->comment = 0;
1219             return JimParseCmd(pc);
1220             break;
1221         case '$':
1222             pc->comment = 0;
1223             if (JimParseVar(pc) == JIM_ERR) {
1224                 pc->tstart = pc->tend = pc->p++; pc->len--;
1225                 pc->tline = pc->linenr;
1226                 pc->tt = JIM_TT_STR;
1227                 return JIM_OK;
1228             } else
1229                 return JIM_OK;
1230             break;
1231         case '#':
1232             if (pc->comment) {
1233                 JimParseComment(pc);
1234                 continue;
1235             } else {
1236                 return JimParseStr(pc);
1237             }
1238         default:
1239             pc->comment = 0;
1240             return JimParseStr(pc);
1241             break;
1242         }
1243         return JIM_OK;
1244     }
1245 }
1246
1247 int JimParseSep(struct JimParserCtx *pc)
1248 {
1249     pc->tstart = pc->p;
1250     pc->tline = pc->linenr;
1251     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1252            (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1253         if (*pc->p == '\\') {
1254             pc->p++; pc->len--;
1255             pc->linenr++;
1256         }
1257         pc->p++; pc->len--;
1258     }
1259     pc->tend = pc->p-1;
1260     pc->tt = JIM_TT_SEP;
1261     return JIM_OK;
1262 }
1263
1264 int JimParseEol(struct JimParserCtx *pc)
1265 {
1266     pc->tstart = pc->p;
1267     pc->tline = pc->linenr;
1268     while (*pc->p == ' ' || *pc->p == '\n' ||
1269            *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1270         if (*pc->p == '\n')
1271             pc->linenr++;
1272         pc->p++; pc->len--;
1273     }
1274     pc->tend = pc->p-1;
1275     pc->tt = JIM_TT_EOL;
1276     return JIM_OK;
1277 }
1278
1279 /* Todo. Don't stop if ']' appears inside {} or quoted.
1280  * Also should handle the case of puts [string length "]"] */
1281 int JimParseCmd(struct JimParserCtx *pc)
1282 {
1283     int level = 1;
1284     int blevel = 0;
1285
1286     pc->tstart = ++pc->p; pc->len--;
1287     pc->tline = pc->linenr;
1288     while (1) {
1289         if (pc->len == 0) {
1290             break;
1291         } else if (*pc->p == '[' && blevel == 0) {
1292             level++;
1293         } else if (*pc->p == ']' && blevel == 0) {
1294             level--;
1295             if (!level) break;
1296         } else if (*pc->p == '\\') {
1297             pc->p++; pc->len--;
1298         } else if (*pc->p == '{') {
1299             blevel++;
1300         } else if (*pc->p == '}') {
1301             if (blevel != 0)
1302                 blevel--;
1303         } else if (*pc->p == '\n')
1304             pc->linenr++;
1305         pc->p++; pc->len--;
1306     }
1307     pc->tend = pc->p-1;
1308     pc->tt = JIM_TT_CMD;
1309     if (*pc->p == ']') {
1310         pc->p++; pc->len--;
1311     }
1312     return JIM_OK;
1313 }
1314
1315 int JimParseVar(struct JimParserCtx *pc)
1316 {
1317     int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1318
1319     pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1320     pc->tline = pc->linenr;
1321     if (*pc->p == '{') {
1322         pc->tstart = ++pc->p; pc->len--;
1323         brace = 1;
1324     }
1325     if (brace) {
1326         while (!stop) {
1327             if (*pc->p == '}' || pc->len == 0) {
1328                 stop = 1;
1329                 if (pc->len == 0)
1330                     continue;
1331             }
1332             else if (*pc->p == '\n')
1333                 pc->linenr++;
1334             pc->p++; pc->len--;
1335         }
1336         if (pc->len == 0)
1337             pc->tend = pc->p-1;
1338         else
1339             pc->tend = pc->p-2;
1340     } else {
1341         while (!stop) {
1342             if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1343                 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1344                 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1345                 stop = 1;
1346             else {
1347                 pc->p++; pc->len--;
1348             }
1349         }
1350         /* Parse [dict get] syntax sugar. */
1351         if (*pc->p == '(') {
1352             while (*pc->p != ')' && pc->len) {
1353                 pc->p++; pc->len--;
1354                 if (*pc->p == '\\' && pc->len >= 2) {
1355                     pc->p += 2; pc->len -= 2;
1356                 }
1357             }
1358             if (*pc->p != '\0') {
1359                 pc->p++; pc->len--;
1360             }
1361             ttype = JIM_TT_DICTSUGAR;
1362         }
1363         pc->tend = pc->p-1;
1364     }
1365     /* Check if we parsed just the '$' character.
1366      * That's not a variable so an error is returned
1367      * to tell the state machine to consider this '$' just
1368      * a string. */
1369     if (pc->tstart == pc->p) {
1370         pc->p--; pc->len++;
1371         return JIM_ERR;
1372     }
1373     pc->tt = ttype;
1374     return JIM_OK;
1375 }
1376
1377 int JimParseBrace(struct JimParserCtx *pc)
1378 {
1379     int level = 1;
1380
1381     pc->tstart = ++pc->p; pc->len--;
1382     pc->tline = pc->linenr;
1383     while (1) {
1384         if (*pc->p == '\\' && pc->len >= 2) {
1385             pc->p++; pc->len--;
1386             if (*pc->p == '\n')
1387                 pc->linenr++;
1388         } else if (*pc->p == '{') {
1389             level++;
1390         } else if (pc->len == 0 || *pc->p == '}') {
1391             level--;
1392             if (pc->len == 0 || level == 0) {
1393                 pc->tend = pc->p-1;
1394                 if (pc->len != 0) {
1395                     pc->p++; pc->len--;
1396                 }
1397                 pc->tt = JIM_TT_STR;
1398                 return JIM_OK;
1399             }
1400         } else if (*pc->p == '\n') {
1401             pc->linenr++;
1402         }
1403         pc->p++; pc->len--;
1404     }
1405     return JIM_OK; /* unreached */
1406 }
1407
1408 int JimParseStr(struct JimParserCtx *pc)
1409 {
1410     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1411             pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1412     if (newword && *pc->p == '{') {
1413         return JimParseBrace(pc);
1414     } else if (newword && *pc->p == '"') {
1415         pc->state = JIM_PS_QUOTE;
1416         pc->p++; pc->len--;
1417     }
1418     pc->tstart = pc->p;
1419     pc->tline = pc->linenr;
1420     while (1) {
1421         if (pc->len == 0) {
1422             pc->tend = pc->p-1;
1423             pc->tt = JIM_TT_ESC;
1424             return JIM_OK;
1425         }
1426         switch(*pc->p) {
1427         case '\\':
1428             if (pc->state == JIM_PS_DEF &&
1429                 *(pc->p+1) == '\n') {
1430                 pc->tend = pc->p-1;
1431                 pc->tt = JIM_TT_ESC;
1432                 return JIM_OK;
1433             }
1434             if (pc->len >= 2) {
1435                 pc->p++; pc->len--;
1436             }
1437             break;
1438         case '$':
1439         case '[':
1440             pc->tend = pc->p-1;
1441             pc->tt = JIM_TT_ESC;
1442             return JIM_OK;
1443         case ' ':
1444         case '\t':
1445         case '\n':
1446         case '\r':
1447         case ';':
1448             if (pc->state == JIM_PS_DEF) {
1449                 pc->tend = pc->p-1;
1450                 pc->tt = JIM_TT_ESC;
1451                 return JIM_OK;
1452             } else if (*pc->p == '\n') {
1453                 pc->linenr++;
1454             }
1455             break;
1456         case '"':
1457             if (pc->state == JIM_PS_QUOTE) {
1458                 pc->tend = pc->p-1;
1459                 pc->tt = JIM_TT_ESC;
1460                 pc->p++; pc->len--;
1461                 pc->state = JIM_PS_DEF;
1462                 return JIM_OK;
1463             }
1464             break;
1465         }
1466         pc->p++; pc->len--;
1467     }
1468     return JIM_OK; /* unreached */
1469 }
1470
1471 int JimParseComment(struct JimParserCtx *pc)
1472 {
1473     while (*pc->p) {
1474         if (*pc->p == '\n') {
1475             pc->linenr++;
1476             if (*(pc->p-1) != '\\') {
1477                 pc->p++; pc->len--;
1478                 return JIM_OK;
1479             }
1480         }
1481         pc->p++; pc->len--;
1482     }
1483     return JIM_OK;
1484 }
1485
1486 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1487 static int xdigitval(int c)
1488 {
1489     if (c >= '0' && c <= '9') return c-'0';
1490     if (c >= 'a' && c <= 'f') return c-'a'+10;
1491     if (c >= 'A' && c <= 'F') return c-'A'+10;
1492     return -1;
1493 }
1494
1495 static int odigitval(int c)
1496 {
1497     if (c >= '0' && c <= '7') return c-'0';
1498     return -1;
1499 }
1500
1501 /* Perform Tcl escape substitution of 's', storing the result
1502  * string into 'dest'. The escaped string is guaranteed to
1503  * be the same length or shorted than the source string.
1504  * Slen is the length of the string at 's', if it's -1 the string
1505  * length will be calculated by the function.
1506  *
1507  * The function returns the length of the resulting string. */
1508 static int JimEscape(char *dest, const char *s, int slen)
1509 {
1510     char *p = dest;
1511     int i, len;
1512     
1513     if (slen == -1)
1514         slen = strlen(s);
1515
1516     for (i = 0; i < slen; i++) {
1517         switch(s[i]) {
1518         case '\\':
1519             switch(s[i+1]) {
1520             case 'a': *p++ = 0x7; i++; break;
1521             case 'b': *p++ = 0x8; i++; break;
1522             case 'f': *p++ = 0xc; i++; break;
1523             case 'n': *p++ = 0xa; i++; break;
1524             case 'r': *p++ = 0xd; i++; break;
1525             case 't': *p++ = 0x9; i++; break;
1526             case 'v': *p++ = 0xb; i++; break;
1527             case '\0': *p++ = '\\'; i++; break;
1528             case '\n': *p++ = ' '; i++; break;
1529             default:
1530                   if (s[i+1] == 'x') {
1531                     int val = 0;
1532                     int c = xdigitval(s[i+2]);
1533                     if (c == -1) {
1534                         *p++ = 'x';
1535                         i++;
1536                         break;
1537                     }
1538                     val = c;
1539                     c = xdigitval(s[i+3]);
1540                     if (c == -1) {
1541                         *p++ = val;
1542                         i += 2;
1543                         break;
1544                     }
1545                     val = (val*16)+c;
1546                     *p++ = val;
1547                     i += 3;
1548                     break;
1549                   } else if (s[i+1] >= '0' && s[i+1] <= '7')
1550                   {
1551                     int val = 0;
1552                     int c = odigitval(s[i+1]);
1553                     val = c;
1554                     c = odigitval(s[i+2]);
1555                     if (c == -1) {
1556                         *p++ = val;
1557                         i ++;
1558                         break;
1559                     }
1560                     val = (val*8)+c;
1561                     c = odigitval(s[i+3]);
1562                     if (c == -1) {
1563                         *p++ = val;
1564                         i += 2;
1565                         break;
1566                     }
1567                     val = (val*8)+c;
1568                     *p++ = val;
1569                     i += 3;
1570                   } else {
1571                     *p++ = s[i+1];
1572                     i++;
1573                   }
1574                   break;
1575             }
1576             break;
1577         default:
1578             *p++ = s[i];
1579             break;
1580         }
1581     }
1582     len = p-dest;
1583     *p++ = '\0';
1584     return len;
1585 }
1586
1587 /* Returns a dynamically allocated copy of the current token in the
1588  * parser context. The function perform conversion of escapes if
1589  * the token is of type JIM_TT_ESC.
1590  *
1591  * Note that after the conversion, tokens that are grouped with
1592  * braces in the source code, are always recognizable from the
1593  * identical string obtained in a different way from the type.
1594  *
1595  * For exmple the string:
1596  *
1597  * {expand}$a
1598  * 
1599  * will return as first token "expand", of type JIM_TT_STR
1600  *
1601  * While the string:
1602  *
1603  * expand$a
1604  *
1605  * will return as first token "expand", of type JIM_TT_ESC
1606  */
1607 char *JimParserGetToken(struct JimParserCtx *pc,
1608         int *lenPtr, int *typePtr, int *linePtr)
1609 {
1610     const char *start, *end;
1611     char *token;
1612     int len;
1613
1614     start = JimParserTstart(pc);
1615     end = JimParserTend(pc);
1616     if (start > end) {
1617         if (lenPtr) *lenPtr = 0;
1618         if (typePtr) *typePtr = JimParserTtype(pc);
1619         if (linePtr) *linePtr = JimParserTline(pc);
1620         token = Jim_Alloc(1);
1621         token[0] = '\0';
1622         return token;
1623     }
1624     len = (end-start)+1;
1625     token = Jim_Alloc(len+1);
1626     if (JimParserTtype(pc) != JIM_TT_ESC) {
1627         /* No escape conversion needed? Just copy it. */
1628         memcpy(token, start, len);
1629         token[len] = '\0';
1630     } else {
1631         /* Else convert the escape chars. */
1632         len = JimEscape(token, start, len);
1633     }
1634     if (lenPtr) *lenPtr = len;
1635     if (typePtr) *typePtr = JimParserTtype(pc);
1636     if (linePtr) *linePtr = JimParserTline(pc);
1637     return token;
1638 }
1639
1640 /* The following functin is not really part of the parsing engine of Jim,
1641  * but it somewhat related. Given an string and its length, it tries
1642  * to guess if the script is complete or there are instead " " or { }
1643  * open and not completed. This is useful for interactive shells
1644  * implementation and for [info complete].
1645  *
1646  * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1647  * '{' on scripts incomplete missing one or more '}' to be balanced.
1648  * '"' on scripts incomplete missing a '"' char.
1649  *
1650  * If the script is complete, 1 is returned, otherwise 0. */
1651 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1652 {
1653     int level = 0;
1654     int state = ' ';
1655
1656     while(len) {
1657         switch (*s) {
1658             case '\\':
1659                 if (len > 1)
1660                     s++;
1661                 break;
1662             case '"':
1663                 if (state == ' ') {
1664                     state = '"';
1665                 } else if (state == '"') {
1666                     state = ' ';
1667                 }
1668                 break;
1669             case '{':
1670                 if (state == '{') {
1671                     level++;
1672                 } else if (state == ' ') {
1673                     state = '{';
1674                     level++;
1675                 }
1676                 break;
1677             case '}':
1678                 if (state == '{') {
1679                     level--;
1680                     if (level == 0)
1681                         state = ' ';
1682                 }
1683                 break;
1684         }
1685         s++;
1686         len--;
1687     }
1688     if (stateCharPtr)
1689         *stateCharPtr = state;
1690     return state == ' ';
1691 }
1692
1693 /* -----------------------------------------------------------------------------
1694  * Tcl Lists parsing
1695  * ---------------------------------------------------------------------------*/
1696 static int JimParseListSep(struct JimParserCtx *pc);
1697 static int JimParseListStr(struct JimParserCtx *pc);
1698
1699 int JimParseList(struct JimParserCtx *pc)
1700 {
1701     if (pc->len == 0) {
1702         pc->tstart = pc->tend = pc->p;
1703         pc->tline = pc->linenr;
1704         pc->tt = JIM_TT_EOL;
1705         pc->eof = 1;
1706         return JIM_OK;
1707     }
1708     switch(*pc->p) {
1709     case ' ':
1710     case '\n':
1711     case '\t':
1712     case '\r':
1713         if (pc->state == JIM_PS_DEF)
1714             return JimParseListSep(pc);
1715         else
1716             return JimParseListStr(pc);
1717         break;
1718     default:
1719         return JimParseListStr(pc);
1720         break;
1721     }
1722     return JIM_OK;
1723 }
1724
1725 int JimParseListSep(struct JimParserCtx *pc)
1726 {
1727     pc->tstart = pc->p;
1728     pc->tline = pc->linenr;
1729     while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1730     {
1731         pc->p++; pc->len--;
1732     }
1733     pc->tend = pc->p-1;
1734     pc->tt = JIM_TT_SEP;
1735     return JIM_OK;
1736 }
1737
1738 int JimParseListStr(struct JimParserCtx *pc)
1739 {
1740     int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1741             pc->tt == JIM_TT_NONE);
1742     if (newword && *pc->p == '{') {
1743         return JimParseBrace(pc);
1744     } else if (newword && *pc->p == '"') {
1745         pc->state = JIM_PS_QUOTE;
1746         pc->p++; pc->len--;
1747     }
1748     pc->tstart = pc->p;
1749     pc->tline = pc->linenr;
1750     while (1) {
1751         if (pc->len == 0) {
1752             pc->tend = pc->p-1;
1753             pc->tt = JIM_TT_ESC;
1754             return JIM_OK;
1755         }
1756         switch(*pc->p) {
1757         case '\\':
1758             pc->p++; pc->len--;
1759             break;
1760         case ' ':
1761         case '\t':
1762         case '\n':
1763         case '\r':
1764             if (pc->state == JIM_PS_DEF) {
1765                 pc->tend = pc->p-1;
1766                 pc->tt = JIM_TT_ESC;
1767                 return JIM_OK;
1768             } else if (*pc->p == '\n') {
1769                 pc->linenr++;
1770             }
1771             break;
1772         case '"':
1773             if (pc->state == JIM_PS_QUOTE) {
1774                 pc->tend = pc->p-1;
1775                 pc->tt = JIM_TT_ESC;
1776                 pc->p++; pc->len--;
1777                 pc->state = JIM_PS_DEF;
1778                 return JIM_OK;
1779             }
1780             break;
1781         }
1782         pc->p++; pc->len--;
1783     }
1784     return JIM_OK; /* unreached */
1785 }
1786
1787 /* -----------------------------------------------------------------------------
1788  * Jim_Obj related functions
1789  * ---------------------------------------------------------------------------*/
1790
1791 /* Return a new initialized object. */
1792 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1793 {
1794     Jim_Obj *objPtr;
1795
1796     /* -- Check if there are objects in the free list -- */
1797     if (interp->freeList != NULL) {
1798         /* -- Unlink the object from the free list -- */
1799         objPtr = interp->freeList;
1800         interp->freeList = objPtr->nextObjPtr;
1801     } else {
1802         /* -- No ready to use objects: allocate a new one -- */
1803         objPtr = Jim_Alloc(sizeof(*objPtr));
1804     }
1805
1806     /* Object is returned with refCount of 0. Every
1807      * kind of GC implemented should take care to don't try
1808      * to scan objects with refCount == 0. */
1809     objPtr->refCount = 0;
1810     /* All the other fields are left not initialized to save time.
1811      * The caller will probably want set they to the right
1812      * value anyway. */
1813
1814     /* -- Put the object into the live list -- */
1815     objPtr->prevObjPtr = NULL;
1816     objPtr->nextObjPtr = interp->liveList;
1817     if (interp->liveList)
1818         interp->liveList->prevObjPtr = objPtr;
1819     interp->liveList = objPtr;
1820
1821     return objPtr;
1822 }
1823
1824 /* Free an object. Actually objects are never freed, but
1825  * just moved to the free objects list, where they will be
1826  * reused by Jim_NewObj(). */
1827 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1828 {
1829     /* Check if the object was already freed, panic. */
1830     if (objPtr->refCount != 0)  {
1831         Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1832                 objPtr->refCount);
1833     }
1834     /* Free the internal representation */
1835     Jim_FreeIntRep(interp, objPtr);
1836     /* Free the string representation */
1837     if (objPtr->bytes != NULL) {
1838         if (objPtr->bytes != JimEmptyStringRep)
1839             Jim_Free(objPtr->bytes);
1840     }
1841     /* Unlink the object from the live objects list */
1842     if (objPtr->prevObjPtr)
1843         objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1844     if (objPtr->nextObjPtr)
1845         objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1846     if (interp->liveList == objPtr)
1847         interp->liveList = objPtr->nextObjPtr;
1848     /* Link the object into the free objects list */
1849     objPtr->prevObjPtr = NULL;
1850     objPtr->nextObjPtr = interp->freeList;
1851     if (interp->freeList)
1852         interp->freeList->prevObjPtr = objPtr;
1853     interp->freeList = objPtr;
1854     objPtr->refCount = -1;
1855 }
1856
1857 /* Invalidate the string representation of an object. */
1858 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1859 {
1860     if (objPtr->bytes != NULL) {
1861         if (objPtr->bytes != JimEmptyStringRep)
1862             Jim_Free(objPtr->bytes);
1863     }
1864     objPtr->bytes = NULL;
1865 }
1866
1867 #define Jim_SetStringRep(o, b, l) \
1868     do { (o)->bytes = b; (o)->length = l; } while (0)
1869
1870 /* Set the initial string representation for an object.
1871  * Does not try to free an old one. */
1872 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1873 {
1874     if (length == 0) {
1875         objPtr->bytes = JimEmptyStringRep;
1876         objPtr->length = 0;
1877     } else {
1878         objPtr->bytes = Jim_Alloc(length+1);
1879         objPtr->length = length;
1880         memcpy(objPtr->bytes, bytes, length);
1881         objPtr->bytes[length] = '\0';
1882     }
1883 }
1884
1885 /* Duplicate an object. The returned object has refcount = 0. */
1886 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1887 {
1888     Jim_Obj *dupPtr;
1889
1890     dupPtr = Jim_NewObj(interp);
1891     if (objPtr->bytes == NULL) {
1892         /* Object does not have a valid string representation. */
1893         dupPtr->bytes = NULL;
1894     } else {
1895         Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1896     }
1897     if (objPtr->typePtr != NULL) {
1898         if (objPtr->typePtr->dupIntRepProc == NULL) {
1899             dupPtr->internalRep = objPtr->internalRep;
1900         } else {
1901             objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1902         }
1903         dupPtr->typePtr = objPtr->typePtr;
1904     } else {
1905         dupPtr->typePtr = NULL;
1906     }
1907     return dupPtr;
1908 }
1909
1910 /* Return the string representation for objPtr. If the object
1911  * string representation is invalid, calls the method to create
1912  * a new one starting from the internal representation of the object. */
1913 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1914 {
1915     if (objPtr->bytes == NULL) {
1916         /* Invalid string repr. Generate it. */
1917         if (objPtr->typePtr->updateStringProc == NULL) {
1918             Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1919                 objPtr->typePtr->name);
1920         }
1921         objPtr->typePtr->updateStringProc(objPtr);
1922     }
1923     if (lenPtr)
1924         *lenPtr = objPtr->length;
1925     return objPtr->bytes;
1926 }
1927
1928 /* Just returns the length of the object's string rep */
1929 int Jim_Length(Jim_Obj *objPtr)
1930 {
1931     int len;
1932
1933     Jim_GetString(objPtr, &len);
1934     return len;
1935 }
1936
1937 /* -----------------------------------------------------------------------------
1938  * String Object
1939  * ---------------------------------------------------------------------------*/
1940 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1941 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1942
1943 static Jim_ObjType stringObjType = {
1944     "string",
1945     NULL,
1946     DupStringInternalRep,
1947     NULL,
1948     JIM_TYPE_REFERENCES,
1949 };
1950
1951 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1952 {
1953     JIM_NOTUSED(interp);
1954
1955     /* This is a bit subtle: the only caller of this function
1956      * should be Jim_DuplicateObj(), that will copy the
1957      * string representaion. After the copy, the duplicated
1958      * object will not have more room in teh buffer than
1959      * srcPtr->length bytes. So we just set it to length. */
1960     dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1961 }
1962
1963 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1964 {
1965     /* Get a fresh string representation. */
1966     (void) Jim_GetString(objPtr, NULL);
1967     /* Free any other internal representation. */
1968     Jim_FreeIntRep(interp, objPtr);
1969     /* Set it as string, i.e. just set the maxLength field. */
1970     objPtr->typePtr = &stringObjType;
1971     objPtr->internalRep.strValue.maxLength = objPtr->length;
1972     return JIM_OK;
1973 }
1974
1975 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1976 {
1977     Jim_Obj *objPtr = Jim_NewObj(interp);
1978
1979     if (len == -1)
1980         len = strlen(s);
1981     /* Alloc/Set the string rep. */
1982     if (len == 0) {
1983         objPtr->bytes = JimEmptyStringRep;
1984         objPtr->length = 0;
1985     } else {
1986         objPtr->bytes = Jim_Alloc(len+1);
1987         objPtr->length = len;
1988         memcpy(objPtr->bytes, s, len);
1989         objPtr->bytes[len] = '\0';
1990     }
1991
1992     /* No typePtr field for the vanilla string object. */
1993     objPtr->typePtr = NULL;
1994     return objPtr;
1995 }
1996
1997 /* This version does not try to duplicate the 's' pointer, but
1998  * use it directly. */
1999 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2000 {
2001     Jim_Obj *objPtr = Jim_NewObj(interp);
2002
2003     if (len == -1)
2004         len = strlen(s);
2005     Jim_SetStringRep(objPtr, s, len);
2006     objPtr->typePtr = NULL;
2007     return objPtr;
2008 }
2009
2010 /* Low-level string append. Use it only against objects
2011  * of type "string". */
2012 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2013 {
2014     int needlen;
2015
2016     if (len == -1)
2017         len = strlen(str);
2018     needlen = objPtr->length + len;
2019     if (objPtr->internalRep.strValue.maxLength < needlen ||
2020         objPtr->internalRep.strValue.maxLength == 0) {
2021         if (objPtr->bytes == JimEmptyStringRep) {
2022             objPtr->bytes = Jim_Alloc((needlen*2)+1);
2023         } else {
2024             objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2025         }
2026         objPtr->internalRep.strValue.maxLength = needlen*2;
2027     }
2028     memcpy(objPtr->bytes + objPtr->length, str, len);
2029     objPtr->bytes[objPtr->length+len] = '\0';
2030     objPtr->length += len;
2031 }
2032
2033 /* Low-level wrapper to append an object. */
2034 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2035 {
2036     int len;
2037     const char *str;
2038
2039     str = Jim_GetString(appendObjPtr, &len);
2040     StringAppendString(objPtr, str, len);
2041 }
2042
2043 /* Higher level API to append strings to objects. */
2044 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2045         int len)
2046 {
2047     if (Jim_IsShared(objPtr))
2048         Jim_Panic(interp,"Jim_AppendString called with shared object");
2049     if (objPtr->typePtr != &stringObjType)
2050         SetStringFromAny(interp, objPtr);
2051     StringAppendString(objPtr, str, len);
2052 }
2053
2054 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2055 {
2056         char *buf;
2057         va_list ap;
2058
2059         va_start( ap, fmt );
2060         buf = jim_vasprintf( fmt, ap );
2061         va_end(ap);
2062
2063         if( buf ){
2064                 Jim_AppendString( interp, objPtr, buf, -1 );
2065                 jim_vasprintf_done(buf);
2066         }
2067 }
2068
2069
2070 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2071         Jim_Obj *appendObjPtr)
2072 {
2073     int len;
2074     const char *str;
2075
2076     str = Jim_GetString(appendObjPtr, &len);
2077     Jim_AppendString(interp, objPtr, str, len);
2078 }
2079
2080 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2081 {
2082     va_list ap;
2083
2084     if (objPtr->typePtr != &stringObjType)
2085         SetStringFromAny(interp, objPtr);
2086     va_start(ap, objPtr);
2087     while (1) {
2088         char *s = va_arg(ap, char*);
2089
2090         if (s == NULL) break;
2091         Jim_AppendString(interp, objPtr, s, -1);
2092     }
2093     va_end(ap);
2094 }
2095
2096 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2097 {
2098     const char *aStr, *bStr;
2099     int aLen, bLen, i;
2100
2101     if (aObjPtr == bObjPtr) return 1;
2102     aStr = Jim_GetString(aObjPtr, &aLen);
2103     bStr = Jim_GetString(bObjPtr, &bLen);
2104     if (aLen != bLen) return 0;
2105     if (nocase == 0)
2106         return memcmp(aStr, bStr, aLen) == 0;
2107     for (i = 0; i < aLen; i++) {
2108         if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2109             return 0;
2110     }
2111     return 1;
2112 }
2113
2114 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2115         int nocase)
2116 {
2117     const char *pattern, *string;
2118     int patternLen, stringLen;
2119
2120     pattern = Jim_GetString(patternObjPtr, &patternLen);
2121     string = Jim_GetString(objPtr, &stringLen);
2122     return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2123 }
2124
2125 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2126         Jim_Obj *secondObjPtr, int nocase)
2127 {
2128     const char *s1, *s2;
2129     int l1, l2;
2130
2131     s1 = Jim_GetString(firstObjPtr, &l1);
2132     s2 = Jim_GetString(secondObjPtr, &l2);
2133     return JimStringCompare(s1, l1, s2, l2, nocase);
2134 }
2135
2136 /* Convert a range, as returned by Jim_GetRange(), into
2137  * an absolute index into an object of the specified length.
2138  * This function may return negative values, or values
2139  * bigger or equal to the length of the list if the index
2140  * is out of range. */
2141 static int JimRelToAbsIndex(int len, int index)
2142 {
2143     if (index < 0)
2144         return len + index;
2145     return index;
2146 }
2147
2148 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2149  * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2150  * for implementation of commands like [string range] and [lrange].
2151  *
2152  * The resulting range is guaranteed to address valid elements of
2153  * the structure. */
2154 static void JimRelToAbsRange(int len, int first, int last,
2155         int *firstPtr, int *lastPtr, int *rangeLenPtr)
2156 {
2157     int rangeLen;
2158
2159     if (first > last) {
2160         rangeLen = 0;
2161     } else {
2162         rangeLen = last-first+1;
2163         if (rangeLen) {
2164             if (first < 0) {
2165                 rangeLen += first;
2166                 first = 0;
2167             }
2168             if (last >= len) {
2169                 rangeLen -= (last-(len-1));
2170                 last = len-1;
2171             }
2172         }
2173     }
2174     if (rangeLen < 0) rangeLen = 0;
2175
2176     *firstPtr = first;
2177     *lastPtr = last;
2178     *rangeLenPtr = rangeLen;
2179 }
2180
2181 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2182         Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2183 {
2184     int first, last;
2185     const char *str;
2186     int len, rangeLen;
2187
2188     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2189         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2190         return NULL;
2191     str = Jim_GetString(strObjPtr, &len);
2192     first = JimRelToAbsIndex(len, first);
2193     last = JimRelToAbsIndex(len, last);
2194     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2195     return Jim_NewStringObj(interp, str+first, rangeLen);
2196 }
2197
2198 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2199 {
2200     char *buf = Jim_Alloc(strObjPtr->length+1);
2201     int i;
2202
2203     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2204     for (i = 0; i < strObjPtr->length; i++)
2205         buf[i] = tolower(buf[i]);
2206     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2207 }
2208
2209 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2210 {
2211     char *buf = Jim_Alloc(strObjPtr->length+1);
2212     int i;
2213
2214     memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2215     for (i = 0; i < strObjPtr->length; i++)
2216         buf[i] = toupper(buf[i]);
2217     return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2218 }
2219
2220 /* This is the core of the [format] command.
2221  * TODO: Lots of things work - via a hack
2222  *       However, no format item can be >= JIM_MAX_FMT 
2223  */
2224 #define JIM_MAX_FMT 2048
2225 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2226         int objc, Jim_Obj *const *objv, char *sprintf_buf)
2227 {
2228     const char *fmt, *_fmt;
2229     int fmtLen;
2230     Jim_Obj *resObjPtr;
2231     
2232
2233     fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2234         _fmt = fmt;
2235     resObjPtr = Jim_NewStringObj(interp, "", 0);
2236     while (fmtLen) {
2237         const char *p = fmt;
2238         char spec[2], c;
2239         jim_wide wideValue;
2240                 double doubleValue;
2241                 /* we cheat and use Sprintf()! */
2242                 char fmt_str[100];
2243                 char *cp;
2244                 int width;
2245                 int ljust;
2246                 int zpad;
2247                 int spad;
2248                 int altfm;
2249                 int forceplus;
2250                 int prec;
2251                 int inprec;
2252                 int haveprec;
2253                 int accum;
2254
2255         while (*fmt != '%' && fmtLen) {
2256             fmt++; fmtLen--;
2257         }
2258         Jim_AppendString(interp, resObjPtr, p, fmt-p);
2259         if (fmtLen == 0)
2260             break;
2261         fmt++; fmtLen--; /* skip '%' */
2262                 zpad = 0;
2263                 spad = 0;
2264                 width = -1;
2265                 ljust = 0;
2266                 altfm = 0;
2267                 forceplus = 0;
2268                 inprec = 0;
2269                 haveprec = 0;
2270                 prec = -1; /* not found yet */
2271     next_fmt:
2272                 if( fmtLen <= 0 ){
2273                         break;
2274                 }
2275                 switch( *fmt ){
2276                         /* terminals */
2277         case 'b': /* binary - not all printfs() do this */
2278                 case 's': /* string */
2279                 case 'i': /* integer */
2280                 case 'd': /* decimal */
2281                 case 'x': /* hex */
2282                 case 'X': /* CAP hex */
2283                 case 'c': /* char */
2284                 case 'o': /* octal */
2285                 case 'u': /* unsigned */
2286                 case 'f': /* float */
2287                         break;
2288                         
2289                         /* non-terminals */
2290                 case '0': /* zero pad */
2291                         zpad = 1;
2292                         *fmt++;  fmtLen--;
2293                         goto next_fmt;
2294                         break;
2295                 case '+':
2296                         forceplus = 1;
2297                         *fmt++;  fmtLen--;
2298                         goto next_fmt;
2299                         break;
2300                 case ' ': /* sign space */
2301                         spad = 1;
2302                         *fmt++;  fmtLen--;
2303                         goto next_fmt;
2304                         break;
2305                 case '-':
2306                         ljust = 1;
2307                         *fmt++;  fmtLen--;
2308                         goto next_fmt;
2309                         break;
2310                 case '#':
2311                         altfm = 1;
2312                         *fmt++; fmtLen--;
2313                         goto next_fmt;
2314
2315                 case '.':
2316                         inprec = 1;
2317                         *fmt++; fmtLen--;
2318                         goto next_fmt;
2319                         break;
2320                 case '1':
2321                 case '2':
2322                 case '3':
2323                 case '4':
2324                 case '5':
2325                 case '6':
2326                 case '7':
2327                 case '8':
2328                 case '9':
2329                         accum = 0;
2330                         while( isdigit(*fmt) && (fmtLen > 0) ){
2331                                 accum = (accum * 10) + (*fmt - '0');
2332                                 fmt++;  fmtLen--;
2333                         }
2334                         if( inprec ){
2335                                 haveprec = 1;
2336                                 prec = accum;
2337                         } else {
2338                                 width = accum;
2339                         }
2340                         goto next_fmt;
2341                 case '*':
2342                         /* suck up the next item as an integer */
2343                         *fmt++;  fmtLen--;
2344                         objc--;
2345                         if( objc <= 0 ){
2346                                 goto not_enough_args;
2347                         }
2348                         if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2349                                 Jim_FreeNewObj(interp, resObjPtr );
2350                                 return NULL;
2351                         }
2352                         if( inprec ){
2353                                 haveprec = 1;
2354                                 prec = wideValue;
2355                                 if( prec < 0 ){
2356                                         /* man 3 printf says */
2357                                         /* if prec is negative, it is zero */
2358                                         prec = 0;
2359                                 }
2360                         } else {
2361                                 width = wideValue;
2362                                 if( width < 0 ){
2363                                         ljust = 1;
2364                                         width = -width;
2365                                 }
2366                         }
2367                         objv++;
2368                         goto next_fmt;
2369                         break;
2370                 }
2371                 
2372                 
2373                 if (*fmt != '%') {
2374             if (objc == 0) {
2375                         not_enough_args:
2376                 Jim_FreeNewObj(interp, resObjPtr);
2377                 Jim_SetResultString(interp,
2378                                                                         "not enough arguments for all format specifiers", -1);
2379                 return NULL;
2380             } else {
2381                 objc--;
2382             }
2383         }
2384                 
2385                 /*
2386                  * Create the formatter
2387                  * cause we cheat and use sprintf()
2388                  */
2389                 cp = fmt_str;
2390                 *cp++ = '%';
2391                 if( altfm ){
2392                         *cp++ = '#';
2393                 }
2394                 if( forceplus ){
2395                         *cp++ = '+';
2396                 } else if( spad ){
2397                         /* PLUS overrides */
2398                         *cp++ = ' ';
2399                 }
2400                 if( ljust ){
2401                         *cp++ = '-';
2402                 }
2403                 if( zpad  ){
2404                         *cp++ = '0';
2405                 }
2406                 if( width > 0 ){
2407                         sprintf( cp, "%d", width );
2408                         /* skip ahead */
2409                         cp = strchr(cp,0);
2410                 }
2411                 /* did we find a period? */
2412                 if( inprec ){
2413                         /* then add it */
2414                         *cp++ = '.';
2415                         /* did something occur after the period? */
2416                         if( haveprec ){
2417                                 sprintf( cp, "%d", prec );
2418                         }
2419                         cp = strchr(cp,0);
2420                 }
2421                 *cp = 0;
2422
2423                 /* here we do the work */
2424                 /* actually - we make sprintf() do it for us */
2425         switch(*fmt) {
2426         case 's':
2427                         *cp++ = 's';
2428                         *cp   = 0;
2429                         /* BUG: we do not handled embeded NULLs */
2430                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2431             break;
2432         case 'c':
2433                         *cp++ = 'c';
2434                         *cp   = 0;
2435             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2436                 Jim_FreeNewObj(interp, resObjPtr);
2437                 return NULL;
2438             }
2439             c = (char) wideValue;
2440                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2441             break;
2442                 case 'f':
2443                 case 'F':
2444                 case 'g':
2445                 case 'G':
2446                 case 'e':
2447                 case 'E':
2448                         *cp++ = *fmt;
2449                         *cp   = 0;
2450                         if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2451                                 Jim_FreeNewObj( interp, resObjPtr );
2452                                 return NULL;
2453                         }
2454                         snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2455                         break;
2456         case 'b':
2457         case 'd':
2458                 case 'i':
2459                 case 'u':
2460                 case 'x':
2461                 case 'X':
2462                         /* jim widevaluse are 64bit */
2463                         if( sizeof(jim_wide) == sizeof(long long) ){
2464                                 *cp++ = 'l'; 
2465                                 *cp++ = 'l';
2466                         } else {
2467                                 *cp++ = 'l';
2468                         }
2469                         *cp++ = *fmt;
2470                         *cp   = 0;
2471             if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2472                 Jim_FreeNewObj(interp, resObjPtr);
2473                 return NULL;
2474             }
2475                         snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2476             break;
2477         case '%':
2478                         sprintf_buf[0] = '%';
2479                         sprintf_buf[1] = 0;
2480                         objv--; /* undo the objv++ below */
2481             break;
2482         default:
2483             spec[0] = *fmt; spec[1] = '\0';
2484             Jim_FreeNewObj(interp, resObjPtr);
2485             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2486             Jim_AppendStrings(interp, Jim_GetResult(interp),
2487                     "bad field specifier \"",  spec, "\"", NULL);
2488             return NULL;
2489         }
2490                 /* force terminate */
2491 #if 0
2492                 printf("FMT was: %s\n", fmt_str );
2493                 printf("RES was: |%s|\n", sprintf_buf );
2494 #endif
2495                 
2496                 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2497                 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2498                 /* next obj */
2499                 objv++;
2500         fmt++;
2501         fmtLen--;
2502     }
2503     return resObjPtr;
2504 }
2505
2506 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2507         int objc, Jim_Obj *const *objv)
2508 {
2509         char *sprintf_buf=malloc(JIM_MAX_FMT);
2510         Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2511         free(sprintf_buf);
2512         return t; 
2513 }
2514
2515 /* -----------------------------------------------------------------------------
2516  * Compared String Object
2517  * ---------------------------------------------------------------------------*/
2518
2519 /* This is strange object that allows to compare a C literal string
2520  * with a Jim object in very short time if the same comparison is done
2521  * multiple times. For example every time the [if] command is executed,
2522  * Jim has to check if a given argument is "else". This comparions if
2523  * the code has no errors are true most of the times, so we can cache
2524  * inside the object the pointer of the string of the last matching
2525  * comparison. Because most C compilers perform literal sharing,
2526  * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2527  * this works pretty well even if comparisons are at different places
2528  * inside the C code. */
2529
2530 static Jim_ObjType comparedStringObjType = {
2531     "compared-string",
2532     NULL,
2533     NULL,
2534     NULL,
2535     JIM_TYPE_REFERENCES,
2536 };
2537
2538 /* The only way this object is exposed to the API is via the following
2539  * function. Returns true if the string and the object string repr.
2540  * are the same, otherwise zero is returned.
2541  *
2542  * Note: this isn't binary safe, but it hardly needs to be.*/
2543 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2544         const char *str)
2545 {
2546     if (objPtr->typePtr == &comparedStringObjType &&
2547         objPtr->internalRep.ptr == str)
2548         return 1;
2549     else {
2550         const char *objStr = Jim_GetString(objPtr, NULL);
2551         if (strcmp(str, objStr) != 0) return 0;
2552         if (objPtr->typePtr != &comparedStringObjType) {
2553             Jim_FreeIntRep(interp, objPtr);
2554             objPtr->typePtr = &comparedStringObjType;
2555         }
2556         objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2557         return 1;
2558     }
2559 }
2560
2561 int qsortCompareStringPointers(const void *a, const void *b)
2562 {
2563     char * const *sa = (char * const *)a;
2564     char * const *sb = (char * const *)b;
2565     return strcmp(*sa, *sb);
2566 }
2567
2568 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2569         const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2570 {
2571     const char * const *entryPtr = NULL;
2572     char **tablePtrSorted;
2573     int i, count = 0;
2574
2575     *indexPtr = -1;
2576     for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2577         if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2578             *indexPtr = i;
2579             return JIM_OK;
2580         }
2581         count++; /* If nothing matches, this will reach the len of tablePtr */
2582     }
2583     if (flags & JIM_ERRMSG) {
2584         if (name == NULL)
2585             name = "option";
2586         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2587         Jim_AppendStrings(interp, Jim_GetResult(interp),
2588             "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2589             NULL);
2590         tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2591         memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2592         qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2593         for (i = 0; i < count; i++) {
2594             if (i+1 == count && count > 1)
2595                 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2596             Jim_AppendString(interp, Jim_GetResult(interp),
2597                     tablePtrSorted[i], -1);
2598             if (i+1 != count)
2599                 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2600         }
2601         Jim_Free(tablePtrSorted);
2602     }
2603     return JIM_ERR;
2604 }
2605
2606 int Jim_GetNvp(Jim_Interp *interp, 
2607                            Jim_Obj *objPtr,
2608                            const Jim_Nvp *nvp_table, 
2609                            const Jim_Nvp ** result)
2610 {
2611         Jim_Nvp *n;
2612         int e;
2613
2614         e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2615         if( e == JIM_ERR ){
2616                 return e;
2617         }
2618
2619         /* Success? found? */
2620         if( n->name ){
2621                 /* remove const */
2622                 *result = (Jim_Nvp *)n;
2623                 return JIM_OK;
2624         } else {
2625                 return JIM_ERR;
2626         }
2627 }
2628
2629 /* -----------------------------------------------------------------------------
2630  * Source Object
2631  *
2632  * This object is just a string from the language point of view, but
2633  * in the internal representation it contains the filename and line number
2634  * where this given token was read. This information is used by
2635  * Jim_EvalObj() if the object passed happens to be of type "source".
2636  *
2637  * This allows to propagate the information about line numbers and file
2638  * names and give error messages with absolute line numbers.
2639  *
2640  * Note that this object uses shared strings for filenames, and the
2641  * pointer to the filename together with the line number is taken into
2642  * the space for the "inline" internal represenation of the Jim_Object,
2643  * so there is almost memory zero-overhead.
2644  *
2645  * Also the object will be converted to something else if the given
2646  * token it represents in the source file is not something to be
2647  * evaluated (not a script), and will be specialized in some other way,
2648  * so the time overhead is alzo null.
2649  * ---------------------------------------------------------------------------*/
2650
2651 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2652 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2653
2654 static Jim_ObjType sourceObjType = {
2655     "source",
2656     FreeSourceInternalRep,
2657     DupSourceInternalRep,
2658     NULL,
2659     JIM_TYPE_REFERENCES,
2660 };
2661
2662 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2663 {
2664     Jim_ReleaseSharedString(interp,
2665             objPtr->internalRep.sourceValue.fileName);
2666 }
2667
2668 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2669 {
2670     dupPtr->internalRep.sourceValue.fileName =
2671         Jim_GetSharedString(interp,
2672                 srcPtr->internalRep.sourceValue.fileName);
2673     dupPtr->internalRep.sourceValue.lineNumber =
2674         dupPtr->internalRep.sourceValue.lineNumber;
2675     dupPtr->typePtr = &sourceObjType;
2676 }
2677
2678 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2679         const char *fileName, int lineNumber)
2680 {
2681     if (Jim_IsShared(objPtr))
2682         Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2683     if (objPtr->typePtr != NULL)
2684         Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2685     objPtr->internalRep.sourceValue.fileName =
2686         Jim_GetSharedString(interp, fileName);
2687     objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2688     objPtr->typePtr = &sourceObjType;
2689 }
2690
2691 /* -----------------------------------------------------------------------------
2692  * Script Object
2693  * ---------------------------------------------------------------------------*/
2694
2695 #define JIM_CMDSTRUCT_EXPAND -1
2696
2697 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2698 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2699 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2700
2701 static Jim_ObjType scriptObjType = {
2702     "script",
2703     FreeScriptInternalRep,
2704     DupScriptInternalRep,
2705     NULL,
2706     JIM_TYPE_REFERENCES,
2707 };
2708
2709 /* The ScriptToken structure represents every token into a scriptObj.
2710  * Every token contains an associated Jim_Obj that can be specialized
2711  * by commands operating on it. */
2712 typedef struct ScriptToken {
2713     int type;
2714     Jim_Obj *objPtr;
2715     int linenr;
2716 } ScriptToken;
2717
2718 /* This is the script object internal representation. An array of
2719  * ScriptToken structures, with an associated command structure array.
2720  * The command structure is a pre-computed representation of the
2721  * command length and arguments structure as a simple liner array
2722  * of integers.
2723  * 
2724  * For example the script:
2725  *
2726  * puts hello
2727  * set $i $x$y [foo]BAR
2728  *
2729  * will produce a ScriptObj with the following Tokens:
2730  *
2731  * ESC puts
2732  * SEP
2733  * ESC hello
2734  * EOL
2735  * ESC set
2736  * EOL
2737  * VAR i
2738  * SEP
2739  * VAR x
2740  * VAR y
2741  * SEP
2742  * CMD foo
2743  * ESC BAR
2744  * EOL
2745  *
2746  * This is a description of the tokens, separators, and of lines.
2747  * The command structure instead represents the number of arguments
2748  * of every command, followed by the tokens of which every argument
2749  * is composed. So for the example script, the cmdstruct array will
2750  * contain:
2751  *
2752  * 2 1 1 4 1 1 2 2
2753  *
2754  * Because "puts hello" has two args (2), composed of single tokens (1 1)
2755  * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2756  * composed of single tokens (1 1) and the last two of double tokens
2757  * (2 2).
2758  *
2759  * The precomputation of the command structure makes Jim_Eval() faster,
2760  * and simpler because there aren't dynamic lengths / allocations.
2761  *
2762  * -- {expand} handling --
2763  *
2764  * Expand is handled in a special way. When a command
2765  * contains at least an argument with the {expand} prefix,
2766  * the command structure presents a -1 before the integer
2767  * describing the number of arguments. This is used in order
2768  * to send the command exection to a different path in case
2769  * of {expand} and guarantee a fast path for the more common
2770  * case. Also, the integers describing the number of tokens
2771  * are expressed with negative sign, to allow for fast check
2772  * of what's an {expand}-prefixed argument and what not.
2773  *
2774  * For example the command:
2775  *
2776  * list {expand}{1 2}
2777  *
2778  * Will produce the following cmdstruct array:
2779  *
2780  * -1 2 1 -2
2781  *
2782  * -- the substFlags field of the structure --
2783  *
2784  * The scriptObj structure is used to represent both "script" objects
2785  * and "subst" objects. In the second case, the cmdStruct related
2786  * fields are not used at all, but there is an additional field used
2787  * that is 'substFlags': this represents the flags used to turn
2788  * the string into the intenral representation used to perform the
2789  * substitution. If this flags are not what the application requires
2790  * the scriptObj is created again. For example the script:
2791  *
2792  * subst -nocommands $string
2793  * subst -novariables $string
2794  *
2795  * Will recreate the internal representation of the $string object
2796  * two times.
2797  */
2798 typedef struct ScriptObj {
2799     int len; /* Length as number of tokens. */
2800     int commands; /* number of top-level commands in script. */
2801     ScriptToken *token; /* Tokens array. */
2802     int *cmdStruct; /* commands structure */
2803     int csLen; /* length of the cmdStruct array. */
2804     int substFlags; /* flags used for the compilation of "subst" objects */
2805     int inUse; /* Used to share a ScriptObj. Currently
2806               only used by Jim_EvalObj() as protection against
2807               shimmering of the currently evaluated object. */
2808     char *fileName;
2809 } ScriptObj;
2810
2811 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2812 {
2813     int i;
2814     struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2815
2816     script->inUse--;
2817     if (script->inUse != 0) return;
2818     for (i = 0; i < script->len; i++) {
2819         if (script->token[i].objPtr != NULL)
2820             Jim_DecrRefCount(interp, script->token[i].objPtr);
2821     }
2822     Jim_Free(script->token);
2823     Jim_Free(script->cmdStruct);
2824     Jim_Free(script->fileName);
2825     Jim_Free(script);
2826 }
2827
2828 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2829 {
2830     JIM_NOTUSED(interp);
2831     JIM_NOTUSED(srcPtr);
2832
2833     /* Just returns an simple string. */
2834     dupPtr->typePtr = NULL;
2835 }
2836
2837 /* Add a new token to the internal repr of a script object */
2838 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2839         char *strtoken, int len, int type, char *filename, int linenr)
2840 {
2841     int prevtype;
2842     struct ScriptToken *token;
2843
2844     prevtype = (script->len == 0) ? JIM_TT_EOL : \
2845         script->token[script->len-1].type;
2846     /* Skip tokens without meaning, like words separators
2847      * following a word separator or an end of command and
2848      * so on. */
2849     if (prevtype == JIM_TT_EOL) {
2850         if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2851             Jim_Free(strtoken);
2852             return;
2853         }
2854     } else if (prevtype == JIM_TT_SEP) {
2855         if (type == JIM_TT_SEP) {
2856             Jim_Free(strtoken);
2857             return;
2858         } else if (type == JIM_TT_EOL) {
2859             /* If an EOL is following by a SEP, drop the previous
2860              * separator. */
2861             script->len--;
2862             Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2863         }
2864     } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2865             type == JIM_TT_ESC && len == 0)
2866     {
2867         /* Don't add empty tokens used in interpolation */
2868         Jim_Free(strtoken);
2869         return;
2870     }
2871     /* Make space for a new istruction */
2872     script->len++;
2873     script->token = Jim_Realloc(script->token,
2874             sizeof(ScriptToken)*script->len);
2875     /* Initialize the new token */
2876     token = script->token+(script->len-1);
2877     token->type = type;
2878     /* Every object is intially as a string, but the
2879      * internal type may be specialized during execution of the
2880      * script. */
2881     token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2882     /* To add source info to SEP and EOL tokens is useless because
2883      * they will never by called as arguments of Jim_EvalObj(). */
2884     if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2885         JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2886     Jim_IncrRefCount(token->objPtr);
2887     token->linenr = linenr;
2888 }
2889
2890 /* Add an integer into the command structure field of the script object. */
2891 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2892 {
2893     script->csLen++;
2894     script->cmdStruct = Jim_Realloc(script->cmdStruct,
2895                     sizeof(int)*script->csLen);
2896     script->cmdStruct[script->csLen-1] = val;
2897 }
2898
2899 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2900  * of objPtr. Search nested script objects recursively. */
2901 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2902         ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2903 {
2904     int i;
2905
2906     for (i = 0; i < script->len; i++) {
2907         if (script->token[i].objPtr != objPtr &&
2908             Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2909             return script->token[i].objPtr;
2910         }
2911         /* Enter recursively on scripts only if the object
2912          * is not the same as the one we are searching for
2913          * shared occurrences. */
2914         if (script->token[i].objPtr->typePtr == &scriptObjType &&
2915             script->token[i].objPtr != objPtr) {
2916             Jim_Obj *foundObjPtr;
2917
2918             ScriptObj *subScript =
2919                 script->token[i].objPtr->internalRep.ptr;
2920             /* Don't recursively enter the script we are trying
2921              * to make shared to avoid circular references. */
2922             if (subScript == scriptBarrier) continue;
2923             if (subScript != script) {
2924                 foundObjPtr =
2925                     ScriptSearchLiteral(interp, subScript,
2926                             scriptBarrier, objPtr);
2927                 if (foundObjPtr != NULL)
2928                     return foundObjPtr;
2929             }
2930         }
2931     }
2932     return NULL;
2933 }
2934
2935 /* Share literals of a script recursively sharing sub-scripts literals. */
2936 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2937         ScriptObj *topLevelScript)
2938 {
2939     int i, j;
2940
2941     return;
2942     /* Try to share with toplevel object. */
2943     if (topLevelScript != NULL) {
2944         for (i = 0; i < script->len; i++) {
2945             Jim_Obj *foundObjPtr;
2946             char *str = script->token[i].objPtr->bytes;
2947
2948             if (script->token[i].objPtr->refCount != 1) continue;
2949             if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2950             if (strchr(str, ' ') || strchr(str, '\n')) continue;
2951             foundObjPtr = ScriptSearchLiteral(interp,
2952                     topLevelScript,
2953                     script, /* barrier */
2954                     script->token[i].objPtr);
2955             if (foundObjPtr != NULL) {
2956                 Jim_IncrRefCount(foundObjPtr);
2957                 Jim_DecrRefCount(interp,
2958                         script->token[i].objPtr);
2959                 script->token[i].objPtr = foundObjPtr;
2960             }
2961         }
2962     }
2963     /* Try to share locally */
2964     for (i = 0; i < script->len; i++) {
2965         char *str = script->token[i].objPtr->bytes;
2966
2967         if (script->token[i].objPtr->refCount != 1) continue;
2968         if (strchr(str, ' ') || strchr(str, '\n')) continue;
2969         for (j = 0; j < script->len; j++) {
2970             if (script->token[i].objPtr !=
2971                     script->token[j].objPtr &&
2972                 Jim_StringEqObj(script->token[i].objPtr,
2973                             script->token[j].objPtr, 0))
2974             {
2975                 Jim_IncrRefCount(script->token[j].objPtr);
2976                 Jim_DecrRefCount(interp,
2977                         script->token[i].objPtr);
2978                 script->token[i].objPtr =
2979                     script->token[j].objPtr;
2980             }
2981         }
2982     }
2983 }
2984
2985 /* This method takes the string representation of an object
2986  * as a Tcl script, and generates the pre-parsed internal representation
2987  * of the script. */
2988 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2989 {
2990     int scriptTextLen;
2991     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
2992     struct JimParserCtx parser;
2993     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
2994     ScriptToken *token;
2995     int args, tokens, start, end, i;
2996     int initialLineNumber;
2997     int propagateSourceInfo = 0;
2998
2999     script->len = 0;
3000     script->csLen = 0;
3001     script->commands = 0;
3002     script->token = NULL;
3003     script->cmdStruct = NULL;
3004     script->inUse = 1;
3005     /* Try to get information about filename / line number */
3006     if (objPtr->typePtr == &sourceObjType) {
3007         script->fileName =
3008             Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3009         initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3010         propagateSourceInfo = 1;
3011     } else {
3012         script->fileName = Jim_StrDup("?");
3013         initialLineNumber = 1;
3014     }
3015
3016     JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3017     while(!JimParserEof(&parser)) {
3018         char *token;
3019         int len, type, linenr;
3020
3021         JimParseScript(&parser);
3022         token = JimParserGetToken(&parser, &len, &type, &linenr);
3023         ScriptObjAddToken(interp, script, token, len, type,
3024                 propagateSourceInfo ? script->fileName : NULL,
3025                 linenr);
3026     }
3027     token = script->token;
3028
3029     /* Compute the command structure array
3030      * (see the ScriptObj struct definition for more info) */
3031     start = 0; /* Current command start token index */
3032     end = -1; /* Current command end token index */
3033     while (1) {
3034         int expand = 0; /* expand flag. set to 1 on {expand} form. */
3035         int interpolation = 0; /* set to 1 if there is at least one
3036                       argument of the command obtained via
3037                       interpolation of more tokens. */
3038         /* Search for the end of command, while
3039          * count the number of args. */
3040         start = ++end;
3041         if (start >= script->len) break;
3042         args = 1; /* Number of args in current command */
3043         while (token[end].type != JIM_TT_EOL) {
3044             if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3045                     token[end-1].type == JIM_TT_EOL)
3046             {
3047                 if (token[end].type == JIM_TT_STR &&
3048                     token[end+1].type != JIM_TT_SEP &&
3049                     token[end+1].type != JIM_TT_EOL &&
3050                     (!strcmp(token[end].objPtr->bytes, "expand") ||
3051                      !strcmp(token[end].objPtr->bytes, "*")))
3052                     expand++;
3053             }
3054             if (token[end].type == JIM_TT_SEP)
3055                 args++;
3056             end++;
3057         }
3058         interpolation = !((end-start+1) == args*2);
3059         /* Add the 'number of arguments' info into cmdstruct.
3060          * Negative value if there is list expansion involved. */
3061         if (expand)
3062             ScriptObjAddInt(script, -1);
3063         ScriptObjAddInt(script, args);
3064         /* Now add info about the number of tokens. */
3065         tokens = 0; /* Number of tokens in current argument. */
3066         expand = 0;
3067         for (i = start; i <= end; i++) {
3068             if (token[i].type == JIM_TT_SEP ||
3069                 token[i].type == JIM_TT_EOL)
3070             {
3071                 if (tokens == 1 && expand)
3072                     expand = 0;
3073                 ScriptObjAddInt(script,
3074                         expand ? -tokens : tokens);
3075
3076                 expand = 0;
3077                 tokens = 0;
3078                 continue;
3079             } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3080                    (!strcmp(token[i].objPtr->bytes, "expand") ||
3081                     !strcmp(token[i].objPtr->bytes, "*")))
3082             {
3083                 expand++;
3084             }
3085             tokens++;
3086         }
3087     }
3088     /* Perform literal sharing, but only for objects that appear
3089      * to be scripts written as literals inside the source code,
3090      * and not computed at runtime. Literal sharing is a costly
3091      * operation that should be done only against objects that
3092      * are likely to require compilation only the first time, and
3093      * then are executed multiple times. */
3094     if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3095         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3096         if (bodyObjPtr->typePtr == &scriptObjType) {
3097             ScriptObj *bodyScript =
3098                 bodyObjPtr->internalRep.ptr;
3099             ScriptShareLiterals(interp, script, bodyScript);
3100         }
3101     } else if (propagateSourceInfo) {
3102         ScriptShareLiterals(interp, script, NULL);
3103     }
3104     /* Free the old internal rep and set the new one. */
3105     Jim_FreeIntRep(interp, objPtr);
3106     Jim_SetIntRepPtr(objPtr, script);
3107     objPtr->typePtr = &scriptObjType;
3108     return JIM_OK;
3109 }
3110
3111 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3112 {
3113     if (objPtr->typePtr != &scriptObjType) {
3114         SetScriptFromAny(interp, objPtr);
3115     }
3116     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3117 }
3118
3119 /* -----------------------------------------------------------------------------
3120  * Commands
3121  * ---------------------------------------------------------------------------*/
3122
3123 /* Commands HashTable Type.
3124  *
3125  * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3126 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3127 {
3128     Jim_Cmd *cmdPtr = (void*) val;
3129
3130     if (cmdPtr->cmdProc == NULL) {
3131         Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3132         Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3133         if (cmdPtr->staticVars) {
3134             Jim_FreeHashTable(cmdPtr->staticVars);
3135             Jim_Free(cmdPtr->staticVars);
3136         }
3137     } else if (cmdPtr->delProc != NULL) {
3138             /* If it was a C coded command, call the delProc if any */
3139             cmdPtr->delProc(interp, cmdPtr->privData);
3140     }
3141     Jim_Free(val);
3142 }
3143
3144 static Jim_HashTableType JimCommandsHashTableType = {
3145     JimStringCopyHTHashFunction,        /* hash function */
3146     JimStringCopyHTKeyDup,        /* key dup */
3147     NULL,                    /* val dup */
3148     JimStringCopyHTKeyCompare,        /* key compare */
3149     JimStringCopyHTKeyDestructor,        /* key destructor */
3150     Jim_CommandsHT_ValDestructor        /* val destructor */
3151 };
3152
3153 /* ------------------------- Commands related functions --------------------- */
3154
3155 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3156         Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3157 {
3158     Jim_HashEntry *he;
3159     Jim_Cmd *cmdPtr;
3160
3161     he = Jim_FindHashEntry(&interp->commands, cmdName);
3162     if (he == NULL) { /* New command to create */
3163         cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3164         cmdPtr->cmdProc = cmdProc;
3165         cmdPtr->privData = privData;
3166         cmdPtr->delProc = delProc;
3167         Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3168     } else {
3169         Jim_InterpIncrProcEpoch(interp);
3170         /* Free the arglist/body objects if it was a Tcl procedure */
3171         cmdPtr = he->val;
3172         if (cmdPtr->cmdProc == NULL) {
3173             Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3174             Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3175             if (cmdPtr->staticVars) {
3176                 Jim_FreeHashTable(cmdPtr->staticVars);
3177                 Jim_Free(cmdPtr->staticVars);
3178             }
3179             cmdPtr->staticVars = NULL;
3180         } else if (cmdPtr->delProc != NULL) {
3181             /* If it was a C coded command, call the delProc if any */
3182             cmdPtr->delProc(interp, cmdPtr->privData);
3183         }
3184         cmdPtr->cmdProc = cmdProc;
3185         cmdPtr->privData = privData;
3186     }
3187     /* There is no need to increment the 'proc epoch' because
3188      * creation of a new procedure can never affect existing
3189      * cached commands. We don't do negative caching. */
3190     return JIM_OK;
3191 }
3192
3193 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3194         Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3195         int arityMin, int arityMax)
3196 {
3197     Jim_Cmd *cmdPtr;
3198
3199     cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3200     cmdPtr->cmdProc = NULL; /* Not a C coded command */
3201     cmdPtr->argListObjPtr = argListObjPtr;
3202     cmdPtr->bodyObjPtr = bodyObjPtr;
3203     Jim_IncrRefCount(argListObjPtr);
3204     Jim_IncrRefCount(bodyObjPtr);
3205     cmdPtr->arityMin = arityMin;
3206     cmdPtr->arityMax = arityMax;
3207     cmdPtr->staticVars = NULL;
3208    
3209     /* Create the statics hash table. */
3210     if (staticsListObjPtr) {
3211         int len, i;
3212
3213         Jim_ListLength(interp, staticsListObjPtr, &len);
3214         if (len != 0) {
3215             cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3216             Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3217                     interp);
3218             for (i = 0; i < len; i++) {
3219                 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3220                 Jim_Var *varPtr;
3221                 int subLen;
3222
3223                 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3224                 /* Check if it's composed of two elements. */
3225                 Jim_ListLength(interp, objPtr, &subLen);
3226                 if (subLen == 1 || subLen == 2) {
3227                     /* Try to get the variable value from the current
3228                      * environment. */
3229                     Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3230                     if (subLen == 1) {
3231                         initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3232                                 JIM_NONE);
3233                         if (initObjPtr == NULL) {
3234                             Jim_SetResult(interp,
3235                                     Jim_NewEmptyStringObj(interp));
3236                             Jim_AppendStrings(interp, Jim_GetResult(interp),
3237                                 "variable for initialization of static \"",
3238                                 Jim_GetString(nameObjPtr, NULL),
3239                                 "\" not found in the local context",
3240                                 NULL);
3241                             goto err;
3242                         }
3243                     } else {
3244                         Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3245                     }
3246                     varPtr = Jim_Alloc(sizeof(*varPtr));
3247                     varPtr->objPtr = initObjPtr;
3248                     Jim_IncrRefCount(initObjPtr);
3249                     varPtr->linkFramePtr = NULL;
3250                     if (Jim_AddHashEntry(cmdPtr->staticVars,
3251                             Jim_GetString(nameObjPtr, NULL),
3252                             varPtr) != JIM_OK)
3253                     {
3254                         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3255                         Jim_AppendStrings(interp, Jim_GetResult(interp),
3256                             "static variable name \"",
3257                             Jim_GetString(objPtr, NULL), "\"",
3258                             " duplicated in statics list", NULL);
3259                         Jim_DecrRefCount(interp, initObjPtr);
3260                         Jim_Free(varPtr);
3261                         goto err;
3262                     }
3263                 } else {
3264                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3265                     Jim_AppendStrings(interp, Jim_GetResult(interp),
3266                         "too many fields in static specifier \"",
3267                         objPtr, "\"", NULL);
3268                     goto err;
3269                 }
3270             }
3271         }
3272     }
3273
3274     /* Add the new command */
3275
3276     /* it may already exist, so we try to delete the old one */
3277     if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3278         /* There was an old procedure with the same name, this requires
3279          * a 'proc epoch' update. */
3280         Jim_InterpIncrProcEpoch(interp);
3281     }
3282     /* If a procedure with the same name didn't existed there is no need
3283      * to increment the 'proc epoch' because creation of a new procedure
3284      * can never affect existing cached commands. We don't do
3285      * negative caching. */
3286     Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3287     return JIM_OK;
3288
3289 err:
3290     Jim_FreeHashTable(cmdPtr->staticVars);
3291     Jim_Free(cmdPtr->staticVars);
3292     Jim_DecrRefCount(interp, argListObjPtr);
3293     Jim_DecrRefCount(interp, bodyObjPtr);
3294     Jim_Free(cmdPtr);
3295     return JIM_ERR;
3296 }
3297
3298 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3299 {
3300     if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3301         return JIM_ERR;
3302     Jim_InterpIncrProcEpoch(interp);
3303     return JIM_OK;
3304 }
3305
3306 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, 
3307         const char *newName)
3308 {
3309     Jim_Cmd *cmdPtr;
3310     Jim_HashEntry *he;
3311     Jim_Cmd *copyCmdPtr;
3312
3313     if (newName[0] == '\0') /* Delete! */
3314         return Jim_DeleteCommand(interp, oldName);
3315     /* Rename */
3316     he = Jim_FindHashEntry(&interp->commands, oldName);
3317     if (he == NULL)
3318         return JIM_ERR; /* Invalid command name */
3319     cmdPtr = he->val;
3320     copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3321     *copyCmdPtr = *cmdPtr;
3322     /* In order to avoid that a procedure will get arglist/body/statics
3323      * freed by the hash table methods, fake a C-coded command
3324      * setting cmdPtr->cmdProc as not NULL */
3325     cmdPtr->cmdProc = (void*)1;
3326     /* Also make sure delProc is NULL. */
3327     cmdPtr->delProc = NULL;
3328     /* Destroy the old command, and make sure the new is freed
3329      * as well. */
3330     Jim_DeleteHashEntry(&interp->commands, oldName);
3331     Jim_DeleteHashEntry(&interp->commands, newName);
3332     /* Now the new command. We are sure it can't fail because
3333      * the target name was already freed. */
3334     Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3335     /* Increment the epoch */
3336     Jim_InterpIncrProcEpoch(interp);
3337     return JIM_OK;
3338 }
3339
3340 /* -----------------------------------------------------------------------------
3341  * Command object
3342  * ---------------------------------------------------------------------------*/
3343
3344 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3345
3346 static Jim_ObjType commandObjType = {
3347     "command",
3348     NULL,
3349     NULL,
3350     NULL,
3351     JIM_TYPE_REFERENCES,
3352 };
3353
3354 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3355 {
3356     Jim_HashEntry *he;
3357     const char *cmdName;
3358
3359     /* Get the string representation */
3360     cmdName = Jim_GetString(objPtr, NULL);
3361     /* Lookup this name into the commands hash table */
3362     he = Jim_FindHashEntry(&interp->commands, cmdName);
3363     if (he == NULL)
3364         return JIM_ERR;
3365
3366     /* Free the old internal repr and set the new one. */
3367     Jim_FreeIntRep(interp, objPtr);
3368     objPtr->typePtr = &commandObjType;
3369     objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3370     objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3371     return JIM_OK;
3372 }
3373
3374 /* This function returns the command structure for the command name
3375  * stored in objPtr. It tries to specialize the objPtr to contain
3376  * a cached info instead to perform the lookup into the hash table
3377  * every time. The information cached may not be uptodate, in such
3378  * a case the lookup is performed and the cache updated. */
3379 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3380 {
3381     if ((objPtr->typePtr != &commandObjType ||
3382         objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3383         SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3384         if (flags & JIM_ERRMSG) {
3385             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3386             Jim_AppendStrings(interp, Jim_GetResult(interp),
3387                 "invalid command name \"", objPtr->bytes, "\"",
3388                 NULL);
3389         }
3390         return NULL;
3391     }
3392     return objPtr->internalRep.cmdValue.cmdPtr;
3393 }
3394
3395 /* -----------------------------------------------------------------------------
3396  * Variables
3397  * ---------------------------------------------------------------------------*/
3398
3399 /* Variables HashTable Type.
3400  *
3401  * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3402 static void JimVariablesHTValDestructor(void *interp, void *val)
3403 {
3404     Jim_Var *varPtr = (void*) val;
3405
3406     Jim_DecrRefCount(interp, varPtr->objPtr);
3407     Jim_Free(val);
3408 }
3409
3410 static Jim_HashTableType JimVariablesHashTableType = {
3411     JimStringCopyHTHashFunction,        /* hash function */
3412     JimStringCopyHTKeyDup,              /* key dup */
3413     NULL,                               /* val dup */
3414     JimStringCopyHTKeyCompare,        /* key compare */
3415     JimStringCopyHTKeyDestructor,     /* key destructor */
3416     JimVariablesHTValDestructor       /* val destructor */
3417 };
3418
3419 /* -----------------------------------------------------------------------------
3420  * Variable object
3421  * ---------------------------------------------------------------------------*/
3422
3423 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3424
3425 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3426
3427 static Jim_ObjType variableObjType = {
3428     "variable",
3429     NULL,
3430     NULL,
3431     NULL,
3432     JIM_TYPE_REFERENCES,
3433 };
3434
3435 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3436  * is in the form "varname(key)". */
3437 static int Jim_NameIsDictSugar(const char *str, int len)
3438 {
3439     if (len == -1)
3440         len = strlen(str);
3441     if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3442         return 1;
3443     return 0;
3444 }
3445
3446 /* This method should be called only by the variable API.
3447  * It returns JIM_OK on success (variable already exists),
3448  * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3449  * a variable name, but syntax glue for [dict] i.e. the last
3450  * character is ')' */
3451 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3452 {
3453     Jim_HashEntry *he;
3454     const char *varName;
3455     int len;
3456
3457     /* Check if the object is already an uptodate variable */
3458     if (objPtr->typePtr == &variableObjType &&
3459         objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3460         return JIM_OK; /* nothing to do */
3461     /* Get the string representation */
3462     varName = Jim_GetString(objPtr, &len);
3463     /* Make sure it's not syntax glue to get/set dict. */
3464     if (Jim_NameIsDictSugar(varName, len))
3465             return JIM_DICT_SUGAR;
3466     /* Lookup this name into the variables hash table */
3467     he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3468     if (he == NULL) {
3469         /* Try with static vars. */
3470         if (interp->framePtr->staticVars == NULL)
3471             return JIM_ERR;
3472         if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3473             return JIM_ERR;
3474     }
3475     /* Free the old internal repr and set the new one. */
3476     Jim_FreeIntRep(interp, objPtr);
3477     objPtr->typePtr = &variableObjType;
3478     objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3479     objPtr->internalRep.varValue.varPtr = (void*)he->val;
3480     return JIM_OK;
3481 }
3482
3483 /* -------------------- Variables related functions ------------------------- */
3484 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3485         Jim_Obj *valObjPtr);
3486 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3487
3488 /* For now that's dummy. Variables lookup should be optimized
3489  * in many ways, with caching of lookups, and possibly with
3490  * a table of pre-allocated vars in every CallFrame for local vars.
3491  * All the caching should also have an 'epoch' mechanism similar
3492  * to the one used by Tcl for procedures lookup caching. */
3493
3494 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3495 {
3496     const char *name;
3497     Jim_Var *var;
3498     int err;
3499
3500     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3501         /* Check for [dict] syntax sugar. */
3502         if (err == JIM_DICT_SUGAR)
3503             return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3504         /* New variable to create */
3505         name = Jim_GetString(nameObjPtr, NULL);
3506
3507         var = Jim_Alloc(sizeof(*var));
3508         var->objPtr = valObjPtr;
3509         Jim_IncrRefCount(valObjPtr);
3510         var->linkFramePtr = NULL;
3511         /* Insert the new variable */
3512         Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3513         /* Make the object int rep a variable */
3514         Jim_FreeIntRep(interp, nameObjPtr);
3515         nameObjPtr->typePtr = &variableObjType;
3516         nameObjPtr->internalRep.varValue.callFrameId =
3517             interp->framePtr->id;
3518         nameObjPtr->internalRep.varValue.varPtr = var;
3519     } else {
3520         var = nameObjPtr->internalRep.varValue.varPtr;
3521         if (var->linkFramePtr == NULL) {
3522             Jim_IncrRefCount(valObjPtr);
3523             Jim_DecrRefCount(interp, var->objPtr);
3524             var->objPtr = valObjPtr;
3525         } else { /* Else handle the link */
3526             Jim_CallFrame *savedCallFrame;
3527
3528             savedCallFrame = interp->framePtr;
3529             interp->framePtr = var->linkFramePtr;
3530             err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3531             interp->framePtr = savedCallFrame;
3532             if (err != JIM_OK)
3533                 return err;
3534         }
3535     }
3536     return JIM_OK;
3537 }
3538
3539 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3540 {
3541     Jim_Obj *nameObjPtr;
3542     int result;
3543
3544     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3545     Jim_IncrRefCount(nameObjPtr);
3546     result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3547     Jim_DecrRefCount(interp, nameObjPtr);
3548     return result;
3549 }
3550
3551 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3552 {
3553     Jim_CallFrame *savedFramePtr;
3554     int result;
3555
3556     savedFramePtr = interp->framePtr;
3557     interp->framePtr = interp->topFramePtr;
3558     result = Jim_SetVariableStr(interp, name, objPtr);
3559     interp->framePtr = savedFramePtr;
3560     return result;
3561 }
3562
3563 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3564 {
3565     Jim_Obj *nameObjPtr, *valObjPtr;
3566     int result;
3567
3568     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3569     valObjPtr = Jim_NewStringObj(interp, val, -1);
3570     Jim_IncrRefCount(nameObjPtr);
3571     Jim_IncrRefCount(valObjPtr);
3572     result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3573     Jim_DecrRefCount(interp, nameObjPtr);
3574     Jim_DecrRefCount(interp, valObjPtr);
3575     return result;
3576 }
3577
3578 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3579         Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3580 {
3581     const char *varName;
3582     int len;
3583
3584     /* Check for cycles. */
3585     if (interp->framePtr == targetCallFrame) {
3586         Jim_Obj *objPtr = targetNameObjPtr;
3587         Jim_Var *varPtr;
3588         /* Cycles are only possible with 'uplevel 0' */
3589         while(1) {
3590             if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3591                 Jim_SetResultString(interp,
3592                     "can't upvar from variable to itself", -1);
3593                 return JIM_ERR;
3594             }
3595             if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3596                 break;
3597             varPtr = objPtr->internalRep.varValue.varPtr;
3598             if (varPtr->linkFramePtr != targetCallFrame) break;
3599             objPtr = varPtr->objPtr;
3600         }
3601     }
3602     varName = Jim_GetString(nameObjPtr, &len);
3603     if (Jim_NameIsDictSugar(varName, len)) {
3604         Jim_SetResultString(interp,
3605             "Dict key syntax invalid as link source", -1);
3606         return JIM_ERR;
3607     }
3608     /* Perform the binding */
3609     Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3610     /* We are now sure 'nameObjPtr' type is variableObjType */
3611     nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3612     return JIM_OK;
3613 }
3614
3615 /* Return the Jim_Obj pointer associated with a variable name,
3616  * or NULL if the variable was not found in the current context.
3617  * The same optimization discussed in the comment to the
3618  * 'SetVariable' function should apply here. */
3619 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3620 {
3621     int err;
3622
3623     /* All the rest is handled here */
3624     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3625         /* Check for [dict] syntax sugar. */
3626         if (err == JIM_DICT_SUGAR)
3627             return JimDictSugarGet(interp, nameObjPtr);
3628         if (flags & JIM_ERRMSG) {
3629             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3630             Jim_AppendStrings(interp, Jim_GetResult(interp),
3631                 "can't read \"", nameObjPtr->bytes,
3632                 "\": no such variable", NULL);
3633         }
3634         return NULL;
3635     } else {
3636         Jim_Var *varPtr;
3637         Jim_Obj *objPtr;
3638         Jim_CallFrame *savedCallFrame;
3639
3640         varPtr = nameObjPtr->internalRep.varValue.varPtr;
3641         if (varPtr->linkFramePtr == NULL)
3642             return varPtr->objPtr;
3643         /* The variable is a link? Resolve it. */
3644         savedCallFrame = interp->framePtr;
3645         interp->framePtr = varPtr->linkFramePtr;
3646         objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3647         if (objPtr == NULL && flags & JIM_ERRMSG) {
3648             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3649             Jim_AppendStrings(interp, Jim_GetResult(interp),
3650                 "can't read \"", nameObjPtr->bytes,
3651                 "\": no such variable", NULL);
3652         }
3653         interp->framePtr = savedCallFrame;
3654         return objPtr;
3655     }
3656 }
3657
3658 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3659         int flags)
3660 {
3661     Jim_CallFrame *savedFramePtr;
3662     Jim_Obj *objPtr;
3663
3664     savedFramePtr = interp->framePtr;
3665     interp->framePtr = interp->topFramePtr;
3666     objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3667     interp->framePtr = savedFramePtr;
3668
3669     return objPtr;
3670 }
3671
3672 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3673 {
3674     Jim_Obj *nameObjPtr, *varObjPtr;
3675
3676     nameObjPtr = Jim_NewStringObj(interp, name, -1);
3677     Jim_IncrRefCount(nameObjPtr);
3678     varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3679     Jim_DecrRefCount(interp, nameObjPtr);
3680     return varObjPtr;
3681 }
3682
3683 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3684         int flags)
3685 {
3686     Jim_CallFrame *savedFramePtr;
3687     Jim_Obj *objPtr;
3688
3689     savedFramePtr = interp->framePtr;
3690     interp->framePtr = interp->topFramePtr;
3691     objPtr = Jim_GetVariableStr(interp, name, flags);
3692     interp->framePtr = savedFramePtr;
3693
3694     return objPtr;
3695 }
3696
3697 /* Unset a variable.
3698  * Note: On success unset invalidates all the variable objects created
3699  * in the current call frame incrementing. */
3700 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3701 {
3702     const char *name;
3703     Jim_Var *varPtr;
3704     int err;
3705     
3706     if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3707         /* Check for [dict] syntax sugar. */
3708         if (err == JIM_DICT_SUGAR)
3709             return JimDictSugarSet(interp, nameObjPtr, NULL);
3710         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3711         Jim_AppendStrings(interp, Jim_GetResult(interp),
3712             "can't unset \"", nameObjPtr->bytes,
3713             "\": no such variable", NULL);
3714         return JIM_ERR; /* var not found */
3715     }
3716     varPtr = nameObjPtr->internalRep.varValue.varPtr;
3717     /* If it's a link call UnsetVariable recursively */
3718     if (varPtr->linkFramePtr) {
3719         int retval;
3720
3721         Jim_CallFrame *savedCallFrame;
3722
3723         savedCallFrame = interp->framePtr;
3724         interp->framePtr = varPtr->linkFramePtr;
3725         retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3726         interp->framePtr = savedCallFrame;
3727         if (retval != JIM_OK && flags & JIM_ERRMSG) {
3728             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3729             Jim_AppendStrings(interp, Jim_GetResult(interp),
3730                 "can't unset \"", nameObjPtr->bytes,
3731                 "\": no such variable", NULL);
3732         }
3733         return retval;
3734     } else {
3735         name = Jim_GetString(nameObjPtr, NULL);
3736         if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3737                 != JIM_OK) return JIM_ERR;
3738         /* Change the callframe id, invalidating var lookup caching */
3739         JimChangeCallFrameId(interp, interp->framePtr);
3740         return JIM_OK;
3741     }
3742 }
3743
3744 /* ----------  Dict syntax sugar (similar to array Tcl syntax) -------------- */
3745
3746 /* Given a variable name for [dict] operation syntax sugar,
3747  * this function returns two objects, the first with the name
3748  * of the variable to set, and the second with the rispective key.
3749  * For example "foo(bar)" will return objects with string repr. of
3750  * "foo" and "bar".
3751  *
3752  * The returned objects have refcount = 1. The function can't fail. */
3753 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3754         Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3755 {
3756     const char *str, *p;
3757     char *t;
3758     int len, keyLen, nameLen;
3759     Jim_Obj *varObjPtr, *keyObjPtr;
3760
3761     str = Jim_GetString(objPtr, &len);
3762     p = strchr(str, '(');
3763     p++;
3764     keyLen = len-((p-str)+1);
3765     nameLen = (p-str)-1;
3766     /* Create the objects with the variable name and key. */
3767     t = Jim_Alloc(nameLen+1);
3768     memcpy(t, str, nameLen);
3769     t[nameLen] = '\0';
3770     varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3771
3772     t = Jim_Alloc(keyLen+1);
3773     memcpy(t, p, keyLen);
3774     t[keyLen] = '\0';
3775     keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3776
3777     Jim_IncrRefCount(varObjPtr);
3778     Jim_IncrRefCount(keyObjPtr);
3779     *varPtrPtr = varObjPtr;
3780     *keyPtrPtr = keyObjPtr;
3781 }
3782
3783 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3784  * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3785 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3786         Jim_Obj *valObjPtr)
3787 {
3788     Jim_Obj *varObjPtr, *keyObjPtr;
3789     int err = JIM_OK;
3790
3791     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3792     err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3793             valObjPtr);
3794     Jim_DecrRefCount(interp, varObjPtr);
3795     Jim_DecrRefCount(interp, keyObjPtr);
3796     return err;
3797 }
3798
3799 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3800 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3801 {
3802     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3803
3804     JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3805     dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3806     if (!dictObjPtr) {
3807         resObjPtr = NULL;
3808         goto err;
3809     }
3810     if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3811             != JIM_OK) {
3812         resObjPtr = NULL;
3813     }
3814 err:
3815     Jim_DecrRefCount(interp, varObjPtr);
3816     Jim_DecrRefCount(interp, keyObjPtr);
3817     return resObjPtr;
3818 }
3819
3820 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3821
3822 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3823 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3824         Jim_Obj *dupPtr);
3825
3826 static Jim_ObjType dictSubstObjType = {
3827     "dict-substitution",
3828     FreeDictSubstInternalRep,
3829     DupDictSubstInternalRep,
3830     NULL,
3831     JIM_TYPE_NONE,
3832 };
3833
3834 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3835 {
3836     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3837     Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3838 }
3839
3840 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3841         Jim_Obj *dupPtr)
3842 {
3843     JIM_NOTUSED(interp);
3844
3845     dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3846         srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3847     dupPtr->internalRep.dictSubstValue.indexObjPtr =
3848         srcPtr->internalRep.dictSubstValue.indexObjPtr;
3849     dupPtr->typePtr = &dictSubstObjType;
3850 }
3851
3852 /* This function is used to expand [dict get] sugar in the form
3853  * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3854  * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3855  * object that is *guaranteed* to be in the form VARNAME(INDEX).
3856  * The 'index' part is [subst]ituted, and is used to lookup a key inside
3857  * the [dict]ionary contained in variable VARNAME. */
3858 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3859 {
3860     Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3861     Jim_Obj *substKeyObjPtr = NULL;
3862
3863     if (objPtr->typePtr != &dictSubstObjType) {
3864         JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3865         Jim_FreeIntRep(interp, objPtr);
3866         objPtr->typePtr = &dictSubstObjType;
3867         objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3868         objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3869     }
3870     if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3871                 &substKeyObjPtr, JIM_NONE)
3872             != JIM_OK) {
3873         substKeyObjPtr = NULL;
3874         goto err;
3875     }
3876     Jim_IncrRefCount(substKeyObjPtr);
3877     dictObjPtr = Jim_GetVariable(interp,
3878             objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3879     if (!dictObjPtr) {
3880         resObjPtr = NULL;
3881         goto err;
3882     }
3883     if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3884             != JIM_OK) {
3885         resObjPtr = NULL;
3886         goto err;
3887     }
3888 err:
3889     if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3890     return resObjPtr;
3891 }
3892
3893 /* -----------------------------------------------------------------------------
3894  * CallFrame
3895  * ---------------------------------------------------------------------------*/
3896
3897 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3898 {
3899     Jim_CallFrame *cf;
3900     if (interp->freeFramesList) {
3901         cf = interp->freeFramesList;
3902         interp->freeFramesList = cf->nextFramePtr;
3903     } else {
3904         cf = Jim_Alloc(sizeof(*cf));
3905         cf->vars.table = NULL;
3906     }
3907
3908     cf->id = interp->callFrameEpoch++;
3909     cf->parentCallFrame = NULL;
3910     cf->argv = NULL;
3911     cf->argc = 0;
3912     cf->procArgsObjPtr = NULL;
3913     cf->procBodyObjPtr = NULL;
3914     cf->nextFramePtr = NULL;
3915     cf->staticVars = NULL;
3916     if (cf->vars.table == NULL)
3917         Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3918     return cf;
3919 }
3920
3921 /* Used to invalidate every caching related to callframe stability. */
3922 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3923 {
3924     cf->id = interp->callFrameEpoch++;
3925 }
3926
3927 #define JIM_FCF_NONE 0 /* no flags */
3928 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3929 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3930         int flags)
3931 {
3932     if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3933     if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3934     if (!(flags & JIM_FCF_NOHT))
3935         Jim_FreeHashTable(&cf->vars);
3936     else {
3937         int i;
3938         Jim_HashEntry **table = cf->vars.table, *he;
3939
3940         for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3941             he = table[i];
3942             while (he != NULL) {
3943                 Jim_HashEntry *nextEntry = he->next;
3944                 Jim_Var *varPtr = (void*) he->val;
3945
3946                 Jim_DecrRefCount(interp, varPtr->objPtr);
3947                 Jim_Free(he->val);
3948                 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3949                 Jim_Free(he);
3950                 table[i] = NULL;
3951                 he = nextEntry;
3952             }
3953         }
3954         cf->vars.used = 0;
3955     }
3956     cf->nextFramePtr = interp->freeFramesList;
3957     interp->freeFramesList = cf;
3958 }
3959
3960 /* -----------------------------------------------------------------------------
3961  * References
3962  * ---------------------------------------------------------------------------*/
3963
3964 /* References HashTable Type.
3965  *
3966  * Keys are jim_wide integers, dynamically allocated for now but in the
3967  * future it's worth to cache this 8 bytes objects. Values are poitners
3968  * to Jim_References. */
3969 static void JimReferencesHTValDestructor(void *interp, void *val)
3970 {
3971     Jim_Reference *refPtr = (void*) val;
3972
3973     Jim_DecrRefCount(interp, refPtr->objPtr);
3974     if (refPtr->finalizerCmdNamePtr != NULL) {
3975         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
3976     }
3977     Jim_Free(val);
3978 }
3979
3980 unsigned int JimReferencesHTHashFunction(const void *key)
3981 {
3982     /* Only the least significant bits are used. */
3983     const jim_wide *widePtr = key;
3984     unsigned int intValue = (unsigned int) *widePtr;
3985     return Jim_IntHashFunction(intValue);
3986 }
3987
3988 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
3989 {
3990     /* Only the least significant bits are used. */
3991     const jim_wide *widePtr = key;
3992     unsigned int intValue = (unsigned int) *widePtr;
3993     return intValue; /* identity function. */
3994 }
3995
3996 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
3997 {
3998     void *copy = Jim_Alloc(sizeof(jim_wide));
3999     JIM_NOTUSED(privdata);
4000
4001     memcpy(copy, key, sizeof(jim_wide));
4002     return copy;
4003 }
4004
4005 int JimReferencesHTKeyCompare(void *privdata, const void *key1, 
4006         const void *key2)
4007 {
4008     JIM_NOTUSED(privdata);
4009
4010     return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4011 }
4012
4013 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4014 {
4015     JIM_NOTUSED(privdata);
4016
4017     Jim_Free((void*)key);
4018 }
4019
4020 static Jim_HashTableType JimReferencesHashTableType = {
4021     JimReferencesHTHashFunction,    /* hash function */
4022     JimReferencesHTKeyDup,          /* key dup */
4023     NULL,                           /* val dup */
4024     JimReferencesHTKeyCompare,      /* key compare */
4025     JimReferencesHTKeyDestructor,   /* key destructor */
4026     JimReferencesHTValDestructor    /* val destructor */
4027 };
4028
4029 /* -----------------------------------------------------------------------------
4030  * Reference object type and References API
4031  * ---------------------------------------------------------------------------*/
4032
4033 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4034
4035 static Jim_ObjType referenceObjType = {
4036     "reference",
4037     NULL,
4038     NULL,
4039     UpdateStringOfReference,
4040     JIM_TYPE_REFERENCES,
4041 };
4042
4043 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4044 {
4045     int len;
4046     char buf[JIM_REFERENCE_SPACE+1];
4047     Jim_Reference *refPtr;
4048
4049     refPtr = objPtr->internalRep.refValue.refPtr;
4050     len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4051     objPtr->bytes = Jim_Alloc(len+1);
4052     memcpy(objPtr->bytes, buf, len+1);
4053     objPtr->length = len;
4054 }
4055
4056 /* returns true if 'c' is a valid reference tag character.
4057  * i.e. inside the range [_a-zA-Z0-9] */
4058 static int isrefchar(int c)
4059 {
4060     if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4061         (c >= '0' && c <= '9')) return 1;
4062     return 0;
4063 }
4064
4065 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4066 {
4067     jim_wide wideValue;
4068     int i, len;
4069     const char *str, *start, *end;
4070     char refId[21];
4071     Jim_Reference *refPtr;
4072     Jim_HashEntry *he;
4073
4074     /* Get the string representation */
4075     str = Jim_GetString(objPtr, &len);
4076     /* Check if it looks like a reference */
4077     if (len < JIM_REFERENCE_SPACE) goto badformat;
4078     /* Trim spaces */
4079     start = str;
4080     end = str+len-1;
4081     while (*start == ' ') start++;
4082     while (*end == ' ' && end > start) end--;
4083     if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4084     /* <reference.<1234567>.%020> */
4085     if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4086     if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4087     /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4088     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4089         if (!isrefchar(start[12+i])) goto badformat;
4090     }
4091     /* Extract info from the refernece. */
4092     memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4093     refId[20] = '\0';
4094     /* Try to convert the ID into a jim_wide */
4095     if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4096     /* Check if the reference really exists! */
4097     he = Jim_FindHashEntry(&interp->references, &wideValue);
4098     if (he == NULL) {
4099         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4100         Jim_AppendStrings(interp, Jim_GetResult(interp),
4101                 "Invalid reference ID \"", str, "\"", NULL);
4102         return JIM_ERR;
4103     }
4104     refPtr = he->val;
4105     /* Free the old internal repr and set the new one. */
4106     Jim_FreeIntRep(interp, objPtr);
4107     objPtr->typePtr = &referenceObjType;
4108     objPtr->internalRep.refValue.id = wideValue;
4109     objPtr->internalRep.refValue.refPtr = refPtr;
4110     return JIM_OK;
4111
4112 badformat:
4113     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4114     Jim_AppendStrings(interp, Jim_GetResult(interp),
4115             "expected reference but got \"", str, "\"", NULL);
4116     return JIM_ERR;
4117 }
4118
4119 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4120  * as finalizer command (or NULL if there is no finalizer).
4121  * The returned reference object has refcount = 0. */
4122 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4123         Jim_Obj *cmdNamePtr)
4124 {
4125     struct Jim_Reference *refPtr;
4126     jim_wide wideValue = interp->referenceNextId;
4127     Jim_Obj *refObjPtr;
4128     const char *tag;
4129     int tagLen, i;
4130
4131     /* Perform the Garbage Collection if needed. */
4132     Jim_CollectIfNeeded(interp);
4133
4134     refPtr = Jim_Alloc(sizeof(*refPtr));
4135     refPtr->objPtr = objPtr;
4136     Jim_IncrRefCount(objPtr);
4137     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4138     if (cmdNamePtr)
4139         Jim_IncrRefCount(cmdNamePtr);
4140     Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4141     refObjPtr = Jim_NewObj(interp);
4142     refObjPtr->typePtr = &referenceObjType;
4143     refObjPtr->bytes = NULL;
4144     refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4145     refObjPtr->internalRep.refValue.refPtr = refPtr;
4146     interp->referenceNextId++;
4147     /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4148      * that does not pass the 'isrefchar' test is replaced with '_' */
4149     tag = Jim_GetString(tagPtr, &tagLen);
4150     if (tagLen > JIM_REFERENCE_TAGLEN)
4151         tagLen = JIM_REFERENCE_TAGLEN;
4152     for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4153         if (i < tagLen)
4154             refPtr->tag[i] = tag[i];
4155         else
4156             refPtr->tag[i] = '_';
4157     }
4158     refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4159     return refObjPtr;
4160 }
4161
4162 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4163 {
4164     if (objPtr->typePtr != &referenceObjType &&
4165         SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4166         return NULL;
4167     return objPtr->internalRep.refValue.refPtr;
4168 }
4169
4170 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4171 {
4172     Jim_Reference *refPtr;
4173
4174     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4175         return JIM_ERR;
4176     Jim_IncrRefCount(cmdNamePtr);
4177     if (refPtr->finalizerCmdNamePtr)
4178         Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4179     refPtr->finalizerCmdNamePtr = cmdNamePtr;
4180     return JIM_OK;
4181 }
4182
4183 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4184 {
4185     Jim_Reference *refPtr;
4186
4187     if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4188         return JIM_ERR;
4189     *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4190     return JIM_OK;
4191 }
4192
4193 /* -----------------------------------------------------------------------------
4194  * References Garbage Collection
4195  * ---------------------------------------------------------------------------*/
4196
4197 /* This the hash table type for the "MARK" phase of the GC */
4198 static Jim_HashTableType JimRefMarkHashTableType = {
4199     JimReferencesHTHashFunction,    /* hash function */
4200     JimReferencesHTKeyDup,          /* key dup */
4201     NULL,                           /* val dup */
4202     JimReferencesHTKeyCompare,      /* key compare */
4203     JimReferencesHTKeyDestructor,   /* key destructor */
4204     NULL                            /* val destructor */
4205 };
4206
4207 /* #define JIM_DEBUG_GC 1 */
4208
4209 /* Performs the garbage collection. */
4210 int Jim_Collect(Jim_Interp *interp)
4211 {
4212     Jim_HashTable marks;
4213     Jim_HashTableIterator *htiter;
4214     Jim_HashEntry *he;
4215     Jim_Obj *objPtr;
4216     int collected = 0;
4217
4218     /* Avoid recursive calls */
4219     if (interp->lastCollectId == -1) {
4220         /* Jim_Collect() already running. Return just now. */
4221         return 0;
4222     }
4223     interp->lastCollectId = -1;
4224
4225     /* Mark all the references found into the 'mark' hash table.
4226      * The references are searched in every live object that
4227      * is of a type that can contain references. */
4228     Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4229     objPtr = interp->liveList;
4230     while(objPtr) {
4231         if (objPtr->typePtr == NULL ||
4232             objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4233             const char *str, *p;
4234             int len;
4235
4236             /* If the object is of type reference, to get the
4237              * Id is simple... */
4238             if (objPtr->typePtr == &referenceObjType) {
4239                 Jim_AddHashEntry(&marks,
4240                     &objPtr->internalRep.refValue.id, NULL);
4241 #ifdef JIM_DEBUG_GC
4242                 Jim_fprintf(interp,interp->cookie_stdout,
4243                     "MARK (reference): %d refcount: %d" JIM_NL, 
4244                     (int) objPtr->internalRep.refValue.id,
4245                     objPtr->refCount);
4246 #endif
4247                 objPtr = objPtr->nextObjPtr;
4248                 continue;
4249             }
4250             /* Get the string repr of the object we want
4251              * to scan for references. */
4252             p = str = Jim_GetString(objPtr, &len);
4253             /* Skip objects too little to contain references. */
4254             if (len < JIM_REFERENCE_SPACE) {
4255                 objPtr = objPtr->nextObjPtr;
4256                 continue;
4257             }
4258             /* Extract references from the object string repr. */
4259             while(1) {
4260                 int i;
4261                 jim_wide id;
4262                 char buf[21];
4263
4264                 if ((p = strstr(p, "<reference.<")) == NULL)
4265                     break;
4266                 /* Check if it's a valid reference. */
4267                 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4268                 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4269                 for (i = 21; i <= 40; i++)
4270                     if (!isdigit((int)p[i]))
4271                         break;
4272                 /* Get the ID */
4273                 memcpy(buf, p+21, 20);
4274                 buf[20] = '\0';
4275                 Jim_StringToWide(buf, &id, 10);
4276
4277                 /* Ok, a reference for the given ID
4278                  * was found. Mark it. */
4279                 Jim_AddHashEntry(&marks, &id, NULL);
4280 #ifdef JIM_DEBUG_GC
4281                 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4282 #endif
4283                 p += JIM_REFERENCE_SPACE;
4284             }
4285         }
4286         objPtr = objPtr->nextObjPtr;
4287     }
4288
4289     /* Run the references hash table to destroy every reference that
4290      * is not referenced outside (not present in the mark HT). */
4291     htiter = Jim_GetHashTableIterator(&interp->references);
4292     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4293         const jim_wide *refId;
4294         Jim_Reference *refPtr;
4295
4296         refId = he->key;
4297         /* Check if in the mark phase we encountered
4298          * this reference. */
4299         if (Jim_FindHashEntry(&marks, refId) == NULL) {
4300 #ifdef JIM_DEBUG_GC
4301             Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4302 #endif
4303             collected++;
4304             /* Drop the reference, but call the
4305              * finalizer first if registered. */
4306             refPtr = he->val;
4307             if (refPtr->finalizerCmdNamePtr) {
4308                 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4309                 Jim_Obj *objv[3], *oldResult;
4310
4311                 JimFormatReference(refstr, refPtr, *refId);
4312
4313                 objv[0] = refPtr->finalizerCmdNamePtr;
4314                 objv[1] = Jim_NewStringObjNoAlloc(interp,
4315                         refstr, 32);
4316                 objv[2] = refPtr->objPtr;
4317                 Jim_IncrRefCount(objv[0]);
4318                 Jim_IncrRefCount(objv[1]);
4319                 Jim_IncrRefCount(objv[2]);
4320
4321                 /* Drop the reference itself */
4322                 Jim_DeleteHashEntry(&interp->references, refId);
4323
4324                 /* Call the finalizer. Errors ignored. */
4325                 oldResult = interp->result;
4326                 Jim_IncrRefCount(oldResult);
4327                 Jim_EvalObjVector(interp, 3, objv);
4328                 Jim_SetResult(interp, oldResult);
4329                 Jim_DecrRefCount(interp, oldResult);
4330
4331                 Jim_DecrRefCount(interp, objv[0]);
4332                 Jim_DecrRefCount(interp, objv[1]);
4333                 Jim_DecrRefCount(interp, objv[2]);
4334             } else {
4335                 Jim_DeleteHashEntry(&interp->references, refId);
4336             }
4337         }
4338     }
4339     Jim_FreeHashTableIterator(htiter);
4340     Jim_FreeHashTable(&marks);
4341     interp->lastCollectId = interp->referenceNextId;
4342     interp->lastCollectTime = time(NULL);
4343     return collected;
4344 }
4345
4346 #define JIM_COLLECT_ID_PERIOD 5000
4347 #define JIM_COLLECT_TIME_PERIOD 300
4348
4349 void Jim_CollectIfNeeded(Jim_Interp *interp)
4350 {
4351     jim_wide elapsedId;
4352     int elapsedTime;
4353     
4354     elapsedId = interp->referenceNextId - interp->lastCollectId;
4355     elapsedTime = time(NULL) - interp->lastCollectTime;
4356
4357
4358     if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4359         elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4360         Jim_Collect(interp);
4361     }
4362 }
4363
4364 /* -----------------------------------------------------------------------------
4365  * Interpreter related functions
4366  * ---------------------------------------------------------------------------*/
4367
4368 Jim_Interp *Jim_CreateInterp(void)
4369 {
4370     Jim_Interp *i = Jim_Alloc(sizeof(*i));
4371     Jim_Obj *pathPtr;
4372
4373     i->errorLine = 0;
4374     i->errorFileName = Jim_StrDup("");
4375     i->numLevels = 0;
4376     i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4377     i->returnCode = JIM_OK;
4378     i->exitCode = 0;
4379     i->procEpoch = 0;
4380     i->callFrameEpoch = 0;
4381     i->liveList = i->freeList = NULL;
4382     i->scriptFileName = Jim_StrDup("");
4383     i->referenceNextId = 0;
4384     i->lastCollectId = 0;
4385     i->lastCollectTime = time(NULL);
4386     i->freeFramesList = NULL;
4387     i->prngState = NULL;
4388     i->evalRetcodeLevel = -1;
4389     i->cookie_stdin = stdin;
4390     i->cookie_stdout = stdout;
4391     i->cookie_stderr = stderr;
4392         i->cb_fwrite   = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4393         i->cb_fread    = ((size_t (*)(       void *, size_t, size_t, void *))(fread));
4394         i->cb_vfprintf = ((int    (*)( void *, const char *fmt, va_list ))(vfprintf));
4395         i->cb_fflush   = ((int    (*)( void *))(fflush));
4396         i->cb_fgets    = ((char * (*)( char *, int, void *))(fgets));
4397
4398     /* Note that we can create objects only after the
4399      * interpreter liveList and freeList pointers are
4400      * initialized to NULL. */
4401     Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4402     Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4403     Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4404             NULL);
4405     Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4406     Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4407     Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4408     i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4409     i->emptyObj = Jim_NewEmptyStringObj(i);
4410     i->result = i->emptyObj;
4411     i->stackTrace = Jim_NewListObj(i, NULL, 0);
4412     i->unknown = Jim_NewStringObj(i, "unknown", -1);
4413     Jim_IncrRefCount(i->emptyObj);
4414     Jim_IncrRefCount(i->result);
4415     Jim_IncrRefCount(i->stackTrace);
4416     Jim_IncrRefCount(i->unknown);
4417
4418     /* Initialize key variables every interpreter should contain */
4419     pathPtr = Jim_NewStringObj(i, "./", -1);
4420     Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4421     Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4422
4423     /* Export the core API to extensions */
4424     JimRegisterCoreApi(i);
4425     return i;
4426 }
4427
4428 /* This is the only function Jim exports directly without
4429  * to use the STUB system. It is only used by embedders
4430  * in order to get an interpreter with the Jim API pointers
4431  * registered. */
4432 Jim_Interp *ExportedJimCreateInterp(void)
4433 {
4434     return Jim_CreateInterp();
4435 }
4436
4437 void Jim_FreeInterp(Jim_Interp *i)
4438 {
4439     Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4440     Jim_Obj *objPtr, *nextObjPtr;
4441
4442     Jim_DecrRefCount(i, i->emptyObj);
4443     Jim_DecrRefCount(i, i->result);
4444     Jim_DecrRefCount(i, i->stackTrace);
4445     Jim_DecrRefCount(i, i->unknown);
4446     Jim_Free((void*)i->errorFileName);
4447     Jim_Free((void*)i->scriptFileName);
4448     Jim_FreeHashTable(&i->commands);
4449     Jim_FreeHashTable(&i->references);
4450     Jim_FreeHashTable(&i->stub);
4451     Jim_FreeHashTable(&i->assocData);
4452     Jim_FreeHashTable(&i->packages);
4453     Jim_Free(i->prngState);
4454     /* Free the call frames list */
4455     while(cf) {
4456         prevcf = cf->parentCallFrame;
4457         JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4458         cf = prevcf;
4459     }
4460     /* Check that the live object list is empty, otherwise
4461      * there is a memory leak. */
4462     if (i->liveList != NULL) {
4463         Jim_Obj *objPtr = i->liveList;
4464     
4465         Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4466         Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4467         while(objPtr) {
4468             const char *type = objPtr->typePtr ?
4469                 objPtr->typePtr->name : "";
4470             Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4471                     objPtr, type,
4472                     objPtr->bytes ? objPtr->bytes
4473                     : "(null)", objPtr->refCount);
4474             if (objPtr->typePtr == &sourceObjType) {
4475                 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4476                 objPtr->internalRep.sourceValue.fileName,
4477                 objPtr->internalRep.sourceValue.lineNumber);
4478             }
4479             objPtr = objPtr->nextObjPtr;
4480         }
4481         Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4482         Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4483     }
4484     /* Free all the freed objects. */
4485     objPtr = i->freeList;
4486     while (objPtr) {
4487         nextObjPtr = objPtr->nextObjPtr;
4488         Jim_Free(objPtr);
4489         objPtr = nextObjPtr;
4490     }
4491     /* Free cached CallFrame structures */
4492     cf = i->freeFramesList;
4493     while(cf) {
4494         nextcf = cf->nextFramePtr;
4495         if (cf->vars.table != NULL)
4496             Jim_Free(cf->vars.table);
4497         Jim_Free(cf);
4498         cf = nextcf;
4499     }
4500     /* Free the sharedString hash table. Make sure to free it
4501      * after every other Jim_Object was freed. */
4502     Jim_FreeHashTable(&i->sharedStrings);
4503     /* Free the interpreter structure. */
4504     Jim_Free(i);
4505 }
4506
4507 /* Store the call frame relative to the level represented by
4508  * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4509  * level is assumed to be '1'.
4510  *
4511  * If a newLevelptr int pointer is specified, the function stores
4512  * the absolute level integer value of the new target callframe into
4513  * *newLevelPtr. (this is used to adjust interp->numLevels
4514  * in the implementation of [uplevel], so that [info level] will
4515  * return a correct information).
4516  *
4517  * This function accepts the 'level' argument in the form
4518  * of the commands [uplevel] and [upvar].
4519  *
4520  * For a function accepting a relative integer as level suitable
4521  * for implementation of [info level ?level?] check the
4522  * GetCallFrameByInteger() function. */
4523 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4524         Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4525 {
4526     long level;
4527     const char *str;
4528     Jim_CallFrame *framePtr;
4529
4530     if (newLevelPtr) *newLevelPtr = interp->numLevels;
4531     if (levelObjPtr) {
4532         str = Jim_GetString(levelObjPtr, NULL);
4533         if (str[0] == '#') {
4534             char *endptr;
4535             /* speedup for the toplevel (level #0) */
4536             if (str[1] == '0' && str[2] == '\0') {
4537                 if (newLevelPtr) *newLevelPtr = 0;
4538                 *framePtrPtr = interp->topFramePtr;
4539                 return JIM_OK;
4540             }
4541
4542             level = strtol(str+1, &endptr, 0);
4543             if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4544                 goto badlevel;
4545             /* An 'absolute' level is converted into the
4546              * 'number of levels to go back' format. */
4547             level = interp->numLevels - level;
4548             if (level < 0) goto badlevel;
4549         } else {
4550             if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4551                 goto badlevel;
4552         }
4553     } else {
4554         str = "1"; /* Needed to format the error message. */
4555         level = 1;
4556     }
4557     /* Lookup */
4558     framePtr = interp->framePtr;
4559     if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4560     while (level--) {
4561         framePtr = framePtr->parentCallFrame;
4562         if (framePtr == NULL) goto badlevel;
4563     }
4564     *framePtrPtr = framePtr;
4565     return JIM_OK;
4566 badlevel:
4567     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4568     Jim_AppendStrings(interp, Jim_GetResult(interp),
4569             "bad level \"", str, "\"", NULL);
4570     return JIM_ERR;
4571 }
4572
4573 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4574  * as a relative integer like in the [info level ?level?] command. */
4575 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4576         Jim_CallFrame **framePtrPtr)
4577 {
4578     jim_wide level;
4579     jim_wide relLevel; /* level relative to the current one. */
4580     Jim_CallFrame *framePtr;
4581
4582     if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4583         goto badlevel;
4584     if (level > 0) {
4585         /* An 'absolute' level is converted into the
4586          * 'number of levels to go back' format. */
4587         relLevel = interp->numLevels - level;
4588     } else {
4589         relLevel = -level;
4590     }
4591     /* Lookup */
4592     framePtr = interp->framePtr;
4593     while (relLevel--) {
4594         framePtr = framePtr->parentCallFrame;
4595         if (framePtr == NULL) goto badlevel;
4596     }
4597     *framePtrPtr = framePtr;
4598     return JIM_OK;
4599 badlevel:
4600     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4601     Jim_AppendStrings(interp, Jim_GetResult(interp),
4602             "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4603     return JIM_ERR;
4604 }
4605
4606 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4607 {
4608     Jim_Free((void*)interp->errorFileName);
4609     interp->errorFileName = Jim_StrDup(filename);
4610 }
4611
4612 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4613 {
4614     interp->errorLine = linenr;
4615 }
4616
4617 static void JimResetStackTrace(Jim_Interp *interp)
4618 {
4619     Jim_DecrRefCount(interp, interp->stackTrace);
4620     interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4621     Jim_IncrRefCount(interp->stackTrace);
4622 }
4623
4624 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4625         const char *filename, int linenr)
4626 {
4627     if (Jim_IsShared(interp->stackTrace)) {
4628         interp->stackTrace =
4629             Jim_DuplicateObj(interp, interp->stackTrace);
4630         Jim_IncrRefCount(interp->stackTrace);
4631     }
4632     Jim_ListAppendElement(interp, interp->stackTrace,
4633             Jim_NewStringObj(interp, procname, -1));
4634     Jim_ListAppendElement(interp, interp->stackTrace,
4635             Jim_NewStringObj(interp, filename, -1));
4636     Jim_ListAppendElement(interp, interp->stackTrace,
4637             Jim_NewIntObj(interp, linenr));
4638 }
4639
4640 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4641 {
4642     AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4643     assocEntryPtr->delProc = delProc;
4644     assocEntryPtr->data = data;
4645     return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4646 }
4647
4648 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4649 {
4650     Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4651     if (entryPtr != NULL) {
4652         AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4653         return assocEntryPtr->data;
4654     }
4655     return NULL;
4656 }
4657
4658 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4659 {
4660     return Jim_DeleteHashEntry(&interp->assocData, key);
4661 }
4662
4663 int Jim_GetExitCode(Jim_Interp *interp) {
4664     return interp->exitCode;
4665 }
4666
4667 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4668 {
4669     if (fp != NULL) interp->cookie_stdin = fp;
4670     return interp->cookie_stdin;
4671 }
4672
4673 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4674 {
4675     if (fp != NULL) interp->cookie_stdout = fp;
4676     return interp->cookie_stdout;
4677 }
4678
4679 void *Jim_SetStderr(Jim_Interp *interp, void  *fp)
4680 {
4681     if (fp != NULL) interp->cookie_stderr = fp;
4682     return interp->cookie_stderr;
4683 }
4684
4685 /* -----------------------------------------------------------------------------
4686  * Shared strings.
4687  * Every interpreter has an hash table where to put shared dynamically
4688  * allocate strings that are likely to be used a lot of times.
4689  * For example, in the 'source' object type, there is a pointer to
4690  * the filename associated with that object. Every script has a lot
4691  * of this objects with the identical file name, so it is wise to share
4692  * this info.
4693  *
4694  * The API is trivial: Jim_GetSharedString(interp, "foobar")
4695  * returns the pointer to the shared string. Every time a reference
4696  * to the string is no longer used, the user should call
4697  * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4698  * a given string, it is removed from the hash table.
4699  * ---------------------------------------------------------------------------*/
4700 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4701 {
4702     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4703
4704     if (he == NULL) {
4705         char *strCopy = Jim_StrDup(str);
4706
4707         Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4708         return strCopy;
4709     } else {
4710         long refCount = (long) he->val;
4711
4712         refCount++;
4713         he->val = (void*) refCount;
4714         return he->key;
4715     }
4716 }
4717
4718 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4719 {
4720     long refCount;
4721     Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4722
4723     if (he == NULL)
4724         Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4725               "unknown shared string '%s'", str);
4726     refCount = (long) he->val;
4727     refCount--;
4728     if (refCount == 0) {
4729         Jim_DeleteHashEntry(&interp->sharedStrings, str);
4730     } else {
4731         he->val = (void*) refCount;
4732     }
4733 }
4734
4735 /* -----------------------------------------------------------------------------
4736  * Integer object
4737  * ---------------------------------------------------------------------------*/
4738 #define JIM_INTEGER_SPACE 24
4739
4740 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4741 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4742
4743 static Jim_ObjType intObjType = {
4744     "int",
4745     NULL,
4746     NULL,
4747     UpdateStringOfInt,
4748     JIM_TYPE_NONE,
4749 };
4750
4751 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4752 {
4753     int len;
4754     char buf[JIM_INTEGER_SPACE+1];
4755
4756     len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4757     objPtr->bytes = Jim_Alloc(len+1);
4758     memcpy(objPtr->bytes, buf, len+1);
4759     objPtr->length = len;
4760 }
4761
4762 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4763 {
4764     jim_wide wideValue;
4765     const char *str;
4766
4767     /* Get the string representation */
4768     str = Jim_GetString(objPtr, NULL);
4769     /* Try to convert into a jim_wide */
4770     if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4771         if (flags & JIM_ERRMSG) {
4772             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4773             Jim_AppendStrings(interp, Jim_GetResult(interp),
4774                     "expected integer but got \"", str, "\"", NULL);
4775         }
4776         return JIM_ERR;
4777     }
4778     if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4779         errno == ERANGE) {
4780         Jim_SetResultString(interp,
4781             "Integer value too big to be represented", -1);
4782         return JIM_ERR;
4783     }
4784     /* Free the old internal repr and set the new one. */
4785     Jim_FreeIntRep(interp, objPtr);
4786     objPtr->typePtr = &intObjType;
4787     objPtr->internalRep.wideValue = wideValue;
4788     return JIM_OK;
4789 }
4790
4791 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4792 {
4793     if (objPtr->typePtr != &intObjType &&
4794         SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4795         return JIM_ERR;
4796     *widePtr = objPtr->internalRep.wideValue;
4797     return JIM_OK;
4798 }
4799
4800 /* Get a wide but does not set an error if the format is bad. */
4801 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4802         jim_wide *widePtr)
4803 {
4804     if (objPtr->typePtr != &intObjType &&
4805         SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4806         return JIM_ERR;
4807     *widePtr = objPtr->internalRep.wideValue;
4808     return JIM_OK;
4809 }
4810
4811 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4812 {
4813     jim_wide wideValue;
4814     int retval;
4815
4816     retval = Jim_GetWide(interp, objPtr, &wideValue);
4817     if (retval == JIM_OK) {
4818         *longPtr = (long) wideValue;
4819         return JIM_OK;
4820     }
4821     return JIM_ERR;
4822 }
4823
4824 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4825 {
4826     if (Jim_IsShared(objPtr))
4827         Jim_Panic(interp,"Jim_SetWide called with shared object");
4828     if (objPtr->typePtr != &intObjType) {
4829         Jim_FreeIntRep(interp, objPtr);
4830         objPtr->typePtr = &intObjType;
4831     }
4832     Jim_InvalidateStringRep(objPtr);
4833     objPtr->internalRep.wideValue = wideValue;
4834 }
4835
4836 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4837 {
4838     Jim_Obj *objPtr;
4839
4840     objPtr = Jim_NewObj(interp);
4841     objPtr->typePtr = &intObjType;
4842     objPtr->bytes = NULL;
4843     objPtr->internalRep.wideValue = wideValue;
4844     return objPtr;
4845 }
4846
4847 /* -----------------------------------------------------------------------------
4848  * Double object
4849  * ---------------------------------------------------------------------------*/
4850 #define JIM_DOUBLE_SPACE 30
4851
4852 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4853 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4854
4855 static Jim_ObjType doubleObjType = {
4856     "double",
4857     NULL,
4858     NULL,
4859     UpdateStringOfDouble,
4860     JIM_TYPE_NONE,
4861 };
4862
4863 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4864 {
4865     int len;
4866     char buf[JIM_DOUBLE_SPACE+1];
4867
4868     len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4869     objPtr->bytes = Jim_Alloc(len+1);
4870     memcpy(objPtr->bytes, buf, len+1);
4871     objPtr->length = len;
4872 }
4873
4874 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4875 {
4876     double doubleValue;
4877     const char *str;
4878
4879     /* Get the string representation */
4880     str = Jim_GetString(objPtr, NULL);
4881     /* Try to convert into a double */
4882     if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4883         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4884         Jim_AppendStrings(interp, Jim_GetResult(interp),
4885                 "expected number but got '", str, "'", NULL);
4886         return JIM_ERR;
4887     }
4888     /* Free the old internal repr and set the new one. */
4889     Jim_FreeIntRep(interp, objPtr);
4890     objPtr->typePtr = &doubleObjType;
4891     objPtr->internalRep.doubleValue = doubleValue;
4892     return JIM_OK;
4893 }
4894
4895 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4896 {
4897     if (objPtr->typePtr != &doubleObjType &&
4898         SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4899         return JIM_ERR;
4900     *doublePtr = objPtr->internalRep.doubleValue;
4901     return JIM_OK;
4902 }
4903
4904 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4905 {
4906     if (Jim_IsShared(objPtr))
4907         Jim_Panic(interp,"Jim_SetDouble called with shared object");
4908     if (objPtr->typePtr != &doubleObjType) {
4909         Jim_FreeIntRep(interp, objPtr);
4910         objPtr->typePtr = &doubleObjType;
4911     }
4912     Jim_InvalidateStringRep(objPtr);
4913     objPtr->internalRep.doubleValue = doubleValue;
4914 }
4915
4916 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4917 {
4918     Jim_Obj *objPtr;
4919
4920     objPtr = Jim_NewObj(interp);
4921     objPtr->typePtr = &doubleObjType;
4922     objPtr->bytes = NULL;
4923     objPtr->internalRep.doubleValue = doubleValue;
4924     return objPtr;
4925 }
4926
4927 /* -----------------------------------------------------------------------------
4928  * List object
4929  * ---------------------------------------------------------------------------*/
4930 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4931 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4932 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4933 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4934 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4935
4936 /* Note that while the elements of the list may contain references,
4937  * the list object itself can't. This basically means that the
4938  * list object string representation as a whole can't contain references
4939  * that are not presents in the single elements. */
4940 static Jim_ObjType listObjType = {
4941     "list",
4942     FreeListInternalRep,
4943     DupListInternalRep,
4944     UpdateStringOfList,
4945     JIM_TYPE_NONE,
4946 };
4947
4948 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4949 {
4950     int i;
4951
4952     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4953         Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4954     }
4955     Jim_Free(objPtr->internalRep.listValue.ele);
4956 }
4957
4958 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4959 {
4960     int i;
4961     JIM_NOTUSED(interp);
4962
4963     dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4964     dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4965     dupPtr->internalRep.listValue.ele =
4966         Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4967     memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4968             sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4969     for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4970         Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4971     }
4972     dupPtr->typePtr = &listObjType;
4973 }
4974
4975 /* The following function checks if a given string can be encoded
4976  * into a list element without any kind of quoting, surrounded by braces,
4977  * or using escapes to quote. */
4978 #define JIM_ELESTR_SIMPLE 0
4979 #define JIM_ELESTR_BRACE 1
4980 #define JIM_ELESTR_QUOTE 2
4981 static int ListElementQuotingType(const char *s, int len)
4982 {
4983     int i, level, trySimple = 1;
4984
4985     /* Try with the SIMPLE case */
4986     if (len == 0) return JIM_ELESTR_BRACE;
4987     if (s[0] == '"' || s[0] == '{') {
4988         trySimple = 0;
4989         goto testbrace;
4990     }
4991     for (i = 0; i < len; i++) {
4992         switch(s[i]) {
4993         case ' ':
4994         case '$':
4995         case '"':
4996         case '[':
4997         case ']':
4998         case ';':
4999         case '\\':
5000         case '\r':
5001         case '\n':
5002         case '\t':
5003         case '\f':
5004         case '\v':
5005             trySimple = 0;
5006         case '{':
5007         case '}':
5008             goto testbrace;
5009         }
5010     }
5011     return JIM_ELESTR_SIMPLE;
5012
5013 testbrace:
5014     /* Test if it's possible to do with braces */
5015     if (s[len-1] == '\\' ||
5016         s[len-1] == ']') return JIM_ELESTR_QUOTE;
5017     level = 0;
5018     for (i = 0; i < len; i++) {
5019         switch(s[i]) {
5020         case '{': level++; break;
5021         case '}': level--;
5022               if (level < 0) return JIM_ELESTR_QUOTE;
5023               break;
5024         case '\\':
5025               if (s[i+1] == '\n')
5026                   return JIM_ELESTR_QUOTE;
5027               else
5028                   if (s[i+1] != '\0') i++;
5029               break;
5030         }
5031     }
5032     if (level == 0) {
5033         if (!trySimple) return JIM_ELESTR_BRACE;
5034         for (i = 0; i < len; i++) {
5035             switch(s[i]) {
5036             case ' ':
5037             case '$':
5038             case '"':
5039             case '[':
5040             case ']':
5041             case ';':
5042             case '\\':
5043             case '\r':
5044             case '\n':
5045             case '\t':
5046             case '\f':
5047             case '\v':
5048                 return JIM_ELESTR_BRACE;
5049                 break;
5050             }
5051         }
5052         return JIM_ELESTR_SIMPLE;
5053     }
5054     return JIM_ELESTR_QUOTE;
5055 }
5056
5057 /* Returns the malloc-ed representation of a string
5058  * using backslash to quote special chars. */
5059 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5060 {
5061     char *q = Jim_Alloc(len*2+1), *p;
5062
5063     p = q;
5064     while(*s) {
5065         switch (*s) {
5066         case ' ':
5067         case '$':
5068         case '"':
5069         case '[':
5070         case ']':
5071         case '{':
5072         case '}':
5073         case ';':
5074         case '\\':
5075             *p++ = '\\';
5076             *p++ = *s++;
5077             break;
5078         case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5079         case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5080         case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5081         case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5082         case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5083         default:
5084             *p++ = *s++;
5085             break;
5086         }
5087     }
5088     *p = '\0';
5089     *qlenPtr = p-q;
5090     return q;
5091 }
5092
5093 void UpdateStringOfList(struct Jim_Obj *objPtr)
5094 {
5095     int i, bufLen, realLength;
5096     const char *strRep;
5097     char *p;
5098     int *quotingType;
5099     Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5100
5101     /* (Over) Estimate the space needed. */
5102     quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5103     bufLen = 0;
5104     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5105         int len;
5106
5107         strRep = Jim_GetString(ele[i], &len);
5108         quotingType[i] = ListElementQuotingType(strRep, len);
5109         switch (quotingType[i]) {
5110         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5111         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5112         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5113         }
5114         bufLen++; /* elements separator. */
5115     }
5116     bufLen++;
5117
5118     /* Generate the string rep. */
5119     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5120     realLength = 0;
5121     for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5122         int len, qlen;
5123         const char *strRep = Jim_GetString(ele[i], &len);
5124         char *q;
5125
5126         switch(quotingType[i]) {
5127         case JIM_ELESTR_SIMPLE:
5128             memcpy(p, strRep, len);
5129             p += len;
5130             realLength += len;
5131             break;
5132         case JIM_ELESTR_BRACE:
5133             *p++ = '{';
5134             memcpy(p, strRep, len);
5135             p += len;
5136             *p++ = '}';
5137             realLength += len+2;
5138             break;
5139         case JIM_ELESTR_QUOTE:
5140             q = BackslashQuoteString(strRep, len, &qlen);
5141             memcpy(p, q, qlen);
5142             Jim_Free(q);
5143             p += qlen;
5144             realLength += qlen;
5145             break;
5146         }
5147         /* Add a separating space */
5148         if (i+1 != objPtr->internalRep.listValue.len) {
5149             *p++ = ' ';
5150             realLength ++;
5151         }
5152     }
5153     *p = '\0'; /* nul term. */
5154     objPtr->length = realLength;
5155     Jim_Free(quotingType);
5156 }
5157
5158 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5159 {
5160     struct JimParserCtx parser;
5161     const char *str;
5162     int strLen;
5163
5164     /* Get the string representation */
5165     str = Jim_GetString(objPtr, &strLen);
5166
5167     /* Free the old internal repr just now and initialize the
5168      * new one just now. The string->list conversion can't fail. */
5169     Jim_FreeIntRep(interp, objPtr);
5170     objPtr->typePtr = &listObjType;
5171     objPtr->internalRep.listValue.len = 0;
5172     objPtr->internalRep.listValue.maxLen = 0;
5173     objPtr->internalRep.listValue.ele = NULL;
5174
5175     /* Convert into a list */
5176     JimParserInit(&parser, str, strLen, 1);
5177     while(!JimParserEof(&parser)) {
5178         char *token;
5179         int tokenLen, type;
5180         Jim_Obj *elementPtr;
5181
5182         JimParseList(&parser);
5183         if (JimParserTtype(&parser) != JIM_TT_STR &&
5184             JimParserTtype(&parser) != JIM_TT_ESC)
5185             continue;
5186         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5187         elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5188         ListAppendElement(objPtr, elementPtr);
5189     }
5190     return JIM_OK;
5191 }
5192
5193 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, 
5194         int len)
5195 {
5196     Jim_Obj *objPtr;
5197     int i;
5198
5199     objPtr = Jim_NewObj(interp);
5200     objPtr->typePtr = &listObjType;
5201     objPtr->bytes = NULL;
5202     objPtr->internalRep.listValue.ele = NULL;
5203     objPtr->internalRep.listValue.len = 0;
5204     objPtr->internalRep.listValue.maxLen = 0;
5205     for (i = 0; i < len; i++) {
5206         ListAppendElement(objPtr, elements[i]);
5207     }
5208     return objPtr;
5209 }
5210
5211 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5212  * length of the vector. Note that the user of this function should make
5213  * sure that the list object can't shimmer while the vector returned
5214  * is in use, this vector is the one stored inside the internal representation
5215  * of the list object. This function is not exported, extensions should
5216  * always access to the List object elements using Jim_ListIndex(). */
5217 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5218         Jim_Obj ***listVec)
5219 {
5220     Jim_ListLength(interp, listObj, argc);
5221     assert(listObj->typePtr == &listObjType);
5222     *listVec = listObj->internalRep.listValue.ele;
5223 }
5224
5225 /* ListSortElements type values */
5226 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5227       JIM_LSORT_NOCASE_DECR};
5228
5229 /* Sort the internal rep of a list. */
5230 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5231 {
5232     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5233 }
5234
5235 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5236 {
5237     return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5238 }
5239
5240 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5241 {
5242     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5243 }
5244
5245 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5246 {
5247     return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5248 }
5249
5250 /* Sort a list *in place*. MUST be called with non-shared objects. */
5251 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5252 {
5253     typedef int (qsort_comparator)(const void *, const void *);
5254     int (*fn)(Jim_Obj**, Jim_Obj**);
5255     Jim_Obj **vector;
5256     int len;
5257
5258     if (Jim_IsShared(listObjPtr))
5259         Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5260     if (listObjPtr->typePtr != &listObjType)
5261         SetListFromAny(interp, listObjPtr);
5262
5263     vector = listObjPtr->internalRep.listValue.ele;
5264     len = listObjPtr->internalRep.listValue.len;
5265     switch (type) {
5266         case JIM_LSORT_ASCII: fn = ListSortString;  break;
5267         case JIM_LSORT_NOCASE: fn = ListSortStringNoCase;  break;
5268         case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr;  break;
5269         case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr;  break;
5270         default:
5271             fn = NULL; /* avoid warning */
5272             Jim_Panic(interp,"ListSort called with invalid sort type");
5273     }
5274     qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5275     Jim_InvalidateStringRep(listObjPtr);
5276 }
5277
5278 /* This is the low-level function to append an element to a list.
5279  * The higher-level Jim_ListAppendElement() performs shared object
5280  * check and invalidate the string repr. This version is used
5281  * in the internals of the List Object and is not exported.
5282  *
5283  * NOTE: this function can be called only against objects
5284  * with internal type of List. */
5285 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5286 {
5287     int requiredLen = listPtr->internalRep.listValue.len + 1;
5288
5289     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5290         int maxLen = requiredLen * 2;
5291
5292         listPtr->internalRep.listValue.ele =
5293             Jim_Realloc(listPtr->internalRep.listValue.ele,
5294                     sizeof(Jim_Obj*)*maxLen);
5295         listPtr->internalRep.listValue.maxLen = maxLen;
5296     }
5297     listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5298         objPtr;
5299     listPtr->internalRep.listValue.len ++;
5300     Jim_IncrRefCount(objPtr);
5301 }
5302
5303 /* This is the low-level function to insert elements into a list.
5304  * The higher-level Jim_ListInsertElements() performs shared object
5305  * check and invalidate the string repr. This version is used
5306  * in the internals of the List Object and is not exported.
5307  *
5308  * NOTE: this function can be called only against objects
5309  * with internal type of List. */
5310 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5311         Jim_Obj *const *elemVec)
5312 {
5313     int currentLen = listPtr->internalRep.listValue.len;
5314     int requiredLen = currentLen + elemc;
5315     int i;
5316     Jim_Obj **point;
5317
5318     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5319         int maxLen = requiredLen * 2;
5320
5321         listPtr->internalRep.listValue.ele =
5322             Jim_Realloc(listPtr->internalRep.listValue.ele,
5323                     sizeof(Jim_Obj*)*maxLen);
5324         listPtr->internalRep.listValue.maxLen = maxLen;
5325     }
5326     point = listPtr->internalRep.listValue.ele + index;
5327     memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5328     for (i=0; i < elemc; ++i) {
5329         point[i] = elemVec[i];
5330         Jim_IncrRefCount(point[i]);
5331     }
5332     listPtr->internalRep.listValue.len += elemc;
5333 }
5334
5335 /* Appends every element of appendListPtr into listPtr.
5336  * Both have to be of the list type. */
5337 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5338 {
5339     int i, oldLen = listPtr->internalRep.listValue.len;
5340     int appendLen = appendListPtr->internalRep.listValue.len;
5341     int requiredLen = oldLen + appendLen;
5342
5343     if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5344         int maxLen = requiredLen * 2;
5345
5346         listPtr->internalRep.listValue.ele =
5347             Jim_Realloc(listPtr->internalRep.listValue.ele,
5348                     sizeof(Jim_Obj*)*maxLen);
5349         listPtr->internalRep.listValue.maxLen = maxLen;
5350     }
5351     for (i = 0; i < appendLen; i++) {
5352         Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5353         listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5354         Jim_IncrRefCount(objPtr);
5355     }
5356     listPtr->internalRep.listValue.len += appendLen;
5357 }
5358
5359 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5360 {
5361     if (Jim_IsShared(listPtr))
5362         Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5363     if (listPtr->typePtr != &listObjType)
5364         SetListFromAny(interp, listPtr);
5365     Jim_InvalidateStringRep(listPtr);
5366     ListAppendElement(listPtr, objPtr);
5367 }
5368
5369 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5370 {
5371     if (Jim_IsShared(listPtr))
5372         Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5373     if (listPtr->typePtr != &listObjType)
5374         SetListFromAny(interp, listPtr);
5375     Jim_InvalidateStringRep(listPtr);
5376     ListAppendList(listPtr, appendListPtr);
5377 }
5378
5379 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5380 {
5381     if (listPtr->typePtr != &listObjType)
5382         SetListFromAny(interp, listPtr);
5383     *intPtr = listPtr->internalRep.listValue.len;
5384 }
5385
5386 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5387         int objc, Jim_Obj *const *objVec)
5388 {
5389     if (Jim_IsShared(listPtr))
5390         Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5391     if (listPtr->typePtr != &listObjType)
5392         SetListFromAny(interp, listPtr);
5393     if (index >= 0 && index > listPtr->internalRep.listValue.len)
5394         index = listPtr->internalRep.listValue.len;
5395     else if (index < 0 ) 
5396         index = 0;
5397     Jim_InvalidateStringRep(listPtr);
5398     ListInsertElements(listPtr, index, objc, objVec);
5399 }
5400
5401 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5402         Jim_Obj **objPtrPtr, int flags)
5403 {
5404     if (listPtr->typePtr != &listObjType)
5405         SetListFromAny(interp, listPtr);
5406     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5407         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5408         if (flags & JIM_ERRMSG) {
5409             Jim_SetResultString(interp,
5410                 "list index out of range", -1);
5411         }
5412         return JIM_ERR;
5413     }
5414     if (index < 0)
5415         index = listPtr->internalRep.listValue.len+index;
5416     *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5417     return JIM_OK;
5418 }
5419
5420 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5421         Jim_Obj *newObjPtr, int flags)
5422 {
5423     if (listPtr->typePtr != &listObjType)
5424         SetListFromAny(interp, listPtr);
5425     if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5426         (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5427         if (flags & JIM_ERRMSG) {
5428             Jim_SetResultString(interp,
5429                 "list index out of range", -1);
5430         }
5431         return JIM_ERR;
5432     }
5433     if (index < 0)
5434         index = listPtr->internalRep.listValue.len+index;
5435     Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5436     listPtr->internalRep.listValue.ele[index] = newObjPtr;
5437     Jim_IncrRefCount(newObjPtr);
5438     return JIM_OK;
5439 }
5440
5441 /* Modify the list stored into the variable named 'varNamePtr'
5442  * setting the element specified by the 'indexc' indexes objects in 'indexv',
5443  * with the new element 'newObjptr'. */
5444 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5445         Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5446 {
5447     Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5448     int shared, i, index;
5449
5450     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5451     if (objPtr == NULL)
5452         return JIM_ERR;
5453     if ((shared = Jim_IsShared(objPtr)))
5454         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5455     for (i = 0; i < indexc-1; i++) {
5456         listObjPtr = objPtr;
5457         if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5458             goto err;
5459         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5460                     JIM_ERRMSG) != JIM_OK) {
5461             goto err;
5462         }
5463         if (Jim_IsShared(objPtr)) {
5464             objPtr = Jim_DuplicateObj(interp, objPtr);
5465             ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5466         }
5467         Jim_InvalidateStringRep(listObjPtr);
5468     }
5469     if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5470         goto err;
5471     if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5472         goto err;
5473     Jim_InvalidateStringRep(objPtr);
5474     Jim_InvalidateStringRep(varObjPtr);
5475     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5476         goto err;
5477     Jim_SetResult(interp, varObjPtr);
5478     return JIM_OK;
5479 err:
5480     if (shared) {
5481         Jim_FreeNewObj(interp, varObjPtr);
5482     }
5483     return JIM_ERR;
5484 }
5485
5486 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5487 {
5488     int i;
5489
5490     /* If all the objects in objv are lists without string rep.
5491      * it's possible to return a list as result, that's the
5492      * concatenation of all the lists. */
5493     for (i = 0; i < objc; i++) {
5494         if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5495             break;
5496     }
5497     if (i == objc) {
5498         Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5499         for (i = 0; i < objc; i++)
5500             Jim_ListAppendList(interp, objPtr, objv[i]);
5501         return objPtr;
5502     } else {
5503         /* Else... we have to glue strings together */
5504         int len = 0, objLen;
5505         char *bytes, *p;
5506
5507         /* Compute the length */
5508         for (i = 0; i < objc; i++) {
5509             Jim_GetString(objv[i], &objLen);
5510             len += objLen;
5511         }
5512         if (objc) len += objc-1;
5513         /* Create the string rep, and a stinrg object holding it. */
5514         p = bytes = Jim_Alloc(len+1);
5515         for (i = 0; i < objc; i++) {
5516             const char *s = Jim_GetString(objv[i], &objLen);
5517             while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5518             {
5519                 s++; objLen--; len--;
5520             }
5521             while (objLen && (s[objLen-1] == ' ' ||
5522                 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5523                 objLen--; len--;
5524             }
5525             memcpy(p, s, objLen);
5526             p += objLen;
5527             if (objLen && i+1 != objc) {
5528                 *p++ = ' ';
5529             } else if (i+1 != objc) {
5530                 /* Drop the space calcuated for this
5531                  * element that is instead null. */
5532                 len--;
5533             }
5534         }
5535         *p = '\0';
5536         return Jim_NewStringObjNoAlloc(interp, bytes, len);
5537     }
5538 }
5539
5540 /* Returns a list composed of the elements in the specified range.
5541  * first and start are directly accepted as Jim_Objects and
5542  * processed for the end?-index? case. */
5543 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5544 {
5545     int first, last;
5546     int len, rangeLen;
5547
5548     if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5549         Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5550         return NULL;
5551     Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5552     first = JimRelToAbsIndex(len, first);
5553     last = JimRelToAbsIndex(len, last);
5554     JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5555     return Jim_NewListObj(interp,
5556             listObjPtr->internalRep.listValue.ele+first, rangeLen);
5557 }
5558
5559 /* -----------------------------------------------------------------------------
5560  * Dict object
5561  * ---------------------------------------------------------------------------*/
5562 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5563 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5564 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5565 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5566
5567 /* Dict HashTable Type.
5568  *
5569  * Keys and Values are Jim objects. */
5570
5571 unsigned int JimObjectHTHashFunction(const void *key)
5572 {
5573     const char *str;
5574     Jim_Obj *objPtr = (Jim_Obj*) key;
5575     int len, h;
5576
5577     str = Jim_GetString(objPtr, &len);
5578     h = Jim_GenHashFunction((unsigned char*)str, len);
5579     return h;
5580 }
5581
5582 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5583 {
5584     JIM_NOTUSED(privdata);
5585
5586     return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5587 }
5588
5589 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5590 {
5591     Jim_Obj *objPtr = val;
5592
5593     Jim_DecrRefCount(interp, objPtr);
5594 }
5595
5596 static Jim_HashTableType JimDictHashTableType = {
5597     JimObjectHTHashFunction,            /* hash function */
5598     NULL,                               /* key dup */
5599     NULL,                               /* val dup */
5600     JimObjectHTKeyCompare,              /* key compare */
5601     (void(*)(void*, const void*))       /* ATTENTION: const cast */
5602         JimObjectHTKeyValDestructor,    /* key destructor */
5603     JimObjectHTKeyValDestructor         /* val destructor */
5604 };
5605
5606 /* Note that while the elements of the dict may contain references,
5607  * the list object itself can't. This basically means that the
5608  * dict object string representation as a whole can't contain references
5609  * that are not presents in the single elements. */
5610 static Jim_ObjType dictObjType = {
5611     "dict",
5612     FreeDictInternalRep,
5613     DupDictInternalRep,
5614     UpdateStringOfDict,
5615     JIM_TYPE_NONE,
5616 };
5617
5618 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5619 {
5620     JIM_NOTUSED(interp);
5621
5622     Jim_FreeHashTable(objPtr->internalRep.ptr);
5623     Jim_Free(objPtr->internalRep.ptr);
5624 }
5625
5626 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5627 {
5628     Jim_HashTable *ht, *dupHt;
5629     Jim_HashTableIterator *htiter;
5630     Jim_HashEntry *he;
5631
5632     /* Create a new hash table */
5633     ht = srcPtr->internalRep.ptr;
5634     dupHt = Jim_Alloc(sizeof(*dupHt));
5635     Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5636     if (ht->size != 0)
5637         Jim_ExpandHashTable(dupHt, ht->size);
5638     /* Copy every element from the source to the dup hash table */
5639     htiter = Jim_GetHashTableIterator(ht);
5640     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5641         const Jim_Obj *keyObjPtr = he->key;
5642         Jim_Obj *valObjPtr = he->val;
5643
5644         Jim_IncrRefCount((Jim_Obj*)keyObjPtr);  /* ATTENTION: const cast */
5645         Jim_IncrRefCount(valObjPtr);
5646         Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5647     }
5648     Jim_FreeHashTableIterator(htiter);
5649
5650     dupPtr->internalRep.ptr = dupHt;
5651     dupPtr->typePtr = &dictObjType;
5652 }
5653
5654 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5655 {
5656     int i, bufLen, realLength;
5657     const char *strRep;
5658     char *p;
5659     int *quotingType, objc;
5660     Jim_HashTable *ht;
5661     Jim_HashTableIterator *htiter;
5662     Jim_HashEntry *he;
5663     Jim_Obj **objv;
5664
5665     /* Trun the hash table into a flat vector of Jim_Objects. */
5666     ht = objPtr->internalRep.ptr;
5667     objc = ht->used*2;
5668     objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5669     htiter = Jim_GetHashTableIterator(ht);
5670     i = 0;
5671     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5672         objv[i++] = (Jim_Obj*)he->key;  /* ATTENTION: const cast */
5673         objv[i++] = he->val;
5674     }
5675     Jim_FreeHashTableIterator(htiter);
5676     /* (Over) Estimate the space needed. */
5677     quotingType = Jim_Alloc(sizeof(int)*objc);
5678     bufLen = 0;
5679     for (i = 0; i < objc; i++) {
5680         int len;
5681
5682         strRep = Jim_GetString(objv[i], &len);
5683         quotingType[i] = ListElementQuotingType(strRep, len);
5684         switch (quotingType[i]) {
5685         case JIM_ELESTR_SIMPLE: bufLen += len; break;
5686         case JIM_ELESTR_BRACE: bufLen += len+2; break;
5687         case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5688         }
5689         bufLen++; /* elements separator. */
5690     }
5691     bufLen++;
5692
5693     /* Generate the string rep. */
5694     p = objPtr->bytes = Jim_Alloc(bufLen+1);
5695     realLength = 0;
5696     for (i = 0; i < objc; i++) {
5697         int len, qlen;
5698         const char *strRep = Jim_GetString(objv[i], &len);
5699         char *q;
5700
5701         switch(quotingType[i]) {
5702         case JIM_ELESTR_SIMPLE:
5703             memcpy(p, strRep, len);
5704             p += len;
5705             realLength += len;
5706             break;
5707         case JIM_ELESTR_BRACE:
5708             *p++ = '{';
5709             memcpy(p, strRep, len);
5710             p += len;
5711             *p++ = '}';
5712             realLength += len+2;
5713             break;
5714         case JIM_ELESTR_QUOTE:
5715             q = BackslashQuoteString(strRep, len, &qlen);
5716             memcpy(p, q, qlen);
5717             Jim_Free(q);
5718             p += qlen;
5719             realLength += qlen;
5720             break;
5721         }
5722         /* Add a separating space */
5723         if (i+1 != objc) {
5724             *p++ = ' ';
5725             realLength ++;
5726         }
5727     }
5728     *p = '\0'; /* nul term. */
5729     objPtr->length = realLength;
5730     Jim_Free(quotingType);
5731     Jim_Free(objv);
5732 }
5733
5734 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5735 {
5736     struct JimParserCtx parser;
5737     Jim_HashTable *ht;
5738     Jim_Obj *objv[2];
5739     const char *str;
5740     int i, strLen;
5741
5742     /* Get the string representation */
5743     str = Jim_GetString(objPtr, &strLen);
5744
5745     /* Free the old internal repr just now and initialize the
5746      * new one just now. The string->list conversion can't fail. */
5747     Jim_FreeIntRep(interp, objPtr);
5748     ht = Jim_Alloc(sizeof(*ht));
5749     Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5750     objPtr->typePtr = &dictObjType;
5751     objPtr->internalRep.ptr = ht;
5752
5753     /* Convert into a dict */
5754     JimParserInit(&parser, str, strLen, 1);
5755     i = 0;
5756     while(!JimParserEof(&parser)) {
5757         char *token;
5758         int tokenLen, type;
5759
5760         JimParseList(&parser);
5761         if (JimParserTtype(&parser) != JIM_TT_STR &&
5762             JimParserTtype(&parser) != JIM_TT_ESC)
5763             continue;
5764         token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5765         objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5766         if (i == 2) {
5767             i = 0;
5768             Jim_IncrRefCount(objv[0]);
5769             Jim_IncrRefCount(objv[1]);
5770             if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5771                 Jim_HashEntry *he;
5772                 he = Jim_FindHashEntry(ht, objv[0]);
5773                 Jim_DecrRefCount(interp, objv[0]);
5774                 /* ATTENTION: const cast */
5775                 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5776                 he->val = objv[1];
5777             }
5778         }
5779     }
5780     if (i) {
5781         Jim_FreeNewObj(interp, objv[0]);
5782         objPtr->typePtr = NULL;
5783         Jim_FreeHashTable(ht);
5784         Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5785         return JIM_ERR;
5786     }
5787     return JIM_OK;
5788 }
5789
5790 /* Dict object API */
5791
5792 /* Add an element to a dict. objPtr must be of the "dict" type.
5793  * The higer-level exported function is Jim_DictAddElement().
5794  * If an element with the specified key already exists, the value
5795  * associated is replaced with the new one.
5796  *
5797  * if valueObjPtr == NULL, the key is instead removed if it exists. */
5798 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5799         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5800 {
5801     Jim_HashTable *ht = objPtr->internalRep.ptr;
5802
5803     if (valueObjPtr == NULL) { /* unset */
5804         Jim_DeleteHashEntry(ht, keyObjPtr);
5805         return;
5806     }
5807     Jim_IncrRefCount(keyObjPtr);
5808     Jim_IncrRefCount(valueObjPtr);
5809     if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5810         Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5811         Jim_DecrRefCount(interp, keyObjPtr);
5812         /* ATTENTION: const cast */
5813         Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5814         he->val = valueObjPtr;
5815     }
5816 }
5817
5818 /* Add an element, higher-level interface for DictAddElement().
5819  * If valueObjPtr == NULL, the key is removed if it exists. */
5820 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5821         Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5822 {
5823     if (Jim_IsShared(objPtr))
5824         Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5825     if (objPtr->typePtr != &dictObjType) {
5826         if (SetDictFromAny(interp, objPtr) != JIM_OK)
5827             return JIM_ERR;
5828     }
5829     DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5830     Jim_InvalidateStringRep(objPtr);
5831     return JIM_OK;
5832 }
5833
5834 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5835 {
5836     Jim_Obj *objPtr;
5837     int i;
5838
5839     if (len % 2)
5840         Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5841
5842     objPtr = Jim_NewObj(interp);
5843     objPtr->typePtr = &dictObjType;
5844     objPtr->bytes = NULL;
5845     objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5846     Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5847     for (i = 0; i < len; i += 2)
5848         DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5849     return objPtr;
5850 }
5851
5852 /* Return the value associated to the specified dict key */
5853 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5854         Jim_Obj **objPtrPtr, int flags)
5855 {
5856     Jim_HashEntry *he;
5857     Jim_HashTable *ht;
5858
5859     if (dictPtr->typePtr != &dictObjType) {
5860         if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5861             return JIM_ERR;
5862     }
5863     ht = dictPtr->internalRep.ptr;
5864     if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5865         if (flags & JIM_ERRMSG) {
5866             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5867             Jim_AppendStrings(interp, Jim_GetResult(interp),
5868                     "key \"", Jim_GetString(keyPtr, NULL),
5869                     "\" not found in dictionary", NULL);
5870         }
5871         return JIM_ERR;
5872     }
5873     *objPtrPtr = he->val;
5874     return JIM_OK;
5875 }
5876
5877 /* Return the value associated to the specified dict keys */
5878 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5879         Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5880 {
5881     Jim_Obj *objPtr;
5882     int i;
5883
5884     if (keyc == 0) {
5885         *objPtrPtr = dictPtr;
5886         return JIM_OK;
5887     }
5888
5889     for (i = 0; i < keyc; i++) {
5890         if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5891                 != JIM_OK)
5892             return JIM_ERR;
5893         dictPtr = objPtr;
5894     }
5895     *objPtrPtr = objPtr;
5896     return JIM_OK;
5897 }
5898
5899 /* Modify the dict stored into the variable named 'varNamePtr'
5900  * setting the element specified by the 'keyc' keys objects in 'keyv',
5901  * with the new value of the element 'newObjPtr'.
5902  *
5903  * If newObjPtr == NULL the operation is to remove the given key
5904  * from the dictionary. */
5905 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5906         Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5907 {
5908     Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5909     int shared, i;
5910
5911     varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5912     if (objPtr == NULL) {
5913         if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5914             return JIM_ERR;
5915         varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5916         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5917             Jim_FreeNewObj(interp, varObjPtr);
5918             return JIM_ERR;
5919         }
5920     }
5921     if ((shared = Jim_IsShared(objPtr)))
5922         varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5923     for (i = 0; i < keyc-1; i++) {
5924         dictObjPtr = objPtr;
5925
5926         /* Check if it's a valid dictionary */
5927         if (dictObjPtr->typePtr != &dictObjType) {
5928             if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5929                 goto err;
5930         }
5931         /* Check if the given key exists. */
5932         Jim_InvalidateStringRep(dictObjPtr);
5933         if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5934             newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5935         {
5936             /* This key exists at the current level.
5937              * Make sure it's not shared!. */
5938             if (Jim_IsShared(objPtr)) {
5939                 objPtr = Jim_DuplicateObj(interp, objPtr);
5940                 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5941             }
5942         } else {
5943             /* Key not found. If it's an [unset] operation
5944              * this is an error. Only the last key may not
5945              * exist. */
5946             if (newObjPtr == NULL)
5947                 goto err;
5948             /* Otherwise set an empty dictionary
5949              * as key's value. */
5950             objPtr = Jim_NewDictObj(interp, NULL, 0);
5951             DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5952         }
5953     }
5954     if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5955             != JIM_OK)
5956         goto err;
5957     Jim_InvalidateStringRep(objPtr);
5958     Jim_InvalidateStringRep(varObjPtr);
5959     if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5960         goto err;
5961     Jim_SetResult(interp, varObjPtr);
5962     return JIM_OK;
5963 err:
5964     if (shared) {
5965         Jim_FreeNewObj(interp, varObjPtr);
5966     }
5967     return JIM_ERR;
5968 }
5969
5970 /* -----------------------------------------------------------------------------
5971  * Index object
5972  * ---------------------------------------------------------------------------*/
5973 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
5974 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5975
5976 static Jim_ObjType indexObjType = {
5977     "index",
5978     NULL,
5979     NULL,
5980     UpdateStringOfIndex,
5981     JIM_TYPE_NONE,
5982 };
5983
5984 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
5985 {
5986     int len;
5987     char buf[JIM_INTEGER_SPACE+1];
5988
5989     if (objPtr->internalRep.indexValue >= 0)
5990         len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
5991     else if (objPtr->internalRep.indexValue == -1)
5992         len = sprintf(buf, "end");
5993     else {
5994         len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
5995     }
5996     objPtr->bytes = Jim_Alloc(len+1);
5997     memcpy(objPtr->bytes, buf, len+1);
5998     objPtr->length = len;
5999 }
6000
6001 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6002 {
6003     int index, end = 0;
6004     const char *str;
6005
6006     /* Get the string representation */
6007     str = Jim_GetString(objPtr, NULL);
6008     /* Try to convert into an index */
6009     if (!strcmp(str, "end")) {
6010         index = 0;
6011         end = 1;
6012     } else {
6013         if (!strncmp(str, "end-", 4)) {
6014             str += 4;
6015             end = 1;
6016         }
6017         if (Jim_StringToIndex(str, &index) != JIM_OK) {
6018             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6019             Jim_AppendStrings(interp, Jim_GetResult(interp),
6020                     "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6021                     "must be integer or end?-integer?", NULL);
6022             return JIM_ERR;
6023         }
6024     }
6025     if (end) {
6026         if (index < 0)
6027             index = INT_MAX;
6028         else
6029             index = -(index+1);
6030     } else if (!end && index < 0)
6031         index = -INT_MAX;
6032     /* Free the old internal repr and set the new one. */
6033     Jim_FreeIntRep(interp, objPtr);
6034     objPtr->typePtr = &indexObjType;
6035     objPtr->internalRep.indexValue = index;
6036     return JIM_OK;
6037 }
6038
6039 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6040 {
6041     /* Avoid shimmering if the object is an integer. */
6042     if (objPtr->typePtr == &intObjType) {
6043         jim_wide val = objPtr->internalRep.wideValue;
6044         if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6045             *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6046             return JIM_OK;
6047         }
6048     }
6049     if (objPtr->typePtr != &indexObjType &&
6050         SetIndexFromAny(interp, objPtr) == JIM_ERR)
6051         return JIM_ERR;
6052     *indexPtr = objPtr->internalRep.indexValue;
6053     return JIM_OK;
6054 }
6055
6056 /* -----------------------------------------------------------------------------
6057  * Return Code Object.
6058  * ---------------------------------------------------------------------------*/
6059
6060 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6061
6062 static Jim_ObjType returnCodeObjType = {
6063     "return-code",
6064     NULL,
6065     NULL,
6066     NULL,
6067     JIM_TYPE_NONE,
6068 };
6069
6070 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6071 {
6072     const char *str;
6073     int strLen, returnCode;
6074     jim_wide wideValue;
6075
6076     /* Get the string representation */
6077     str = Jim_GetString(objPtr, &strLen);
6078     /* Try to convert into an integer */
6079     if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6080         returnCode = (int) wideValue;
6081     else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6082         returnCode = JIM_OK;
6083     else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6084         returnCode = JIM_ERR;
6085     else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6086         returnCode = JIM_RETURN;
6087     else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6088         returnCode = JIM_BREAK;
6089     else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6090         returnCode = JIM_CONTINUE;
6091     else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6092         returnCode = JIM_EVAL;
6093     else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6094         returnCode = JIM_EXIT;
6095     else {
6096         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6097         Jim_AppendStrings(interp, Jim_GetResult(interp),
6098                 "expected return code but got '", str, "'",
6099                 NULL);
6100         return JIM_ERR;
6101     }
6102     /* Free the old internal repr and set the new one. */
6103     Jim_FreeIntRep(interp, objPtr);
6104     objPtr->typePtr = &returnCodeObjType;
6105     objPtr->internalRep.returnCode = returnCode;
6106     return JIM_OK;
6107 }
6108
6109 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6110 {
6111     if (objPtr->typePtr != &returnCodeObjType &&
6112         SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6113         return JIM_ERR;
6114     *intPtr = objPtr->internalRep.returnCode;
6115     return JIM_OK;
6116 }
6117
6118 /* -----------------------------------------------------------------------------
6119  * Expression Parsing
6120  * ---------------------------------------------------------------------------*/
6121 static int JimParseExprOperator(struct JimParserCtx *pc);
6122 static int JimParseExprNumber(struct JimParserCtx *pc);
6123 static int JimParseExprIrrational(struct JimParserCtx *pc);
6124
6125 /* Exrp's Stack machine operators opcodes. */
6126
6127 /* Binary operators (numbers) */
6128 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6129 #define JIM_EXPROP_MUL 0
6130 #define JIM_EXPROP_DIV 1
6131 #define JIM_EXPROP_MOD 2
6132 #define JIM_EXPROP_SUB 3
6133 #define JIM_EXPROP_ADD 4
6134 #define JIM_EXPROP_LSHIFT 5
6135 #define JIM_EXPROP_RSHIFT 6
6136 #define JIM_EXPROP_ROTL 7
6137 #define JIM_EXPROP_ROTR 8
6138 #define JIM_EXPROP_LT 9
6139 #define JIM_EXPROP_GT 10
6140 #define JIM_EXPROP_LTE 11
6141 #define JIM_EXPROP_GTE 12
6142 #define JIM_EXPROP_NUMEQ 13
6143 #define JIM_EXPROP_NUMNE 14
6144 #define JIM_EXPROP_BITAND 15
6145 #define JIM_EXPROP_BITXOR 16
6146 #define JIM_EXPROP_BITOR 17
6147 #define JIM_EXPROP_LOGICAND 18
6148 #define JIM_EXPROP_LOGICOR 19
6149 #define JIM_EXPROP_LOGICAND_LEFT 20
6150 #define JIM_EXPROP_LOGICOR_LEFT 21
6151 #define JIM_EXPROP_POW 22
6152 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6153
6154 /* Binary operators (strings) */
6155 #define JIM_EXPROP_STREQ 23
6156 #define JIM_EXPROP_STRNE 24
6157
6158 /* Unary operators (numbers) */
6159 #define JIM_EXPROP_NOT 25
6160 #define JIM_EXPROP_BITNOT 26
6161 #define JIM_EXPROP_UNARYMINUS 27
6162 #define JIM_EXPROP_UNARYPLUS 28
6163 #define JIM_EXPROP_LOGICAND_RIGHT 29
6164 #define JIM_EXPROP_LOGICOR_RIGHT 30
6165
6166 /* Ternary operators */
6167 #define JIM_EXPROP_TERNARY 31
6168
6169 /* Operands */
6170 #define JIM_EXPROP_NUMBER 32
6171 #define JIM_EXPROP_COMMAND 33
6172 #define JIM_EXPROP_VARIABLE 34
6173 #define JIM_EXPROP_DICTSUGAR 35
6174 #define JIM_EXPROP_SUBST 36
6175 #define JIM_EXPROP_STRING 37
6176
6177 /* Operators table */
6178 typedef struct Jim_ExprOperator {
6179     const char *name;
6180     int precedence;
6181     int arity;
6182     int opcode;
6183 } Jim_ExprOperator;
6184
6185 /* name - precedence - arity - opcode */
6186 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6187     {"!", 300, 1, JIM_EXPROP_NOT},
6188     {"~", 300, 1, JIM_EXPROP_BITNOT},
6189     {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6190     {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6191
6192     {"**", 250, 2, JIM_EXPROP_POW},
6193
6194     {"*", 200, 2, JIM_EXPROP_MUL},
6195     {"/", 200, 2, JIM_EXPROP_DIV},
6196     {"%", 200, 2, JIM_EXPROP_MOD},
6197
6198     {"-", 100, 2, JIM_EXPROP_SUB},
6199     {"+", 100, 2, JIM_EXPROP_ADD},
6200
6201     {"<<<", 90, 3, JIM_EXPROP_ROTL},
6202     {">>>", 90, 3, JIM_EXPROP_ROTR},
6203     {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6204     {">>", 90, 2, JIM_EXPROP_RSHIFT},
6205
6206     {"<",  80, 2, JIM_EXPROP_LT},
6207     {">",  80, 2, JIM_EXPROP_GT},
6208     {"<=", 80, 2, JIM_EXPROP_LTE},
6209     {">=", 80, 2, JIM_EXPROP_GTE},
6210
6211     {"==", 70, 2, JIM_EXPROP_NUMEQ},
6212     {"!=", 70, 2, JIM_EXPROP_NUMNE},
6213
6214     {"eq", 60, 2, JIM_EXPROP_STREQ},
6215     {"ne", 60, 2, JIM_EXPROP_STRNE},
6216
6217     {"&", 50, 2, JIM_EXPROP_BITAND},
6218     {"^", 49, 2, JIM_EXPROP_BITXOR},
6219     {"|", 48, 2, JIM_EXPROP_BITOR},
6220
6221     {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6222     {"||", 10, 2, JIM_EXPROP_LOGICOR},
6223
6224     {"?", 5, 3, JIM_EXPROP_TERNARY},
6225     /* private operators */
6226     {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6227     {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6228     {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6229     {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6230 };
6231
6232 #define JIM_EXPR_OPERATORS_NUM \
6233     (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6234
6235 int JimParseExpression(struct JimParserCtx *pc)
6236 {
6237     /* Discard spaces and quoted newline */
6238     while(*(pc->p) == ' ' ||
6239           *(pc->p) == '\t' ||
6240           *(pc->p) == '\r' ||
6241           *(pc->p) == '\n' ||
6242             (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6243         pc->p++; pc->len--;
6244     }
6245
6246     if (pc->len == 0) {
6247         pc->tstart = pc->tend = pc->p;
6248         pc->tline = pc->linenr;
6249         pc->tt = JIM_TT_EOL;
6250         pc->eof = 1;
6251         return JIM_OK;
6252     }
6253     switch(*(pc->p)) {
6254     case '(':
6255         pc->tstart = pc->tend = pc->p;
6256         pc->tline = pc->linenr;
6257         pc->tt = JIM_TT_SUBEXPR_START;
6258         pc->p++; pc->len--;
6259         break;
6260     case ')':
6261         pc->tstart = pc->tend = pc->p;
6262         pc->tline = pc->linenr;
6263         pc->tt = JIM_TT_SUBEXPR_END;
6264         pc->p++; pc->len--;
6265         break;
6266     case '[':
6267         return JimParseCmd(pc);
6268         break;
6269     case '$':
6270         if (JimParseVar(pc) == JIM_ERR)
6271             return JimParseExprOperator(pc);
6272         else
6273             return JIM_OK;
6274         break;
6275     case '-':
6276         if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6277             isdigit((int)*(pc->p+1)))
6278             return JimParseExprNumber(pc);
6279         else
6280             return JimParseExprOperator(pc);
6281         break;
6282     case '0': case '1': case '2': case '3': case '4':
6283     case '5': case '6': case '7': case '8': case '9': case '.':
6284         return JimParseExprNumber(pc);
6285         break;
6286     case '"':
6287     case '{':
6288         /* Here it's possible to reuse the List String parsing. */
6289         pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6290         return JimParseListStr(pc);
6291         break;
6292     case 'N': case 'I':
6293     case 'n': case 'i':
6294         if (JimParseExprIrrational(pc) == JIM_ERR)
6295             return JimParseExprOperator(pc);
6296         break;
6297     default:
6298         return JimParseExprOperator(pc);
6299         break;
6300     }
6301     return JIM_OK;
6302 }
6303
6304 int JimParseExprNumber(struct JimParserCtx *pc)
6305 {
6306     int allowdot = 1;
6307     int allowhex = 0;
6308
6309     pc->tstart = pc->p;
6310     pc->tline = pc->linenr;
6311     if (*pc->p == '-') {
6312         pc->p++; pc->len--;
6313     }
6314     while (  isdigit((int)*pc->p) 
6315           || (allowhex && isxdigit((int)*pc->p) )
6316           || (allowdot && *pc->p == '.') 
6317           || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6318               (*pc->p == 'x' || *pc->p == 'X'))
6319           )
6320     {
6321         if ((*pc->p == 'x') || (*pc->p == 'X')) {
6322             allowhex = 1;
6323             allowdot = 0;
6324                 }
6325         if (*pc->p == '.')
6326             allowdot = 0;
6327         pc->p++; pc->len--;
6328         if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6329             pc->p += 2; pc->len -= 2;
6330         }
6331     }
6332     pc->tend = pc->p-1;
6333     pc->tt = JIM_TT_EXPR_NUMBER;
6334     return JIM_OK;
6335 }
6336
6337 int JimParseExprIrrational(struct JimParserCtx *pc)
6338 {
6339     const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6340     const char **token;
6341     for (token = Tokens; *token != NULL; token++) {
6342         int len = strlen(*token);
6343         if (strncmp(*token, pc->p, len) == 0) {
6344             pc->tstart = pc->p;
6345             pc->tend = pc->p + len - 1;
6346             pc->p += len; pc->len -= len;
6347             pc->tline = pc->linenr;
6348             pc->tt = JIM_TT_EXPR_NUMBER;
6349             return JIM_OK;
6350         }
6351     }
6352     return JIM_ERR;
6353 }
6354
6355 int JimParseExprOperator(struct JimParserCtx *pc)
6356 {
6357     int i;
6358     int bestIdx = -1, bestLen = 0;
6359
6360     /* Try to get the longest match. */
6361     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6362         const char *opname;
6363         int oplen;
6364
6365         opname = Jim_ExprOperators[i].name;
6366         if (opname == NULL) continue;
6367         oplen = strlen(opname);
6368
6369         if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6370             bestIdx = i;
6371             bestLen = oplen;
6372         }
6373     }
6374     if (bestIdx == -1) return JIM_ERR;
6375     pc->tstart = pc->p;
6376     pc->tend = pc->p + bestLen - 1;
6377     pc->p += bestLen; pc->len -= bestLen;
6378     pc->tline = pc->linenr;
6379     pc->tt = JIM_TT_EXPR_OPERATOR;
6380     return JIM_OK;
6381 }
6382
6383 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6384 {
6385     int i;
6386     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6387         if (Jim_ExprOperators[i].name &&
6388             strcmp(opname, Jim_ExprOperators[i].name) == 0)
6389             return &Jim_ExprOperators[i];
6390     return NULL;
6391 }
6392
6393 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6394 {
6395     int i;
6396     for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6397         if (Jim_ExprOperators[i].opcode == opcode)
6398             return &Jim_ExprOperators[i];
6399     return NULL;
6400 }
6401
6402 /* -----------------------------------------------------------------------------
6403  * Expression Object
6404  * ---------------------------------------------------------------------------*/
6405 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6406 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6407 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6408
6409 static Jim_ObjType exprObjType = {
6410     "expression",
6411     FreeExprInternalRep,
6412     DupExprInternalRep,
6413     NULL,
6414     JIM_TYPE_REFERENCES,
6415 };
6416
6417 /* Expr bytecode structure */
6418 typedef struct ExprByteCode {
6419     int *opcode;        /* Integer array of opcodes. */
6420     Jim_Obj **obj;      /* Array of associated Jim Objects. */
6421     int len;            /* Bytecode length */
6422     int inUse;          /* Used for sharing. */
6423 } ExprByteCode;
6424
6425 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6426 {
6427     int i;
6428     ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6429
6430     expr->inUse--;
6431     if (expr->inUse != 0) return;
6432     for (i = 0; i < expr->len; i++)
6433         Jim_DecrRefCount(interp, expr->obj[i]);
6434     Jim_Free(expr->opcode);
6435     Jim_Free(expr->obj);
6436     Jim_Free(expr);
6437 }
6438
6439 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6440 {
6441     JIM_NOTUSED(interp);
6442     JIM_NOTUSED(srcPtr);
6443
6444     /* Just returns an simple string. */
6445     dupPtr->typePtr = NULL;
6446 }
6447
6448 /* Add a new instruction to an expression bytecode structure. */
6449 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6450         int opcode, char *str, int len)
6451 {
6452     expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6453     expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6454     expr->opcode[expr->len] = opcode;
6455     expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6456     Jim_IncrRefCount(expr->obj[expr->len]);
6457     expr->len++;
6458 }
6459
6460 /* Check if an expr program looks correct. */
6461 static int ExprCheckCorrectness(ExprByteCode *expr)
6462 {
6463     int i;
6464     int stacklen = 0;
6465
6466     /* Try to check if there are stack underflows,
6467      * and make sure at the end of the program there is
6468      * a single result on the stack. */
6469     for (i = 0; i < expr->len; i++) {
6470         switch(expr->opcode[i]) {
6471         case JIM_EXPROP_NUMBER:
6472         case JIM_EXPROP_STRING:
6473         case JIM_EXPROP_SUBST:
6474         case JIM_EXPROP_VARIABLE:
6475         case JIM_EXPROP_DICTSUGAR:
6476         case JIM_EXPROP_COMMAND:
6477             stacklen++;
6478             break;
6479         case JIM_EXPROP_NOT:
6480         case JIM_EXPROP_BITNOT:
6481         case JIM_EXPROP_UNARYMINUS:
6482         case JIM_EXPROP_UNARYPLUS:
6483             /* Unary operations */
6484             if (stacklen < 1) return JIM_ERR;
6485             break;
6486         case JIM_EXPROP_ADD:
6487         case JIM_EXPROP_SUB:
6488         case JIM_EXPROP_MUL:
6489         case JIM_EXPROP_DIV:
6490         case JIM_EXPROP_MOD:
6491         case JIM_EXPROP_LT:
6492         case JIM_EXPROP_GT:
6493         case JIM_EXPROP_LTE:
6494         case JIM_EXPROP_GTE:
6495         case JIM_EXPROP_ROTL:
6496         case JIM_EXPROP_ROTR:
6497         case JIM_EXPROP_LSHIFT:
6498         case JIM_EXPROP_RSHIFT:
6499         case JIM_EXPROP_NUMEQ:
6500         case JIM_EXPROP_NUMNE:
6501         case JIM_EXPROP_STREQ:
6502         case JIM_EXPROP_STRNE:
6503         case JIM_EXPROP_BITAND:
6504         case JIM_EXPROP_BITXOR:
6505         case JIM_EXPROP_BITOR:
6506         case JIM_EXPROP_LOGICAND:
6507         case JIM_EXPROP_LOGICOR:
6508         case JIM_EXPROP_POW:
6509             /* binary operations */
6510             if (stacklen < 2) return JIM_ERR;
6511             stacklen--;
6512             break;
6513         default:
6514             Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6515             break;
6516         }
6517     }
6518     if (stacklen != 1) return JIM_ERR;
6519     return JIM_OK;
6520 }
6521
6522 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6523         ScriptObj *topLevelScript)
6524 {
6525     int i;
6526
6527     return;
6528     for (i = 0; i < expr->len; i++) {
6529         Jim_Obj *foundObjPtr;
6530
6531         if (expr->obj[i] == NULL) continue;
6532         foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6533                 NULL, expr->obj[i]);
6534         if (foundObjPtr != NULL) {
6535             Jim_IncrRefCount(foundObjPtr);
6536             Jim_DecrRefCount(interp, expr->obj[i]);
6537             expr->obj[i] = foundObjPtr;
6538         }
6539     }
6540 }
6541
6542 /* This procedure converts every occurrence of || and && opereators
6543  * in lazy unary versions.
6544  *
6545  * a b || is converted into:
6546  *
6547  * a <offset> |L b |R
6548  *
6549  * a b && is converted into:
6550  *
6551  * a <offset> &L b &R
6552  *
6553  * "|L" checks if 'a' is true:
6554  *   1) if it is true pushes 1 and skips <offset> istructions to reach
6555  *      the opcode just after |R.
6556  *   2) if it is false does nothing.
6557  * "|R" checks if 'b' is true:
6558  *   1) if it is true pushes 1, otherwise pushes 0.
6559  *
6560  * "&L" checks if 'a' is true:
6561  *   1) if it is true does nothing.
6562  *   2) If it is false pushes 0 and skips <offset> istructions to reach
6563  *      the opcode just after &R
6564  * "&R" checks if 'a' is true:
6565  *      if it is true pushes 1, otherwise pushes 0.
6566  */
6567 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6568 {
6569     while (1) {
6570         int index = -1, leftindex, arity, i, offset;
6571         Jim_ExprOperator *op;
6572
6573         /* Search for || or && */
6574         for (i = 0; i < expr->len; i++) {
6575             if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6576                 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6577                 index = i;
6578                 break;
6579             }
6580         }
6581         if (index == -1) return;
6582         /* Search for the end of the first operator */
6583         leftindex = index-1;
6584         arity = 1;
6585         while(arity) {
6586             switch(expr->opcode[leftindex]) {
6587             case JIM_EXPROP_NUMBER:
6588             case JIM_EXPROP_COMMAND:
6589             case JIM_EXPROP_VARIABLE:
6590             case JIM_EXPROP_DICTSUGAR:
6591             case JIM_EXPROP_SUBST:
6592             case JIM_EXPROP_STRING:
6593                 break;
6594             default:
6595                 op = JimExprOperatorInfoByOpcode(expr->opcode[i]);
6596                 if (op == NULL) {
6597                     Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6598                 }
6599                 arity += op->arity;
6600                 break;
6601             }
6602             arity--;
6603             leftindex--;
6604         }
6605         leftindex++;
6606         expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6607         expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6608         memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6609                 sizeof(int)*(expr->len-leftindex));
6610         memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6611                 sizeof(Jim_Obj*)*(expr->len-leftindex));
6612         expr->len += 2;
6613         index += 2;
6614         offset = (index-leftindex)-1;
6615         Jim_DecrRefCount(interp, expr->obj[index]);
6616         if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6617             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6618             expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6619             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6620             expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6621         } else {
6622             expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6623             expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6624             expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6625             expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6626         }
6627         expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6628         expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6629         Jim_IncrRefCount(expr->obj[index]);
6630         Jim_IncrRefCount(expr->obj[leftindex]);
6631         Jim_IncrRefCount(expr->obj[leftindex+1]);
6632     }
6633 }
6634
6635 /* This method takes the string representation of an expression
6636  * and generates a program for the Expr's stack-based VM. */
6637 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6638 {
6639     int exprTextLen;
6640     const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6641     struct JimParserCtx parser;
6642     int i, shareLiterals;
6643     ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6644     Jim_Stack stack;
6645     Jim_ExprOperator *op;
6646
6647     /* Perform literal sharing with the current procedure
6648      * running only if this expression appears to be not generated
6649      * at runtime. */
6650     shareLiterals = objPtr->typePtr == &sourceObjType;
6651
6652     expr->opcode = NULL;
6653     expr->obj = NULL;
6654     expr->len = 0;
6655     expr->inUse = 1;
6656
6657     Jim_InitStack(&stack);
6658     JimParserInit(&parser, exprText, exprTextLen, 1);
6659     while(!JimParserEof(&parser)) {
6660         char *token;
6661         int len, type;
6662
6663         if (JimParseExpression(&parser) != JIM_OK) {
6664             Jim_SetResultString(interp, "Syntax error in expression", -1);
6665             goto err;
6666         }
6667         token = JimParserGetToken(&parser, &len, &type, NULL);
6668         if (type == JIM_TT_EOL) {
6669             Jim_Free(token);
6670             break;
6671         }
6672         switch(type) {
6673         case JIM_TT_STR:
6674             ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6675             break;
6676         case JIM_TT_ESC:
6677             ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6678             break;
6679         case JIM_TT_VAR:
6680             ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6681             break;
6682         case JIM_TT_DICTSUGAR:
6683             ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6684             break;
6685         case JIM_TT_CMD:
6686             ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6687             break;
6688         case JIM_TT_EXPR_NUMBER:
6689             ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6690             break;
6691         case JIM_TT_EXPR_OPERATOR:
6692             op = JimExprOperatorInfo(token);
6693             while(1) {
6694                 Jim_ExprOperator *stackTopOp;
6695
6696                 if (Jim_StackPeek(&stack) != NULL) {
6697                     stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6698                 } else {
6699                     stackTopOp = NULL;
6700                 }
6701                 if (Jim_StackLen(&stack) && op->arity != 1 &&
6702                     stackTopOp && stackTopOp->precedence >= op->precedence)
6703                 {
6704                     ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6705                         Jim_StackPeek(&stack), -1);
6706                     Jim_StackPop(&stack);
6707                 } else {
6708                     break;
6709                 }
6710             }
6711             Jim_StackPush(&stack, token);
6712             break;
6713         case JIM_TT_SUBEXPR_START:
6714             Jim_StackPush(&stack, Jim_StrDup("("));
6715             Jim_Free(token);
6716             break;
6717         case JIM_TT_SUBEXPR_END:
6718             {
6719                 int found = 0;
6720                 while(Jim_StackLen(&stack)) {
6721                     char *opstr = Jim_StackPop(&stack);
6722                     if (!strcmp(opstr, "(")) {
6723                         Jim_Free(opstr);
6724                         found = 1;
6725                         break;
6726                     }
6727                     op = JimExprOperatorInfo(opstr);
6728                     ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6729                 }
6730                 if (!found) {
6731                     Jim_SetResultString(interp,
6732                         "Unexpected close parenthesis", -1);
6733                     goto err;
6734                 }
6735             }
6736             Jim_Free(token);
6737             break;
6738         default:
6739             Jim_Panic(interp,"Default reached in SetExprFromAny()");
6740             break;
6741         }
6742     }
6743     while (Jim_StackLen(&stack)) {
6744         char *opstr = Jim_StackPop(&stack);
6745         op = JimExprOperatorInfo(opstr);
6746         if (op == NULL && !strcmp(opstr, "(")) {
6747             Jim_Free(opstr);
6748             Jim_SetResultString(interp, "Missing close parenthesis", -1);
6749             goto err;
6750         }
6751         ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6752     }
6753     /* Check program correctness. */
6754     if (ExprCheckCorrectness(expr) != JIM_OK) {
6755         Jim_SetResultString(interp, "Invalid expression", -1);
6756         goto err;
6757     }
6758
6759     /* Free the stack used for the compilation. */
6760     Jim_FreeStackElements(&stack, Jim_Free);
6761     Jim_FreeStack(&stack);
6762
6763     /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6764     ExprMakeLazy(interp, expr);
6765
6766     /* Perform literal sharing */
6767     if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6768         Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6769         if (bodyObjPtr->typePtr == &scriptObjType) {
6770             ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6771             ExprShareLiterals(interp, expr, bodyScript);
6772         }
6773     }
6774
6775     /* Free the old internal rep and set the new one. */
6776     Jim_FreeIntRep(interp, objPtr);
6777     Jim_SetIntRepPtr(objPtr, expr);
6778     objPtr->typePtr = &exprObjType;
6779     return JIM_OK;
6780
6781 err:    /* we jump here on syntax/compile errors. */
6782     Jim_FreeStackElements(&stack, Jim_Free);
6783     Jim_FreeStack(&stack);
6784     Jim_Free(expr->opcode);
6785     for (i = 0; i < expr->len; i++) {
6786         Jim_DecrRefCount(interp,expr->obj[i]);
6787     }
6788     Jim_Free(expr->obj);
6789     Jim_Free(expr);
6790     return JIM_ERR;
6791 }
6792
6793 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6794 {
6795     if (objPtr->typePtr != &exprObjType) {
6796         if (SetExprFromAny(interp, objPtr) != JIM_OK)
6797             return NULL;
6798     }
6799     return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6800 }
6801
6802 /* -----------------------------------------------------------------------------
6803  * Expressions evaluation.
6804  * Jim uses a specialized stack-based virtual machine for expressions,
6805  * that takes advantage of the fact that expr's operators
6806  * can't be redefined.
6807  *
6808  * Jim_EvalExpression() uses the bytecode compiled by
6809  * SetExprFromAny() method of the "expression" object.
6810  *
6811  * On success a Tcl Object containing the result of the evaluation
6812  * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6813  * returned.
6814  * On error the function returns a retcode != to JIM_OK and set a suitable
6815  * error on the interp.
6816  * ---------------------------------------------------------------------------*/
6817 #define JIM_EE_STATICSTACK_LEN 10
6818
6819 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6820         Jim_Obj **exprResultPtrPtr)
6821 {
6822     ExprByteCode *expr;
6823     Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6824     int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6825
6826     Jim_IncrRefCount(exprObjPtr);
6827     expr = Jim_GetExpression(interp, exprObjPtr);
6828     if (!expr) {
6829         Jim_DecrRefCount(interp, exprObjPtr);
6830         return JIM_ERR; /* error in expression. */
6831     }
6832     /* In order to avoid that the internal repr gets freed due to
6833      * shimmering of the exprObjPtr's object, we make the internal rep
6834      * shared. */
6835     expr->inUse++;
6836
6837     /* The stack-based expr VM itself */
6838
6839     /* Stack allocation. Expr programs have the feature that
6840      * a program of length N can't require a stack longer than
6841      * N. */
6842     if (expr->len > JIM_EE_STATICSTACK_LEN)
6843         stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6844     else
6845         stack = staticStack;
6846
6847     /* Execute every istruction */
6848     for (i = 0; i < expr->len; i++) {
6849         Jim_Obj *A, *B, *objPtr;
6850         jim_wide wA, wB, wC;
6851         double dA, dB, dC;
6852         const char *sA, *sB;
6853         int Alen, Blen, retcode;
6854         int opcode = expr->opcode[i];
6855
6856         if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6857             stack[stacklen++] = expr->obj[i];
6858             Jim_IncrRefCount(expr->obj[i]);
6859         } else if (opcode == JIM_EXPROP_VARIABLE) {
6860             objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6861             if (objPtr == NULL) {
6862                 error = 1;
6863                 goto err;
6864             }
6865             stack[stacklen++] = objPtr;
6866             Jim_IncrRefCount(objPtr);
6867         } else if (opcode == JIM_EXPROP_SUBST) {
6868             if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6869                         &objPtr, JIM_NONE)) != JIM_OK)
6870             {
6871                 error = 1;
6872                 errRetCode = retcode;
6873                 goto err;
6874             }
6875             stack[stacklen++] = objPtr;
6876             Jim_IncrRefCount(objPtr);
6877         } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6878             objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6879             if (objPtr == NULL) {
6880                 error = 1;
6881                 goto err;
6882             }
6883             stack[stacklen++] = objPtr;
6884             Jim_IncrRefCount(objPtr);
6885         } else if (opcode == JIM_EXPROP_COMMAND) {
6886             if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6887                 error = 1;
6888                 errRetCode = retcode;
6889                 goto err;
6890             }
6891             stack[stacklen++] = interp->result;
6892             Jim_IncrRefCount(interp->result);
6893         } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6894                    opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6895         {
6896             /* Note that there isn't to increment the
6897              * refcount of objects. the references are moved
6898              * from stack to A and B. */
6899             B = stack[--stacklen];
6900             A = stack[--stacklen];
6901
6902             /* --- Integer --- */
6903             if ((A->typePtr == &doubleObjType && !A->bytes) ||
6904                 (B->typePtr == &doubleObjType && !B->bytes) ||
6905                 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6906                 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6907                 goto trydouble;
6908             }
6909             Jim_DecrRefCount(interp, A);
6910             Jim_DecrRefCount(interp, B);
6911             switch(expr->opcode[i]) {
6912             case JIM_EXPROP_ADD: wC = wA+wB; break;
6913             case JIM_EXPROP_SUB: wC = wA-wB; break;
6914             case JIM_EXPROP_MUL: wC = wA*wB; break;
6915             case JIM_EXPROP_LT: wC = wA<wB; break;
6916             case JIM_EXPROP_GT: wC = wA>wB; break;
6917             case JIM_EXPROP_LTE: wC = wA<=wB; break;
6918             case JIM_EXPROP_GTE: wC = wA>=wB; break;
6919             case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6920             case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6921             case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6922             case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6923             case JIM_EXPROP_BITAND: wC = wA&wB; break;
6924             case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6925             case JIM_EXPROP_BITOR: wC = wA|wB; break;
6926             case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6927             case JIM_EXPROP_LOGICAND_LEFT:
6928                 if (wA == 0) {
6929                     i += (int)wB;
6930                     wC = 0;
6931                 } else {
6932                     continue;
6933                 }
6934                 break;
6935             case JIM_EXPROP_LOGICOR_LEFT:
6936                 if (wA != 0) {
6937                     i += (int)wB;
6938                     wC = 1;
6939                 } else {
6940                     continue;
6941                 }
6942                 break;
6943             case JIM_EXPROP_DIV:
6944                 if (wB == 0) goto divbyzero;
6945                 wC = wA/wB;
6946                 break;
6947             case JIM_EXPROP_MOD:
6948                 if (wB == 0) goto divbyzero;
6949                 wC = wA%wB;
6950                 break;
6951             case JIM_EXPROP_ROTL: {
6952                 /* uint32_t would be better. But not everyone has inttypes.h?*/
6953                 unsigned long uA = (unsigned long)wA;
6954 #ifdef _MSC_VER
6955                 wC = _rotl(uA,(unsigned long)wB);
6956 #else
6957                 const unsigned int S = sizeof(unsigned long) * 8;
6958                 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6959 #endif
6960                 break;
6961             }
6962             case JIM_EXPROP_ROTR: {
6963                 unsigned long uA = (unsigned long)wA;
6964 #ifdef _MSC_VER
6965                 wC = _rotr(uA,(unsigned long)wB);
6966 #else
6967                 const unsigned int S = sizeof(unsigned long) * 8;
6968                 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
6969 #endif
6970                 break;
6971             }
6972
6973             default:
6974                 wC = 0; /* avoid gcc warning */
6975                 break;
6976             }
6977             stack[stacklen] = Jim_NewIntObj(interp, wC);
6978             Jim_IncrRefCount(stack[stacklen]);
6979             stacklen++;
6980             continue;
6981 trydouble:
6982             /* --- Double --- */
6983             if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
6984                 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
6985                 Jim_DecrRefCount(interp, A);
6986                 Jim_DecrRefCount(interp, B);
6987                 error = 1;
6988                 goto err;
6989             }
6990             Jim_DecrRefCount(interp, A);
6991             Jim_DecrRefCount(interp, B);
6992             switch(expr->opcode[i]) {
6993             case JIM_EXPROP_ROTL:
6994             case JIM_EXPROP_ROTR:
6995             case JIM_EXPROP_LSHIFT:
6996             case JIM_EXPROP_RSHIFT:
6997             case JIM_EXPROP_BITAND:
6998             case JIM_EXPROP_BITXOR:
6999             case JIM_EXPROP_BITOR:
7000             case JIM_EXPROP_MOD:
7001             case JIM_EXPROP_POW:
7002                 Jim_SetResultString(interp,
7003                     "Got floating-point value where integer was expected", -1);
7004                 error = 1;
7005                 goto err;
7006                 break;
7007             case JIM_EXPROP_ADD: dC = dA+dB; break;
7008             case JIM_EXPROP_SUB: dC = dA-dB; break;
7009             case JIM_EXPROP_MUL: dC = dA*dB; break;
7010             case JIM_EXPROP_LT: dC = dA<dB; break;
7011             case JIM_EXPROP_GT: dC = dA>dB; break;
7012             case JIM_EXPROP_LTE: dC = dA<=dB; break;
7013             case JIM_EXPROP_GTE: dC = dA>=dB; break;
7014             case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7015             case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7016             case JIM_EXPROP_LOGICAND_LEFT:
7017                 if (dA == 0) {
7018                     i += (int)dB;
7019                     dC = 0;
7020                 } else {
7021                     continue;
7022                 }
7023                 break;
7024             case JIM_EXPROP_LOGICOR_LEFT:
7025                 if (dA != 0) {
7026                     i += (int)dB;
7027                     dC = 1;
7028                 } else {
7029                     continue;
7030                 }
7031                 break;
7032             case JIM_EXPROP_DIV:
7033                 if (dB == 0) goto divbyzero;
7034                 dC = dA/dB;
7035                 break;
7036             default:
7037                 dC = 0; /* avoid gcc warning */
7038                 break;
7039             }
7040             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7041             Jim_IncrRefCount(stack[stacklen]);
7042             stacklen++;
7043         } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7044             B = stack[--stacklen];
7045             A = stack[--stacklen];
7046             sA = Jim_GetString(A, &Alen);
7047             sB = Jim_GetString(B, &Blen);
7048             switch(expr->opcode[i]) {
7049             case JIM_EXPROP_STREQ:
7050                 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7051                     wC = 1;
7052                 else
7053                     wC = 0;
7054                 break;
7055             case JIM_EXPROP_STRNE:
7056                 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7057                     wC = 1;
7058                 else
7059                     wC = 0;
7060                 break;
7061             default:
7062                 wC = 0; /* avoid gcc warning */
7063                 break;
7064             }
7065             Jim_DecrRefCount(interp, A);
7066             Jim_DecrRefCount(interp, B);
7067             stack[stacklen] = Jim_NewIntObj(interp, wC);
7068             Jim_IncrRefCount(stack[stacklen]);
7069             stacklen++;
7070         } else if (opcode == JIM_EXPROP_NOT ||
7071                    opcode == JIM_EXPROP_BITNOT ||
7072                    opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7073                    opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7074             /* Note that there isn't to increment the
7075              * refcount of objects. the references are moved
7076              * from stack to A and B. */
7077             A = stack[--stacklen];
7078
7079             /* --- Integer --- */
7080             if ((A->typePtr == &doubleObjType && !A->bytes) ||
7081                 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7082                 goto trydouble_unary;
7083             }
7084             Jim_DecrRefCount(interp, A);
7085             switch(expr->opcode[i]) {
7086             case JIM_EXPROP_NOT: wC = !wA; break;
7087             case JIM_EXPROP_BITNOT: wC = ~wA; break;
7088             case JIM_EXPROP_LOGICAND_RIGHT:
7089             case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7090             default:
7091                 wC = 0; /* avoid gcc warning */
7092                 break;
7093             }
7094             stack[stacklen] = Jim_NewIntObj(interp, wC);
7095             Jim_IncrRefCount(stack[stacklen]);
7096             stacklen++;
7097             continue;
7098 trydouble_unary:
7099             /* --- Double --- */
7100             if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7101                 Jim_DecrRefCount(interp, A);
7102                 error = 1;
7103                 goto err;
7104             }
7105             Jim_DecrRefCount(interp, A);
7106             switch(expr->opcode[i]) {
7107             case JIM_EXPROP_NOT: dC = !dA; break;
7108             case JIM_EXPROP_LOGICAND_RIGHT:
7109             case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7110             case JIM_EXPROP_BITNOT:
7111                 Jim_SetResultString(interp,
7112                     "Got floating-point value where integer was expected", -1);
7113                 error = 1;
7114                 goto err;
7115                 break;
7116             default:
7117                 dC = 0; /* avoid gcc warning */
7118                 break;
7119             }
7120             stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7121             Jim_IncrRefCount(stack[stacklen]);
7122             stacklen++;
7123         } else {
7124             Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7125         }
7126     }
7127 err:
7128     /* There is no need to decerement the inUse field because
7129      * this reference is transfered back into the exprObjPtr. */
7130     Jim_FreeIntRep(interp, exprObjPtr);
7131     exprObjPtr->typePtr = &exprObjType;
7132     Jim_SetIntRepPtr(exprObjPtr, expr);
7133     Jim_DecrRefCount(interp, exprObjPtr);
7134     if (!error) {
7135         *exprResultPtrPtr = stack[0];
7136         Jim_IncrRefCount(stack[0]);
7137         errRetCode = JIM_OK;
7138     }
7139     for (i = 0; i < stacklen; i++) {
7140         Jim_DecrRefCount(interp, stack[i]);
7141     }
7142     if (stack != staticStack)
7143         Jim_Free(stack);
7144     return errRetCode;
7145 divbyzero:
7146     error = 1;
7147     Jim_SetResultString(interp, "Division by zero", -1);
7148     goto err;
7149 }
7150
7151 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7152 {
7153     int retcode;
7154     jim_wide wideValue;
7155     double doubleValue;
7156     Jim_Obj *exprResultPtr;
7157
7158     retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7159     if (retcode != JIM_OK)
7160         return retcode;
7161     if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7162         if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7163         {
7164             Jim_DecrRefCount(interp, exprResultPtr);
7165             return JIM_ERR;
7166         } else {
7167             Jim_DecrRefCount(interp, exprResultPtr);
7168             *boolPtr = doubleValue != 0;
7169             return JIM_OK;
7170         }
7171     }
7172     Jim_DecrRefCount(interp, exprResultPtr);
7173     *boolPtr = wideValue != 0;
7174     return JIM_OK;
7175 }
7176
7177 /* -----------------------------------------------------------------------------
7178  * ScanFormat String Object
7179  * ---------------------------------------------------------------------------*/
7180
7181 /* This Jim_Obj will held a parsed representation of a format string passed to
7182  * the Jim_ScanString command. For error diagnostics, the scanformat string has
7183  * to be parsed in its entirely first and then, if correct, can be used for
7184  * scanning. To avoid endless re-parsing, the parsed representation will be
7185  * stored in an internal representation and re-used for performance reason. */
7186  
7187 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7188  * scanformat string. This part will later be used to extract information
7189  * out from the string to be parsed by Jim_ScanString */
7190  
7191 typedef struct ScanFmtPartDescr {
7192     char type;         /* Type of conversion (e.g. c, d, f) */
7193     char modifier;     /* Modify type (e.g. l - long, h - short */
7194     size_t  width;     /* Maximal width of input to be converted */
7195     int  pos;          /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */ 
7196     char *arg;         /* Specification of a CHARSET conversion */
7197     char *prefix;      /* Prefix to be scanned literally before conversion */
7198 } ScanFmtPartDescr;
7199
7200 /* The ScanFmtStringObj will held the internal representation of a scanformat
7201  * string parsed and separated in part descriptions. Furthermore it contains
7202  * the original string representation of the scanformat string to allow for
7203  * fast update of the Jim_Obj's string representation part.
7204  *
7205  * As add-on the internal object representation add some scratch pad area
7206  * for usage by Jim_ScanString to avoid endless allocating and freeing of
7207  * memory for purpose of string scanning.
7208  *
7209  * The error member points to a static allocated string in case of a mal-
7210  * formed scanformat string or it contains '0' (NULL) in case of a valid
7211  * parse representation.
7212  *
7213  * The whole memory of the internal representation is allocated as a single
7214  * area of memory that will be internally separated. So freeing and duplicating
7215  * of such an object is cheap */
7216
7217 typedef struct ScanFmtStringObj {
7218     jim_wide        size;         /* Size of internal repr in bytes */
7219     char            *stringRep;   /* Original string representation */
7220     size_t          count;        /* Number of ScanFmtPartDescr contained */
7221     size_t          convCount;    /* Number of conversions that will assign */
7222     size_t          maxPos;       /* Max position index if XPG3 is used */
7223     const char      *error;       /* Ptr to error text (NULL if no error */
7224     char            *scratch;     /* Some scratch pad used by Jim_ScanString */
7225     ScanFmtPartDescr descr[1];    /* The vector of partial descriptions */
7226 } ScanFmtStringObj;
7227
7228
7229 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7230 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7231 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7232
7233 static Jim_ObjType scanFmtStringObjType = {
7234     "scanformatstring",
7235     FreeScanFmtInternalRep,
7236     DupScanFmtInternalRep,
7237     UpdateStringOfScanFmt,
7238     JIM_TYPE_NONE,
7239 };
7240
7241 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7242 {
7243     JIM_NOTUSED(interp);
7244     Jim_Free((char*)objPtr->internalRep.ptr);
7245     objPtr->internalRep.ptr = 0;
7246 }
7247
7248 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7249 {
7250     size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7251     ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7252
7253     JIM_NOTUSED(interp);
7254     memcpy(newVec, srcPtr->internalRep.ptr, size);
7255     dupPtr->internalRep.ptr = newVec;
7256     dupPtr->typePtr = &scanFmtStringObjType;
7257 }
7258
7259 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7260 {
7261     char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7262
7263     objPtr->bytes = Jim_StrDup(bytes);
7264     objPtr->length = strlen(bytes);
7265 }
7266
7267 /* SetScanFmtFromAny will parse a given string and create the internal
7268  * representation of the format specification. In case of an error
7269  * the error data member of the internal representation will be set
7270  * to an descriptive error text and the function will be left with
7271  * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7272  * specification */
7273
7274 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7275 {
7276     ScanFmtStringObj *fmtObj;
7277     char *buffer;
7278     int maxCount, i, approxSize, lastPos = -1;
7279     const char *fmt = objPtr->bytes;
7280     int maxFmtLen = objPtr->length;
7281     const char *fmtEnd = fmt + maxFmtLen;
7282     int curr;
7283
7284     Jim_FreeIntRep(interp, objPtr);
7285     /* Count how many conversions could take place maximally */
7286     for (i=0, maxCount=0; i < maxFmtLen; ++i)
7287         if (fmt[i] == '%')
7288             ++maxCount;
7289     /* Calculate an approximation of the memory necessary */
7290     approxSize = sizeof(ScanFmtStringObj)           /* Size of the container */
7291         + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7292         + maxFmtLen * sizeof(char) + 3 + 1          /* Scratch + "%n" + '\0' */
7293         + maxFmtLen * sizeof(char) + 1              /* Original stringrep */
7294         + maxFmtLen * sizeof(char)                  /* Arg for CHARSETs */
7295         + (maxCount +1) * sizeof(char)              /* '\0' for every partial */
7296         + 1;                                        /* safety byte */
7297     fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7298     memset(fmtObj, 0, approxSize);
7299     fmtObj->size = approxSize;
7300     fmtObj->maxPos = 0;
7301     fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7302     fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7303     memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7304     buffer = fmtObj->stringRep + maxFmtLen + 1;
7305     objPtr->internalRep.ptr = fmtObj;
7306     objPtr->typePtr = &scanFmtStringObjType;
7307     for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7308         int width=0, skip;
7309         ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7310         fmtObj->count++;
7311         descr->width = 0;                   /* Assume width unspecified */ 
7312         /* Overread and store any "literal" prefix */
7313         if (*fmt != '%' || fmt[1] == '%') {
7314             descr->type = 0;
7315             descr->prefix = &buffer[i];
7316             for (; fmt < fmtEnd; ++fmt) {
7317                 if (*fmt == '%') {
7318                     if (fmt[1] != '%') break;
7319                     ++fmt;
7320                 }
7321                 buffer[i++] = *fmt;
7322             }
7323             buffer[i++] = 0;
7324         } 
7325         /* Skip the conversion introducing '%' sign */
7326         ++fmt;      
7327         /* End reached due to non-conversion literal only? */
7328         if (fmt >= fmtEnd)
7329             goto done;
7330         descr->pos = 0;                     /* Assume "natural" positioning */
7331         if (*fmt == '*') {
7332             descr->pos = -1;       /* Okay, conversion will not be assigned */
7333             ++fmt;
7334         } else
7335             fmtObj->convCount++;    /* Otherwise count as assign-conversion */
7336         /* Check if next token is a number (could be width or pos */
7337         if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7338             fmt += skip;
7339             /* Was the number a XPG3 position specifier? */
7340             if (descr->pos != -1 && *fmt == '$') {
7341                 int prev;
7342                 ++fmt;
7343                 descr->pos = width;
7344                 width = 0;
7345                 /* Look if "natural" postioning and XPG3 one was mixed */
7346                 if ((lastPos == 0 && descr->pos > 0)
7347                         || (lastPos > 0 && descr->pos == 0)) {
7348                     fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7349                     return JIM_ERR;
7350                 }
7351                 /* Look if this position was already used */
7352                 for (prev=0; prev < curr; ++prev) {
7353                     if (fmtObj->descr[prev].pos == -1) continue;
7354                     if (fmtObj->descr[prev].pos == descr->pos) {
7355                         fmtObj->error = "same \"%n$\" conversion specifier "
7356                             "used more than once";
7357                         return JIM_ERR;
7358                     }
7359                 }
7360                 /* Try to find a width after the XPG3 specifier */
7361                 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7362                     descr->width = width;
7363                     fmt += skip;
7364                 }
7365                 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7366                     fmtObj->maxPos = descr->pos;
7367             } else {
7368                 /* Number was not a XPG3, so it has to be a width */
7369                 descr->width = width;
7370             }
7371         }
7372         /* If positioning mode was undetermined yet, fix this */
7373         if (lastPos == -1)
7374             lastPos = descr->pos;
7375         /* Handle CHARSET conversion type ... */
7376         if (*fmt == '[') {
7377             int swapped = 1, beg = i, end, j;
7378             descr->type = '[';
7379             descr->arg = &buffer[i];
7380             ++fmt;
7381             if (*fmt == '^') buffer[i++] = *fmt++;
7382             if (*fmt == ']') buffer[i++] = *fmt++;
7383             while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7384             if (*fmt != ']') {
7385                 fmtObj->error = "unmatched [ in format string";
7386                 return JIM_ERR;
7387             } 
7388             end = i;
7389             buffer[i++] = 0;
7390             /* In case a range fence was given "backwards", swap it */
7391             while (swapped) {
7392                 swapped = 0;
7393                 for (j=beg+1; j < end-1; ++j) {
7394                     if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7395                         char tmp = buffer[j-1];
7396                         buffer[j-1] = buffer[j+1];
7397                         buffer[j+1] = tmp;
7398                         swapped = 1;
7399                     }
7400                 }
7401             }
7402         } else {
7403             /* Remember any valid modifier if given */
7404             if (strchr("hlL", *fmt) != 0)
7405                 descr->modifier = tolower((int)*fmt++);
7406             
7407             descr->type = *fmt;
7408             if (strchr("efgcsndoxui", *fmt) == 0) {
7409                 fmtObj->error = "bad scan conversion character";
7410                 return JIM_ERR;
7411             } else if (*fmt == 'c' && descr->width != 0) {
7412                 fmtObj->error = "field width may not be specified in %c "
7413                     "conversion";
7414                 return JIM_ERR;
7415             } else if (*fmt == 'u' && descr->modifier == 'l') {
7416                 fmtObj->error = "unsigned wide not supported";
7417                 return JIM_ERR;
7418             }
7419         }
7420         curr++;
7421     }
7422 done:
7423     if (fmtObj->convCount == 0) {
7424         fmtObj->error = "no any conversion specifier given";
7425         return JIM_ERR;
7426     }
7427     return JIM_OK;
7428 }
7429
7430 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7431
7432 #define FormatGetCnvCount(_fo_) \
7433     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7434 #define FormatGetMaxPos(_fo_) \
7435     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7436 #define FormatGetError(_fo_) \
7437     ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7438
7439 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7440  * charsets ([a-z123]) within scanning. Later on perhaps a base for a 
7441  * bitvector implementation in Jim? */ 
7442
7443 static int JimTestBit(const char *bitvec, char ch)
7444 {
7445     div_t pos = div(ch-1, 8);
7446     return bitvec[pos.quot] & (1 << pos.rem);
7447 }
7448
7449 static void JimSetBit(char *bitvec, char ch)
7450 {
7451     div_t pos = div(ch-1, 8);
7452     bitvec[pos.quot] |= (1 << pos.rem);
7453 }
7454
7455 #if 0 /* currently not used */
7456 static void JimClearBit(char *bitvec, char ch)
7457 {
7458     div_t pos = div(ch-1, 8);
7459     bitvec[pos.quot] &= ~(1 << pos.rem);
7460 }
7461 #endif
7462
7463 /* JimScanAString is used to scan an unspecified string that ends with
7464  * next WS, or a string that is specified via a charset. The charset
7465  * is currently implemented in a way to only allow for usage with
7466  * ASCII. Whenever we will switch to UNICODE, another idea has to
7467  * be born :-/
7468  *
7469  * FIXME: Works only with ASCII */
7470
7471 static Jim_Obj *
7472 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7473 {
7474     size_t i;
7475     Jim_Obj *result;
7476     char charset[256/8+1];  /* A Charset may contain max 256 chars */
7477     char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7478
7479     /* First init charset to nothing or all, depending if a specified
7480      * or an unspecified string has to be parsed */
7481     memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7482     if (sdescr) {
7483         /* There was a set description given, that means we are parsing
7484          * a specified string. So we have to build a corresponding 
7485          * charset reflecting the description */
7486         int notFlag = 0;
7487         /* Should the set be negated at the end? */
7488         if (*sdescr == '^') {
7489             notFlag = 1;
7490             ++sdescr;
7491         }
7492         /* Here '-' is meant literally and not to define a range */
7493         if (*sdescr == '-') {
7494             JimSetBit(charset, '-');
7495             ++sdescr;
7496         }
7497         while (*sdescr) {
7498             if (sdescr[1] == '-' && sdescr[2] != 0) {
7499                 /* Handle range definitions */
7500                 int i;
7501                 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7502                     JimSetBit(charset, (char)i);
7503                 sdescr += 3;
7504             } else {
7505                 /* Handle verbatim character definitions */
7506                 JimSetBit(charset, *sdescr++);
7507             }
7508         }
7509         /* Negate the charset if there was a NOT given */
7510         for (i=0; notFlag && i < sizeof(charset); ++i)
7511             charset[i] = ~charset[i];
7512     } 
7513     /* And after all the mess above, the real work begin ... */
7514     while (str && *str) {
7515         if (!sdescr && isspace((int)*str))
7516             break; /* EOS via WS if unspecified */
7517         if (JimTestBit(charset, *str)) *buffer++ = *str++;
7518         else break;             /* EOS via mismatch if specified scanning */
7519     }
7520     *buffer = 0;                /* Close the string properly ... */
7521     result = Jim_NewStringObj(interp, anchor, -1);
7522     Jim_Free(anchor);           /* ... and free it afer usage */
7523     return result;
7524 }
7525
7526 /* ScanOneEntry will scan one entry out of the string passed as argument.
7527  * It use the sscanf() function for this task. After extracting and
7528  * converting of the value, the count of scanned characters will be
7529  * returned of -1 in case of no conversion tool place and string was
7530  * already scanned thru */
7531
7532 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7533         ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7534 {
7535 #   define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7536         ? sizeof(jim_wide)                             \
7537         : sizeof(double))
7538     char buffer[MAX_SIZE];
7539     char *value = buffer;
7540     const char *tok;
7541     const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7542     size_t sLen = strlen(&str[pos]), scanned = 0;
7543     size_t anchor = pos;
7544     int i;
7545
7546     /* First pessimiticly assume, we will not scan anything :-) */
7547     *valObjPtr = 0;
7548     if (descr->prefix) {
7549         /* There was a prefix given before the conversion, skip it and adjust
7550          * the string-to-be-parsed accordingly */
7551         for (i=0; str[pos] && descr->prefix[i]; ++i) {
7552             /* If prefix require, skip WS */
7553             if (isspace((int)descr->prefix[i]))
7554                 while (str[pos] && isspace((int)str[pos])) ++pos;
7555             else if (descr->prefix[i] != str[pos]) 
7556                 break;  /* Prefix do not match here, leave the loop */
7557             else
7558                 ++pos;  /* Prefix matched so far, next round */
7559         }
7560         if (str[pos] == 0)
7561             return -1;  /* All of str consumed: EOF condition */
7562         else if (descr->prefix[i] != 0)
7563             return 0;   /* Not whole prefix consumed, no conversion possible */
7564     }
7565     /* For all but following conversion, skip leading WS */
7566     if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7567         while (isspace((int)str[pos])) ++pos;
7568     /* Determine how much skipped/scanned so far */
7569     scanned = pos - anchor;
7570     if (descr->type == 'n') {
7571         /* Return pseudo conversion means: how much scanned so far? */
7572         *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7573     } else if (str[pos] == 0) {
7574         /* Cannot scan anything, as str is totally consumed */
7575         return -1;
7576     } else {
7577         /* Processing of conversions follows ... */
7578         if (descr->width > 0) {
7579             /* Do not try to scan as fas as possible but only the given width.
7580              * To ensure this, we copy the part that should be scanned. */
7581             size_t tLen = descr->width > sLen ? sLen : descr->width;
7582             tok = Jim_StrDupLen(&str[pos], tLen);
7583         } else {
7584             /* As no width was given, simply refer to the original string */
7585             tok = &str[pos];
7586         }
7587         switch (descr->type) {
7588             case 'c':
7589                 *valObjPtr = Jim_NewIntObj(interp, *tok);
7590                 scanned += 1;
7591                 break;
7592             case 'd': case 'o': case 'x': case 'u': case 'i': {
7593                 char *endp;  /* Position where the number finished */
7594                 int base = descr->type == 'o' ? 8
7595                     : descr->type == 'x' ? 16
7596                     : descr->type == 'i' ? 0
7597                     : 10;
7598                     
7599                 do {
7600                     /* Try to scan a number with the given base */
7601                     if (descr->modifier == 'l')
7602 #ifdef HAVE_LONG_LONG
7603                       *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7604 #else
7605                       *(jim_wide*)value = strtol(tok, &endp, base);
7606 #endif
7607                     else
7608                       if (descr->type == 'u')
7609                         *(long*)value = strtoul(tok, &endp, base);
7610                       else
7611                         *(long*)value = strtol(tok, &endp, base);
7612                     /* If scanning failed, and base was undetermined, simply
7613                      * put it to 10 and try once more. This should catch the
7614                      * case where %i begin to parse a number prefix (e.g. 
7615                      * '0x' but no further digits follows. This will be
7616                      * handled as a ZERO followed by a char 'x' by Tcl */
7617                     if (endp == tok && base == 0) base = 10;
7618                     else break;
7619                 } while (1);
7620                 if (endp != tok) {
7621                     /* There was some number sucessfully scanned! */
7622                     if (descr->modifier == 'l')
7623                         *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7624                     else
7625                         *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7626                     /* Adjust the number-of-chars scanned so far */
7627                     scanned += endp - tok;
7628                 } else {
7629                     /* Nothing was scanned. We have to determine if this
7630                      * happened due to e.g. prefix mismatch or input str
7631                      * exhausted */
7632                     scanned = *tok ? 0 : -1;
7633                 }
7634                 break;
7635             }
7636             case 's': case '[': {
7637                 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7638                 scanned += Jim_Length(*valObjPtr);
7639                 break;
7640             }
7641             case 'e': case 'f': case 'g': {
7642                 char *endp;
7643
7644                 *(double*)value = strtod(tok, &endp);
7645                 if (endp != tok) {
7646                     /* There was some number sucessfully scanned! */
7647                     *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7648                     /* Adjust the number-of-chars scanned so far */
7649                     scanned += endp - tok;
7650                 } else {
7651                     /* Nothing was scanned. We have to determine if this
7652                      * happened due to e.g. prefix mismatch or input str
7653                      * exhausted */
7654                     scanned = *tok ? 0 : -1;
7655                 }
7656                 break;
7657             }
7658         }
7659         /* If a substring was allocated (due to pre-defined width) do not
7660          * forget to free it */
7661         if (tok != &str[pos])
7662             Jim_Free((char*)tok);
7663     }
7664     return scanned;
7665 }
7666
7667 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7668  * string and returns all converted (and not ignored) values in a list back
7669  * to the caller. If an error occured, a NULL pointer will be returned */
7670
7671 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7672         Jim_Obj *fmtObjPtr, int flags)
7673 {
7674     size_t i, pos;
7675     int scanned = 1;
7676     const char *str = Jim_GetString(strObjPtr, 0);
7677     Jim_Obj *resultList = 0;
7678     Jim_Obj **resultVec;
7679     int resultc;
7680     Jim_Obj *emptyStr = 0;
7681     ScanFmtStringObj *fmtObj;
7682
7683     /* If format specification is not an object, convert it! */
7684     if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7685         SetScanFmtFromAny(interp, fmtObjPtr);
7686     fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7687     /* Check if format specification was valid */
7688     if (fmtObj->error != 0) {
7689         if (flags & JIM_ERRMSG)
7690             Jim_SetResultString(interp, fmtObj->error, -1);
7691         return 0;
7692     }
7693     /* Allocate a new "shared" empty string for all unassigned conversions */
7694     emptyStr = Jim_NewEmptyStringObj(interp);
7695     Jim_IncrRefCount(emptyStr);
7696     /* Create a list and fill it with empty strings up to max specified XPG3 */
7697     resultList = Jim_NewListObj(interp, 0, 0);
7698     if (fmtObj->maxPos > 0) {
7699         for (i=0; i < fmtObj->maxPos; ++i)
7700             Jim_ListAppendElement(interp, resultList, emptyStr);
7701         JimListGetElements(interp, resultList, &resultc, &resultVec);
7702     }
7703     /* Now handle every partial format description */
7704     for (i=0, pos=0; i < fmtObj->count; ++i) {
7705         ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7706         Jim_Obj *value = 0;
7707         /* Only last type may be "literal" w/o conversion - skip it! */
7708         if (descr->type == 0) continue;
7709         /* As long as any conversion could be done, we will proceed */
7710         if (scanned > 0)
7711             scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7712         /* In case our first try results in EOF, we will leave */
7713         if (scanned == -1 && i == 0)
7714             goto eof;
7715         /* Advance next pos-to-be-scanned for the amount scanned already */
7716         pos += scanned;
7717         /* value == 0 means no conversion took place so take empty string */
7718         if (value == 0)
7719             value = Jim_NewEmptyStringObj(interp);
7720         /* If value is a non-assignable one, skip it */
7721         if (descr->pos == -1) {
7722             Jim_FreeNewObj(interp, value);
7723         } else if (descr->pos == 0)
7724             /* Otherwise append it to the result list if no XPG3 was given */
7725             Jim_ListAppendElement(interp, resultList, value);
7726         else if (resultVec[descr->pos-1] == emptyStr) {
7727             /* But due to given XPG3, put the value into the corr. slot */
7728             Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7729             Jim_IncrRefCount(value);
7730             resultVec[descr->pos-1] = value;
7731         } else {
7732             /* Otherwise, the slot was already used - free obj and ERROR */
7733             Jim_FreeNewObj(interp, value);
7734             goto err;
7735         }
7736     }
7737     Jim_DecrRefCount(interp, emptyStr);
7738     return resultList;
7739 eof:
7740     Jim_DecrRefCount(interp, emptyStr);
7741     Jim_FreeNewObj(interp, resultList);
7742     return (Jim_Obj*)EOF;
7743 err:
7744     Jim_DecrRefCount(interp, emptyStr);
7745     Jim_FreeNewObj(interp, resultList);
7746     return 0;
7747 }
7748
7749 /* -----------------------------------------------------------------------------
7750  * Pseudo Random Number Generation
7751  * ---------------------------------------------------------------------------*/
7752 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7753         int seedLen);
7754
7755 /* Initialize the sbox with the numbers from 0 to 255 */
7756 static void JimPrngInit(Jim_Interp *interp)
7757 {
7758     int i;
7759     unsigned int seed[256];
7760
7761     interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7762     for (i = 0; i < 256; i++)
7763         seed[i] = (rand() ^ time(NULL) ^ clock());
7764     JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7765 }
7766
7767 /* Generates N bytes of random data */
7768 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7769 {
7770     Jim_PrngState *prng;
7771     unsigned char *destByte = (unsigned char*) dest;
7772     unsigned int si, sj, x;
7773
7774     /* initialization, only needed the first time */
7775     if (interp->prngState == NULL)
7776         JimPrngInit(interp);
7777     prng = interp->prngState;
7778     /* generates 'len' bytes of pseudo-random numbers */
7779     for (x = 0; x < len; x++) {
7780         prng->i = (prng->i+1) & 0xff;
7781         si = prng->sbox[prng->i];
7782         prng->j = (prng->j + si) & 0xff;
7783         sj = prng->sbox[prng->j];
7784         prng->sbox[prng->i] = sj;
7785         prng->sbox[prng->j] = si;
7786         *destByte++ = prng->sbox[(si+sj)&0xff];
7787     }
7788 }
7789
7790 /* Re-seed the generator with user-provided bytes */
7791 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7792         int seedLen)
7793 {
7794     int i;
7795     unsigned char buf[256];
7796     Jim_PrngState *prng;
7797
7798     /* initialization, only needed the first time */
7799     if (interp->prngState == NULL)
7800         JimPrngInit(interp);
7801     prng = interp->prngState;
7802
7803     /* Set the sbox[i] with i */
7804     for (i = 0; i < 256; i++)
7805         prng->sbox[i] = i;
7806     /* Now use the seed to perform a random permutation of the sbox */
7807     for (i = 0; i < seedLen; i++) {
7808         unsigned char t;
7809
7810         t = prng->sbox[i&0xFF];
7811         prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7812         prng->sbox[seed[i]] = t;
7813     }
7814     prng->i = prng->j = 0;
7815     /* discard the first 256 bytes of stream. */
7816     JimRandomBytes(interp, buf, 256);
7817 }
7818
7819 /* -----------------------------------------------------------------------------
7820  * Dynamic libraries support (WIN32 not supported)
7821  * ---------------------------------------------------------------------------*/
7822
7823 #ifdef JIM_DYNLIB
7824 #ifdef WIN32
7825 #define RTLD_LAZY 0
7826 void * dlopen(const char *path, int mode) 
7827 {
7828     JIM_NOTUSED(mode);
7829
7830     return (void *)LoadLibraryA(path);
7831 }
7832 int dlclose(void *handle)
7833 {
7834     FreeLibrary((HANDLE)handle);
7835     return 0;
7836 }
7837 void *dlsym(void *handle, const char *symbol)
7838 {
7839     return GetProcAddress((HMODULE)handle, symbol);
7840 }
7841 static char win32_dlerror_string[121];
7842 const char *dlerror(void)
7843 {
7844     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7845                    LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7846     return win32_dlerror_string;
7847 }
7848 #endif /* WIN32 */
7849
7850 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7851 {
7852     Jim_Obj *libPathObjPtr;
7853     int prefixc, i;
7854     void *handle;
7855     int (*onload)(Jim_Interp *interp);
7856
7857     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7858     if (libPathObjPtr == NULL) {
7859         prefixc = 0;
7860         libPathObjPtr = NULL;
7861     } else {
7862         Jim_IncrRefCount(libPathObjPtr);
7863         Jim_ListLength(interp, libPathObjPtr, &prefixc);
7864     }
7865
7866     for (i = -1; i < prefixc; i++) {
7867         if (i < 0) {
7868             handle = dlopen(pathName, RTLD_LAZY);
7869         } else {
7870             FILE *fp;
7871             char buf[JIM_PATH_LEN];
7872             const char *prefix;
7873             int prefixlen;
7874             Jim_Obj *prefixObjPtr;
7875             
7876             buf[0] = '\0';
7877             if (Jim_ListIndex(interp, libPathObjPtr, i,
7878                     &prefixObjPtr, JIM_NONE) != JIM_OK)
7879                 continue;
7880             prefix = Jim_GetString(prefixObjPtr, NULL);
7881             prefixlen = strlen(prefix);
7882             if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7883                 continue;
7884             if (prefixlen && prefix[prefixlen-1] == '/')
7885                 sprintf(buf, "%s%s", prefix, pathName);
7886             else
7887                 sprintf(buf, "%s/%s", prefix, pathName);
7888             printf("opening '%s'\n", buf);
7889             fp = fopen(buf, "r");
7890             if (fp == NULL)
7891                 continue;
7892             fclose(fp);
7893             handle = dlopen(buf, RTLD_LAZY);
7894             printf("got handle %p\n", handle);
7895         }
7896         if (handle == NULL) {
7897             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7898             Jim_AppendStrings(interp, Jim_GetResult(interp),
7899                 "error loading extension \"", pathName,
7900                 "\": ", dlerror(), NULL);
7901             if (i < 0)
7902                 continue;
7903             goto err;
7904         }
7905         if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7906             Jim_SetResultString(interp,
7907                     "No Jim_OnLoad symbol found on extension", -1);
7908             goto err;
7909         }
7910         if (onload(interp) == JIM_ERR) {
7911             dlclose(handle);
7912             goto err;
7913         }
7914         Jim_SetEmptyResult(interp);
7915         if (libPathObjPtr != NULL)
7916             Jim_DecrRefCount(interp, libPathObjPtr);
7917         return JIM_OK;
7918     }
7919 err:
7920     if (libPathObjPtr != NULL)
7921         Jim_DecrRefCount(interp, libPathObjPtr);
7922     return JIM_ERR;
7923 }
7924 #else /* JIM_DYNLIB */
7925 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7926 {
7927     JIM_NOTUSED(interp);
7928     JIM_NOTUSED(pathName);
7929
7930     Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7931     return JIM_ERR;
7932 }
7933 #endif/* JIM_DYNLIB */
7934
7935 /* -----------------------------------------------------------------------------
7936  * Packages handling
7937  * ---------------------------------------------------------------------------*/
7938
7939 #define JIM_PKG_ANY_VERSION -1
7940
7941 /* Convert a string of the type "1.2" into an integer.
7942  * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted 
7943  * to the integer with value 102 */
7944 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7945         int *intPtr, int flags)
7946 {
7947     char *copy;
7948     jim_wide major, minor;
7949     char *majorStr, *minorStr, *p;
7950
7951     if (v[0] == '\0') {
7952         *intPtr = JIM_PKG_ANY_VERSION;
7953         return JIM_OK;
7954     }
7955
7956     copy = Jim_StrDup(v);
7957     p = strchr(copy, '.');
7958     if (p == NULL) goto badfmt;
7959     *p = '\0';
7960     majorStr = copy;
7961     minorStr = p+1;
7962
7963     if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
7964         Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
7965         goto badfmt;
7966     *intPtr = (int)(major*100+minor);
7967     Jim_Free(copy);
7968     return JIM_OK;
7969
7970 badfmt:
7971     Jim_Free(copy);
7972     if (flags & JIM_ERRMSG) {
7973         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7974         Jim_AppendStrings(interp, Jim_GetResult(interp),
7975                 "invalid package version '", v, "'", NULL);
7976     }
7977     return JIM_ERR;
7978 }
7979
7980 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
7981 static int JimPackageMatchVersion(int needed, int actual, int flags)
7982 {
7983     if (needed == JIM_PKG_ANY_VERSION) return 1;
7984     if (flags & JIM_MATCHVER_EXACT) {
7985         return needed == actual;
7986     } else {
7987         return needed/100 == actual/100 && (needed <= actual);
7988     }
7989 }
7990
7991 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
7992         int flags)
7993 {
7994     int intVersion;
7995     /* Check if the version format is ok */
7996     if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
7997         return JIM_ERR;
7998     /* If the package was already provided returns an error. */
7999     if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8000         if (flags & JIM_ERRMSG) {
8001             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8002             Jim_AppendStrings(interp, Jim_GetResult(interp),
8003                     "package '", name, "' was already provided", NULL);
8004         }
8005         return JIM_ERR;
8006     }
8007     Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8008     return JIM_OK;
8009 }
8010
8011 #ifndef JIM_ANSIC
8012
8013 #ifndef WIN32
8014 # include <sys/types.h>
8015 # include <dirent.h>
8016 #else
8017 # include <io.h>
8018 /* Posix dirent.h compatiblity layer for WIN32.
8019  * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8020  * Copyright Salvatore Sanfilippo ,2005.
8021  *
8022  * Permission to use, copy, modify, and distribute this software and its
8023  * documentation for any purpose is hereby granted without fee, provided
8024  * that this copyright and permissions notice appear in all copies and
8025  * derivatives.
8026  *
8027  * This software is supplied "as is" without express or implied warranty.
8028  * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8029  */
8030
8031 struct dirent {
8032     char *d_name;
8033 };
8034
8035 typedef struct DIR {
8036     long                handle; /* -1 for failed rewind */
8037     struct _finddata_t  info;
8038     struct dirent       result; /* d_name null iff first time */
8039     char                *name;  /* null-terminated char string */
8040 } DIR;
8041
8042 DIR *opendir(const char *name)
8043 {
8044     DIR *dir = 0;
8045
8046     if(name && name[0]) {
8047         size_t base_length = strlen(name);
8048         const char *all = /* search pattern must end with suitable wildcard */
8049             strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8050
8051         if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8052            (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8053         {
8054             strcat(strcpy(dir->name, name), all);
8055
8056             if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8057                 dir->result.d_name = 0;
8058             else { /* rollback */
8059                 Jim_Free(dir->name);
8060                 Jim_Free(dir);
8061                 dir = 0;
8062             }
8063         } else { /* rollback */
8064             Jim_Free(dir);
8065             dir   = 0;
8066             errno = ENOMEM;
8067         }
8068     } else {
8069         errno = EINVAL;
8070     }
8071     return dir;
8072 }
8073
8074 int closedir(DIR *dir)
8075 {
8076     int result = -1;
8077
8078     if(dir) {
8079         if(dir->handle != -1)
8080             result = _findclose(dir->handle);
8081         Jim_Free(dir->name);
8082         Jim_Free(dir);
8083     }
8084     if(result == -1) /* map all errors to EBADF */
8085         errno = EBADF;
8086     return result;
8087 }
8088
8089 struct dirent *readdir(DIR *dir)
8090 {
8091     struct dirent *result = 0;
8092
8093     if(dir && dir->handle != -1) {
8094         if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8095             result         = &dir->result;
8096             result->d_name = dir->info.name;
8097         }
8098     } else {
8099         errno = EBADF;
8100     }
8101     return result;
8102 }
8103
8104 #endif /* WIN32 */
8105
8106 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8107         int prefixc, const char *pkgName, int pkgVer, int flags)
8108 {
8109     int bestVer = -1, i;
8110     int pkgNameLen = strlen(pkgName);
8111     char *bestPackage = NULL;
8112     struct dirent *de;
8113
8114     for (i = 0; i < prefixc; i++) {
8115         DIR *dir;
8116         char buf[JIM_PATH_LEN];
8117         int prefixLen;
8118
8119         if (prefixes[i] == NULL) continue;
8120         strncpy(buf, prefixes[i], JIM_PATH_LEN);
8121         buf[JIM_PATH_LEN-1] = '\0';
8122         prefixLen = strlen(buf);
8123         if (prefixLen && buf[prefixLen-1] == '/')
8124             buf[prefixLen-1] = '\0';
8125
8126         if ((dir = opendir(buf)) == NULL) continue;
8127         while ((de = readdir(dir)) != NULL) {
8128             char *fileName = de->d_name;
8129             int fileNameLen = strlen(fileName);
8130
8131             if (strncmp(fileName, "jim-", 4) == 0 &&
8132                 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8133                 *(fileName+4+pkgNameLen) == '-' &&
8134                 fileNameLen > 4 && /* note that this is not really useful */
8135                 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8136                  strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8137                  strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8138             {
8139                 char ver[6]; /* xx.yy<nulterm> */
8140                 char *p = strrchr(fileName, '.');
8141                 int verLen, fileVer;
8142
8143                 verLen = p - (fileName+4+pkgNameLen+1);
8144                 if (verLen < 3 || verLen > 5) continue;
8145                 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8146                 ver[verLen] = '\0';
8147                 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8148                         != JIM_OK) continue;
8149                 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8150                     (bestVer == -1 || bestVer < fileVer))
8151                 {
8152                     bestVer = fileVer;
8153                     Jim_Free(bestPackage);
8154                     bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8155                     sprintf(bestPackage, "%s/%s", buf, fileName);
8156                 }
8157             }
8158         }
8159         closedir(dir);
8160     }
8161     return bestPackage;
8162 }
8163
8164 #else /* JIM_ANSIC */
8165
8166 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8167         int prefixc, const char *pkgName, int pkgVer, int flags)
8168 {
8169     JIM_NOTUSED(interp);
8170     JIM_NOTUSED(prefixes);
8171     JIM_NOTUSED(prefixc);
8172     JIM_NOTUSED(pkgName);
8173     JIM_NOTUSED(pkgVer);
8174     JIM_NOTUSED(flags);
8175     return NULL;
8176 }
8177
8178 #endif /* JIM_ANSIC */
8179
8180 /* Search for a suitable package under every dir specified by jim_libpath
8181  * and load it if possible. If a suitable package was loaded with success
8182  * JIM_OK is returned, otherwise JIM_ERR is returned. */
8183 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8184         int flags)
8185 {
8186     Jim_Obj *libPathObjPtr;
8187     char **prefixes, *best;
8188     int prefixc, i, retCode = JIM_OK;
8189
8190     libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8191     if (libPathObjPtr == NULL) {
8192         prefixc = 0;
8193         libPathObjPtr = NULL;
8194     } else {
8195         Jim_IncrRefCount(libPathObjPtr);
8196         Jim_ListLength(interp, libPathObjPtr, &prefixc);
8197     }
8198
8199     prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8200     for (i = 0; i < prefixc; i++) {
8201             Jim_Obj *prefixObjPtr;
8202             if (Jim_ListIndex(interp, libPathObjPtr, i,
8203                     &prefixObjPtr, JIM_NONE) != JIM_OK)
8204             {
8205                 prefixes[i] = NULL;
8206                 continue;
8207             }
8208             prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8209     }
8210     /* Scan every directory to find the "best" package. */
8211     best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8212     if (best != NULL) {
8213         char *p = strrchr(best, '.');
8214         /* Try to load/source it */
8215         if (p && strcmp(p, ".tcl") == 0) {
8216             retCode = Jim_EvalFile(interp, best);
8217         } else {
8218             retCode = Jim_LoadLibrary(interp, best);
8219         }
8220     } else {
8221         retCode = JIM_ERR;
8222     }
8223     Jim_Free(best);
8224     for (i = 0; i < prefixc; i++)
8225         Jim_Free(prefixes[i]);
8226     Jim_Free(prefixes);
8227     if (libPathObjPtr)
8228         Jim_DecrRefCount(interp, libPathObjPtr);
8229     return retCode;
8230 }
8231
8232 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8233         const char *ver, int flags)
8234 {
8235     Jim_HashEntry *he;
8236     int requiredVer;
8237
8238     if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8239         return NULL;
8240     he = Jim_FindHashEntry(&interp->packages, name);
8241     if (he == NULL) {
8242         /* Try to load the package. */
8243         if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8244             he = Jim_FindHashEntry(&interp->packages, name);
8245             if (he == NULL) {
8246                 return "?";
8247             }
8248             return he->val;
8249         }
8250         /* No way... return an error. */
8251         if (flags & JIM_ERRMSG) {
8252             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8253             Jim_AppendStrings(interp, Jim_GetResult(interp),
8254                     "Can't find package '", name, "'", NULL);
8255         }
8256         return NULL;
8257     } else {
8258         int actualVer;
8259         if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8260                 != JIM_OK)
8261         {
8262             return NULL;
8263         }
8264         /* Check if version matches. */
8265         if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8266             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8267             Jim_AppendStrings(interp, Jim_GetResult(interp),
8268                     "Package '", name, "' already loaded, but with version ",
8269                     he->val, NULL);
8270             return NULL;
8271         }
8272         return he->val;
8273     }
8274 }
8275
8276 /* -----------------------------------------------------------------------------
8277  * Eval
8278  * ---------------------------------------------------------------------------*/
8279 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8280 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8281
8282 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8283         Jim_Obj *const *argv);
8284
8285 /* Handle calls to the [unknown] command */
8286 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8287 {
8288     Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8289     int retCode;
8290
8291     /* If the [unknown] command does not exists returns
8292      * just now */
8293     if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8294         return JIM_ERR;
8295
8296     /* The object interp->unknown just contains
8297      * the "unknown" string, it is used in order to
8298      * avoid to lookup the unknown command every time
8299      * but instread to cache the result. */
8300     if (argc+1 <= JIM_EVAL_SARGV_LEN)
8301         v = sv;
8302     else
8303         v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8304     /* Make a copy of the arguments vector, but shifted on
8305      * the right of one position. The command name of the
8306      * command will be instead the first argument of the
8307      * [unknonw] call. */
8308     memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8309     v[0] = interp->unknown;
8310     /* Call it */
8311     retCode = Jim_EvalObjVector(interp, argc+1, v);
8312     /* Clean up */
8313     if (v != sv)
8314         Jim_Free(v);
8315     return retCode;
8316 }
8317
8318 /* Eval the object vector 'objv' composed of 'objc' elements.
8319  * Every element is used as single argument.
8320  * Jim_EvalObj() will call this function every time its object
8321  * argument is of "list" type, with no string representation.
8322  *
8323  * This is possible because the string representation of a
8324  * list object generated by the UpdateStringOfList is made
8325  * in a way that ensures that every list element is a different
8326  * command argument. */
8327 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8328 {
8329     int i, retcode;
8330     Jim_Cmd *cmdPtr;
8331
8332     /* Incr refcount of arguments. */
8333     for (i = 0; i < objc; i++)
8334         Jim_IncrRefCount(objv[i]);
8335     /* Command lookup */
8336     cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8337     if (cmdPtr == NULL) {
8338         retcode = JimUnknown(interp, objc, objv);
8339     } else {
8340         /* Call it -- Make sure result is an empty object. */
8341         Jim_SetEmptyResult(interp);
8342         if (cmdPtr->cmdProc) {
8343             interp->cmdPrivData = cmdPtr->privData;
8344             retcode = cmdPtr->cmdProc(interp, objc, objv);
8345         } else {
8346             retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8347     if (retcode == JIM_ERR) {
8348         JimAppendStackTrace(interp,
8349             Jim_GetString(objv[0], NULL), "?", 1);
8350     }
8351         }
8352     }
8353     /* Decr refcount of arguments and return the retcode */
8354     for (i = 0; i < objc; i++)
8355         Jim_DecrRefCount(interp, objv[i]);
8356     return retcode;
8357 }
8358
8359 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8360  * via *objPtrPtr. This function is only called by Jim_EvalObj().
8361  * The returned object has refcount = 0. */
8362 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8363         int tokens, Jim_Obj **objPtrPtr)
8364 {
8365     int totlen = 0, i, retcode;
8366     Jim_Obj **intv;
8367     Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8368     Jim_Obj *objPtr;
8369     char *s;
8370
8371     if (tokens <= JIM_EVAL_SINTV_LEN)
8372         intv = sintv;
8373     else
8374         intv = Jim_Alloc(sizeof(Jim_Obj*)*
8375                 tokens);
8376     /* Compute every token forming the argument
8377      * in the intv objects vector. */
8378     for (i = 0; i < tokens; i++) {
8379         switch(token[i].type) {
8380         case JIM_TT_ESC:
8381         case JIM_TT_STR:
8382             intv[i] = token[i].objPtr;
8383             break;
8384         case JIM_TT_VAR:
8385             intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8386             if (!intv[i]) {
8387                 retcode = JIM_ERR;
8388                 goto err;
8389             }
8390             break;
8391         case JIM_TT_DICTSUGAR:
8392             intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8393             if (!intv[i]) {
8394                 retcode = JIM_ERR;
8395                 goto err;
8396             }
8397             break;
8398         case JIM_TT_CMD:
8399             retcode = Jim_EvalObj(interp, token[i].objPtr);
8400             if (retcode != JIM_OK)
8401                 goto err;
8402             intv[i] = Jim_GetResult(interp);
8403             break;
8404         default:
8405             Jim_Panic(interp,
8406               "default token type reached "
8407               "in Jim_InterpolateTokens().");
8408             break;
8409         }
8410         Jim_IncrRefCount(intv[i]);
8411         /* Make sure there is a valid
8412          * string rep, and add the string
8413          * length to the total legnth. */
8414         Jim_GetString(intv[i], NULL);
8415         totlen += intv[i]->length;
8416     }
8417     /* Concatenate every token in an unique
8418      * object. */
8419     objPtr = Jim_NewStringObjNoAlloc(interp,
8420             NULL, 0);
8421     s = objPtr->bytes = Jim_Alloc(totlen+1);
8422     objPtr->length = totlen;
8423     for (i = 0; i < tokens; i++) {
8424         memcpy(s, intv[i]->bytes, intv[i]->length);
8425         s += intv[i]->length;
8426         Jim_DecrRefCount(interp, intv[i]);
8427     }
8428     objPtr->bytes[totlen] = '\0';
8429     /* Free the intv vector if not static. */
8430     if (tokens > JIM_EVAL_SINTV_LEN)
8431         Jim_Free(intv);
8432     *objPtrPtr = objPtr;
8433     return JIM_OK;
8434 err:
8435     i--;
8436     for (; i >= 0; i--)
8437         Jim_DecrRefCount(interp, intv[i]);
8438     if (tokens > JIM_EVAL_SINTV_LEN)
8439         Jim_Free(intv);
8440     return retcode;
8441 }
8442
8443 /* Helper of Jim_EvalObj() to perform argument expansion.
8444  * Basically this function append an argument to 'argv'
8445  * (and increments argc by reference accordingly), performing
8446  * expansion of the list object if 'expand' is non-zero, or
8447  * just adding objPtr to argv if 'expand' is zero. */
8448 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8449         int *argcPtr, int expand, Jim_Obj *objPtr)
8450 {
8451     if (!expand) {
8452         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8453         /* refcount of objPtr not incremented because
8454          * we are actually transfering a reference from
8455          * the old 'argv' to the expanded one. */
8456         (*argv)[*argcPtr] = objPtr;
8457         (*argcPtr)++;
8458     } else {
8459         int len, i;
8460
8461         Jim_ListLength(interp, objPtr, &len);
8462         (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8463         for (i = 0; i < len; i++) {
8464             (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8465             Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8466             (*argcPtr)++;
8467         }
8468         /* The original object reference is no longer needed,
8469          * after the expansion it is no longer present on
8470          * the argument vector, but the single elements are
8471          * in its place. */
8472         Jim_DecrRefCount(interp, objPtr);
8473     }
8474 }
8475
8476 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8477 {
8478     int i, j = 0, len;
8479     ScriptObj *script;
8480     ScriptToken *token;
8481     int *cs; /* command structure array */
8482     int retcode = JIM_OK;
8483     Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8484
8485     interp->errorFlag = 0;
8486
8487     /* If the object is of type "list" and there is no
8488      * string representation for this object, we can call
8489      * a specialized version of Jim_EvalObj() */
8490     if (scriptObjPtr->typePtr == &listObjType &&
8491         scriptObjPtr->internalRep.listValue.len &&
8492         scriptObjPtr->bytes == NULL) {
8493         Jim_IncrRefCount(scriptObjPtr);
8494         retcode = Jim_EvalObjVector(interp,
8495                 scriptObjPtr->internalRep.listValue.len,
8496                 scriptObjPtr->internalRep.listValue.ele);
8497         Jim_DecrRefCount(interp, scriptObjPtr);
8498         return retcode;
8499     }
8500
8501     Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8502     script = Jim_GetScript(interp, scriptObjPtr);
8503     /* Now we have to make sure the internal repr will not be
8504      * freed on shimmering.
8505      *
8506      * Think for example to this:
8507      *
8508      * set x {llength $x; ... some more code ...}; eval $x
8509      *
8510      * In order to preserve the internal rep, we increment the
8511      * inUse field of the script internal rep structure. */
8512     script->inUse++;
8513
8514     token = script->token;
8515     len = script->len;
8516     cs = script->cmdStruct;
8517     i = 0; /* 'i' is the current token index. */
8518
8519     /* Reset the interpreter result. This is useful to
8520      * return the emtpy result in the case of empty program. */
8521     Jim_SetEmptyResult(interp);
8522
8523     /* Execute every command sequentially, returns on
8524      * error (i.e. if a command does not return JIM_OK) */
8525     while (i < len) {
8526         int expand = 0;
8527         int argc = *cs++; /* Get the number of arguments */
8528         Jim_Cmd *cmd;
8529
8530         /* Set the expand flag if needed. */
8531         if (argc == -1) {
8532             expand++;
8533             argc = *cs++;
8534         }
8535         /* Allocate the arguments vector */
8536         if (argc <= JIM_EVAL_SARGV_LEN)
8537             argv = sargv;
8538         else
8539             argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8540         /* Populate the arguments objects. */
8541         for (j = 0; j < argc; j++) {
8542             int tokens = *cs++;
8543
8544             /* tokens is negative if expansion is needed.
8545              * for this argument. */
8546             if (tokens < 0) {
8547                 tokens = (-tokens)-1;
8548                 i++;
8549             }
8550             if (tokens == 1) {
8551                 /* Fast path if the token does not
8552                  * need interpolation */
8553                 switch(token[i].type) {
8554                 case JIM_TT_ESC:
8555                 case JIM_TT_STR:
8556                     argv[j] = token[i].objPtr;
8557                     break;
8558                 case JIM_TT_VAR:
8559                     tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8560                             JIM_ERRMSG);
8561                     if (!tmpObjPtr) {
8562                         retcode = JIM_ERR;
8563                         goto err;
8564                     }
8565                     argv[j] = tmpObjPtr;
8566                     break;
8567                 case JIM_TT_DICTSUGAR:
8568                     tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8569                     if (!tmpObjPtr) {
8570                         retcode = JIM_ERR;
8571                         goto err;
8572                     }
8573                     argv[j] = tmpObjPtr;
8574                     break;
8575                 case JIM_TT_CMD:
8576                     retcode = Jim_EvalObj(interp, token[i].objPtr);
8577                     if (retcode != JIM_OK)
8578                         goto err;
8579                     argv[j] = Jim_GetResult(interp);
8580                     break;
8581                 default:
8582                     Jim_Panic(interp,
8583                       "default token type reached "
8584                       "in Jim_EvalObj().");
8585                     break;
8586                 }
8587                 Jim_IncrRefCount(argv[j]);
8588                 i += 2;
8589             } else {
8590                 /* For interpolation we call an helper
8591                  * function doing the work for us. */
8592                 if ((retcode = Jim_InterpolateTokens(interp,
8593                         token+i, tokens, &tmpObjPtr)) != JIM_OK)
8594                 {
8595                     goto err;
8596                 }
8597                 argv[j] = tmpObjPtr;
8598                 Jim_IncrRefCount(argv[j]);
8599                 i += tokens+1;
8600             }
8601         }
8602         /* Handle {expand} expansion */
8603         if (expand) {
8604             int *ecs = cs - argc;
8605             int eargc = 0;
8606             Jim_Obj **eargv = NULL;
8607
8608             for (j = 0; j < argc; j++) {
8609                 Jim_ExpandArgument( interp, &eargv, &eargc,
8610                         ecs[j] < 0, argv[j]);
8611             }
8612             if (argv != sargv)
8613                 Jim_Free(argv);
8614             argc = eargc;
8615             argv = eargv;
8616             j = argc;
8617             if (argc == 0) {
8618                 /* Nothing to do with zero args. */
8619                 Jim_Free(eargv);
8620                 continue;
8621             }
8622         }
8623         /* Lookup the command to call */
8624         cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8625         if (cmd != NULL) {
8626             /* Call it -- Make sure result is an empty object. */
8627             Jim_SetEmptyResult(interp);
8628             if (cmd->cmdProc) {
8629                 interp->cmdPrivData = cmd->privData;
8630                 retcode = cmd->cmdProc(interp, argc, argv);
8631             } else {
8632                 retcode = JimCallProcedure(interp, cmd, argc, argv);
8633                 if (retcode == JIM_ERR) {
8634                     JimAppendStackTrace(interp,
8635                         Jim_GetString(argv[0], NULL), script->fileName,
8636                         token[i-argc*2].linenr);
8637                 }
8638             }
8639         } else {
8640             /* Call [unknown] */
8641             retcode = JimUnknown(interp, argc, argv);
8642             if (retcode == JIM_ERR) {
8643                 JimAppendStackTrace(interp,
8644                     Jim_GetString(argv[0], NULL), script->fileName,
8645                     token[i-argc*2].linenr);
8646             }
8647         }
8648         if (retcode != JIM_OK) {
8649             i -= argc*2; /* point to the command name. */
8650             goto err;
8651         }
8652         /* Decrement the arguments count */
8653         for (j = 0; j < argc; j++) {
8654             Jim_DecrRefCount(interp, argv[j]);
8655         }
8656
8657         if (argv != sargv) {
8658             Jim_Free(argv);
8659             argv = NULL;
8660         }
8661     }
8662     /* Note that we don't have to decrement inUse, because the
8663      * following code transfers our use of the reference again to
8664      * the script object. */
8665     j = 0; /* on normal termination, the argv array is already
8666           Jim_DecrRefCount-ed. */
8667 err:
8668     /* Handle errors. */
8669     if (retcode == JIM_ERR && !interp->errorFlag) {
8670         interp->errorFlag = 1;
8671         JimSetErrorFileName(interp, script->fileName);
8672         JimSetErrorLineNumber(interp, token[i].linenr);
8673         JimResetStackTrace(interp);
8674     }
8675     Jim_FreeIntRep(interp, scriptObjPtr);
8676     scriptObjPtr->typePtr = &scriptObjType;
8677     Jim_SetIntRepPtr(scriptObjPtr, script);
8678     Jim_DecrRefCount(interp, scriptObjPtr);
8679     for (i = 0; i < j; i++) {
8680         Jim_DecrRefCount(interp, argv[i]);
8681     }
8682     if (argv != sargv)
8683         Jim_Free(argv);
8684     return retcode;
8685 }
8686
8687 /* Call a procedure implemented in Tcl.
8688  * It's possible to speed-up a lot this function, currently
8689  * the callframes are not cached, but allocated and
8690  * destroied every time. What is expecially costly is
8691  * to create/destroy the local vars hash table every time.
8692  *
8693  * This can be fixed just implementing callframes caching
8694  * in JimCreateCallFrame() and JimFreeCallFrame(). */
8695 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8696         Jim_Obj *const *argv)
8697 {
8698     int i, retcode;
8699     Jim_CallFrame *callFramePtr;
8700
8701     /* Check arity */
8702     if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8703         argc > cmd->arityMax)) {
8704         Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8705         Jim_AppendStrings(interp, objPtr,
8706             "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8707             (cmd->arityMin > 1) ? " " : "",
8708             Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8709         Jim_SetResult(interp, objPtr);
8710         return JIM_ERR;
8711     }
8712     /* Check if there are too nested calls */
8713     if (interp->numLevels == interp->maxNestingDepth) {
8714         Jim_SetResultString(interp,
8715             "Too many nested calls. Infinite recursion?", -1);
8716         return JIM_ERR;
8717     }
8718     /* Create a new callframe */
8719     callFramePtr = JimCreateCallFrame(interp);
8720     callFramePtr->parentCallFrame = interp->framePtr;
8721     callFramePtr->argv = argv;
8722     callFramePtr->argc = argc;
8723     callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8724     callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8725     callFramePtr->staticVars = cmd->staticVars;
8726     Jim_IncrRefCount(cmd->argListObjPtr);
8727     Jim_IncrRefCount(cmd->bodyObjPtr);
8728     interp->framePtr = callFramePtr;
8729     interp->numLevels ++;
8730     /* Set arguments */
8731     for (i = 0; i < cmd->arityMin-1; i++) {
8732         Jim_Obj *objPtr;
8733
8734         Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8735         Jim_SetVariable(interp, objPtr, argv[i+1]);
8736     }
8737     if (cmd->arityMax == -1) {
8738         Jim_Obj *listObjPtr, *objPtr;
8739
8740         listObjPtr = Jim_NewListObj(interp, argv+cmd->arityMin,
8741                 argc-cmd->arityMin);
8742         Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8743         Jim_SetVariable(interp, objPtr, listObjPtr);
8744     }
8745     /* Eval the body */
8746     retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8747
8748     /* Destroy the callframe */
8749     interp->numLevels --;
8750     interp->framePtr = interp->framePtr->parentCallFrame;
8751     if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8752         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8753     } else {
8754         JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8755     }
8756     /* Handle the JIM_EVAL return code */
8757     if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8758         int savedLevel = interp->evalRetcodeLevel;
8759
8760         interp->evalRetcodeLevel = interp->numLevels;
8761         while (retcode == JIM_EVAL) {
8762             Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8763             Jim_IncrRefCount(resultScriptObjPtr);
8764             retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8765             Jim_DecrRefCount(interp, resultScriptObjPtr);
8766         }
8767         interp->evalRetcodeLevel = savedLevel;
8768     }
8769     /* Handle the JIM_RETURN return code */
8770     if (retcode == JIM_RETURN) {
8771         retcode = interp->returnCode;
8772         interp->returnCode = JIM_OK;
8773     }
8774     return retcode;
8775 }
8776
8777 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8778 {
8779     int retval;
8780     Jim_Obj *scriptObjPtr;
8781
8782         scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8783     Jim_IncrRefCount(scriptObjPtr);
8784
8785
8786         if( filename ){
8787                 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8788         }
8789
8790     retval = Jim_EvalObj(interp, scriptObjPtr);
8791     Jim_DecrRefCount(interp, scriptObjPtr);
8792     return retval;
8793 }
8794
8795 int Jim_Eval(Jim_Interp *interp, const char *script)
8796 {
8797         return Jim_Eval_Named( interp, script, NULL, 0 );
8798 }
8799
8800
8801
8802 /* Execute script in the scope of the global level */
8803 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8804 {
8805     Jim_CallFrame *savedFramePtr;
8806     int retval;
8807
8808     savedFramePtr = interp->framePtr;
8809     interp->framePtr = interp->topFramePtr;
8810     retval = Jim_Eval(interp, script);
8811     interp->framePtr = savedFramePtr;
8812     return retval;
8813 }
8814
8815 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8816 {
8817     Jim_CallFrame *savedFramePtr;
8818     int retval;
8819
8820     savedFramePtr = interp->framePtr;
8821     interp->framePtr = interp->topFramePtr;
8822     retval = Jim_EvalObj(interp, scriptObjPtr);
8823     interp->framePtr = savedFramePtr;
8824     /* Try to report the error (if any) via the bgerror proc */
8825     if (retval != JIM_OK) {
8826         Jim_Obj *objv[2];
8827
8828         objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8829         objv[1] = Jim_GetResult(interp);
8830         Jim_IncrRefCount(objv[0]);
8831         Jim_IncrRefCount(objv[1]);
8832         if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8833             /* Report the error to stderr. */
8834             Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8835             Jim_PrintErrorMessage(interp);
8836         }
8837         Jim_DecrRefCount(interp, objv[0]);
8838         Jim_DecrRefCount(interp, objv[1]);
8839     }
8840     return retval;
8841 }
8842
8843 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8844 {
8845     char *prg = NULL;
8846     FILE *fp;
8847     int nread, totread, maxlen, buflen;
8848     int retval;
8849     Jim_Obj *scriptObjPtr;
8850     
8851     if ((fp = fopen(filename, "r")) == NULL) {
8852         const int cwd_len=2048;
8853                 char *cwd=malloc(cwd_len);
8854         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8855         getcwd( cwd, cwd_len );
8856         Jim_AppendStrings(interp, Jim_GetResult(interp),
8857         "Error loading script \"", filename, "\"",
8858             " cwd: ", cwd,
8859             " err: ", strerror(errno), NULL);
8860             free(cwd);
8861         return JIM_ERR;
8862     }
8863     buflen = 1024;
8864     maxlen = totread = 0;
8865     while (1) {
8866         if (maxlen < totread+buflen+1) {
8867             maxlen = totread+buflen+1;
8868             prg = Jim_Realloc(prg, maxlen);
8869         }
8870                 /* do not use Jim_fread() - this is really a file */
8871         if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8872         totread += nread;
8873     }
8874     prg[totread] = '\0';
8875         /* do not use Jim_fclose() - this is really a file */
8876     fclose(fp);
8877
8878     scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8879     JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8880     Jim_IncrRefCount(scriptObjPtr);
8881     retval = Jim_EvalObj(interp, scriptObjPtr);
8882     Jim_DecrRefCount(interp, scriptObjPtr);
8883     return retval;
8884 }
8885
8886 /* -----------------------------------------------------------------------------
8887  * Subst
8888  * ---------------------------------------------------------------------------*/
8889 static int JimParseSubstStr(struct JimParserCtx *pc)
8890 {
8891     pc->tstart = pc->p;
8892     pc->tline = pc->linenr;
8893     while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8894         pc->p++; pc->len--;
8895     }
8896     pc->tend = pc->p-1;
8897     pc->tt = JIM_TT_ESC;
8898     return JIM_OK;
8899 }
8900
8901 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8902 {
8903     int retval;
8904
8905     if (pc->len == 0) {
8906         pc->tstart = pc->tend = pc->p;
8907         pc->tline = pc->linenr;
8908         pc->tt = JIM_TT_EOL;
8909         pc->eof = 1;
8910         return JIM_OK;
8911     }
8912     switch(*pc->p) {
8913     case '[':
8914         retval = JimParseCmd(pc);
8915         if (flags & JIM_SUBST_NOCMD) {
8916             pc->tstart--;
8917             pc->tend++;
8918             pc->tt = (flags & JIM_SUBST_NOESC) ?
8919                 JIM_TT_STR : JIM_TT_ESC;
8920         }
8921         return retval;
8922         break;
8923     case '$':
8924         if (JimParseVar(pc) == JIM_ERR) {
8925             pc->tstart = pc->tend = pc->p++; pc->len--;
8926             pc->tline = pc->linenr;
8927             pc->tt = JIM_TT_STR;
8928         } else {
8929             if (flags & JIM_SUBST_NOVAR) {
8930                 pc->tstart--;
8931                 if (flags & JIM_SUBST_NOESC)
8932                     pc->tt = JIM_TT_STR;
8933                 else
8934                     pc->tt = JIM_TT_ESC;
8935                 if (*pc->tstart == '{') {
8936                     pc->tstart--;
8937                     if (*(pc->tend+1))
8938                         pc->tend++;
8939                 }
8940             }
8941         }
8942         break;
8943     default:
8944         retval = JimParseSubstStr(pc);
8945         if (flags & JIM_SUBST_NOESC)
8946             pc->tt = JIM_TT_STR;
8947         return retval;
8948         break;
8949     }
8950     return JIM_OK;
8951 }
8952
8953 /* The subst object type reuses most of the data structures and functions
8954  * of the script object. Script's data structures are a bit more complex
8955  * for what is needed for [subst]itution tasks, but the reuse helps to
8956  * deal with a single data structure at the cost of some more memory
8957  * usage for substitutions. */
8958 static Jim_ObjType substObjType = {
8959     "subst",
8960     FreeScriptInternalRep,
8961     DupScriptInternalRep,
8962     NULL,
8963     JIM_TYPE_REFERENCES,
8964 };
8965
8966 /* This method takes the string representation of an object
8967  * as a Tcl string where to perform [subst]itution, and generates
8968  * the pre-parsed internal representation. */
8969 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
8970 {
8971     int scriptTextLen;
8972     const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
8973     struct JimParserCtx parser;
8974     struct ScriptObj *script = Jim_Alloc(sizeof(*script));
8975
8976     script->len = 0;
8977     script->csLen = 0;
8978     script->commands = 0;
8979     script->token = NULL;
8980     script->cmdStruct = NULL;
8981     script->inUse = 1;
8982     script->substFlags = flags;
8983     script->fileName = NULL;
8984
8985     JimParserInit(&parser, scriptText, scriptTextLen, 1);
8986     while(1) {
8987         char *token;
8988         int len, type, linenr;
8989
8990         JimParseSubst(&parser, flags);
8991         if (JimParserEof(&parser)) break;
8992         token = JimParserGetToken(&parser, &len, &type, &linenr);
8993         ScriptObjAddToken(interp, script, token, len, type,
8994                 NULL, linenr);
8995     }
8996     /* Free the old internal rep and set the new one. */
8997     Jim_FreeIntRep(interp, objPtr);
8998     Jim_SetIntRepPtr(objPtr, script);
8999     objPtr->typePtr = &scriptObjType;
9000     return JIM_OK;
9001 }
9002
9003 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9004 {
9005     struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9006
9007     if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9008         SetSubstFromAny(interp, objPtr, flags);
9009     return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9010 }
9011
9012 /* Performs commands,variables,blackslashes substitution,
9013  * storing the result object (with refcount 0) into
9014  * resObjPtrPtr. */
9015 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9016         Jim_Obj **resObjPtrPtr, int flags)
9017 {
9018     ScriptObj *script;
9019     ScriptToken *token;
9020     int i, len, retcode = JIM_OK;
9021     Jim_Obj *resObjPtr, *savedResultObjPtr;
9022
9023     script = Jim_GetSubst(interp, substObjPtr, flags);
9024 #ifdef JIM_OPTIMIZATION
9025     /* Fast path for a very common case with array-alike syntax,
9026      * that's: $foo($bar) */
9027     if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9028         Jim_Obj *varObjPtr = script->token[0].objPtr;
9029         
9030         Jim_IncrRefCount(varObjPtr);
9031         resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9032         if (resObjPtr == NULL) {
9033             Jim_DecrRefCount(interp, varObjPtr);
9034             return JIM_ERR;
9035         }
9036         Jim_DecrRefCount(interp, varObjPtr);
9037         *resObjPtrPtr = resObjPtr;
9038         return JIM_OK;
9039     }
9040 #endif
9041
9042     Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9043     /* In order to preserve the internal rep, we increment the
9044      * inUse field of the script internal rep structure. */
9045     script->inUse++;
9046
9047     token = script->token;
9048     len = script->len;
9049
9050     /* Save the interp old result, to set it again before
9051      * to return. */
9052     savedResultObjPtr = interp->result;
9053     Jim_IncrRefCount(savedResultObjPtr);
9054     
9055     /* Perform the substitution. Starts with an empty object
9056      * and adds every token (performing the appropriate
9057      * var/command/escape substitution). */
9058     resObjPtr = Jim_NewStringObj(interp, "", 0);
9059     for (i = 0; i < len; i++) {
9060         Jim_Obj *objPtr;
9061
9062         switch(token[i].type) {
9063         case JIM_TT_STR:
9064         case JIM_TT_ESC:
9065             Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9066             break;
9067         case JIM_TT_VAR:
9068             objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9069             if (objPtr == NULL) goto err;
9070             Jim_IncrRefCount(objPtr);
9071             Jim_AppendObj(interp, resObjPtr, objPtr);
9072             Jim_DecrRefCount(interp, objPtr);
9073             break;
9074         case JIM_TT_DICTSUGAR:
9075             objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9076             if (!objPtr) {
9077                 retcode = JIM_ERR;
9078                 goto err;
9079             }
9080             break;
9081         case JIM_TT_CMD:
9082             if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9083                 goto err;
9084             Jim_AppendObj(interp, resObjPtr, interp->result);
9085             break;
9086         default:
9087             Jim_Panic(interp,
9088               "default token type (%d) reached "
9089               "in Jim_SubstObj().", token[i].type);
9090             break;
9091         }
9092     }
9093 ok:
9094     if (retcode == JIM_OK)
9095         Jim_SetResult(interp, savedResultObjPtr);
9096     Jim_DecrRefCount(interp, savedResultObjPtr);
9097     /* Note that we don't have to decrement inUse, because the
9098      * following code transfers our use of the reference again to
9099      * the script object. */
9100     Jim_FreeIntRep(interp, substObjPtr);
9101     substObjPtr->typePtr = &scriptObjType;
9102     Jim_SetIntRepPtr(substObjPtr, script);
9103     Jim_DecrRefCount(interp, substObjPtr);
9104     *resObjPtrPtr = resObjPtr;
9105     return retcode;
9106 err:
9107     Jim_FreeNewObj(interp, resObjPtr);
9108     retcode = JIM_ERR;
9109     goto ok;
9110 }
9111
9112 /* -----------------------------------------------------------------------------
9113  * API Input/Export functions
9114  * ---------------------------------------------------------------------------*/
9115
9116 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9117 {
9118     Jim_HashEntry *he;
9119
9120     he = Jim_FindHashEntry(&interp->stub, funcname);
9121     if (!he)
9122         return JIM_ERR;
9123     memcpy(targetPtrPtr, &he->val, sizeof(void*));
9124     return JIM_OK;
9125 }
9126
9127 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9128 {
9129     return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9130 }
9131
9132 #define JIM_REGISTER_API(name) \
9133     Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9134
9135 void JimRegisterCoreApi(Jim_Interp *interp)
9136 {
9137   interp->getApiFuncPtr = Jim_GetApi;
9138   JIM_REGISTER_API(Alloc);
9139   JIM_REGISTER_API(Free);
9140   JIM_REGISTER_API(Eval);
9141   JIM_REGISTER_API(Eval_Named);
9142   JIM_REGISTER_API(EvalGlobal);
9143   JIM_REGISTER_API(EvalFile);
9144   JIM_REGISTER_API(EvalObj);
9145   JIM_REGISTER_API(EvalObjBackground);
9146   JIM_REGISTER_API(EvalObjVector);
9147   JIM_REGISTER_API(InitHashTable);
9148   JIM_REGISTER_API(ExpandHashTable);
9149   JIM_REGISTER_API(AddHashEntry);
9150   JIM_REGISTER_API(ReplaceHashEntry);
9151   JIM_REGISTER_API(DeleteHashEntry);
9152   JIM_REGISTER_API(FreeHashTable);
9153   JIM_REGISTER_API(FindHashEntry);
9154   JIM_REGISTER_API(ResizeHashTable);
9155   JIM_REGISTER_API(GetHashTableIterator);
9156   JIM_REGISTER_API(NextHashEntry);
9157   JIM_REGISTER_API(NewObj);
9158   JIM_REGISTER_API(FreeObj);
9159   JIM_REGISTER_API(InvalidateStringRep);
9160   JIM_REGISTER_API(InitStringRep);
9161   JIM_REGISTER_API(DuplicateObj);
9162   JIM_REGISTER_API(GetString);
9163   JIM_REGISTER_API(Length);
9164   JIM_REGISTER_API(InvalidateStringRep);
9165   JIM_REGISTER_API(NewStringObj);
9166   JIM_REGISTER_API(NewStringObjNoAlloc);
9167   JIM_REGISTER_API(AppendString);
9168   JIM_REGISTER_API(AppendString_sprintf);
9169   JIM_REGISTER_API(AppendObj);
9170   JIM_REGISTER_API(AppendStrings);
9171   JIM_REGISTER_API(StringEqObj);
9172   JIM_REGISTER_API(StringMatchObj);
9173   JIM_REGISTER_API(StringRangeObj);
9174   JIM_REGISTER_API(FormatString);
9175   JIM_REGISTER_API(CompareStringImmediate);
9176   JIM_REGISTER_API(NewReference);
9177   JIM_REGISTER_API(GetReference);
9178   JIM_REGISTER_API(SetFinalizer);
9179   JIM_REGISTER_API(GetFinalizer);
9180   JIM_REGISTER_API(CreateInterp);
9181   JIM_REGISTER_API(FreeInterp);
9182   JIM_REGISTER_API(GetExitCode);
9183   JIM_REGISTER_API(SetStdin);
9184   JIM_REGISTER_API(SetStdout);
9185   JIM_REGISTER_API(SetStderr);
9186   JIM_REGISTER_API(CreateCommand);
9187   JIM_REGISTER_API(CreateProcedure);
9188   JIM_REGISTER_API(DeleteCommand);
9189   JIM_REGISTER_API(RenameCommand);
9190   JIM_REGISTER_API(GetCommand);
9191   JIM_REGISTER_API(SetVariable);
9192   JIM_REGISTER_API(SetVariableStr);
9193   JIM_REGISTER_API(SetGlobalVariableStr);
9194   JIM_REGISTER_API(SetVariableStrWithStr);
9195   JIM_REGISTER_API(SetVariableLink);
9196   JIM_REGISTER_API(GetVariable);
9197   JIM_REGISTER_API(GetCallFrameByLevel);
9198   JIM_REGISTER_API(Collect);
9199   JIM_REGISTER_API(CollectIfNeeded);
9200   JIM_REGISTER_API(GetIndex);
9201   JIM_REGISTER_API(NewListObj);
9202   JIM_REGISTER_API(ListAppendElement);
9203   JIM_REGISTER_API(ListAppendList);
9204   JIM_REGISTER_API(ListLength);
9205   JIM_REGISTER_API(ListIndex);
9206   JIM_REGISTER_API(SetListIndex);
9207   JIM_REGISTER_API(ConcatObj);
9208   JIM_REGISTER_API(NewDictObj);
9209   JIM_REGISTER_API(DictKey);
9210   JIM_REGISTER_API(DictKeysVector);
9211   JIM_REGISTER_API(GetIndex);
9212   JIM_REGISTER_API(GetReturnCode);
9213   JIM_REGISTER_API(EvalExpression);
9214   JIM_REGISTER_API(GetBoolFromExpr);
9215   JIM_REGISTER_API(GetWide);
9216   JIM_REGISTER_API(GetLong);
9217   JIM_REGISTER_API(SetWide);
9218   JIM_REGISTER_API(NewIntObj);
9219   JIM_REGISTER_API(GetDouble);
9220   JIM_REGISTER_API(SetDouble);
9221   JIM_REGISTER_API(NewDoubleObj);
9222   JIM_REGISTER_API(WrongNumArgs);
9223   JIM_REGISTER_API(SetDictKeysVector);
9224   JIM_REGISTER_API(SubstObj);
9225   JIM_REGISTER_API(RegisterApi);
9226   JIM_REGISTER_API(PrintErrorMessage);
9227   JIM_REGISTER_API(InteractivePrompt);
9228   JIM_REGISTER_API(RegisterCoreCommands);
9229   JIM_REGISTER_API(GetSharedString);
9230   JIM_REGISTER_API(ReleaseSharedString);
9231   JIM_REGISTER_API(Panic);
9232   JIM_REGISTER_API(StrDup);
9233   JIM_REGISTER_API(UnsetVariable);
9234   JIM_REGISTER_API(GetVariableStr);
9235   JIM_REGISTER_API(GetGlobalVariable);
9236   JIM_REGISTER_API(GetGlobalVariableStr);
9237   JIM_REGISTER_API(GetAssocData);
9238   JIM_REGISTER_API(SetAssocData);
9239   JIM_REGISTER_API(DeleteAssocData);
9240   JIM_REGISTER_API(GetEnum);
9241   JIM_REGISTER_API(ScriptIsComplete);
9242   JIM_REGISTER_API(PackageRequire);
9243   JIM_REGISTER_API(PackageProvide);
9244   JIM_REGISTER_API(InitStack);
9245   JIM_REGISTER_API(FreeStack);
9246   JIM_REGISTER_API(StackLen);
9247   JIM_REGISTER_API(StackPush);
9248   JIM_REGISTER_API(StackPop);
9249   JIM_REGISTER_API(StackPeek);
9250   JIM_REGISTER_API(FreeStackElements);
9251   JIM_REGISTER_API(fprintf  );
9252   JIM_REGISTER_API(vfprintf );
9253   JIM_REGISTER_API(fwrite   );
9254   JIM_REGISTER_API(fread    );
9255   JIM_REGISTER_API(fflush   );
9256   JIM_REGISTER_API(fgets    );
9257   JIM_REGISTER_API(GetNvp);
9258   JIM_REGISTER_API(Nvp_name2value);
9259   JIM_REGISTER_API(Nvp_name2value_simple);
9260   JIM_REGISTER_API(Nvp_name2value_obj);
9261   JIM_REGISTER_API(Nvp_name2value_nocase);
9262   JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9263
9264   JIM_REGISTER_API(Nvp_value2name);
9265   JIM_REGISTER_API(Nvp_value2name_simple);
9266   JIM_REGISTER_API(Nvp_value2name_obj);
9267
9268   JIM_REGISTER_API(GetOpt_Setup);
9269   JIM_REGISTER_API(GetOpt_Debug);
9270   JIM_REGISTER_API(GetOpt_Obj);
9271   JIM_REGISTER_API(GetOpt_String);
9272   JIM_REGISTER_API(GetOpt_Double);
9273   JIM_REGISTER_API(GetOpt_Wide);
9274   JIM_REGISTER_API(GetOpt_Nvp);
9275   JIM_REGISTER_API(GetOpt_NvpUnknown);
9276   JIM_REGISTER_API(GetOpt_Enum);
9277   
9278   JIM_REGISTER_API(Debug_ArgvString);
9279   JIM_REGISTER_API(SetResult_sprintf);
9280   JIM_REGISTER_API(SetResult_NvpUnknown);
9281
9282 }
9283
9284 /* -----------------------------------------------------------------------------
9285  * Core commands utility functions
9286  * ---------------------------------------------------------------------------*/
9287 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, 
9288         const char *msg)
9289 {
9290     int i;
9291     Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9292
9293     Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9294     for (i = 0; i < argc; i++) {
9295         Jim_AppendObj(interp, objPtr, argv[i]);
9296         if (!(i+1 == argc && msg[0] == '\0'))
9297             Jim_AppendString(interp, objPtr, " ", 1);
9298     }
9299     Jim_AppendString(interp, objPtr, msg, -1);
9300     Jim_AppendString(interp, objPtr, "\"", 1);
9301     Jim_SetResult(interp, objPtr);
9302 }
9303
9304 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9305 {
9306     Jim_HashTableIterator *htiter;
9307     Jim_HashEntry *he;
9308     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9309     const char *pattern;
9310     int patternLen;
9311     
9312     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9313     htiter = Jim_GetHashTableIterator(&interp->commands);
9314     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9315         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9316                     strlen((const char*)he->key), 0))
9317             continue;
9318         Jim_ListAppendElement(interp, listObjPtr,
9319                 Jim_NewStringObj(interp, he->key, -1));
9320     }
9321     Jim_FreeHashTableIterator(htiter);
9322     return listObjPtr;
9323 }
9324
9325 #define JIM_VARLIST_GLOBALS 0
9326 #define JIM_VARLIST_LOCALS 1
9327 #define JIM_VARLIST_VARS 2
9328
9329 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9330         int mode)
9331 {
9332     Jim_HashTableIterator *htiter;
9333     Jim_HashEntry *he;
9334     Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9335     const char *pattern;
9336     int patternLen;
9337     
9338     pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9339     if (mode == JIM_VARLIST_GLOBALS) {
9340         htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9341     } else {
9342         /* For [info locals], if we are at top level an emtpy list
9343          * is returned. I don't agree, but we aim at compatibility (SS) */
9344         if (mode == JIM_VARLIST_LOCALS &&
9345             interp->framePtr == interp->topFramePtr)
9346             return listObjPtr;
9347         htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9348     }
9349     while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9350         Jim_Var *varPtr = (Jim_Var*) he->val;
9351         if (mode == JIM_VARLIST_LOCALS) {
9352             if (varPtr->linkFramePtr != NULL)
9353                 continue;
9354         }
9355         if (pattern && !JimStringMatch(pattern, patternLen, he->key, 
9356                     strlen((const char*)he->key), 0))
9357             continue;
9358         Jim_ListAppendElement(interp, listObjPtr,
9359                 Jim_NewStringObj(interp, he->key, -1));
9360     }
9361     Jim_FreeHashTableIterator(htiter);
9362     return listObjPtr;
9363 }
9364
9365 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9366         Jim_Obj **objPtrPtr)
9367 {
9368     Jim_CallFrame *targetCallFrame;
9369
9370     if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9371             != JIM_OK)
9372         return JIM_ERR;
9373     /* No proc call at toplevel callframe */
9374     if (targetCallFrame == interp->topFramePtr) {
9375         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9376         Jim_AppendStrings(interp, Jim_GetResult(interp),
9377                 "bad level \"",
9378                 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9379         return JIM_ERR;
9380     }
9381     *objPtrPtr = Jim_NewListObj(interp,
9382             targetCallFrame->argv,
9383             targetCallFrame->argc);
9384     return JIM_OK;
9385 }
9386
9387 /* -----------------------------------------------------------------------------
9388  * Core commands
9389  * ---------------------------------------------------------------------------*/
9390
9391 /* fake [puts] -- not the real puts, just for debugging. */
9392 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9393         Jim_Obj *const *argv)
9394 {
9395     const char *str;
9396     int len, nonewline = 0;
9397     
9398     if (argc != 2 && argc != 3) {
9399         Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9400         return JIM_ERR;
9401     }
9402     if (argc == 3) {
9403         if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9404         {
9405             Jim_SetResultString(interp, "The second argument must "
9406                     "be -nonewline", -1);
9407             return JIM_OK;
9408         } else {
9409             nonewline = 1;
9410             argv++;
9411         }
9412     }
9413     str = Jim_GetString(argv[1], &len);
9414     Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9415     if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9416     return JIM_OK;
9417 }
9418
9419 /* Helper for [+] and [*] */
9420 static int Jim_AddMulHelper(Jim_Interp *interp, int argc, 
9421         Jim_Obj *const *argv, int op)
9422 {
9423     jim_wide wideValue, res;
9424     double doubleValue, doubleRes;
9425     int i;
9426
9427     res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9428     
9429     for (i = 1; i < argc; i++) {
9430         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9431             goto trydouble;
9432         if (op == JIM_EXPROP_ADD)
9433             res += wideValue;
9434         else
9435             res *= wideValue;
9436     }
9437     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9438     return JIM_OK;
9439 trydouble:
9440     doubleRes = (double) res;
9441     for (;i < argc; i++) {
9442         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9443             return JIM_ERR;
9444         if (op == JIM_EXPROP_ADD)
9445             doubleRes += doubleValue;
9446         else
9447             doubleRes *= doubleValue;
9448     }
9449     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9450     return JIM_OK;
9451 }
9452
9453 /* Helper for [-] and [/] */
9454 static int Jim_SubDivHelper(Jim_Interp *interp, int argc, 
9455         Jim_Obj *const *argv, int op)
9456 {
9457     jim_wide wideValue, res = 0;
9458     double doubleValue, doubleRes = 0;
9459     int i = 2;
9460
9461     if (argc < 2) {
9462         Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9463         return JIM_ERR;
9464     } else if (argc == 2) {
9465         /* The arity = 2 case is different. For [- x] returns -x,
9466          * while [/ x] returns 1/x. */
9467         if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9468             if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9469                     JIM_OK)
9470             {
9471                 return JIM_ERR;
9472             } else {
9473                 if (op == JIM_EXPROP_SUB)
9474                     doubleRes = -doubleValue;
9475                 else
9476                     doubleRes = 1.0/doubleValue;
9477                 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9478                             doubleRes));
9479                 return JIM_OK;
9480             }
9481         }
9482         if (op == JIM_EXPROP_SUB) {
9483             res = -wideValue;
9484             Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9485         } else {
9486             doubleRes = 1.0/wideValue;
9487             Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9488                         doubleRes));
9489         }
9490         return JIM_OK;
9491     } else {
9492         if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9493             if (Jim_GetDouble(interp, argv[1], &doubleRes)
9494                     != JIM_OK) {
9495                 return JIM_ERR;
9496             } else {
9497                 goto trydouble;
9498             }
9499         }
9500     }
9501     for (i = 2; i < argc; i++) {
9502         if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9503             doubleRes = (double) res;
9504             goto trydouble;
9505         }
9506         if (op == JIM_EXPROP_SUB)
9507             res -= wideValue;
9508         else
9509             res /= wideValue;
9510     }
9511     Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9512     return JIM_OK;
9513 trydouble:
9514     for (;i < argc; i++) {
9515         if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9516             return JIM_ERR;
9517         if (op == JIM_EXPROP_SUB)
9518             doubleRes -= doubleValue;
9519         else
9520             doubleRes /= doubleValue;
9521     }
9522     Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9523     return JIM_OK;
9524 }
9525
9526
9527 /* [+] */
9528 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9529         Jim_Obj *const *argv)
9530 {
9531     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9532 }
9533
9534 /* [*] */
9535 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9536         Jim_Obj *const *argv)
9537 {
9538     return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9539 }
9540
9541 /* [-] */
9542 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9543         Jim_Obj *const *argv)
9544 {
9545     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9546 }
9547
9548 /* [/] */
9549 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9550         Jim_Obj *const *argv)
9551 {
9552     return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9553 }
9554
9555 /* [set] */
9556 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9557         Jim_Obj *const *argv)
9558 {
9559     if (argc != 2 && argc != 3) {
9560         Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9561         return JIM_ERR;
9562     }
9563     if (argc == 2) {
9564         Jim_Obj *objPtr;
9565         objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9566         if (!objPtr)
9567             return JIM_ERR;
9568         Jim_SetResult(interp, objPtr);
9569         return JIM_OK;
9570     }
9571     /* argc == 3 case. */
9572     if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9573         return JIM_ERR;
9574     Jim_SetResult(interp, argv[2]);
9575     return JIM_OK;
9576 }
9577
9578 /* [unset] */
9579 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, 
9580         Jim_Obj *const *argv)
9581 {
9582     int i;
9583
9584     if (argc < 2) {
9585         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9586         return JIM_ERR;
9587     }
9588     for (i = 1; i < argc; i++) {
9589         if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9590             return JIM_ERR;
9591     }
9592     return JIM_OK;
9593 }
9594
9595 /* [incr] */
9596 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, 
9597         Jim_Obj *const *argv)
9598 {
9599     jim_wide wideValue, increment = 1;
9600     Jim_Obj *intObjPtr;
9601
9602     if (argc != 2 && argc != 3) {
9603         Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9604         return JIM_ERR;
9605     }
9606     if (argc == 3) {
9607         if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9608             return JIM_ERR;
9609     }
9610     intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9611     if (!intObjPtr) return JIM_ERR;
9612     if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9613         return JIM_ERR;
9614     if (Jim_IsShared(intObjPtr)) {
9615         intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9616         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9617             Jim_FreeNewObj(interp, intObjPtr);
9618             return JIM_ERR;
9619         }
9620     } else {
9621         Jim_SetWide(interp, intObjPtr, wideValue+increment);
9622         /* The following step is required in order to invalidate the
9623          * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9624         if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9625             return JIM_ERR;
9626         }
9627     }
9628     Jim_SetResult(interp, intObjPtr);
9629     return JIM_OK;
9630 }
9631
9632 /* [while] */
9633 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, 
9634         Jim_Obj *const *argv)
9635 {
9636     if (argc != 3) {
9637         Jim_WrongNumArgs(interp, 1, argv, "condition body");
9638         return JIM_ERR;
9639     }
9640     /* Try to run a specialized version of while if the expression
9641      * is in one of the following forms:
9642      *
9643      *   $a < CONST, $a < $b
9644      *   $a <= CONST, $a <= $b
9645      *   $a > CONST, $a > $b
9646      *   $a >= CONST, $a >= $b
9647      *   $a != CONST, $a != $b
9648      *   $a == CONST, $a == $b
9649      *   $a
9650      *   !$a
9651      *   CONST
9652      */
9653
9654 #ifdef JIM_OPTIMIZATION
9655     {
9656         ExprByteCode *expr;
9657         Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9658         int exprLen, retval;
9659
9660         /* STEP 1 -- Check if there are the conditions to run the specialized
9661          * version of while */
9662         
9663         if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9664         if (expr->len <= 0 || expr->len > 3) goto noopt;
9665         switch(expr->len) {
9666         case 1:
9667             if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9668                 expr->opcode[0] != JIM_EXPROP_NUMBER)
9669                 goto noopt;
9670             break;
9671         case 2:
9672             if (expr->opcode[1] != JIM_EXPROP_NOT ||
9673                 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9674                 goto noopt;
9675             break;
9676         case 3:
9677             if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9678                 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9679                  expr->opcode[1] != JIM_EXPROP_VARIABLE))
9680                 goto noopt;
9681             switch(expr->opcode[2]) {
9682             case JIM_EXPROP_LT:
9683             case JIM_EXPROP_LTE:
9684             case JIM_EXPROP_GT:
9685             case JIM_EXPROP_GTE:
9686             case JIM_EXPROP_NUMEQ:
9687             case JIM_EXPROP_NUMNE:
9688                 /* nothing to do */
9689                 break;
9690             default:
9691                 goto noopt;
9692             }
9693             break;
9694         default:
9695             Jim_Panic(interp,
9696                 "Unexpected default reached in Jim_WhileCoreCommand()");
9697             break;
9698         }
9699
9700         /* STEP 2 -- conditions meet. Initialization. Take different
9701          * branches for different expression lengths. */
9702         exprLen = expr->len;
9703
9704         if (exprLen == 1) {
9705             jim_wide wideValue;
9706
9707             if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9708                 varAObjPtr = expr->obj[0];
9709                 Jim_IncrRefCount(varAObjPtr);
9710             } else {
9711                 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9712                     goto noopt;
9713             }
9714             while (1) {
9715                 if (varAObjPtr) {
9716                     if (!(objPtr =
9717                                Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9718                         Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9719                     {
9720                         Jim_DecrRefCount(interp, varAObjPtr);
9721                         goto noopt;
9722                     }
9723                 }
9724                 if (!wideValue) break;
9725                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9726                     switch(retval) {
9727                     case JIM_BREAK:
9728                         if (varAObjPtr)
9729                             Jim_DecrRefCount(interp, varAObjPtr);
9730                         goto out;
9731                         break;
9732                     case JIM_CONTINUE:
9733                         continue;
9734                         break;
9735                     default:
9736                         if (varAObjPtr)
9737                             Jim_DecrRefCount(interp, varAObjPtr);
9738                         return retval;
9739                     }
9740                 }
9741             }
9742             if (varAObjPtr)
9743                 Jim_DecrRefCount(interp, varAObjPtr);
9744         } else if (exprLen == 3) {
9745             jim_wide wideValueA, wideValueB, cmpRes = 0;
9746             int cmpType = expr->opcode[2];
9747
9748             varAObjPtr = expr->obj[0];
9749             Jim_IncrRefCount(varAObjPtr);
9750             if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9751                 varBObjPtr = expr->obj[1];
9752                 Jim_IncrRefCount(varBObjPtr);
9753             } else {
9754                 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9755                     goto noopt;
9756             }
9757             while (1) {
9758                 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9759                     Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9760                 {
9761                     Jim_DecrRefCount(interp, varAObjPtr);
9762                     if (varBObjPtr)
9763                         Jim_DecrRefCount(interp, varBObjPtr);
9764                     goto noopt;
9765                 }
9766                 if (varBObjPtr) {
9767                     if (!(objPtr =
9768                                Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9769                         Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9770                     {
9771                         Jim_DecrRefCount(interp, varAObjPtr);
9772                         if (varBObjPtr)
9773                             Jim_DecrRefCount(interp, varBObjPtr);
9774                         goto noopt;
9775                     }
9776                 }
9777                 switch(cmpType) {
9778                 case JIM_EXPROP_LT:
9779                     cmpRes = wideValueA < wideValueB; break;
9780                 case JIM_EXPROP_LTE:
9781                     cmpRes = wideValueA <= wideValueB; break;
9782                 case JIM_EXPROP_GT:
9783                     cmpRes = wideValueA > wideValueB; break;
9784                 case JIM_EXPROP_GTE:
9785                     cmpRes = wideValueA >= wideValueB; break;
9786                 case JIM_EXPROP_NUMEQ:
9787                     cmpRes = wideValueA == wideValueB; break;
9788                 case JIM_EXPROP_NUMNE:
9789                     cmpRes = wideValueA != wideValueB; break;
9790                 }
9791                 if (!cmpRes) break;
9792                 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9793                     switch(retval) {
9794                     case JIM_BREAK:
9795                         Jim_DecrRefCount(interp, varAObjPtr);
9796                         if (varBObjPtr)
9797                             Jim_DecrRefCount(interp, varBObjPtr);
9798                         goto out;
9799                         break;
9800                     case JIM_CONTINUE:
9801                         continue;
9802                         break;
9803                     default:
9804                         Jim_DecrRefCount(interp, varAObjPtr);
9805                         if (varBObjPtr)
9806                             Jim_DecrRefCount(interp, varBObjPtr);
9807                         return retval;
9808                     }
9809                 }
9810             }
9811             Jim_DecrRefCount(interp, varAObjPtr);
9812             if (varBObjPtr)
9813                 Jim_DecrRefCount(interp, varBObjPtr);
9814         } else {
9815             /* TODO: case for len == 2 */
9816             goto noopt;
9817         }
9818         Jim_SetEmptyResult(interp);
9819         return JIM_OK;
9820     }
9821 noopt:
9822 #endif
9823
9824     /* The general purpose implementation of while starts here */
9825     while (1) {
9826         int boolean, retval;
9827
9828         if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9829                         &boolean)) != JIM_OK)
9830             return retval;
9831         if (!boolean) break;
9832         if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9833             switch(retval) {
9834             case JIM_BREAK:
9835                 goto out;
9836                 break;
9837             case JIM_CONTINUE:
9838                 continue;
9839                 break;
9840             default:
9841                 return retval;
9842             }
9843         }
9844     }
9845 out:
9846     Jim_SetEmptyResult(interp);
9847     return JIM_OK;
9848 }
9849
9850 /* [for] */
9851 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, 
9852         Jim_Obj *const *argv)
9853 {
9854     int retval;
9855
9856     if (argc != 5) {
9857         Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9858         return JIM_ERR;
9859     }
9860     /* Check if the for is on the form:
9861      *      for {set i CONST} {$i < CONST} {incr i}
9862      *      for {set i CONST} {$i < $j} {incr i}
9863      *      for {set i CONST} {$i <= CONST} {incr i}
9864      *      for {set i CONST} {$i <= $j} {incr i}
9865      * XXX: NOTE: if variable traces are implemented, this optimization
9866      * need to be modified to check for the proc epoch at every variable
9867      * update. */
9868 #ifdef JIM_OPTIMIZATION
9869     {
9870         ScriptObj *initScript, *incrScript;
9871         ExprByteCode *expr;
9872         jim_wide start, stop, currentVal;
9873         unsigned jim_wide procEpoch = interp->procEpoch;
9874         Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9875         int cmpType;
9876         struct Jim_Cmd *cmdPtr;
9877
9878         /* Do it only if there aren't shared arguments */
9879         if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9880             goto evalstart;
9881         initScript = Jim_GetScript(interp, argv[1]);
9882         expr = Jim_GetExpression(interp, argv[2]);
9883         incrScript = Jim_GetScript(interp, argv[3]);
9884
9885         /* Ensure proper lengths to start */
9886         if (initScript->len != 6) goto evalstart;
9887         if (incrScript->len != 4) goto evalstart;
9888         if (expr->len != 3) goto evalstart;
9889         /* Ensure proper token types. */
9890         if (initScript->token[2].type != JIM_TT_ESC ||
9891             initScript->token[4].type != JIM_TT_ESC ||
9892             incrScript->token[2].type != JIM_TT_ESC ||
9893             expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9894             (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9895              expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9896             (expr->opcode[2] != JIM_EXPROP_LT &&
9897              expr->opcode[2] != JIM_EXPROP_LTE))
9898             goto evalstart;
9899         cmpType = expr->opcode[2];
9900         /* Initialization command must be [set] */
9901         cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9902         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
9903             goto evalstart;
9904         /* Update command must be incr */
9905         cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
9906         if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
9907             goto evalstart;
9908         /* set, incr, expression must be about the same variable */
9909         if (!Jim_StringEqObj(initScript->token[2].objPtr,
9910                             incrScript->token[2].objPtr, 0))
9911             goto evalstart;
9912         if (!Jim_StringEqObj(initScript->token[2].objPtr,
9913                             expr->obj[0], 0))
9914             goto evalstart;
9915         /* Check that the initialization and comparison are valid integers */
9916         if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
9917             goto evalstart;
9918         if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
9919             Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
9920         {
9921             goto evalstart;
9922         }
9923
9924         /* Initialization */
9925         varNamePtr = expr->obj[0];
9926         if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9927             stopVarNamePtr = expr->obj[1];
9928             Jim_IncrRefCount(stopVarNamePtr);
9929         }
9930         Jim_IncrRefCount(varNamePtr);
9931
9932         /* --- OPTIMIZED FOR --- */
9933         /* Start to loop */
9934         objPtr = Jim_NewIntObj(interp, start);
9935         if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
9936             Jim_DecrRefCount(interp, varNamePtr);
9937             if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9938             Jim_FreeNewObj(interp, objPtr);
9939             goto evalstart;
9940         }
9941         while (1) {
9942             /* === Check condition === */
9943             /* Common code: */
9944             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
9945             if (objPtr == NULL ||
9946                 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
9947             {
9948                 Jim_DecrRefCount(interp, varNamePtr);
9949                 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9950                 goto testcond;
9951             }
9952             /* Immediate or Variable? get the 'stop' value if the latter. */
9953             if (stopVarNamePtr) {
9954                 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
9955                 if (objPtr == NULL ||
9956                     Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
9957                 {
9958                     Jim_DecrRefCount(interp, varNamePtr);
9959                     Jim_DecrRefCount(interp, stopVarNamePtr);
9960                     goto testcond;
9961                 }
9962             }
9963             if (cmpType == JIM_EXPROP_LT) {
9964                 if (currentVal >= stop) break;
9965             } else {
9966                 if (currentVal > stop) break;
9967             }
9968             /* Eval body */
9969             if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9970                 switch(retval) {
9971                 case JIM_BREAK:
9972                     if (stopVarNamePtr)
9973                         Jim_DecrRefCount(interp, stopVarNamePtr);
9974                     Jim_DecrRefCount(interp, varNamePtr);
9975                     goto out;
9976                 case JIM_CONTINUE:
9977                     /* nothing to do */
9978                     break;
9979                 default:
9980                     if (stopVarNamePtr)
9981                         Jim_DecrRefCount(interp, stopVarNamePtr);
9982                     Jim_DecrRefCount(interp, varNamePtr);
9983                     return retval;
9984                 }
9985             }
9986             /* If there was a change in procedures/command continue
9987              * with the usual [for] command implementation */
9988             if (procEpoch != interp->procEpoch) {
9989                 if (stopVarNamePtr)
9990                     Jim_DecrRefCount(interp, stopVarNamePtr);
9991                 Jim_DecrRefCount(interp, varNamePtr);
9992                 goto evalnext;
9993             }
9994             /* Increment */
9995             objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
9996             if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
9997                 objPtr->internalRep.wideValue ++;
9998                 Jim_InvalidateStringRep(objPtr);
9999             } else {
10000                 Jim_Obj *auxObjPtr;
10001
10002                 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10003                     if (stopVarNamePtr)
10004                         Jim_DecrRefCount(interp, stopVarNamePtr);
10005                     Jim_DecrRefCount(interp, varNamePtr);
10006                     goto evalnext;
10007                 }
10008                 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10009                 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10010                     if (stopVarNamePtr)
10011                         Jim_DecrRefCount(interp, stopVarNamePtr);
10012                     Jim_DecrRefCount(interp, varNamePtr);
10013                     Jim_FreeNewObj(interp, auxObjPtr);
10014                     goto evalnext;
10015                 }
10016             }
10017         }
10018         if (stopVarNamePtr)
10019             Jim_DecrRefCount(interp, stopVarNamePtr);
10020         Jim_DecrRefCount(interp, varNamePtr);
10021         Jim_SetEmptyResult(interp);
10022         return JIM_OK;
10023     }
10024 #endif
10025 evalstart:
10026     /* Eval start */
10027     if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10028         return retval;
10029     while (1) {
10030         int boolean;
10031 testcond:
10032         /* Test the condition */
10033         if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10034                 != JIM_OK)
10035             return retval;
10036         if (!boolean) break;
10037         /* Eval body */
10038         if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10039             switch(retval) {
10040             case JIM_BREAK:
10041                 goto out;
10042                 break;
10043             case JIM_CONTINUE:
10044                 /* Nothing to do */
10045                 break;
10046             default:
10047                 return retval;
10048             }
10049         }
10050 evalnext:
10051         /* Eval next */
10052         if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10053             switch(retval) {
10054             case JIM_BREAK:
10055                 goto out;
10056                 break;
10057             case JIM_CONTINUE:
10058                 continue;
10059                 break;
10060             default:
10061                 return retval;
10062             }
10063         }
10064     }
10065 out:
10066     Jim_SetEmptyResult(interp);
10067     return JIM_OK;
10068 }
10069
10070 /* foreach + lmap implementation. */
10071 static int JimForeachMapHelper(Jim_Interp *interp, int argc, 
10072         Jim_Obj *const *argv, int doMap)
10073 {
10074     int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10075     int nbrOfLoops = 0;
10076     Jim_Obj *emptyStr, *script, *mapRes = NULL;
10077
10078     if (argc < 4 || argc % 2 != 0) {
10079         Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10080         return JIM_ERR;
10081     }
10082     if (doMap) {
10083         mapRes = Jim_NewListObj(interp, NULL, 0);
10084         Jim_IncrRefCount(mapRes);
10085     }
10086     emptyStr = Jim_NewEmptyStringObj(interp);
10087     Jim_IncrRefCount(emptyStr);
10088     script = argv[argc-1];            /* Last argument is a script */
10089     nbrOfLists = (argc - 1 - 1) / 2;  /* argc - 'foreach' - script */
10090     listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10091     listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10092     /* Initialize iterators and remember max nbr elements each list */
10093     memset(listsIdx, 0, nbrOfLists * sizeof(int));
10094     /* Remember lengths of all lists and calculate how much rounds to loop */
10095     for (i=0; i < nbrOfLists*2; i += 2) {
10096         div_t cnt;
10097         int count;
10098         Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10099         Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10100         if (listsEnd[i] == 0) {
10101             Jim_SetResultString(interp, "foreach varlist is empty", -1);
10102             goto err;
10103         }
10104         cnt = div(listsEnd[i+1], listsEnd[i]);
10105         count = cnt.quot + (cnt.rem ? 1 : 0);
10106         if (count > nbrOfLoops)
10107             nbrOfLoops = count;
10108     }
10109     for (; nbrOfLoops-- > 0; ) {
10110         for (i=0; i < nbrOfLists; ++i) {
10111             int varIdx = 0, var = i * 2;
10112             while (varIdx < listsEnd[var]) {
10113                 Jim_Obj *varName, *ele;
10114                 int lst = i * 2 + 1;
10115                 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10116                         != JIM_OK)
10117                         goto err;
10118                 if (listsIdx[i] < listsEnd[lst]) {
10119                     if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10120                         != JIM_OK)
10121                         goto err;
10122                     if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10123                         Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10124                         goto err;
10125                     }
10126                     ++listsIdx[i];  /* Remember next iterator of current list */ 
10127                 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10128                     Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10129                     goto err;
10130                 }
10131                 ++varIdx;  /* Next variable */
10132             }
10133         }
10134         switch (result = Jim_EvalObj(interp, script)) {
10135             case JIM_OK:
10136                 if (doMap)
10137                     Jim_ListAppendElement(interp, mapRes, interp->result);
10138                 break;
10139             case JIM_CONTINUE:
10140                 break;
10141             case JIM_BREAK:
10142                 goto out;
10143                 break;
10144             default:
10145                 goto err;
10146         }
10147     }
10148 out:
10149     result = JIM_OK;
10150     if (doMap)
10151         Jim_SetResult(interp, mapRes);
10152     else
10153         Jim_SetEmptyResult(interp);
10154 err:
10155     if (doMap)
10156         Jim_DecrRefCount(interp, mapRes);
10157     Jim_DecrRefCount(interp, emptyStr);
10158     Jim_Free(listsIdx);
10159     Jim_Free(listsEnd);
10160     return result;
10161 }
10162
10163 /* [foreach] */
10164 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, 
10165         Jim_Obj *const *argv)
10166 {
10167     return JimForeachMapHelper(interp, argc, argv, 0);
10168 }
10169
10170 /* [lmap] */
10171 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, 
10172         Jim_Obj *const *argv)
10173 {
10174     return JimForeachMapHelper(interp, argc, argv, 1);
10175 }
10176
10177 /* [if] */
10178 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, 
10179         Jim_Obj *const *argv)
10180 {
10181     int boolean, retval, current = 1, falsebody = 0;
10182     if (argc >= 3) {
10183         while (1) {
10184             /* Far not enough arguments given! */
10185             if (current >= argc) goto err;
10186             if ((retval = Jim_GetBoolFromExpr(interp,
10187                         argv[current++], &boolean))
10188                     != JIM_OK)
10189                 return retval;
10190             /* There lacks something, isn't it? */
10191             if (current >= argc) goto err;
10192             if (Jim_CompareStringImmediate(interp, argv[current],
10193                         "then")) current++;
10194             /* Tsk tsk, no then-clause? */
10195             if (current >= argc) goto err;
10196             if (boolean)
10197                 return Jim_EvalObj(interp, argv[current]);
10198              /* Ok: no else-clause follows */
10199             if (++current >= argc) {
10200                 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));                   
10201                 return JIM_OK;
10202             }
10203             falsebody = current++;
10204             if (Jim_CompareStringImmediate(interp, argv[falsebody],
10205                         "else")) {
10206                 /* IIICKS - else-clause isn't last cmd? */
10207                 if (current != argc-1) goto err;
10208                 return Jim_EvalObj(interp, argv[current]);
10209             } else if (Jim_CompareStringImmediate(interp,
10210                         argv[falsebody], "elseif"))
10211                 /* Ok: elseif follows meaning all the stuff
10212                  * again (how boring...) */
10213                 continue;
10214             /* OOPS - else-clause is not last cmd?*/
10215             else if (falsebody != argc-1)
10216                 goto err;
10217             return Jim_EvalObj(interp, argv[falsebody]);
10218         }
10219         return JIM_OK;
10220     }
10221 err:
10222     Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10223     return JIM_ERR;
10224 }
10225
10226 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10227
10228 /* [switch] */
10229 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, 
10230         Jim_Obj *const *argv)
10231 {
10232     int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10233     Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10234     Jim_Obj *script = 0;
10235     if (argc < 3) goto wrongnumargs;
10236     for (opt=1; opt < argc; ++opt) {
10237         const char *option = Jim_GetString(argv[opt], 0);
10238         if (*option != '-') break;
10239         else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10240         else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10241         else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10242         else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10243         else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10244             if ((argc - opt) < 2) goto wrongnumargs;
10245             command = argv[++opt]; 
10246         } else {
10247             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10248             Jim_AppendStrings(interp, Jim_GetResult(interp),
10249                 "bad option \"", option, "\": must be -exact, -glob, "
10250                 "-regexp, -command procname or --", 0);
10251             goto err;            
10252         }
10253         if ((argc - opt) < 2) goto wrongnumargs;
10254     }
10255     strObj = argv[opt++];
10256     patCount = argc - opt;
10257     if (patCount == 1) {
10258         Jim_Obj **vector;
10259         JimListGetElements(interp, argv[opt], &patCount, &vector);
10260         caseList = vector;
10261     } else
10262         caseList = &argv[opt];
10263     if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10264     for (i=0; script == 0 && i < patCount; i += 2) {
10265         Jim_Obj *patObj = caseList[i];
10266         if (!Jim_CompareStringImmediate(interp, patObj, "default")
10267             || i < (patCount-2)) {
10268             switch (matchOpt) {
10269                 case SWITCH_EXACT:
10270                     if (Jim_StringEqObj(strObj, patObj, 0))
10271                         script = caseList[i+1];
10272                     break;
10273                 case SWITCH_GLOB:
10274                     if (Jim_StringMatchObj(patObj, strObj, 0))
10275                         script = caseList[i+1];
10276                     break;
10277                 case SWITCH_RE:
10278                     command = Jim_NewStringObj(interp, "regexp", -1);
10279                     /* Fall thru intentionally */
10280                 case SWITCH_CMD: {
10281                     Jim_Obj *parms[] = {command, patObj, strObj};
10282                     int rc = Jim_EvalObjVector(interp, 3, parms);
10283                     long matching;
10284                     /* After the execution of a command we need to
10285                      * make sure to reconvert the object into a list
10286                      * again. Only for the single-list style [switch]. */
10287                     if (argc-opt == 1) {
10288                         Jim_Obj **vector;
10289                         JimListGetElements(interp, argv[opt], &patCount,
10290                                 &vector);
10291                         caseList = vector;
10292                     }
10293                     /* command is here already decref'd */
10294                     if (rc != JIM_OK) {
10295                         retcode = rc;
10296                         goto err;
10297                     }
10298                     rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10299                     if (rc != JIM_OK) {
10300                         retcode = rc;
10301                         goto err;
10302                     }
10303                     if (matching)
10304                         script = caseList[i+1];
10305                     break;
10306                 }
10307                 default:
10308                     Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10309                     Jim_AppendStrings(interp, Jim_GetResult(interp),
10310                         "internal error: no such option implemented", 0);
10311                     goto err;
10312             }
10313         } else {
10314           script = caseList[i+1];
10315         }
10316     }
10317     for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10318         i += 2)
10319         script = caseList[i+1];
10320     if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10321         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10322         Jim_AppendStrings(interp, Jim_GetResult(interp),
10323             "no body specified for pattern \"",
10324             Jim_GetString(caseList[i-2], 0), "\"", 0);
10325         goto err;
10326     }
10327     retcode = JIM_OK;
10328     Jim_SetEmptyResult(interp);
10329     if (script != 0)
10330         retcode = Jim_EvalObj(interp, script);
10331     return retcode;
10332 wrongnumargs:
10333     Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10334         "pattern body ... ?default body?   or   "
10335         "{pattern body ?pattern body ...?}");
10336 err:
10337     return retcode;        
10338 }
10339
10340 /* [list] */
10341 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, 
10342         Jim_Obj *const *argv)
10343 {
10344     Jim_Obj *listObjPtr;
10345
10346     listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10347     Jim_SetResult(interp, listObjPtr);
10348     return JIM_OK;
10349 }
10350
10351 /* [lindex] */
10352 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, 
10353         Jim_Obj *const *argv)
10354 {
10355     Jim_Obj *objPtr, *listObjPtr;
10356     int i;
10357     int index;
10358
10359     if (argc < 3) {
10360         Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10361         return JIM_ERR;
10362     }
10363     objPtr = argv[1];
10364     Jim_IncrRefCount(objPtr);
10365     for (i = 2; i < argc; i++) {
10366         listObjPtr = objPtr;
10367         if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10368             Jim_DecrRefCount(interp, listObjPtr);
10369             return JIM_ERR;
10370         }
10371         if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10372                     JIM_NONE) != JIM_OK) {
10373             /* Returns an empty object if the index
10374              * is out of range. */
10375             Jim_DecrRefCount(interp, listObjPtr);
10376             Jim_SetEmptyResult(interp);
10377             return JIM_OK;
10378         }
10379         Jim_IncrRefCount(objPtr);
10380         Jim_DecrRefCount(interp, listObjPtr);
10381     }
10382     Jim_SetResult(interp, objPtr);
10383     Jim_DecrRefCount(interp, objPtr);
10384     return JIM_OK;
10385 }
10386
10387 /* [llength] */
10388 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, 
10389         Jim_Obj *const *argv)
10390 {
10391     int len;
10392
10393     if (argc != 2) {
10394         Jim_WrongNumArgs(interp, 1, argv, "list");
10395         return JIM_ERR;
10396     }
10397     Jim_ListLength(interp, argv[1], &len);
10398     Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10399     return JIM_OK;
10400 }
10401
10402 /* [lappend] */
10403 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, 
10404         Jim_Obj *const *argv)
10405 {
10406     Jim_Obj *listObjPtr;
10407     int shared, i;
10408
10409     if (argc < 2) {
10410         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10411         return JIM_ERR;
10412     }
10413     listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10414     if (!listObjPtr) {
10415         /* Create the list if it does not exists */
10416         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10417         if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10418             Jim_FreeNewObj(interp, listObjPtr);
10419             return JIM_ERR;
10420         }
10421     }
10422     shared = Jim_IsShared(listObjPtr);
10423     if (shared)
10424         listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10425     for (i = 2; i < argc; i++)
10426         Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10427     if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10428         if (shared)
10429             Jim_FreeNewObj(interp, listObjPtr);
10430         return JIM_ERR;
10431     }
10432     Jim_SetResult(interp, listObjPtr);
10433     return JIM_OK;
10434 }
10435
10436 /* [linsert] */
10437 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, 
10438         Jim_Obj *const *argv)
10439 {
10440     int index, len;
10441     Jim_Obj *listPtr;
10442
10443     if (argc < 4) {
10444         Jim_WrongNumArgs(interp, 1, argv, "list index element "
10445             "?element ...?");
10446         return JIM_ERR;
10447     }
10448     listPtr = argv[1];
10449     if (Jim_IsShared(listPtr))
10450         listPtr = Jim_DuplicateObj(interp, listPtr);
10451     if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10452         goto err;
10453     Jim_ListLength(interp, listPtr, &len);
10454     if (index >= len)
10455         index = len;
10456     else if (index < 0)
10457         index = len + index + 1;
10458     Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10459     Jim_SetResult(interp, listPtr);
10460     return JIM_OK;
10461 err:
10462     if (listPtr != argv[1]) {
10463         Jim_FreeNewObj(interp, listPtr);
10464     }
10465     return JIM_ERR;
10466 }
10467
10468 /* [lset] */
10469 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, 
10470         Jim_Obj *const *argv)
10471 {
10472     if (argc < 3) {
10473         Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10474         return JIM_ERR;
10475     } else if (argc == 3) {
10476         if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10477             return JIM_ERR;
10478         Jim_SetResult(interp, argv[2]);
10479         return JIM_OK;
10480     }
10481     if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10482             == JIM_ERR) return JIM_ERR;
10483     return JIM_OK;
10484 }
10485
10486 /* [lsort] */
10487 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10488 {
10489     const char *options[] = {
10490         "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10491     };
10492     enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10493     Jim_Obj *resObj;
10494     int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10495     int decreasing = 0;
10496
10497     if (argc < 2) {
10498         Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10499         return JIM_ERR;
10500     }
10501     for (i = 1; i < (argc-1); i++) {
10502         int option;
10503
10504         if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10505                 != JIM_OK)
10506             return JIM_ERR;
10507         switch(option) {
10508         case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10509         case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10510         case OPT_INCREASING: decreasing = 0; break;
10511         case OPT_DECREASING: decreasing = 1; break;
10512         }
10513     }
10514     if (decreasing) {
10515         switch(lsortType) {
10516         case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10517         case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10518         }
10519     }
10520     resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10521     ListSortElements(interp, resObj, lsortType);
10522     Jim_SetResult(interp, resObj);
10523     return JIM_OK;
10524 }
10525
10526 /* [append] */
10527 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, 
10528         Jim_Obj *const *argv)
10529 {
10530     Jim_Obj *stringObjPtr;
10531     int shared, i;
10532
10533     if (argc < 2) {
10534         Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10535         return JIM_ERR;
10536     }
10537     if (argc == 2) {
10538         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10539         if (!stringObjPtr) return JIM_ERR;
10540     } else {
10541         stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10542         if (!stringObjPtr) {
10543             /* Create the string if it does not exists */
10544             stringObjPtr = Jim_NewEmptyStringObj(interp);
10545             if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10546                     != JIM_OK) {
10547                 Jim_FreeNewObj(interp, stringObjPtr);
10548                 return JIM_ERR;
10549             }
10550         }
10551     }
10552     shared = Jim_IsShared(stringObjPtr);
10553     if (shared)
10554         stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10555     for (i = 2; i < argc; i++)
10556         Jim_AppendObj(interp, stringObjPtr, argv[i]);
10557     if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10558         if (shared)
10559             Jim_FreeNewObj(interp, stringObjPtr);
10560         return JIM_ERR;
10561     }
10562     Jim_SetResult(interp, stringObjPtr);
10563     return JIM_OK;
10564 }
10565
10566 /* [debug] */
10567 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, 
10568         Jim_Obj *const *argv)
10569 {
10570     const char *options[] = {
10571         "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10572         "exprbc",
10573         NULL
10574     };
10575     enum {
10576         OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10577         OPT_EXPRLEN, OPT_EXPRBC
10578     };
10579     int option;
10580
10581     if (argc < 2) {
10582         Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10583         return JIM_ERR;
10584     }
10585     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10586                 JIM_ERRMSG) != JIM_OK)
10587         return JIM_ERR;
10588     if (option == OPT_REFCOUNT) {
10589         if (argc != 3) {
10590             Jim_WrongNumArgs(interp, 2, argv, "object");
10591             return JIM_ERR;
10592         }
10593         Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10594         return JIM_OK;
10595     } else if (option == OPT_OBJCOUNT) {
10596         int freeobj = 0, liveobj = 0;
10597         char buf[256];
10598         Jim_Obj *objPtr;
10599
10600         if (argc != 2) {
10601             Jim_WrongNumArgs(interp, 2, argv, "");
10602             return JIM_ERR;
10603         }
10604         /* Count the number of free objects. */
10605         objPtr = interp->freeList;
10606         while (objPtr) {
10607             freeobj++;
10608             objPtr = objPtr->nextObjPtr;
10609         }
10610         /* Count the number of live objects. */
10611         objPtr = interp->liveList;
10612         while (objPtr) {
10613             liveobj++;
10614             objPtr = objPtr->nextObjPtr;
10615         }
10616         /* Set the result string and return. */
10617         sprintf(buf, "free %d used %d", freeobj, liveobj);
10618         Jim_SetResultString(interp, buf, -1);
10619         return JIM_OK;
10620     } else if (option == OPT_OBJECTS) {
10621         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10622         /* Count the number of live objects. */
10623         objPtr = interp->liveList;
10624         listObjPtr = Jim_NewListObj(interp, NULL, 0);
10625         while (objPtr) {
10626             char buf[128];
10627             const char *type = objPtr->typePtr ?
10628                 objPtr->typePtr->name : "";
10629             subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10630             sprintf(buf, "%p", objPtr);
10631             Jim_ListAppendElement(interp, subListObjPtr,
10632                 Jim_NewStringObj(interp, buf, -1));
10633             Jim_ListAppendElement(interp, subListObjPtr,
10634                 Jim_NewStringObj(interp, type, -1));
10635             Jim_ListAppendElement(interp, subListObjPtr,
10636                 Jim_NewIntObj(interp, objPtr->refCount));
10637             Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10638             Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10639             objPtr = objPtr->nextObjPtr;
10640         }
10641         Jim_SetResult(interp, listObjPtr);
10642         return JIM_OK;
10643     } else if (option == OPT_INVSTR) {
10644         Jim_Obj *objPtr;
10645
10646         if (argc != 3) {
10647             Jim_WrongNumArgs(interp, 2, argv, "object");
10648             return JIM_ERR;
10649         }
10650         objPtr = argv[2];
10651         if (objPtr->typePtr != NULL)
10652             Jim_InvalidateStringRep(objPtr);
10653         Jim_SetEmptyResult(interp);
10654         return JIM_OK;
10655     } else if (option == OPT_SCRIPTLEN) {
10656         ScriptObj *script;
10657         if (argc != 3) {
10658             Jim_WrongNumArgs(interp, 2, argv, "script");
10659             return JIM_ERR;
10660         }
10661         script = Jim_GetScript(interp, argv[2]);
10662         Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10663         return JIM_OK;
10664     } else if (option == OPT_EXPRLEN) {
10665         ExprByteCode *expr;
10666         if (argc != 3) {
10667             Jim_WrongNumArgs(interp, 2, argv, "expression");
10668             return JIM_ERR;
10669         }
10670         expr = Jim_GetExpression(interp, argv[2]);
10671         if (expr == NULL)
10672             return JIM_ERR;
10673         Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10674         return JIM_OK;
10675     } else if (option == OPT_EXPRBC) {
10676         Jim_Obj *objPtr;
10677         ExprByteCode *expr;
10678         int i;
10679
10680         if (argc != 3) {
10681             Jim_WrongNumArgs(interp, 2, argv, "expression");
10682             return JIM_ERR;
10683         }
10684         expr = Jim_GetExpression(interp, argv[2]);
10685         if (expr == NULL)
10686             return JIM_ERR;
10687         objPtr = Jim_NewListObj(interp, NULL, 0);
10688         for (i = 0; i < expr->len; i++) {
10689             const char *type;
10690             Jim_ExprOperator *op;
10691
10692             switch(expr->opcode[i]) {
10693             case JIM_EXPROP_NUMBER: type = "number"; break;
10694             case JIM_EXPROP_COMMAND: type = "command"; break;
10695             case JIM_EXPROP_VARIABLE: type = "variable"; break;
10696             case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10697             case JIM_EXPROP_SUBST: type = "subst"; break;
10698             case JIM_EXPROP_STRING: type = "string"; break;
10699             default:
10700                 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10701                 if (op == NULL) {
10702                     type = "private";
10703                 } else {
10704                     type = "operator";
10705                 }
10706                 break;
10707             }
10708             Jim_ListAppendElement(interp, objPtr,
10709                     Jim_NewStringObj(interp, type, -1));
10710             Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10711         }
10712         Jim_SetResult(interp, objPtr);
10713         return JIM_OK;
10714     } else {
10715         Jim_SetResultString(interp,
10716             "bad option. Valid options are refcount, "
10717             "objcount, objects, invstr", -1);
10718         return JIM_ERR;
10719     }
10720     return JIM_OK; /* unreached */
10721 }
10722
10723 /* [eval] */
10724 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, 
10725         Jim_Obj *const *argv)
10726 {
10727     if (argc == 2) {
10728         return Jim_EvalObj(interp, argv[1]);
10729     } else if (argc > 2) {
10730         Jim_Obj *objPtr;
10731         int retcode;
10732
10733         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10734         Jim_IncrRefCount(objPtr);
10735         retcode = Jim_EvalObj(interp, objPtr);
10736         Jim_DecrRefCount(interp, objPtr);
10737         return retcode;
10738     } else {
10739         Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10740         return JIM_ERR;
10741     }
10742 }
10743
10744 /* [uplevel] */
10745 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, 
10746         Jim_Obj *const *argv)
10747 {
10748     if (argc >= 2) {
10749         int retcode, newLevel, oldLevel;
10750         Jim_CallFrame *savedCallFrame, *targetCallFrame;
10751         Jim_Obj *objPtr;
10752         const char *str;
10753
10754         /* Save the old callframe pointer */
10755         savedCallFrame = interp->framePtr;
10756
10757         /* Lookup the target frame pointer */
10758         str = Jim_GetString(argv[1], NULL);
10759         if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10760         {
10761             if (Jim_GetCallFrameByLevel(interp, argv[1],
10762                         &targetCallFrame,
10763                         &newLevel) != JIM_OK)
10764                 return JIM_ERR;
10765             argc--;
10766             argv++;
10767         } else {
10768             if (Jim_GetCallFrameByLevel(interp, NULL,
10769                         &targetCallFrame,
10770                         &newLevel) != JIM_OK)
10771                 return JIM_ERR;
10772         }
10773         if (argc < 2) {
10774             argc++;
10775             argv--;
10776             Jim_WrongNumArgs(interp, 1, argv,
10777                     "?level? command ?arg ...?");
10778             return JIM_ERR;
10779         }
10780         /* Eval the code in the target callframe. */
10781         interp->framePtr = targetCallFrame;
10782         oldLevel = interp->numLevels;
10783         interp->numLevels = newLevel;
10784         if (argc == 2) {
10785             retcode = Jim_EvalObj(interp, argv[1]);
10786         } else {
10787             objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10788             Jim_IncrRefCount(objPtr);
10789             retcode = Jim_EvalObj(interp, objPtr);
10790             Jim_DecrRefCount(interp, objPtr);
10791         }
10792         interp->numLevels = oldLevel;
10793         interp->framePtr = savedCallFrame;
10794         return retcode;
10795     } else {
10796         Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10797         return JIM_ERR;
10798     }
10799 }
10800
10801 /* [expr] */
10802 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, 
10803         Jim_Obj *const *argv)
10804 {
10805     Jim_Obj *exprResultPtr;
10806     int retcode;
10807
10808     if (argc == 2) {
10809         retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10810     } else if (argc > 2) {
10811         Jim_Obj *objPtr;
10812
10813         objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10814         Jim_IncrRefCount(objPtr);
10815         retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10816         Jim_DecrRefCount(interp, objPtr);
10817     } else {
10818         Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10819         return JIM_ERR;
10820     }
10821     if (retcode != JIM_OK) return retcode;
10822     Jim_SetResult(interp, exprResultPtr);
10823     Jim_DecrRefCount(interp, exprResultPtr);
10824     return JIM_OK;
10825 }
10826
10827 /* [break] */
10828 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, 
10829         Jim_Obj *const *argv)
10830 {
10831     if (argc != 1) {
10832         Jim_WrongNumArgs(interp, 1, argv, "");
10833         return JIM_ERR;
10834     }
10835     return JIM_BREAK;
10836 }
10837
10838 /* [continue] */
10839 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10840         Jim_Obj *const *argv)
10841 {
10842     if (argc != 1) {
10843         Jim_WrongNumArgs(interp, 1, argv, "");
10844         return JIM_ERR;
10845     }
10846     return JIM_CONTINUE;
10847 }
10848
10849 /* [return] */
10850 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, 
10851         Jim_Obj *const *argv)
10852 {
10853     if (argc == 1) {
10854         return JIM_RETURN;
10855     } else if (argc == 2) {
10856         Jim_SetResult(interp, argv[1]);
10857         interp->returnCode = JIM_OK;
10858         return JIM_RETURN;
10859     } else if (argc == 3 || argc == 4) {
10860         int returnCode;
10861         if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10862             return JIM_ERR;
10863         interp->returnCode = returnCode;
10864         if (argc == 4)
10865             Jim_SetResult(interp, argv[3]);
10866         return JIM_RETURN;
10867     } else {
10868         Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10869         return JIM_ERR;
10870     }
10871     return JIM_RETURN; /* unreached */
10872 }
10873
10874 /* [tailcall] */
10875 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10876         Jim_Obj *const *argv)
10877 {
10878     Jim_Obj *objPtr;
10879
10880     objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10881     Jim_SetResult(interp, objPtr);
10882     return JIM_EVAL;
10883 }
10884
10885 /* [proc] */
10886 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, 
10887         Jim_Obj *const *argv)
10888 {
10889     int argListLen;
10890     int arityMin, arityMax;
10891
10892     if (argc != 4 && argc != 5) {
10893         Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10894         return JIM_ERR;
10895     }
10896     Jim_ListLength(interp, argv[2], &argListLen);
10897     arityMin = arityMax = argListLen+1;
10898     if (argListLen) {
10899         const char *str;
10900         int len;
10901         Jim_Obj *lastArgPtr;
10902         
10903         Jim_ListIndex(interp, argv[2], argListLen-1, &lastArgPtr, JIM_NONE);
10904         str = Jim_GetString(lastArgPtr, &len);
10905         if (len == 4 && memcmp(str, "args", 4) == 0) {
10906             arityMin--;
10907             arityMax = -1;
10908         }
10909     }
10910     if (argc == 4) {
10911         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10912                 argv[2], NULL, argv[3], arityMin, arityMax);
10913     } else {
10914         return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10915                 argv[2], argv[3], argv[4], arityMin, arityMax);
10916     }
10917 }
10918
10919 /* [concat] */
10920 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, 
10921         Jim_Obj *const *argv)
10922 {
10923     Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
10924     return JIM_OK;
10925 }
10926
10927 /* [upvar] */
10928 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, 
10929         Jim_Obj *const *argv)
10930 {
10931     const char *str;
10932     int i;
10933     Jim_CallFrame *targetCallFrame;
10934
10935     /* Lookup the target frame pointer */
10936     str = Jim_GetString(argv[1], NULL);
10937     if (argc > 3 && 
10938         ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
10939     {
10940         if (Jim_GetCallFrameByLevel(interp, argv[1],
10941                     &targetCallFrame, NULL) != JIM_OK)
10942             return JIM_ERR;
10943         argc--;
10944         argv++;
10945     } else {
10946         if (Jim_GetCallFrameByLevel(interp, NULL,
10947                     &targetCallFrame, NULL) != JIM_OK)
10948             return JIM_ERR;
10949     }
10950     /* Check for arity */
10951     if (argc < 3 || ((argc-1)%2) != 0) {
10952         Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
10953         return JIM_ERR;
10954     }
10955     /* Now... for every other/local couple: */
10956     for (i = 1; i < argc; i += 2) {
10957         if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
10958                 targetCallFrame) != JIM_OK) return JIM_ERR;
10959     }
10960     return JIM_OK;
10961 }
10962
10963 /* [global] */
10964 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, 
10965         Jim_Obj *const *argv)
10966 {
10967     int i;
10968
10969     if (argc < 2) {
10970         Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
10971         return JIM_ERR;
10972     }
10973     /* Link every var to the toplevel having the same name */
10974     if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
10975     for (i = 1; i < argc; i++) {
10976         if (Jim_SetVariableLink(interp, argv[i], argv[i],
10977                 interp->topFramePtr) != JIM_OK) return JIM_ERR;
10978     }
10979     return JIM_OK;
10980 }
10981
10982 /* does the [string map] operation. On error NULL is returned,
10983  * otherwise a new string object with the result, having refcount = 0,
10984  * is returned. */
10985 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
10986         Jim_Obj *objPtr, int nocase)
10987 {
10988     int numMaps;
10989     const char **key, *str, *noMatchStart = NULL;
10990     Jim_Obj **value;
10991     int *keyLen, strLen, i;
10992     Jim_Obj *resultObjPtr;
10993     
10994     Jim_ListLength(interp, mapListObjPtr, &numMaps);
10995     if (numMaps % 2) {
10996         Jim_SetResultString(interp,
10997                 "list must contain an even number of elements", -1);
10998         return NULL;
10999     }
11000     /* Initialization */
11001     numMaps /= 2;
11002     key = Jim_Alloc(sizeof(char*)*numMaps);
11003     keyLen = Jim_Alloc(sizeof(int)*numMaps);
11004     value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11005     resultObjPtr = Jim_NewStringObj(interp, "", 0);
11006     for (i = 0; i < numMaps; i++) {
11007         Jim_Obj *eleObjPtr;
11008
11009         Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11010         key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11011         Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11012         value[i] = eleObjPtr;
11013     }
11014     str = Jim_GetString(objPtr, &strLen);
11015     /* Map it */
11016     while(strLen) {
11017         for (i = 0; i < numMaps; i++) {
11018             if (strLen >= keyLen[i] && keyLen[i]) {
11019                 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11020                             nocase))
11021                 {
11022                     if (noMatchStart) {
11023                         Jim_AppendString(interp, resultObjPtr,
11024                                 noMatchStart, str-noMatchStart);
11025                         noMatchStart = NULL;
11026                     }
11027                     Jim_AppendObj(interp, resultObjPtr, value[i]);
11028                     str += keyLen[i];
11029                     strLen -= keyLen[i];
11030                     break;
11031                 }
11032             }
11033         }
11034         if (i == numMaps) { /* no match */
11035             if (noMatchStart == NULL)
11036                 noMatchStart = str;
11037             str ++;
11038             strLen --;
11039         }
11040     }
11041     if (noMatchStart) {
11042         Jim_AppendString(interp, resultObjPtr,
11043             noMatchStart, str-noMatchStart);
11044     }
11045     Jim_Free((void*)key);
11046     Jim_Free(keyLen);
11047     Jim_Free(value);
11048     return resultObjPtr;
11049 }
11050
11051 /* [string] */
11052 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, 
11053         Jim_Obj *const *argv)
11054 {
11055     int option;
11056     const char *options[] = {
11057         "length", "compare", "match", "equal", "range", "map", "repeat",
11058         "index", "first", "tolower", "toupper", NULL
11059     };
11060     enum {
11061         OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11062         OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11063     };
11064
11065     if (argc < 2) {
11066         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11067         return JIM_ERR;
11068     }
11069     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11070                 JIM_ERRMSG) != JIM_OK)
11071         return JIM_ERR;
11072
11073     if (option == OPT_LENGTH) {
11074         int len;
11075
11076         if (argc != 3) {
11077             Jim_WrongNumArgs(interp, 2, argv, "string");
11078             return JIM_ERR;
11079         }
11080         Jim_GetString(argv[2], &len);
11081         Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11082         return JIM_OK;
11083     } else if (option == OPT_COMPARE) {
11084         int nocase = 0;
11085         if ((argc != 4 && argc != 5) ||
11086             (argc == 5 && Jim_CompareStringImmediate(interp,
11087                 argv[2], "-nocase") == 0)) {
11088             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11089             return JIM_ERR;
11090         }
11091         if (argc == 5) {
11092             nocase = 1;
11093             argv++;
11094         }
11095         Jim_SetResult(interp, Jim_NewIntObj(interp,
11096                     Jim_StringCompareObj(argv[2],
11097                             argv[3], nocase)));
11098         return JIM_OK;
11099     } else if (option == OPT_MATCH) {
11100         int nocase = 0;
11101         if ((argc != 4 && argc != 5) ||
11102             (argc == 5 && Jim_CompareStringImmediate(interp,
11103                 argv[2], "-nocase") == 0)) {
11104             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11105                     "string");
11106             return JIM_ERR;
11107         }
11108         if (argc == 5) {
11109             nocase = 1;
11110             argv++;
11111         }
11112         Jim_SetResult(interp,
11113             Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11114                     argv[3], nocase)));
11115         return JIM_OK;
11116     } else if (option == OPT_EQUAL) {
11117         if (argc != 4) {
11118             Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11119             return JIM_ERR;
11120         }
11121         Jim_SetResult(interp,
11122             Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11123                     argv[3], 0)));
11124         return JIM_OK;
11125     } else if (option == OPT_RANGE) {
11126         Jim_Obj *objPtr;
11127
11128         if (argc != 5) {
11129             Jim_WrongNumArgs(interp, 2, argv, "string first last");
11130             return JIM_ERR;
11131         }
11132         objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11133         if (objPtr == NULL)
11134             return JIM_ERR;
11135         Jim_SetResult(interp, objPtr);
11136         return JIM_OK;
11137     } else if (option == OPT_MAP) {
11138         int nocase = 0;
11139         Jim_Obj *objPtr;
11140
11141         if ((argc != 4 && argc != 5) ||
11142             (argc == 5 && Jim_CompareStringImmediate(interp,
11143                 argv[2], "-nocase") == 0)) {
11144             Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11145                     "string");
11146             return JIM_ERR;
11147         }
11148         if (argc == 5) {
11149             nocase = 1;
11150             argv++;
11151         }
11152         objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11153         if (objPtr == NULL)
11154             return JIM_ERR;
11155         Jim_SetResult(interp, objPtr);
11156         return JIM_OK;
11157     } else if (option == OPT_REPEAT) {
11158         Jim_Obj *objPtr;
11159         jim_wide count;
11160
11161         if (argc != 4) {
11162             Jim_WrongNumArgs(interp, 2, argv, "string count");
11163             return JIM_ERR;
11164         }
11165         if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11166             return JIM_ERR;
11167         objPtr = Jim_NewStringObj(interp, "", 0);
11168         while (count--) {
11169             Jim_AppendObj(interp, objPtr, argv[2]);
11170         }
11171         Jim_SetResult(interp, objPtr);
11172         return JIM_OK;
11173     } else if (option == OPT_INDEX) {
11174         int index, len;
11175         const char *str;
11176
11177         if (argc != 4) {
11178             Jim_WrongNumArgs(interp, 2, argv, "string index");
11179             return JIM_ERR;
11180         }
11181         if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11182             return JIM_ERR;
11183         str = Jim_GetString(argv[2], &len);
11184         if (index != INT_MIN && index != INT_MAX)
11185             index = JimRelToAbsIndex(len, index);
11186         if (index < 0 || index >= len) {
11187             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11188             return JIM_OK;
11189         } else {
11190             Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11191             return JIM_OK;
11192         }
11193     } else if (option == OPT_FIRST) {
11194         int index = 0, l1, l2;
11195         const char *s1, *s2;
11196
11197         if (argc != 4 && argc != 5) {
11198             Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11199             return JIM_ERR;
11200         }
11201         s1 = Jim_GetString(argv[2], &l1);
11202         s2 = Jim_GetString(argv[3], &l2);
11203         if (argc == 5) {
11204             if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11205                 return JIM_ERR;
11206             index = JimRelToAbsIndex(l2, index);
11207         }
11208         Jim_SetResult(interp, Jim_NewIntObj(interp,
11209                     JimStringFirst(s1, l1, s2, l2, index)));
11210         return JIM_OK;
11211     } else if (option == OPT_TOLOWER) {
11212         if (argc != 3) {
11213             Jim_WrongNumArgs(interp, 2, argv, "string");
11214             return JIM_ERR;
11215         }
11216         Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11217     } else if (option == OPT_TOUPPER) {
11218         if (argc != 3) {
11219             Jim_WrongNumArgs(interp, 2, argv, "string");
11220             return JIM_ERR;
11221         }
11222         Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11223     }
11224     return JIM_OK;
11225 }
11226
11227 /* [time] */
11228 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, 
11229         Jim_Obj *const *argv)
11230 {
11231     long i, count = 1;
11232     jim_wide start, elapsed;
11233     char buf [256];
11234     const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11235
11236     if (argc < 2) {
11237         Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11238         return JIM_ERR;
11239     }
11240     if (argc == 3) {
11241         if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11242             return JIM_ERR;
11243     }
11244     if (count < 0)
11245         return JIM_OK;
11246     i = count;
11247     start = JimClock();
11248     while (i-- > 0) {
11249         int retval;
11250
11251         if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11252             return retval;
11253     }
11254     elapsed = JimClock() - start;
11255     sprintf(buf, fmt, elapsed/count);
11256     Jim_SetResultString(interp, buf, -1);
11257     return JIM_OK;
11258 }
11259
11260 /* [exit] */
11261 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, 
11262         Jim_Obj *const *argv)
11263 {
11264     long exitCode = 0;
11265
11266     if (argc > 2) {
11267         Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11268         return JIM_ERR;
11269     }
11270     if (argc == 2) {
11271         if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11272             return JIM_ERR;
11273     }
11274     interp->exitCode = exitCode;
11275     return JIM_EXIT;
11276 }
11277
11278 /* [catch] */
11279 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, 
11280         Jim_Obj *const *argv)
11281 {
11282     int exitCode = 0;
11283
11284     if (argc != 2 && argc != 3) {
11285         Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11286         return JIM_ERR;
11287     }
11288     exitCode = Jim_EvalObj(interp, argv[1]);
11289     if (argc == 3) {
11290         if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11291                 != JIM_OK)
11292             return JIM_ERR;
11293     }
11294     Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11295     return JIM_OK;
11296 }
11297
11298 /* [ref] */
11299 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, 
11300         Jim_Obj *const *argv)
11301 {
11302     if (argc != 3 && argc != 4) {
11303         Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11304         return JIM_ERR;
11305     }
11306     if (argc == 3) {
11307         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11308     } else {
11309         Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11310                     argv[3]));
11311     }
11312     return JIM_OK;
11313 }
11314
11315 /* [getref] */
11316 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, 
11317         Jim_Obj *const *argv)
11318 {
11319     Jim_Reference *refPtr;
11320
11321     if (argc != 2) {
11322         Jim_WrongNumArgs(interp, 1, argv, "reference");
11323         return JIM_ERR;
11324     }
11325     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11326         return JIM_ERR;
11327     Jim_SetResult(interp, refPtr->objPtr);
11328     return JIM_OK;
11329 }
11330
11331 /* [setref] */
11332 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, 
11333         Jim_Obj *const *argv)
11334 {
11335     Jim_Reference *refPtr;
11336
11337     if (argc != 3) {
11338         Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11339         return JIM_ERR;
11340     }
11341     if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11342         return JIM_ERR;
11343     Jim_IncrRefCount(argv[2]);
11344     Jim_DecrRefCount(interp, refPtr->objPtr);
11345     refPtr->objPtr = argv[2];
11346     Jim_SetResult(interp, argv[2]);
11347     return JIM_OK;
11348 }
11349
11350 /* [collect] */
11351 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, 
11352         Jim_Obj *const *argv)
11353 {
11354     if (argc != 1) {
11355         Jim_WrongNumArgs(interp, 1, argv, "");
11356         return JIM_ERR;
11357     }
11358     Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11359     return JIM_OK;
11360 }
11361
11362 /* [finalize] reference ?newValue? */
11363 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, 
11364         Jim_Obj *const *argv)
11365 {
11366     if (argc != 2 && argc != 3) {
11367         Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11368         return JIM_ERR;
11369     }
11370     if (argc == 2) {
11371         Jim_Obj *cmdNamePtr;
11372
11373         if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11374             return JIM_ERR;
11375         if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11376             Jim_SetResult(interp, cmdNamePtr);
11377     } else {
11378         if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11379             return JIM_ERR;
11380         Jim_SetResult(interp, argv[2]);
11381     }
11382     return JIM_OK;
11383 }
11384
11385 /* TODO */
11386 /* [info references] (list of all the references/finalizers) */
11387
11388 /* [rename] */
11389 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, 
11390         Jim_Obj *const *argv)
11391 {
11392     const char *oldName, *newName;
11393
11394     if (argc != 3) {
11395         Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11396         return JIM_ERR;
11397     }
11398     oldName = Jim_GetString(argv[1], NULL);
11399     newName = Jim_GetString(argv[2], NULL);
11400     if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11401         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11402         Jim_AppendStrings(interp, Jim_GetResult(interp),
11403             "can't rename \"", oldName, "\": ",
11404             "command doesn't exist", NULL);
11405         return JIM_ERR;
11406     }
11407     return JIM_OK;
11408 }
11409
11410 /* [dict] */
11411 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, 
11412         Jim_Obj *const *argv)
11413 {
11414     int option;
11415     const char *options[] = {
11416         "create", "get", "set", "unset", "exists", NULL
11417     };
11418     enum {
11419         OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11420     };
11421
11422     if (argc < 2) {
11423         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11424         return JIM_ERR;
11425     }
11426
11427     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11428                 JIM_ERRMSG) != JIM_OK)
11429         return JIM_ERR;
11430
11431     if (option == OPT_CREATE) {
11432         Jim_Obj *objPtr;
11433
11434         if (argc % 2) {
11435             Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11436             return JIM_ERR;
11437         }
11438         objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11439         Jim_SetResult(interp, objPtr);
11440         return JIM_OK;
11441     } else if (option == OPT_GET) {
11442         Jim_Obj *objPtr;
11443
11444         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11445                 JIM_ERRMSG) != JIM_OK)
11446             return JIM_ERR;
11447         Jim_SetResult(interp, objPtr);
11448         return JIM_OK;
11449     } else if (option == OPT_SET) {
11450         if (argc < 5) {
11451             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11452             return JIM_ERR;
11453         }
11454         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11455                     argv[argc-1]);
11456     } else if (option == OPT_UNSET) {
11457         if (argc < 4) {
11458             Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11459             return JIM_ERR;
11460         }
11461         return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11462                     NULL);
11463     } else if (option == OPT_EXIST) {
11464         Jim_Obj *objPtr;
11465         int exists;
11466
11467         if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11468                 JIM_ERRMSG) == JIM_OK)
11469             exists = 1;
11470         else
11471             exists = 0;
11472         Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11473         return JIM_OK;
11474     } else {
11475         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11476         Jim_AppendStrings(interp, Jim_GetResult(interp),
11477             "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11478             " must be create, get, set", NULL);
11479         return JIM_ERR;
11480     }
11481     return JIM_OK;
11482 }
11483
11484 /* [load] */
11485 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, 
11486         Jim_Obj *const *argv)
11487 {
11488     if (argc < 2) {
11489         Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11490         return JIM_ERR;
11491     }
11492     return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11493 }
11494
11495 /* [subst] */
11496 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, 
11497         Jim_Obj *const *argv)
11498 {
11499     int i, flags = 0;
11500     Jim_Obj *objPtr;
11501
11502     if (argc < 2) {
11503         Jim_WrongNumArgs(interp, 1, argv,
11504             "?-nobackslashes? ?-nocommands? ?-novariables? string");
11505         return JIM_ERR;
11506     }
11507     i = argc-2;
11508     while(i--) {
11509         if (Jim_CompareStringImmediate(interp, argv[i+1],
11510                     "-nobackslashes"))
11511             flags |= JIM_SUBST_NOESC;
11512         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11513                     "-novariables"))
11514             flags |= JIM_SUBST_NOVAR;
11515         else if (Jim_CompareStringImmediate(interp, argv[i+1],
11516                     "-nocommands"))
11517             flags |= JIM_SUBST_NOCMD;
11518         else {
11519             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11520             Jim_AppendStrings(interp, Jim_GetResult(interp),
11521                 "bad option \"", Jim_GetString(argv[i+1], NULL),
11522                 "\": must be -nobackslashes, -nocommands, or "
11523                 "-novariables", NULL);
11524             return JIM_ERR;
11525         }
11526     }
11527     if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11528         return JIM_ERR;
11529     Jim_SetResult(interp, objPtr);
11530     return JIM_OK;
11531 }
11532
11533 /* [info] */
11534 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, 
11535         Jim_Obj *const *argv)
11536 {
11537     int cmd, result = JIM_OK;
11538     static const char *commands[] = {
11539         "body", "commands", "exists", "globals", "level", "locals",
11540         "vars", "version", "complete", "args", NULL
11541     };
11542     enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11543           INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS};
11544     
11545     if (argc < 2) {
11546         Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11547         return JIM_ERR;
11548     }
11549     if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11550         != JIM_OK) {
11551         return JIM_ERR;
11552     }
11553     
11554     if (cmd == INFO_COMMANDS) {
11555         if (argc != 2 && argc != 3) {
11556             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11557             return JIM_ERR;
11558         }
11559         if (argc == 3)
11560             Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11561         else
11562             Jim_SetResult(interp, JimCommandsList(interp, NULL));
11563     } else if (cmd == INFO_EXISTS) {
11564         Jim_Obj *exists;
11565         if (argc != 3) {
11566             Jim_WrongNumArgs(interp, 2, argv, "varName");
11567             return JIM_ERR;
11568         }
11569         exists = Jim_GetVariable(interp, argv[2], 0);
11570         Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11571     } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11572         int mode;
11573         switch (cmd) {
11574             case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11575             case INFO_LOCALS:  mode = JIM_VARLIST_LOCALS; break;
11576             case INFO_VARS:    mode = JIM_VARLIST_VARS; break;
11577             default: mode = 0; /* avoid warning */; break;
11578         }
11579         if (argc != 2 && argc != 3) {
11580             Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11581             return JIM_ERR;
11582         }
11583         if (argc == 3)
11584             Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11585         else
11586             Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11587     } else if (cmd == INFO_LEVEL) {
11588         Jim_Obj *objPtr;
11589         switch (argc) {
11590             case 2:
11591                 Jim_SetResult(interp,
11592                               Jim_NewIntObj(interp, interp->numLevels));
11593                 break;
11594             case 3:
11595                 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11596                     return JIM_ERR;
11597                 Jim_SetResult(interp, objPtr);
11598                 break;
11599             default:
11600                 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11601                 return JIM_ERR;
11602         }
11603     } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11604         Jim_Cmd *cmdPtr;
11605
11606         if (argc != 3) {
11607             Jim_WrongNumArgs(interp, 2, argv, "procname");
11608             return JIM_ERR;
11609         }
11610         if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11611             return JIM_ERR;
11612         if (cmdPtr->cmdProc != NULL) {
11613             Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11614             Jim_AppendStrings(interp, Jim_GetResult(interp),
11615                 "command \"", Jim_GetString(argv[2], NULL),
11616                 "\" is not a procedure", NULL);
11617             return JIM_ERR;
11618         }
11619         if (cmd == INFO_BODY)
11620             Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11621         else
11622             Jim_SetResult(interp, cmdPtr->argListObjPtr);
11623     } else if (cmd == INFO_VERSION) {
11624         char buf[(JIM_INTEGER_SPACE * 2) + 1];
11625         sprintf(buf, "%d.%d", 
11626                 JIM_VERSION / 100, JIM_VERSION % 100);
11627         Jim_SetResultString(interp, buf, -1);
11628     } else if (cmd == INFO_COMPLETE) {
11629         const char *s;
11630         int len;
11631
11632         if (argc != 3) {
11633             Jim_WrongNumArgs(interp, 2, argv, "script");
11634             return JIM_ERR;
11635         }
11636         s = Jim_GetString(argv[2], &len);
11637         Jim_SetResult(interp,
11638                 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11639     }
11640     return result;
11641 }
11642
11643 /* [split] */
11644 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, 
11645         Jim_Obj *const *argv)
11646 {
11647     const char *str, *splitChars, *noMatchStart;
11648     int splitLen, strLen, i;
11649     Jim_Obj *resObjPtr;
11650
11651     if (argc != 2 && argc != 3) {
11652         Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11653         return JIM_ERR;
11654     }
11655     /* Init */
11656     if (argc == 2) {
11657         splitChars = " \n\t\r";
11658         splitLen = 4;
11659     } else {
11660         splitChars = Jim_GetString(argv[2], &splitLen);
11661     }
11662     str = Jim_GetString(argv[1], &strLen);
11663     if (!strLen) return JIM_OK;
11664     noMatchStart = str;
11665     resObjPtr = Jim_NewListObj(interp, NULL, 0);
11666     /* Split */
11667     if (splitLen) {
11668         while (strLen) {
11669             for (i = 0; i < splitLen; i++) {
11670                 if (*str == splitChars[i]) {
11671                     Jim_Obj *objPtr;
11672
11673                     objPtr = Jim_NewStringObj(interp, noMatchStart,
11674                             (str-noMatchStart));
11675                     Jim_ListAppendElement(interp, resObjPtr, objPtr);
11676                     noMatchStart = str+1;
11677                     break;
11678                 }
11679             }
11680             str ++;
11681             strLen --;
11682         }
11683         Jim_ListAppendElement(interp, resObjPtr,
11684                 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11685     } else {
11686         /* This handles the special case of splitchars eq {}. This
11687          * is trivial but we want to perform object sharing as Tcl does. */
11688         Jim_Obj *objCache[256];
11689         const unsigned char *u = (unsigned char*) str;
11690         memset(objCache, 0, sizeof(objCache));
11691         for (i = 0; i < strLen; i++) {
11692             int c = u[i];
11693             
11694             if (objCache[c] == NULL)
11695                 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11696             Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11697         }
11698     }
11699     Jim_SetResult(interp, resObjPtr);
11700     return JIM_OK;
11701 }
11702
11703 /* [join] */
11704 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, 
11705         Jim_Obj *const *argv)
11706 {
11707     const char *joinStr;
11708     int joinStrLen, i, listLen;
11709     Jim_Obj *resObjPtr;
11710
11711     if (argc != 2 && argc != 3) {
11712         Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11713         return JIM_ERR;
11714     }
11715     /* Init */
11716     if (argc == 2) {
11717         joinStr = " ";
11718         joinStrLen = 1;
11719     } else {
11720         joinStr = Jim_GetString(argv[2], &joinStrLen);
11721     }
11722     Jim_ListLength(interp, argv[1], &listLen);
11723     resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11724     /* Split */
11725     for (i = 0; i < listLen; i++) {
11726         Jim_Obj *objPtr;
11727
11728         Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11729         Jim_AppendObj(interp, resObjPtr, objPtr);
11730         if (i+1 != listLen) {
11731             Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11732         }
11733     }
11734     Jim_SetResult(interp, resObjPtr);
11735     return JIM_OK;
11736 }
11737
11738 /* [format] */
11739 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11740         Jim_Obj *const *argv)
11741 {
11742     Jim_Obj *objPtr;
11743
11744     if (argc < 2) {
11745         Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11746         return JIM_ERR;
11747     }
11748     objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11749     if (objPtr == NULL)
11750         return JIM_ERR;
11751     Jim_SetResult(interp, objPtr);
11752     return JIM_OK;
11753 }
11754
11755 /* [scan] */
11756 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11757         Jim_Obj *const *argv)
11758 {
11759     Jim_Obj *listPtr, **outVec;
11760     int outc, i, count = 0;
11761
11762     if (argc < 3) {
11763         Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11764         return JIM_ERR;
11765     } 
11766     if (argv[2]->typePtr != &scanFmtStringObjType)
11767         SetScanFmtFromAny(interp, argv[2]);
11768     if (FormatGetError(argv[2]) != 0) {
11769         Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11770         return JIM_ERR;
11771     }
11772     if (argc > 3) {
11773         int maxPos = FormatGetMaxPos(argv[2]);
11774         int count = FormatGetCnvCount(argv[2]);
11775         if (maxPos > argc-3) {
11776             Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11777             return JIM_ERR;
11778         } else if (count != 0 && count < argc-3) {
11779             Jim_SetResultString(interp, "variable is not assigned by any "
11780                 "conversion specifiers", -1);
11781             return JIM_ERR;
11782         } else if (count > argc-3) {
11783             Jim_SetResultString(interp, "different numbers of variable names and "
11784                 "field specifiers", -1);
11785             return JIM_ERR;
11786         }
11787     } 
11788     listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11789     if (listPtr == 0)
11790         return JIM_ERR;
11791     if (argc > 3) {
11792         int len = 0;
11793         if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11794             Jim_ListLength(interp, listPtr, &len);
11795         if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11796             Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11797             return JIM_OK;
11798         }
11799         JimListGetElements(interp, listPtr, &outc, &outVec);
11800         for (i = 0; i < outc; ++i) {
11801             if (Jim_Length(outVec[i]) > 0) {
11802                 ++count;
11803                 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11804                     goto err;
11805             }
11806         }
11807         Jim_FreeNewObj(interp, listPtr);
11808         Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11809     } else {
11810         if (listPtr == (Jim_Obj*)EOF) {
11811             Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11812             return JIM_OK;
11813         }
11814         Jim_SetResult(interp, listPtr);
11815     }
11816     return JIM_OK;
11817 err:
11818     Jim_FreeNewObj(interp, listPtr);
11819     return JIM_ERR;
11820 }
11821
11822 /* [error] */
11823 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11824         Jim_Obj *const *argv)
11825 {
11826     if (argc != 2) {
11827         Jim_WrongNumArgs(interp, 1, argv, "message");
11828         return JIM_ERR;
11829     }
11830     Jim_SetResult(interp, argv[1]);
11831     return JIM_ERR;
11832 }
11833
11834 /* [lrange] */
11835 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11836         Jim_Obj *const *argv)
11837 {
11838     Jim_Obj *objPtr;
11839
11840     if (argc != 4) {
11841         Jim_WrongNumArgs(interp, 1, argv, "list first last");
11842         return JIM_ERR;
11843     }
11844     if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11845         return JIM_ERR;
11846     Jim_SetResult(interp, objPtr);
11847     return JIM_OK;
11848 }
11849
11850 /* [env] */
11851 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11852         Jim_Obj *const *argv)
11853 {
11854     const char *key;
11855     char *val;
11856
11857     if (argc != 2) {
11858         Jim_WrongNumArgs(interp, 1, argv, "varName");
11859         return JIM_ERR;
11860     }
11861     key = Jim_GetString(argv[1], NULL);
11862     val = getenv(key);
11863     if (val == NULL) {
11864         Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11865         Jim_AppendStrings(interp, Jim_GetResult(interp),
11866                 "environment variable \"",
11867                 key, "\" does not exist", NULL);
11868         return JIM_ERR;
11869     }
11870     Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
11871     return JIM_OK;
11872 }
11873
11874 /* [source] */
11875 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
11876         Jim_Obj *const *argv)
11877 {
11878     int retval;
11879
11880     if (argc != 2) {
11881         Jim_WrongNumArgs(interp, 1, argv, "fileName");
11882         return JIM_ERR;
11883     }
11884     retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
11885     if (retval == JIM_RETURN)
11886         return JIM_OK;
11887     return retval;
11888 }
11889
11890 /* [lreverse] */
11891 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
11892         Jim_Obj *const *argv)
11893 {
11894     Jim_Obj *revObjPtr, **ele;
11895     int len;
11896
11897     if (argc != 2) {
11898         Jim_WrongNumArgs(interp, 1, argv, "list");
11899         return JIM_ERR;
11900     }
11901     JimListGetElements(interp, argv[1], &len, &ele);
11902     len--;
11903     revObjPtr = Jim_NewListObj(interp, NULL, 0);
11904     while (len >= 0)
11905         ListAppendElement(revObjPtr, ele[len--]);
11906     Jim_SetResult(interp, revObjPtr);
11907     return JIM_OK;
11908 }
11909
11910 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
11911 {
11912     jim_wide len;
11913
11914     if (step == 0) return -1;
11915     if (start == end) return 0;
11916     else if (step > 0 && start > end) return -1;
11917     else if (step < 0 && end > start) return -1;
11918     len = end-start;
11919     if (len < 0) len = -len; /* abs(len) */
11920     if (step < 0) step = -step; /* abs(step) */
11921     len = 1 + ((len-1)/step);
11922     /* We can truncate safely to INT_MAX, the range command
11923      * will always return an error for a such long range
11924      * because Tcl lists can't be so long. */
11925     if (len > INT_MAX) len = INT_MAX;
11926     return (int)((len < 0) ? -1 : len);
11927 }
11928
11929 /* [range] */
11930 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
11931         Jim_Obj *const *argv)
11932 {
11933     jim_wide start = 0, end, step = 1;
11934     int len, i;
11935     Jim_Obj *objPtr;
11936
11937     if (argc < 2 || argc > 4) {
11938         Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
11939         return JIM_ERR;
11940     }
11941     if (argc == 2) {
11942         if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
11943             return JIM_ERR;
11944     } else {
11945         if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
11946             Jim_GetWide(interp, argv[2], &end) != JIM_OK)
11947             return JIM_ERR;
11948         if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
11949             return JIM_ERR;
11950     }
11951     if ((len = JimRangeLen(start, end, step)) == -1) {
11952         Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
11953         return JIM_ERR;
11954     }
11955     objPtr = Jim_NewListObj(interp, NULL, 0);
11956     for (i = 0; i < len; i++)
11957         ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
11958     Jim_SetResult(interp, objPtr);
11959     return JIM_OK;
11960 }
11961
11962 /* [rand] */
11963 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
11964         Jim_Obj *const *argv)
11965 {
11966     jim_wide min = 0, max, len, maxMul;
11967
11968     if (argc < 1 || argc > 3) {
11969         Jim_WrongNumArgs(interp, 1, argv, "?min? max");
11970         return JIM_ERR;
11971     }
11972     if (argc == 1) {
11973         max = JIM_WIDE_MAX;
11974     } else if (argc == 2) {
11975         if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
11976             return JIM_ERR;
11977     } else if (argc == 3) {
11978         if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
11979             Jim_GetWide(interp, argv[2], &max) != JIM_OK)
11980             return JIM_ERR;
11981     }
11982     len = max-min;
11983     if (len < 0) {
11984         Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
11985         return JIM_ERR;
11986     }
11987     maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
11988     while (1) {
11989         jim_wide r;
11990
11991         JimRandomBytes(interp, &r, sizeof(jim_wide));
11992         if (r < 0 || r >= maxMul) continue;
11993         r = (len == 0) ? 0 : r%len;
11994         Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
11995         return JIM_OK;
11996     }
11997 }
11998
11999 /* [package] */
12000 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc, 
12001         Jim_Obj *const *argv)
12002 {
12003     int option;
12004     const char *options[] = {
12005         "require", "provide", NULL
12006     };
12007     enum {OPT_REQUIRE, OPT_PROVIDE};
12008
12009     if (argc < 2) {
12010         Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12011         return JIM_ERR;
12012     }
12013     if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12014                 JIM_ERRMSG) != JIM_OK)
12015         return JIM_ERR;
12016
12017     if (option == OPT_REQUIRE) {
12018         int exact = 0;
12019         const char *ver;
12020
12021         if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12022             exact = 1;
12023             argv++;
12024             argc--;
12025         }
12026         if (argc != 3 && argc != 4) {
12027             Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12028             return JIM_ERR;
12029         }
12030         ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12031                 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12032                 JIM_ERRMSG);
12033         if (ver == NULL)
12034             return JIM_ERR;
12035         Jim_SetResultString(interp, ver, -1);
12036     } else if (option == OPT_PROVIDE) {
12037         if (argc != 4) {
12038             Jim_WrongNumArgs(interp, 2, argv, "package version");
12039             return JIM_ERR;
12040         }
12041         return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12042                     Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12043     }
12044     return JIM_OK;
12045 }
12046
12047
12048 static void
12049 jim_get_s_us( jim_wide *s, jim_wide *us )
12050 {
12051 #if defined(WIN32)
12052         /* 
12053          * Sorry - I do not have, or use Win32.
12054          * This concept is from 
12055          * 
12056          * Method is from: 
12057          *    http://www.openasthra.com/c-tidbits/gettimeofday-function-for-windows/
12058          *
12059          * I have no method to test/verify.
12060          *  - Duane 6-sep-2008.
12061          * (once verified, please somebody remove this comment)
12062          */
12063 #if defined(_MSC_VER) || defined(_MSC_EXTENSIONS)
12064   #define DELTA_EPOCH_IN_MICROSECS  11644473600000000Ui64
12065 #else
12066   #define DELTA_EPOCH_IN_MICROSECS  11644473600000000ULL
12067 #endif
12068
12069         FILETIME ft;
12070         unsigned __int64 tmpres;
12071         tmpres = 0;
12072         GetSystemTimeAsFileTime( &ft );
12073
12074         tmpres |= ft.dwHighDateTime;
12075         tmpres <<= 32;
12076         tmpres |= ft.dwLowDateTime;
12077         /* convert to unix representation */
12078         tmpres /= 10;
12079         tmpres -= DELTA_EPOCH_IN_MICROSECS;
12080         
12081         *s  = (tmpres / 1000000ULL);
12082         *us = (tmpres % 1000000ULL);
12083         
12084 #undef DELTA_EPOCH_IN_MICROSECS
12085
12086 #else
12087         /* LINUX/CYGWIN */
12088         struct timeval tv;
12089         struct timezone tz;
12090         gettimeofday( &tv, &tz );
12091         *s  = tv.tv_sec;
12092         *us = tv.tv_usec;
12093 #endif
12094 }
12095
12096
12097 /* [clock] */
12098 static int Jim_ClockCoreCommand( Jim_Interp *interp, int argc,
12099                                                                    Jim_Obj *const *argv)
12100 {
12101         /*
12102          *  See: TCL man page for 'clock'
12103          *  we do not impliment all features.
12104          */
12105         jim_wide r,s,us;
12106         int option;
12107         const char *options[] = {
12108                 "clicks",
12109                 "microseconds",
12110                 "milliseconds",
12111                 "seconds",
12112                 NULL 
12113         };
12114         enum { OPT_CLICKS, OPT_USEC, OPT_MSEC, OPT_SEC };
12115
12116         if( argc < 2 ){
12117                 Jim_WrongNumArgs( interp, 1, argv, "option ?arguments ...?");
12118                 return JIM_ERR;
12119         }
12120
12121         if( Jim_GetEnum(interp, argv[1], options, &option, "option",
12122                                         JIM_ERRMSG) != JIM_OK ){
12123                 return JIM_ERR;
12124         }
12125
12126         // platform independent get time.
12127         jim_get_s_us( &s, &us );
12128
12129         r = 0;
12130         switch(option){
12131         case OPT_CLICKS:
12132         case OPT_USEC:
12133                 /* clicks & usecs are the same */
12134                 r = (s * 1000000) + us;
12135                 break;
12136         case OPT_MSEC:
12137                 r = (s * 1000) + (us / 1000);
12138                 break;
12139         case OPT_SEC:
12140                 r = s;
12141                 break;
12142         }
12143                 
12144         Jim_SetResult( interp, Jim_NewWideObj( interp, r ) );
12145         return JIM_OK;
12146 }
12147          
12148
12149 static struct {
12150     const char *name;
12151     Jim_CmdProc cmdProc;
12152 } Jim_CoreCommandsTable[] = {
12153     {"set", Jim_SetCoreCommand},
12154     {"unset", Jim_UnsetCoreCommand},
12155     {"puts", Jim_PutsCoreCommand},
12156     {"+", Jim_AddCoreCommand},
12157     {"*", Jim_MulCoreCommand},
12158     {"-", Jim_SubCoreCommand},
12159     {"/", Jim_DivCoreCommand},
12160     {"incr", Jim_IncrCoreCommand},
12161     {"while", Jim_WhileCoreCommand},
12162     {"for", Jim_ForCoreCommand},
12163     {"foreach", Jim_ForeachCoreCommand},
12164     {"lmap", Jim_LmapCoreCommand},
12165     {"if", Jim_IfCoreCommand},
12166     {"switch", Jim_SwitchCoreCommand},
12167     {"list", Jim_ListCoreCommand},
12168     {"lindex", Jim_LindexCoreCommand},
12169     {"lset", Jim_LsetCoreCommand},
12170     {"llength", Jim_LlengthCoreCommand},
12171     {"lappend", Jim_LappendCoreCommand},
12172     {"linsert", Jim_LinsertCoreCommand},
12173     {"lsort", Jim_LsortCoreCommand},
12174     {"append", Jim_AppendCoreCommand},
12175     {"debug", Jim_DebugCoreCommand},
12176     {"eval", Jim_EvalCoreCommand},
12177     {"uplevel", Jim_UplevelCoreCommand},
12178     {"expr", Jim_ExprCoreCommand},
12179     {"break", Jim_BreakCoreCommand},
12180     {"continue", Jim_ContinueCoreCommand},
12181     {"proc", Jim_ProcCoreCommand},
12182     {"concat", Jim_ConcatCoreCommand},
12183     {"return", Jim_ReturnCoreCommand},
12184     {"upvar", Jim_UpvarCoreCommand},
12185     {"global", Jim_GlobalCoreCommand},
12186     {"string", Jim_StringCoreCommand},
12187     {"time", Jim_TimeCoreCommand},
12188     {"exit", Jim_ExitCoreCommand},
12189     {"catch", Jim_CatchCoreCommand},
12190     {"ref", Jim_RefCoreCommand},
12191     {"getref", Jim_GetrefCoreCommand},
12192     {"setref", Jim_SetrefCoreCommand},
12193     {"finalize", Jim_FinalizeCoreCommand},
12194     {"collect", Jim_CollectCoreCommand},
12195     {"rename", Jim_RenameCoreCommand},
12196     {"dict", Jim_DictCoreCommand},
12197     {"load", Jim_LoadCoreCommand},
12198     {"subst", Jim_SubstCoreCommand},
12199     {"info", Jim_InfoCoreCommand},
12200     {"split", Jim_SplitCoreCommand},
12201     {"join", Jim_JoinCoreCommand},
12202     {"format", Jim_FormatCoreCommand},
12203     {"scan", Jim_ScanCoreCommand},
12204     {"error", Jim_ErrorCoreCommand},
12205     {"lrange", Jim_LrangeCoreCommand},
12206     {"env", Jim_EnvCoreCommand},
12207     {"source", Jim_SourceCoreCommand},
12208     {"lreverse", Jim_LreverseCoreCommand},
12209     {"range", Jim_RangeCoreCommand},
12210     {"rand", Jim_RandCoreCommand},
12211     {"package", Jim_PackageCoreCommand},
12212     {"tailcall", Jim_TailcallCoreCommand},
12213         {"clock", Jim_ClockCoreCommand},
12214     {NULL, NULL},
12215 };
12216
12217 /* Some Jim core command is actually a procedure written in Jim itself. */
12218 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12219 {
12220     Jim_Eval(interp, (char*)
12221 "proc lambda {arglist args} {\n"
12222 "    set name [ref {} function lambdaFinalizer]\n"
12223 "    uplevel 1 [list proc $name $arglist {expand}$args]\n"
12224 "    return $name\n"
12225 "}\n"
12226 "proc lambdaFinalizer {name val} {\n"
12227 "    rename $name {}\n"
12228 "}\n"
12229     );
12230 }
12231
12232 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12233 {
12234     int i = 0;
12235
12236     while(Jim_CoreCommandsTable[i].name != NULL) {
12237         Jim_CreateCommand(interp, 
12238                 Jim_CoreCommandsTable[i].name,
12239                 Jim_CoreCommandsTable[i].cmdProc,
12240                 NULL, NULL);
12241         i++;
12242     }
12243     Jim_RegisterCoreProcedures(interp);
12244 }
12245
12246 /* -----------------------------------------------------------------------------
12247  * Interactive prompt
12248  * ---------------------------------------------------------------------------*/
12249 void Jim_PrintErrorMessage(Jim_Interp *interp)
12250 {
12251     int len, i;
12252
12253     Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL,
12254                                 interp->errorFileName, interp->errorLine);
12255     Jim_fprintf(interp,interp->cookie_stderr, "    %s" JIM_NL,
12256             Jim_GetString(interp->result, NULL));
12257     Jim_ListLength(interp, interp->stackTrace, &len);
12258     for (i = len-3; i >= 0; i-= 3) {
12259         Jim_Obj *objPtr;
12260         const char *proc, *file, *line;
12261
12262         Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12263         proc = Jim_GetString(objPtr, NULL);
12264         Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12265                 JIM_NONE);
12266         file = Jim_GetString(objPtr, NULL);
12267         Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12268                 JIM_NONE);
12269         line = Jim_GetString(objPtr, NULL);
12270                 Jim_fprintf( interp, interp->cookie_stderr,
12271                 "In procedure '%s' called at file \"%s\", line %s" JIM_NL,
12272                 proc, file, line);
12273     }
12274 }
12275
12276 int Jim_InteractivePrompt(Jim_Interp *interp)
12277 {
12278     int retcode = JIM_OK;
12279     Jim_Obj *scriptObjPtr;
12280
12281     Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12282            "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12283            JIM_VERSION / 100, JIM_VERSION % 100);
12284      Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12285     while (1) {
12286         char buf[1024];
12287         const char *result;
12288         const char *retcodestr[] = {
12289             "ok", "error", "return", "break", "continue", "eval", "exit"
12290         };
12291         int reslen;
12292
12293         if (retcode != 0) {
12294             if (retcode >= 2 && retcode <= 6)
12295                 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12296             else
12297                 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12298         } else
12299             Jim_fprintf( interp, interp->cookie_stdout, ". ");
12300         Jim_fflush( interp, interp->cookie_stdout);
12301         scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12302         Jim_IncrRefCount(scriptObjPtr);
12303         while(1) {
12304             const char *str;
12305             char state;
12306             int len;
12307
12308             if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12309                 Jim_DecrRefCount(interp, scriptObjPtr);
12310                 goto out;
12311             }
12312             Jim_AppendString(interp, scriptObjPtr, buf, -1);
12313             str = Jim_GetString(scriptObjPtr, &len);
12314             if (Jim_ScriptIsComplete(str, len, &state))
12315                 break;
12316             Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12317             Jim_fflush( interp, interp->cookie_stdout);
12318         }
12319         retcode = Jim_EvalObj(interp, scriptObjPtr);
12320         Jim_DecrRefCount(interp, scriptObjPtr);
12321         result = Jim_GetString(Jim_GetResult(interp), &reslen);
12322         if (retcode == JIM_ERR) {
12323             Jim_PrintErrorMessage(interp);
12324         } else if (retcode == JIM_EXIT) {
12325             exit(Jim_GetExitCode(interp));
12326         } else {
12327             if (reslen) {
12328                                 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12329                                 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12330             }
12331         }
12332     }
12333 out:
12334     return 0;
12335 }
12336
12337 /* -----------------------------------------------------------------------------
12338  * Jim's idea of STDIO..
12339  * ---------------------------------------------------------------------------*/
12340
12341 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12342 {
12343         int r;
12344
12345         va_list ap;
12346         va_start(ap,fmt);
12347         r = Jim_vfprintf( interp, cookie, fmt,ap );
12348         va_end(ap);
12349         return r;
12350 }
12351
12352 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12353 {
12354         if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12355                 errno = ENOTSUP;
12356                 return -1;
12357         }
12358         return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12359 }
12360
12361 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12362 {
12363         if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12364                 errno = ENOTSUP;
12365                 return 0;
12366         }
12367         return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12368 }
12369
12370 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12371 {
12372         if( (interp == NULL) || (interp->cb_fread == NULL) ){
12373                 errno = ENOTSUP;
12374                 return 0;
12375         }
12376         return (*(interp->cb_fread))( ptr, size, n, cookie);
12377 }
12378
12379 int Jim_fflush( Jim_Interp *interp, void *cookie )
12380 {
12381         if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12382                 /* pretend all is well */
12383                 return 0;
12384         }
12385         return (*(interp->cb_fflush))( cookie );
12386 }
12387
12388 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12389 {
12390         if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12391                 errno = ENOTSUP;
12392                 return NULL;
12393         }
12394         return (*(interp->cb_fgets))( s, size, cookie );
12395 }
12396
12397 Jim_Nvp *
12398 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12399 {
12400         while( p->name ){
12401                 if( 0 == strcmp( name, p->name ) ){
12402                         break;
12403                 }
12404                 p++;
12405         }
12406         return ((Jim_Nvp *)(p));
12407 }
12408
12409 Jim_Nvp *
12410 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12411 {
12412         while( p->name ){
12413                 if( 0 == strcasecmp( name, p->name ) ){
12414                         break;
12415                 }
12416                 p++;
12417         }
12418         return ((Jim_Nvp *)(p));
12419 }
12420
12421 int
12422 Jim_Nvp_name2value_obj( Jim_Interp *interp, 
12423                                                 const Jim_Nvp *p, 
12424                                                 Jim_Obj *o, 
12425                                                 Jim_Nvp **result )
12426 {
12427         return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12428 }
12429         
12430
12431 int 
12432 Jim_Nvp_name2value( Jim_Interp *interp, 
12433                                         const Jim_Nvp *_p, 
12434                                         const char *name, 
12435                                         Jim_Nvp **result)
12436 {
12437         const Jim_Nvp *p;
12438
12439         p = Jim_Nvp_name2value_simple( _p, name );
12440
12441         /* result */
12442         if( result ){
12443                 *result = (Jim_Nvp *)(p);
12444         }
12445         
12446         /* found? */
12447         if( p->name ){
12448                 return JIM_OK;
12449         } else {
12450                 return JIM_ERR;
12451         }
12452 }
12453
12454 int
12455 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12456 {
12457         return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12458 }
12459
12460 int
12461 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12462 {
12463         const Jim_Nvp *p;
12464
12465         p = Jim_Nvp_name2value_nocase_simple( _p, name );
12466
12467         if( puthere ){
12468                 *puthere = (Jim_Nvp *)(p);
12469         }
12470         /* found */
12471         if( p->name ){
12472                 return JIM_OK;
12473         } else {
12474                 return JIM_ERR;
12475         }
12476 }
12477
12478
12479 int 
12480 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12481 {
12482         int e;;
12483         jim_wide w;
12484
12485         e = Jim_GetWide( interp, o, &w );
12486         if( e != JIM_OK ){
12487                 return e;
12488         }
12489
12490         return Jim_Nvp_value2name( interp, p, w, result );
12491 }
12492
12493 Jim_Nvp *
12494 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12495 {
12496         while( p->name ){
12497                 if( value == p->value ){
12498                         break;
12499                 }
12500                 p++;
12501         }
12502         return ((Jim_Nvp *)(p));
12503 }
12504
12505
12506 int 
12507 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12508 {
12509         const Jim_Nvp *p;
12510
12511         p = Jim_Nvp_value2name_simple( _p, value );
12512
12513         if( result ){
12514                 *result = (Jim_Nvp *)(p);
12515         }
12516
12517         if( p->name ){
12518                 return JIM_OK;
12519         } else {
12520                 return JIM_ERR;
12521         }
12522 }
12523
12524
12525 int
12526 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const *  argv)
12527 {
12528         memset( p, 0, sizeof(*p) );
12529         p->interp = interp;
12530         p->argc   = argc;
12531         p->argv   = argv;
12532
12533         return JIM_OK;
12534 }
12535
12536 void
12537 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12538 {
12539         int x;
12540
12541         Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12542         for( x = 0 ; x < p->argc ; x++ ){
12543                 Jim_fprintf( p->interp, p->interp->cookie_stderr, 
12544                                          "%2d) %s\n", 
12545                                          x, 
12546                                          Jim_GetString( p->argv[x], NULL ) );
12547         }
12548         Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12549 }
12550
12551
12552 int
12553 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12554 {
12555         Jim_Obj *o;
12556         
12557         o = NULL; // failure 
12558         if( goi->argc > 0 ){
12559                 // success 
12560                 o = goi->argv[0];
12561                 goi->argc -= 1;
12562                 goi->argv += 1;
12563         }
12564         if( puthere ){
12565                 *puthere = o;
12566         }
12567         if( o != NULL ){
12568                 return JIM_OK;
12569         } else {
12570                 return JIM_ERR;
12571         }
12572 }
12573
12574 int
12575 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12576 {
12577         int r;
12578         Jim_Obj *o;
12579         const char *cp;
12580
12581
12582         r = Jim_GetOpt_Obj( goi, &o );
12583         if( r == JIM_OK ){
12584                 cp = Jim_GetString( o, len );
12585                 if( puthere ){
12586                         /* remove const */
12587                         *puthere = (char *)(cp);
12588                 }
12589         }
12590         return r;
12591 }
12592
12593 int
12594 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12595 {
12596         int r;
12597         Jim_Obj *o;
12598         double _safe;
12599         
12600         if( puthere == NULL ){
12601                 puthere = &_safe;
12602         }
12603
12604         r = Jim_GetOpt_Obj( goi, &o );
12605         if( r == JIM_OK ){
12606                 r = Jim_GetDouble( goi->interp, o, puthere );
12607                 if( r != JIM_OK ){
12608                         Jim_SetResult_sprintf( goi->interp,
12609                                                                    "not a number: %s", 
12610                                                                    Jim_GetString( o, NULL ) );
12611                 }
12612         }
12613         return r;
12614 }
12615
12616 int
12617 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12618 {
12619         int r;
12620         Jim_Obj *o;
12621         jim_wide _safe;
12622
12623         if( puthere == NULL ){
12624                 puthere = &_safe;
12625         }
12626
12627         r = Jim_GetOpt_Obj( goi, &o );
12628         if( r == JIM_OK ){
12629                 r = Jim_GetWide( goi->interp, o, puthere );
12630         }
12631         return r;
12632 }
12633
12634 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi, 
12635                                         const Jim_Nvp *nvp, 
12636                                         Jim_Nvp **puthere)
12637 {
12638         Jim_Nvp *_safe;
12639         Jim_Obj *o;
12640         int e;
12641
12642         if( puthere == NULL ){
12643                 puthere = &_safe;
12644         }
12645
12646         e = Jim_GetOpt_Obj( goi, &o );
12647         if( e == JIM_OK ){
12648                 e = Jim_Nvp_name2value_obj( goi->interp,
12649                                                                         nvp, 
12650                                                                         o,
12651                                                                         puthere );
12652         }
12653
12654         return e;
12655 }
12656
12657 void
12658 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12659                                            const Jim_Nvp *nvptable,
12660                                            int hadprefix )
12661 {
12662         if( hadprefix ){
12663                 Jim_SetResult_NvpUnknown( goi->interp,
12664                                                                   goi->argv[-2],
12665                                                                   goi->argv[-1],
12666                                                                   nvptable );
12667         } else {
12668                 Jim_SetResult_NvpUnknown( goi->interp,
12669                                                                   NULL,
12670                                                                   goi->argv[-1],
12671                                                                   nvptable );
12672         }
12673 }
12674                                            
12675
12676 int 
12677 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12678                                  const char * const *  lookup,
12679                                  int *puthere)
12680 {
12681         int _safe;
12682         Jim_Obj *o;
12683         int e;
12684
12685         if( puthere == NULL ){
12686                 puthere = &_safe;
12687         }
12688         e = Jim_GetOpt_Obj( goi, &o );
12689         if( e == JIM_OK ){
12690                 e = Jim_GetEnum( goi->interp,
12691                                                  o,
12692                                                  lookup,
12693                                                  puthere,
12694                                                  "option",
12695                                                  JIM_ERRMSG );
12696         }
12697         return e;
12698 }
12699         
12700
12701
12702 int
12703 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12704 {
12705         va_list ap;
12706         char *buf;
12707         
12708         va_start(ap,fmt);
12709         buf = jim_vasprintf( fmt, ap );
12710         va_end(ap);
12711         if( buf ){
12712                 Jim_SetResultString( interp, buf, -1 );
12713                 jim_vasprintf_done(buf);
12714         }
12715         return JIM_OK;
12716 }
12717         
12718
12719 void
12720 Jim_SetResult_NvpUnknown( Jim_Interp *interp, 
12721                                                   Jim_Obj *param_name,
12722                                                   Jim_Obj *param_value,
12723                                                   const Jim_Nvp *nvp )
12724 {
12725         if( param_name ){
12726                 Jim_SetResult_sprintf( interp,
12727                                                            "%s: Unknown: %s, try one of: ",
12728                                                            Jim_GetString( param_name, NULL ),
12729                                                            Jim_GetString( param_value, NULL ) );
12730         } else {
12731                 Jim_SetResult_sprintf( interp,
12732                                                            "Unknown param: %s, try one of: ",
12733                                                            Jim_GetString( param_value, NULL ) );
12734         }
12735         while( nvp->name ){
12736                 const char *a;
12737                 const char *b;
12738
12739                 if( (nvp+1)->name ){
12740                         a = nvp->name;
12741                         b = ", ";
12742                 } else {
12743                         a = "or ";
12744                         b = nvp->name;
12745                 }
12746                 Jim_AppendStrings( interp,
12747                                                    Jim_GetResult(interp),
12748                                                    a, b, NULL );
12749                 nvp++;
12750         }
12751 }
12752                                                            
12753
12754 static Jim_Obj *debug_string_obj;
12755
12756 const char *
12757 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12758 {
12759         int x;
12760
12761         if( debug_string_obj ){
12762                 Jim_FreeObj( interp, debug_string_obj );
12763         }
12764
12765         debug_string_obj = Jim_NewEmptyStringObj( interp );
12766         for( x = 0 ; x < argc ; x++ ){
12767                 Jim_AppendStrings( interp,
12768                                                    debug_string_obj,
12769                                                    Jim_GetString( argv[x], NULL ),
12770                                                    " ",
12771                                                    NULL );
12772         }
12773
12774         return Jim_GetString( debug_string_obj, NULL );
12775 }