- added myself to copyright on files i remember adding large contributions for over...
[openocd.git] / 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 }

Linking to existing account procedure

If you already have an account and want to add another login method you MUST first sign in with your existing account and then change URL to read https://review.openocd.org/login/?link to get to this page again but this time it'll work for linking. Thank you.

SSH host keys fingerprints

1024 SHA256:YKx8b7u5ZWdcbp7/4AeXNaqElP49m6QrwfXaqQGJAOk gerrit-code-review@openocd.zylin.com (DSA)
384 SHA256:jHIbSQa4REvwCFG4cq5LBlBLxmxSqelQPem/EXIrxjk gerrit-code-review@openocd.org (ECDSA)
521 SHA256:UAOPYkU9Fjtcao0Ul/Rrlnj/OsQvt+pgdYSZ4jOYdgs gerrit-code-review@openocd.org (ECDSA)
256 SHA256:A13M5QlnozFOvTllybRZH6vm7iSt0XLxbA48yfc2yfY gerrit-code-review@openocd.org (ECDSA)
256 SHA256:spYMBqEYoAOtK7yZBrcwE8ZpYt6b68Cfh9yEVetvbXg gerrit-code-review@openocd.org (ED25519)
+--[ED25519 256]--+
|=..              |
|+o..   .         |
|*.o   . .        |
|+B . . .         |
|Bo. = o S        |
|Oo.+ + =         |
|oB=.* = . o      |
| =+=.+   + E     |
|. .=o   . o      |
+----[SHA256]-----+
2048 SHA256:0Onrb7/PHjpo6iVZ7xQX2riKN83FJ3KGU0TvI0TaFG4 gerrit-code-review@openocd.zylin.com (RSA)