Duane Ellis: "target as an [tcl] object" feature.
[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
61 #include "replacements.h"
62
63 /* Include the platform dependent libraries for
64 * dynamic loading of libraries. */
65 #ifdef JIM_DYNLIB
66 #if defined(_WIN32) || defined(WIN32)
67 #ifndef WIN32
68 #define WIN32 1
69 #endif
70 #ifndef STRICT
71 #define STRICT
72 #endif
73 #define WIN32_LEAN_AND_MEAN
74 #include <windows.h>
75 #if _MSC_VER >= 1000
76 #pragma warning(disable:4146)
77 #endif /* _MSC_VER */
78 #else
79 #include <dlfcn.h>
80 #endif /* WIN32 */
81 #endif /* JIM_DYNLIB */
82
83 #ifdef __ECOS
84 #include <cyg/jimtcl/jim.h>
85 #else
86 #include "jim.h"
87 #endif
88
89 #ifdef HAVE_BACKTRACE
90 #include <execinfo.h>
91 #endif
92
93 /* -----------------------------------------------------------------------------
94 * Global variables
95 * ---------------------------------------------------------------------------*/
96
97 /* A shared empty string for the objects string representation.
98 * Jim_InvalidateStringRep knows about it and don't try to free. */
99 static char *JimEmptyStringRep = (char*) "";
100
101 /* -----------------------------------------------------------------------------
102 * Required prototypes of not exported functions
103 * ---------------------------------------------------------------------------*/
104 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
105 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
106 static void JimRegisterCoreApi(Jim_Interp *interp);
107
108 static Jim_HashTableType JimVariablesHashTableType;
109
110 /* -----------------------------------------------------------------------------
111 * Utility functions
112 * ---------------------------------------------------------------------------*/
113
114 static char *
115 jim_vasprintf( const char *fmt, va_list ap )
116 {
117 #ifndef HAVE_VASPRINTF
118 /* yucky way */
119 static char buf[2048];
120 vsnprintf( buf, sizeof(buf), fmt, ap );
121 /* garentee termination */
122 buf[sizeof(buf)-1] = 0;
123 #else
124 char *buf;
125 vasprintf( &buf, fmt, ap );
126 #endif
127 return buf;
128 }
129
130 static void
131 jim_vasprintf_done( void *buf )
132 {
133 #ifndef HAVE_VASPRINTF
134 (void)(buf);
135 #else
136 free(buf);
137 #endif
138 }
139
140
141 /*
142 * Convert a string to a jim_wide INTEGER.
143 * This function originates from BSD.
144 *
145 * Ignores `locale' stuff. Assumes that the upper and lower case
146 * alphabets and digits are each contiguous.
147 */
148 #ifdef HAVE_LONG_LONG
149 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
150 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
151 {
152 register const char *s;
153 register unsigned jim_wide acc;
154 register unsigned char c;
155 register unsigned jim_wide qbase, cutoff;
156 register int neg, any, cutlim;
157
158 /*
159 * Skip white space and pick up leading +/- sign if any.
160 * If base is 0, allow 0x for hex and 0 for octal, else
161 * assume decimal; if base is already 16, allow 0x.
162 */
163 s = nptr;
164 do {
165 c = *s++;
166 } while (isspace(c));
167 if (c == '-') {
168 neg = 1;
169 c = *s++;
170 } else {
171 neg = 0;
172 if (c == '+')
173 c = *s++;
174 }
175 if ((base == 0 || base == 16) &&
176 c == '0' && (*s == 'x' || *s == 'X')) {
177 c = s[1];
178 s += 2;
179 base = 16;
180 }
181 if (base == 0)
182 base = c == '0' ? 8 : 10;
183
184 /*
185 * Compute the cutoff value between legal numbers and illegal
186 * numbers. That is the largest legal value, divided by the
187 * base. An input number that is greater than this value, if
188 * followed by a legal input character, is too big. One that
189 * is equal to this value may be valid or not; the limit
190 * between valid and invalid numbers is then based on the last
191 * digit. For instance, if the range for quads is
192 * [-9223372036854775808..9223372036854775807] and the input base
193 * is 10, cutoff will be set to 922337203685477580 and cutlim to
194 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
195 * accumulated a value > 922337203685477580, or equal but the
196 * next digit is > 7 (or 8), the number is too big, and we will
197 * return a range error.
198 *
199 * Set any if any `digits' consumed; make it negative to indicate
200 * overflow.
201 */
202 qbase = (unsigned)base;
203 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
204 : LLONG_MAX;
205 cutlim = (int)(cutoff % qbase);
206 cutoff /= qbase;
207 for (acc = 0, any = 0;; c = *s++) {
208 if (!JimIsAscii(c))
209 break;
210 if (isdigit(c))
211 c -= '0';
212 else if (isalpha(c))
213 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
214 else
215 break;
216 if (c >= base)
217 break;
218 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
219 any = -1;
220 else {
221 any = 1;
222 acc *= qbase;
223 acc += c;
224 }
225 }
226 if (any < 0) {
227 acc = neg ? LLONG_MIN : LLONG_MAX;
228 errno = ERANGE;
229 } else if (neg)
230 acc = -acc;
231 if (endptr != 0)
232 *endptr = (char *)(any ? s - 1 : nptr);
233 return (acc);
234 }
235 #endif
236
237 /* Glob-style pattern matching. */
238 static int JimStringMatch(const char *pattern, int patternLen,
239 const char *string, int stringLen, int nocase)
240 {
241 while(patternLen) {
242 switch(pattern[0]) {
243 case '*':
244 while (pattern[1] == '*') {
245 pattern++;
246 patternLen--;
247 }
248 if (patternLen == 1)
249 return 1; /* match */
250 while(stringLen) {
251 if (JimStringMatch(pattern+1, patternLen-1,
252 string, stringLen, nocase))
253 return 1; /* match */
254 string++;
255 stringLen--;
256 }
257 return 0; /* no match */
258 break;
259 case '?':
260 if (stringLen == 0)
261 return 0; /* no match */
262 string++;
263 stringLen--;
264 break;
265 case '[':
266 {
267 int not, match;
268
269 pattern++;
270 patternLen--;
271 not = pattern[0] == '^';
272 if (not) {
273 pattern++;
274 patternLen--;
275 }
276 match = 0;
277 while(1) {
278 if (pattern[0] == '\\') {
279 pattern++;
280 patternLen--;
281 if (pattern[0] == string[0])
282 match = 1;
283 } else if (pattern[0] == ']') {
284 break;
285 } else if (patternLen == 0) {
286 pattern--;
287 patternLen++;
288 break;
289 } else if (pattern[1] == '-' && patternLen >= 3) {
290 int start = pattern[0];
291 int end = pattern[2];
292 int c = string[0];
293 if (start > end) {
294 int t = start;
295 start = end;
296 end = t;
297 }
298 if (nocase) {
299 start = tolower(start);
300 end = tolower(end);
301 c = tolower(c);
302 }
303 pattern += 2;
304 patternLen -= 2;
305 if (c >= start && c <= end)
306 match = 1;
307 } else {
308 if (!nocase) {
309 if (pattern[0] == string[0])
310 match = 1;
311 } else {
312 if (tolower((int)pattern[0]) == tolower((int)string[0]))
313 match = 1;
314 }
315 }
316 pattern++;
317 patternLen--;
318 }
319 if (not)
320 match = !match;
321 if (!match)
322 return 0; /* no match */
323 string++;
324 stringLen--;
325 break;
326 }
327 case '\\':
328 if (patternLen >= 2) {
329 pattern++;
330 patternLen--;
331 }
332 /* fall through */
333 default:
334 if (!nocase) {
335 if (pattern[0] != string[0])
336 return 0; /* no match */
337 } else {
338 if (tolower((int)pattern[0]) != tolower((int)string[0]))
339 return 0; /* no match */
340 }
341 string++;
342 stringLen--;
343 break;
344 }
345 pattern++;
346 patternLen--;
347 if (stringLen == 0) {
348 while(*pattern == '*') {
349 pattern++;
350 patternLen--;
351 }
352 break;
353 }
354 }
355 if (patternLen == 0 && stringLen == 0)
356 return 1;
357 return 0;
358 }
359
360 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
361 int nocase)
362 {
363 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
364
365 if (nocase == 0) {
366 while(l1 && l2) {
367 if (*u1 != *u2)
368 return (int)*u1-*u2;
369 u1++; u2++; l1--; l2--;
370 }
371 if (!l1 && !l2) return 0;
372 return l1-l2;
373 } else {
374 while(l1 && l2) {
375 if (tolower((int)*u1) != tolower((int)*u2))
376 return tolower((int)*u1)-tolower((int)*u2);
377 u1++; u2++; l1--; l2--;
378 }
379 if (!l1 && !l2) return 0;
380 return l1-l2;
381 }
382 }
383
384 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
385 * The index of the first occurrence of s1 in s2 is returned.
386 * If s1 is not found inside s2, -1 is returned. */
387 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
388 {
389 int i;
390
391 if (!l1 || !l2 || l1 > l2) return -1;
392 if (index < 0) index = 0;
393 s2 += index;
394 for (i = index; i <= l2-l1; i++) {
395 if (memcmp(s2, s1, l1) == 0)
396 return i;
397 s2++;
398 }
399 return -1;
400 }
401
402 int Jim_WideToString(char *buf, jim_wide wideValue)
403 {
404 const char *fmt = "%" JIM_WIDE_MODIFIER;
405 return sprintf(buf, fmt, wideValue);
406 }
407
408 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
409 {
410 char *endptr;
411
412 #ifdef HAVE_LONG_LONG
413 *widePtr = JimStrtoll(str, &endptr, base);
414 #else
415 *widePtr = strtol(str, &endptr, base);
416 #endif
417 if ((str[0] == '\0') || (str == endptr) )
418 return JIM_ERR;
419 if (endptr[0] != '\0') {
420 while(*endptr) {
421 if (!isspace((int)*endptr))
422 return JIM_ERR;
423 endptr++;
424 }
425 }
426 return JIM_OK;
427 }
428
429 int Jim_StringToIndex(const char *str, int *intPtr)
430 {
431 char *endptr;
432
433 *intPtr = strtol(str, &endptr, 10);
434 if ( (str[0] == '\0') || (str == endptr) )
435 return JIM_ERR;
436 if (endptr[0] != '\0') {
437 while(*endptr) {
438 if (!isspace((int)*endptr))
439 return JIM_ERR;
440 endptr++;
441 }
442 }
443 return JIM_OK;
444 }
445
446 /* The string representation of references has two features in order
447 * to make the GC faster. The first is that every reference starts
448 * with a non common character '~', in order to make the string matching
449 * fater. The second is that the reference string rep his 32 characters
450 * in length, this allows to avoid to check every object with a string
451 * repr < 32, and usually there are many of this objects. */
452
453 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
454
455 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
456 {
457 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
458 sprintf(buf, fmt, refPtr->tag, id);
459 return JIM_REFERENCE_SPACE;
460 }
461
462 int Jim_DoubleToString(char *buf, double doubleValue)
463 {
464 char *s;
465 int len;
466
467 len = sprintf(buf, "%.17g", doubleValue);
468 s = buf;
469 while(*s) {
470 if (*s == '.') return len;
471 s++;
472 }
473 /* Add a final ".0" if it's a number. But not
474 * for NaN or InF */
475 if (isdigit((int)buf[0])
476 || ((buf[0] == '-' || buf[0] == '+')
477 && isdigit((int)buf[1]))) {
478 s[0] = '.';
479 s[1] = '0';
480 s[2] = '\0';
481 return len+2;
482 }
483 return len;
484 }
485
486 int Jim_StringToDouble(const char *str, double *doublePtr)
487 {
488 char *endptr;
489
490 *doublePtr = strtod(str, &endptr);
491 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
492 return JIM_ERR;
493 return JIM_OK;
494 }
495
496 static jim_wide JimPowWide(jim_wide b, jim_wide e)
497 {
498 jim_wide i, res = 1;
499 if ((b==0 && e!=0) || (e<0)) return 0;
500 for(i=0; i<e; i++) {res *= b;}
501 return res;
502 }
503
504 /* -----------------------------------------------------------------------------
505 * Special functions
506 * ---------------------------------------------------------------------------*/
507
508 /* Note that 'interp' may be NULL if not available in the
509 * context of the panic. It's only useful to get the error
510 * file descriptor, it will default to stderr otherwise. */
511 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
512 {
513 va_list ap;
514
515 va_start(ap, fmt);
516 /*
517 * Send it here first.. Assuming STDIO still works
518 */
519 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
520 vfprintf(stderr, fmt, ap);
521 fprintf(stderr, JIM_NL JIM_NL);
522 va_end(ap);
523
524 #ifdef HAVE_BACKTRACE
525 {
526 void *array[40];
527 int size, i;
528 char **strings;
529
530 size = backtrace(array, 40);
531 strings = backtrace_symbols(array, size);
532 for (i = 0; i < size; i++)
533 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
534 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
535 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
536 }
537 #endif
538
539 /* This may actually crash... we do it last */
540 if( interp && interp->cookie_stderr ){
541 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
542 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
543 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
544 }
545 abort();
546 }
547
548 /* -----------------------------------------------------------------------------
549 * Memory allocation
550 * ---------------------------------------------------------------------------*/
551
552 /* Macro used for memory debugging.
553 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
554 * and similary for Jim_Realloc and Jim_Free */
555 #if 0
556 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
557 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
558 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
559 #endif
560
561 void *Jim_Alloc(int size)
562 {
563 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
564 if (size==0)
565 size=1;
566 void *p = malloc(size);
567 if (p == NULL)
568 Jim_Panic(NULL,"malloc: Out of memory");
569 return p;
570 }
571
572 void Jim_Free(void *ptr) {
573 free(ptr);
574 }
575
576 void *Jim_Realloc(void *ptr, int size)
577 {
578 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
579 if (size==0)
580 size=1;
581 void *p = realloc(ptr, size);
582 if (p == NULL)
583 Jim_Panic(NULL,"realloc: Out of memory");
584 return p;
585 }
586
587 char *Jim_StrDup(const char *s)
588 {
589 int l = strlen(s);
590 char *copy = Jim_Alloc(l+1);
591
592 memcpy(copy, s, l+1);
593 return copy;
594 }
595
596 char *Jim_StrDupLen(const char *s, int l)
597 {
598 char *copy = Jim_Alloc(l+1);
599
600 memcpy(copy, s, l+1);
601 copy[l] = 0; /* Just to be sure, original could be substring */
602 return copy;
603 }
604
605 /* -----------------------------------------------------------------------------
606 * Time related functions
607 * ---------------------------------------------------------------------------*/
608 /* Returns microseconds of CPU used since start. */
609 static jim_wide JimClock(void)
610 {
611 #if (defined WIN32) && !(defined JIM_ANSIC)
612 LARGE_INTEGER t, f;
613 QueryPerformanceFrequency(&f);
614 QueryPerformanceCounter(&t);
615 return (long)((t.QuadPart * 1000000) / f.QuadPart);
616 #else /* !WIN32 */
617 clock_t clocks = clock();
618
619 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
620 #endif /* WIN32 */
621 }
622
623 /* -----------------------------------------------------------------------------
624 * Hash Tables
625 * ---------------------------------------------------------------------------*/
626
627 /* -------------------------- private prototypes ---------------------------- */
628 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
629 static unsigned int JimHashTableNextPower(unsigned int size);
630 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
631
632 /* -------------------------- hash functions -------------------------------- */
633
634 /* Thomas Wang's 32 bit Mix Function */
635 unsigned int Jim_IntHashFunction(unsigned int key)
636 {
637 key += ~(key << 15);
638 key ^= (key >> 10);
639 key += (key << 3);
640 key ^= (key >> 6);
641 key += ~(key << 11);
642 key ^= (key >> 16);
643 return key;
644 }
645
646 /* Identity hash function for integer keys */
647 unsigned int Jim_IdentityHashFunction(unsigned int key)
648 {
649 return key;
650 }
651
652 /* Generic hash function (we are using to multiply by 9 and add the byte
653 * as Tcl) */
654 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
655 {
656 unsigned int h = 0;
657 while(len--)
658 h += (h<<3)+*buf++;
659 return h;
660 }
661
662 /* ----------------------------- API implementation ------------------------- */
663 /* reset an hashtable already initialized with ht_init().
664 * NOTE: This function should only called by ht_destroy(). */
665 static void JimResetHashTable(Jim_HashTable *ht)
666 {
667 ht->table = NULL;
668 ht->size = 0;
669 ht->sizemask = 0;
670 ht->used = 0;
671 ht->collisions = 0;
672 }
673
674 /* Initialize the hash table */
675 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
676 void *privDataPtr)
677 {
678 JimResetHashTable(ht);
679 ht->type = type;
680 ht->privdata = privDataPtr;
681 return JIM_OK;
682 }
683
684 /* Resize the table to the minimal size that contains all the elements,
685 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
686 int Jim_ResizeHashTable(Jim_HashTable *ht)
687 {
688 int minimal = ht->used;
689
690 if (minimal < JIM_HT_INITIAL_SIZE)
691 minimal = JIM_HT_INITIAL_SIZE;
692 return Jim_ExpandHashTable(ht, minimal);
693 }
694
695 /* Expand or create the hashtable */
696 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
697 {
698 Jim_HashTable n; /* the new hashtable */
699 unsigned int realsize = JimHashTableNextPower(size), i;
700
701 /* the size is invalid if it is smaller than the number of
702 * elements already inside the hashtable */
703 if (ht->used >= size)
704 return JIM_ERR;
705
706 Jim_InitHashTable(&n, ht->type, ht->privdata);
707 n.size = realsize;
708 n.sizemask = realsize-1;
709 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
710
711 /* Initialize all the pointers to NULL */
712 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
713
714 /* Copy all the elements from the old to the new table:
715 * note that if the old hash table is empty ht->size is zero,
716 * so Jim_ExpandHashTable just creates an hash table. */
717 n.used = ht->used;
718 for (i = 0; i < ht->size && ht->used > 0; i++) {
719 Jim_HashEntry *he, *nextHe;
720
721 if (ht->table[i] == NULL) continue;
722
723 /* For each hash entry on this slot... */
724 he = ht->table[i];
725 while(he) {
726 unsigned int h;
727
728 nextHe = he->next;
729 /* Get the new element index */
730 h = Jim_HashKey(ht, he->key) & n.sizemask;
731 he->next = n.table[h];
732 n.table[h] = he;
733 ht->used--;
734 /* Pass to the next element */
735 he = nextHe;
736 }
737 }
738 assert(ht->used == 0);
739 Jim_Free(ht->table);
740
741 /* Remap the new hashtable in the old */
742 *ht = n;
743 return JIM_OK;
744 }
745
746 /* Add an element to the target hash table */
747 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
748 {
749 int index;
750 Jim_HashEntry *entry;
751
752 /* Get the index of the new element, or -1 if
753 * the element already exists. */
754 if ((index = JimInsertHashEntry(ht, key)) == -1)
755 return JIM_ERR;
756
757 /* Allocates the memory and stores key */
758 entry = Jim_Alloc(sizeof(*entry));
759 entry->next = ht->table[index];
760 ht->table[index] = entry;
761
762 /* Set the hash entry fields. */
763 Jim_SetHashKey(ht, entry, key);
764 Jim_SetHashVal(ht, entry, val);
765 ht->used++;
766 return JIM_OK;
767 }
768
769 /* Add an element, discarding the old if the key already exists */
770 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
771 {
772 Jim_HashEntry *entry;
773
774 /* Try to add the element. If the key
775 * does not exists Jim_AddHashEntry will suceed. */
776 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
777 return JIM_OK;
778 /* It already exists, get the entry */
779 entry = Jim_FindHashEntry(ht, key);
780 /* Free the old value and set the new one */
781 Jim_FreeEntryVal(ht, entry);
782 Jim_SetHashVal(ht, entry, val);
783 return JIM_OK;
784 }
785
786 /* Search and remove an element */
787 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
788 {
789 unsigned int h;
790 Jim_HashEntry *he, *prevHe;
791
792 if (ht->size == 0)
793 return JIM_ERR;
794 h = Jim_HashKey(ht, key) & ht->sizemask;
795 he = ht->table[h];
796
797 prevHe = NULL;
798 while(he) {
799 if (Jim_CompareHashKeys(ht, key, he->key)) {
800 /* Unlink the element from the list */
801 if (prevHe)
802 prevHe->next = he->next;
803 else
804 ht->table[h] = he->next;
805 Jim_FreeEntryKey(ht, he);
806 Jim_FreeEntryVal(ht, he);
807 Jim_Free(he);
808 ht->used--;
809 return JIM_OK;
810 }
811 prevHe = he;
812 he = he->next;
813 }
814 return JIM_ERR; /* not found */
815 }
816
817 /* Destroy an entire hash table */
818 int Jim_FreeHashTable(Jim_HashTable *ht)
819 {
820 unsigned int i;
821
822 /* Free all the elements */
823 for (i = 0; i < ht->size && ht->used > 0; i++) {
824 Jim_HashEntry *he, *nextHe;
825
826 if ((he = ht->table[i]) == NULL) continue;
827 while(he) {
828 nextHe = he->next;
829 Jim_FreeEntryKey(ht, he);
830 Jim_FreeEntryVal(ht, he);
831 Jim_Free(he);
832 ht->used--;
833 he = nextHe;
834 }
835 }
836 /* Free the table and the allocated cache structure */
837 Jim_Free(ht->table);
838 /* Re-initialize the table */
839 JimResetHashTable(ht);
840 return JIM_OK; /* never fails */
841 }
842
843 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
844 {
845 Jim_HashEntry *he;
846 unsigned int h;
847
848 if (ht->size == 0) return NULL;
849 h = Jim_HashKey(ht, key) & ht->sizemask;
850 he = ht->table[h];
851 while(he) {
852 if (Jim_CompareHashKeys(ht, key, he->key))
853 return he;
854 he = he->next;
855 }
856 return NULL;
857 }
858
859 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
860 {
861 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
862
863 iter->ht = ht;
864 iter->index = -1;
865 iter->entry = NULL;
866 iter->nextEntry = NULL;
867 return iter;
868 }
869
870 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
871 {
872 while (1) {
873 if (iter->entry == NULL) {
874 iter->index++;
875 if (iter->index >=
876 (signed)iter->ht->size) break;
877 iter->entry = iter->ht->table[iter->index];
878 } else {
879 iter->entry = iter->nextEntry;
880 }
881 if (iter->entry) {
882 /* We need to save the 'next' here, the iterator user
883 * may delete the entry we are returning. */
884 iter->nextEntry = iter->entry->next;
885 return iter->entry;
886 }
887 }
888 return NULL;
889 }
890
891 /* ------------------------- private functions ------------------------------ */
892
893 /* Expand the hash table if needed */
894 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
895 {
896 /* If the hash table is empty expand it to the intial size,
897 * if the table is "full" dobule its size. */
898 if (ht->size == 0)
899 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
900 if (ht->size == ht->used)
901 return Jim_ExpandHashTable(ht, ht->size*2);
902 return JIM_OK;
903 }
904
905 /* Our hash table capability is a power of two */
906 static unsigned int JimHashTableNextPower(unsigned int size)
907 {
908 unsigned int i = JIM_HT_INITIAL_SIZE;
909
910 if (size >= 2147483648U)
911 return 2147483648U;
912 while(1) {
913 if (i >= size)
914 return i;
915 i *= 2;
916 }
917 }
918
919 /* Returns the index of a free slot that can be populated with
920 * an hash entry for the given 'key'.
921 * If the key already exists, -1 is returned. */
922 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
923 {
924 unsigned int h;
925 Jim_HashEntry *he;
926
927 /* Expand the hashtable if needed */
928 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
929 return -1;
930 /* Compute the key hash value */
931 h = Jim_HashKey(ht, key) & ht->sizemask;
932 /* Search if this slot does not already contain the given key */
933 he = ht->table[h];
934 while(he) {
935 if (Jim_CompareHashKeys(ht, key, he->key))
936 return -1;
937 he = he->next;
938 }
939 return h;
940 }
941
942 /* ----------------------- StringCopy Hash Table Type ------------------------*/
943
944 static unsigned int JimStringCopyHTHashFunction(const void *key)
945 {
946 return Jim_GenHashFunction(key, strlen(key));
947 }
948
949 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
950 {
951 int len = strlen(key);
952 char *copy = Jim_Alloc(len+1);
953 JIM_NOTUSED(privdata);
954
955 memcpy(copy, key, len);
956 copy[len] = '\0';
957 return copy;
958 }
959
960 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
961 {
962 int len = strlen(val);
963 char *copy = Jim_Alloc(len+1);
964 JIM_NOTUSED(privdata);
965
966 memcpy(copy, val, len);
967 copy[len] = '\0';
968 return copy;
969 }
970
971 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
972 const void *key2)
973 {
974 JIM_NOTUSED(privdata);
975
976 return strcmp(key1, key2) == 0;
977 }
978
979 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
980 {
981 JIM_NOTUSED(privdata);
982
983 Jim_Free((void*)key); /* ATTENTION: const cast */
984 }
985
986 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
987 {
988 JIM_NOTUSED(privdata);
989
990 Jim_Free((void*)val); /* ATTENTION: const cast */
991 }
992
993 static Jim_HashTableType JimStringCopyHashTableType = {
994 JimStringCopyHTHashFunction, /* hash function */
995 JimStringCopyHTKeyDup, /* key dup */
996 NULL, /* val dup */
997 JimStringCopyHTKeyCompare, /* key compare */
998 JimStringCopyHTKeyDestructor, /* key destructor */
999 NULL /* val destructor */
1000 };
1001
1002 /* This is like StringCopy but does not auto-duplicate the key.
1003 * It's used for intepreter's shared strings. */
1004 static Jim_HashTableType JimSharedStringsHashTableType = {
1005 JimStringCopyHTHashFunction, /* hash function */
1006 NULL, /* key dup */
1007 NULL, /* val dup */
1008 JimStringCopyHTKeyCompare, /* key compare */
1009 JimStringCopyHTKeyDestructor, /* key destructor */
1010 NULL /* val destructor */
1011 };
1012
1013 /* This is like StringCopy but also automatically handle dynamic
1014 * allocated C strings as values. */
1015 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1016 JimStringCopyHTHashFunction, /* hash function */
1017 JimStringCopyHTKeyDup, /* key dup */
1018 JimStringKeyValCopyHTValDup, /* val dup */
1019 JimStringCopyHTKeyCompare, /* key compare */
1020 JimStringCopyHTKeyDestructor, /* key destructor */
1021 JimStringKeyValCopyHTValDestructor, /* val destructor */
1022 };
1023
1024 typedef struct AssocDataValue {
1025 Jim_InterpDeleteProc *delProc;
1026 void *data;
1027 } AssocDataValue;
1028
1029 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1030 {
1031 AssocDataValue *assocPtr = (AssocDataValue *)data;
1032 if (assocPtr->delProc != NULL)
1033 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1034 Jim_Free(data);
1035 }
1036
1037 static Jim_HashTableType JimAssocDataHashTableType = {
1038 JimStringCopyHTHashFunction, /* hash function */
1039 JimStringCopyHTKeyDup, /* key dup */
1040 NULL, /* val dup */
1041 JimStringCopyHTKeyCompare, /* key compare */
1042 JimStringCopyHTKeyDestructor, /* key destructor */
1043 JimAssocDataHashTableValueDestructor /* val destructor */
1044 };
1045
1046 /* -----------------------------------------------------------------------------
1047 * Stack - This is a simple generic stack implementation. It is used for
1048 * example in the 'expr' expression compiler.
1049 * ---------------------------------------------------------------------------*/
1050 void Jim_InitStack(Jim_Stack *stack)
1051 {
1052 stack->len = 0;
1053 stack->maxlen = 0;
1054 stack->vector = NULL;
1055 }
1056
1057 void Jim_FreeStack(Jim_Stack *stack)
1058 {
1059 Jim_Free(stack->vector);
1060 }
1061
1062 int Jim_StackLen(Jim_Stack *stack)
1063 {
1064 return stack->len;
1065 }
1066
1067 void Jim_StackPush(Jim_Stack *stack, void *element) {
1068 int neededLen = stack->len+1;
1069 if (neededLen > stack->maxlen) {
1070 stack->maxlen = neededLen*2;
1071 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1072 }
1073 stack->vector[stack->len] = element;
1074 stack->len++;
1075 }
1076
1077 void *Jim_StackPop(Jim_Stack *stack)
1078 {
1079 if (stack->len == 0) return NULL;
1080 stack->len--;
1081 return stack->vector[stack->len];
1082 }
1083
1084 void *Jim_StackPeek(Jim_Stack *stack)
1085 {
1086 if (stack->len == 0) return NULL;
1087 return stack->vector[stack->len-1];
1088 }
1089
1090 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1091 {
1092 int i;
1093
1094 for (i = 0; i < stack->len; i++)
1095 freeFunc(stack->vector[i]);
1096 }
1097
1098 /* -----------------------------------------------------------------------------
1099 * Parser
1100 * ---------------------------------------------------------------------------*/
1101
1102 /* Token types */
1103 #define JIM_TT_NONE -1 /* No token returned */
1104 #define JIM_TT_STR 0 /* simple string */
1105 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1106 #define JIM_TT_VAR 2 /* var substitution */
1107 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1108 #define JIM_TT_CMD 4 /* command substitution */
1109 #define JIM_TT_SEP 5 /* word separator */
1110 #define JIM_TT_EOL 6 /* line separator */
1111
1112 /* Additional token types needed for expressions */
1113 #define JIM_TT_SUBEXPR_START 7
1114 #define JIM_TT_SUBEXPR_END 8
1115 #define JIM_TT_EXPR_NUMBER 9
1116 #define JIM_TT_EXPR_OPERATOR 10
1117
1118 /* Parser states */
1119 #define JIM_PS_DEF 0 /* Default state */
1120 #define JIM_PS_QUOTE 1 /* Inside "" */
1121
1122 /* Parser context structure. The same context is used both to parse
1123 * Tcl scripts and lists. */
1124 struct JimParserCtx {
1125 const char *prg; /* Program text */
1126 const char *p; /* Pointer to the point of the program we are parsing */
1127 int len; /* Left length of 'prg' */
1128 int linenr; /* Current line number */
1129 const char *tstart;
1130 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1131 int tline; /* Line number of the returned token */
1132 int tt; /* Token type */
1133 int eof; /* Non zero if EOF condition is true. */
1134 int state; /* Parser state */
1135 int comment; /* Non zero if the next chars may be a comment. */
1136 };
1137
1138 #define JimParserEof(c) ((c)->eof)
1139 #define JimParserTstart(c) ((c)->tstart)
1140 #define JimParserTend(c) ((c)->tend)
1141 #define JimParserTtype(c) ((c)->tt)
1142 #define JimParserTline(c) ((c)->tline)
1143
1144 static int JimParseScript(struct JimParserCtx *pc);
1145 static int JimParseSep(struct JimParserCtx *pc);
1146 static int JimParseEol(struct JimParserCtx *pc);
1147 static int JimParseCmd(struct JimParserCtx *pc);
1148 static int JimParseVar(struct JimParserCtx *pc);
1149 static int JimParseBrace(struct JimParserCtx *pc);
1150 static int JimParseStr(struct JimParserCtx *pc);
1151 static int JimParseComment(struct JimParserCtx *pc);
1152 static char *JimParserGetToken(struct JimParserCtx *pc,
1153 int *lenPtr, int *typePtr, int *linePtr);
1154
1155 /* Initialize a parser context.
1156 * 'prg' is a pointer to the program text, linenr is the line
1157 * number of the first line contained in the program. */
1158 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1159 int len, int linenr)
1160 {
1161 pc->prg = prg;
1162 pc->p = prg;
1163 pc->len = len;
1164 pc->tstart = NULL;
1165 pc->tend = NULL;
1166 pc->tline = 0;
1167 pc->tt = JIM_TT_NONE;
1168 pc->eof = 0;
1169 pc->state = JIM_PS_DEF;
1170 pc->linenr = linenr;
1171 pc->comment = 1;
1172 }
1173
1174 int JimParseScript(struct JimParserCtx *pc)
1175 {
1176 while(1) { /* the while is used to reiterate with continue if needed */
1177 if (!pc->len) {
1178 pc->tstart = pc->p;
1179 pc->tend = pc->p-1;
1180 pc->tline = pc->linenr;
1181 pc->tt = JIM_TT_EOL;
1182 pc->eof = 1;
1183 return JIM_OK;
1184 }
1185 switch(*(pc->p)) {
1186 case '\\':
1187 if (*(pc->p+1) == '\n')
1188 return JimParseSep(pc);
1189 else {
1190 pc->comment = 0;
1191 return JimParseStr(pc);
1192 }
1193 break;
1194 case ' ':
1195 case '\t':
1196 case '\r':
1197 if (pc->state == JIM_PS_DEF)
1198 return JimParseSep(pc);
1199 else {
1200 pc->comment = 0;
1201 return JimParseStr(pc);
1202 }
1203 break;
1204 case '\n':
1205 case ';':
1206 pc->comment = 1;
1207 if (pc->state == JIM_PS_DEF)
1208 return JimParseEol(pc);
1209 else
1210 return JimParseStr(pc);
1211 break;
1212 case '[':
1213 pc->comment = 0;
1214 return JimParseCmd(pc);
1215 break;
1216 case '$':
1217 pc->comment = 0;
1218 if (JimParseVar(pc) == JIM_ERR) {
1219 pc->tstart = pc->tend = pc->p++; pc->len--;
1220 pc->tline = pc->linenr;
1221 pc->tt = JIM_TT_STR;
1222 return JIM_OK;
1223 } else
1224 return JIM_OK;
1225 break;
1226 case '#':
1227 if (pc->comment) {
1228 JimParseComment(pc);
1229 continue;
1230 } else {
1231 return JimParseStr(pc);
1232 }
1233 default:
1234 pc->comment = 0;
1235 return JimParseStr(pc);
1236 break;
1237 }
1238 return JIM_OK;
1239 }
1240 }
1241
1242 int JimParseSep(struct JimParserCtx *pc)
1243 {
1244 pc->tstart = pc->p;
1245 pc->tline = pc->linenr;
1246 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1247 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1248 if (*pc->p == '\\') {
1249 pc->p++; pc->len--;
1250 pc->linenr++;
1251 }
1252 pc->p++; pc->len--;
1253 }
1254 pc->tend = pc->p-1;
1255 pc->tt = JIM_TT_SEP;
1256 return JIM_OK;
1257 }
1258
1259 int JimParseEol(struct JimParserCtx *pc)
1260 {
1261 pc->tstart = pc->p;
1262 pc->tline = pc->linenr;
1263 while (*pc->p == ' ' || *pc->p == '\n' ||
1264 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1265 if (*pc->p == '\n')
1266 pc->linenr++;
1267 pc->p++; pc->len--;
1268 }
1269 pc->tend = pc->p-1;
1270 pc->tt = JIM_TT_EOL;
1271 return JIM_OK;
1272 }
1273
1274 /* Todo. Don't stop if ']' appears inside {} or quoted.
1275 * Also should handle the case of puts [string length "]"] */
1276 int JimParseCmd(struct JimParserCtx *pc)
1277 {
1278 int level = 1;
1279 int blevel = 0;
1280
1281 pc->tstart = ++pc->p; pc->len--;
1282 pc->tline = pc->linenr;
1283 while (1) {
1284 if (pc->len == 0) {
1285 break;
1286 } else if (*pc->p == '[' && blevel == 0) {
1287 level++;
1288 } else if (*pc->p == ']' && blevel == 0) {
1289 level--;
1290 if (!level) break;
1291 } else if (*pc->p == '\\') {
1292 pc->p++; pc->len--;
1293 } else if (*pc->p == '{') {
1294 blevel++;
1295 } else if (*pc->p == '}') {
1296 if (blevel != 0)
1297 blevel--;
1298 } else if (*pc->p == '\n')
1299 pc->linenr++;
1300 pc->p++; pc->len--;
1301 }
1302 pc->tend = pc->p-1;
1303 pc->tt = JIM_TT_CMD;
1304 if (*pc->p == ']') {
1305 pc->p++; pc->len--;
1306 }
1307 return JIM_OK;
1308 }
1309
1310 int JimParseVar(struct JimParserCtx *pc)
1311 {
1312 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1313
1314 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1315 pc->tline = pc->linenr;
1316 if (*pc->p == '{') {
1317 pc->tstart = ++pc->p; pc->len--;
1318 brace = 1;
1319 }
1320 if (brace) {
1321 while (!stop) {
1322 if (*pc->p == '}' || pc->len == 0) {
1323 stop = 1;
1324 if (pc->len == 0)
1325 continue;
1326 }
1327 else if (*pc->p == '\n')
1328 pc->linenr++;
1329 pc->p++; pc->len--;
1330 }
1331 if (pc->len == 0)
1332 pc->tend = pc->p-1;
1333 else
1334 pc->tend = pc->p-2;
1335 } else {
1336 while (!stop) {
1337 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1338 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1339 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1340 stop = 1;
1341 else {
1342 pc->p++; pc->len--;
1343 }
1344 }
1345 /* Parse [dict get] syntax sugar. */
1346 if (*pc->p == '(') {
1347 while (*pc->p != ')' && pc->len) {
1348 pc->p++; pc->len--;
1349 if (*pc->p == '\\' && pc->len >= 2) {
1350 pc->p += 2; pc->len -= 2;
1351 }
1352 }
1353 if (*pc->p != '\0') {
1354 pc->p++; pc->len--;
1355 }
1356 ttype = JIM_TT_DICTSUGAR;
1357 }
1358 pc->tend = pc->p-1;
1359 }
1360 /* Check if we parsed just the '$' character.
1361 * That's not a variable so an error is returned
1362 * to tell the state machine to consider this '$' just
1363 * a string. */
1364 if (pc->tstart == pc->p) {
1365 pc->p--; pc->len++;
1366 return JIM_ERR;
1367 }
1368 pc->tt = ttype;
1369 return JIM_OK;
1370 }
1371
1372 int JimParseBrace(struct JimParserCtx *pc)
1373 {
1374 int level = 1;
1375
1376 pc->tstart = ++pc->p; pc->len--;
1377 pc->tline = pc->linenr;
1378 while (1) {
1379 if (*pc->p == '\\' && pc->len >= 2) {
1380 pc->p++; pc->len--;
1381 if (*pc->p == '\n')
1382 pc->linenr++;
1383 } else if (*pc->p == '{') {
1384 level++;
1385 } else if (pc->len == 0 || *pc->p == '}') {
1386 level--;
1387 if (pc->len == 0 || level == 0) {
1388 pc->tend = pc->p-1;
1389 if (pc->len != 0) {
1390 pc->p++; pc->len--;
1391 }
1392 pc->tt = JIM_TT_STR;
1393 return JIM_OK;
1394 }
1395 } else if (*pc->p == '\n') {
1396 pc->linenr++;
1397 }
1398 pc->p++; pc->len--;
1399 }
1400 return JIM_OK; /* unreached */
1401 }
1402
1403 int JimParseStr(struct JimParserCtx *pc)
1404 {
1405 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1406 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1407 if (newword && *pc->p == '{') {
1408 return JimParseBrace(pc);
1409 } else if (newword && *pc->p == '"') {
1410 pc->state = JIM_PS_QUOTE;
1411 pc->p++; pc->len--;
1412 }
1413 pc->tstart = pc->p;
1414 pc->tline = pc->linenr;
1415 while (1) {
1416 if (pc->len == 0) {
1417 pc->tend = pc->p-1;
1418 pc->tt = JIM_TT_ESC;
1419 return JIM_OK;
1420 }
1421 switch(*pc->p) {
1422 case '\\':
1423 if (pc->state == JIM_PS_DEF &&
1424 *(pc->p+1) == '\n') {
1425 pc->tend = pc->p-1;
1426 pc->tt = JIM_TT_ESC;
1427 return JIM_OK;
1428 }
1429 if (pc->len >= 2) {
1430 pc->p++; pc->len--;
1431 }
1432 break;
1433 case '$':
1434 case '[':
1435 pc->tend = pc->p-1;
1436 pc->tt = JIM_TT_ESC;
1437 return JIM_OK;
1438 case ' ':
1439 case '\t':
1440 case '\n':
1441 case '\r':
1442 case ';':
1443 if (pc->state == JIM_PS_DEF) {
1444 pc->tend = pc->p-1;
1445 pc->tt = JIM_TT_ESC;
1446 return JIM_OK;
1447 } else if (*pc->p == '\n') {
1448 pc->linenr++;
1449 }
1450 break;
1451 case '"':
1452 if (pc->state == JIM_PS_QUOTE) {
1453 pc->tend = pc->p-1;
1454 pc->tt = JIM_TT_ESC;
1455 pc->p++; pc->len--;
1456 pc->state = JIM_PS_DEF;
1457 return JIM_OK;
1458 }
1459 break;
1460 }
1461 pc->p++; pc->len--;
1462 }
1463 return JIM_OK; /* unreached */
1464 }
1465
1466 int JimParseComment(struct JimParserCtx *pc)
1467 {
1468 while (*pc->p) {
1469 if (*pc->p == '\n') {
1470 pc->linenr++;
1471 if (*(pc->p-1) != '\\') {
1472 pc->p++; pc->len--;
1473 return JIM_OK;
1474 }
1475 }
1476 pc->p++; pc->len--;
1477 }
1478 return JIM_OK;
1479 }
1480
1481 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1482 static int xdigitval(int c)
1483 {
1484 if (c >= '0' && c <= '9') return c-'0';
1485 if (c >= 'a' && c <= 'f') return c-'a'+10;
1486 if (c >= 'A' && c <= 'F') return c-'A'+10;
1487 return -1;
1488 }
1489
1490 static int odigitval(int c)
1491 {
1492 if (c >= '0' && c <= '7') return c-'0';
1493 return -1;
1494 }
1495
1496 /* Perform Tcl escape substitution of 's', storing the result
1497 * string into 'dest'. The escaped string is guaranteed to
1498 * be the same length or shorted than the source string.
1499 * Slen is the length of the string at 's', if it's -1 the string
1500 * length will be calculated by the function.
1501 *
1502 * The function returns the length of the resulting string. */
1503 static int JimEscape(char *dest, const char *s, int slen)
1504 {
1505 char *p = dest;
1506 int i, len;
1507
1508 if (slen == -1)
1509 slen = strlen(s);
1510
1511 for (i = 0; i < slen; i++) {
1512 switch(s[i]) {
1513 case '\\':
1514 switch(s[i+1]) {
1515 case 'a': *p++ = 0x7; i++; break;
1516 case 'b': *p++ = 0x8; i++; break;
1517 case 'f': *p++ = 0xc; i++; break;
1518 case 'n': *p++ = 0xa; i++; break;
1519 case 'r': *p++ = 0xd; i++; break;
1520 case 't': *p++ = 0x9; i++; break;
1521 case 'v': *p++ = 0xb; i++; break;
1522 case '\0': *p++ = '\\'; i++; break;
1523 case '\n': *p++ = ' '; i++; break;
1524 default:
1525 if (s[i+1] == 'x') {
1526 int val = 0;
1527 int c = xdigitval(s[i+2]);
1528 if (c == -1) {
1529 *p++ = 'x';
1530 i++;
1531 break;
1532 }
1533 val = c;
1534 c = xdigitval(s[i+3]);
1535 if (c == -1) {
1536 *p++ = val;
1537 i += 2;
1538 break;
1539 }
1540 val = (val*16)+c;
1541 *p++ = val;
1542 i += 3;
1543 break;
1544 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1545 {
1546 int val = 0;
1547 int c = odigitval(s[i+1]);
1548 val = c;
1549 c = odigitval(s[i+2]);
1550 if (c == -1) {
1551 *p++ = val;
1552 i ++;
1553 break;
1554 }
1555 val = (val*8)+c;
1556 c = odigitval(s[i+3]);
1557 if (c == -1) {
1558 *p++ = val;
1559 i += 2;
1560 break;
1561 }
1562 val = (val*8)+c;
1563 *p++ = val;
1564 i += 3;
1565 } else {
1566 *p++ = s[i+1];
1567 i++;
1568 }
1569 break;
1570 }
1571 break;
1572 default:
1573 *p++ = s[i];
1574 break;
1575 }
1576 }
1577 len = p-dest;
1578 *p++ = '\0';
1579 return len;
1580 }
1581
1582 /* Returns a dynamically allocated copy of the current token in the
1583 * parser context. The function perform conversion of escapes if
1584 * the token is of type JIM_TT_ESC.
1585 *
1586 * Note that after the conversion, tokens that are grouped with
1587 * braces in the source code, are always recognizable from the
1588 * identical string obtained in a different way from the type.
1589 *
1590 * For exmple the string:
1591 *
1592 * {expand}$a
1593 *
1594 * will return as first token "expand", of type JIM_TT_STR
1595 *
1596 * While the string:
1597 *
1598 * expand$a
1599 *
1600 * will return as first token "expand", of type JIM_TT_ESC
1601 */
1602 char *JimParserGetToken(struct JimParserCtx *pc,
1603 int *lenPtr, int *typePtr, int *linePtr)
1604 {
1605 const char *start, *end;
1606 char *token;
1607 int len;
1608
1609 start = JimParserTstart(pc);
1610 end = JimParserTend(pc);
1611 if (start > end) {
1612 if (lenPtr) *lenPtr = 0;
1613 if (typePtr) *typePtr = JimParserTtype(pc);
1614 if (linePtr) *linePtr = JimParserTline(pc);
1615 token = Jim_Alloc(1);
1616 token[0] = '\0';
1617 return token;
1618 }
1619 len = (end-start)+1;
1620 token = Jim_Alloc(len+1);
1621 if (JimParserTtype(pc) != JIM_TT_ESC) {
1622 /* No escape conversion needed? Just copy it. */
1623 memcpy(token, start, len);
1624 token[len] = '\0';
1625 } else {
1626 /* Else convert the escape chars. */
1627 len = JimEscape(token, start, len);
1628 }
1629 if (lenPtr) *lenPtr = len;
1630 if (typePtr) *typePtr = JimParserTtype(pc);
1631 if (linePtr) *linePtr = JimParserTline(pc);
1632 return token;
1633 }
1634
1635 /* The following functin is not really part of the parsing engine of Jim,
1636 * but it somewhat related. Given an string and its length, it tries
1637 * to guess if the script is complete or there are instead " " or { }
1638 * open and not completed. This is useful for interactive shells
1639 * implementation and for [info complete].
1640 *
1641 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1642 * '{' on scripts incomplete missing one or more '}' to be balanced.
1643 * '"' on scripts incomplete missing a '"' char.
1644 *
1645 * If the script is complete, 1 is returned, otherwise 0. */
1646 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1647 {
1648 int level = 0;
1649 int state = ' ';
1650
1651 while(len) {
1652 switch (*s) {
1653 case '\\':
1654 if (len > 1)
1655 s++;
1656 break;
1657 case '"':
1658 if (state == ' ') {
1659 state = '"';
1660 } else if (state == '"') {
1661 state = ' ';
1662 }
1663 break;
1664 case '{':
1665 if (state == '{') {
1666 level++;
1667 } else if (state == ' ') {
1668 state = '{';
1669 level++;
1670 }
1671 break;
1672 case '}':
1673 if (state == '{') {
1674 level--;
1675 if (level == 0)
1676 state = ' ';
1677 }
1678 break;
1679 }
1680 s++;
1681 len--;
1682 }
1683 if (stateCharPtr)
1684 *stateCharPtr = state;
1685 return state == ' ';
1686 }
1687
1688 /* -----------------------------------------------------------------------------
1689 * Tcl Lists parsing
1690 * ---------------------------------------------------------------------------*/
1691 static int JimParseListSep(struct JimParserCtx *pc);
1692 static int JimParseListStr(struct JimParserCtx *pc);
1693
1694 int JimParseList(struct JimParserCtx *pc)
1695 {
1696 if (pc->len == 0) {
1697 pc->tstart = pc->tend = pc->p;
1698 pc->tline = pc->linenr;
1699 pc->tt = JIM_TT_EOL;
1700 pc->eof = 1;
1701 return JIM_OK;
1702 }
1703 switch(*pc->p) {
1704 case ' ':
1705 case '\n':
1706 case '\t':
1707 case '\r':
1708 if (pc->state == JIM_PS_DEF)
1709 return JimParseListSep(pc);
1710 else
1711 return JimParseListStr(pc);
1712 break;
1713 default:
1714 return JimParseListStr(pc);
1715 break;
1716 }
1717 return JIM_OK;
1718 }
1719
1720 int JimParseListSep(struct JimParserCtx *pc)
1721 {
1722 pc->tstart = pc->p;
1723 pc->tline = pc->linenr;
1724 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1725 {
1726 pc->p++; pc->len--;
1727 }
1728 pc->tend = pc->p-1;
1729 pc->tt = JIM_TT_SEP;
1730 return JIM_OK;
1731 }
1732
1733 int JimParseListStr(struct JimParserCtx *pc)
1734 {
1735 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1736 pc->tt == JIM_TT_NONE);
1737 if (newword && *pc->p == '{') {
1738 return JimParseBrace(pc);
1739 } else if (newword && *pc->p == '"') {
1740 pc->state = JIM_PS_QUOTE;
1741 pc->p++; pc->len--;
1742 }
1743 pc->tstart = pc->p;
1744 pc->tline = pc->linenr;
1745 while (1) {
1746 if (pc->len == 0) {
1747 pc->tend = pc->p-1;
1748 pc->tt = JIM_TT_ESC;
1749 return JIM_OK;
1750 }
1751 switch(*pc->p) {
1752 case '\\':
1753 pc->p++; pc->len--;
1754 break;
1755 case ' ':
1756 case '\t':
1757 case '\n':
1758 case '\r':
1759 if (pc->state == JIM_PS_DEF) {
1760 pc->tend = pc->p-1;
1761 pc->tt = JIM_TT_ESC;
1762 return JIM_OK;
1763 } else if (*pc->p == '\n') {
1764 pc->linenr++;
1765 }
1766 break;
1767 case '"':
1768 if (pc->state == JIM_PS_QUOTE) {
1769 pc->tend = pc->p-1;
1770 pc->tt = JIM_TT_ESC;
1771 pc->p++; pc->len--;
1772 pc->state = JIM_PS_DEF;
1773 return JIM_OK;
1774 }
1775 break;
1776 }
1777 pc->p++; pc->len--;
1778 }
1779 return JIM_OK; /* unreached */
1780 }
1781
1782 /* -----------------------------------------------------------------------------
1783 * Jim_Obj related functions
1784 * ---------------------------------------------------------------------------*/
1785
1786 /* Return a new initialized object. */
1787 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1788 {
1789 Jim_Obj *objPtr;
1790
1791 /* -- Check if there are objects in the free list -- */
1792 if (interp->freeList != NULL) {
1793 /* -- Unlink the object from the free list -- */
1794 objPtr = interp->freeList;
1795 interp->freeList = objPtr->nextObjPtr;
1796 } else {
1797 /* -- No ready to use objects: allocate a new one -- */
1798 objPtr = Jim_Alloc(sizeof(*objPtr));
1799 }
1800
1801 /* Object is returned with refCount of 0. Every
1802 * kind of GC implemented should take care to don't try
1803 * to scan objects with refCount == 0. */
1804 objPtr->refCount = 0;
1805 /* All the other fields are left not initialized to save time.
1806 * The caller will probably want set they to the right
1807 * value anyway. */
1808
1809 /* -- Put the object into the live list -- */
1810 objPtr->prevObjPtr = NULL;
1811 objPtr->nextObjPtr = interp->liveList;
1812 if (interp->liveList)
1813 interp->liveList->prevObjPtr = objPtr;
1814 interp->liveList = objPtr;
1815
1816 return objPtr;
1817 }
1818
1819 /* Free an object. Actually objects are never freed, but
1820 * just moved to the free objects list, where they will be
1821 * reused by Jim_NewObj(). */
1822 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1823 {
1824 /* Check if the object was already freed, panic. */
1825 if (objPtr->refCount != 0) {
1826 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1827 objPtr->refCount);
1828 }
1829 /* Free the internal representation */
1830 Jim_FreeIntRep(interp, objPtr);
1831 /* Free the string representation */
1832 if (objPtr->bytes != NULL) {
1833 if (objPtr->bytes != JimEmptyStringRep)
1834 Jim_Free(objPtr->bytes);
1835 }
1836 /* Unlink the object from the live objects list */
1837 if (objPtr->prevObjPtr)
1838 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1839 if (objPtr->nextObjPtr)
1840 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1841 if (interp->liveList == objPtr)
1842 interp->liveList = objPtr->nextObjPtr;
1843 /* Link the object into the free objects list */
1844 objPtr->prevObjPtr = NULL;
1845 objPtr->nextObjPtr = interp->freeList;
1846 if (interp->freeList)
1847 interp->freeList->prevObjPtr = objPtr;
1848 interp->freeList = objPtr;
1849 objPtr->refCount = -1;
1850 }
1851
1852 /* Invalidate the string representation of an object. */
1853 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1854 {
1855 if (objPtr->bytes != NULL) {
1856 if (objPtr->bytes != JimEmptyStringRep)
1857 Jim_Free(objPtr->bytes);
1858 }
1859 objPtr->bytes = NULL;
1860 }
1861
1862 #define Jim_SetStringRep(o, b, l) \
1863 do { (o)->bytes = b; (o)->length = l; } while (0)
1864
1865 /* Set the initial string representation for an object.
1866 * Does not try to free an old one. */
1867 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1868 {
1869 if (length == 0) {
1870 objPtr->bytes = JimEmptyStringRep;
1871 objPtr->length = 0;
1872 } else {
1873 objPtr->bytes = Jim_Alloc(length+1);
1874 objPtr->length = length;
1875 memcpy(objPtr->bytes, bytes, length);
1876 objPtr->bytes[length] = '\0';
1877 }
1878 }
1879
1880 /* Duplicate an object. The returned object has refcount = 0. */
1881 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1882 {
1883 Jim_Obj *dupPtr;
1884
1885 dupPtr = Jim_NewObj(interp);
1886 if (objPtr->bytes == NULL) {
1887 /* Object does not have a valid string representation. */
1888 dupPtr->bytes = NULL;
1889 } else {
1890 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1891 }
1892 if (objPtr->typePtr != NULL) {
1893 if (objPtr->typePtr->dupIntRepProc == NULL) {
1894 dupPtr->internalRep = objPtr->internalRep;
1895 } else {
1896 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1897 }
1898 dupPtr->typePtr = objPtr->typePtr;
1899 } else {
1900 dupPtr->typePtr = NULL;
1901 }
1902 return dupPtr;
1903 }
1904
1905 /* Return the string representation for objPtr. If the object
1906 * string representation is invalid, calls the method to create
1907 * a new one starting from the internal representation of the object. */
1908 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1909 {
1910 if (objPtr->bytes == NULL) {
1911 /* Invalid string repr. Generate it. */
1912 if (objPtr->typePtr->updateStringProc == NULL) {
1913 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1914 objPtr->typePtr->name);
1915 }
1916 objPtr->typePtr->updateStringProc(objPtr);
1917 }
1918 if (lenPtr)
1919 *lenPtr = objPtr->length;
1920 return objPtr->bytes;
1921 }
1922
1923 /* Just returns the length of the object's string rep */
1924 int Jim_Length(Jim_Obj *objPtr)
1925 {
1926 int len;
1927
1928 Jim_GetString(objPtr, &len);
1929 return len;
1930 }
1931
1932 /* -----------------------------------------------------------------------------
1933 * String Object
1934 * ---------------------------------------------------------------------------*/
1935 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1936 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1937
1938 static Jim_ObjType stringObjType = {
1939 "string",
1940 NULL,
1941 DupStringInternalRep,
1942 NULL,
1943 JIM_TYPE_REFERENCES,
1944 };
1945
1946 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1947 {
1948 JIM_NOTUSED(interp);
1949
1950 /* This is a bit subtle: the only caller of this function
1951 * should be Jim_DuplicateObj(), that will copy the
1952 * string representaion. After the copy, the duplicated
1953 * object will not have more room in teh buffer than
1954 * srcPtr->length bytes. So we just set it to length. */
1955 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1956 }
1957
1958 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1959 {
1960 /* Get a fresh string representation. */
1961 (void) Jim_GetString(objPtr, NULL);
1962 /* Free any other internal representation. */
1963 Jim_FreeIntRep(interp, objPtr);
1964 /* Set it as string, i.e. just set the maxLength field. */
1965 objPtr->typePtr = &stringObjType;
1966 objPtr->internalRep.strValue.maxLength = objPtr->length;
1967 return JIM_OK;
1968 }
1969
1970 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1971 {
1972 Jim_Obj *objPtr = Jim_NewObj(interp);
1973
1974 if (len == -1)
1975 len = strlen(s);
1976 /* Alloc/Set the string rep. */
1977 if (len == 0) {
1978 objPtr->bytes = JimEmptyStringRep;
1979 objPtr->length = 0;
1980 } else {
1981 objPtr->bytes = Jim_Alloc(len+1);
1982 objPtr->length = len;
1983 memcpy(objPtr->bytes, s, len);
1984 objPtr->bytes[len] = '\0';
1985 }
1986
1987 /* No typePtr field for the vanilla string object. */
1988 objPtr->typePtr = NULL;
1989 return objPtr;
1990 }
1991
1992 /* This version does not try to duplicate the 's' pointer, but
1993 * use it directly. */
1994 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
1995 {
1996 Jim_Obj *objPtr = Jim_NewObj(interp);
1997
1998 if (len == -1)
1999 len = strlen(s);
2000 Jim_SetStringRep(objPtr, s, len);
2001 objPtr->typePtr = NULL;
2002 return objPtr;
2003 }
2004
2005 /* Low-level string append. Use it only against objects
2006 * of type "string". */
2007 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2008 {
2009 int needlen;
2010
2011 if (len == -1)
2012 len = strlen(str);
2013 needlen = objPtr->length + len;
2014 if (objPtr->internalRep.strValue.maxLength < needlen ||
2015 objPtr->internalRep.strValue.maxLength == 0) {
2016 if (objPtr->bytes == JimEmptyStringRep) {
2017 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2018 } else {
2019 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2020 }
2021 objPtr->internalRep.strValue.maxLength = needlen*2;
2022 }
2023 memcpy(objPtr->bytes + objPtr->length, str, len);
2024 objPtr->bytes[objPtr->length+len] = '\0';
2025 objPtr->length += len;
2026 }
2027
2028 /* Low-level wrapper to append an object. */
2029 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2030 {
2031 int len;
2032 const char *str;
2033
2034 str = Jim_GetString(appendObjPtr, &len);
2035 StringAppendString(objPtr, str, len);
2036 }
2037
2038 /* Higher level API to append strings to objects. */
2039 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2040 int len)
2041 {
2042 if (Jim_IsShared(objPtr))
2043 Jim_Panic(interp,"Jim_AppendString called with shared object");
2044 if (objPtr->typePtr != &stringObjType)
2045 SetStringFromAny(interp, objPtr);
2046 StringAppendString(objPtr, str, len);
2047 }
2048
2049 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2050 {
2051 char *buf;
2052 va_list ap;
2053
2054 va_start( ap, fmt );
2055 buf = jim_vasprintf( fmt, ap );
2056 va_end(ap);
2057
2058 if( buf ){
2059 Jim_AppendString( interp, objPtr, buf, -1 );
2060 jim_vasprintf_done(buf);
2061 }
2062 }
2063
2064
2065 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2066 Jim_Obj *appendObjPtr)
2067 {
2068 int len;
2069 const char *str;
2070
2071 str = Jim_GetString(appendObjPtr, &len);
2072 Jim_AppendString(interp, objPtr, str, len);
2073 }
2074
2075 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2076 {
2077 va_list ap;
2078
2079 if (objPtr->typePtr != &stringObjType)
2080 SetStringFromAny(interp, objPtr);
2081 va_start(ap, objPtr);
2082 while (1) {
2083 char *s = va_arg(ap, char*);
2084
2085 if (s == NULL) break;
2086 Jim_AppendString(interp, objPtr, s, -1);
2087 }
2088 va_end(ap);
2089 }
2090
2091 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2092 {
2093 const char *aStr, *bStr;
2094 int aLen, bLen, i;
2095
2096 if (aObjPtr == bObjPtr) return 1;
2097 aStr = Jim_GetString(aObjPtr, &aLen);
2098 bStr = Jim_GetString(bObjPtr, &bLen);
2099 if (aLen != bLen) return 0;
2100 if (nocase == 0)
2101 return memcmp(aStr, bStr, aLen) == 0;
2102 for (i = 0; i < aLen; i++) {
2103 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2104 return 0;
2105 }
2106 return 1;
2107 }
2108
2109 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2110 int nocase)
2111 {
2112 const char *pattern, *string;
2113 int patternLen, stringLen;
2114
2115 pattern = Jim_GetString(patternObjPtr, &patternLen);
2116 string = Jim_GetString(objPtr, &stringLen);
2117 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2118 }
2119
2120 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2121 Jim_Obj *secondObjPtr, int nocase)
2122 {
2123 const char *s1, *s2;
2124 int l1, l2;
2125
2126 s1 = Jim_GetString(firstObjPtr, &l1);
2127 s2 = Jim_GetString(secondObjPtr, &l2);
2128 return JimStringCompare(s1, l1, s2, l2, nocase);
2129 }
2130
2131 /* Convert a range, as returned by Jim_GetRange(), into
2132 * an absolute index into an object of the specified length.
2133 * This function may return negative values, or values
2134 * bigger or equal to the length of the list if the index
2135 * is out of range. */
2136 static int JimRelToAbsIndex(int len, int index)
2137 {
2138 if (index < 0)
2139 return len + index;
2140 return index;
2141 }
2142
2143 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2144 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2145 * for implementation of commands like [string range] and [lrange].
2146 *
2147 * The resulting range is guaranteed to address valid elements of
2148 * the structure. */
2149 static void JimRelToAbsRange(int len, int first, int last,
2150 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2151 {
2152 int rangeLen;
2153
2154 if (first > last) {
2155 rangeLen = 0;
2156 } else {
2157 rangeLen = last-first+1;
2158 if (rangeLen) {
2159 if (first < 0) {
2160 rangeLen += first;
2161 first = 0;
2162 }
2163 if (last >= len) {
2164 rangeLen -= (last-(len-1));
2165 last = len-1;
2166 }
2167 }
2168 }
2169 if (rangeLen < 0) rangeLen = 0;
2170
2171 *firstPtr = first;
2172 *lastPtr = last;
2173 *rangeLenPtr = rangeLen;
2174 }
2175
2176 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2177 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2178 {
2179 int first, last;
2180 const char *str;
2181 int len, rangeLen;
2182
2183 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2184 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2185 return NULL;
2186 str = Jim_GetString(strObjPtr, &len);
2187 first = JimRelToAbsIndex(len, first);
2188 last = JimRelToAbsIndex(len, last);
2189 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2190 return Jim_NewStringObj(interp, str+first, rangeLen);
2191 }
2192
2193 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2194 {
2195 char *buf = Jim_Alloc(strObjPtr->length+1);
2196 int i;
2197
2198 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2199 for (i = 0; i < strObjPtr->length; i++)
2200 buf[i] = tolower(buf[i]);
2201 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2202 }
2203
2204 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2205 {
2206 char *buf = Jim_Alloc(strObjPtr->length+1);
2207 int i;
2208
2209 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2210 for (i = 0; i < strObjPtr->length; i++)
2211 buf[i] = toupper(buf[i]);
2212 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2213 }
2214
2215 /* This is the core of the [format] command.
2216 * TODO: Lots of things work - via a hack
2217 * However, no format item can be >= JIM_MAX_FMT
2218 */
2219 #define JIM_MAX_FMT 2048
2220 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2221 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2222 {
2223 const char *fmt, *_fmt;
2224 int fmtLen;
2225 Jim_Obj *resObjPtr;
2226
2227
2228 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2229 _fmt = fmt;
2230 resObjPtr = Jim_NewStringObj(interp, "", 0);
2231 while (fmtLen) {
2232 const char *p = fmt;
2233 char spec[2], c;
2234 jim_wide wideValue;
2235 double doubleValue;
2236 /* we cheat and use Sprintf()! */
2237 char fmt_str[100];
2238 char *cp;
2239 int width;
2240 int ljust;
2241 int zpad;
2242 int spad;
2243 int altfm;
2244 int forceplus;
2245 int prec;
2246 int inprec;
2247 int haveprec;
2248 int accum;
2249
2250 while (*fmt != '%' && fmtLen) {
2251 fmt++; fmtLen--;
2252 }
2253 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2254 if (fmtLen == 0)
2255 break;
2256 fmt++; fmtLen--; /* skip '%' */
2257 zpad = 0;
2258 spad = 0;
2259 width = -1;
2260 ljust = 0;
2261 altfm = 0;
2262 forceplus = 0;
2263 inprec = 0;
2264 haveprec = 0;
2265 prec = -1; /* not found yet */
2266 next_fmt:
2267 if( fmtLen <= 0 ){
2268 break;
2269 }
2270 switch( *fmt ){
2271 /* terminals */
2272 case 'b': /* binary - not all printfs() do this */
2273 case 's': /* string */
2274 case 'i': /* integer */
2275 case 'd': /* decimal */
2276 case 'x': /* hex */
2277 case 'X': /* CAP hex */
2278 case 'c': /* char */
2279 case 'o': /* octal */
2280 case 'u': /* unsigned */
2281 case 'f': /* float */
2282 break;
2283
2284 /* non-terminals */
2285 case '0': /* zero pad */
2286 zpad = 1;
2287 *fmt++; fmtLen--;
2288 goto next_fmt;
2289 break;
2290 case '+':
2291 forceplus = 1;
2292 *fmt++; fmtLen--;
2293 goto next_fmt;
2294 break;
2295 case ' ': /* sign space */
2296 spad = 1;
2297 *fmt++; fmtLen--;
2298 goto next_fmt;
2299 break;
2300 case '-':
2301 ljust = 1;
2302 *fmt++; fmtLen--;
2303 goto next_fmt;
2304 break;
2305 case '#':
2306 altfm = 1;
2307 *fmt++; fmtLen--;
2308 goto next_fmt;
2309
2310 case '.':
2311 inprec = 1;
2312 *fmt++; fmtLen--;
2313 goto next_fmt;
2314 break;
2315 case '1':
2316 case '2':
2317 case '3':
2318 case '4':
2319 case '5':
2320 case '6':
2321 case '7':
2322 case '8':
2323 case '9':
2324 accum = 0;
2325 while( isdigit(*fmt) && (fmtLen > 0) ){
2326 accum = (accum * 10) + (*fmt - '0');
2327 fmt++; fmtLen--;
2328 }
2329 if( inprec ){
2330 haveprec = 1;
2331 prec = accum;
2332 } else {
2333 width = accum;
2334 }
2335 goto next_fmt;
2336 case '*':
2337 /* suck up the next item as an integer */
2338 *fmt++; fmtLen--;
2339 objc--;
2340 if( objc <= 0 ){
2341 goto not_enough_args;
2342 }
2343 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2344 Jim_FreeNewObj(interp, resObjPtr );
2345 return NULL;
2346 }
2347 if( inprec ){
2348 haveprec = 1;
2349 prec = wideValue;
2350 if( prec < 0 ){
2351 /* man 3 printf says */
2352 /* if prec is negative, it is zero */
2353 prec = 0;
2354 }
2355 } else {
2356 width = wideValue;
2357 if( width < 0 ){
2358 ljust = 1;
2359 width = -width;
2360 }
2361 }
2362 objv++;
2363 goto next_fmt;
2364 break;
2365 }
2366
2367
2368 if (*fmt != '%') {
2369 if (objc == 0) {
2370 not_enough_args:
2371 Jim_FreeNewObj(interp, resObjPtr);
2372 Jim_SetResultString(interp,
2373 "not enough arguments for all format specifiers", -1);
2374 return NULL;
2375 } else {
2376 objc--;
2377 }
2378 }
2379
2380 /*
2381 * Create the formatter
2382 * cause we cheat and use sprintf()
2383 */
2384 cp = fmt_str;
2385 *cp++ = '%';
2386 if( altfm ){
2387 *cp++ = '#';
2388 }
2389 if( forceplus ){
2390 *cp++ = '+';
2391 } else if( spad ){
2392 /* PLUS overrides */
2393 *cp++ = ' ';
2394 }
2395 if( ljust ){
2396 *cp++ = '-';
2397 }
2398 if( zpad ){
2399 *cp++ = '0';
2400 }
2401 if( width > 0 ){
2402 sprintf( cp, "%d", width );
2403 /* skip ahead */
2404 cp = strchr(cp,0);
2405 }
2406 /* did we find a period? */
2407 if( inprec ){
2408 /* then add it */
2409 *cp++ = '.';
2410 /* did something occur after the period? */
2411 if( haveprec ){
2412 sprintf( cp, "%d", prec );
2413 }
2414 cp = strchr(cp,0);
2415 }
2416 *cp = 0;
2417
2418 /* here we do the work */
2419 /* actually - we make sprintf() do it for us */
2420 switch(*fmt) {
2421 case 's':
2422 *cp++ = 's';
2423 *cp = 0;
2424 /* BUG: we do not handled embeded NULLs */
2425 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2426 break;
2427 case 'c':
2428 *cp++ = 'c';
2429 *cp = 0;
2430 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2431 Jim_FreeNewObj(interp, resObjPtr);
2432 return NULL;
2433 }
2434 c = (char) wideValue;
2435 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2436 break;
2437 case 'f':
2438 case 'F':
2439 case 'g':
2440 case 'G':
2441 case 'e':
2442 case 'E':
2443 *cp++ = *fmt;
2444 *cp = 0;
2445 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2446 Jim_FreeNewObj( interp, resObjPtr );
2447 return NULL;
2448 }
2449 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2450 break;
2451 case 'b':
2452 case 'd':
2453 case 'i':
2454 case 'u':
2455 case 'x':
2456 case 'X':
2457 /* jim widevaluse are 64bit */
2458 if( sizeof(jim_wide) == sizeof(long long) ){
2459 *cp++ = 'l';
2460 *cp++ = 'l';
2461 } else {
2462 *cp++ = 'l';
2463 }
2464 *cp++ = *fmt;
2465 *cp = 0;
2466 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2467 Jim_FreeNewObj(interp, resObjPtr);
2468 return NULL;
2469 }
2470 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2471 break;
2472 case '%':
2473 sprintf_buf[0] = '%';
2474 sprintf_buf[1] = 0;
2475 objv--; /* undo the objv++ below */
2476 break;
2477 default:
2478 spec[0] = *fmt; spec[1] = '\0';
2479 Jim_FreeNewObj(interp, resObjPtr);
2480 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2481 Jim_AppendStrings(interp, Jim_GetResult(interp),
2482 "bad field specifier \"", spec, "\"", NULL);
2483 return NULL;
2484 }
2485 /* force terminate */
2486 #if 0
2487 printf("FMT was: %s\n", fmt_str );
2488 printf("RES was: |%s|\n", sprintf_buf );
2489 #endif
2490
2491 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2492 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2493 /* next obj */
2494 objv++;
2495 fmt++;
2496 fmtLen--;
2497 }
2498 return resObjPtr;
2499 }
2500
2501 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2502 int objc, Jim_Obj *const *objv)
2503 {
2504 char *sprintf_buf=malloc(JIM_MAX_FMT);
2505 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2506 free(sprintf_buf);
2507 return t;
2508 }
2509
2510 /* -----------------------------------------------------------------------------
2511 * Compared String Object
2512 * ---------------------------------------------------------------------------*/
2513
2514 /* This is strange object that allows to compare a C literal string
2515 * with a Jim object in very short time if the same comparison is done
2516 * multiple times. For example every time the [if] command is executed,
2517 * Jim has to check if a given argument is "else". This comparions if
2518 * the code has no errors are true most of the times, so we can cache
2519 * inside the object the pointer of the string of the last matching
2520 * comparison. Because most C compilers perform literal sharing,
2521 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2522 * this works pretty well even if comparisons are at different places
2523 * inside the C code. */
2524
2525 static Jim_ObjType comparedStringObjType = {
2526 "compared-string",
2527 NULL,
2528 NULL,
2529 NULL,
2530 JIM_TYPE_REFERENCES,
2531 };
2532
2533 /* The only way this object is exposed to the API is via the following
2534 * function. Returns true if the string and the object string repr.
2535 * are the same, otherwise zero is returned.
2536 *
2537 * Note: this isn't binary safe, but it hardly needs to be.*/
2538 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2539 const char *str)
2540 {
2541 if (objPtr->typePtr == &comparedStringObjType &&
2542 objPtr->internalRep.ptr == str)
2543 return 1;
2544 else {
2545 const char *objStr = Jim_GetString(objPtr, NULL);
2546 if (strcmp(str, objStr) != 0) return 0;
2547 if (objPtr->typePtr != &comparedStringObjType) {
2548 Jim_FreeIntRep(interp, objPtr);
2549 objPtr->typePtr = &comparedStringObjType;
2550 }
2551 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2552 return 1;
2553 }
2554 }
2555
2556 int qsortCompareStringPointers(const void *a, const void *b)
2557 {
2558 char * const *sa = (char * const *)a;
2559 char * const *sb = (char * const *)b;
2560 return strcmp(*sa, *sb);
2561 }
2562
2563 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2564 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2565 {
2566 const char * const *entryPtr = NULL;
2567 char **tablePtrSorted;
2568 int i, count = 0;
2569
2570 *indexPtr = -1;
2571 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2572 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2573 *indexPtr = i;
2574 return JIM_OK;
2575 }
2576 count++; /* If nothing matches, this will reach the len of tablePtr */
2577 }
2578 if (flags & JIM_ERRMSG) {
2579 if (name == NULL)
2580 name = "option";
2581 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2582 Jim_AppendStrings(interp, Jim_GetResult(interp),
2583 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2584 NULL);
2585 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2586 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2587 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2588 for (i = 0; i < count; i++) {
2589 if (i+1 == count && count > 1)
2590 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2591 Jim_AppendString(interp, Jim_GetResult(interp),
2592 tablePtrSorted[i], -1);
2593 if (i+1 != count)
2594 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2595 }
2596 Jim_Free(tablePtrSorted);
2597 }
2598 return JIM_ERR;
2599 }
2600
2601 int Jim_GetNvp(Jim_Interp *interp,
2602 Jim_Obj *objPtr,
2603 const Jim_Nvp *nvp_table,
2604 const Jim_Nvp ** result)
2605 {
2606 Jim_Nvp *n;
2607 int e;
2608
2609 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2610 if( e == JIM_ERR ){
2611 return e;
2612 }
2613
2614 /* Success? found? */
2615 if( n->name ){
2616 /* remove const */
2617 *result = (Jim_Nvp *)n;
2618 return JIM_OK;
2619 } else {
2620 return JIM_ERR;
2621 }
2622 }
2623
2624 /* -----------------------------------------------------------------------------
2625 * Source Object
2626 *
2627 * This object is just a string from the language point of view, but
2628 * in the internal representation it contains the filename and line number
2629 * where this given token was read. This information is used by
2630 * Jim_EvalObj() if the object passed happens to be of type "source".
2631 *
2632 * This allows to propagate the information about line numbers and file
2633 * names and give error messages with absolute line numbers.
2634 *
2635 * Note that this object uses shared strings for filenames, and the
2636 * pointer to the filename together with the line number is taken into
2637 * the space for the "inline" internal represenation of the Jim_Object,
2638 * so there is almost memory zero-overhead.
2639 *
2640 * Also the object will be converted to something else if the given
2641 * token it represents in the source file is not something to be
2642 * evaluated (not a script), and will be specialized in some other way,
2643 * so the time overhead is alzo null.
2644 * ---------------------------------------------------------------------------*/
2645
2646 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2647 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2648
2649 static Jim_ObjType sourceObjType = {
2650 "source",
2651 FreeSourceInternalRep,
2652 DupSourceInternalRep,
2653 NULL,
2654 JIM_TYPE_REFERENCES,
2655 };
2656
2657 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2658 {
2659 Jim_ReleaseSharedString(interp,
2660 objPtr->internalRep.sourceValue.fileName);
2661 }
2662
2663 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2664 {
2665 dupPtr->internalRep.sourceValue.fileName =
2666 Jim_GetSharedString(interp,
2667 srcPtr->internalRep.sourceValue.fileName);
2668 dupPtr->internalRep.sourceValue.lineNumber =
2669 dupPtr->internalRep.sourceValue.lineNumber;
2670 dupPtr->typePtr = &sourceObjType;
2671 }
2672
2673 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2674 const char *fileName, int lineNumber)
2675 {
2676 if (Jim_IsShared(objPtr))
2677 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2678 if (objPtr->typePtr != NULL)
2679 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2680 objPtr->internalRep.sourceValue.fileName =
2681 Jim_GetSharedString(interp, fileName);
2682 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2683 objPtr->typePtr = &sourceObjType;
2684 }
2685
2686 /* -----------------------------------------------------------------------------
2687 * Script Object
2688 * ---------------------------------------------------------------------------*/
2689
2690 #define JIM_CMDSTRUCT_EXPAND -1
2691
2692 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2693 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2694 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2695
2696 static Jim_ObjType scriptObjType = {
2697 "script",
2698 FreeScriptInternalRep,
2699 DupScriptInternalRep,
2700 NULL,
2701 JIM_TYPE_REFERENCES,
2702 };
2703
2704 /* The ScriptToken structure represents every token into a scriptObj.
2705 * Every token contains an associated Jim_Obj that can be specialized
2706 * by commands operating on it. */
2707 typedef struct ScriptToken {
2708 int type;
2709 Jim_Obj *objPtr;
2710 int linenr;
2711 } ScriptToken;
2712
2713 /* This is the script object internal representation. An array of
2714 * ScriptToken structures, with an associated command structure array.
2715 * The command structure is a pre-computed representation of the
2716 * command length and arguments structure as a simple liner array
2717 * of integers.
2718 *
2719 * For example the script:
2720 *
2721 * puts hello
2722 * set $i $x$y [foo]BAR
2723 *
2724 * will produce a ScriptObj with the following Tokens:
2725 *
2726 * ESC puts
2727 * SEP
2728 * ESC hello
2729 * EOL
2730 * ESC set
2731 * EOL
2732 * VAR i
2733 * SEP
2734 * VAR x
2735 * VAR y
2736 * SEP
2737 * CMD foo
2738 * ESC BAR
2739 * EOL
2740 *
2741 * This is a description of the tokens, separators, and of lines.
2742 * The command structure instead represents the number of arguments
2743 * of every command, followed by the tokens of which every argument
2744 * is composed. So for the example script, the cmdstruct array will
2745 * contain:
2746 *
2747 * 2 1 1 4 1 1 2 2
2748 *
2749 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2750 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2751 * composed of single tokens (1 1) and the last two of double tokens
2752 * (2 2).
2753 *
2754 * The precomputation of the command structure makes Jim_Eval() faster,
2755 * and simpler because there aren't dynamic lengths / allocations.
2756 *
2757 * -- {expand} handling --
2758 *
2759 * Expand is handled in a special way. When a command
2760 * contains at least an argument with the {expand} prefix,
2761 * the command structure presents a -1 before the integer
2762 * describing the number of arguments. This is used in order
2763 * to send the command exection to a different path in case
2764 * of {expand} and guarantee a fast path for the more common
2765 * case. Also, the integers describing the number of tokens
2766 * are expressed with negative sign, to allow for fast check
2767 * of what's an {expand}-prefixed argument and what not.
2768 *
2769 * For example the command:
2770 *
2771 * list {expand}{1 2}
2772 *
2773 * Will produce the following cmdstruct array:
2774 *
2775 * -1 2 1 -2
2776 *
2777 * -- the substFlags field of the structure --
2778 *
2779 * The scriptObj structure is used to represent both "script" objects
2780 * and "subst" objects. In the second case, the cmdStruct related
2781 * fields are not used at all, but there is an additional field used
2782 * that is 'substFlags': this represents the flags used to turn
2783 * the string into the intenral representation used to perform the
2784 * substitution. If this flags are not what the application requires
2785 * the scriptObj is created again. For example the script:
2786 *
2787 * subst -nocommands $string
2788 * subst -novariables $string
2789 *
2790 * Will recreate the internal representation of the $string object
2791 * two times.
2792 */
2793 typedef struct ScriptObj {
2794 int len; /* Length as number of tokens. */
2795 int commands; /* number of top-level commands in script. */
2796 ScriptToken *token; /* Tokens array. */
2797 int *cmdStruct; /* commands structure */
2798 int csLen; /* length of the cmdStruct array. */
2799 int substFlags; /* flags used for the compilation of "subst" objects */
2800 int inUse; /* Used to share a ScriptObj. Currently
2801 only used by Jim_EvalObj() as protection against
2802 shimmering of the currently evaluated object. */
2803 char *fileName;
2804 } ScriptObj;
2805
2806 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2807 {
2808 int i;
2809 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2810
2811 script->inUse--;
2812 if (script->inUse != 0) return;
2813 for (i = 0; i < script->len; i++) {
2814 if (script->token[i].objPtr != NULL)
2815 Jim_DecrRefCount(interp, script->token[i].objPtr);
2816 }
2817 Jim_Free(script->token);
2818 Jim_Free(script->cmdStruct);
2819 Jim_Free(script->fileName);
2820 Jim_Free(script);
2821 }
2822
2823 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2824 {
2825 JIM_NOTUSED(interp);
2826 JIM_NOTUSED(srcPtr);
2827
2828 /* Just returns an simple string. */
2829 dupPtr->typePtr = NULL;
2830 }
2831
2832 /* Add a new token to the internal repr of a script object */
2833 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2834 char *strtoken, int len, int type, char *filename, int linenr)
2835 {
2836 int prevtype;
2837 struct ScriptToken *token;
2838
2839 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2840 script->token[script->len-1].type;
2841 /* Skip tokens without meaning, like words separators
2842 * following a word separator or an end of command and
2843 * so on. */
2844 if (prevtype == JIM_TT_EOL) {
2845 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2846 Jim_Free(strtoken);
2847 return;
2848 }
2849 } else if (prevtype == JIM_TT_SEP) {
2850 if (type == JIM_TT_SEP) {
2851 Jim_Free(strtoken);
2852 return;
2853 } else if (type == JIM_TT_EOL) {
2854 /* If an EOL is following by a SEP, drop the previous
2855 * separator. */
2856 script->len--;
2857 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2858 }
2859 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2860 type == JIM_TT_ESC && len == 0)
2861 {
2862 /* Don't add empty tokens used in interpolation */
2863 Jim_Free(strtoken);
2864 return;
2865 }
2866 /* Make space for a new istruction */
2867 script->len++;
2868 script->token = Jim_Realloc(script->token,
2869 sizeof(ScriptToken)*script->len);
2870 /* Initialize the new token */
2871 token = script->token+(script->len-1);
2872 token->type = type;
2873 /* Every object is intially as a string, but the
2874 * internal type may be specialized during execution of the
2875 * script. */
2876 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2877 /* To add source info to SEP and EOL tokens is useless because
2878 * they will never by called as arguments of Jim_EvalObj(). */
2879 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2880 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2881 Jim_IncrRefCount(token->objPtr);
2882 token->linenr = linenr;
2883 }
2884
2885 /* Add an integer into the command structure field of the script object. */
2886 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2887 {
2888 script->csLen++;
2889 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2890 sizeof(int)*script->csLen);
2891 script->cmdStruct[script->csLen-1] = val;
2892 }
2893
2894 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2895 * of objPtr. Search nested script objects recursively. */
2896 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2897 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2898 {
2899 int i;
2900
2901 for (i = 0; i < script->len; i++) {
2902 if (script->token[i].objPtr != objPtr &&
2903 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2904 return script->token[i].objPtr;
2905 }
2906 /* Enter recursively on scripts only if the object
2907 * is not the same as the one we are searching for
2908 * shared occurrences. */
2909 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2910 script->token[i].objPtr != objPtr) {
2911 Jim_Obj *foundObjPtr;
2912
2913 ScriptObj *subScript =
2914 script->token[i].objPtr->internalRep.ptr;
2915 /* Don't recursively enter the script we are trying
2916 * to make shared to avoid circular references. */
2917 if (subScript == scriptBarrier) continue;
2918 if (subScript != script) {
2919 foundObjPtr =
2920 ScriptSearchLiteral(interp, subScript,
2921 scriptBarrier, objPtr);
2922 if (foundObjPtr != NULL)
2923 return foundObjPtr;
2924 }
2925 }
2926 }
2927 return NULL;
2928 }
2929
2930 /* Share literals of a script recursively sharing sub-scripts literals. */
2931 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2932 ScriptObj *topLevelScript)
2933 {
2934 int i, j;
2935
2936 return;
2937 /* Try to share with toplevel object. */
2938 if (topLevelScript != NULL) {
2939 for (i = 0; i < script->len; i++) {
2940 Jim_Obj *foundObjPtr;
2941 char *str = script->token[i].objPtr->bytes;
2942
2943 if (script->token[i].objPtr->refCount != 1) continue;
2944 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2945 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2946 foundObjPtr = ScriptSearchLiteral(interp,
2947 topLevelScript,
2948 script, /* barrier */
2949 script->token[i].objPtr);
2950 if (foundObjPtr != NULL) {
2951 Jim_IncrRefCount(foundObjPtr);
2952 Jim_DecrRefCount(interp,
2953 script->token[i].objPtr);
2954 script->token[i].objPtr = foundObjPtr;
2955 }
2956 }
2957 }
2958 /* Try to share locally */
2959 for (i = 0; i < script->len; i++) {
2960 char *str = script->token[i].objPtr->bytes;
2961
2962 if (script->token[i].objPtr->refCount != 1) continue;
2963 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2964 for (j = 0; j < script->len; j++) {
2965 if (script->token[i].objPtr !=
2966 script->token[j].objPtr &&
2967 Jim_StringEqObj(script->token[i].objPtr,
2968 script->token[j].objPtr, 0))
2969 {
2970 Jim_IncrRefCount(script->token[j].objPtr);
2971 Jim_DecrRefCount(interp,
2972 script->token[i].objPtr);
2973 script->token[i].objPtr =
2974 script->token[j].objPtr;
2975 }
2976 }
2977 }
2978 }
2979
2980 /* This method takes the string representation of an object
2981 * as a Tcl script, and generates the pre-parsed internal representation
2982 * of the script. */
2983 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2984 {
2985 int scriptTextLen;
2986 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
2987 struct JimParserCtx parser;
2988 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
2989 ScriptToken *token;
2990 int args, tokens, start, end, i;
2991 int initialLineNumber;
2992 int propagateSourceInfo = 0;
2993
2994 script->len = 0;
2995 script->csLen = 0;
2996 script->commands = 0;
2997 script->token = NULL;
2998 script->cmdStruct = NULL;
2999 script->inUse = 1;
3000 /* Try to get information about filename / line number */
3001 if (objPtr->typePtr == &sourceObjType) {
3002 script->fileName =
3003 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3004 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3005 propagateSourceInfo = 1;
3006 } else {
3007 script->fileName = Jim_StrDup("?");
3008 initialLineNumber = 1;
3009 }
3010
3011 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3012 while(!JimParserEof(&parser)) {
3013 char *token;
3014 int len, type, linenr;
3015
3016 JimParseScript(&parser);
3017 token = JimParserGetToken(&parser, &len, &type, &linenr);
3018 ScriptObjAddToken(interp, script, token, len, type,
3019 propagateSourceInfo ? script->fileName : NULL,
3020 linenr);
3021 }
3022 token = script->token;
3023
3024 /* Compute the command structure array
3025 * (see the ScriptObj struct definition for more info) */
3026 start = 0; /* Current command start token index */
3027 end = -1; /* Current command end token index */
3028 while (1) {
3029 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3030 int interpolation = 0; /* set to 1 if there is at least one
3031 argument of the command obtained via
3032 interpolation of more tokens. */
3033 /* Search for the end of command, while
3034 * count the number of args. */
3035 start = ++end;
3036 if (start >= script->len) break;
3037 args = 1; /* Number of args in current command */
3038 while (token[end].type != JIM_TT_EOL) {
3039 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3040 token[end-1].type == JIM_TT_EOL)
3041 {
3042 if (token[end].type == JIM_TT_STR &&
3043 token[end+1].type != JIM_TT_SEP &&
3044 token[end+1].type != JIM_TT_EOL &&
3045 (!strcmp(token[end].objPtr->bytes, "expand") ||
3046 !strcmp(token[end].objPtr->bytes, "*")))
3047 expand++;
3048 }
3049 if (token[end].type == JIM_TT_SEP)
3050 args++;
3051 end++;
3052 }
3053 interpolation = !((end-start+1) == args*2);
3054 /* Add the 'number of arguments' info into cmdstruct.
3055 * Negative value if there is list expansion involved. */
3056 if (expand)
3057 ScriptObjAddInt(script, -1);
3058 ScriptObjAddInt(script, args);
3059 /* Now add info about the number of tokens. */
3060 tokens = 0; /* Number of tokens in current argument. */
3061 expand = 0;
3062 for (i = start; i <= end; i++) {
3063 if (token[i].type == JIM_TT_SEP ||
3064 token[i].type == JIM_TT_EOL)
3065 {
3066 if (tokens == 1 && expand)
3067 expand = 0;
3068 ScriptObjAddInt(script,
3069 expand ? -tokens : tokens);
3070
3071 expand = 0;
3072 tokens = 0;
3073 continue;
3074 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3075 (!strcmp(token[i].objPtr->bytes, "expand") ||
3076 !strcmp(token[i].objPtr->bytes, "*")))
3077 {
3078 expand++;
3079 }
3080 tokens++;
3081 }
3082 }
3083 /* Perform literal sharing, but only for objects that appear
3084 * to be scripts written as literals inside the source code,
3085 * and not computed at runtime. Literal sharing is a costly
3086 * operation that should be done only against objects that
3087 * are likely to require compilation only the first time, and
3088 * then are executed multiple times. */
3089 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3090 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3091 if (bodyObjPtr->typePtr == &scriptObjType) {
3092 ScriptObj *bodyScript =
3093 bodyObjPtr->internalRep.ptr;
3094 ScriptShareLiterals(interp, script, bodyScript);
3095 }
3096 } else if (propagateSourceInfo) {
3097 ScriptShareLiterals(interp, script, NULL);
3098 }
3099 /* Free the old internal rep and set the new one. */
3100 Jim_FreeIntRep(interp, objPtr);
3101 Jim_SetIntRepPtr(objPtr, script);
3102 objPtr->typePtr = &scriptObjType;
3103 return JIM_OK;
3104 }
3105
3106 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3107 {
3108 if (objPtr->typePtr != &scriptObjType) {
3109 SetScriptFromAny(interp, objPtr);
3110 }
3111 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3112 }
3113
3114 /* -----------------------------------------------------------------------------
3115 * Commands
3116 * ---------------------------------------------------------------------------*/
3117
3118 /* Commands HashTable Type.
3119 *
3120 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3121 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3122 {
3123 Jim_Cmd *cmdPtr = (void*) val;
3124
3125 if (cmdPtr->cmdProc == NULL) {
3126 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3127 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3128 if (cmdPtr->staticVars) {
3129 Jim_FreeHashTable(cmdPtr->staticVars);
3130 Jim_Free(cmdPtr->staticVars);
3131 }
3132 } else if (cmdPtr->delProc != NULL) {
3133 /* If it was a C coded command, call the delProc if any */
3134 cmdPtr->delProc(interp, cmdPtr->privData);
3135 }
3136 Jim_Free(val);
3137 }
3138
3139 static Jim_HashTableType JimCommandsHashTableType = {
3140 JimStringCopyHTHashFunction, /* hash function */
3141 JimStringCopyHTKeyDup, /* key dup */
3142 NULL, /* val dup */
3143 JimStringCopyHTKeyCompare, /* key compare */
3144 JimStringCopyHTKeyDestructor, /* key destructor */
3145 Jim_CommandsHT_ValDestructor /* val destructor */
3146 };
3147
3148 /* ------------------------- Commands related functions --------------------- */
3149
3150 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3151 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3152 {
3153 Jim_HashEntry *he;
3154 Jim_Cmd *cmdPtr;
3155
3156 he = Jim_FindHashEntry(&interp->commands, cmdName);
3157 if (he == NULL) { /* New command to create */
3158 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3159 cmdPtr->cmdProc = cmdProc;
3160 cmdPtr->privData = privData;
3161 cmdPtr->delProc = delProc;
3162 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3163 } else {
3164 Jim_InterpIncrProcEpoch(interp);
3165 /* Free the arglist/body objects if it was a Tcl procedure */
3166 cmdPtr = he->val;
3167 if (cmdPtr->cmdProc == NULL) {
3168 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3169 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3170 if (cmdPtr->staticVars) {
3171 Jim_FreeHashTable(cmdPtr->staticVars);
3172 Jim_Free(cmdPtr->staticVars);
3173 }
3174 cmdPtr->staticVars = NULL;
3175 } else if (cmdPtr->delProc != NULL) {
3176 /* If it was a C coded command, call the delProc if any */
3177 cmdPtr->delProc(interp, cmdPtr->privData);
3178 }
3179 cmdPtr->cmdProc = cmdProc;
3180 cmdPtr->privData = privData;
3181 }
3182 /* There is no need to increment the 'proc epoch' because
3183 * creation of a new procedure can never affect existing
3184 * cached commands. We don't do negative caching. */
3185 return JIM_OK;
3186 }
3187
3188 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3189 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3190 int arityMin, int arityMax)
3191 {
3192 Jim_Cmd *cmdPtr;
3193
3194 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3195 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3196 cmdPtr->argListObjPtr = argListObjPtr;
3197 cmdPtr->bodyObjPtr = bodyObjPtr;
3198 Jim_IncrRefCount(argListObjPtr);
3199 Jim_IncrRefCount(bodyObjPtr);
3200 cmdPtr->arityMin = arityMin;
3201 cmdPtr->arityMax = arityMax;
3202 cmdPtr->staticVars = NULL;
3203
3204 /* Create the statics hash table. */
3205 if (staticsListObjPtr) {
3206 int len, i;
3207
3208 Jim_ListLength(interp, staticsListObjPtr, &len);
3209 if (len != 0) {
3210 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3211 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3212 interp);
3213 for (i = 0; i < len; i++) {
3214 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3215 Jim_Var *varPtr;
3216 int subLen;
3217
3218 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3219 /* Check if it's composed of two elements. */
3220 Jim_ListLength(interp, objPtr, &subLen);
3221 if (subLen == 1 || subLen == 2) {
3222 /* Try to get the variable value from the current
3223 * environment. */
3224 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3225 if (subLen == 1) {
3226 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3227 JIM_NONE);
3228 if (initObjPtr == NULL) {
3229 Jim_SetResult(interp,
3230 Jim_NewEmptyStringObj(interp));
3231 Jim_AppendStrings(interp, Jim_GetResult(interp),
3232 "variable for initialization of static \"",
3233 Jim_GetString(nameObjPtr, NULL),
3234 "\" not found in the local context",
3235 NULL);
3236 goto err;
3237 }
3238 } else {
3239 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3240 }
3241 varPtr = Jim_Alloc(sizeof(*varPtr));
3242 varPtr->objPtr = initObjPtr;
3243 Jim_IncrRefCount(initObjPtr);
3244 varPtr->linkFramePtr = NULL;
3245 if (Jim_AddHashEntry(cmdPtr->staticVars,
3246 Jim_GetString(nameObjPtr, NULL),
3247 varPtr) != JIM_OK)
3248 {
3249 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3250 Jim_AppendStrings(interp, Jim_GetResult(interp),
3251 "static variable name \"",
3252 Jim_GetString(objPtr, NULL), "\"",
3253 " duplicated in statics list", NULL);
3254 Jim_DecrRefCount(interp, initObjPtr);
3255 Jim_Free(varPtr);
3256 goto err;
3257 }
3258 } else {
3259 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3260 Jim_AppendStrings(interp, Jim_GetResult(interp),
3261 "too many fields in static specifier \"",
3262 objPtr, "\"", NULL);
3263 goto err;
3264 }
3265 }
3266 }
3267 }
3268
3269 /* Add the new command */
3270
3271 /* it may already exist, so we try to delete the old one */
3272 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3273 /* There was an old procedure with the same name, this requires
3274 * a 'proc epoch' update. */
3275 Jim_InterpIncrProcEpoch(interp);
3276 }
3277 /* If a procedure with the same name didn't existed there is no need
3278 * to increment the 'proc epoch' because creation of a new procedure
3279 * can never affect existing cached commands. We don't do
3280 * negative caching. */
3281 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3282 return JIM_OK;
3283
3284 err:
3285 Jim_FreeHashTable(cmdPtr->staticVars);
3286 Jim_Free(cmdPtr->staticVars);
3287 Jim_DecrRefCount(interp, argListObjPtr);
3288 Jim_DecrRefCount(interp, bodyObjPtr);
3289 Jim_Free(cmdPtr);
3290 return JIM_ERR;
3291 }
3292
3293 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3294 {
3295 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3296 return JIM_ERR;
3297 Jim_InterpIncrProcEpoch(interp);
3298 return JIM_OK;
3299 }
3300
3301 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3302 const char *newName)
3303 {
3304 Jim_Cmd *cmdPtr;
3305 Jim_HashEntry *he;
3306 Jim_Cmd *copyCmdPtr;
3307
3308 if (newName[0] == '\0') /* Delete! */
3309 return Jim_DeleteCommand(interp, oldName);
3310 /* Rename */
3311 he = Jim_FindHashEntry(&interp->commands, oldName);
3312 if (he == NULL)
3313 return JIM_ERR; /* Invalid command name */
3314 cmdPtr = he->val;
3315 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3316 *copyCmdPtr = *cmdPtr;
3317 /* In order to avoid that a procedure will get arglist/body/statics
3318 * freed by the hash table methods, fake a C-coded command
3319 * setting cmdPtr->cmdProc as not NULL */
3320 cmdPtr->cmdProc = (void*)1;
3321 /* Also make sure delProc is NULL. */
3322 cmdPtr->delProc = NULL;
3323 /* Destroy the old command, and make sure the new is freed
3324 * as well. */
3325 Jim_DeleteHashEntry(&interp->commands, oldName);
3326 Jim_DeleteHashEntry(&interp->commands, newName);
3327 /* Now the new command. We are sure it can't fail because
3328 * the target name was already freed. */
3329 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3330 /* Increment the epoch */
3331 Jim_InterpIncrProcEpoch(interp);
3332 return JIM_OK;
3333 }
3334
3335 /* -----------------------------------------------------------------------------
3336 * Command object
3337 * ---------------------------------------------------------------------------*/
3338
3339 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3340
3341 static Jim_ObjType commandObjType = {
3342 "command",
3343 NULL,
3344 NULL,
3345 NULL,
3346 JIM_TYPE_REFERENCES,
3347 };
3348
3349 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3350 {
3351 Jim_HashEntry *he;
3352 const char *cmdName;
3353
3354 /* Get the string representation */
3355 cmdName = Jim_GetString(objPtr, NULL);
3356 /* Lookup this name into the commands hash table */
3357 he = Jim_FindHashEntry(&interp->commands, cmdName);
3358 if (he == NULL)
3359 return JIM_ERR;
3360
3361 /* Free the old internal repr and set the new one. */
3362 Jim_FreeIntRep(interp, objPtr);
3363 objPtr->typePtr = &commandObjType;
3364 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3365 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3366 return JIM_OK;
3367 }
3368
3369 /* This function returns the command structure for the command name
3370 * stored in objPtr. It tries to specialize the objPtr to contain
3371 * a cached info instead to perform the lookup into the hash table
3372 * every time. The information cached may not be uptodate, in such
3373 * a case the lookup is performed and the cache updated. */
3374 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3375 {
3376 if ((objPtr->typePtr != &commandObjType ||
3377 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3378 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3379 if (flags & JIM_ERRMSG) {
3380 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3381 Jim_AppendStrings(interp, Jim_GetResult(interp),
3382 "invalid command name \"", objPtr->bytes, "\"",
3383 NULL);
3384 }
3385 return NULL;
3386 }
3387 return objPtr->internalRep.cmdValue.cmdPtr;
3388 }
3389
3390 /* -----------------------------------------------------------------------------
3391 * Variables
3392 * ---------------------------------------------------------------------------*/
3393
3394 /* Variables HashTable Type.
3395 *
3396 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3397 static void JimVariablesHTValDestructor(void *interp, void *val)
3398 {
3399 Jim_Var *varPtr = (void*) val;
3400
3401 Jim_DecrRefCount(interp, varPtr->objPtr);
3402 Jim_Free(val);
3403 }
3404
3405 static Jim_HashTableType JimVariablesHashTableType = {
3406 JimStringCopyHTHashFunction, /* hash function */
3407 JimStringCopyHTKeyDup, /* key dup */
3408 NULL, /* val dup */
3409 JimStringCopyHTKeyCompare, /* key compare */
3410 JimStringCopyHTKeyDestructor, /* key destructor */
3411 JimVariablesHTValDestructor /* val destructor */
3412 };
3413
3414 /* -----------------------------------------------------------------------------
3415 * Variable object
3416 * ---------------------------------------------------------------------------*/
3417
3418 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3419
3420 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3421
3422 static Jim_ObjType variableObjType = {
3423 "variable",
3424 NULL,
3425 NULL,
3426 NULL,
3427 JIM_TYPE_REFERENCES,
3428 };
3429
3430 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3431 * is in the form "varname(key)". */
3432 static int Jim_NameIsDictSugar(const char *str, int len)
3433 {
3434 if (len == -1)
3435 len = strlen(str);
3436 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3437 return 1;
3438 return 0;
3439 }
3440
3441 /* This method should be called only by the variable API.
3442 * It returns JIM_OK on success (variable already exists),
3443 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3444 * a variable name, but syntax glue for [dict] i.e. the last
3445 * character is ')' */
3446 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3447 {
3448 Jim_HashEntry *he;
3449 const char *varName;
3450 int len;
3451
3452 /* Check if the object is already an uptodate variable */
3453 if (objPtr->typePtr == &variableObjType &&
3454 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3455 return JIM_OK; /* nothing to do */
3456 /* Get the string representation */
3457 varName = Jim_GetString(objPtr, &len);
3458 /* Make sure it's not syntax glue to get/set dict. */
3459 if (Jim_NameIsDictSugar(varName, len))
3460 return JIM_DICT_SUGAR;
3461 /* Lookup this name into the variables hash table */
3462 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3463 if (he == NULL) {
3464 /* Try with static vars. */
3465 if (interp->framePtr->staticVars == NULL)
3466 return JIM_ERR;
3467 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3468 return JIM_ERR;
3469 }
3470 /* Free the old internal repr and set the new one. */
3471 Jim_FreeIntRep(interp, objPtr);
3472 objPtr->typePtr = &variableObjType;
3473 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3474 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3475 return JIM_OK;
3476 }
3477
3478 /* -------------------- Variables related functions ------------------------- */
3479 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3480 Jim_Obj *valObjPtr);
3481 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3482
3483 /* For now that's dummy. Variables lookup should be optimized
3484 * in many ways, with caching of lookups, and possibly with
3485 * a table of pre-allocated vars in every CallFrame for local vars.
3486 * All the caching should also have an 'epoch' mechanism similar
3487 * to the one used by Tcl for procedures lookup caching. */
3488
3489 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3490 {
3491 const char *name;
3492 Jim_Var *var;
3493 int err;
3494
3495 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3496 /* Check for [dict] syntax sugar. */
3497 if (err == JIM_DICT_SUGAR)
3498 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3499 /* New variable to create */
3500 name = Jim_GetString(nameObjPtr, NULL);
3501
3502 var = Jim_Alloc(sizeof(*var));
3503 var->objPtr = valObjPtr;
3504 Jim_IncrRefCount(valObjPtr);
3505 var->linkFramePtr = NULL;
3506 /* Insert the new variable */
3507 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3508 /* Make the object int rep a variable */
3509 Jim_FreeIntRep(interp, nameObjPtr);
3510 nameObjPtr->typePtr = &variableObjType;
3511 nameObjPtr->internalRep.varValue.callFrameId =
3512 interp->framePtr->id;
3513 nameObjPtr->internalRep.varValue.varPtr = var;
3514 } else {
3515 var = nameObjPtr->internalRep.varValue.varPtr;
3516 if (var->linkFramePtr == NULL) {
3517 Jim_IncrRefCount(valObjPtr);
3518 Jim_DecrRefCount(interp, var->objPtr);
3519 var->objPtr = valObjPtr;
3520 } else { /* Else handle the link */
3521 Jim_CallFrame *savedCallFrame;
3522
3523 savedCallFrame = interp->framePtr;
3524 interp->framePtr = var->linkFramePtr;
3525 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3526 interp->framePtr = savedCallFrame;
3527 if (err != JIM_OK)
3528 return err;
3529 }
3530 }
3531 return JIM_OK;
3532 }
3533
3534 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3535 {
3536 Jim_Obj *nameObjPtr;
3537 int result;
3538
3539 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3540 Jim_IncrRefCount(nameObjPtr);
3541 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3542 Jim_DecrRefCount(interp, nameObjPtr);
3543 return result;
3544 }
3545
3546 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3547 {
3548 Jim_CallFrame *savedFramePtr;
3549 int result;
3550
3551 savedFramePtr = interp->framePtr;
3552 interp->framePtr = interp->topFramePtr;
3553 result = Jim_SetVariableStr(interp, name, objPtr);
3554 interp->framePtr = savedFramePtr;
3555 return result;
3556 }
3557
3558 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3559 {
3560 Jim_Obj *nameObjPtr, *valObjPtr;
3561 int result;
3562
3563 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3564 valObjPtr = Jim_NewStringObj(interp, val, -1);
3565 Jim_IncrRefCount(nameObjPtr);
3566 Jim_IncrRefCount(valObjPtr);
3567 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3568 Jim_DecrRefCount(interp, nameObjPtr);
3569 Jim_DecrRefCount(interp, valObjPtr);
3570 return result;
3571 }
3572
3573 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3574 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3575 {
3576 const char *varName;
3577 int len;
3578
3579 /* Check for cycles. */
3580 if (interp->framePtr == targetCallFrame) {
3581 Jim_Obj *objPtr = targetNameObjPtr;
3582 Jim_Var *varPtr;
3583 /* Cycles are only possible with 'uplevel 0' */
3584 while(1) {
3585 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3586 Jim_SetResultString(interp,
3587 "can't upvar from variable to itself", -1);
3588 return JIM_ERR;
3589 }
3590 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3591 break;
3592 varPtr = objPtr->internalRep.varValue.varPtr;
3593 if (varPtr->linkFramePtr != targetCallFrame) break;
3594 objPtr = varPtr->objPtr;
3595 }
3596 }
3597 varName = Jim_GetString(nameObjPtr, &len);
3598 if (Jim_NameIsDictSugar(varName, len)) {
3599 Jim_SetResultString(interp,
3600 "Dict key syntax invalid as link source", -1);
3601 return JIM_ERR;
3602 }
3603 /* Perform the binding */
3604 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3605 /* We are now sure 'nameObjPtr' type is variableObjType */
3606 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3607 return JIM_OK;
3608 }
3609
3610 /* Return the Jim_Obj pointer associated with a variable name,
3611 * or NULL if the variable was not found in the current context.
3612 * The same optimization discussed in the comment to the
3613 * 'SetVariable' function should apply here. */
3614 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3615 {
3616 int err;
3617
3618 /* All the rest is handled here */
3619 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3620 /* Check for [dict] syntax sugar. */
3621 if (err == JIM_DICT_SUGAR)
3622 return JimDictSugarGet(interp, nameObjPtr);
3623 if (flags & JIM_ERRMSG) {
3624 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3625 Jim_AppendStrings(interp, Jim_GetResult(interp),
3626 "can't read \"", nameObjPtr->bytes,
3627 "\": no such variable", NULL);
3628 }
3629 return NULL;
3630 } else {
3631 Jim_Var *varPtr;
3632 Jim_Obj *objPtr;
3633 Jim_CallFrame *savedCallFrame;
3634
3635 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3636 if (varPtr->linkFramePtr == NULL)
3637 return varPtr->objPtr;
3638 /* The variable is a link? Resolve it. */
3639 savedCallFrame = interp->framePtr;
3640 interp->framePtr = varPtr->linkFramePtr;
3641 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3642 if (objPtr == NULL && flags & JIM_ERRMSG) {
3643 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3644 Jim_AppendStrings(interp, Jim_GetResult(interp),
3645 "can't read \"", nameObjPtr->bytes,
3646 "\": no such variable", NULL);
3647 }
3648 interp->framePtr = savedCallFrame;
3649 return objPtr;
3650 }
3651 }
3652
3653 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3654 int flags)
3655 {
3656 Jim_CallFrame *savedFramePtr;
3657 Jim_Obj *objPtr;
3658
3659 savedFramePtr = interp->framePtr;
3660 interp->framePtr = interp->topFramePtr;
3661 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3662 interp->framePtr = savedFramePtr;
3663
3664 return objPtr;
3665 }
3666
3667 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3668 {
3669 Jim_Obj *nameObjPtr, *varObjPtr;
3670
3671 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3672 Jim_IncrRefCount(nameObjPtr);
3673 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3674 Jim_DecrRefCount(interp, nameObjPtr);
3675 return varObjPtr;
3676 }
3677
3678 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3679 int flags)
3680 {
3681 Jim_CallFrame *savedFramePtr;
3682 Jim_Obj *objPtr;
3683
3684 savedFramePtr = interp->framePtr;
3685 interp->framePtr = interp->topFramePtr;
3686 objPtr = Jim_GetVariableStr(interp, name, flags);
3687 interp->framePtr = savedFramePtr;
3688
3689 return objPtr;
3690 }
3691
3692 /* Unset a variable.
3693 * Note: On success unset invalidates all the variable objects created
3694 * in the current call frame incrementing. */
3695 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3696 {
3697 const char *name;
3698 Jim_Var *varPtr;
3699 int err;
3700
3701 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3702 /* Check for [dict] syntax sugar. */
3703 if (err == JIM_DICT_SUGAR)
3704 return JimDictSugarSet(interp, nameObjPtr, NULL);
3705 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3706 Jim_AppendStrings(interp, Jim_GetResult(interp),
3707 "can't unset \"", nameObjPtr->bytes,
3708 "\": no such variable", NULL);
3709 return JIM_ERR; /* var not found */
3710 }
3711 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3712 /* If it's a link call UnsetVariable recursively */
3713 if (varPtr->linkFramePtr) {
3714 int retval;
3715
3716 Jim_CallFrame *savedCallFrame;
3717
3718 savedCallFrame = interp->framePtr;
3719 interp->framePtr = varPtr->linkFramePtr;
3720 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3721 interp->framePtr = savedCallFrame;
3722 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3723 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3724 Jim_AppendStrings(interp, Jim_GetResult(interp),
3725 "can't unset \"", nameObjPtr->bytes,
3726 "\": no such variable", NULL);
3727 }
3728 return retval;
3729 } else {
3730 name = Jim_GetString(nameObjPtr, NULL);
3731 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3732 != JIM_OK) return JIM_ERR;
3733 /* Change the callframe id, invalidating var lookup caching */
3734 JimChangeCallFrameId(interp, interp->framePtr);
3735 return JIM_OK;
3736 }
3737 }
3738
3739 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3740
3741 /* Given a variable name for [dict] operation syntax sugar,
3742 * this function returns two objects, the first with the name
3743 * of the variable to set, and the second with the rispective key.
3744 * For example "foo(bar)" will return objects with string repr. of
3745 * "foo" and "bar".
3746 *
3747 * The returned objects have refcount = 1. The function can't fail. */
3748 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3749 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3750 {
3751 const char *str, *p;
3752 char *t;
3753 int len, keyLen, nameLen;
3754 Jim_Obj *varObjPtr, *keyObjPtr;
3755
3756 str = Jim_GetString(objPtr, &len);
3757 p = strchr(str, '(');
3758 p++;
3759 keyLen = len-((p-str)+1);
3760 nameLen = (p-str)-1;
3761 /* Create the objects with the variable name and key. */
3762 t = Jim_Alloc(nameLen+1);
3763 memcpy(t, str, nameLen);
3764 t[nameLen] = '\0';
3765 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3766
3767 t = Jim_Alloc(keyLen+1);
3768 memcpy(t, p, keyLen);
3769 t[keyLen] = '\0';
3770 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3771
3772 Jim_IncrRefCount(varObjPtr);
3773 Jim_IncrRefCount(keyObjPtr);
3774 *varPtrPtr = varObjPtr;
3775 *keyPtrPtr = keyObjPtr;
3776 }
3777
3778 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3779 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3780 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3781 Jim_Obj *valObjPtr)
3782 {
3783 Jim_Obj *varObjPtr, *keyObjPtr;
3784 int err = JIM_OK;
3785
3786 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3787 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3788 valObjPtr);
3789 Jim_DecrRefCount(interp, varObjPtr);
3790 Jim_DecrRefCount(interp, keyObjPtr);
3791 return err;
3792 }
3793
3794 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3795 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3796 {
3797 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3798
3799 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3800 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3801 if (!dictObjPtr) {
3802 resObjPtr = NULL;
3803 goto err;
3804 }
3805 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3806 != JIM_OK) {
3807 resObjPtr = NULL;
3808 }
3809 err:
3810 Jim_DecrRefCount(interp, varObjPtr);
3811 Jim_DecrRefCount(interp, keyObjPtr);
3812 return resObjPtr;
3813 }
3814
3815 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3816
3817 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3818 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3819 Jim_Obj *dupPtr);
3820
3821 static Jim_ObjType dictSubstObjType = {
3822 "dict-substitution",
3823 FreeDictSubstInternalRep,
3824 DupDictSubstInternalRep,
3825 NULL,
3826 JIM_TYPE_NONE,
3827 };
3828
3829 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3830 {
3831 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3832 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3833 }
3834
3835 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3836 Jim_Obj *dupPtr)
3837 {
3838 JIM_NOTUSED(interp);
3839
3840 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3841 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3842 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3843 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3844 dupPtr->typePtr = &dictSubstObjType;
3845 }
3846
3847 /* This function is used to expand [dict get] sugar in the form
3848 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3849 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3850 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3851 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3852 * the [dict]ionary contained in variable VARNAME. */
3853 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3854 {
3855 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3856 Jim_Obj *substKeyObjPtr = NULL;
3857
3858 if (objPtr->typePtr != &dictSubstObjType) {
3859 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3860 Jim_FreeIntRep(interp, objPtr);
3861 objPtr->typePtr = &dictSubstObjType;
3862 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3863 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3864 }
3865 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3866 &substKeyObjPtr, JIM_NONE)
3867 != JIM_OK) {
3868 substKeyObjPtr = NULL;
3869 goto err;
3870 }
3871 Jim_IncrRefCount(substKeyObjPtr);
3872 dictObjPtr = Jim_GetVariable(interp,
3873 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3874 if (!dictObjPtr) {
3875 resObjPtr = NULL;
3876 goto err;
3877 }
3878 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3879 != JIM_OK) {
3880 resObjPtr = NULL;
3881 goto err;
3882 }
3883 err:
3884 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3885 return resObjPtr;
3886 }
3887
3888 /* -----------------------------------------------------------------------------
3889 * CallFrame
3890 * ---------------------------------------------------------------------------*/
3891
3892 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3893 {
3894 Jim_CallFrame *cf;
3895 if (interp->freeFramesList) {
3896 cf = interp->freeFramesList;
3897 interp->freeFramesList = cf->nextFramePtr;
3898 } else {
3899 cf = Jim_Alloc(sizeof(*cf));
3900 cf->vars.table = NULL;
3901 }
3902
3903 cf->id = interp->callFrameEpoch++;
3904 cf->parentCallFrame = NULL;
3905 cf->argv = NULL;
3906 cf->argc = 0;
3907 cf->procArgsObjPtr = NULL;
3908 cf->procBodyObjPtr = NULL;
3909 cf->nextFramePtr = NULL;
3910 cf->staticVars = NULL;
3911 if (cf->vars.table == NULL)
3912 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3913 return cf;
3914 }
3915
3916 /* Used to invalidate every caching related to callframe stability. */
3917 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3918 {
3919 cf->id = interp->callFrameEpoch++;
3920 }
3921
3922 #define JIM_FCF_NONE 0 /* no flags */
3923 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3924 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3925 int flags)
3926 {
3927 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3928 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3929 if (!(flags & JIM_FCF_NOHT))
3930 Jim_FreeHashTable(&cf->vars);
3931 else {
3932 int i;
3933 Jim_HashEntry **table = cf->vars.table, *he;
3934
3935 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3936 he = table[i];
3937 while (he != NULL) {
3938 Jim_HashEntry *nextEntry = he->next;
3939 Jim_Var *varPtr = (void*) he->val;
3940
3941 Jim_DecrRefCount(interp, varPtr->objPtr);
3942 Jim_Free(he->val);
3943 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3944 Jim_Free(he);
3945 table[i] = NULL;
3946 he = nextEntry;
3947 }
3948 }
3949 cf->vars.used = 0;
3950 }
3951 cf->nextFramePtr = interp->freeFramesList;
3952 interp->freeFramesList = cf;
3953 }
3954
3955 /* -----------------------------------------------------------------------------
3956 * References
3957 * ---------------------------------------------------------------------------*/
3958
3959 /* References HashTable Type.
3960 *
3961 * Keys are jim_wide integers, dynamically allocated for now but in the
3962 * future it's worth to cache this 8 bytes objects. Values are poitners
3963 * to Jim_References. */
3964 static void JimReferencesHTValDestructor(void *interp, void *val)
3965 {
3966 Jim_Reference *refPtr = (void*) val;
3967
3968 Jim_DecrRefCount(interp, refPtr->objPtr);
3969 if (refPtr->finalizerCmdNamePtr != NULL) {
3970 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
3971 }
3972 Jim_Free(val);
3973 }
3974
3975 unsigned int JimReferencesHTHashFunction(const void *key)
3976 {
3977 /* Only the least significant bits are used. */
3978 const jim_wide *widePtr = key;
3979 unsigned int intValue = (unsigned int) *widePtr;
3980 return Jim_IntHashFunction(intValue);
3981 }
3982
3983 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
3984 {
3985 /* Only the least significant bits are used. */
3986 const jim_wide *widePtr = key;
3987 unsigned int intValue = (unsigned int) *widePtr;
3988 return intValue; /* identity function. */
3989 }
3990
3991 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
3992 {
3993 void *copy = Jim_Alloc(sizeof(jim_wide));
3994 JIM_NOTUSED(privdata);
3995
3996 memcpy(copy, key, sizeof(jim_wide));
3997 return copy;
3998 }
3999
4000 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4001 const void *key2)
4002 {
4003 JIM_NOTUSED(privdata);
4004
4005 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4006 }
4007
4008 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4009 {
4010 JIM_NOTUSED(privdata);
4011
4012 Jim_Free((void*)key);
4013 }
4014
4015 static Jim_HashTableType JimReferencesHashTableType = {
4016 JimReferencesHTHashFunction, /* hash function */
4017 JimReferencesHTKeyDup, /* key dup */
4018 NULL, /* val dup */
4019 JimReferencesHTKeyCompare, /* key compare */
4020 JimReferencesHTKeyDestructor, /* key destructor */
4021 JimReferencesHTValDestructor /* val destructor */
4022 };
4023
4024 /* -----------------------------------------------------------------------------
4025 * Reference object type and References API
4026 * ---------------------------------------------------------------------------*/
4027
4028 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4029
4030 static Jim_ObjType referenceObjType = {
4031 "reference",
4032 NULL,
4033 NULL,
4034 UpdateStringOfReference,
4035 JIM_TYPE_REFERENCES,
4036 };
4037
4038 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4039 {
4040 int len;
4041 char buf[JIM_REFERENCE_SPACE+1];
4042 Jim_Reference *refPtr;
4043
4044 refPtr = objPtr->internalRep.refValue.refPtr;
4045 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4046 objPtr->bytes = Jim_Alloc(len+1);
4047 memcpy(objPtr->bytes, buf, len+1);
4048 objPtr->length = len;
4049 }
4050
4051 /* returns true if 'c' is a valid reference tag character.
4052 * i.e. inside the range [_a-zA-Z0-9] */
4053 static int isrefchar(int c)
4054 {
4055 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4056 (c >= '0' && c <= '9')) return 1;
4057 return 0;
4058 }
4059
4060 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4061 {
4062 jim_wide wideValue;
4063 int i, len;
4064 const char *str, *start, *end;
4065 char refId[21];
4066 Jim_Reference *refPtr;
4067 Jim_HashEntry *he;
4068
4069 /* Get the string representation */
4070 str = Jim_GetString(objPtr, &len);
4071 /* Check if it looks like a reference */
4072 if (len < JIM_REFERENCE_SPACE) goto badformat;
4073 /* Trim spaces */
4074 start = str;
4075 end = str+len-1;
4076 while (*start == ' ') start++;
4077 while (*end == ' ' && end > start) end--;
4078 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4079 /* <reference.<1234567>.%020> */
4080 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4081 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4082 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4083 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4084 if (!isrefchar(start[12+i])) goto badformat;
4085 }
4086 /* Extract info from the refernece. */
4087 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4088 refId[20] = '\0';
4089 /* Try to convert the ID into a jim_wide */
4090 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4091 /* Check if the reference really exists! */
4092 he = Jim_FindHashEntry(&interp->references, &wideValue);
4093 if (he == NULL) {
4094 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4095 Jim_AppendStrings(interp, Jim_GetResult(interp),
4096 "Invalid reference ID \"", str, "\"", NULL);
4097 return JIM_ERR;
4098 }
4099 refPtr = he->val;
4100 /* Free the old internal repr and set the new one. */
4101 Jim_FreeIntRep(interp, objPtr);
4102 objPtr->typePtr = &referenceObjType;
4103 objPtr->internalRep.refValue.id = wideValue;
4104 objPtr->internalRep.refValue.refPtr = refPtr;
4105 return JIM_OK;
4106
4107 badformat:
4108 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4109 Jim_AppendStrings(interp, Jim_GetResult(interp),
4110 "expected reference but got \"", str, "\"", NULL);
4111 return JIM_ERR;
4112 }
4113
4114 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4115 * as finalizer command (or NULL if there is no finalizer).
4116 * The returned reference object has refcount = 0. */
4117 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4118 Jim_Obj *cmdNamePtr)
4119 {
4120 struct Jim_Reference *refPtr;
4121 jim_wide wideValue = interp->referenceNextId;
4122 Jim_Obj *refObjPtr;
4123 const char *tag;
4124 int tagLen, i;
4125
4126 /* Perform the Garbage Collection if needed. */
4127 Jim_CollectIfNeeded(interp);
4128
4129 refPtr = Jim_Alloc(sizeof(*refPtr));
4130 refPtr->objPtr = objPtr;
4131 Jim_IncrRefCount(objPtr);
4132 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4133 if (cmdNamePtr)
4134 Jim_IncrRefCount(cmdNamePtr);
4135 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4136 refObjPtr = Jim_NewObj(interp);
4137 refObjPtr->typePtr = &referenceObjType;
4138 refObjPtr->bytes = NULL;
4139 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4140 refObjPtr->internalRep.refValue.refPtr = refPtr;
4141 interp->referenceNextId++;
4142 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4143 * that does not pass the 'isrefchar' test is replaced with '_' */
4144 tag = Jim_GetString(tagPtr, &tagLen);
4145 if (tagLen > JIM_REFERENCE_TAGLEN)
4146 tagLen = JIM_REFERENCE_TAGLEN;
4147 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4148 if (i < tagLen)
4149 refPtr->tag[i] = tag[i];
4150 else
4151 refPtr->tag[i] = '_';
4152 }
4153 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4154 return refObjPtr;
4155 }
4156
4157 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4158 {
4159 if (objPtr->typePtr != &referenceObjType &&
4160 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4161 return NULL;
4162 return objPtr->internalRep.refValue.refPtr;
4163 }
4164
4165 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4166 {
4167 Jim_Reference *refPtr;
4168
4169 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4170 return JIM_ERR;
4171 Jim_IncrRefCount(cmdNamePtr);
4172 if (refPtr->finalizerCmdNamePtr)
4173 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4174 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4175 return JIM_OK;
4176 }
4177
4178 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4179 {
4180 Jim_Reference *refPtr;
4181
4182 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4183 return JIM_ERR;
4184 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4185 return JIM_OK;
4186 }
4187
4188 /* -----------------------------------------------------------------------------
4189 * References Garbage Collection
4190 * ---------------------------------------------------------------------------*/
4191
4192 /* This the hash table type for the "MARK" phase of the GC */
4193 static Jim_HashTableType JimRefMarkHashTableType = {
4194 JimReferencesHTHashFunction, /* hash function */
4195 JimReferencesHTKeyDup, /* key dup */
4196 NULL, /* val dup */
4197 JimReferencesHTKeyCompare, /* key compare */
4198 JimReferencesHTKeyDestructor, /* key destructor */
4199 NULL /* val destructor */
4200 };
4201
4202 /* #define JIM_DEBUG_GC 1 */
4203
4204 /* Performs the garbage collection. */
4205 int Jim_Collect(Jim_Interp *interp)
4206 {
4207 Jim_HashTable marks;
4208 Jim_HashTableIterator *htiter;
4209 Jim_HashEntry *he;
4210 Jim_Obj *objPtr;
4211 int collected = 0;
4212
4213 /* Avoid recursive calls */
4214 if (interp->lastCollectId == -1) {
4215 /* Jim_Collect() already running. Return just now. */
4216 return 0;
4217 }
4218 interp->lastCollectId = -1;
4219
4220 /* Mark all the references found into the 'mark' hash table.
4221 * The references are searched in every live object that
4222 * is of a type that can contain references. */
4223 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4224 objPtr = interp->liveList;
4225 while(objPtr) {
4226 if (objPtr->typePtr == NULL ||
4227 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4228 const char *str, *p;
4229 int len;
4230
4231 /* If the object is of type reference, to get the
4232 * Id is simple... */
4233 if (objPtr->typePtr == &referenceObjType) {
4234 Jim_AddHashEntry(&marks,
4235 &objPtr->internalRep.refValue.id, NULL);
4236 #ifdef JIM_DEBUG_GC
4237 Jim_fprintf(interp,interp->cookie_stdout,
4238 "MARK (reference): %d refcount: %d" JIM_NL,
4239 (int) objPtr->internalRep.refValue.id,
4240 objPtr->refCount);
4241 #endif
4242 objPtr = objPtr->nextObjPtr;
4243 continue;
4244 }
4245 /* Get the string repr of the object we want
4246 * to scan for references. */
4247 p = str = Jim_GetString(objPtr, &len);
4248 /* Skip objects too little to contain references. */
4249 if (len < JIM_REFERENCE_SPACE) {
4250 objPtr = objPtr->nextObjPtr;
4251 continue;
4252 }
4253 /* Extract references from the object string repr. */
4254 while(1) {
4255 int i;
4256 jim_wide id;
4257 char buf[21];
4258
4259 if ((p = strstr(p, "<reference.<")) == NULL)
4260 break;
4261 /* Check if it's a valid reference. */
4262 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4263 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4264 for (i = 21; i <= 40; i++)
4265 if (!isdigit((int)p[i]))
4266 break;
4267 /* Get the ID */
4268 memcpy(buf, p+21, 20);
4269 buf[20] = '\0';
4270 Jim_StringToWide(buf, &id, 10);
4271
4272 /* Ok, a reference for the given ID
4273 * was found. Mark it. */
4274 Jim_AddHashEntry(&marks, &id, NULL);
4275 #ifdef JIM_DEBUG_GC
4276 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4277 #endif
4278 p += JIM_REFERENCE_SPACE;
4279 }
4280 }
4281 objPtr = objPtr->nextObjPtr;
4282 }
4283
4284 /* Run the references hash table to destroy every reference that
4285 * is not referenced outside (not present in the mark HT). */
4286 htiter = Jim_GetHashTableIterator(&interp->references);
4287 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4288 const jim_wide *refId;
4289 Jim_Reference *refPtr;
4290
4291 refId = he->key;
4292 /* Check if in the mark phase we encountered
4293 * this reference. */
4294 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4295 #ifdef JIM_DEBUG_GC
4296 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4297 #endif
4298 collected++;
4299 /* Drop the reference, but call the
4300 * finalizer first if registered. */
4301 refPtr = he->val;
4302 if (refPtr->finalizerCmdNamePtr) {
4303 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4304 Jim_Obj *objv[3], *oldResult;
4305
4306 JimFormatReference(refstr, refPtr, *refId);
4307
4308 objv[0] = refPtr->finalizerCmdNamePtr;
4309 objv[1] = Jim_NewStringObjNoAlloc(interp,
4310 refstr, 32);
4311 objv[2] = refPtr->objPtr;
4312 Jim_IncrRefCount(objv[0]);
4313 Jim_IncrRefCount(objv[1]);
4314 Jim_IncrRefCount(objv[2]);
4315
4316 /* Drop the reference itself */
4317 Jim_DeleteHashEntry(&interp->references, refId);
4318
4319 /* Call the finalizer. Errors ignored. */
4320 oldResult = interp->result;
4321 Jim_IncrRefCount(oldResult);
4322 Jim_EvalObjVector(interp, 3, objv);
4323 Jim_SetResult(interp, oldResult);
4324 Jim_DecrRefCount(interp, oldResult);
4325
4326 Jim_DecrRefCount(interp, objv[0]);
4327 Jim_DecrRefCount(interp, objv[1]);
4328 Jim_DecrRefCount(interp, objv[2]);
4329 } else {
4330 Jim_DeleteHashEntry(&interp->references, refId);
4331 }
4332 }
4333 }
4334 Jim_FreeHashTableIterator(htiter);
4335 Jim_FreeHashTable(&marks);
4336 interp->lastCollectId = interp->referenceNextId;
4337 interp->lastCollectTime = time(NULL);
4338 return collected;
4339 }
4340
4341 #define JIM_COLLECT_ID_PERIOD 5000
4342 #define JIM_COLLECT_TIME_PERIOD 300
4343
4344 void Jim_CollectIfNeeded(Jim_Interp *interp)
4345 {
4346 jim_wide elapsedId;
4347 int elapsedTime;
4348
4349 elapsedId = interp->referenceNextId - interp->lastCollectId;
4350 elapsedTime = time(NULL) - interp->lastCollectTime;
4351
4352
4353 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4354 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4355 Jim_Collect(interp);
4356 }
4357 }
4358
4359 /* -----------------------------------------------------------------------------
4360 * Interpreter related functions
4361 * ---------------------------------------------------------------------------*/
4362
4363 Jim_Interp *Jim_CreateInterp(void)
4364 {
4365 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4366 Jim_Obj *pathPtr;
4367
4368 i->errorLine = 0;
4369 i->errorFileName = Jim_StrDup("");
4370 i->numLevels = 0;
4371 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4372 i->returnCode = JIM_OK;
4373 i->exitCode = 0;
4374 i->procEpoch = 0;
4375 i->callFrameEpoch = 0;
4376 i->liveList = i->freeList = NULL;
4377 i->scriptFileName = Jim_StrDup("");
4378 i->referenceNextId = 0;
4379 i->lastCollectId = 0;
4380 i->lastCollectTime = time(NULL);
4381 i->freeFramesList = NULL;
4382 i->prngState = NULL;
4383 i->evalRetcodeLevel = -1;
4384 i->cookie_stdin = stdin;
4385 i->cookie_stdout = stdout;
4386 i->cookie_stderr = stderr;
4387 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4388 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4389 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4390 i->cb_fflush = ((int (*)( void *))(fflush));
4391 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4392
4393 /* Note that we can create objects only after the
4394 * interpreter liveList and freeList pointers are
4395 * initialized to NULL. */
4396 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4397 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4398 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4399 NULL);
4400 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4401 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4402 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4403 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4404 i->emptyObj = Jim_NewEmptyStringObj(i);
4405 i->result = i->emptyObj;
4406 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4407 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4408 Jim_IncrRefCount(i->emptyObj);
4409 Jim_IncrRefCount(i->result);
4410 Jim_IncrRefCount(i->stackTrace);
4411 Jim_IncrRefCount(i->unknown);
4412
4413 /* Initialize key variables every interpreter should contain */
4414 pathPtr = Jim_NewStringObj(i, "./", -1);
4415 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4416 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4417
4418 /* Export the core API to extensions */
4419 JimRegisterCoreApi(i);
4420 return i;
4421 }
4422
4423 /* This is the only function Jim exports directly without
4424 * to use the STUB system. It is only used by embedders
4425 * in order to get an interpreter with the Jim API pointers
4426 * registered. */
4427 Jim_Interp *ExportedJimCreateInterp(void)
4428 {
4429 return Jim_CreateInterp();
4430 }
4431
4432 void Jim_FreeInterp(Jim_Interp *i)
4433 {
4434 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4435 Jim_Obj *objPtr, *nextObjPtr;
4436
4437 Jim_DecrRefCount(i, i->emptyObj);
4438 Jim_DecrRefCount(i, i->result);
4439 Jim_DecrRefCount(i, i->stackTrace);
4440 Jim_DecrRefCount(i, i->unknown);
4441 Jim_Free((void*)i->errorFileName);
4442 Jim_Free((void*)i->scriptFileName);
4443 Jim_FreeHashTable(&i->commands);
4444 Jim_FreeHashTable(&i->references);
4445 Jim_FreeHashTable(&i->stub);
4446 Jim_FreeHashTable(&i->assocData);
4447 Jim_FreeHashTable(&i->packages);
4448 Jim_Free(i->prngState);
4449 /* Free the call frames list */
4450 while(cf) {
4451 prevcf = cf->parentCallFrame;
4452 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4453 cf = prevcf;
4454 }
4455 /* Check that the live object list is empty, otherwise
4456 * there is a memory leak. */
4457 if (i->liveList != NULL) {
4458 Jim_Obj *objPtr = i->liveList;
4459
4460 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4461 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4462 while(objPtr) {
4463 const char *type = objPtr->typePtr ?
4464 objPtr->typePtr->name : "";
4465 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4466 objPtr, type,
4467 objPtr->bytes ? objPtr->bytes
4468 : "(null)", objPtr->refCount);
4469 if (objPtr->typePtr == &sourceObjType) {
4470 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4471 objPtr->internalRep.sourceValue.fileName,
4472 objPtr->internalRep.sourceValue.lineNumber);
4473 }
4474 objPtr = objPtr->nextObjPtr;
4475 }
4476 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4477 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4478 }
4479 /* Free all the freed objects. */
4480 objPtr = i->freeList;
4481 while (objPtr) {
4482 nextObjPtr = objPtr->nextObjPtr;
4483 Jim_Free(objPtr);
4484 objPtr = nextObjPtr;
4485 }
4486 /* Free cached CallFrame structures */
4487 cf = i->freeFramesList;
4488 while(cf) {
4489 nextcf = cf->nextFramePtr;
4490 if (cf->vars.table != NULL)
4491 Jim_Free(cf->vars.table);
4492 Jim_Free(cf);
4493 cf = nextcf;
4494 }
4495 /* Free the sharedString hash table. Make sure to free it
4496 * after every other Jim_Object was freed. */
4497 Jim_FreeHashTable(&i->sharedStrings);
4498 /* Free the interpreter structure. */
4499 Jim_Free(i);
4500 }
4501
4502 /* Store the call frame relative to the level represented by
4503 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4504 * level is assumed to be '1'.
4505 *
4506 * If a newLevelptr int pointer is specified, the function stores
4507 * the absolute level integer value of the new target callframe into
4508 * *newLevelPtr. (this is used to adjust interp->numLevels
4509 * in the implementation of [uplevel], so that [info level] will
4510 * return a correct information).
4511 *
4512 * This function accepts the 'level' argument in the form
4513 * of the commands [uplevel] and [upvar].
4514 *
4515 * For a function accepting a relative integer as level suitable
4516 * for implementation of [info level ?level?] check the
4517 * GetCallFrameByInteger() function. */
4518 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4519 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4520 {
4521 long level;
4522 const char *str;
4523 Jim_CallFrame *framePtr;
4524
4525 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4526 if (levelObjPtr) {
4527 str = Jim_GetString(levelObjPtr, NULL);
4528 if (str[0] == '#') {
4529 char *endptr;
4530 /* speedup for the toplevel (level #0) */
4531 if (str[1] == '0' && str[2] == '\0') {
4532 if (newLevelPtr) *newLevelPtr = 0;
4533 *framePtrPtr = interp->topFramePtr;
4534 return JIM_OK;
4535 }
4536
4537 level = strtol(str+1, &endptr, 0);
4538 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4539 goto badlevel;
4540 /* An 'absolute' level is converted into the
4541 * 'number of levels to go back' format. */
4542 level = interp->numLevels - level;
4543 if (level < 0) goto badlevel;
4544 } else {
4545 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4546 goto badlevel;
4547 }
4548 } else {
4549 str = "1"; /* Needed to format the error message. */
4550 level = 1;
4551 }
4552 /* Lookup */
4553 framePtr = interp->framePtr;
4554 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4555 while (level--) {
4556 framePtr = framePtr->parentCallFrame;
4557 if (framePtr == NULL) goto badlevel;
4558 }
4559 *framePtrPtr = framePtr;
4560 return JIM_OK;
4561 badlevel:
4562 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4563 Jim_AppendStrings(interp, Jim_GetResult(interp),
4564 "bad level \"", str, "\"", NULL);
4565 return JIM_ERR;
4566 }
4567
4568 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4569 * as a relative integer like in the [info level ?level?] command. */
4570 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4571 Jim_CallFrame **framePtrPtr)
4572 {
4573 jim_wide level;
4574 jim_wide relLevel; /* level relative to the current one. */
4575 Jim_CallFrame *framePtr;
4576
4577 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4578 goto badlevel;
4579 if (level > 0) {
4580 /* An 'absolute' level is converted into the
4581 * 'number of levels to go back' format. */
4582 relLevel = interp->numLevels - level;
4583 } else {
4584 relLevel = -level;
4585 }
4586 /* Lookup */
4587 framePtr = interp->framePtr;
4588 while (relLevel--) {
4589 framePtr = framePtr->parentCallFrame;
4590 if (framePtr == NULL) goto badlevel;
4591 }
4592 *framePtrPtr = framePtr;
4593 return JIM_OK;
4594 badlevel:
4595 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4596 Jim_AppendStrings(interp, Jim_GetResult(interp),
4597 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4598 return JIM_ERR;
4599 }
4600
4601 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4602 {
4603 Jim_Free((void*)interp->errorFileName);
4604 interp->errorFileName = Jim_StrDup(filename);
4605 }
4606
4607 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4608 {
4609 interp->errorLine = linenr;
4610 }
4611
4612 static void JimResetStackTrace(Jim_Interp *interp)
4613 {
4614 Jim_DecrRefCount(interp, interp->stackTrace);
4615 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4616 Jim_IncrRefCount(interp->stackTrace);
4617 }
4618
4619 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4620 const char *filename, int linenr)
4621 {
4622 if (Jim_IsShared(interp->stackTrace)) {
4623 interp->stackTrace =
4624 Jim_DuplicateObj(interp, interp->stackTrace);
4625 Jim_IncrRefCount(interp->stackTrace);
4626 }
4627 Jim_ListAppendElement(interp, interp->stackTrace,
4628 Jim_NewStringObj(interp, procname, -1));
4629 Jim_ListAppendElement(interp, interp->stackTrace,
4630 Jim_NewStringObj(interp, filename, -1));
4631 Jim_ListAppendElement(interp, interp->stackTrace,
4632 Jim_NewIntObj(interp, linenr));
4633 }
4634
4635 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4636 {
4637 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4638 assocEntryPtr->delProc = delProc;
4639 assocEntryPtr->data = data;
4640 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4641 }
4642
4643 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4644 {
4645 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4646 if (entryPtr != NULL) {
4647 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4648 return assocEntryPtr->data;
4649 }
4650 return NULL;
4651 }
4652
4653 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4654 {
4655 return Jim_DeleteHashEntry(&interp->assocData, key);
4656 }
4657
4658 int Jim_GetExitCode(Jim_Interp *interp) {
4659 return interp->exitCode;
4660 }
4661
4662 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4663 {
4664 if (fp != NULL) interp->cookie_stdin = fp;
4665 return interp->cookie_stdin;
4666 }
4667
4668 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4669 {
4670 if (fp != NULL) interp->cookie_stdout = fp;
4671 return interp->cookie_stdout;
4672 }
4673
4674 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4675 {
4676 if (fp != NULL) interp->cookie_stderr = fp;
4677 return interp->cookie_stderr;
4678 }
4679
4680 /* -----------------------------------------------------------------------------
4681 * Shared strings.
4682 * Every interpreter has an hash table where to put shared dynamically
4683 * allocate strings that are likely to be used a lot of times.
4684 * For example, in the 'source' object type, there is a pointer to
4685 * the filename associated with that object. Every script has a lot
4686 * of this objects with the identical file name, so it is wise to share
4687 * this info.
4688 *
4689 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4690 * returns the pointer to the shared string. Every time a reference
4691 * to the string is no longer used, the user should call
4692 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4693 * a given string, it is removed from the hash table.
4694 * ---------------------------------------------------------------------------*/
4695 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4696 {
4697 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4698
4699 if (he == NULL) {
4700 char *strCopy = Jim_StrDup(str);
4701
4702 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4703 return strCopy;
4704 } else {
4705 long refCount = (long) he->val;
4706
4707 refCount++;
4708 he->val = (void*) refCount;
4709 return he->key;
4710 }
4711 }
4712
4713 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4714 {
4715 long refCount;
4716 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4717
4718 if (he == NULL)
4719 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4720 "unknown shared string '%s'", str);
4721 refCount = (long) he->val;
4722 refCount--;
4723 if (refCount == 0) {
4724 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4725 } else {
4726 he->val = (void*) refCount;
4727 }
4728 }
4729
4730 /* -----------------------------------------------------------------------------
4731 * Integer object
4732 * ---------------------------------------------------------------------------*/
4733 #define JIM_INTEGER_SPACE 24
4734
4735 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4736 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4737
4738 static Jim_ObjType intObjType = {
4739 "int",
4740 NULL,
4741 NULL,
4742 UpdateStringOfInt,
4743 JIM_TYPE_NONE,
4744 };
4745
4746 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4747 {
4748 int len;
4749 char buf[JIM_INTEGER_SPACE+1];
4750
4751 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4752 objPtr->bytes = Jim_Alloc(len+1);
4753 memcpy(objPtr->bytes, buf, len+1);
4754 objPtr->length = len;
4755 }
4756
4757 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4758 {
4759 jim_wide wideValue;
4760 const char *str;
4761
4762 /* Get the string representation */
4763 str = Jim_GetString(objPtr, NULL);
4764 /* Try to convert into a jim_wide */
4765 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4766 if (flags & JIM_ERRMSG) {
4767 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4768 Jim_AppendStrings(interp, Jim_GetResult(interp),
4769 "expected integer but got \"", str, "\"", NULL);
4770 }
4771 return JIM_ERR;
4772 }
4773 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4774 errno == ERANGE) {
4775 Jim_SetResultString(interp,
4776 "Integer value too big to be represented", -1);
4777 return JIM_ERR;
4778 }
4779 /* Free the old internal repr and set the new one. */
4780 Jim_FreeIntRep(interp, objPtr);
4781 objPtr->typePtr = &intObjType;
4782 objPtr->internalRep.wideValue = wideValue;
4783 return JIM_OK;
4784 }
4785
4786 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4787 {
4788 if (objPtr->typePtr != &intObjType &&
4789 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4790 return JIM_ERR;
4791 *widePtr = objPtr->internalRep.wideValue;
4792 return JIM_OK;
4793 }
4794
4795 /* Get a wide but does not set an error if the format is bad. */
4796 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4797 jim_wide *widePtr)
4798 {
4799 if (objPtr->typePtr != &intObjType &&
4800 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4801 return JIM_ERR;
4802 *widePtr = objPtr->internalRep.wideValue;
4803 return JIM_OK;
4804 }
4805
4806 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4807 {
4808 jim_wide wideValue;
4809 int retval;
4810
4811 retval = Jim_GetWide(interp, objPtr, &wideValue);
4812 if (retval == JIM_OK) {
4813 *longPtr = (long) wideValue;
4814 return JIM_OK;
4815 }
4816 return JIM_ERR;
4817 }
4818
4819 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4820 {
4821 if (Jim_IsShared(objPtr))
4822 Jim_Panic(interp,"Jim_SetWide called with shared object");
4823 if (objPtr->typePtr != &intObjType) {
4824 Jim_FreeIntRep(interp, objPtr);
4825 objPtr->typePtr = &intObjType;
4826 }
4827 Jim_InvalidateStringRep(objPtr);
4828 objPtr->internalRep.wideValue = wideValue;
4829 }
4830
4831 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4832 {
4833 Jim_Obj *objPtr;
4834
4835 objPtr = Jim_NewObj(interp);
4836 objPtr->typePtr = &intObjType;
4837 objPtr->bytes = NULL;
4838 objPtr->internalRep.wideValue = wideValue;
4839 return objPtr;
4840 }
4841
4842 /* -----------------------------------------------------------------------------
4843 * Double object
4844 * ---------------------------------------------------------------------------*/
4845 #define JIM_DOUBLE_SPACE 30
4846
4847 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4848 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4849
4850 static Jim_ObjType doubleObjType = {
4851 "double",
4852 NULL,
4853 NULL,
4854 UpdateStringOfDouble,
4855 JIM_TYPE_NONE,
4856 };
4857
4858 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4859 {
4860 int len;
4861 char buf[JIM_DOUBLE_SPACE+1];
4862
4863 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4864 objPtr->bytes = Jim_Alloc(len+1);
4865 memcpy(objPtr->bytes, buf, len+1);
4866 objPtr->length = len;
4867 }
4868
4869 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4870 {
4871 double doubleValue;
4872 const char *str;
4873
4874 /* Get the string representation */
4875 str = Jim_GetString(objPtr, NULL);
4876 /* Try to convert into a double */
4877 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4878 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4879 Jim_AppendStrings(interp, Jim_GetResult(interp),
4880 "expected number but got '", str, "'", NULL);
4881 return JIM_ERR;
4882 }
4883 /* Free the old internal repr and set the new one. */
4884 Jim_FreeIntRep(interp, objPtr);
4885 objPtr->typePtr = &doubleObjType;
4886 objPtr->internalRep.doubleValue = doubleValue;
4887 return JIM_OK;
4888 }
4889
4890 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4891 {
4892 if (objPtr->typePtr != &doubleObjType &&
4893 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4894 return JIM_ERR;
4895 *doublePtr = objPtr->internalRep.doubleValue;
4896 return JIM_OK;
4897 }
4898
4899 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4900 {
4901 if (Jim_IsShared(objPtr))
4902 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4903 if (objPtr->typePtr != &doubleObjType) {
4904 Jim_FreeIntRep(interp, objPtr);
4905 objPtr->typePtr = &doubleObjType;
4906 }
4907 Jim_InvalidateStringRep(objPtr);
4908 objPtr->internalRep.doubleValue = doubleValue;
4909 }
4910
4911 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4912 {
4913 Jim_Obj *objPtr;
4914
4915 objPtr = Jim_NewObj(interp);
4916 objPtr->typePtr = &doubleObjType;
4917 objPtr->bytes = NULL;
4918 objPtr->internalRep.doubleValue = doubleValue;
4919 return objPtr;
4920 }
4921
4922 /* -----------------------------------------------------------------------------
4923 * List object
4924 * ---------------------------------------------------------------------------*/
4925 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4926 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4927 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4928 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4929 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4930
4931 /* Note that while the elements of the list may contain references,
4932 * the list object itself can't. This basically means that the
4933 * list object string representation as a whole can't contain references
4934 * that are not presents in the single elements. */
4935 static Jim_ObjType listObjType = {
4936 "list",
4937 FreeListInternalRep,
4938 DupListInternalRep,
4939 UpdateStringOfList,
4940 JIM_TYPE_NONE,
4941 };
4942
4943 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4944 {
4945 int i;
4946
4947 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4948 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4949 }
4950 Jim_Free(objPtr->internalRep.listValue.ele);
4951 }
4952
4953 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4954 {
4955 int i;
4956 JIM_NOTUSED(interp);
4957
4958 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4959 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4960 dupPtr->internalRep.listValue.ele =
4961 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4962 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4963 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4964 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4965 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4966 }
4967 dupPtr->typePtr = &listObjType;
4968 }
4969
4970 /* The following function checks if a given string can be encoded
4971 * into a list element without any kind of quoting, surrounded by braces,
4972 * or using escapes to quote. */
4973 #define JIM_ELESTR_SIMPLE 0
4974 #define JIM_ELESTR_BRACE 1
4975 #define JIM_ELESTR_QUOTE 2
4976 static int ListElementQuotingType(const char *s, int len)
4977 {
4978 int i, level, trySimple = 1;
4979
4980 /* Try with the SIMPLE case */
4981 if (len == 0) return JIM_ELESTR_BRACE;
4982 if (s[0] == '"' || s[0] == '{') {
4983 trySimple = 0;
4984 goto testbrace;
4985 }
4986 for (i = 0; i < len; i++) {
4987 switch(s[i]) {
4988 case ' ':
4989 case '$':
4990 case '"':
4991 case '[':
4992 case ']':
4993 case ';':
4994 case '\\':
4995 case '\r':
4996 case '\n':
4997 case '\t':
4998 case '\f':
4999 case '\v':
5000 trySimple = 0;
5001 case '{':
5002 case '}':
5003 goto testbrace;
5004 }
5005 }
5006 return JIM_ELESTR_SIMPLE;
5007
5008 testbrace:
5009 /* Test if it's possible to do with braces */
5010 if (s[len-1] == '\\' ||
5011 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5012 level = 0;
5013 for (i = 0; i < len; i++) {
5014 switch(s[i]) {
5015 case '{': level++; break;
5016 case '}': level--;
5017 if (level < 0) return JIM_ELESTR_QUOTE;
5018 break;
5019 case '\\':
5020 if (s[i+1] == '\n')
5021 return JIM_ELESTR_QUOTE;
5022 else
5023 if (s[i+1] != '\0') i++;
5024 break;
5025 }
5026 }
5027 if (level == 0) {
5028 if (!trySimple) return JIM_ELESTR_BRACE;
5029 for (i = 0; i < len; i++) {
5030 switch(s[i]) {
5031 case ' ':
5032 case '$':
5033 case '"':
5034 case '[':
5035 case ']':
5036 case ';':
5037 case '\\':
5038 case '\r':
5039 case '\n':
5040 case '\t':
5041 case '\f':
5042 case '\v':
5043 return JIM_ELESTR_BRACE;
5044 break;
5045 }
5046 }
5047 return JIM_ELESTR_SIMPLE;
5048 }
5049 return JIM_ELESTR_QUOTE;
5050 }
5051
5052 /* Returns the malloc-ed representation of a string
5053 * using backslash to quote special chars. */
5054 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5055 {
5056 char *q = Jim_Alloc(len*2+1), *p;
5057
5058 p = q;
5059 while(*s) {
5060 switch (*s) {
5061 case ' ':
5062 case '$':
5063 case '"':
5064 case '[':
5065 case ']':
5066 case '{':
5067 case '}':
5068 case ';':
5069 case '\\':
5070 *p++ = '\\';
5071 *p++ = *s++;
5072 break;
5073 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5074 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5075 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5076 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5077 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5078 default:
5079 *p++ = *s++;
5080 break;
5081 }
5082 }
5083 *p = '\0';
5084 *qlenPtr = p-q;
5085 return q;
5086 }
5087
5088 void UpdateStringOfList(struct Jim_Obj *objPtr)
5089 {
5090 int i, bufLen, realLength;
5091 const char *strRep;
5092 char *p;
5093 int *quotingType;
5094 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5095
5096 /* (Over) Estimate the space needed. */
5097 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5098 bufLen = 0;
5099 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5100 int len;
5101
5102 strRep = Jim_GetString(ele[i], &len);
5103 quotingType[i] = ListElementQuotingType(strRep, len);
5104 switch (quotingType[i]) {
5105 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5106 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5107 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5108 }
5109 bufLen++; /* elements separator. */
5110 }
5111 bufLen++;
5112
5113 /* Generate the string rep. */
5114 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5115 realLength = 0;
5116 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5117 int len, qlen;
5118 const char *strRep = Jim_GetString(ele[i], &len);
5119 char *q;
5120
5121 switch(quotingType[i]) {
5122 case JIM_ELESTR_SIMPLE:
5123 memcpy(p, strRep, len);
5124 p += len;
5125 realLength += len;
5126 break;
5127 case JIM_ELESTR_BRACE:
5128 *p++ = '{';
5129 memcpy(p, strRep, len);
5130 p += len;
5131 *p++ = '}';
5132 realLength += len+2;
5133 break;
5134 case JIM_ELESTR_QUOTE:
5135 q = BackslashQuoteString(strRep, len, &qlen);
5136 memcpy(p, q, qlen);
5137 Jim_Free(q);
5138 p += qlen;
5139 realLength += qlen;
5140 break;
5141 }
5142 /* Add a separating space */
5143 if (i+1 != objPtr->internalRep.listValue.len) {
5144 *p++ = ' ';
5145 realLength ++;
5146 }
5147 }
5148 *p = '\0'; /* nul term. */
5149 objPtr->length = realLength;
5150 Jim_Free(quotingType);
5151 }
5152
5153 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5154 {
5155 struct JimParserCtx parser;
5156 const char *str;
5157 int strLen;
5158
5159 /* Get the string representation */
5160 str = Jim_GetString(objPtr, &strLen);
5161
5162 /* Free the old internal repr just now and initialize the
5163 * new one just now. The string->list conversion can't fail. */
5164 Jim_FreeIntRep(interp, objPtr);
5165 objPtr->typePtr = &listObjType;
5166 objPtr->internalRep.listValue.len = 0;
5167 objPtr->internalRep.listValue.maxLen = 0;
5168 objPtr->internalRep.listValue.ele = NULL;
5169
5170 /* Convert into a list */
5171 JimParserInit(&parser, str, strLen, 1);
5172 while(!JimParserEof(&parser)) {
5173 char *token;
5174 int tokenLen, type;
5175 Jim_Obj *elementPtr;
5176
5177 JimParseList(&parser);
5178 if (JimParserTtype(&parser) != JIM_TT_STR &&
5179 JimParserTtype(&parser) != JIM_TT_ESC)
5180 continue;
5181 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5182 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5183 ListAppendElement(objPtr, elementPtr);
5184 }
5185 return JIM_OK;
5186 }
5187
5188 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5189 int len)
5190 {
5191 Jim_Obj *objPtr;
5192 int i;
5193
5194 objPtr = Jim_NewObj(interp);
5195 objPtr->typePtr = &listObjType;
5196 objPtr->bytes = NULL;
5197 objPtr->internalRep.listValue.ele = NULL;
5198 objPtr->internalRep.listValue.len = 0;
5199 objPtr->internalRep.listValue.maxLen = 0;
5200 for (i = 0; i < len; i++) {
5201 ListAppendElement(objPtr, elements[i]);
5202 }
5203 return objPtr;
5204 }
5205
5206 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5207 * length of the vector. Note that the user of this function should make
5208 * sure that the list object can't shimmer while the vector returned
5209 * is in use, this vector is the one stored inside the internal representation
5210 * of the list object. This function is not exported, extensions should
5211 * always access to the List object elements using Jim_ListIndex(). */
5212 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5213 Jim_Obj ***listVec)
5214 {
5215 Jim_ListLength(interp, listObj, argc);
5216 assert(listObj->typePtr == &listObjType);
5217 *listVec = listObj->internalRep.listValue.ele;
5218 }
5219
5220 /* ListSortElements type values */
5221 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5222 JIM_LSORT_NOCASE_DECR};
5223
5224 /* Sort the internal rep of a list. */
5225 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5226 {
5227 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5228 }
5229
5230 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5231 {
5232 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5233 }
5234
5235 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5236 {
5237 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5238 }
5239
5240 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5241 {
5242 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5243 }
5244
5245 /* Sort a list *in place*. MUST be called with non-shared objects. */
5246 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5247 {
5248 typedef int (qsort_comparator)(const void *, const void *);
5249 int (*fn)(Jim_Obj**, Jim_Obj**);
5250 Jim_Obj **vector;
5251 int len;
5252
5253 if (Jim_IsShared(listObjPtr))
5254 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5255 if (listObjPtr->typePtr != &listObjType)
5256 SetListFromAny(interp, listObjPtr);
5257
5258 vector = listObjPtr->internalRep.listValue.ele;
5259 len = listObjPtr->internalRep.listValue.len;
5260 switch (type) {
5261 case JIM_LSORT_ASCII: fn = ListSortString; break;
5262 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5263 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5264 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5265 default:
5266 fn = NULL; /* avoid warning */
5267 Jim_Panic(interp,"ListSort called with invalid sort type");
5268 }
5269 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5270 Jim_InvalidateStringRep(listObjPtr);
5271 }
5272
5273 /* This is the low-level function to append an element to a list.
5274 * The higher-level Jim_ListAppendElement() performs shared object
5275 * check and invalidate the string repr. This version is used
5276 * in the internals of the List Object and is not exported.
5277 *
5278 * NOTE: this function can be called only against objects
5279 * with internal type of List. */
5280 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5281 {
5282 int requiredLen = listPtr->internalRep.listValue.len + 1;
5283
5284 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5285 int maxLen = requiredLen * 2;
5286
5287 listPtr->internalRep.listValue.ele =
5288 Jim_Realloc(listPtr->internalRep.listValue.ele,
5289 sizeof(Jim_Obj*)*maxLen);
5290 listPtr->internalRep.listValue.maxLen = maxLen;
5291 }
5292 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5293 objPtr;
5294 listPtr->internalRep.listValue.len ++;
5295 Jim_IncrRefCount(objPtr);
5296 }
5297
5298 /* This is the low-level function to insert elements into a list.
5299 * The higher-level Jim_ListInsertElements() performs shared object
5300 * check and invalidate the string repr. This version is used
5301 * in the internals of the List Object and is not exported.
5302 *
5303 * NOTE: this function can be called only against objects
5304 * with internal type of List. */
5305 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5306 Jim_Obj *const *elemVec)
5307 {
5308 int currentLen = listPtr->internalRep.listValue.len;
5309 int requiredLen = currentLen + elemc;
5310 int i;
5311 Jim_Obj **point;
5312
5313 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5314 int maxLen = requiredLen * 2;
5315
5316 listPtr->internalRep.listValue.ele =
5317 Jim_Realloc(listPtr->internalRep.listValue.ele,
5318 sizeof(Jim_Obj*)*maxLen);
5319 listPtr->internalRep.listValue.maxLen = maxLen;
5320 }
5321 point = listPtr->internalRep.listValue.ele + index;
5322 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5323 for (i=0; i < elemc; ++i) {
5324 point[i] = elemVec[i];
5325 Jim_IncrRefCount(point[i]);
5326 }
5327 listPtr->internalRep.listValue.len += elemc;
5328 }
5329
5330 /* Appends every element of appendListPtr into listPtr.
5331 * Both have to be of the list type. */
5332 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5333 {
5334 int i, oldLen = listPtr->internalRep.listValue.len;
5335 int appendLen = appendListPtr->internalRep.listValue.len;
5336 int requiredLen = oldLen + appendLen;
5337
5338 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5339 int maxLen = requiredLen * 2;
5340
5341 listPtr->internalRep.listValue.ele =
5342 Jim_Realloc(listPtr->internalRep.listValue.ele,
5343 sizeof(Jim_Obj*)*maxLen);
5344 listPtr->internalRep.listValue.maxLen = maxLen;
5345 }
5346 for (i = 0; i < appendLen; i++) {
5347 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5348 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5349 Jim_IncrRefCount(objPtr);
5350 }
5351 listPtr->internalRep.listValue.len += appendLen;
5352 }
5353
5354 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5355 {
5356 if (Jim_IsShared(listPtr))
5357 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5358 if (listPtr->typePtr != &listObjType)
5359 SetListFromAny(interp, listPtr);
5360 Jim_InvalidateStringRep(listPtr);
5361 ListAppendElement(listPtr, objPtr);
5362 }
5363
5364 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5365 {
5366 if (Jim_IsShared(listPtr))
5367 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5368 if (listPtr->typePtr != &listObjType)
5369 SetListFromAny(interp, listPtr);
5370 Jim_InvalidateStringRep(listPtr);
5371 ListAppendList(listPtr, appendListPtr);
5372 }
5373
5374 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5375 {
5376 if (listPtr->typePtr != &listObjType)
5377 SetListFromAny(interp, listPtr);
5378 *intPtr = listPtr->internalRep.listValue.len;
5379 }
5380
5381 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5382 int objc, Jim_Obj *const *objVec)
5383 {
5384 if (Jim_IsShared(listPtr))
5385 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5386 if (listPtr->typePtr != &listObjType)
5387 SetListFromAny(interp, listPtr);
5388 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5389 index = listPtr->internalRep.listValue.len;
5390 else if (index < 0 )
5391 index = 0;
5392 Jim_InvalidateStringRep(listPtr);
5393 ListInsertElements(listPtr, index, objc, objVec);
5394 }
5395
5396 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5397 Jim_Obj **objPtrPtr, int flags)
5398 {
5399 if (listPtr->typePtr != &listObjType)
5400 SetListFromAny(interp, listPtr);
5401 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5402 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5403 if (flags & JIM_ERRMSG) {
5404 Jim_SetResultString(interp,
5405 "list index out of range", -1);
5406 }
5407 return JIM_ERR;
5408 }
5409 if (index < 0)
5410 index = listPtr->internalRep.listValue.len+index;
5411 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5412 return JIM_OK;
5413 }
5414
5415 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5416 Jim_Obj *newObjPtr, int flags)
5417 {
5418 if (listPtr->typePtr != &listObjType)
5419 SetListFromAny(interp, listPtr);
5420 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5421 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5422 if (flags & JIM_ERRMSG) {
5423 Jim_SetResultString(interp,
5424 "list index out of range", -1);
5425 }
5426 return JIM_ERR;
5427 }
5428 if (index < 0)
5429 index = listPtr->internalRep.listValue.len+index;
5430 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5431 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5432 Jim_IncrRefCount(newObjPtr);
5433 return JIM_OK;
5434 }
5435
5436 /* Modify the list stored into the variable named 'varNamePtr'
5437 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5438 * with the new element 'newObjptr'. */
5439 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5440 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5441 {
5442 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5443 int shared, i, index;
5444
5445 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5446 if (objPtr == NULL)
5447 return JIM_ERR;
5448 if ((shared = Jim_IsShared(objPtr)))
5449 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5450 for (i = 0; i < indexc-1; i++) {
5451 listObjPtr = objPtr;
5452 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5453 goto err;
5454 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5455 JIM_ERRMSG) != JIM_OK) {
5456 goto err;
5457 }
5458 if (Jim_IsShared(objPtr)) {
5459 objPtr = Jim_DuplicateObj(interp, objPtr);
5460 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5461 }
5462 Jim_InvalidateStringRep(listObjPtr);
5463 }
5464 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5465 goto err;
5466 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5467 goto err;
5468 Jim_InvalidateStringRep(objPtr);
5469 Jim_InvalidateStringRep(varObjPtr);
5470 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5471 goto err;
5472 Jim_SetResult(interp, varObjPtr);
5473 return JIM_OK;
5474 err:
5475 if (shared) {
5476 Jim_FreeNewObj(interp, varObjPtr);
5477 }
5478 return JIM_ERR;
5479 }
5480
5481 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5482 {
5483 int i;
5484
5485 /* If all the objects in objv are lists without string rep.
5486 * it's possible to return a list as result, that's the
5487 * concatenation of all the lists. */
5488 for (i = 0; i < objc; i++) {
5489 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5490 break;
5491 }
5492 if (i == objc) {
5493 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5494 for (i = 0; i < objc; i++)
5495 Jim_ListAppendList(interp, objPtr, objv[i]);
5496 return objPtr;
5497 } else {
5498 /* Else... we have to glue strings together */
5499 int len = 0, objLen;
5500 char *bytes, *p;
5501
5502 /* Compute the length */
5503 for (i = 0; i < objc; i++) {
5504 Jim_GetString(objv[i], &objLen);
5505 len += objLen;
5506 }
5507 if (objc) len += objc-1;
5508 /* Create the string rep, and a stinrg object holding it. */
5509 p = bytes = Jim_Alloc(len+1);
5510 for (i = 0; i < objc; i++) {
5511 const char *s = Jim_GetString(objv[i], &objLen);
5512 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5513 {
5514 s++; objLen--; len--;
5515 }
5516 while (objLen && (s[objLen-1] == ' ' ||
5517 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5518 objLen--; len--;
5519 }
5520 memcpy(p, s, objLen);
5521 p += objLen;
5522 if (objLen && i+1 != objc) {
5523 *p++ = ' ';
5524 } else if (i+1 != objc) {
5525 /* Drop the space calcuated for this
5526 * element that is instead null. */
5527 len--;
5528 }
5529 }
5530 *p = '\0';
5531 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5532 }
5533 }
5534
5535 /* Returns a list composed of the elements in the specified range.
5536 * first and start are directly accepted as Jim_Objects and
5537 * processed for the end?-index? case. */
5538 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5539 {
5540 int first, last;
5541 int len, rangeLen;
5542
5543 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5544 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5545 return NULL;
5546 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5547 first = JimRelToAbsIndex(len, first);
5548 last = JimRelToAbsIndex(len, last);
5549 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5550 return Jim_NewListObj(interp,
5551 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5552 }
5553
5554 /* -----------------------------------------------------------------------------
5555 * Dict object
5556 * ---------------------------------------------------------------------------*/
5557 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5558 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5559 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5560 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5561
5562 /* Dict HashTable Type.
5563 *
5564 * Keys and Values are Jim objects. */
5565
5566 unsigned int JimObjectHTHashFunction(const void *key)
5567 {
5568 const char *str;
5569 Jim_Obj *objPtr = (Jim_Obj*) key;
5570 int len, h;
5571
5572 str = Jim_GetString(objPtr, &len);
5573 h = Jim_GenHashFunction((unsigned char*)str, len);
5574 return h;
5575 }
5576
5577 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5578 {
5579 JIM_NOTUSED(privdata);
5580
5581 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5582 }
5583
5584 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5585 {
5586 Jim_Obj *objPtr = val;
5587
5588 Jim_DecrRefCount(interp, objPtr);
5589 }
5590
5591 static Jim_HashTableType JimDictHashTableType = {
5592 JimObjectHTHashFunction, /* hash function */
5593 NULL, /* key dup */
5594 NULL, /* val dup */
5595 JimObjectHTKeyCompare, /* key compare */
5596 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5597 JimObjectHTKeyValDestructor, /* key destructor */
5598 JimObjectHTKeyValDestructor /* val destructor */
5599 };
5600
5601 /* Note that while the elements of the dict may contain references,
5602 * the list object itself can't. This basically means that the
5603 * dict object string representation as a whole can't contain references
5604 * that are not presents in the single elements. */
5605 static Jim_ObjType dictObjType = {
5606 "dict",
5607 FreeDictInternalRep,
5608 DupDictInternalRep,
5609 UpdateStringOfDict,
5610 JIM_TYPE_NONE,
5611 };
5612
5613 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5614 {
5615 JIM_NOTUSED(interp);
5616
5617 Jim_FreeHashTable(objPtr->internalRep.ptr);
5618 Jim_Free(objPtr->internalRep.ptr);
5619 }
5620
5621 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5622 {
5623 Jim_HashTable *ht, *dupHt;
5624 Jim_HashTableIterator *htiter;
5625 Jim_HashEntry *he;
5626
5627 /* Create a new hash table */
5628 ht = srcPtr->internalRep.ptr;
5629 dupHt = Jim_Alloc(sizeof(*dupHt));
5630 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5631 if (ht->size != 0)
5632 Jim_ExpandHashTable(dupHt, ht->size);
5633 /* Copy every element from the source to the dup hash table */
5634 htiter = Jim_GetHashTableIterator(ht);
5635 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5636 const Jim_Obj *keyObjPtr = he->key;
5637 Jim_Obj *valObjPtr = he->val;
5638
5639 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5640 Jim_IncrRefCount(valObjPtr);
5641 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5642 }
5643 Jim_FreeHashTableIterator(htiter);
5644
5645 dupPtr->internalRep.ptr = dupHt;
5646 dupPtr->typePtr = &dictObjType;
5647 }
5648
5649 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5650 {
5651 int i, bufLen, realLength;
5652 const char *strRep;
5653 char *p;
5654 int *quotingType, objc;
5655 Jim_HashTable *ht;
5656 Jim_HashTableIterator *htiter;
5657 Jim_HashEntry *he;
5658 Jim_Obj **objv;
5659
5660 /* Trun the hash table into a flat vector of Jim_Objects. */
5661 ht = objPtr->internalRep.ptr;
5662 objc = ht->used*2;
5663 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5664 htiter = Jim_GetHashTableIterator(ht);
5665 i = 0;
5666 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5667 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5668 objv[i++] = he->val;
5669 }
5670 Jim_FreeHashTableIterator(htiter);
5671 /* (Over) Estimate the space needed. */
5672 quotingType = Jim_Alloc(sizeof(int)*objc);
5673 bufLen = 0;
5674 for (i = 0; i < objc; i++) {
5675 int len;
5676
5677 strRep = Jim_GetString(objv[i], &len);
5678 quotingType[i] = ListElementQuotingType(strRep, len);
5679 switch (quotingType[i]) {
5680 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5681 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5682 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5683 }
5684 bufLen++; /* elements separator. */
5685 }
5686 bufLen++;
5687
5688 /* Generate the string rep. */
5689 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5690 realLength = 0;
5691 for (i = 0; i < objc; i++) {
5692 int len, qlen;
5693 const char *strRep = Jim_GetString(objv[i], &len);
5694 char *q;
5695
5696 switch(quotingType[i]) {
5697 case JIM_ELESTR_SIMPLE:
5698 memcpy(p, strRep, len);
5699 p += len;
5700 realLength += len;
5701 break;
5702 case JIM_ELESTR_BRACE:
5703 *p++ = '{';
5704 memcpy(p, strRep, len);
5705 p += len;
5706 *p++ = '}';
5707 realLength += len+2;
5708 break;
5709 case JIM_ELESTR_QUOTE:
5710 q = BackslashQuoteString(strRep, len, &qlen);
5711 memcpy(p, q, qlen);
5712 Jim_Free(q);
5713 p += qlen;
5714 realLength += qlen;
5715 break;
5716 }
5717 /* Add a separating space */
5718 if (i+1 != objc) {
5719 *p++ = ' ';
5720 realLength ++;
5721 }
5722 }
5723 *p = '\0'; /* nul term. */
5724 objPtr->length = realLength;
5725 Jim_Free(quotingType);
5726 Jim_Free(objv);
5727 }
5728
5729 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5730 {
5731 struct JimParserCtx parser;
5732 Jim_HashTable *ht;
5733 Jim_Obj *objv[2];
5734 const char *str;
5735 int i, strLen;
5736
5737 /* Get the string representation */
5738 str = Jim_GetString(objPtr, &strLen);
5739
5740 /* Free the old internal repr just now and initialize the
5741 * new one just now. The string->list conversion can't fail. */
5742 Jim_FreeIntRep(interp, objPtr);
5743 ht = Jim_Alloc(sizeof(*ht));
5744 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5745 objPtr->typePtr = &dictObjType;
5746 objPtr->internalRep.ptr = ht;
5747
5748 /* Convert into a dict */
5749 JimParserInit(&parser, str, strLen, 1);
5750 i = 0;
5751 while(!JimParserEof(&parser)) {
5752 char *token;
5753 int tokenLen, type;
5754
5755 JimParseList(&parser);
5756 if (JimParserTtype(&parser) != JIM_TT_STR &&
5757 JimParserTtype(&parser) != JIM_TT_ESC)
5758 continue;
5759 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5760 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5761 if (i == 2) {
5762 i = 0;
5763 Jim_IncrRefCount(objv[0]);
5764 Jim_IncrRefCount(objv[1]);
5765 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5766 Jim_HashEntry *he;
5767 he = Jim_FindHashEntry(ht, objv[0]);
5768 Jim_DecrRefCount(interp, objv[0]);
5769 /* ATTENTION: const cast */
5770 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5771 he->val = objv[1];
5772 }
5773 }
5774 }
5775 if (i) {
5776 Jim_FreeNewObj(interp, objv[0]);
5777 objPtr->typePtr = NULL;
5778 Jim_FreeHashTable(ht);
5779 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5780 return JIM_ERR;
5781 }
5782 return JIM_OK;
5783 }
5784
5785 /* Dict object API */
5786
5787 /* Add an element to a dict. objPtr must be of the "dict" type.
5788 * The higer-level exported function is Jim_DictAddElement().
5789 * If an element with the specified key already exists, the value
5790 * associated is replaced with the new one.
5791 *
5792 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5793 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5794 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5795 {
5796 Jim_HashTable *ht = objPtr->internalRep.ptr;
5797
5798 if (valueObjPtr == NULL) { /* unset */
5799 Jim_DeleteHashEntry(ht, keyObjPtr);
5800 return;
5801 }
5802 Jim_IncrRefCount(keyObjPtr);
5803 Jim_IncrRefCount(valueObjPtr);
5804 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5805 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5806 Jim_DecrRefCount(interp, keyObjPtr);
5807 /* ATTENTION: const cast */
5808 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5809 he->val = valueObjPtr;
5810 }
5811 }
5812
5813 /* Add an element, higher-level interface for DictAddElement().
5814 * If valueObjPtr == NULL, the key is removed if it exists. */
5815 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5816 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5817 {
5818 if (Jim_IsShared(objPtr))
5819 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5820 if (objPtr->typePtr != &dictObjType) {
5821 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5822 return JIM_ERR;
5823 }
5824 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5825 Jim_InvalidateStringRep(objPtr);
5826 return JIM_OK;
5827 }
5828
5829 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5830 {
5831 Jim_Obj *objPtr;
5832 int i;
5833
5834 if (len % 2)
5835 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5836
5837 objPtr = Jim_NewObj(interp);
5838 objPtr->typePtr = &dictObjType;
5839 objPtr->bytes = NULL;
5840 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5841 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5842 for (i = 0; i < len; i += 2)
5843 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5844 return objPtr;
5845 }
5846
5847 /* Return the value associated to the specified dict key */
5848 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5849 Jim_Obj **objPtrPtr, int flags)
5850 {
5851 Jim_HashEntry *he;
5852 Jim_HashTable *ht;
5853
5854 if (dictPtr->typePtr != &dictObjType) {
5855 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5856 return JIM_ERR;
5857 }
5858 ht = dictPtr->internalRep.ptr;
5859 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5860 if (flags & JIM_ERRMSG) {
5861 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5862 Jim_AppendStrings(interp, Jim_GetResult(interp),
5863 "key \"", Jim_GetString(keyPtr, NULL),
5864 "\" not found in dictionary", NULL);
5865 }
5866 return JIM_ERR;
5867 }
5868 *objPtrPtr = he->val;
5869 return JIM_OK;
5870 }
5871
5872 /* Return the value associated to the specified dict keys */
5873 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5874 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5875 {
5876 Jim_Obj *objPtr;
5877 int i;
5878
5879 if (keyc == 0) {
5880 *objPtrPtr = dictPtr;
5881 return JIM_OK;
5882 }
5883
5884 for (i = 0; i < keyc; i++) {
5885 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5886 != JIM_OK)
5887 return JIM_ERR;
5888 dictPtr = objPtr;
5889 }
5890 *objPtrPtr = objPtr;
5891 return JIM_OK;
5892 }
5893
5894 /* Modify the dict stored into the variable named 'varNamePtr'
5895 * setting the element specified by the 'keyc' keys objects in 'keyv',
5896 * with the new value of the element 'newObjPtr'.
5897 *
5898 * If newObjPtr == NULL the operation is to remove the given key
5899 * from the dictionary. */
5900 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5901 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5902 {
5903 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5904 int shared, i;
5905
5906 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5907 if (objPtr == NULL) {
5908 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5909 return JIM_ERR;
5910 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5911 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5912 Jim_FreeNewObj(interp, varObjPtr);
5913 return JIM_ERR;
5914 }
5915 }
5916 if ((shared = Jim_IsShared(objPtr)))
5917 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5918 for (i = 0; i < keyc-1; i++) {
5919 dictObjPtr = objPtr;
5920
5921 /* Check if it's a valid dictionary */
5922 if (dictObjPtr->typePtr != &dictObjType) {
5923 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5924 goto err;
5925 }
5926 /* Check if the given key exists. */
5927 Jim_InvalidateStringRep(dictObjPtr);
5928 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5929 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5930 {
5931 /* This key exists at the current level.
5932 * Make sure it's not shared!. */
5933 if (Jim_IsShared(objPtr)) {
5934 objPtr = Jim_DuplicateObj(interp, objPtr);
5935 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5936 }
5937 } else {
5938 /* Key not found. If it's an [unset] operation
5939 * this is an error. Only the last key may not
5940 * exist. */
5941 if (newObjPtr == NULL)
5942 goto err;
5943 /* Otherwise set an empty dictionary
5944 * as key's value. */
5945 objPtr = Jim_NewDictObj(interp, NULL, 0);
5946 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5947 }
5948 }
5949 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5950 != JIM_OK)
5951 goto err;
5952 Jim_InvalidateStringRep(objPtr);
5953 Jim_InvalidateStringRep(varObjPtr);
5954 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5955 goto err;
5956 Jim_SetResult(interp, varObjPtr);
5957 return JIM_OK;
5958 err:
5959 if (shared) {
5960 Jim_FreeNewObj(interp, varObjPtr);
5961 }
5962 return JIM_ERR;
5963 }
5964
5965 /* -----------------------------------------------------------------------------
5966 * Index object
5967 * ---------------------------------------------------------------------------*/
5968 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
5969 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5970
5971 static Jim_ObjType indexObjType = {
5972 "index",
5973 NULL,
5974 NULL,
5975 UpdateStringOfIndex,
5976 JIM_TYPE_NONE,
5977 };
5978
5979 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
5980 {
5981 int len;
5982 char buf[JIM_INTEGER_SPACE+1];
5983
5984 if (objPtr->internalRep.indexValue >= 0)
5985 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
5986 else if (objPtr->internalRep.indexValue == -1)
5987 len = sprintf(buf, "end");
5988 else {
5989 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
5990 }
5991 objPtr->bytes = Jim_Alloc(len+1);
5992 memcpy(objPtr->bytes, buf, len+1);
5993 objPtr->length = len;
5994 }
5995
5996 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5997 {
5998 int index, end = 0;
5999 const char *str;
6000
6001 /* Get the string representation */
6002 str = Jim_GetString(objPtr, NULL);
6003 /* Try to convert into an index */
6004 if (!strcmp(str, "end")) {
6005 index = 0;
6006 end = 1;
6007 } else {
6008 if (!strncmp(str, "end-", 4)) {
6009 str += 4;
6010 end = 1;
6011 }
6012 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6013 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6014 Jim_AppendStrings(interp, Jim_GetResult(interp),
6015 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6016 "must be integer or end?-integer?", NULL);
6017 return JIM_ERR;
6018 }
6019 }
6020 if (end) {
6021 if (index < 0)
6022 index = INT_MAX;
6023 else
6024 index = -(index+1);
6025 } else if (!end && index < 0)
6026 index = -INT_MAX;
6027 /* Free the old internal repr and set the new one. */
6028 Jim_FreeIntRep(interp, objPtr);
6029 objPtr->typePtr = &indexObjType;
6030 objPtr->internalRep.indexValue = index;
6031 return JIM_OK;
6032 }
6033
6034 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6035 {
6036 /* Avoid shimmering if the object is an integer. */
6037 if (objPtr->typePtr == &intObjType) {
6038 jim_wide val = objPtr->internalRep.wideValue;
6039 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6040 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6041 return JIM_OK;
6042 }
6043 }
6044 if (objPtr->typePtr != &indexObjType &&
6045 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6046 return JIM_ERR;
6047 *indexPtr = objPtr->internalRep.indexValue;
6048 return JIM_OK;
6049 }
6050
6051 /* -----------------------------------------------------------------------------
6052 * Return Code Object.
6053 * ---------------------------------------------------------------------------*/
6054
6055 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6056
6057 static Jim_ObjType returnCodeObjType = {
6058 "return-code",
6059 NULL,
6060 NULL,
6061 NULL,
6062 JIM_TYPE_NONE,
6063 };
6064
6065 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6066 {
6067 const char *str;
6068 int strLen, returnCode;
6069 jim_wide wideValue;
6070
6071 /* Get the string representation */
6072 str = Jim_GetString(objPtr, &strLen);
6073 /* Try to convert into an integer */
6074 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6075 returnCode = (int) wideValue;
6076 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6077 returnCode = JIM_OK;
6078 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6079 returnCode = JIM_ERR;
6080 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6081 returnCode = JIM_RETURN;
6082 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6083 returnCode = JIM_BREAK;
6084 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6085 returnCode = JIM_CONTINUE;
6086 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6087 returnCode = JIM_EVAL;
6088 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6089 returnCode = JIM_EXIT;
6090 else {
6091 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6092 Jim_AppendStrings(interp, Jim_GetResult(interp),
6093 "expected return code but got '", str, "'",
6094 NULL);
6095 return JIM_ERR;
6096 }
6097 /* Free the old internal repr and set the new one. */
6098 Jim_FreeIntRep(interp, objPtr);
6099 objPtr->typePtr = &returnCodeObjType;
6100 objPtr->internalRep.returnCode = returnCode;
6101 return JIM_OK;
6102 }
6103
6104 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6105 {
6106 if (objPtr->typePtr != &returnCodeObjType &&
6107 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6108 return JIM_ERR;
6109 *intPtr = objPtr->internalRep.returnCode;
6110 return JIM_OK;
6111 }
6112
6113 /* -----------------------------------------------------------------------------
6114 * Expression Parsing
6115 * ---------------------------------------------------------------------------*/
6116 static int JimParseExprOperator(struct JimParserCtx *pc);
6117 static int JimParseExprNumber(struct JimParserCtx *pc);
6118 static int JimParseExprIrrational(struct JimParserCtx *pc);
6119
6120 /* Exrp's Stack machine operators opcodes. */
6121
6122 /* Binary operators (numbers) */
6123 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6124 #define JIM_EXPROP_MUL 0
6125 #define JIM_EXPROP_DIV 1
6126 #define JIM_EXPROP_MOD 2
6127 #define JIM_EXPROP_SUB 3
6128 #define JIM_EXPROP_ADD 4
6129 #define JIM_EXPROP_LSHIFT 5
6130 #define JIM_EXPROP_RSHIFT 6
6131 #define JIM_EXPROP_ROTL 7
6132 #define JIM_EXPROP_ROTR 8
6133 #define JIM_EXPROP_LT 9
6134 #define JIM_EXPROP_GT 10
6135 #define JIM_EXPROP_LTE 11
6136 #define JIM_EXPROP_GTE 12
6137 #define JIM_EXPROP_NUMEQ 13
6138 #define JIM_EXPROP_NUMNE 14
6139 #define JIM_EXPROP_BITAND 15
6140 #define JIM_EXPROP_BITXOR 16
6141 #define JIM_EXPROP_BITOR 17
6142 #define JIM_EXPROP_LOGICAND 18
6143 #define JIM_EXPROP_LOGICOR 19
6144 #define JIM_EXPROP_LOGICAND_LEFT 20
6145 #define JIM_EXPROP_LOGICOR_LEFT 21
6146 #define JIM_EXPROP_POW 22
6147 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6148
6149 /* Binary operators (strings) */
6150 #define JIM_EXPROP_STREQ 23
6151 #define JIM_EXPROP_STRNE 24
6152
6153 /* Unary operators (numbers) */
6154 #define JIM_EXPROP_NOT 25
6155 #define JIM_EXPROP_BITNOT 26
6156 #define JIM_EXPROP_UNARYMINUS 27
6157 #define JIM_EXPROP_UNARYPLUS 28
6158 #define JIM_EXPROP_LOGICAND_RIGHT 29
6159 #define JIM_EXPROP_LOGICOR_RIGHT 30
6160
6161 /* Ternary operators */
6162 #define JIM_EXPROP_TERNARY 31
6163
6164 /* Operands */
6165 #define JIM_EXPROP_NUMBER 32
6166 #define JIM_EXPROP_COMMAND 33
6167 #define JIM_EXPROP_VARIABLE 34
6168 #define JIM_EXPROP_DICTSUGAR 35
6169 #define JIM_EXPROP_SUBST 36
6170 #define JIM_EXPROP_STRING 37
6171
6172 /* Operators table */
6173 typedef struct Jim_ExprOperator {
6174 const char *name;
6175 int precedence;
6176 int arity;
6177 int opcode;
6178 } Jim_ExprOperator;
6179
6180 /* name - precedence - arity - opcode */
6181 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6182 {"!", 300, 1, JIM_EXPROP_NOT},
6183 {"~", 300, 1, JIM_EXPROP_BITNOT},
6184 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6185 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6186
6187 {"**", 250, 2, JIM_EXPROP_POW},
6188
6189 {"*", 200, 2, JIM_EXPROP_MUL},
6190 {"/", 200, 2, JIM_EXPROP_DIV},
6191 {"%", 200, 2, JIM_EXPROP_MOD},
6192
6193 {"-", 100, 2, JIM_EXPROP_SUB},
6194 {"+", 100, 2, JIM_EXPROP_ADD},
6195
6196 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6197 {">>>", 90, 3, JIM_EXPROP_ROTR},
6198 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6199 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6200
6201 {"<", 80, 2, JIM_EXPROP_LT},
6202 {">", 80, 2, JIM_EXPROP_GT},
6203 {"<=", 80, 2, JIM_EXPROP_LTE},
6204 {">=", 80, 2, JIM_EXPROP_GTE},
6205
6206 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6207 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6208
6209 {"eq", 60, 2, JIM_EXPROP_STREQ},
6210 {"ne", 60, 2, JIM_EXPROP_STRNE},
6211
6212 {"&", 50, 2, JIM_EXPROP_BITAND},
6213 {"^", 49, 2, JIM_EXPROP_BITXOR},
6214 {"|", 48, 2, JIM_EXPROP_BITOR},
6215
6216 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6217 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6218
6219 {"?", 5, 3, JIM_EXPROP_TERNARY},
6220 /* private operators */
6221 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6222 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6223 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6224 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6225 };
6226
6227 #define JIM_EXPR_OPERATORS_NUM \
6228 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6229
6230 int JimParseExpression(struct JimParserCtx *pc)
6231 {
6232 /* Discard spaces and quoted newline */
6233 while(*(pc->p) == ' ' ||
6234 *(pc->p) == '\t' ||
6235 *(pc->p) == '\r' ||
6236 *(pc->p) == '\n' ||
6237 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6238 pc->p++; pc->len--;
6239 }
6240
6241 if (pc->len == 0) {
6242 pc->tstart = pc->tend = pc->p;
6243 pc->tline = pc->linenr;
6244 pc->tt = JIM_TT_EOL;
6245 pc->eof = 1;
6246 return JIM_OK;
6247 }
6248 switch(*(pc->p)) {
6249 case '(':
6250 pc->tstart = pc->tend = pc->p;
6251 pc->tline = pc->linenr;
6252 pc->tt = JIM_TT_SUBEXPR_START;
6253 pc->p++; pc->len--;
6254 break;
6255 case ')':
6256 pc->tstart = pc->tend = pc->p;
6257 pc->tline = pc->linenr;
6258 pc->tt = JIM_TT_SUBEXPR_END;
6259 pc->p++; pc->len--;
6260 break;
6261 case '[':
6262 return JimParseCmd(pc);
6263 break;
6264 case '$':
6265 if (JimParseVar(pc) == JIM_ERR)
6266 return JimParseExprOperator(pc);
6267 else
6268 return JIM_OK;
6269 break;
6270 case '-':
6271 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6272 isdigit((int)*(pc->p+1)))
6273 return JimParseExprNumber(pc);
6274 else
6275 return JimParseExprOperator(pc);
6276 break;
6277 case '0': case '1': case '2': case '3': case '4':
6278 case '5': case '6': case '7': case '8': case '9': case '.':
6279 return JimParseExprNumber(pc);
6280 break;
6281 case '"':
6282 case '{':
6283 /* Here it's possible to reuse the List String parsing. */
6284 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6285 return JimParseListStr(pc);
6286 break;
6287 case 'N': case 'I':
6288 case 'n': case 'i':
6289 if (JimParseExprIrrational(pc) == JIM_ERR)
6290 return JimParseExprOperator(pc);
6291 break;
6292 default:
6293 return JimParseExprOperator(pc);
6294 break;
6295 }
6296 return JIM_OK;
6297 }
6298
6299 int JimParseExprNumber(struct JimParserCtx *pc)
6300 {
6301 int allowdot = 1;
6302 int allowhex = 0;
6303
6304 pc->tstart = pc->p;
6305 pc->tline = pc->linenr;
6306 if (*pc->p == '-') {
6307 pc->p++; pc->len--;
6308 }
6309 while ( isdigit((int)*pc->p)
6310 || (allowhex && isxdigit((int)*pc->p) )
6311 || (allowdot && *pc->p == '.')
6312 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6313 (*pc->p == 'x' || *pc->p == 'X'))
6314 )
6315 {
6316 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6317 allowhex = 1;
6318 allowdot = 0;
6319 }
6320 if (*pc->p == '.')
6321 allowdot = 0;
6322 pc->p++; pc->len--;
6323 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6324 pc->p += 2; pc->len -= 2;
6325 }
6326 }
6327 pc->tend = pc->p-1;
6328 pc->tt = JIM_TT_EXPR_NUMBER;
6329 return JIM_OK;
6330 }
6331
6332 int JimParseExprIrrational(struct JimParserCtx *pc)
6333 {
6334 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6335 const char **token;
6336 for (token = Tokens; *token != NULL; token++) {
6337 int len = strlen(*token);
6338 if (strncmp(*token, pc->p, len) == 0) {
6339 pc->tstart = pc->p;
6340 pc->tend = pc->p + len - 1;
6341 pc->p += len; pc->len -= len;
6342 pc->tline = pc->linenr;
6343 pc->tt = JIM_TT_EXPR_NUMBER;
6344 return JIM_OK;
6345 }
6346 }
6347 return JIM_ERR;
6348 }
6349
6350 int JimParseExprOperator(struct JimParserCtx *pc)
6351 {
6352 int i;
6353 int bestIdx = -1, bestLen = 0;
6354
6355 /* Try to get the longest match. */
6356 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6357 const char *opname;
6358 int oplen;
6359
6360 opname = Jim_ExprOperators[i].name;
6361 if (opname == NULL) continue;
6362 oplen = strlen(opname);
6363
6364 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6365 bestIdx = i;
6366 bestLen = oplen;
6367 }
6368 }
6369 if (bestIdx == -1) return JIM_ERR;
6370 pc->tstart = pc->p;
6371 pc->tend = pc->p + bestLen - 1;
6372 pc->p += bestLen; pc->len -= bestLen;
6373 pc->tline = pc->linenr;
6374 pc->tt = JIM_TT_EXPR_OPERATOR;
6375 return JIM_OK;
6376 }
6377
6378 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6379 {
6380 int i;
6381 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6382 if (Jim_ExprOperators[i].name &&
6383 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6384 return &Jim_ExprOperators[i];
6385 return NULL;
6386 }
6387
6388 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6389 {
6390 int i;
6391 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6392 if (Jim_ExprOperators[i].opcode == opcode)
6393 return &Jim_ExprOperators[i];
6394 return NULL;
6395 }
6396
6397 /* -----------------------------------------------------------------------------
6398 * Expression Object
6399 * ---------------------------------------------------------------------------*/
6400 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6401 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6402 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6403
6404 static Jim_ObjType exprObjType = {
6405 "expression",
6406 FreeExprInternalRep,
6407 DupExprInternalRep,
6408 NULL,
6409 JIM_TYPE_REFERENCES,
6410 };
6411
6412 /* Expr bytecode structure */
6413 typedef struct ExprByteCode {
6414 int *opcode; /* Integer array of opcodes. */
6415 Jim_Obj **obj; /* Array of associated Jim Objects. */
6416 int len; /* Bytecode length */
6417 int inUse; /* Used for sharing. */
6418 } ExprByteCode;
6419
6420 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6421 {
6422 int i;
6423 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6424
6425 expr->inUse--;
6426 if (expr->inUse != 0) return;
6427 for (i = 0; i < expr->len; i++)
6428 Jim_DecrRefCount(interp, expr->obj[i]);
6429 Jim_Free(expr->opcode);
6430 Jim_Free(expr->obj);
6431 Jim_Free(expr);
6432 }
6433
6434 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6435 {
6436 JIM_NOTUSED(interp);
6437 JIM_NOTUSED(srcPtr);
6438
6439 /* Just returns an simple string. */
6440 dupPtr->typePtr = NULL;
6441 }
6442
6443 /* Add a new instruction to an expression bytecode structure. */
6444 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6445 int opcode, char *str, int len)
6446 {
6447 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6448 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6449 expr->opcode[expr->len] = opcode;
6450 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6451 Jim_IncrRefCount(expr->obj[expr->len]);
6452 expr->len++;
6453 }
6454
6455 /* Check if an expr program looks correct. */
6456 static int ExprCheckCorrectness(ExprByteCode *expr)
6457 {
6458 int i;
6459 int stacklen = 0;
6460
6461 /* Try to check if there are stack underflows,
6462 * and make sure at the end of the program there is
6463 * a single result on the stack. */
6464 for (i = 0; i < expr->len; i++) {
6465 switch(expr->opcode[i]) {
6466 case JIM_EXPROP_NUMBER:
6467 case JIM_EXPROP_STRING:
6468 case JIM_EXPROP_SUBST:
6469 case JIM_EXPROP_VARIABLE:
6470 case JIM_EXPROP_DICTSUGAR:
6471 case JIM_EXPROP_COMMAND:
6472 stacklen++;
6473 break;
6474 case JIM_EXPROP_NOT:
6475 case JIM_EXPROP_BITNOT:
6476 case JIM_EXPROP_UNARYMINUS:
6477 case JIM_EXPROP_UNARYPLUS:
6478 /* Unary operations */
6479 if (stacklen < 1) return JIM_ERR;
6480 break;
6481 case JIM_EXPROP_ADD:
6482 case JIM_EXPROP_SUB:
6483 case JIM_EXPROP_MUL:
6484 case JIM_EXPROP_DIV:
6485 case JIM_EXPROP_MOD:
6486 case JIM_EXPROP_LT:
6487 case JIM_EXPROP_GT:
6488 case JIM_EXPROP_LTE:
6489 case JIM_EXPROP_GTE:
6490 case JIM_EXPROP_ROTL:
6491 case JIM_EXPROP_ROTR:
6492 case JIM_EXPROP_LSHIFT:
6493 case JIM_EXPROP_RSHIFT:
6494 case JIM_EXPROP_NUMEQ:
6495 case JIM_EXPROP_NUMNE:
6496 case JIM_EXPROP_STREQ:
6497 case JIM_EXPROP_STRNE:
6498 case JIM_EXPROP_BITAND:
6499 case JIM_EXPROP_BITXOR:
6500 case JIM_EXPROP_BITOR:
6501 case JIM_EXPROP_LOGICAND:
6502 case JIM_EXPROP_LOGICOR:
6503 case JIM_EXPROP_POW:
6504 /* binary operations */
6505 if (stacklen < 2) return JIM_ERR;
6506 stacklen--;
6507 break;
6508 default:
6509 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6510 break;
6511 }
6512 }
6513 if (stacklen != 1) return JIM_ERR;
6514 return JIM_OK;
6515 }
6516
6517 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6518 ScriptObj *topLevelScript)
6519 {
6520 int i;
6521
6522 return;
6523 for (i = 0; i < expr->len; i++) {
6524 Jim_Obj *foundObjPtr;
6525
6526 if (expr->obj[i] == NULL) continue;
6527 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6528 NULL, expr->obj[i]);
6529 if (foundObjPtr != NULL) {
6530 Jim_IncrRefCount(foundObjPtr);
6531 Jim_DecrRefCount(interp, expr->obj[i]);
6532 expr->obj[i] = foundObjPtr;
6533 }
6534 }
6535 }
6536
6537 /* This procedure converts every occurrence of || and && opereators
6538 * in lazy unary versions.
6539 *
6540 * a b || is converted into:
6541 *
6542 * a <offset> |L b |R
6543 *
6544 * a b && is converted into:
6545 *
6546 * a <offset> &L b &R
6547 *
6548 * "|L" checks if 'a' is true:
6549 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6550 * the opcode just after |R.
6551 * 2) if it is false does nothing.
6552 * "|R" checks if 'b' is true:
6553 * 1) if it is true pushes 1, otherwise pushes 0.
6554 *
6555 * "&L" checks if 'a' is true:
6556 * 1) if it is true does nothing.
6557 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6558 * the opcode just after &R
6559 * "&R" checks if 'a' is true:
6560 * if it is true pushes 1, otherwise pushes 0.
6561 */
6562 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6563 {
6564 while (1) {
6565 int index = -1, leftindex, arity, i, offset;
6566 Jim_ExprOperator *op;
6567
6568 /* Search for || or && */
6569 for (i = 0; i < expr->len; i++) {
6570 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6571 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6572 index = i;
6573 break;
6574 }
6575 }
6576 if (index == -1) return;
6577 /* Search for the end of the first operator */
6578 leftindex = index-1;
6579 arity = 1;
6580 while(arity) {
6581 switch(expr->opcode[leftindex]) {
6582 case JIM_EXPROP_NUMBER:
6583 case JIM_EXPROP_COMMAND:
6584 case JIM_EXPROP_VARIABLE:
6585 case JIM_EXPROP_DICTSUGAR:
6586 case JIM_EXPROP_SUBST:
6587 case JIM_EXPROP_STRING:
6588 break;
6589 default:
6590 op = JimExprOperatorInfoByOpcode(expr->opcode[i]);
6591 if (op == NULL) {
6592 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6593 }
6594 arity += op->arity;
6595 break;
6596 }
6597 arity--;
6598 leftindex--;
6599 }
6600 leftindex++;
6601 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6602 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6603 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6604 sizeof(int)*(expr->len-leftindex));
6605 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6606 sizeof(Jim_Obj*)*(expr->len-leftindex));
6607 expr->len += 2;
6608 index += 2;
6609 offset = (index-leftindex)-1;
6610 Jim_DecrRefCount(interp, expr->obj[index]);
6611 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6612 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6613 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6614 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6615 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6616 } else {
6617 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6618 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6619 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6620 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6621 }
6622 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6623 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6624 Jim_IncrRefCount(expr->obj[index]);
6625 Jim_IncrRefCount(expr->obj[leftindex]);
6626 Jim_IncrRefCount(expr->obj[leftindex+1]);
6627 }
6628 }
6629
6630 /* This method takes the string representation of an expression
6631 * and generates a program for the Expr's stack-based VM. */
6632 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6633 {
6634 int exprTextLen;
6635 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6636 struct JimParserCtx parser;
6637 int i, shareLiterals;
6638 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6639 Jim_Stack stack;
6640 Jim_ExprOperator *op;
6641
6642 /* Perform literal sharing with the current procedure
6643 * running only if this expression appears to be not generated
6644 * at runtime. */
6645 shareLiterals = objPtr->typePtr == &sourceObjType;
6646
6647 expr->opcode = NULL;
6648 expr->obj = NULL;
6649 expr->len = 0;
6650 expr->inUse = 1;
6651
6652 Jim_InitStack(&stack);
6653 JimParserInit(&parser, exprText, exprTextLen, 1);
6654 while(!JimParserEof(&parser)) {
6655 char *token;
6656 int len, type;
6657
6658 if (JimParseExpression(&parser) != JIM_OK) {
6659 Jim_SetResultString(interp, "Syntax error in expression", -1);
6660 goto err;
6661 }
6662 token = JimParserGetToken(&parser, &len, &type, NULL);
6663 if (type == JIM_TT_EOL) {
6664 Jim_Free(token);
6665 break;
6666 }
6667 switch(type) {
6668 case JIM_TT_STR:
6669 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6670 break;
6671 case JIM_TT_ESC:
6672 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6673 break;
6674 case JIM_TT_VAR:
6675 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6676 break;
6677 case JIM_TT_DICTSUGAR:
6678 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6679 break;
6680 case JIM_TT_CMD:
6681 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6682 break;
6683 case JIM_TT_EXPR_NUMBER:
6684 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6685 break;
6686 case JIM_TT_EXPR_OPERATOR:
6687 op = JimExprOperatorInfo(token);
6688 while(1) {
6689 Jim_ExprOperator *stackTopOp;
6690
6691 if (Jim_StackPeek(&stack) != NULL) {
6692 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6693 } else {
6694 stackTopOp = NULL;
6695 }
6696 if (Jim_StackLen(&stack) && op->arity != 1 &&
6697 stackTopOp && stackTopOp->precedence >= op->precedence)
6698 {
6699 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6700 Jim_StackPeek(&stack), -1);
6701 Jim_StackPop(&stack);
6702 } else {
6703 break;
6704 }
6705 }
6706 Jim_StackPush(&stack, token);
6707 break;
6708 case JIM_TT_SUBEXPR_START:
6709 Jim_StackPush(&stack, Jim_StrDup("("));
6710 Jim_Free(token);
6711 break;
6712 case JIM_TT_SUBEXPR_END:
6713 {
6714 int found = 0;
6715 while(Jim_StackLen(&stack)) {
6716 char *opstr = Jim_StackPop(&stack);
6717 if (!strcmp(opstr, "(")) {
6718 Jim_Free(opstr);
6719 found = 1;
6720 break;
6721 }
6722 op = JimExprOperatorInfo(opstr);
6723 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6724 }
6725 if (!found) {
6726 Jim_SetResultString(interp,
6727 "Unexpected close parenthesis", -1);
6728 goto err;
6729 }
6730 }
6731 Jim_Free(token);
6732 break;
6733 default:
6734 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6735 break;
6736 }
6737 }
6738 while (Jim_StackLen(&stack)) {
6739 char *opstr = Jim_StackPop(&stack);
6740 op = JimExprOperatorInfo(opstr);
6741 if (op == NULL && !strcmp(opstr, "(")) {
6742 Jim_Free(opstr);
6743 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6744 goto err;
6745 }
6746 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6747 }
6748 /* Check program correctness. */
6749 if (ExprCheckCorrectness(expr) != JIM_OK) {
6750 Jim_SetResultString(interp, "Invalid expression", -1);
6751 goto err;
6752 }
6753
6754 /* Free the stack used for the compilation. */
6755 Jim_FreeStackElements(&stack, Jim_Free);
6756 Jim_FreeStack(&stack);
6757
6758 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6759 ExprMakeLazy(interp, expr);
6760
6761 /* Perform literal sharing */
6762 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6763 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6764 if (bodyObjPtr->typePtr == &scriptObjType) {
6765 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6766 ExprShareLiterals(interp, expr, bodyScript);
6767 }
6768 }
6769
6770 /* Free the old internal rep and set the new one. */
6771 Jim_FreeIntRep(interp, objPtr);
6772 Jim_SetIntRepPtr(objPtr, expr);
6773 objPtr->typePtr = &exprObjType;
6774 return JIM_OK;
6775
6776 err: /* we jump here on syntax/compile errors. */
6777 Jim_FreeStackElements(&stack, Jim_Free);
6778 Jim_FreeStack(&stack);
6779 Jim_Free(expr->opcode);
6780 for (i = 0; i < expr->len; i++) {
6781 Jim_DecrRefCount(interp,expr->obj[i]);
6782 }
6783 Jim_Free(expr->obj);
6784 Jim_Free(expr);
6785 return JIM_ERR;
6786 }
6787
6788 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6789 {
6790 if (objPtr->typePtr != &exprObjType) {
6791 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6792 return NULL;
6793 }
6794 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6795 }
6796
6797 /* -----------------------------------------------------------------------------
6798 * Expressions evaluation.
6799 * Jim uses a specialized stack-based virtual machine for expressions,
6800 * that takes advantage of the fact that expr's operators
6801 * can't be redefined.
6802 *
6803 * Jim_EvalExpression() uses the bytecode compiled by
6804 * SetExprFromAny() method of the "expression" object.
6805 *
6806 * On success a Tcl Object containing the result of the evaluation
6807 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6808 * returned.
6809 * On error the function returns a retcode != to JIM_OK and set a suitable
6810 * error on the interp.
6811 * ---------------------------------------------------------------------------*/
6812 #define JIM_EE_STATICSTACK_LEN 10
6813
6814 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6815 Jim_Obj **exprResultPtrPtr)
6816 {
6817 ExprByteCode *expr;
6818 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6819 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6820
6821 Jim_IncrRefCount(exprObjPtr);
6822 expr = Jim_GetExpression(interp, exprObjPtr);
6823 if (!expr) {
6824 Jim_DecrRefCount(interp, exprObjPtr);
6825 return JIM_ERR; /* error in expression. */
6826 }
6827 /* In order to avoid that the internal repr gets freed due to
6828 * shimmering of the exprObjPtr's object, we make the internal rep
6829 * shared. */
6830 expr->inUse++;
6831
6832 /* The stack-based expr VM itself */
6833
6834 /* Stack allocation. Expr programs have the feature that
6835 * a program of length N can't require a stack longer than
6836 * N. */
6837 if (expr->len > JIM_EE_STATICSTACK_LEN)
6838 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6839 else
6840 stack = staticStack;
6841
6842 /* Execute every istruction */
6843 for (i = 0; i < expr->len; i++) {
6844 Jim_Obj *A, *B, *objPtr;
6845 jim_wide wA, wB, wC;
6846 double dA, dB, dC;
6847 const char *sA, *sB;
6848 int Alen, Blen, retcode;
6849 int opcode = expr->opcode[i];
6850
6851 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6852 stack[stacklen++] = expr->obj[i];
6853 Jim_IncrRefCount(expr->obj[i]);
6854 } else if (opcode == JIM_EXPROP_VARIABLE) {
6855 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6856 if (objPtr == NULL) {
6857 error = 1;
6858 goto err;
6859 }
6860 stack[stacklen++] = objPtr;
6861 Jim_IncrRefCount(objPtr);
6862 } else if (opcode == JIM_EXPROP_SUBST) {
6863 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6864 &objPtr, JIM_NONE)) != JIM_OK)
6865 {
6866 error = 1;
6867 errRetCode = retcode;
6868 goto err;
6869 }
6870 stack[stacklen++] = objPtr;
6871 Jim_IncrRefCount(objPtr);
6872 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6873 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6874 if (objPtr == NULL) {
6875 error = 1;
6876 goto err;
6877 }
6878 stack[stacklen++] = objPtr;
6879 Jim_IncrRefCount(objPtr);
6880 } else if (opcode == JIM_EXPROP_COMMAND) {
6881 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6882 error = 1;
6883 errRetCode = retcode;
6884 goto err;
6885 }
6886 stack[stacklen++] = interp->result;
6887 Jim_IncrRefCount(interp->result);
6888 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6889 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6890 {
6891 /* Note that there isn't to increment the
6892 * refcount of objects. the references are moved
6893 * from stack to A and B. */
6894 B = stack[--stacklen];
6895 A = stack[--stacklen];
6896
6897 /* --- Integer --- */
6898 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6899 (B->typePtr == &doubleObjType && !B->bytes) ||
6900 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6901 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6902 goto trydouble;
6903 }
6904 Jim_DecrRefCount(interp, A);
6905 Jim_DecrRefCount(interp, B);
6906 switch(expr->opcode[i]) {
6907 case JIM_EXPROP_ADD: wC = wA+wB; break;
6908 case JIM_EXPROP_SUB: wC = wA-wB; break;
6909 case JIM_EXPROP_MUL: wC = wA*wB; break;
6910 case JIM_EXPROP_LT: wC = wA<wB; break;
6911 case JIM_EXPROP_GT: wC = wA>wB; break;
6912 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6913 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6914 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6915 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6916 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6917 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6918 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6919 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6920 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6921 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6922 case JIM_EXPROP_LOGICAND_LEFT:
6923 if (wA == 0) {
6924 i += (int)wB;
6925 wC = 0;
6926 } else {
6927 continue;
6928 }
6929 break;
6930 case JIM_EXPROP_LOGICOR_LEFT:
6931 if (wA != 0) {
6932 i += (int)wB;
6933 wC = 1;
6934 } else {
6935 continue;
6936 }
6937 break;
6938 case JIM_EXPROP_DIV:
6939 if (wB == 0) goto divbyzero;
6940 wC = wA/wB;
6941 break;
6942 case JIM_EXPROP_MOD:
6943 if (wB == 0) goto divbyzero;
6944 wC = wA%wB;
6945 break;
6946 case JIM_EXPROP_ROTL: {
6947 /* uint32_t would be better. But not everyone has inttypes.h?*/
6948 unsigned long uA = (unsigned long)wA;
6949 #ifdef _MSC_VER
6950 wC = _rotl(uA,(unsigned long)wB);
6951 #else
6952 const unsigned int S = sizeof(unsigned long) * 8;
6953 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6954 #endif
6955 break;
6956 }
6957 case JIM_EXPROP_ROTR: {
6958 unsigned long uA = (unsigned long)wA;
6959 #ifdef _MSC_VER
6960 wC = _rotr(uA,(unsigned long)wB);
6961 #else
6962 const unsigned int S = sizeof(unsigned long) * 8;
6963 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
6964 #endif
6965 break;
6966 }
6967
6968 default:
6969 wC = 0; /* avoid gcc warning */
6970 break;
6971 }
6972 stack[stacklen] = Jim_NewIntObj(interp, wC);
6973 Jim_IncrRefCount(stack[stacklen]);
6974 stacklen++;
6975 continue;
6976 trydouble:
6977 /* --- Double --- */
6978 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
6979 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
6980 Jim_DecrRefCount(interp, A);
6981 Jim_DecrRefCount(interp, B);
6982 error = 1;
6983 goto err;
6984 }
6985 Jim_DecrRefCount(interp, A);
6986 Jim_DecrRefCount(interp, B);
6987 switch(expr->opcode[i]) {
6988 case JIM_EXPROP_ROTL:
6989 case JIM_EXPROP_ROTR:
6990 case JIM_EXPROP_LSHIFT:
6991 case JIM_EXPROP_RSHIFT:
6992 case JIM_EXPROP_BITAND:
6993 case JIM_EXPROP_BITXOR:
6994 case JIM_EXPROP_BITOR:
6995 case JIM_EXPROP_MOD:
6996 case JIM_EXPROP_POW:
6997 Jim_SetResultString(interp,
6998 "Got floating-point value where integer was expected", -1);
6999 error = 1;
7000 goto err;
7001 break;
7002 case JIM_EXPROP_ADD: dC = dA+dB; break;
7003 case JIM_EXPROP_SUB: dC = dA-dB; break;
7004 case JIM_EXPROP_MUL: dC = dA*dB; break;
7005 case JIM_EXPROP_LT: dC = dA<dB; break;
7006 case JIM_EXPROP_GT: dC = dA>dB; break;
7007 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7008 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7009 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7010 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7011 case JIM_EXPROP_LOGICAND_LEFT:
7012 if (dA == 0) {
7013 i += (int)dB;
7014 dC = 0;
7015 } else {
7016 continue;
7017 }
7018 break;
7019 case JIM_EXPROP_LOGICOR_LEFT:
7020 if (dA != 0) {
7021 i += (int)dB;
7022 dC = 1;
7023 } else {
7024 continue;
7025 }
7026 break;
7027 case JIM_EXPROP_DIV:
7028 if (dB == 0) goto divbyzero;
7029 dC = dA/dB;
7030 break;
7031 default:
7032 dC = 0; /* avoid gcc warning */
7033 break;
7034 }
7035 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7036 Jim_IncrRefCount(stack[stacklen]);
7037 stacklen++;
7038 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7039 B = stack[--stacklen];
7040 A = stack[--stacklen];
7041 sA = Jim_GetString(A, &Alen);
7042 sB = Jim_GetString(B, &Blen);
7043 switch(expr->opcode[i]) {
7044 case JIM_EXPROP_STREQ:
7045 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7046 wC = 1;
7047 else
7048 wC = 0;
7049 break;
7050 case JIM_EXPROP_STRNE:
7051 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7052 wC = 1;
7053 else
7054 wC = 0;
7055 break;
7056 default:
7057 wC = 0; /* avoid gcc warning */
7058 break;
7059 }
7060 Jim_DecrRefCount(interp, A);
7061 Jim_DecrRefCount(interp, B);
7062 stack[stacklen] = Jim_NewIntObj(interp, wC);
7063 Jim_IncrRefCount(stack[stacklen]);
7064 stacklen++;
7065 } else if (opcode == JIM_EXPROP_NOT ||
7066 opcode == JIM_EXPROP_BITNOT ||
7067 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7068 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7069 /* Note that there isn't to increment the
7070 * refcount of objects. the references are moved
7071 * from stack to A and B. */
7072 A = stack[--stacklen];
7073
7074 /* --- Integer --- */
7075 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7076 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7077 goto trydouble_unary;
7078 }
7079 Jim_DecrRefCount(interp, A);
7080 switch(expr->opcode[i]) {
7081 case JIM_EXPROP_NOT: wC = !wA; break;
7082 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7083 case JIM_EXPROP_LOGICAND_RIGHT:
7084 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7085 default:
7086 wC = 0; /* avoid gcc warning */
7087 break;
7088 }
7089 stack[stacklen] = Jim_NewIntObj(interp, wC);
7090 Jim_IncrRefCount(stack[stacklen]);
7091 stacklen++;
7092 continue;
7093 trydouble_unary:
7094 /* --- Double --- */
7095 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7096 Jim_DecrRefCount(interp, A);
7097 error = 1;
7098 goto err;
7099 }
7100 Jim_DecrRefCount(interp, A);
7101 switch(expr->opcode[i]) {
7102 case JIM_EXPROP_NOT: dC = !dA; break;
7103 case JIM_EXPROP_LOGICAND_RIGHT:
7104 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7105 case JIM_EXPROP_BITNOT:
7106 Jim_SetResultString(interp,
7107 "Got floating-point value where integer was expected", -1);
7108 error = 1;
7109 goto err;
7110 break;
7111 default:
7112 dC = 0; /* avoid gcc warning */
7113 break;
7114 }
7115 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7116 Jim_IncrRefCount(stack[stacklen]);
7117 stacklen++;
7118 } else {
7119 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7120 }
7121 }
7122 err:
7123 /* There is no need to decerement the inUse field because
7124 * this reference is transfered back into the exprObjPtr. */
7125 Jim_FreeIntRep(interp, exprObjPtr);
7126 exprObjPtr->typePtr = &exprObjType;
7127 Jim_SetIntRepPtr(exprObjPtr, expr);
7128 Jim_DecrRefCount(interp, exprObjPtr);
7129 if (!error) {
7130 *exprResultPtrPtr = stack[0];
7131 Jim_IncrRefCount(stack[0]);
7132 errRetCode = JIM_OK;
7133 }
7134 for (i = 0; i < stacklen; i++) {
7135 Jim_DecrRefCount(interp, stack[i]);
7136 }
7137 if (stack != staticStack)
7138 Jim_Free(stack);
7139 return errRetCode;
7140 divbyzero:
7141 error = 1;
7142 Jim_SetResultString(interp, "Division by zero", -1);
7143 goto err;
7144 }
7145
7146 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7147 {
7148 int retcode;
7149 jim_wide wideValue;
7150 double doubleValue;
7151 Jim_Obj *exprResultPtr;
7152
7153 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7154 if (retcode != JIM_OK)
7155 return retcode;
7156 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7157 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7158 {
7159 Jim_DecrRefCount(interp, exprResultPtr);
7160 return JIM_ERR;
7161 } else {
7162 Jim_DecrRefCount(interp, exprResultPtr);
7163 *boolPtr = doubleValue != 0;
7164 return JIM_OK;
7165 }
7166 }
7167 Jim_DecrRefCount(interp, exprResultPtr);
7168 *boolPtr = wideValue != 0;
7169 return JIM_OK;
7170 }
7171
7172 /* -----------------------------------------------------------------------------
7173 * ScanFormat String Object
7174 * ---------------------------------------------------------------------------*/
7175
7176 /* This Jim_Obj will held a parsed representation of a format string passed to
7177 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7178 * to be parsed in its entirely first and then, if correct, can be used for
7179 * scanning. To avoid endless re-parsing, the parsed representation will be
7180 * stored in an internal representation and re-used for performance reason. */
7181
7182 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7183 * scanformat string. This part will later be used to extract information
7184 * out from the string to be parsed by Jim_ScanString */
7185
7186 typedef struct ScanFmtPartDescr {
7187 char type; /* Type of conversion (e.g. c, d, f) */
7188 char modifier; /* Modify type (e.g. l - long, h - short */
7189 size_t width; /* Maximal width of input to be converted */
7190 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7191 char *arg; /* Specification of a CHARSET conversion */
7192 char *prefix; /* Prefix to be scanned literally before conversion */
7193 } ScanFmtPartDescr;
7194
7195 /* The ScanFmtStringObj will held the internal representation of a scanformat
7196 * string parsed and separated in part descriptions. Furthermore it contains
7197 * the original string representation of the scanformat string to allow for
7198 * fast update of the Jim_Obj's string representation part.
7199 *
7200 * As add-on the internal object representation add some scratch pad area
7201 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7202 * memory for purpose of string scanning.
7203 *
7204 * The error member points to a static allocated string in case of a mal-
7205 * formed scanformat string or it contains '0' (NULL) in case of a valid
7206 * parse representation.
7207 *
7208 * The whole memory of the internal representation is allocated as a single
7209 * area of memory that will be internally separated. So freeing and duplicating
7210 * of such an object is cheap */
7211
7212 typedef struct ScanFmtStringObj {
7213 jim_wide size; /* Size of internal repr in bytes */
7214 char *stringRep; /* Original string representation */
7215 size_t count; /* Number of ScanFmtPartDescr contained */
7216 size_t convCount; /* Number of conversions that will assign */
7217 size_t maxPos; /* Max position index if XPG3 is used */
7218 const char *error; /* Ptr to error text (NULL if no error */
7219 char *scratch; /* Some scratch pad used by Jim_ScanString */
7220 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7221 } ScanFmtStringObj;
7222
7223
7224 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7225 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7226 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7227
7228 static Jim_ObjType scanFmtStringObjType = {
7229 "scanformatstring",
7230 FreeScanFmtInternalRep,
7231 DupScanFmtInternalRep,
7232 UpdateStringOfScanFmt,
7233 JIM_TYPE_NONE,
7234 };
7235
7236 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7237 {
7238 JIM_NOTUSED(interp);
7239 Jim_Free((char*)objPtr->internalRep.ptr);
7240 objPtr->internalRep.ptr = 0;
7241 }
7242
7243 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7244 {
7245 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7246 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7247
7248 JIM_NOTUSED(interp);
7249 memcpy(newVec, srcPtr->internalRep.ptr, size);
7250 dupPtr->internalRep.ptr = newVec;
7251 dupPtr->typePtr = &scanFmtStringObjType;
7252 }
7253
7254 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7255 {
7256 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7257
7258 objPtr->bytes = Jim_StrDup(bytes);
7259 objPtr->length = strlen(bytes);
7260 }
7261
7262 /* SetScanFmtFromAny will parse a given string and create the internal
7263 * representation of the format specification. In case of an error
7264 * the error data member of the internal representation will be set
7265 * to an descriptive error text and the function will be left with
7266 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7267 * specification */
7268
7269 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7270 {
7271 ScanFmtStringObj *fmtObj;
7272 char *buffer;
7273 int maxCount, i, approxSize, lastPos = -1;
7274 const char *fmt = objPtr->bytes;
7275 int maxFmtLen = objPtr->length;
7276 const char *fmtEnd = fmt + maxFmtLen;
7277 int curr;
7278
7279 Jim_FreeIntRep(interp, objPtr);
7280 /* Count how many conversions could take place maximally */
7281 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7282 if (fmt[i] == '%')
7283 ++maxCount;
7284 /* Calculate an approximation of the memory necessary */
7285 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7286 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7287 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7288 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7289 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7290 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7291 + 1; /* safety byte */
7292 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7293 memset(fmtObj, 0, approxSize);
7294 fmtObj->size = approxSize;
7295 fmtObj->maxPos = 0;
7296 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7297 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7298 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7299 buffer = fmtObj->stringRep + maxFmtLen + 1;
7300 objPtr->internalRep.ptr = fmtObj;
7301 objPtr->typePtr = &scanFmtStringObjType;
7302 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7303 int width=0, skip;
7304 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7305 fmtObj->count++;
7306 descr->width = 0; /* Assume width unspecified */
7307 /* Overread and store any "literal" prefix */
7308 if (*fmt != '%' || fmt[1] == '%') {
7309 descr->type = 0;
7310 descr->prefix = &buffer[i];
7311 for (; fmt < fmtEnd; ++fmt) {
7312 if (*fmt == '%') {
7313 if (fmt[1] != '%') break;
7314 ++fmt;
7315 }
7316 buffer[i++] = *fmt;
7317 }
7318 buffer[i++] = 0;
7319 }
7320 /* Skip the conversion introducing '%' sign */
7321 ++fmt;
7322 /* End reached due to non-conversion literal only? */
7323 if (fmt >= fmtEnd)
7324 goto done;
7325 descr->pos = 0; /* Assume "natural" positioning */
7326 if (*fmt == '*') {
7327 descr->pos = -1; /* Okay, conversion will not be assigned */
7328 ++fmt;
7329 } else
7330 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7331 /* Check if next token is a number (could be width or pos */
7332 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7333 fmt += skip;
7334 /* Was the number a XPG3 position specifier? */
7335 if (descr->pos != -1 && *fmt == '$') {
7336 int prev;
7337 ++fmt;
7338 descr->pos = width;
7339 width = 0;
7340 /* Look if "natural" postioning and XPG3 one was mixed */
7341 if ((lastPos == 0 && descr->pos > 0)
7342 || (lastPos > 0 && descr->pos == 0)) {
7343 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7344 return JIM_ERR;
7345 }
7346 /* Look if this position was already used */
7347 for (prev=0; prev < curr; ++prev) {
7348 if (fmtObj->descr[prev].pos == -1) continue;
7349 if (fmtObj->descr[prev].pos == descr->pos) {
7350 fmtObj->error = "same \"%n$\" conversion specifier "
7351 "used more than once";
7352 return JIM_ERR;
7353 }
7354 }
7355 /* Try to find a width after the XPG3 specifier */
7356 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7357 descr->width = width;
7358 fmt += skip;
7359 }
7360 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7361 fmtObj->maxPos = descr->pos;
7362 } else {
7363 /* Number was not a XPG3, so it has to be a width */
7364 descr->width = width;
7365 }
7366 }
7367 /* If positioning mode was undetermined yet, fix this */
7368 if (lastPos == -1)
7369 lastPos = descr->pos;
7370 /* Handle CHARSET conversion type ... */
7371 if (*fmt == '[') {
7372 int swapped = 1, beg = i, end, j;
7373 descr->type = '[';
7374 descr->arg = &buffer[i];
7375 ++fmt;
7376 if (*fmt == '^') buffer[i++] = *fmt++;
7377 if (*fmt == ']') buffer[i++] = *fmt++;
7378 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7379 if (*fmt != ']') {
7380 fmtObj->error = "unmatched [ in format string";
7381 return JIM_ERR;
7382 }
7383 end = i;
7384 buffer[i++] = 0;
7385 /* In case a range fence was given "backwards", swap it */
7386 while (swapped) {
7387 swapped = 0;
7388 for (j=beg+1; j < end-1; ++j) {
7389 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7390 char tmp = buffer[j-1];
7391 buffer[j-1] = buffer[j+1];
7392 buffer[j+1] = tmp;
7393 swapped = 1;
7394 }
7395 }
7396 }
7397 } else {
7398 /* Remember any valid modifier if given */
7399 if (strchr("hlL", *fmt) != 0)
7400 descr->modifier = tolower((int)*fmt++);
7401
7402 descr->type = *fmt;
7403 if (strchr("efgcsndoxui", *fmt) == 0) {
7404 fmtObj->error = "bad scan conversion character";
7405 return JIM_ERR;
7406 } else if (*fmt == 'c' && descr->width != 0) {
7407 fmtObj->error = "field width may not be specified in %c "
7408 "conversion";
7409 return JIM_ERR;
7410 } else if (*fmt == 'u' && descr->modifier == 'l') {
7411 fmtObj->error = "unsigned wide not supported";
7412 return JIM_ERR;
7413 }
7414 }
7415 curr++;
7416 }
7417 done:
7418 if (fmtObj->convCount == 0) {
7419 fmtObj->error = "no any conversion specifier given";
7420 return JIM_ERR;
7421 }
7422 return JIM_OK;
7423 }
7424
7425 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7426
7427 #define FormatGetCnvCount(_fo_) \
7428 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7429 #define FormatGetMaxPos(_fo_) \
7430 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7431 #define FormatGetError(_fo_) \
7432 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7433
7434 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7435 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7436 * bitvector implementation in Jim? */
7437
7438 static int JimTestBit(const char *bitvec, char ch)
7439 {
7440 div_t pos = div(ch-1, 8);
7441 return bitvec[pos.quot] & (1 << pos.rem);
7442 }
7443
7444 static void JimSetBit(char *bitvec, char ch)
7445 {
7446 div_t pos = div(ch-1, 8);
7447 bitvec[pos.quot] |= (1 << pos.rem);
7448 }
7449
7450 #if 0 /* currently not used */
7451 static void JimClearBit(char *bitvec, char ch)
7452 {
7453 div_t pos = div(ch-1, 8);
7454 bitvec[pos.quot] &= ~(1 << pos.rem);
7455 }
7456 #endif
7457
7458 /* JimScanAString is used to scan an unspecified string that ends with
7459 * next WS, or a string that is specified via a charset. The charset
7460 * is currently implemented in a way to only allow for usage with
7461 * ASCII. Whenever we will switch to UNICODE, another idea has to
7462 * be born :-/
7463 *
7464 * FIXME: Works only with ASCII */
7465
7466 static Jim_Obj *
7467 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7468 {
7469 size_t i;
7470 Jim_Obj *result;
7471 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7472 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7473
7474 /* First init charset to nothing or all, depending if a specified
7475 * or an unspecified string has to be parsed */
7476 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7477 if (sdescr) {
7478 /* There was a set description given, that means we are parsing
7479 * a specified string. So we have to build a corresponding
7480 * charset reflecting the description */
7481 int notFlag = 0;
7482 /* Should the set be negated at the end? */
7483 if (*sdescr == '^') {
7484 notFlag = 1;
7485 ++sdescr;
7486 }
7487 /* Here '-' is meant literally and not to define a range */
7488 if (*sdescr == '-') {
7489 JimSetBit(charset, '-');
7490 ++sdescr;
7491 }
7492 while (*sdescr) {
7493 if (sdescr[1] == '-' && sdescr[2] != 0) {
7494 /* Handle range definitions */
7495 int i;
7496 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7497 JimSetBit(charset, (char)i);
7498 sdescr += 3;
7499 } else {
7500 /* Handle verbatim character definitions */
7501 JimSetBit(charset, *sdescr++);
7502 }
7503 }
7504 /* Negate the charset if there was a NOT given */
7505 for (i=0; notFlag && i < sizeof(charset); ++i)
7506 charset[i] = ~charset[i];
7507 }
7508 /* And after all the mess above, the real work begin ... */
7509 while (str && *str) {
7510 if (!sdescr && isspace((int)*str))
7511 break; /* EOS via WS if unspecified */
7512 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7513 else break; /* EOS via mismatch if specified scanning */
7514 }
7515 *buffer = 0; /* Close the string properly ... */
7516 result = Jim_NewStringObj(interp, anchor, -1);
7517 Jim_Free(anchor); /* ... and free it afer usage */
7518 return result;
7519 }
7520
7521 /* ScanOneEntry will scan one entry out of the string passed as argument.
7522 * It use the sscanf() function for this task. After extracting and
7523 * converting of the value, the count of scanned characters will be
7524 * returned of -1 in case of no conversion tool place and string was
7525 * already scanned thru */
7526
7527 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7528 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7529 {
7530 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7531 ? sizeof(jim_wide) \
7532 : sizeof(double))
7533 char buffer[MAX_SIZE];
7534 char *value = buffer;
7535 const char *tok;
7536 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7537 size_t sLen = strlen(&str[pos]), scanned = 0;
7538 size_t anchor = pos;
7539 int i;
7540
7541 /* First pessimiticly assume, we will not scan anything :-) */
7542 *valObjPtr = 0;
7543 if (descr->prefix) {
7544 /* There was a prefix given before the conversion, skip it and adjust
7545 * the string-to-be-parsed accordingly */
7546 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7547 /* If prefix require, skip WS */
7548 if (isspace((int)descr->prefix[i]))
7549 while (str[pos] && isspace((int)str[pos])) ++pos;
7550 else if (descr->prefix[i] != str[pos])
7551 break; /* Prefix do not match here, leave the loop */
7552 else
7553 ++pos; /* Prefix matched so far, next round */
7554 }
7555 if (str[pos] == 0)
7556 return -1; /* All of str consumed: EOF condition */
7557 else if (descr->prefix[i] != 0)
7558 return 0; /* Not whole prefix consumed, no conversion possible */
7559 }
7560 /* For all but following conversion, skip leading WS */
7561 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7562 while (isspace((int)str[pos])) ++pos;
7563 /* Determine how much skipped/scanned so far */
7564 scanned = pos - anchor;
7565 if (descr->type == 'n') {
7566 /* Return pseudo conversion means: how much scanned so far? */
7567 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7568 } else if (str[pos] == 0) {
7569 /* Cannot scan anything, as str is totally consumed */
7570 return -1;
7571 } else {
7572 /* Processing of conversions follows ... */
7573 if (descr->width > 0) {
7574 /* Do not try to scan as fas as possible but only the given width.
7575 * To ensure this, we copy the part that should be scanned. */
7576 size_t tLen = descr->width > sLen ? sLen : descr->width;
7577 tok = Jim_StrDupLen(&str[pos], tLen);
7578 } else {
7579 /* As no width was given, simply refer to the original string */
7580 tok = &str[pos];
7581 }
7582 switch (descr->type) {
7583 case 'c':
7584 *valObjPtr = Jim_NewIntObj(interp, *tok);
7585 scanned += 1;
7586 break;
7587 case 'd': case 'o': case 'x': case 'u': case 'i': {
7588 char *endp; /* Position where the number finished */
7589 int base = descr->type == 'o' ? 8
7590 : descr->type == 'x' ? 16
7591 : descr->type == 'i' ? 0
7592 : 10;
7593
7594 do {
7595 /* Try to scan a number with the given base */
7596 if (descr->modifier == 'l')
7597 #ifdef HAVE_LONG_LONG
7598 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7599 #else
7600 *(jim_wide*)value = strtol(tok, &endp, base);
7601 #endif
7602 else
7603 if (descr->type == 'u')
7604 *(long*)value = strtoul(tok, &endp, base);
7605 else
7606 *(long*)value = strtol(tok, &endp, base);
7607 /* If scanning failed, and base was undetermined, simply
7608 * put it to 10 and try once more. This should catch the
7609 * case where %i begin to parse a number prefix (e.g.
7610 * '0x' but no further digits follows. This will be
7611 * handled as a ZERO followed by a char 'x' by Tcl */
7612 if (endp == tok && base == 0) base = 10;
7613 else break;
7614 } while (1);
7615 if (endp != tok) {
7616 /* There was some number sucessfully scanned! */
7617 if (descr->modifier == 'l')
7618 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7619 else
7620 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7621 /* Adjust the number-of-chars scanned so far */
7622 scanned += endp - tok;
7623 } else {
7624 /* Nothing was scanned. We have to determine if this
7625 * happened due to e.g. prefix mismatch or input str
7626 * exhausted */
7627 scanned = *tok ? 0 : -1;
7628 }
7629 break;
7630 }
7631 case 's': case '[': {
7632 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7633 scanned += Jim_Length(*valObjPtr);
7634 break;
7635 }
7636 case 'e': case 'f': case 'g': {
7637 char *endp;
7638
7639 *(double*)value = strtod(tok, &endp);
7640 if (endp != tok) {
7641 /* There was some number sucessfully scanned! */
7642 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7643 /* Adjust the number-of-chars scanned so far */
7644 scanned += endp - tok;
7645 } else {
7646 /* Nothing was scanned. We have to determine if this
7647 * happened due to e.g. prefix mismatch or input str
7648 * exhausted */
7649 scanned = *tok ? 0 : -1;
7650 }
7651 break;
7652 }
7653 }
7654 /* If a substring was allocated (due to pre-defined width) do not
7655 * forget to free it */
7656 if (tok != &str[pos])
7657 Jim_Free((char*)tok);
7658 }
7659 return scanned;
7660 }
7661
7662 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7663 * string and returns all converted (and not ignored) values in a list back
7664 * to the caller. If an error occured, a NULL pointer will be returned */
7665
7666 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7667 Jim_Obj *fmtObjPtr, int flags)
7668 {
7669 size_t i, pos;
7670 int scanned = 1;
7671 const char *str = Jim_GetString(strObjPtr, 0);
7672 Jim_Obj *resultList = 0;
7673 Jim_Obj **resultVec;
7674 int resultc;
7675 Jim_Obj *emptyStr = 0;
7676 ScanFmtStringObj *fmtObj;
7677
7678 /* If format specification is not an object, convert it! */
7679 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7680 SetScanFmtFromAny(interp, fmtObjPtr);
7681 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7682 /* Check if format specification was valid */
7683 if (fmtObj->error != 0) {
7684 if (flags & JIM_ERRMSG)
7685 Jim_SetResultString(interp, fmtObj->error, -1);
7686 return 0;
7687 }
7688 /* Allocate a new "shared" empty string for all unassigned conversions */
7689 emptyStr = Jim_NewEmptyStringObj(interp);
7690 Jim_IncrRefCount(emptyStr);
7691 /* Create a list and fill it with empty strings up to max specified XPG3 */
7692 resultList = Jim_NewListObj(interp, 0, 0);
7693 if (fmtObj->maxPos > 0) {
7694 for (i=0; i < fmtObj->maxPos; ++i)
7695 Jim_ListAppendElement(interp, resultList, emptyStr);
7696 JimListGetElements(interp, resultList, &resultc, &resultVec);
7697 }
7698 /* Now handle every partial format description */
7699 for (i=0, pos=0; i < fmtObj->count; ++i) {
7700 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7701 Jim_Obj *value = 0;
7702 /* Only last type may be "literal" w/o conversion - skip it! */
7703 if (descr->type == 0) continue;
7704 /* As long as any conversion could be done, we will proceed */
7705 if (scanned > 0)
7706 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7707 /* In case our first try results in EOF, we will leave */
7708 if (scanned == -1 && i == 0)
7709 goto eof;
7710 /* Advance next pos-to-be-scanned for the amount scanned already */
7711 pos += scanned;
7712 /* value == 0 means no conversion took place so take empty string */
7713 if (value == 0)
7714 value = Jim_NewEmptyStringObj(interp);
7715 /* If value is a non-assignable one, skip it */
7716 if (descr->pos == -1) {
7717 Jim_FreeNewObj(interp, value);
7718 } else if (descr->pos == 0)
7719 /* Otherwise append it to the result list if no XPG3 was given */
7720 Jim_ListAppendElement(interp, resultList, value);
7721 else if (resultVec[descr->pos-1] == emptyStr) {
7722 /* But due to given XPG3, put the value into the corr. slot */
7723 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7724 Jim_IncrRefCount(value);
7725 resultVec[descr->pos-1] = value;
7726 } else {
7727 /* Otherwise, the slot was already used - free obj and ERROR */
7728 Jim_FreeNewObj(interp, value);
7729 goto err;
7730 }
7731 }
7732 Jim_DecrRefCount(interp, emptyStr);
7733 return resultList;
7734 eof:
7735 Jim_DecrRefCount(interp, emptyStr);
7736 Jim_FreeNewObj(interp, resultList);
7737 return (Jim_Obj*)EOF;
7738 err:
7739 Jim_DecrRefCount(interp, emptyStr);
7740 Jim_FreeNewObj(interp, resultList);
7741 return 0;
7742 }
7743
7744 /* -----------------------------------------------------------------------------
7745 * Pseudo Random Number Generation
7746 * ---------------------------------------------------------------------------*/
7747 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7748 int seedLen);
7749
7750 /* Initialize the sbox with the numbers from 0 to 255 */
7751 static void JimPrngInit(Jim_Interp *interp)
7752 {
7753 int i;
7754 unsigned int seed[256];
7755
7756 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7757 for (i = 0; i < 256; i++)
7758 seed[i] = (rand() ^ time(NULL) ^ clock());
7759 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7760 }
7761
7762 /* Generates N bytes of random data */
7763 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7764 {
7765 Jim_PrngState *prng;
7766 unsigned char *destByte = (unsigned char*) dest;
7767 unsigned int si, sj, x;
7768
7769 /* initialization, only needed the first time */
7770 if (interp->prngState == NULL)
7771 JimPrngInit(interp);
7772 prng = interp->prngState;
7773 /* generates 'len' bytes of pseudo-random numbers */
7774 for (x = 0; x < len; x++) {
7775 prng->i = (prng->i+1) & 0xff;
7776 si = prng->sbox[prng->i];
7777 prng->j = (prng->j + si) & 0xff;
7778 sj = prng->sbox[prng->j];
7779 prng->sbox[prng->i] = sj;
7780 prng->sbox[prng->j] = si;
7781 *destByte++ = prng->sbox[(si+sj)&0xff];
7782 }
7783 }
7784
7785 /* Re-seed the generator with user-provided bytes */
7786 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7787 int seedLen)
7788 {
7789 int i;
7790 unsigned char buf[256];
7791 Jim_PrngState *prng;
7792
7793 /* initialization, only needed the first time */
7794 if (interp->prngState == NULL)
7795 JimPrngInit(interp);
7796 prng = interp->prngState;
7797
7798 /* Set the sbox[i] with i */
7799 for (i = 0; i < 256; i++)
7800 prng->sbox[i] = i;
7801 /* Now use the seed to perform a random permutation of the sbox */
7802 for (i = 0; i < seedLen; i++) {
7803 unsigned char t;
7804
7805 t = prng->sbox[i&0xFF];
7806 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7807 prng->sbox[seed[i]] = t;
7808 }
7809 prng->i = prng->j = 0;
7810 /* discard the first 256 bytes of stream. */
7811 JimRandomBytes(interp, buf, 256);
7812 }
7813
7814 /* -----------------------------------------------------------------------------
7815 * Dynamic libraries support (WIN32 not supported)
7816 * ---------------------------------------------------------------------------*/
7817
7818 #ifdef JIM_DYNLIB
7819 #ifdef WIN32
7820 #define RTLD_LAZY 0
7821 void * dlopen(const char *path, int mode)
7822 {
7823 JIM_NOTUSED(mode);
7824
7825 return (void *)LoadLibraryA(path);
7826 }
7827 int dlclose(void *handle)
7828 {
7829 FreeLibrary((HANDLE)handle);
7830 return 0;
7831 }
7832 void *dlsym(void *handle, const char *symbol)
7833 {
7834 return GetProcAddress((HMODULE)handle, symbol);
7835 }
7836 static char win32_dlerror_string[121];
7837 const char *dlerror(void)
7838 {
7839 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7840 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7841 return win32_dlerror_string;
7842 }
7843 #endif /* WIN32 */
7844
7845 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7846 {
7847 Jim_Obj *libPathObjPtr;
7848 int prefixc, i;
7849 void *handle;
7850 int (*onload)(Jim_Interp *interp);
7851
7852 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7853 if (libPathObjPtr == NULL) {
7854 prefixc = 0;
7855 libPathObjPtr = NULL;
7856 } else {
7857 Jim_IncrRefCount(libPathObjPtr);
7858 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7859 }
7860
7861 for (i = -1; i < prefixc; i++) {
7862 if (i < 0) {
7863 handle = dlopen(pathName, RTLD_LAZY);
7864 } else {
7865 FILE *fp;
7866 char buf[JIM_PATH_LEN];
7867 const char *prefix;
7868 int prefixlen;
7869 Jim_Obj *prefixObjPtr;
7870
7871 buf[0] = '\0';
7872 if (Jim_ListIndex(interp, libPathObjPtr, i,
7873 &prefixObjPtr, JIM_NONE) != JIM_OK)
7874 continue;
7875 prefix = Jim_GetString(prefixObjPtr, NULL);
7876 prefixlen = strlen(prefix);
7877 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7878 continue;
7879 if (prefixlen && prefix[prefixlen-1] == '/')
7880 sprintf(buf, "%s%s", prefix, pathName);
7881 else
7882 sprintf(buf, "%s/%s", prefix, pathName);
7883 printf("opening '%s'\n", buf);
7884 fp = fopen(buf, "r");
7885 if (fp == NULL)
7886 continue;
7887 fclose(fp);
7888 handle = dlopen(buf, RTLD_LAZY);
7889 printf("got handle %p\n", handle);
7890 }
7891 if (handle == NULL) {
7892 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7893 Jim_AppendStrings(interp, Jim_GetResult(interp),
7894 "error loading extension \"", pathName,
7895 "\": ", dlerror(), NULL);
7896 if (i < 0)
7897 continue;
7898 goto err;
7899 }
7900 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7901 Jim_SetResultString(interp,
7902 "No Jim_OnLoad symbol found on extension", -1);
7903 goto err;
7904 }
7905 if (onload(interp) == JIM_ERR) {
7906 dlclose(handle);
7907 goto err;
7908 }
7909 Jim_SetEmptyResult(interp);
7910 if (libPathObjPtr != NULL)
7911 Jim_DecrRefCount(interp, libPathObjPtr);
7912 return JIM_OK;
7913 }
7914 err:
7915 if (libPathObjPtr != NULL)
7916 Jim_DecrRefCount(interp, libPathObjPtr);
7917 return JIM_ERR;
7918 }
7919 #else /* JIM_DYNLIB */
7920 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7921 {
7922 JIM_NOTUSED(interp);
7923 JIM_NOTUSED(pathName);
7924
7925 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7926 return JIM_ERR;
7927 }
7928 #endif/* JIM_DYNLIB */
7929
7930 /* -----------------------------------------------------------------------------
7931 * Packages handling
7932 * ---------------------------------------------------------------------------*/
7933
7934 #define JIM_PKG_ANY_VERSION -1
7935
7936 /* Convert a string of the type "1.2" into an integer.
7937 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7938 * to the integer with value 102 */
7939 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7940 int *intPtr, int flags)
7941 {
7942 char *copy;
7943 jim_wide major, minor;
7944 char *majorStr, *minorStr, *p;
7945
7946 if (v[0] == '\0') {
7947 *intPtr = JIM_PKG_ANY_VERSION;
7948 return JIM_OK;
7949 }
7950
7951 copy = Jim_StrDup(v);
7952 p = strchr(copy, '.');
7953 if (p == NULL) goto badfmt;
7954 *p = '\0';
7955 majorStr = copy;
7956 minorStr = p+1;
7957
7958 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
7959 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
7960 goto badfmt;
7961 *intPtr = (int)(major*100+minor);
7962 Jim_Free(copy);
7963 return JIM_OK;
7964
7965 badfmt:
7966 Jim_Free(copy);
7967 if (flags & JIM_ERRMSG) {
7968 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7969 Jim_AppendStrings(interp, Jim_GetResult(interp),
7970 "invalid package version '", v, "'", NULL);
7971 }
7972 return JIM_ERR;
7973 }
7974
7975 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
7976 static int JimPackageMatchVersion(int needed, int actual, int flags)
7977 {
7978 if (needed == JIM_PKG_ANY_VERSION) return 1;
7979 if (flags & JIM_MATCHVER_EXACT) {
7980 return needed == actual;
7981 } else {
7982 return needed/100 == actual/100 && (needed <= actual);
7983 }
7984 }
7985
7986 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
7987 int flags)
7988 {
7989 int intVersion;
7990 /* Check if the version format is ok */
7991 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
7992 return JIM_ERR;
7993 /* If the package was already provided returns an error. */
7994 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
7995 if (flags & JIM_ERRMSG) {
7996 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7997 Jim_AppendStrings(interp, Jim_GetResult(interp),
7998 "package '", name, "' was already provided", NULL);
7999 }
8000 return JIM_ERR;
8001 }
8002 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8003 return JIM_OK;
8004 }
8005
8006 #ifndef JIM_ANSIC
8007
8008 #ifndef WIN32
8009 # include <sys/types.h>
8010 # include <dirent.h>
8011 #else
8012 # include <io.h>
8013 /* Posix dirent.h compatiblity layer for WIN32.
8014 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8015 * Copyright Salvatore Sanfilippo ,2005.
8016 *
8017 * Permission to use, copy, modify, and distribute this software and its
8018 * documentation for any purpose is hereby granted without fee, provided
8019 * that this copyright and permissions notice appear in all copies and
8020 * derivatives.
8021 *
8022 * This software is supplied "as is" without express or implied warranty.
8023 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8024 */
8025
8026 struct dirent {
8027 char *d_name;
8028 };
8029
8030 typedef struct DIR {
8031 long handle; /* -1 for failed rewind */
8032 struct _finddata_t info;
8033 struct dirent result; /* d_name null iff first time */
8034 char *name; /* null-terminated char string */
8035 } DIR;
8036
8037 DIR *opendir(const char *name)
8038 {
8039 DIR *dir = 0;
8040
8041 if(name && name[0]) {
8042 size_t base_length = strlen(name);
8043 const char *all = /* search pattern must end with suitable wildcard */
8044 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8045
8046 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8047 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8048 {
8049 strcat(strcpy(dir->name, name), all);
8050
8051 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8052 dir->result.d_name = 0;
8053 else { /* rollback */
8054 Jim_Free(dir->name);
8055 Jim_Free(dir);
8056 dir = 0;
8057 }
8058 } else { /* rollback */
8059 Jim_Free(dir);
8060 dir = 0;
8061 errno = ENOMEM;
8062 }
8063 } else {
8064 errno = EINVAL;
8065 }
8066 return dir;
8067 }
8068
8069 int closedir(DIR *dir)
8070 {
8071 int result = -1;
8072
8073 if(dir) {
8074 if(dir->handle != -1)
8075 result = _findclose(dir->handle);
8076 Jim_Free(dir->name);
8077 Jim_Free(dir);
8078 }
8079 if(result == -1) /* map all errors to EBADF */
8080 errno = EBADF;
8081 return result;
8082 }
8083
8084 struct dirent *readdir(DIR *dir)
8085 {
8086 struct dirent *result = 0;
8087
8088 if(dir && dir->handle != -1) {
8089 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8090 result = &dir->result;
8091 result->d_name = dir->info.name;
8092 }
8093 } else {
8094 errno = EBADF;
8095 }
8096 return result;
8097 }
8098
8099 #endif /* WIN32 */
8100
8101 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8102 int prefixc, const char *pkgName, int pkgVer, int flags)
8103 {
8104 int bestVer = -1, i;
8105 int pkgNameLen = strlen(pkgName);
8106 char *bestPackage = NULL;
8107 struct dirent *de;
8108
8109 for (i = 0; i < prefixc; i++) {
8110 DIR *dir;
8111 char buf[JIM_PATH_LEN];
8112 int prefixLen;
8113
8114 if (prefixes[i] == NULL) continue;
8115 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8116 buf[JIM_PATH_LEN-1] = '\0';
8117 prefixLen = strlen(buf);
8118 if (prefixLen && buf[prefixLen-1] == '/')
8119 buf[prefixLen-1] = '\0';
8120
8121 if ((dir = opendir(buf)) == NULL) continue;
8122 while ((de = readdir(dir)) != NULL) {
8123 char *fileName = de->d_name;
8124 int fileNameLen = strlen(fileName);
8125
8126 if (strncmp(fileName, "jim-", 4) == 0 &&
8127 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8128 *(fileName+4+pkgNameLen) == '-' &&
8129 fileNameLen > 4 && /* note that this is not really useful */
8130 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8131 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8132 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8133 {
8134 char ver[6]; /* xx.yy<nulterm> */
8135 char *p = strrchr(fileName, '.');
8136 int verLen, fileVer;
8137
8138 verLen = p - (fileName+4+pkgNameLen+1);
8139 if (verLen < 3 || verLen > 5) continue;
8140 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8141 ver[verLen] = '\0';
8142 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8143 != JIM_OK) continue;
8144 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8145 (bestVer == -1 || bestVer < fileVer))
8146 {
8147 bestVer = fileVer;
8148 Jim_Free(bestPackage);
8149 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8150 sprintf(bestPackage, "%s/%s", buf, fileName);
8151 }
8152 }
8153 }
8154 closedir(dir);
8155 }
8156 return bestPackage;
8157 }
8158
8159 #else /* JIM_ANSIC */
8160
8161 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8162 int prefixc, const char *pkgName, int pkgVer, int flags)
8163 {
8164 JIM_NOTUSED(interp);
8165 JIM_NOTUSED(prefixes);
8166 JIM_NOTUSED(prefixc);
8167 JIM_NOTUSED(pkgName);
8168 JIM_NOTUSED(pkgVer);
8169 JIM_NOTUSED(flags);
8170 return NULL;
8171 }
8172
8173 #endif /* JIM_ANSIC */
8174
8175 /* Search for a suitable package under every dir specified by jim_libpath
8176 * and load it if possible. If a suitable package was loaded with success
8177 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8178 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8179 int flags)
8180 {
8181 Jim_Obj *libPathObjPtr;
8182 char **prefixes, *best;
8183 int prefixc, i, retCode = JIM_OK;
8184
8185 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8186 if (libPathObjPtr == NULL) {
8187 prefixc = 0;
8188 libPathObjPtr = NULL;
8189 } else {
8190 Jim_IncrRefCount(libPathObjPtr);
8191 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8192 }
8193
8194 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8195 for (i = 0; i < prefixc; i++) {
8196 Jim_Obj *prefixObjPtr;
8197 if (Jim_ListIndex(interp, libPathObjPtr, i,
8198 &prefixObjPtr, JIM_NONE) != JIM_OK)
8199 {
8200 prefixes[i] = NULL;
8201 continue;
8202 }
8203 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8204 }
8205 /* Scan every directory to find the "best" package. */
8206 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8207 if (best != NULL) {
8208 char *p = strrchr(best, '.');
8209 /* Try to load/source it */
8210 if (p && strcmp(p, ".tcl") == 0) {
8211 retCode = Jim_EvalFile(interp, best);
8212 } else {
8213 retCode = Jim_LoadLibrary(interp, best);
8214 }
8215 } else {
8216 retCode = JIM_ERR;
8217 }
8218 Jim_Free(best);
8219 for (i = 0; i < prefixc; i++)
8220 Jim_Free(prefixes[i]);
8221 Jim_Free(prefixes);
8222 if (libPathObjPtr)
8223 Jim_DecrRefCount(interp, libPathObjPtr);
8224 return retCode;
8225 }
8226
8227 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8228 const char *ver, int flags)
8229 {
8230 Jim_HashEntry *he;
8231 int requiredVer;
8232
8233 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8234 return NULL;
8235 he = Jim_FindHashEntry(&interp->packages, name);
8236 if (he == NULL) {
8237 /* Try to load the package. */
8238 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8239 he = Jim_FindHashEntry(&interp->packages, name);
8240 if (he == NULL) {
8241 return "?";
8242 }
8243 return he->val;
8244 }
8245 /* No way... return an error. */
8246 if (flags & JIM_ERRMSG) {
8247 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8248 Jim_AppendStrings(interp, Jim_GetResult(interp),
8249 "Can't find package '", name, "'", NULL);
8250 }
8251 return NULL;
8252 } else {
8253 int actualVer;
8254 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8255 != JIM_OK)
8256 {
8257 return NULL;
8258 }
8259 /* Check if version matches. */
8260 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8261 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8262 Jim_AppendStrings(interp, Jim_GetResult(interp),
8263 "Package '", name, "' already loaded, but with version ",
8264 he->val, NULL);
8265 return NULL;
8266 }
8267 return he->val;
8268 }
8269 }
8270
8271 /* -----------------------------------------------------------------------------
8272 * Eval
8273 * ---------------------------------------------------------------------------*/
8274 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8275 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8276
8277 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8278 Jim_Obj *const *argv);
8279
8280 /* Handle calls to the [unknown] command */
8281 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8282 {
8283 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8284 int retCode;
8285
8286 /* If the [unknown] command does not exists returns
8287 * just now */
8288 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8289 return JIM_ERR;
8290
8291 /* The object interp->unknown just contains
8292 * the "unknown" string, it is used in order to
8293 * avoid to lookup the unknown command every time
8294 * but instread to cache the result. */
8295 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8296 v = sv;
8297 else
8298 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8299 /* Make a copy of the arguments vector, but shifted on
8300 * the right of one position. The command name of the
8301 * command will be instead the first argument of the
8302 * [unknonw] call. */
8303 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8304 v[0] = interp->unknown;
8305 /* Call it */
8306 retCode = Jim_EvalObjVector(interp, argc+1, v);
8307 /* Clean up */
8308 if (v != sv)
8309 Jim_Free(v);
8310 return retCode;
8311 }
8312
8313 /* Eval the object vector 'objv' composed of 'objc' elements.
8314 * Every element is used as single argument.
8315 * Jim_EvalObj() will call this function every time its object
8316 * argument is of "list" type, with no string representation.
8317 *
8318 * This is possible because the string representation of a
8319 * list object generated by the UpdateStringOfList is made
8320 * in a way that ensures that every list element is a different
8321 * command argument. */
8322 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8323 {
8324 int i, retcode;
8325 Jim_Cmd *cmdPtr;
8326
8327 /* Incr refcount of arguments. */
8328 for (i = 0; i < objc; i++)
8329 Jim_IncrRefCount(objv[i]);
8330 /* Command lookup */
8331 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8332 if (cmdPtr == NULL) {
8333 retcode = JimUnknown(interp, objc, objv);
8334 } else {
8335 /* Call it -- Make sure result is an empty object. */
8336 Jim_SetEmptyResult(interp);
8337 if (cmdPtr->cmdProc) {
8338 interp->cmdPrivData = cmdPtr->privData;
8339 retcode = cmdPtr->cmdProc(interp, objc, objv);
8340 } else {
8341 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8342 if (retcode == JIM_ERR) {
8343 JimAppendStackTrace(interp,
8344 Jim_GetString(objv[0], NULL), "?", 1);
8345 }
8346 }
8347 }
8348 /* Decr refcount of arguments and return the retcode */
8349 for (i = 0; i < objc; i++)
8350 Jim_DecrRefCount(interp, objv[i]);
8351 return retcode;
8352 }
8353
8354 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8355 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8356 * The returned object has refcount = 0. */
8357 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8358 int tokens, Jim_Obj **objPtrPtr)
8359 {
8360 int totlen = 0, i, retcode;
8361 Jim_Obj **intv;
8362 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8363 Jim_Obj *objPtr;
8364 char *s;
8365
8366 if (tokens <= JIM_EVAL_SINTV_LEN)
8367 intv = sintv;
8368 else
8369 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8370 tokens);
8371 /* Compute every token forming the argument
8372 * in the intv objects vector. */
8373 for (i = 0; i < tokens; i++) {
8374 switch(token[i].type) {
8375 case JIM_TT_ESC:
8376 case JIM_TT_STR:
8377 intv[i] = token[i].objPtr;
8378 break;
8379 case JIM_TT_VAR:
8380 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8381 if (!intv[i]) {
8382 retcode = JIM_ERR;
8383 goto err;
8384 }
8385 break;
8386 case JIM_TT_DICTSUGAR:
8387 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8388 if (!intv[i]) {
8389 retcode = JIM_ERR;
8390 goto err;
8391 }
8392 break;
8393 case JIM_TT_CMD:
8394 retcode = Jim_EvalObj(interp, token[i].objPtr);
8395 if (retcode != JIM_OK)
8396 goto err;
8397 intv[i] = Jim_GetResult(interp);
8398 break;
8399 default:
8400 Jim_Panic(interp,
8401 "default token type reached "
8402 "in Jim_InterpolateTokens().");
8403 break;
8404 }
8405 Jim_IncrRefCount(intv[i]);
8406 /* Make sure there is a valid
8407 * string rep, and add the string
8408 * length to the total legnth. */
8409 Jim_GetString(intv[i], NULL);
8410 totlen += intv[i]->length;
8411 }
8412 /* Concatenate every token in an unique
8413 * object. */
8414 objPtr = Jim_NewStringObjNoAlloc(interp,
8415 NULL, 0);
8416 s = objPtr->bytes = Jim_Alloc(totlen+1);
8417 objPtr->length = totlen;
8418 for (i = 0; i < tokens; i++) {
8419 memcpy(s, intv[i]->bytes, intv[i]->length);
8420 s += intv[i]->length;
8421 Jim_DecrRefCount(interp, intv[i]);
8422 }
8423 objPtr->bytes[totlen] = '\0';
8424 /* Free the intv vector if not static. */
8425 if (tokens > JIM_EVAL_SINTV_LEN)
8426 Jim_Free(intv);
8427 *objPtrPtr = objPtr;
8428 return JIM_OK;
8429 err:
8430 i--;
8431 for (; i >= 0; i--)
8432 Jim_DecrRefCount(interp, intv[i]);
8433 if (tokens > JIM_EVAL_SINTV_LEN)
8434 Jim_Free(intv);
8435 return retcode;
8436 }
8437
8438 /* Helper of Jim_EvalObj() to perform argument expansion.
8439 * Basically this function append an argument to 'argv'
8440 * (and increments argc by reference accordingly), performing
8441 * expansion of the list object if 'expand' is non-zero, or
8442 * just adding objPtr to argv if 'expand' is zero. */
8443 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8444 int *argcPtr, int expand, Jim_Obj *objPtr)
8445 {
8446 if (!expand) {
8447 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8448 /* refcount of objPtr not incremented because
8449 * we are actually transfering a reference from
8450 * the old 'argv' to the expanded one. */
8451 (*argv)[*argcPtr] = objPtr;
8452 (*argcPtr)++;
8453 } else {
8454 int len, i;
8455
8456 Jim_ListLength(interp, objPtr, &len);
8457 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8458 for (i = 0; i < len; i++) {
8459 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8460 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8461 (*argcPtr)++;
8462 }
8463 /* The original object reference is no longer needed,
8464 * after the expansion it is no longer present on
8465 * the argument vector, but the single elements are
8466 * in its place. */
8467 Jim_DecrRefCount(interp, objPtr);
8468 }
8469 }
8470
8471 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8472 {
8473 int i, j = 0, len;
8474 ScriptObj *script;
8475 ScriptToken *token;
8476 int *cs; /* command structure array */
8477 int retcode = JIM_OK;
8478 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8479
8480 interp->errorFlag = 0;
8481
8482 /* If the object is of type "list" and there is no
8483 * string representation for this object, we can call
8484 * a specialized version of Jim_EvalObj() */
8485 if (scriptObjPtr->typePtr == &listObjType &&
8486 scriptObjPtr->internalRep.listValue.len &&
8487 scriptObjPtr->bytes == NULL) {
8488 Jim_IncrRefCount(scriptObjPtr);
8489 retcode = Jim_EvalObjVector(interp,
8490 scriptObjPtr->internalRep.listValue.len,
8491 scriptObjPtr->internalRep.listValue.ele);
8492 Jim_DecrRefCount(interp, scriptObjPtr);
8493 return retcode;
8494 }
8495
8496 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8497 script = Jim_GetScript(interp, scriptObjPtr);
8498 /* Now we have to make sure the internal repr will not be
8499 * freed on shimmering.
8500 *
8501 * Think for example to this:
8502 *
8503 * set x {llength $x; ... some more code ...}; eval $x
8504 *
8505 * In order to preserve the internal rep, we increment the
8506 * inUse field of the script internal rep structure. */
8507 script->inUse++;
8508
8509 token = script->token;
8510 len = script->len;
8511 cs = script->cmdStruct;
8512 i = 0; /* 'i' is the current token index. */
8513
8514 /* Reset the interpreter result. This is useful to
8515 * return the emtpy result in the case of empty program. */
8516 Jim_SetEmptyResult(interp);
8517
8518 /* Execute every command sequentially, returns on
8519 * error (i.e. if a command does not return JIM_OK) */
8520 while (i < len) {
8521 int expand = 0;
8522 int argc = *cs++; /* Get the number of arguments */
8523 Jim_Cmd *cmd;
8524
8525 /* Set the expand flag if needed. */
8526 if (argc == -1) {
8527 expand++;
8528 argc = *cs++;
8529 }
8530 /* Allocate the arguments vector */
8531 if (argc <= JIM_EVAL_SARGV_LEN)
8532 argv = sargv;
8533 else
8534 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8535 /* Populate the arguments objects. */
8536 for (j = 0; j < argc; j++) {
8537 int tokens = *cs++;
8538
8539 /* tokens is negative if expansion is needed.
8540 * for this argument. */
8541 if (tokens < 0) {
8542 tokens = (-tokens)-1;
8543 i++;
8544 }
8545 if (tokens == 1) {
8546 /* Fast path if the token does not
8547 * need interpolation */
8548 switch(token[i].type) {
8549 case JIM_TT_ESC:
8550 case JIM_TT_STR:
8551 argv[j] = token[i].objPtr;
8552 break;
8553 case JIM_TT_VAR:
8554 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8555 JIM_ERRMSG);
8556 if (!tmpObjPtr) {
8557 retcode = JIM_ERR;
8558 goto err;
8559 }
8560 argv[j] = tmpObjPtr;
8561 break;
8562 case JIM_TT_DICTSUGAR:
8563 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8564 if (!tmpObjPtr) {
8565 retcode = JIM_ERR;
8566 goto err;
8567 }
8568 argv[j] = tmpObjPtr;
8569 break;
8570 case JIM_TT_CMD:
8571 retcode = Jim_EvalObj(interp, token[i].objPtr);
8572 if (retcode != JIM_OK)
8573 goto err;
8574 argv[j] = Jim_GetResult(interp);
8575 break;
8576 default:
8577 Jim_Panic(interp,
8578 "default token type reached "
8579 "in Jim_EvalObj().");
8580 break;
8581 }
8582 Jim_IncrRefCount(argv[j]);
8583 i += 2;
8584 } else {
8585 /* For interpolation we call an helper
8586 * function doing the work for us. */
8587 if ((retcode = Jim_InterpolateTokens(interp,
8588 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8589 {
8590 goto err;
8591 }
8592 argv[j] = tmpObjPtr;
8593 Jim_IncrRefCount(argv[j]);
8594 i += tokens+1;
8595 }
8596 }
8597 /* Handle {expand} expansion */
8598 if (expand) {
8599 int *ecs = cs - argc;
8600 int eargc = 0;
8601 Jim_Obj **eargv = NULL;
8602
8603 for (j = 0; j < argc; j++) {
8604 Jim_ExpandArgument( interp, &eargv, &eargc,
8605 ecs[j] < 0, argv[j]);
8606 }
8607 if (argv != sargv)
8608 Jim_Free(argv);
8609 argc = eargc;
8610 argv = eargv;
8611 j = argc;
8612 if (argc == 0) {
8613 /* Nothing to do with zero args. */
8614 Jim_Free(eargv);
8615 continue;
8616 }
8617 }
8618 /* Lookup the command to call */
8619 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8620 if (cmd != NULL) {
8621 /* Call it -- Make sure result is an empty object. */
8622 Jim_SetEmptyResult(interp);
8623 if (cmd->cmdProc) {
8624 interp->cmdPrivData = cmd->privData;
8625 retcode = cmd->cmdProc(interp, argc, argv);
8626 } else {
8627 retcode = JimCallProcedure(interp, cmd, argc, argv);
8628 if (retcode == JIM_ERR) {
8629 JimAppendStackTrace(interp,
8630 Jim_GetString(argv[0], NULL), script->fileName,
8631 token[i-argc*2].linenr);
8632 }
8633 }
8634 } else {
8635 /* Call [unknown] */
8636 retcode = JimUnknown(interp, argc, argv);
8637 if (retcode == JIM_ERR) {
8638 JimAppendStackTrace(interp,
8639 Jim_GetString(argv[0], NULL), script->fileName,
8640 token[i-argc*2].linenr);
8641 }
8642 }
8643 if (retcode != JIM_OK) {
8644 i -= argc*2; /* point to the command name. */
8645 goto err;
8646 }
8647 /* Decrement the arguments count */
8648 for (j = 0; j < argc; j++) {
8649 Jim_DecrRefCount(interp, argv[j]);
8650 }
8651
8652 if (argv != sargv) {
8653 Jim_Free(argv);
8654 argv = NULL;
8655 }
8656 }
8657 /* Note that we don't have to decrement inUse, because the
8658 * following code transfers our use of the reference again to
8659 * the script object. */
8660 j = 0; /* on normal termination, the argv array is already
8661 Jim_DecrRefCount-ed. */
8662 err:
8663 /* Handle errors. */
8664 if (retcode == JIM_ERR && !interp->errorFlag) {
8665 interp->errorFlag = 1;
8666 JimSetErrorFileName(interp, script->fileName);
8667 JimSetErrorLineNumber(interp, token[i].linenr);
8668 JimResetStackTrace(interp);
8669 }
8670 Jim_FreeIntRep(interp, scriptObjPtr);
8671 scriptObjPtr->typePtr = &scriptObjType;
8672 Jim_SetIntRepPtr(scriptObjPtr, script);
8673 Jim_DecrRefCount(interp, scriptObjPtr);
8674 for (i = 0; i < j; i++) {
8675 Jim_DecrRefCount(interp, argv[i]);
8676 }
8677 if (argv != sargv)
8678 Jim_Free(argv);
8679 return retcode;
8680 }
8681
8682 /* Call a procedure implemented in Tcl.
8683 * It's possible to speed-up a lot this function, currently
8684 * the callframes are not cached, but allocated and
8685 * destroied every time. What is expecially costly is
8686 * to create/destroy the local vars hash table every time.
8687 *
8688 * This can be fixed just implementing callframes caching
8689 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8690 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8691 Jim_Obj *const *argv)
8692 {
8693 int i, retcode;
8694 Jim_CallFrame *callFramePtr;
8695
8696 /* Check arity */
8697 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8698 argc > cmd->arityMax)) {
8699 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8700 Jim_AppendStrings(interp, objPtr,
8701 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8702 (cmd->arityMin > 1) ? " " : "",
8703 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8704 Jim_SetResult(interp, objPtr);
8705 return JIM_ERR;
8706 }
8707 /* Check if there are too nested calls */
8708 if (interp->numLevels == interp->maxNestingDepth) {
8709 Jim_SetResultString(interp,
8710 "Too many nested calls. Infinite recursion?", -1);
8711 return JIM_ERR;
8712 }
8713 /* Create a new callframe */
8714 callFramePtr = JimCreateCallFrame(interp);
8715 callFramePtr->parentCallFrame = interp->framePtr;
8716 callFramePtr->argv = argv;
8717 callFramePtr->argc = argc;
8718 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8719 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8720 callFramePtr->staticVars = cmd->staticVars;
8721 Jim_IncrRefCount(cmd->argListObjPtr);
8722 Jim_IncrRefCount(cmd->bodyObjPtr);
8723 interp->framePtr = callFramePtr;
8724 interp->numLevels ++;
8725 /* Set arguments */
8726 for (i = 0; i < cmd->arityMin-1; i++) {
8727 Jim_Obj *objPtr;
8728
8729 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8730 Jim_SetVariable(interp, objPtr, argv[i+1]);
8731 }
8732 if (cmd->arityMax == -1) {
8733 Jim_Obj *listObjPtr, *objPtr;
8734
8735 listObjPtr = Jim_NewListObj(interp, argv+cmd->arityMin,
8736 argc-cmd->arityMin);
8737 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8738 Jim_SetVariable(interp, objPtr, listObjPtr);
8739 }
8740 /* Eval the body */
8741 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8742
8743 /* Destroy the callframe */
8744 interp->numLevels --;
8745 interp->framePtr = interp->framePtr->parentCallFrame;
8746 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8747 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8748 } else {
8749 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8750 }
8751 /* Handle the JIM_EVAL return code */
8752 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8753 int savedLevel = interp->evalRetcodeLevel;
8754
8755 interp->evalRetcodeLevel = interp->numLevels;
8756 while (retcode == JIM_EVAL) {
8757 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8758 Jim_IncrRefCount(resultScriptObjPtr);
8759 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8760 Jim_DecrRefCount(interp, resultScriptObjPtr);
8761 }
8762 interp->evalRetcodeLevel = savedLevel;
8763 }
8764 /* Handle the JIM_RETURN return code */
8765 if (retcode == JIM_RETURN) {
8766 retcode = interp->returnCode;
8767 interp->returnCode = JIM_OK;
8768 }
8769 return retcode;
8770 }
8771
8772 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8773 {
8774 int retval;
8775 Jim_Obj *scriptObjPtr;
8776
8777 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8778 Jim_IncrRefCount(scriptObjPtr);
8779
8780
8781 if( filename ){
8782 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8783 }
8784
8785 retval = Jim_EvalObj(interp, scriptObjPtr);
8786 Jim_DecrRefCount(interp, scriptObjPtr);
8787 return retval;
8788 }
8789
8790 int Jim_Eval(Jim_Interp *interp, const char *script)
8791 {
8792 return Jim_Eval_Named( interp, script, NULL, 0 );
8793 }
8794
8795
8796
8797 /* Execute script in the scope of the global level */
8798 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8799 {
8800 Jim_CallFrame *savedFramePtr;
8801 int retval;
8802
8803 savedFramePtr = interp->framePtr;
8804 interp->framePtr = interp->topFramePtr;
8805 retval = Jim_Eval(interp, script);
8806 interp->framePtr = savedFramePtr;
8807 return retval;
8808 }
8809
8810 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8811 {
8812 Jim_CallFrame *savedFramePtr;
8813 int retval;
8814
8815 savedFramePtr = interp->framePtr;
8816 interp->framePtr = interp->topFramePtr;
8817 retval = Jim_EvalObj(interp, scriptObjPtr);
8818 interp->framePtr = savedFramePtr;
8819 /* Try to report the error (if any) via the bgerror proc */
8820 if (retval != JIM_OK) {
8821 Jim_Obj *objv[2];
8822
8823 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8824 objv[1] = Jim_GetResult(interp);
8825 Jim_IncrRefCount(objv[0]);
8826 Jim_IncrRefCount(objv[1]);
8827 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8828 /* Report the error to stderr. */
8829 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8830 Jim_PrintErrorMessage(interp);
8831 }
8832 Jim_DecrRefCount(interp, objv[0]);
8833 Jim_DecrRefCount(interp, objv[1]);
8834 }
8835 return retval;
8836 }
8837
8838 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8839 {
8840 char *prg = NULL;
8841 FILE *fp;
8842 int nread, totread, maxlen, buflen;
8843 int retval;
8844 Jim_Obj *scriptObjPtr;
8845
8846 if ((fp = fopen(filename, "r")) == NULL) {
8847 const int cwd_len=2048;
8848 char *cwd=malloc(cwd_len);
8849 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8850 getcwd( cwd, cwd_len );
8851 Jim_AppendStrings(interp, Jim_GetResult(interp),
8852 "Error loading script \"", filename, "\"",
8853 " cwd: ", cwd,
8854 " err: ", strerror(errno), NULL);
8855 free(cwd);
8856 return JIM_ERR;
8857 }
8858 buflen = 1024;
8859 maxlen = totread = 0;
8860 while (1) {
8861 if (maxlen < totread+buflen+1) {
8862 maxlen = totread+buflen+1;
8863 prg = Jim_Realloc(prg, maxlen);
8864 }
8865 /* do not use Jim_fread() - this is really a file */
8866 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8867 totread += nread;
8868 }
8869 prg[totread] = '\0';
8870 /* do not use Jim_fclose() - this is really a file */
8871 fclose(fp);
8872
8873 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8874 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8875 Jim_IncrRefCount(scriptObjPtr);
8876 retval = Jim_EvalObj(interp, scriptObjPtr);
8877 Jim_DecrRefCount(interp, scriptObjPtr);
8878 return retval;
8879 }
8880
8881 /* -----------------------------------------------------------------------------
8882 * Subst
8883 * ---------------------------------------------------------------------------*/
8884 static int JimParseSubstStr(struct JimParserCtx *pc)
8885 {
8886 pc->tstart = pc->p;
8887 pc->tline = pc->linenr;
8888 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8889 pc->p++; pc->len--;
8890 }
8891 pc->tend = pc->p-1;
8892 pc->tt = JIM_TT_ESC;
8893 return JIM_OK;
8894 }
8895
8896 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8897 {
8898 int retval;
8899
8900 if (pc->len == 0) {
8901 pc->tstart = pc->tend = pc->p;
8902 pc->tline = pc->linenr;
8903 pc->tt = JIM_TT_EOL;
8904 pc->eof = 1;
8905 return JIM_OK;
8906 }
8907 switch(*pc->p) {
8908 case '[':
8909 retval = JimParseCmd(pc);
8910 if (flags & JIM_SUBST_NOCMD) {
8911 pc->tstart--;
8912 pc->tend++;
8913 pc->tt = (flags & JIM_SUBST_NOESC) ?
8914 JIM_TT_STR : JIM_TT_ESC;
8915 }
8916 return retval;
8917 break;
8918 case '$':
8919 if (JimParseVar(pc) == JIM_ERR) {
8920 pc->tstart = pc->tend = pc->p++; pc->len--;
8921 pc->tline = pc->linenr;
8922 pc->tt = JIM_TT_STR;
8923 } else {
8924 if (flags & JIM_SUBST_NOVAR) {
8925 pc->tstart--;
8926 if (flags & JIM_SUBST_NOESC)
8927 pc->tt = JIM_TT_STR;
8928 else
8929 pc->tt = JIM_TT_ESC;
8930 if (*pc->tstart == '{') {
8931 pc->tstart--;
8932 if (*(pc->tend+1))
8933 pc->tend++;
8934 }
8935 }
8936 }
8937 break;
8938 default:
8939 retval = JimParseSubstStr(pc);
8940 if (flags & JIM_SUBST_NOESC)
8941 pc->tt = JIM_TT_STR;
8942 return retval;
8943 break;
8944 }
8945 return JIM_OK;
8946 }
8947
8948 /* The subst object type reuses most of the data structures and functions
8949 * of the script object. Script's data structures are a bit more complex
8950 * for what is needed for [subst]itution tasks, but the reuse helps to
8951 * deal with a single data structure at the cost of some more memory
8952 * usage for substitutions. */
8953 static Jim_ObjType substObjType = {
8954 "subst",
8955 FreeScriptInternalRep,
8956 DupScriptInternalRep,
8957 NULL,
8958 JIM_TYPE_REFERENCES,
8959 };
8960
8961 /* This method takes the string representation of an object
8962 * as a Tcl string where to perform [subst]itution, and generates
8963 * the pre-parsed internal representation. */
8964 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
8965 {
8966 int scriptTextLen;
8967 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
8968 struct JimParserCtx parser;
8969 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
8970
8971 script->len = 0;
8972 script->csLen = 0;
8973 script->commands = 0;
8974 script->token = NULL;
8975 script->cmdStruct = NULL;
8976 script->inUse = 1;
8977 script->substFlags = flags;
8978 script->fileName = NULL;
8979
8980 JimParserInit(&parser, scriptText, scriptTextLen, 1);
8981 while(1) {
8982 char *token;
8983 int len, type, linenr;
8984
8985 JimParseSubst(&parser, flags);
8986 if (JimParserEof(&parser)) break;
8987 token = JimParserGetToken(&parser, &len, &type, &linenr);
8988 ScriptObjAddToken(interp, script, token, len, type,
8989 NULL, linenr);
8990 }
8991 /* Free the old internal rep and set the new one. */
8992 Jim_FreeIntRep(interp, objPtr);
8993 Jim_SetIntRepPtr(objPtr, script);
8994 objPtr->typePtr = &scriptObjType;
8995 return JIM_OK;
8996 }
8997
8998 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
8999 {
9000 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9001
9002 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9003 SetSubstFromAny(interp, objPtr, flags);
9004 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9005 }
9006
9007 /* Performs commands,variables,blackslashes substitution,
9008 * storing the result object (with refcount 0) into
9009 * resObjPtrPtr. */
9010 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9011 Jim_Obj **resObjPtrPtr, int flags)
9012 {
9013 ScriptObj *script;
9014 ScriptToken *token;
9015 int i, len, retcode = JIM_OK;
9016 Jim_Obj *resObjPtr, *savedResultObjPtr;
9017
9018 script = Jim_GetSubst(interp, substObjPtr, flags);
9019 #ifdef JIM_OPTIMIZATION
9020 /* Fast path for a very common case with array-alike syntax,
9021 * that's: $foo($bar) */
9022 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9023 Jim_Obj *varObjPtr = script->token[0].objPtr;
9024
9025 Jim_IncrRefCount(varObjPtr);
9026 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9027 if (resObjPtr == NULL) {
9028 Jim_DecrRefCount(interp, varObjPtr);
9029 return JIM_ERR;
9030 }
9031 Jim_DecrRefCount(interp, varObjPtr);
9032 *resObjPtrPtr = resObjPtr;
9033 return JIM_OK;
9034 }
9035 #endif
9036
9037 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9038 /* In order to preserve the internal rep, we increment the
9039 * inUse field of the script internal rep structure. */
9040 script->inUse++;
9041
9042 token = script->token;
9043 len = script->len;
9044
9045 /* Save the interp old result, to set it again before
9046 * to return. */
9047 savedResultObjPtr = interp->result;
9048 Jim_IncrRefCount(savedResultObjPtr);
9049
9050 /* Perform the substitution. Starts with an empty object
9051 * and adds every token (performing the appropriate
9052 * var/command/escape substitution). */
9053 resObjPtr = Jim_NewStringObj(interp, "", 0);
9054 for (i = 0; i < len; i++) {
9055 Jim_Obj *objPtr;
9056
9057 switch(token[i].type) {
9058 case JIM_TT_STR:
9059 case JIM_TT_ESC:
9060 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9061 break;
9062 case JIM_TT_VAR:
9063 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9064 if (objPtr == NULL) goto err;
9065 Jim_IncrRefCount(objPtr);
9066 Jim_AppendObj(interp, resObjPtr, objPtr);
9067 Jim_DecrRefCount(interp, objPtr);
9068 break;
9069 case JIM_TT_DICTSUGAR:
9070 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9071 if (!objPtr) {
9072 retcode = JIM_ERR;
9073 goto err;
9074 }
9075 break;
9076 case JIM_TT_CMD:
9077 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9078 goto err;
9079 Jim_AppendObj(interp, resObjPtr, interp->result);
9080 break;
9081 default:
9082 Jim_Panic(interp,
9083 "default token type (%d) reached "
9084 "in Jim_SubstObj().", token[i].type);
9085 break;
9086 }
9087 }
9088 ok:
9089 if (retcode == JIM_OK)
9090 Jim_SetResult(interp, savedResultObjPtr);
9091 Jim_DecrRefCount(interp, savedResultObjPtr);
9092 /* Note that we don't have to decrement inUse, because the
9093 * following code transfers our use of the reference again to
9094 * the script object. */
9095 Jim_FreeIntRep(interp, substObjPtr);
9096 substObjPtr->typePtr = &scriptObjType;
9097 Jim_SetIntRepPtr(substObjPtr, script);
9098 Jim_DecrRefCount(interp, substObjPtr);
9099 *resObjPtrPtr = resObjPtr;
9100 return retcode;
9101 err:
9102 Jim_FreeNewObj(interp, resObjPtr);
9103 retcode = JIM_ERR;
9104 goto ok;
9105 }
9106
9107 /* -----------------------------------------------------------------------------
9108 * API Input/Export functions
9109 * ---------------------------------------------------------------------------*/
9110
9111 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9112 {
9113 Jim_HashEntry *he;
9114
9115 he = Jim_FindHashEntry(&interp->stub, funcname);
9116 if (!he)
9117 return JIM_ERR;
9118 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9119 return JIM_OK;
9120 }
9121
9122 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9123 {
9124 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9125 }
9126
9127 #define JIM_REGISTER_API(name) \
9128 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9129
9130 void JimRegisterCoreApi(Jim_Interp *interp)
9131 {
9132 interp->getApiFuncPtr = Jim_GetApi;
9133 JIM_REGISTER_API(Alloc);
9134 JIM_REGISTER_API(Free);
9135 JIM_REGISTER_API(Eval);
9136 JIM_REGISTER_API(Eval_Named);
9137 JIM_REGISTER_API(EvalGlobal);
9138 JIM_REGISTER_API(EvalFile);
9139 JIM_REGISTER_API(EvalObj);
9140 JIM_REGISTER_API(EvalObjBackground);
9141 JIM_REGISTER_API(EvalObjVector);
9142 JIM_REGISTER_API(InitHashTable);
9143 JIM_REGISTER_API(ExpandHashTable);
9144 JIM_REGISTER_API(AddHashEntry);
9145 JIM_REGISTER_API(ReplaceHashEntry);
9146 JIM_REGISTER_API(DeleteHashEntry);
9147 JIM_REGISTER_API(FreeHashTable);
9148 JIM_REGISTER_API(FindHashEntry);
9149 JIM_REGISTER_API(ResizeHashTable);
9150 JIM_REGISTER_API(GetHashTableIterator);
9151 JIM_REGISTER_API(NextHashEntry);
9152 JIM_REGISTER_API(NewObj);
9153 JIM_REGISTER_API(FreeObj);
9154 JIM_REGISTER_API(InvalidateStringRep);
9155 JIM_REGISTER_API(InitStringRep);
9156 JIM_REGISTER_API(DuplicateObj);
9157 JIM_REGISTER_API(GetString);
9158 JIM_REGISTER_API(Length);
9159 JIM_REGISTER_API(InvalidateStringRep);
9160 JIM_REGISTER_API(NewStringObj);
9161 JIM_REGISTER_API(NewStringObjNoAlloc);
9162 JIM_REGISTER_API(AppendString);
9163 JIM_REGISTER_API(AppendString_sprintf);
9164 JIM_REGISTER_API(AppendObj);
9165 JIM_REGISTER_API(AppendStrings);
9166 JIM_REGISTER_API(StringEqObj);
9167 JIM_REGISTER_API(StringMatchObj);
9168 JIM_REGISTER_API(StringRangeObj);
9169 JIM_REGISTER_API(FormatString);
9170 JIM_REGISTER_API(CompareStringImmediate);
9171 JIM_REGISTER_API(NewReference);
9172 JIM_REGISTER_API(GetReference);
9173 JIM_REGISTER_API(SetFinalizer);
9174 JIM_REGISTER_API(GetFinalizer);
9175 JIM_REGISTER_API(CreateInterp);
9176 JIM_REGISTER_API(FreeInterp);
9177 JIM_REGISTER_API(GetExitCode);
9178 JIM_REGISTER_API(SetStdin);
9179 JIM_REGISTER_API(SetStdout);
9180 JIM_REGISTER_API(SetStderr);
9181 JIM_REGISTER_API(CreateCommand);
9182 JIM_REGISTER_API(CreateProcedure);
9183 JIM_REGISTER_API(DeleteCommand);
9184 JIM_REGISTER_API(RenameCommand);
9185 JIM_REGISTER_API(GetCommand);
9186 JIM_REGISTER_API(SetVariable);
9187 JIM_REGISTER_API(SetVariableStr);
9188 JIM_REGISTER_API(SetGlobalVariableStr);
9189 JIM_REGISTER_API(SetVariableStrWithStr);
9190 JIM_REGISTER_API(SetVariableLink);
9191 JIM_REGISTER_API(GetVariable);
9192 JIM_REGISTER_API(GetCallFrameByLevel);
9193 JIM_REGISTER_API(Collect);
9194 JIM_REGISTER_API(CollectIfNeeded);
9195 JIM_REGISTER_API(GetIndex);
9196 JIM_REGISTER_API(NewListObj);
9197 JIM_REGISTER_API(ListAppendElement);
9198 JIM_REGISTER_API(ListAppendList);
9199 JIM_REGISTER_API(ListLength);
9200 JIM_REGISTER_API(ListIndex);
9201 JIM_REGISTER_API(SetListIndex);
9202 JIM_REGISTER_API(ConcatObj);
9203 JIM_REGISTER_API(NewDictObj);
9204 JIM_REGISTER_API(DictKey);
9205 JIM_REGISTER_API(DictKeysVector);
9206 JIM_REGISTER_API(GetIndex);
9207 JIM_REGISTER_API(GetReturnCode);
9208 JIM_REGISTER_API(EvalExpression);
9209 JIM_REGISTER_API(GetBoolFromExpr);
9210 JIM_REGISTER_API(GetWide);
9211 JIM_REGISTER_API(GetLong);
9212 JIM_REGISTER_API(SetWide);
9213 JIM_REGISTER_API(NewIntObj);
9214 JIM_REGISTER_API(GetDouble);
9215 JIM_REGISTER_API(SetDouble);
9216 JIM_REGISTER_API(NewDoubleObj);
9217 JIM_REGISTER_API(WrongNumArgs);
9218 JIM_REGISTER_API(SetDictKeysVector);
9219 JIM_REGISTER_API(SubstObj);
9220 JIM_REGISTER_API(RegisterApi);
9221 JIM_REGISTER_API(PrintErrorMessage);
9222 JIM_REGISTER_API(InteractivePrompt);
9223 JIM_REGISTER_API(RegisterCoreCommands);
9224 JIM_REGISTER_API(GetSharedString);
9225 JIM_REGISTER_API(ReleaseSharedString);
9226 JIM_REGISTER_API(Panic);
9227 JIM_REGISTER_API(StrDup);
9228 JIM_REGISTER_API(UnsetVariable);
9229 JIM_REGISTER_API(GetVariableStr);
9230 JIM_REGISTER_API(GetGlobalVariable);
9231 JIM_REGISTER_API(GetGlobalVariableStr);
9232 JIM_REGISTER_API(GetAssocData);
9233 JIM_REGISTER_API(SetAssocData);
9234 JIM_REGISTER_API(DeleteAssocData);
9235 JIM_REGISTER_API(GetEnum);
9236 JIM_REGISTER_API(ScriptIsComplete);
9237 JIM_REGISTER_API(PackageRequire);
9238 JIM_REGISTER_API(PackageProvide);
9239 JIM_REGISTER_API(InitStack);
9240 JIM_REGISTER_API(FreeStack);
9241 JIM_REGISTER_API(StackLen);
9242 JIM_REGISTER_API(StackPush);
9243 JIM_REGISTER_API(StackPop);
9244 JIM_REGISTER_API(StackPeek);
9245 JIM_REGISTER_API(FreeStackElements);
9246 JIM_REGISTER_API(fprintf );
9247 JIM_REGISTER_API(vfprintf );
9248 JIM_REGISTER_API(fwrite );
9249 JIM_REGISTER_API(fread );
9250 JIM_REGISTER_API(fflush );
9251 JIM_REGISTER_API(fgets );
9252 JIM_REGISTER_API(GetNvp);
9253 JIM_REGISTER_API(Nvp_name2value);
9254 JIM_REGISTER_API(Nvp_name2value_simple);
9255 JIM_REGISTER_API(Nvp_name2value_obj);
9256 JIM_REGISTER_API(Nvp_name2value_nocase);
9257 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9258
9259 JIM_REGISTER_API(Nvp_value2name);
9260 JIM_REGISTER_API(Nvp_value2name_simple);
9261 JIM_REGISTER_API(Nvp_value2name_obj);
9262
9263 JIM_REGISTER_API(GetOpt_Setup);
9264 JIM_REGISTER_API(GetOpt_Debug);
9265 JIM_REGISTER_API(GetOpt_Obj);
9266 JIM_REGISTER_API(GetOpt_String);
9267 JIM_REGISTER_API(GetOpt_Double);
9268 JIM_REGISTER_API(GetOpt_Wide);
9269 JIM_REGISTER_API(GetOpt_Nvp);
9270 JIM_REGISTER_API(GetOpt_NvpUnknown);
9271 JIM_REGISTER_API(GetOpt_Enum);
9272
9273 JIM_REGISTER_API(Debug_ArgvString);
9274 JIM_REGISTER_API(SetResult_sprintf);
9275 JIM_REGISTER_API(SetResult_NvpUnknown);
9276
9277 }
9278
9279 /* -----------------------------------------------------------------------------
9280 * Core commands utility functions
9281 * ---------------------------------------------------------------------------*/
9282 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9283 const char *msg)
9284 {
9285 int i;
9286 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9287
9288 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9289 for (i = 0; i < argc; i++) {
9290 Jim_AppendObj(interp, objPtr, argv[i]);
9291 if (!(i+1 == argc && msg[0] == '\0'))
9292 Jim_AppendString(interp, objPtr, " ", 1);
9293 }
9294 Jim_AppendString(interp, objPtr, msg, -1);
9295 Jim_AppendString(interp, objPtr, "\"", 1);
9296 Jim_SetResult(interp, objPtr);
9297 }
9298
9299 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9300 {
9301 Jim_HashTableIterator *htiter;
9302 Jim_HashEntry *he;
9303 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9304 const char *pattern;
9305 int patternLen;
9306
9307 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9308 htiter = Jim_GetHashTableIterator(&interp->commands);
9309 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9310 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9311 strlen((const char*)he->key), 0))
9312 continue;
9313 Jim_ListAppendElement(interp, listObjPtr,
9314 Jim_NewStringObj(interp, he->key, -1));
9315 }
9316 Jim_FreeHashTableIterator(htiter);
9317 return listObjPtr;
9318 }
9319
9320 #define JIM_VARLIST_GLOBALS 0
9321 #define JIM_VARLIST_LOCALS 1
9322 #define JIM_VARLIST_VARS 2
9323
9324 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9325 int mode)
9326 {
9327 Jim_HashTableIterator *htiter;
9328 Jim_HashEntry *he;
9329 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9330 const char *pattern;
9331 int patternLen;
9332
9333 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9334 if (mode == JIM_VARLIST_GLOBALS) {
9335 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9336 } else {
9337 /* For [info locals], if we are at top level an emtpy list
9338 * is returned. I don't agree, but we aim at compatibility (SS) */
9339 if (mode == JIM_VARLIST_LOCALS &&
9340 interp->framePtr == interp->topFramePtr)
9341 return listObjPtr;
9342 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9343 }
9344 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9345 Jim_Var *varPtr = (Jim_Var*) he->val;
9346 if (mode == JIM_VARLIST_LOCALS) {
9347 if (varPtr->linkFramePtr != NULL)
9348 continue;
9349 }
9350 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9351 strlen((const char*)he->key), 0))
9352 continue;
9353 Jim_ListAppendElement(interp, listObjPtr,
9354 Jim_NewStringObj(interp, he->key, -1));
9355 }
9356 Jim_FreeHashTableIterator(htiter);
9357 return listObjPtr;
9358 }
9359
9360 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9361 Jim_Obj **objPtrPtr)
9362 {
9363 Jim_CallFrame *targetCallFrame;
9364
9365 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9366 != JIM_OK)
9367 return JIM_ERR;
9368 /* No proc call at toplevel callframe */
9369 if (targetCallFrame == interp->topFramePtr) {
9370 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9371 Jim_AppendStrings(interp, Jim_GetResult(interp),
9372 "bad level \"",
9373 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9374 return JIM_ERR;
9375 }
9376 *objPtrPtr = Jim_NewListObj(interp,
9377 targetCallFrame->argv,
9378 targetCallFrame->argc);
9379 return JIM_OK;
9380 }
9381
9382 /* -----------------------------------------------------------------------------
9383 * Core commands
9384 * ---------------------------------------------------------------------------*/
9385
9386 /* fake [puts] -- not the real puts, just for debugging. */
9387 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9388 Jim_Obj *const *argv)
9389 {
9390 const char *str;
9391 int len, nonewline = 0;
9392
9393 if (argc != 2 && argc != 3) {
9394 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9395 return JIM_ERR;
9396 }
9397 if (argc == 3) {
9398 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9399 {
9400 Jim_SetResultString(interp, "The second argument must "
9401 "be -nonewline", -1);
9402 return JIM_OK;
9403 } else {
9404 nonewline = 1;
9405 argv++;
9406 }
9407 }
9408 str = Jim_GetString(argv[1], &len);
9409 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9410 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9411 return JIM_OK;
9412 }
9413
9414 /* Helper for [+] and [*] */
9415 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9416 Jim_Obj *const *argv, int op)
9417 {
9418 jim_wide wideValue, res;
9419 double doubleValue, doubleRes;
9420 int i;
9421
9422 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9423
9424 for (i = 1; i < argc; i++) {
9425 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9426 goto trydouble;
9427 if (op == JIM_EXPROP_ADD)
9428 res += wideValue;
9429 else
9430 res *= wideValue;
9431 }
9432 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9433 return JIM_OK;
9434 trydouble:
9435 doubleRes = (double) res;
9436 for (;i < argc; i++) {
9437 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9438 return JIM_ERR;
9439 if (op == JIM_EXPROP_ADD)
9440 doubleRes += doubleValue;
9441 else
9442 doubleRes *= doubleValue;
9443 }
9444 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9445 return JIM_OK;
9446 }
9447
9448 /* Helper for [-] and [/] */
9449 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9450 Jim_Obj *const *argv, int op)
9451 {
9452 jim_wide wideValue, res = 0;
9453 double doubleValue, doubleRes = 0;
9454 int i = 2;
9455
9456 if (argc < 2) {
9457 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9458 return JIM_ERR;
9459 } else if (argc == 2) {
9460 /* The arity = 2 case is different. For [- x] returns -x,
9461 * while [/ x] returns 1/x. */
9462 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9463 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9464 JIM_OK)
9465 {
9466 return JIM_ERR;
9467 } else {
9468 if (op == JIM_EXPROP_SUB)
9469 doubleRes = -doubleValue;
9470 else
9471 doubleRes = 1.0/doubleValue;
9472 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9473 doubleRes));
9474 return JIM_OK;
9475 }
9476 }
9477 if (op == JIM_EXPROP_SUB) {
9478 res = -wideValue;
9479 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9480 } else {
9481 doubleRes = 1.0/wideValue;
9482 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9483 doubleRes));
9484 }
9485 return JIM_OK;
9486 } else {
9487 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9488 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9489 != JIM_OK) {
9490 return JIM_ERR;
9491 } else {
9492 goto trydouble;
9493 }
9494 }
9495 }
9496 for (i = 2; i < argc; i++) {
9497 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9498 doubleRes = (double) res;
9499 goto trydouble;
9500 }
9501 if (op == JIM_EXPROP_SUB)
9502 res -= wideValue;
9503 else
9504 res /= wideValue;
9505 }
9506 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9507 return JIM_OK;
9508 trydouble:
9509 for (;i < argc; i++) {
9510 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9511 return JIM_ERR;
9512 if (op == JIM_EXPROP_SUB)
9513 doubleRes -= doubleValue;
9514 else
9515 doubleRes /= doubleValue;
9516 }
9517 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9518 return JIM_OK;
9519 }
9520
9521
9522 /* [+] */
9523 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9524 Jim_Obj *const *argv)
9525 {
9526 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9527 }
9528
9529 /* [*] */
9530 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9531 Jim_Obj *const *argv)
9532 {
9533 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9534 }
9535
9536 /* [-] */
9537 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9538 Jim_Obj *const *argv)
9539 {
9540 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9541 }
9542
9543 /* [/] */
9544 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9545 Jim_Obj *const *argv)
9546 {
9547 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9548 }
9549
9550 /* [set] */
9551 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9552 Jim_Obj *const *argv)
9553 {
9554 if (argc != 2 && argc != 3) {
9555 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9556 return JIM_ERR;
9557 }
9558 if (argc == 2) {
9559 Jim_Obj *objPtr;
9560 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9561 if (!objPtr)
9562 return JIM_ERR;
9563 Jim_SetResult(interp, objPtr);
9564 return JIM_OK;
9565 }
9566 /* argc == 3 case. */
9567 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9568 return JIM_ERR;
9569 Jim_SetResult(interp, argv[2]);
9570 return JIM_OK;
9571 }
9572
9573 /* [unset] */
9574 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9575 Jim_Obj *const *argv)
9576 {
9577 int i;
9578
9579 if (argc < 2) {
9580 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9581 return JIM_ERR;
9582 }
9583 for (i = 1; i < argc; i++) {
9584 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9585 return JIM_ERR;
9586 }
9587 return JIM_OK;
9588 }
9589
9590 /* [incr] */
9591 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9592 Jim_Obj *const *argv)
9593 {
9594 jim_wide wideValue, increment = 1;
9595 Jim_Obj *intObjPtr;
9596
9597 if (argc != 2 && argc != 3) {
9598 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9599 return JIM_ERR;
9600 }
9601 if (argc == 3) {
9602 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9603 return JIM_ERR;
9604 }
9605 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9606 if (!intObjPtr) return JIM_ERR;
9607 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9608 return JIM_ERR;
9609 if (Jim_IsShared(intObjPtr)) {
9610 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9611 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9612 Jim_FreeNewObj(interp, intObjPtr);
9613 return JIM_ERR;
9614 }
9615 } else {
9616 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9617 /* The following step is required in order to invalidate the
9618 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9619 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9620 return JIM_ERR;
9621 }
9622 }
9623 Jim_SetResult(interp, intObjPtr);
9624 return JIM_OK;
9625 }
9626
9627 /* [while] */
9628 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9629 Jim_Obj *const *argv)
9630 {
9631 if (argc != 3) {
9632 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9633 return JIM_ERR;
9634 }
9635 /* Try to run a specialized version of while if the expression
9636 * is in one of the following forms:
9637 *
9638 * $a < CONST, $a < $b
9639 * $a <= CONST, $a <= $b
9640 * $a > CONST, $a > $b
9641 * $a >= CONST, $a >= $b
9642 * $a != CONST, $a != $b
9643 * $a == CONST, $a == $b
9644 * $a
9645 * !$a
9646 * CONST
9647 */
9648
9649 #ifdef JIM_OPTIMIZATION
9650 {
9651 ExprByteCode *expr;
9652 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9653 int exprLen, retval;
9654
9655 /* STEP 1 -- Check if there are the conditions to run the specialized
9656 * version of while */
9657
9658 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9659 if (expr->len <= 0 || expr->len > 3) goto noopt;
9660 switch(expr->len) {
9661 case 1:
9662 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9663 expr->opcode[0] != JIM_EXPROP_NUMBER)
9664 goto noopt;
9665 break;
9666 case 2:
9667 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9668 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9669 goto noopt;
9670 break;
9671 case 3:
9672 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9673 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9674 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9675 goto noopt;
9676 switch(expr->opcode[2]) {
9677 case JIM_EXPROP_LT:
9678 case JIM_EXPROP_LTE:
9679 case JIM_EXPROP_GT:
9680 case JIM_EXPROP_GTE:
9681 case JIM_EXPROP_NUMEQ:
9682 case JIM_EXPROP_NUMNE:
9683 /* nothing to do */
9684 break;
9685 default:
9686 goto noopt;
9687 }
9688 break;
9689 default:
9690 Jim_Panic(interp,
9691 "Unexpected default reached in Jim_WhileCoreCommand()");
9692 break;
9693 }
9694
9695 /* STEP 2 -- conditions meet. Initialization. Take different
9696 * branches for different expression lengths. */
9697 exprLen = expr->len;
9698
9699 if (exprLen == 1) {
9700 jim_wide wideValue;
9701
9702 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9703 varAObjPtr = expr->obj[0];
9704 Jim_IncrRefCount(varAObjPtr);
9705 } else {
9706 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9707 goto noopt;
9708 }
9709 while (1) {
9710 if (varAObjPtr) {
9711 if (!(objPtr =
9712 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9713 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9714 {
9715 Jim_DecrRefCount(interp, varAObjPtr);
9716 goto noopt;
9717 }
9718 }
9719 if (!wideValue) break;
9720 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9721 switch(retval) {
9722 case JIM_BREAK:
9723 if (varAObjPtr)
9724 Jim_DecrRefCount(interp, varAObjPtr);
9725 goto out;
9726 break;
9727 case JIM_CONTINUE:
9728 continue;
9729 break;
9730 default:
9731 if (varAObjPtr)
9732 Jim_DecrRefCount(interp, varAObjPtr);
9733 return retval;
9734 }
9735 }
9736 }
9737 if (varAObjPtr)
9738 Jim_DecrRefCount(interp, varAObjPtr);
9739 } else if (exprLen == 3) {
9740 jim_wide wideValueA, wideValueB, cmpRes = 0;
9741 int cmpType = expr->opcode[2];
9742
9743 varAObjPtr = expr->obj[0];
9744 Jim_IncrRefCount(varAObjPtr);
9745 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9746 varBObjPtr = expr->obj[1];
9747 Jim_IncrRefCount(varBObjPtr);
9748 } else {
9749 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9750 goto noopt;
9751 }
9752 while (1) {
9753 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9754 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9755 {
9756 Jim_DecrRefCount(interp, varAObjPtr);
9757 if (varBObjPtr)
9758 Jim_DecrRefCount(interp, varBObjPtr);
9759 goto noopt;
9760 }
9761 if (varBObjPtr) {
9762 if (!(objPtr =
9763 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9764 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9765 {
9766 Jim_DecrRefCount(interp, varAObjPtr);
9767 if (varBObjPtr)
9768 Jim_DecrRefCount(interp, varBObjPtr);
9769 goto noopt;
9770 }
9771 }
9772 switch(cmpType) {
9773 case JIM_EXPROP_LT:
9774 cmpRes = wideValueA < wideValueB; break;
9775 case JIM_EXPROP_LTE:
9776 cmpRes = wideValueA <= wideValueB; break;
9777 case JIM_EXPROP_GT:
9778 cmpRes = wideValueA > wideValueB; break;
9779 case JIM_EXPROP_GTE:
9780 cmpRes = wideValueA >= wideValueB; break;
9781 case JIM_EXPROP_NUMEQ:
9782 cmpRes = wideValueA == wideValueB; break;
9783 case JIM_EXPROP_NUMNE:
9784 cmpRes = wideValueA != wideValueB; break;
9785 }
9786 if (!cmpRes) break;
9787 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9788 switch(retval) {
9789 case JIM_BREAK:
9790 Jim_DecrRefCount(interp, varAObjPtr);
9791 if (varBObjPtr)
9792 Jim_DecrRefCount(interp, varBObjPtr);
9793 goto out;
9794 break;
9795 case JIM_CONTINUE:
9796 continue;
9797 break;
9798 default:
9799 Jim_DecrRefCount(interp, varAObjPtr);
9800 if (varBObjPtr)
9801 Jim_DecrRefCount(interp, varBObjPtr);
9802 return retval;
9803 }
9804 }
9805 }
9806 Jim_DecrRefCount(interp, varAObjPtr);
9807 if (varBObjPtr)
9808 Jim_DecrRefCount(interp, varBObjPtr);
9809 } else {
9810 /* TODO: case for len == 2 */
9811 goto noopt;
9812 }
9813 Jim_SetEmptyResult(interp);
9814 return JIM_OK;
9815 }
9816 noopt:
9817 #endif
9818
9819 /* The general purpose implementation of while starts here */
9820 while (1) {
9821 int boolean, retval;
9822
9823 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9824 &boolean)) != JIM_OK)
9825 return retval;
9826 if (!boolean) break;
9827 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9828 switch(retval) {
9829 case JIM_BREAK:
9830 goto out;
9831 break;
9832 case JIM_CONTINUE:
9833 continue;
9834 break;
9835 default:
9836 return retval;
9837 }
9838 }
9839 }
9840 out:
9841 Jim_SetEmptyResult(interp);
9842 return JIM_OK;
9843 }
9844
9845 /* [for] */
9846 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9847 Jim_Obj *const *argv)
9848 {
9849 int retval;
9850
9851 if (argc != 5) {
9852 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9853 return JIM_ERR;
9854 }
9855 /* Check if the for is on the form:
9856 * for {set i CONST} {$i < CONST} {incr i}
9857 * for {set i CONST} {$i < $j} {incr i}
9858 * for {set i CONST} {$i <= CONST} {incr i}
9859 * for {set i CONST} {$i <= $j} {incr i}
9860 * XXX: NOTE: if variable traces are implemented, this optimization
9861 * need to be modified to check for the proc epoch at every variable
9862 * update. */
9863 #ifdef JIM_OPTIMIZATION
9864 {
9865 ScriptObj *initScript, *incrScript;
9866 ExprByteCode *expr;
9867 jim_wide start, stop, currentVal;
9868 unsigned jim_wide procEpoch = interp->procEpoch;
9869 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9870 int cmpType;
9871 struct Jim_Cmd *cmdPtr;
9872
9873 /* Do it only if there aren't shared arguments */
9874 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9875 goto evalstart;
9876 initScript = Jim_GetScript(interp, argv[1]);
9877 expr = Jim_GetExpression(interp, argv[2]);
9878 incrScript = Jim_GetScript(interp, argv[3]);
9879
9880 /* Ensure proper lengths to start */
9881 if (initScript->len != 6) goto evalstart;
9882 if (incrScript->len != 4) goto evalstart;
9883 if (expr->len != 3) goto evalstart;
9884 /* Ensure proper token types. */
9885 if (initScript->token[2].type != JIM_TT_ESC ||
9886 initScript->token[4].type != JIM_TT_ESC ||
9887 incrScript->token[2].type != JIM_TT_ESC ||
9888 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9889 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9890 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9891 (expr->opcode[2] != JIM_EXPROP_LT &&
9892 expr->opcode[2] != JIM_EXPROP_LTE))
9893 goto evalstart;
9894 cmpType = expr->opcode[2];
9895 /* Initialization command must be [set] */
9896 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9897 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
9898 goto evalstart;
9899 /* Update command must be incr */
9900 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
9901 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
9902 goto evalstart;
9903 /* set, incr, expression must be about the same variable */
9904 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9905 incrScript->token[2].objPtr, 0))
9906 goto evalstart;
9907 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9908 expr->obj[0], 0))
9909 goto evalstart;
9910 /* Check that the initialization and comparison are valid integers */
9911 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
9912 goto evalstart;
9913 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
9914 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
9915 {
9916 goto evalstart;
9917 }
9918
9919 /* Initialization */
9920 varNamePtr = expr->obj[0];
9921 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9922 stopVarNamePtr = expr->obj[1];
9923 Jim_IncrRefCount(stopVarNamePtr);
9924 }
9925 Jim_IncrRefCount(varNamePtr);
9926
9927 /* --- OPTIMIZED FOR --- */
9928 /* Start to loop */
9929 objPtr = Jim_NewIntObj(interp, start);
9930 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
9931 Jim_DecrRefCount(interp, varNamePtr);
9932 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9933 Jim_FreeNewObj(interp, objPtr);
9934 goto evalstart;
9935 }
9936 while (1) {
9937 /* === Check condition === */
9938 /* Common code: */
9939 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
9940 if (objPtr == NULL ||
9941 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
9942 {
9943 Jim_DecrRefCount(interp, varNamePtr);
9944 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9945 goto testcond;
9946 }
9947 /* Immediate or Variable? get the 'stop' value if the latter. */
9948 if (stopVarNamePtr) {
9949 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
9950 if (objPtr == NULL ||
9951 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
9952 {
9953 Jim_DecrRefCount(interp, varNamePtr);
9954 Jim_DecrRefCount(interp, stopVarNamePtr);
9955 goto testcond;
9956 }
9957 }
9958 if (cmpType == JIM_EXPROP_LT) {
9959 if (currentVal >= stop) break;
9960 } else {
9961 if (currentVal > stop) break;
9962 }
9963 /* Eval body */
9964 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9965 switch(retval) {
9966 case JIM_BREAK:
9967 if (stopVarNamePtr)
9968 Jim_DecrRefCount(interp, stopVarNamePtr);
9969 Jim_DecrRefCount(interp, varNamePtr);
9970 goto out;
9971 case JIM_CONTINUE:
9972 /* nothing to do */
9973 break;
9974 default:
9975 if (stopVarNamePtr)
9976 Jim_DecrRefCount(interp, stopVarNamePtr);
9977 Jim_DecrRefCount(interp, varNamePtr);
9978 return retval;
9979 }
9980 }
9981 /* If there was a change in procedures/command continue
9982 * with the usual [for] command implementation */
9983 if (procEpoch != interp->procEpoch) {
9984 if (stopVarNamePtr)
9985 Jim_DecrRefCount(interp, stopVarNamePtr);
9986 Jim_DecrRefCount(interp, varNamePtr);
9987 goto evalnext;
9988 }
9989 /* Increment */
9990 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
9991 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
9992 objPtr->internalRep.wideValue ++;
9993 Jim_InvalidateStringRep(objPtr);
9994 } else {
9995 Jim_Obj *auxObjPtr;
9996
9997 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
9998 if (stopVarNamePtr)
9999 Jim_DecrRefCount(interp, stopVarNamePtr);
10000 Jim_DecrRefCount(interp, varNamePtr);
10001 goto evalnext;
10002 }
10003 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10004 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10005 if (stopVarNamePtr)
10006 Jim_DecrRefCount(interp, stopVarNamePtr);
10007 Jim_DecrRefCount(interp, varNamePtr);
10008 Jim_FreeNewObj(interp, auxObjPtr);
10009 goto evalnext;
10010 }
10011 }
10012 }
10013 if (stopVarNamePtr)
10014 Jim_DecrRefCount(interp, stopVarNamePtr);
10015 Jim_DecrRefCount(interp, varNamePtr);
10016 Jim_SetEmptyResult(interp);
10017 return JIM_OK;
10018 }
10019 #endif
10020 evalstart:
10021 /* Eval start */
10022 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10023 return retval;
10024 while (1) {
10025 int boolean;
10026 testcond:
10027 /* Test the condition */
10028 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10029 != JIM_OK)
10030 return retval;
10031 if (!boolean) break;
10032 /* Eval body */
10033 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10034 switch(retval) {
10035 case JIM_BREAK:
10036 goto out;
10037 break;
10038 case JIM_CONTINUE:
10039 /* Nothing to do */
10040 break;
10041 default:
10042 return retval;
10043 }
10044 }
10045 evalnext:
10046 /* Eval next */
10047 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10048 switch(retval) {
10049 case JIM_BREAK:
10050 goto out;
10051 break;
10052 case JIM_CONTINUE:
10053 continue;
10054 break;
10055 default:
10056 return retval;
10057 }
10058 }
10059 }
10060 out:
10061 Jim_SetEmptyResult(interp);
10062 return JIM_OK;
10063 }
10064
10065 /* foreach + lmap implementation. */
10066 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10067 Jim_Obj *const *argv, int doMap)
10068 {
10069 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10070 int nbrOfLoops = 0;
10071 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10072
10073 if (argc < 4 || argc % 2 != 0) {
10074 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10075 return JIM_ERR;
10076 }
10077 if (doMap) {
10078 mapRes = Jim_NewListObj(interp, NULL, 0);
10079 Jim_IncrRefCount(mapRes);
10080 }
10081 emptyStr = Jim_NewEmptyStringObj(interp);
10082 Jim_IncrRefCount(emptyStr);
10083 script = argv[argc-1]; /* Last argument is a script */
10084 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10085 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10086 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10087 /* Initialize iterators and remember max nbr elements each list */
10088 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10089 /* Remember lengths of all lists and calculate how much rounds to loop */
10090 for (i=0; i < nbrOfLists*2; i += 2) {
10091 div_t cnt;
10092 int count;
10093 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10094 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10095 if (listsEnd[i] == 0) {
10096 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10097 goto err;
10098 }
10099 cnt = div(listsEnd[i+1], listsEnd[i]);
10100 count = cnt.quot + (cnt.rem ? 1 : 0);
10101 if (count > nbrOfLoops)
10102 nbrOfLoops = count;
10103 }
10104 for (; nbrOfLoops-- > 0; ) {
10105 for (i=0; i < nbrOfLists; ++i) {
10106 int varIdx = 0, var = i * 2;
10107 while (varIdx < listsEnd[var]) {
10108 Jim_Obj *varName, *ele;
10109 int lst = i * 2 + 1;
10110 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10111 != JIM_OK)
10112 goto err;
10113 if (listsIdx[i] < listsEnd[lst]) {
10114 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10115 != JIM_OK)
10116 goto err;
10117 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10118 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10119 goto err;
10120 }
10121 ++listsIdx[i]; /* Remember next iterator of current list */
10122 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10123 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10124 goto err;
10125 }
10126 ++varIdx; /* Next variable */
10127 }
10128 }
10129 switch (result = Jim_EvalObj(interp, script)) {
10130 case JIM_OK:
10131 if (doMap)
10132 Jim_ListAppendElement(interp, mapRes, interp->result);
10133 break;
10134 case JIM_CONTINUE:
10135 break;
10136 case JIM_BREAK:
10137 goto out;
10138 break;
10139 default:
10140 goto err;
10141 }
10142 }
10143 out:
10144 result = JIM_OK;
10145 if (doMap)
10146 Jim_SetResult(interp, mapRes);
10147 else
10148 Jim_SetEmptyResult(interp);
10149 err:
10150 if (doMap)
10151 Jim_DecrRefCount(interp, mapRes);
10152 Jim_DecrRefCount(interp, emptyStr);
10153 Jim_Free(listsIdx);
10154 Jim_Free(listsEnd);
10155 return result;
10156 }
10157
10158 /* [foreach] */
10159 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10160 Jim_Obj *const *argv)
10161 {
10162 return JimForeachMapHelper(interp, argc, argv, 0);
10163 }
10164
10165 /* [lmap] */
10166 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10167 Jim_Obj *const *argv)
10168 {
10169 return JimForeachMapHelper(interp, argc, argv, 1);
10170 }
10171
10172 /* [if] */
10173 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10174 Jim_Obj *const *argv)
10175 {
10176 int boolean, retval, current = 1, falsebody = 0;
10177 if (argc >= 3) {
10178 while (1) {
10179 /* Far not enough arguments given! */
10180 if (current >= argc) goto err;
10181 if ((retval = Jim_GetBoolFromExpr(interp,
10182 argv[current++], &boolean))
10183 != JIM_OK)
10184 return retval;
10185 /* There lacks something, isn't it? */
10186 if (current >= argc) goto err;
10187 if (Jim_CompareStringImmediate(interp, argv[current],
10188 "then")) current++;
10189 /* Tsk tsk, no then-clause? */
10190 if (current >= argc) goto err;
10191 if (boolean)
10192 return Jim_EvalObj(interp, argv[current]);
10193 /* Ok: no else-clause follows */
10194 if (++current >= argc) {
10195 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10196 return JIM_OK;
10197 }
10198 falsebody = current++;
10199 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10200 "else")) {
10201 /* IIICKS - else-clause isn't last cmd? */
10202 if (current != argc-1) goto err;
10203 return Jim_EvalObj(interp, argv[current]);
10204 } else if (Jim_CompareStringImmediate(interp,
10205 argv[falsebody], "elseif"))
10206 /* Ok: elseif follows meaning all the stuff
10207 * again (how boring...) */
10208 continue;
10209 /* OOPS - else-clause is not last cmd?*/
10210 else if (falsebody != argc-1)
10211 goto err;
10212 return Jim_EvalObj(interp, argv[falsebody]);
10213 }
10214 return JIM_OK;
10215 }
10216 err:
10217 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10218 return JIM_ERR;
10219 }
10220
10221 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10222
10223 /* [switch] */
10224 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10225 Jim_Obj *const *argv)
10226 {
10227 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10228 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10229 Jim_Obj *script = 0;
10230 if (argc < 3) goto wrongnumargs;
10231 for (opt=1; opt < argc; ++opt) {
10232 const char *option = Jim_GetString(argv[opt], 0);
10233 if (*option != '-') break;
10234 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10235 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10236 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10237 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10238 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10239 if ((argc - opt) < 2) goto wrongnumargs;
10240 command = argv[++opt];
10241 } else {
10242 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10243 Jim_AppendStrings(interp, Jim_GetResult(interp),
10244 "bad option \"", option, "\": must be -exact, -glob, "
10245 "-regexp, -command procname or --", 0);
10246 goto err;
10247 }
10248 if ((argc - opt) < 2) goto wrongnumargs;
10249 }
10250 strObj = argv[opt++];
10251 patCount = argc - opt;
10252 if (patCount == 1) {
10253 Jim_Obj **vector;
10254 JimListGetElements(interp, argv[opt], &patCount, &vector);
10255 caseList = vector;
10256 } else
10257 caseList = &argv[opt];
10258 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10259 for (i=0; script == 0 && i < patCount; i += 2) {
10260 Jim_Obj *patObj = caseList[i];
10261 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10262 || i < (patCount-2)) {
10263 switch (matchOpt) {
10264 case SWITCH_EXACT:
10265 if (Jim_StringEqObj(strObj, patObj, 0))
10266 script = caseList[i+1];
10267 break;
10268 case SWITCH_GLOB:
10269 if (Jim_StringMatchObj(patObj, strObj, 0))
10270 script = caseList[i+1];
10271 break;
10272 case SWITCH_RE:
10273 command = Jim_NewStringObj(interp, "regexp", -1);
10274 /* Fall thru intentionally */
10275 case SWITCH_CMD: {
10276 Jim_Obj *parms[] = {command, patObj, strObj};
10277 int rc = Jim_EvalObjVector(interp, 3, parms);
10278 long matching;
10279 /* After the execution of a command we need to
10280 * make sure to reconvert the object into a list
10281 * again. Only for the single-list style [switch]. */
10282 if (argc-opt == 1) {
10283 Jim_Obj **vector;
10284 JimListGetElements(interp, argv[opt], &patCount,
10285 &vector);
10286 caseList = vector;
10287 }
10288 /* command is here already decref'd */
10289 if (rc != JIM_OK) {
10290 retcode = rc;
10291 goto err;
10292 }
10293 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10294 if (rc != JIM_OK) {
10295 retcode = rc;
10296 goto err;
10297 }
10298 if (matching)
10299 script = caseList[i+1];
10300 break;
10301 }
10302 default:
10303 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10304 Jim_AppendStrings(interp, Jim_GetResult(interp),
10305 "internal error: no such option implemented", 0);
10306 goto err;
10307 }
10308 } else {
10309 script = caseList[i+1];
10310 }
10311 }
10312 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10313 i += 2)
10314 script = caseList[i+1];
10315 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10316 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10317 Jim_AppendStrings(interp, Jim_GetResult(interp),
10318 "no body specified for pattern \"",
10319 Jim_GetString(caseList[i-2], 0), "\"", 0);
10320 goto err;
10321 }
10322 retcode = JIM_OK;
10323 Jim_SetEmptyResult(interp);
10324 if (script != 0)
10325 retcode = Jim_EvalObj(interp, script);
10326 return retcode;
10327 wrongnumargs:
10328 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10329 "pattern body ... ?default body? or "
10330 "{pattern body ?pattern body ...?}");
10331 err:
10332 return retcode;
10333 }
10334
10335 /* [list] */
10336 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10337 Jim_Obj *const *argv)
10338 {
10339 Jim_Obj *listObjPtr;
10340
10341 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10342 Jim_SetResult(interp, listObjPtr);
10343 return JIM_OK;
10344 }
10345
10346 /* [lindex] */
10347 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10348 Jim_Obj *const *argv)
10349 {
10350 Jim_Obj *objPtr, *listObjPtr;
10351 int i;
10352 int index;
10353
10354 if (argc < 3) {
10355 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10356 return JIM_ERR;
10357 }
10358 objPtr = argv[1];
10359 Jim_IncrRefCount(objPtr);
10360 for (i = 2; i < argc; i++) {
10361 listObjPtr = objPtr;
10362 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10363 Jim_DecrRefCount(interp, listObjPtr);
10364 return JIM_ERR;
10365 }
10366 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10367 JIM_NONE) != JIM_OK) {
10368 /* Returns an empty object if the index
10369 * is out of range. */
10370 Jim_DecrRefCount(interp, listObjPtr);
10371 Jim_SetEmptyResult(interp);
10372 return JIM_OK;
10373 }
10374 Jim_IncrRefCount(objPtr);
10375 Jim_DecrRefCount(interp, listObjPtr);
10376 }
10377 Jim_SetResult(interp, objPtr);
10378 Jim_DecrRefCount(interp, objPtr);
10379 return JIM_OK;
10380 }
10381
10382 /* [llength] */
10383 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10384 Jim_Obj *const *argv)
10385 {
10386 int len;
10387
10388 if (argc != 2) {
10389 Jim_WrongNumArgs(interp, 1, argv, "list");
10390 return JIM_ERR;
10391 }
10392 Jim_ListLength(interp, argv[1], &len);
10393 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10394 return JIM_OK;
10395 }
10396
10397 /* [lappend] */
10398 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10399 Jim_Obj *const *argv)
10400 {
10401 Jim_Obj *listObjPtr;
10402 int shared, i;
10403
10404 if (argc < 2) {
10405 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10406 return JIM_ERR;
10407 }
10408 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10409 if (!listObjPtr) {
10410 /* Create the list if it does not exists */
10411 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10412 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10413 Jim_FreeNewObj(interp, listObjPtr);
10414 return JIM_ERR;
10415 }
10416 }
10417 shared = Jim_IsShared(listObjPtr);
10418 if (shared)
10419 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10420 for (i = 2; i < argc; i++)
10421 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10422 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10423 if (shared)
10424 Jim_FreeNewObj(interp, listObjPtr);
10425 return JIM_ERR;
10426 }
10427 Jim_SetResult(interp, listObjPtr);
10428 return JIM_OK;
10429 }
10430
10431 /* [linsert] */
10432 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10433 Jim_Obj *const *argv)
10434 {
10435 int index, len;
10436 Jim_Obj *listPtr;
10437
10438 if (argc < 4) {
10439 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10440 "?element ...?");
10441 return JIM_ERR;
10442 }
10443 listPtr = argv[1];
10444 if (Jim_IsShared(listPtr))
10445 listPtr = Jim_DuplicateObj(interp, listPtr);
10446 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10447 goto err;
10448 Jim_ListLength(interp, listPtr, &len);
10449 if (index >= len)
10450 index = len;
10451 else if (index < 0)
10452 index = len + index + 1;
10453 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10454 Jim_SetResult(interp, listPtr);
10455 return JIM_OK;
10456 err:
10457 if (listPtr != argv[1]) {
10458 Jim_FreeNewObj(interp, listPtr);
10459 }
10460 return JIM_ERR;
10461 }
10462
10463 /* [lset] */
10464 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10465 Jim_Obj *const *argv)
10466 {
10467 if (argc < 3) {
10468 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10469 return JIM_ERR;
10470 } else if (argc == 3) {
10471 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10472 return JIM_ERR;
10473 Jim_SetResult(interp, argv[2]);
10474 return JIM_OK;
10475 }
10476 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10477 == JIM_ERR) return JIM_ERR;
10478 return JIM_OK;
10479 }
10480
10481 /* [lsort] */
10482 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10483 {
10484 const char *options[] = {
10485 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10486 };
10487 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10488 Jim_Obj *resObj;
10489 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10490 int decreasing = 0;
10491
10492 if (argc < 2) {
10493 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10494 return JIM_ERR;
10495 }
10496 for (i = 1; i < (argc-1); i++) {
10497 int option;
10498
10499 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10500 != JIM_OK)
10501 return JIM_ERR;
10502 switch(option) {
10503 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10504 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10505 case OPT_INCREASING: decreasing = 0; break;
10506 case OPT_DECREASING: decreasing = 1; break;
10507 }
10508 }
10509 if (decreasing) {
10510 switch(lsortType) {
10511 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10512 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10513 }
10514 }
10515 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10516 ListSortElements(interp, resObj, lsortType);
10517 Jim_SetResult(interp, resObj);
10518 return JIM_OK;
10519 }
10520
10521 /* [append] */
10522 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10523 Jim_Obj *const *argv)
10524 {
10525 Jim_Obj *stringObjPtr;
10526 int shared, i;
10527
10528 if (argc < 2) {
10529 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10530 return JIM_ERR;
10531 }
10532 if (argc == 2) {
10533 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10534 if (!stringObjPtr) return JIM_ERR;
10535 } else {
10536 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10537 if (!stringObjPtr) {
10538 /* Create the string if it does not exists */
10539 stringObjPtr = Jim_NewEmptyStringObj(interp);
10540 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10541 != JIM_OK) {
10542 Jim_FreeNewObj(interp, stringObjPtr);
10543 return JIM_ERR;
10544 }
10545 }
10546 }
10547 shared = Jim_IsShared(stringObjPtr);
10548 if (shared)
10549 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10550 for (i = 2; i < argc; i++)
10551 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10552 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10553 if (shared)
10554 Jim_FreeNewObj(interp, stringObjPtr);
10555 return JIM_ERR;
10556 }
10557 Jim_SetResult(interp, stringObjPtr);
10558 return JIM_OK;
10559 }
10560
10561 /* [debug] */
10562 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10563 Jim_Obj *const *argv)
10564 {
10565 const char *options[] = {
10566 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10567 "exprbc",
10568 NULL
10569 };
10570 enum {
10571 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10572 OPT_EXPRLEN, OPT_EXPRBC
10573 };
10574 int option;
10575
10576 if (argc < 2) {
10577 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10578 return JIM_ERR;
10579 }
10580 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10581 JIM_ERRMSG) != JIM_OK)
10582 return JIM_ERR;
10583 if (option == OPT_REFCOUNT) {
10584 if (argc != 3) {
10585 Jim_WrongNumArgs(interp, 2, argv, "object");
10586 return JIM_ERR;
10587 }
10588 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10589 return JIM_OK;
10590 } else if (option == OPT_OBJCOUNT) {
10591 int freeobj = 0, liveobj = 0;
10592 char buf[256];
10593 Jim_Obj *objPtr;
10594
10595 if (argc != 2) {
10596 Jim_WrongNumArgs(interp, 2, argv, "");
10597 return JIM_ERR;
10598 }
10599 /* Count the number of free objects. */
10600 objPtr = interp->freeList;
10601 while (objPtr) {
10602 freeobj++;
10603 objPtr = objPtr->nextObjPtr;
10604 }
10605 /* Count the number of live objects. */
10606 objPtr = interp->liveList;
10607 while (objPtr) {
10608 liveobj++;
10609 objPtr = objPtr->nextObjPtr;
10610 }
10611 /* Set the result string and return. */
10612 sprintf(buf, "free %d used %d", freeobj, liveobj);
10613 Jim_SetResultString(interp, buf, -1);
10614 return JIM_OK;
10615 } else if (option == OPT_OBJECTS) {
10616 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10617 /* Count the number of live objects. */
10618 objPtr = interp->liveList;
10619 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10620 while (objPtr) {
10621 char buf[128];
10622 const char *type = objPtr->typePtr ?
10623 objPtr->typePtr->name : "";
10624 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10625 sprintf(buf, "%p", objPtr);
10626 Jim_ListAppendElement(interp, subListObjPtr,
10627 Jim_NewStringObj(interp, buf, -1));
10628 Jim_ListAppendElement(interp, subListObjPtr,
10629 Jim_NewStringObj(interp, type, -1));
10630 Jim_ListAppendElement(interp, subListObjPtr,
10631 Jim_NewIntObj(interp, objPtr->refCount));
10632 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10633 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10634 objPtr = objPtr->nextObjPtr;
10635 }
10636 Jim_SetResult(interp, listObjPtr);
10637 return JIM_OK;
10638 } else if (option == OPT_INVSTR) {
10639 Jim_Obj *objPtr;
10640
10641 if (argc != 3) {
10642 Jim_WrongNumArgs(interp, 2, argv, "object");
10643 return JIM_ERR;
10644 }
10645 objPtr = argv[2];
10646 if (objPtr->typePtr != NULL)
10647 Jim_InvalidateStringRep(objPtr);
10648 Jim_SetEmptyResult(interp);
10649 return JIM_OK;
10650 } else if (option == OPT_SCRIPTLEN) {
10651 ScriptObj *script;
10652 if (argc != 3) {
10653 Jim_WrongNumArgs(interp, 2, argv, "script");
10654 return JIM_ERR;
10655 }
10656 script = Jim_GetScript(interp, argv[2]);
10657 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10658 return JIM_OK;
10659 } else if (option == OPT_EXPRLEN) {
10660 ExprByteCode *expr;
10661 if (argc != 3) {
10662 Jim_WrongNumArgs(interp, 2, argv, "expression");
10663 return JIM_ERR;
10664 }
10665 expr = Jim_GetExpression(interp, argv[2]);
10666 if (expr == NULL)
10667 return JIM_ERR;
10668 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10669 return JIM_OK;
10670 } else if (option == OPT_EXPRBC) {
10671 Jim_Obj *objPtr;
10672 ExprByteCode *expr;
10673 int i;
10674
10675 if (argc != 3) {
10676 Jim_WrongNumArgs(interp, 2, argv, "expression");
10677 return JIM_ERR;
10678 }
10679 expr = Jim_GetExpression(interp, argv[2]);
10680 if (expr == NULL)
10681 return JIM_ERR;
10682 objPtr = Jim_NewListObj(interp, NULL, 0);
10683 for (i = 0; i < expr->len; i++) {
10684 const char *type;
10685 Jim_ExprOperator *op;
10686
10687 switch(expr->opcode[i]) {
10688 case JIM_EXPROP_NUMBER: type = "number"; break;
10689 case JIM_EXPROP_COMMAND: type = "command"; break;
10690 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10691 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10692 case JIM_EXPROP_SUBST: type = "subst"; break;
10693 case JIM_EXPROP_STRING: type = "string"; break;
10694 default:
10695 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10696 if (op == NULL) {
10697 type = "private";
10698 } else {
10699 type = "operator";
10700 }
10701 break;
10702 }
10703 Jim_ListAppendElement(interp, objPtr,
10704 Jim_NewStringObj(interp, type, -1));
10705 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10706 }
10707 Jim_SetResult(interp, objPtr);
10708 return JIM_OK;
10709 } else {
10710 Jim_SetResultString(interp,
10711 "bad option. Valid options are refcount, "
10712 "objcount, objects, invstr", -1);
10713 return JIM_ERR;
10714 }
10715 return JIM_OK; /* unreached */
10716 }
10717
10718 /* [eval] */
10719 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10720 Jim_Obj *const *argv)
10721 {
10722 if (argc == 2) {
10723 return Jim_EvalObj(interp, argv[1]);
10724 } else if (argc > 2) {
10725 Jim_Obj *objPtr;
10726 int retcode;
10727
10728 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10729 Jim_IncrRefCount(objPtr);
10730 retcode = Jim_EvalObj(interp, objPtr);
10731 Jim_DecrRefCount(interp, objPtr);
10732 return retcode;
10733 } else {
10734 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10735 return JIM_ERR;
10736 }
10737 }
10738
10739 /* [uplevel] */
10740 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10741 Jim_Obj *const *argv)
10742 {
10743 if (argc >= 2) {
10744 int retcode, newLevel, oldLevel;
10745 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10746 Jim_Obj *objPtr;
10747 const char *str;
10748
10749 /* Save the old callframe pointer */
10750 savedCallFrame = interp->framePtr;
10751
10752 /* Lookup the target frame pointer */
10753 str = Jim_GetString(argv[1], NULL);
10754 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10755 {
10756 if (Jim_GetCallFrameByLevel(interp, argv[1],
10757 &targetCallFrame,
10758 &newLevel) != JIM_OK)
10759 return JIM_ERR;
10760 argc--;
10761 argv++;
10762 } else {
10763 if (Jim_GetCallFrameByLevel(interp, NULL,
10764 &targetCallFrame,
10765 &newLevel) != JIM_OK)
10766 return JIM_ERR;
10767 }
10768 if (argc < 2) {
10769 argc++;
10770 argv--;
10771 Jim_WrongNumArgs(interp, 1, argv,
10772 "?level? command ?arg ...?");
10773 return JIM_ERR;
10774 }
10775 /* Eval the code in the target callframe. */
10776 interp->framePtr = targetCallFrame;
10777 oldLevel = interp->numLevels;
10778 interp->numLevels = newLevel;
10779 if (argc == 2) {
10780 retcode = Jim_EvalObj(interp, argv[1]);
10781 } else {
10782 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10783 Jim_IncrRefCount(objPtr);
10784 retcode = Jim_EvalObj(interp, objPtr);
10785 Jim_DecrRefCount(interp, objPtr);
10786 }
10787 interp->numLevels = oldLevel;
10788 interp->framePtr = savedCallFrame;
10789 return retcode;
10790 } else {
10791 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10792 return JIM_ERR;
10793 }
10794 }
10795
10796 /* [expr] */
10797 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10798 Jim_Obj *const *argv)
10799 {
10800 Jim_Obj *exprResultPtr;
10801 int retcode;
10802
10803 if (argc == 2) {
10804 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10805 } else if (argc > 2) {
10806 Jim_Obj *objPtr;
10807
10808 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10809 Jim_IncrRefCount(objPtr);
10810 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10811 Jim_DecrRefCount(interp, objPtr);
10812 } else {
10813 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10814 return JIM_ERR;
10815 }
10816 if (retcode != JIM_OK) return retcode;
10817 Jim_SetResult(interp, exprResultPtr);
10818 Jim_DecrRefCount(interp, exprResultPtr);
10819 return JIM_OK;
10820 }
10821
10822 /* [break] */
10823 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10824 Jim_Obj *const *argv)
10825 {
10826 if (argc != 1) {
10827 Jim_WrongNumArgs(interp, 1, argv, "");
10828 return JIM_ERR;
10829 }
10830 return JIM_BREAK;
10831 }
10832
10833 /* [continue] */
10834 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10835 Jim_Obj *const *argv)
10836 {
10837 if (argc != 1) {
10838 Jim_WrongNumArgs(interp, 1, argv, "");
10839 return JIM_ERR;
10840 }
10841 return JIM_CONTINUE;
10842 }
10843
10844 /* [return] */
10845 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10846 Jim_Obj *const *argv)
10847 {
10848 if (argc == 1) {
10849 return JIM_RETURN;
10850 } else if (argc == 2) {
10851 Jim_SetResult(interp, argv[1]);
10852 interp->returnCode = JIM_OK;
10853 return JIM_RETURN;
10854 } else if (argc == 3 || argc == 4) {
10855 int returnCode;
10856 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10857 return JIM_ERR;
10858 interp->returnCode = returnCode;
10859 if (argc == 4)
10860 Jim_SetResult(interp, argv[3]);
10861 return JIM_RETURN;
10862 } else {
10863 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10864 return JIM_ERR;
10865 }
10866 return JIM_RETURN; /* unreached */
10867 }
10868
10869 /* [tailcall] */
10870 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10871 Jim_Obj *const *argv)
10872 {
10873 Jim_Obj *objPtr;
10874
10875 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10876 Jim_SetResult(interp, objPtr);
10877 return JIM_EVAL;
10878 }
10879
10880 /* [proc] */
10881 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10882 Jim_Obj *const *argv)
10883 {
10884 int argListLen;
10885 int arityMin, arityMax;
10886
10887 if (argc != 4 && argc != 5) {
10888 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10889 return JIM_ERR;
10890 }
10891 Jim_ListLength(interp, argv[2], &argListLen);
10892 arityMin = arityMax = argListLen+1;
10893 if (argListLen) {
10894 const char *str;
10895 int len;
10896 Jim_Obj *lastArgPtr;
10897
10898 Jim_ListIndex(interp, argv[2], argListLen-1, &lastArgPtr, JIM_NONE);
10899 str = Jim_GetString(lastArgPtr, &len);
10900 if (len == 4 && memcmp(str, "args", 4) == 0) {
10901 arityMin--;
10902 arityMax = -1;
10903 }
10904 }
10905 if (argc == 4) {
10906 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10907 argv[2], NULL, argv[3], arityMin, arityMax);
10908 } else {
10909 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10910 argv[2], argv[3], argv[4], arityMin, arityMax);
10911 }
10912 }
10913
10914 /* [concat] */
10915 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
10916 Jim_Obj *const *argv)
10917 {
10918 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
10919 return JIM_OK;
10920 }
10921
10922 /* [upvar] */
10923 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
10924 Jim_Obj *const *argv)
10925 {
10926 const char *str;
10927 int i;
10928 Jim_CallFrame *targetCallFrame;
10929
10930 /* Lookup the target frame pointer */
10931 str = Jim_GetString(argv[1], NULL);
10932 if (argc > 3 &&
10933 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
10934 {
10935 if (Jim_GetCallFrameByLevel(interp, argv[1],
10936 &targetCallFrame, NULL) != JIM_OK)
10937 return JIM_ERR;
10938 argc--;
10939 argv++;
10940 } else {
10941 if (Jim_GetCallFrameByLevel(interp, NULL,
10942 &targetCallFrame, NULL) != JIM_OK)
10943 return JIM_ERR;
10944 }
10945 /* Check for arity */
10946 if (argc < 3 || ((argc-1)%2) != 0) {
10947 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
10948 return JIM_ERR;
10949 }
10950 /* Now... for every other/local couple: */
10951 for (i = 1; i < argc; i += 2) {
10952 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
10953 targetCallFrame) != JIM_OK) return JIM_ERR;
10954 }
10955 return JIM_OK;
10956 }
10957
10958 /* [global] */
10959 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
10960 Jim_Obj *const *argv)
10961 {
10962 int i;
10963
10964 if (argc < 2) {
10965 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
10966 return JIM_ERR;
10967 }
10968 /* Link every var to the toplevel having the same name */
10969 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
10970 for (i = 1; i < argc; i++) {
10971 if (Jim_SetVariableLink(interp, argv[i], argv[i],
10972 interp->topFramePtr) != JIM_OK) return JIM_ERR;
10973 }
10974 return JIM_OK;
10975 }
10976
10977 /* does the [string map] operation. On error NULL is returned,
10978 * otherwise a new string object with the result, having refcount = 0,
10979 * is returned. */
10980 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
10981 Jim_Obj *objPtr, int nocase)
10982 {
10983 int numMaps;
10984 const char **key, *str, *noMatchStart = NULL;
10985 Jim_Obj **value;
10986 int *keyLen, strLen, i;
10987 Jim_Obj *resultObjPtr;
10988
10989 Jim_ListLength(interp, mapListObjPtr, &numMaps);
10990 if (numMaps % 2) {
10991 Jim_SetResultString(interp,
10992 "list must contain an even number of elements", -1);
10993 return NULL;
10994 }
10995 /* Initialization */
10996 numMaps /= 2;
10997 key = Jim_Alloc(sizeof(char*)*numMaps);
10998 keyLen = Jim_Alloc(sizeof(int)*numMaps);
10999 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11000 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11001 for (i = 0; i < numMaps; i++) {
11002 Jim_Obj *eleObjPtr;
11003
11004 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11005 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11006 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11007 value[i] = eleObjPtr;
11008 }
11009 str = Jim_GetString(objPtr, &strLen);
11010 /* Map it */
11011 while(strLen) {
11012 for (i = 0; i < numMaps; i++) {
11013 if (strLen >= keyLen[i] && keyLen[i]) {
11014 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11015 nocase))
11016 {
11017 if (noMatchStart) {
11018 Jim_AppendString(interp, resultObjPtr,
11019 noMatchStart, str-noMatchStart);
11020 noMatchStart = NULL;
11021 }
11022 Jim_AppendObj(interp, resultObjPtr, value[i]);
11023 str += keyLen[i];
11024 strLen -= keyLen[i];
11025 break;
11026 }
11027 }
11028 }
11029 if (i == numMaps) { /* no match */
11030 if (noMatchStart == NULL)
11031 noMatchStart = str;
11032 str ++;
11033 strLen --;
11034 }
11035 }
11036 if (noMatchStart) {
11037 Jim_AppendString(interp, resultObjPtr,
11038 noMatchStart, str-noMatchStart);
11039 }
11040 Jim_Free((void*)key);
11041 Jim_Free(keyLen);
11042 Jim_Free(value);
11043 return resultObjPtr;
11044 }
11045
11046 /* [string] */
11047 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11048 Jim_Obj *const *argv)
11049 {
11050 int option;
11051 const char *options[] = {
11052 "length", "compare", "match", "equal", "range", "map", "repeat",
11053 "index", "first", "tolower", "toupper", NULL
11054 };
11055 enum {
11056 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11057 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11058 };
11059
11060 if (argc < 2) {
11061 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11062 return JIM_ERR;
11063 }
11064 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11065 JIM_ERRMSG) != JIM_OK)
11066 return JIM_ERR;
11067
11068 if (option == OPT_LENGTH) {
11069 int len;
11070
11071 if (argc != 3) {
11072 Jim_WrongNumArgs(interp, 2, argv, "string");
11073 return JIM_ERR;
11074 }
11075 Jim_GetString(argv[2], &len);
11076 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11077 return JIM_OK;
11078 } else if (option == OPT_COMPARE) {
11079 int nocase = 0;
11080 if ((argc != 4 && argc != 5) ||
11081 (argc == 5 && Jim_CompareStringImmediate(interp,
11082 argv[2], "-nocase") == 0)) {
11083 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11084 return JIM_ERR;
11085 }
11086 if (argc == 5) {
11087 nocase = 1;
11088 argv++;
11089 }
11090 Jim_SetResult(interp, Jim_NewIntObj(interp,
11091 Jim_StringCompareObj(argv[2],
11092 argv[3], nocase)));
11093 return JIM_OK;
11094 } else if (option == OPT_MATCH) {
11095 int nocase = 0;
11096 if ((argc != 4 && argc != 5) ||
11097 (argc == 5 && Jim_CompareStringImmediate(interp,
11098 argv[2], "-nocase") == 0)) {
11099 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11100 "string");
11101 return JIM_ERR;
11102 }
11103 if (argc == 5) {
11104 nocase = 1;
11105 argv++;
11106 }
11107 Jim_SetResult(interp,
11108 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11109 argv[3], nocase)));
11110 return JIM_OK;
11111 } else if (option == OPT_EQUAL) {
11112 if (argc != 4) {
11113 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11114 return JIM_ERR;
11115 }
11116 Jim_SetResult(interp,
11117 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11118 argv[3], 0)));
11119 return JIM_OK;
11120 } else if (option == OPT_RANGE) {
11121 Jim_Obj *objPtr;
11122
11123 if (argc != 5) {
11124 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11125 return JIM_ERR;
11126 }
11127 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11128 if (objPtr == NULL)
11129 return JIM_ERR;
11130 Jim_SetResult(interp, objPtr);
11131 return JIM_OK;
11132 } else if (option == OPT_MAP) {
11133 int nocase = 0;
11134 Jim_Obj *objPtr;
11135
11136 if ((argc != 4 && argc != 5) ||
11137 (argc == 5 && Jim_CompareStringImmediate(interp,
11138 argv[2], "-nocase") == 0)) {
11139 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11140 "string");
11141 return JIM_ERR;
11142 }
11143 if (argc == 5) {
11144 nocase = 1;
11145 argv++;
11146 }
11147 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11148 if (objPtr == NULL)
11149 return JIM_ERR;
11150 Jim_SetResult(interp, objPtr);
11151 return JIM_OK;
11152 } else if (option == OPT_REPEAT) {
11153 Jim_Obj *objPtr;
11154 jim_wide count;
11155
11156 if (argc != 4) {
11157 Jim_WrongNumArgs(interp, 2, argv, "string count");
11158 return JIM_ERR;
11159 }
11160 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11161 return JIM_ERR;
11162 objPtr = Jim_NewStringObj(interp, "", 0);
11163 while (count--) {
11164 Jim_AppendObj(interp, objPtr, argv[2]);
11165 }
11166 Jim_SetResult(interp, objPtr);
11167 return JIM_OK;
11168 } else if (option == OPT_INDEX) {
11169 int index, len;
11170 const char *str;
11171
11172 if (argc != 4) {
11173 Jim_WrongNumArgs(interp, 2, argv, "string index");
11174 return JIM_ERR;
11175 }
11176 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11177 return JIM_ERR;
11178 str = Jim_GetString(argv[2], &len);
11179 if (index != INT_MIN && index != INT_MAX)
11180 index = JimRelToAbsIndex(len, index);
11181 if (index < 0 || index >= len) {
11182 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11183 return JIM_OK;
11184 } else {
11185 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11186 return JIM_OK;
11187 }
11188 } else if (option == OPT_FIRST) {
11189 int index = 0, l1, l2;
11190 const char *s1, *s2;
11191
11192 if (argc != 4 && argc != 5) {
11193 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11194 return JIM_ERR;
11195 }
11196 s1 = Jim_GetString(argv[2], &l1);
11197 s2 = Jim_GetString(argv[3], &l2);
11198 if (argc == 5) {
11199 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11200 return JIM_ERR;
11201 index = JimRelToAbsIndex(l2, index);
11202 }
11203 Jim_SetResult(interp, Jim_NewIntObj(interp,
11204 JimStringFirst(s1, l1, s2, l2, index)));
11205 return JIM_OK;
11206 } else if (option == OPT_TOLOWER) {
11207 if (argc != 3) {
11208 Jim_WrongNumArgs(interp, 2, argv, "string");
11209 return JIM_ERR;
11210 }
11211 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11212 } else if (option == OPT_TOUPPER) {
11213 if (argc != 3) {
11214 Jim_WrongNumArgs(interp, 2, argv, "string");
11215 return JIM_ERR;
11216 }
11217 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11218 }
11219 return JIM_OK;
11220 }
11221
11222 /* [time] */
11223 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11224 Jim_Obj *const *argv)
11225 {
11226 long i, count = 1;
11227 jim_wide start, elapsed;
11228 char buf [256];
11229 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11230
11231 if (argc < 2) {
11232 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11233 return JIM_ERR;
11234 }
11235 if (argc == 3) {
11236 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11237 return JIM_ERR;
11238 }
11239 if (count < 0)
11240 return JIM_OK;
11241 i = count;
11242 start = JimClock();
11243 while (i-- > 0) {
11244 int retval;
11245
11246 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11247 return retval;
11248 }
11249 elapsed = JimClock() - start;
11250 sprintf(buf, fmt, elapsed/count);
11251 Jim_SetResultString(interp, buf, -1);
11252 return JIM_OK;
11253 }
11254
11255 /* [exit] */
11256 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11257 Jim_Obj *const *argv)
11258 {
11259 long exitCode = 0;
11260
11261 if (argc > 2) {
11262 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11263 return JIM_ERR;
11264 }
11265 if (argc == 2) {
11266 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11267 return JIM_ERR;
11268 }
11269 interp->exitCode = exitCode;
11270 return JIM_EXIT;
11271 }
11272
11273 /* [catch] */
11274 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11275 Jim_Obj *const *argv)
11276 {
11277 int exitCode = 0;
11278
11279 if (argc != 2 && argc != 3) {
11280 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11281 return JIM_ERR;
11282 }
11283 exitCode = Jim_EvalObj(interp, argv[1]);
11284 if (argc == 3) {
11285 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11286 != JIM_OK)
11287 return JIM_ERR;
11288 }
11289 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11290 return JIM_OK;
11291 }
11292
11293 /* [ref] */
11294 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11295 Jim_Obj *const *argv)
11296 {
11297 if (argc != 3 && argc != 4) {
11298 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11299 return JIM_ERR;
11300 }
11301 if (argc == 3) {
11302 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11303 } else {
11304 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11305 argv[3]));
11306 }
11307 return JIM_OK;
11308 }
11309
11310 /* [getref] */
11311 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11312 Jim_Obj *const *argv)
11313 {
11314 Jim_Reference *refPtr;
11315
11316 if (argc != 2) {
11317 Jim_WrongNumArgs(interp, 1, argv, "reference");
11318 return JIM_ERR;
11319 }
11320 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11321 return JIM_ERR;
11322 Jim_SetResult(interp, refPtr->objPtr);
11323 return JIM_OK;
11324 }
11325
11326 /* [setref] */
11327 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11328 Jim_Obj *const *argv)
11329 {
11330 Jim_Reference *refPtr;
11331
11332 if (argc != 3) {
11333 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11334 return JIM_ERR;
11335 }
11336 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11337 return JIM_ERR;
11338 Jim_IncrRefCount(argv[2]);
11339 Jim_DecrRefCount(interp, refPtr->objPtr);
11340 refPtr->objPtr = argv[2];
11341 Jim_SetResult(interp, argv[2]);
11342 return JIM_OK;
11343 }
11344
11345 /* [collect] */
11346 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11347 Jim_Obj *const *argv)
11348 {
11349 if (argc != 1) {
11350 Jim_WrongNumArgs(interp, 1, argv, "");
11351 return JIM_ERR;
11352 }
11353 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11354 return JIM_OK;
11355 }
11356
11357 /* [finalize] reference ?newValue? */
11358 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11359 Jim_Obj *const *argv)
11360 {
11361 if (argc != 2 && argc != 3) {
11362 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11363 return JIM_ERR;
11364 }
11365 if (argc == 2) {
11366 Jim_Obj *cmdNamePtr;
11367
11368 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11369 return JIM_ERR;
11370 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11371 Jim_SetResult(interp, cmdNamePtr);
11372 } else {
11373 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11374 return JIM_ERR;
11375 Jim_SetResult(interp, argv[2]);
11376 }
11377 return JIM_OK;
11378 }
11379
11380 /* TODO */
11381 /* [info references] (list of all the references/finalizers) */
11382
11383 /* [rename] */
11384 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11385 Jim_Obj *const *argv)
11386 {
11387 const char *oldName, *newName;
11388
11389 if (argc != 3) {
11390 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11391 return JIM_ERR;
11392 }
11393 oldName = Jim_GetString(argv[1], NULL);
11394 newName = Jim_GetString(argv[2], NULL);
11395 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11396 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11397 Jim_AppendStrings(interp, Jim_GetResult(interp),
11398 "can't rename \"", oldName, "\": ",
11399 "command doesn't exist", NULL);
11400 return JIM_ERR;
11401 }
11402 return JIM_OK;
11403 }
11404
11405 /* [dict] */
11406 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11407 Jim_Obj *const *argv)
11408 {
11409 int option;
11410 const char *options[] = {
11411 "create", "get", "set", "unset", "exists", NULL
11412 };
11413 enum {
11414 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11415 };
11416
11417 if (argc < 2) {
11418 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11419 return JIM_ERR;
11420 }
11421
11422 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11423 JIM_ERRMSG) != JIM_OK)
11424 return JIM_ERR;
11425
11426 if (option == OPT_CREATE) {
11427 Jim_Obj *objPtr;
11428
11429 if (argc % 2) {
11430 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11431 return JIM_ERR;
11432 }
11433 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11434 Jim_SetResult(interp, objPtr);
11435 return JIM_OK;
11436 } else if (option == OPT_GET) {
11437 Jim_Obj *objPtr;
11438
11439 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11440 JIM_ERRMSG) != JIM_OK)
11441 return JIM_ERR;
11442 Jim_SetResult(interp, objPtr);
11443 return JIM_OK;
11444 } else if (option == OPT_SET) {
11445 if (argc < 5) {
11446 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11447 return JIM_ERR;
11448 }
11449 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11450 argv[argc-1]);
11451 } else if (option == OPT_UNSET) {
11452 if (argc < 4) {
11453 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11454 return JIM_ERR;
11455 }
11456 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11457 NULL);
11458 } else if (option == OPT_EXIST) {
11459 Jim_Obj *objPtr;
11460 int exists;
11461
11462 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11463 JIM_ERRMSG) == JIM_OK)
11464 exists = 1;
11465 else
11466 exists = 0;
11467 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11468 return JIM_OK;
11469 } else {
11470 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11471 Jim_AppendStrings(interp, Jim_GetResult(interp),
11472 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11473 " must be create, get, set", NULL);
11474 return JIM_ERR;
11475 }
11476 return JIM_OK;
11477 }
11478
11479 /* [load] */
11480 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11481 Jim_Obj *const *argv)
11482 {
11483 if (argc < 2) {
11484 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11485 return JIM_ERR;
11486 }
11487 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11488 }
11489
11490 /* [subst] */
11491 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11492 Jim_Obj *const *argv)
11493 {
11494 int i, flags = 0;
11495 Jim_Obj *objPtr;
11496
11497 if (argc < 2) {
11498 Jim_WrongNumArgs(interp, 1, argv,
11499 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11500 return JIM_ERR;
11501 }
11502 i = argc-2;
11503 while(i--) {
11504 if (Jim_CompareStringImmediate(interp, argv[i+1],
11505 "-nobackslashes"))
11506 flags |= JIM_SUBST_NOESC;
11507 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11508 "-novariables"))
11509 flags |= JIM_SUBST_NOVAR;
11510 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11511 "-nocommands"))
11512 flags |= JIM_SUBST_NOCMD;
11513 else {
11514 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11515 Jim_AppendStrings(interp, Jim_GetResult(interp),
11516 "bad option \"", Jim_GetString(argv[i+1], NULL),
11517 "\": must be -nobackslashes, -nocommands, or "
11518 "-novariables", NULL);
11519 return JIM_ERR;
11520 }
11521 }
11522 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11523 return JIM_ERR;
11524 Jim_SetResult(interp, objPtr);
11525 return JIM_OK;
11526 }
11527
11528 /* [info] */
11529 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11530 Jim_Obj *const *argv)
11531 {
11532 int cmd, result = JIM_OK;
11533 static const char *commands[] = {
11534 "body", "commands", "exists", "globals", "level", "locals",
11535 "vars", "version", "complete", "args", NULL
11536 };
11537 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11538 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS};
11539
11540 if (argc < 2) {
11541 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11542 return JIM_ERR;
11543 }
11544 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11545 != JIM_OK) {
11546 return JIM_ERR;
11547 }
11548
11549 if (cmd == INFO_COMMANDS) {
11550 if (argc != 2 && argc != 3) {
11551 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11552 return JIM_ERR;
11553 }
11554 if (argc == 3)
11555 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11556 else
11557 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11558 } else if (cmd == INFO_EXISTS) {
11559 Jim_Obj *exists;
11560 if (argc != 3) {
11561 Jim_WrongNumArgs(interp, 2, argv, "varName");
11562 return JIM_ERR;
11563 }
11564 exists = Jim_GetVariable(interp, argv[2], 0);
11565 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11566 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11567 int mode;
11568 switch (cmd) {
11569 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11570 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11571 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11572 default: mode = 0; /* avoid warning */; break;
11573 }
11574 if (argc != 2 && argc != 3) {
11575 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11576 return JIM_ERR;
11577 }
11578 if (argc == 3)
11579 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11580 else
11581 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11582 } else if (cmd == INFO_LEVEL) {
11583 Jim_Obj *objPtr;
11584 switch (argc) {
11585 case 2:
11586 Jim_SetResult(interp,
11587 Jim_NewIntObj(interp, interp->numLevels));
11588 break;
11589 case 3:
11590 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11591 return JIM_ERR;
11592 Jim_SetResult(interp, objPtr);
11593 break;
11594 default:
11595 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11596 return JIM_ERR;
11597 }
11598 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11599 Jim_Cmd *cmdPtr;
11600
11601 if (argc != 3) {
11602 Jim_WrongNumArgs(interp, 2, argv, "procname");
11603 return JIM_ERR;
11604 }
11605 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11606 return JIM_ERR;
11607 if (cmdPtr->cmdProc != NULL) {
11608 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11609 Jim_AppendStrings(interp, Jim_GetResult(interp),
11610 "command \"", Jim_GetString(argv[2], NULL),
11611 "\" is not a procedure", NULL);
11612 return JIM_ERR;
11613 }
11614 if (cmd == INFO_BODY)
11615 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11616 else
11617 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11618 } else if (cmd == INFO_VERSION) {
11619 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11620 sprintf(buf, "%d.%d",
11621 JIM_VERSION / 100, JIM_VERSION % 100);
11622 Jim_SetResultString(interp, buf, -1);
11623 } else if (cmd == INFO_COMPLETE) {
11624 const char *s;
11625 int len;
11626
11627 if (argc != 3) {
11628 Jim_WrongNumArgs(interp, 2, argv, "script");
11629 return JIM_ERR;
11630 }
11631 s = Jim_GetString(argv[2], &len);
11632 Jim_SetResult(interp,
11633 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11634 }
11635 return result;
11636 }
11637
11638 /* [split] */
11639 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11640 Jim_Obj *const *argv)
11641 {
11642 const char *str, *splitChars, *noMatchStart;
11643 int splitLen, strLen, i;
11644 Jim_Obj *resObjPtr;
11645
11646 if (argc != 2 && argc != 3) {
11647 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11648 return JIM_ERR;
11649 }
11650 /* Init */
11651 if (argc == 2) {
11652 splitChars = " \n\t\r";
11653 splitLen = 4;
11654 } else {
11655 splitChars = Jim_GetString(argv[2], &splitLen);
11656 }
11657 str = Jim_GetString(argv[1], &strLen);
11658 if (!strLen) return JIM_OK;
11659 noMatchStart = str;
11660 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11661 /* Split */
11662 if (splitLen) {
11663 while (strLen) {
11664 for (i = 0; i < splitLen; i++) {
11665 if (*str == splitChars[i]) {
11666 Jim_Obj *objPtr;
11667
11668 objPtr = Jim_NewStringObj(interp, noMatchStart,
11669 (str-noMatchStart));
11670 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11671 noMatchStart = str+1;
11672 break;
11673 }
11674 }
11675 str ++;
11676 strLen --;
11677 }
11678 Jim_ListAppendElement(interp, resObjPtr,
11679 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11680 } else {
11681 /* This handles the special case of splitchars eq {}. This
11682 * is trivial but we want to perform object sharing as Tcl does. */
11683 Jim_Obj *objCache[256];
11684 const unsigned char *u = (unsigned char*) str;
11685 memset(objCache, 0, sizeof(objCache));
11686 for (i = 0; i < strLen; i++) {
11687 int c = u[i];
11688
11689 if (objCache[c] == NULL)
11690 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11691 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11692 }
11693 }
11694 Jim_SetResult(interp, resObjPtr);
11695 return JIM_OK;
11696 }
11697
11698 /* [join] */
11699 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11700 Jim_Obj *const *argv)
11701 {
11702 const char *joinStr;
11703 int joinStrLen, i, listLen;
11704 Jim_Obj *resObjPtr;
11705
11706 if (argc != 2 && argc != 3) {
11707 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11708 return JIM_ERR;
11709 }
11710 /* Init */
11711 if (argc == 2) {
11712 joinStr = " ";
11713 joinStrLen = 1;
11714 } else {
11715 joinStr = Jim_GetString(argv[2], &joinStrLen);
11716 }
11717 Jim_ListLength(interp, argv[1], &listLen);
11718 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11719 /* Split */
11720 for (i = 0; i < listLen; i++) {
11721 Jim_Obj *objPtr;
11722
11723 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11724 Jim_AppendObj(interp, resObjPtr, objPtr);
11725 if (i+1 != listLen) {
11726 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11727 }
11728 }
11729 Jim_SetResult(interp, resObjPtr);
11730 return JIM_OK;
11731 }
11732
11733 /* [format] */
11734 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11735 Jim_Obj *const *argv)
11736 {
11737 Jim_Obj *objPtr;
11738
11739 if (argc < 2) {
11740 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11741 return JIM_ERR;
11742 }
11743 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11744 if (objPtr == NULL)
11745 return JIM_ERR;
11746 Jim_SetResult(interp, objPtr);
11747 return JIM_OK;
11748 }
11749
11750 /* [scan] */
11751 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11752 Jim_Obj *const *argv)
11753 {
11754 Jim_Obj *listPtr, **outVec;
11755 int outc, i, count = 0;
11756
11757 if (argc < 3) {
11758 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11759 return JIM_ERR;
11760 }
11761 if (argv[2]->typePtr != &scanFmtStringObjType)
11762 SetScanFmtFromAny(interp, argv[2]);
11763 if (FormatGetError(argv[2]) != 0) {
11764 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11765 return JIM_ERR;
11766 }
11767 if (argc > 3) {
11768 int maxPos = FormatGetMaxPos(argv[2]);
11769 int count = FormatGetCnvCount(argv[2]);
11770 if (maxPos > argc-3) {
11771 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11772 return JIM_ERR;
11773 } else if (count != 0 && count < argc-3) {
11774 Jim_SetResultString(interp, "variable is not assigned by any "
11775 "conversion specifiers", -1);
11776 return JIM_ERR;
11777 } else if (count > argc-3) {
11778 Jim_SetResultString(interp, "different numbers of variable names and "
11779 "field specifiers", -1);
11780 return JIM_ERR;
11781 }
11782 }
11783 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11784 if (listPtr == 0)
11785 return JIM_ERR;
11786 if (argc > 3) {
11787 int len = 0;
11788 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11789 Jim_ListLength(interp, listPtr, &len);
11790 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11791 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11792 return JIM_OK;
11793 }
11794 JimListGetElements(interp, listPtr, &outc, &outVec);
11795 for (i = 0; i < outc; ++i) {
11796 if (Jim_Length(outVec[i]) > 0) {
11797 ++count;
11798 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11799 goto err;
11800 }
11801 }
11802 Jim_FreeNewObj(interp, listPtr);
11803 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11804 } else {
11805 if (listPtr == (Jim_Obj*)EOF) {
11806 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11807 return JIM_OK;
11808 }
11809 Jim_SetResult(interp, listPtr);
11810 }
11811 return JIM_OK;
11812 err:
11813 Jim_FreeNewObj(interp, listPtr);
11814 return JIM_ERR;
11815 }
11816
11817 /* [error] */
11818 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11819 Jim_Obj *const *argv)
11820 {
11821 if (argc != 2) {
11822 Jim_WrongNumArgs(interp, 1, argv, "message");
11823 return JIM_ERR;
11824 }
11825 Jim_SetResult(interp, argv[1]);
11826 return JIM_ERR;
11827 }
11828
11829 /* [lrange] */
11830 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11831 Jim_Obj *const *argv)
11832 {
11833 Jim_Obj *objPtr;
11834
11835 if (argc != 4) {
11836 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11837 return JIM_ERR;
11838 }
11839 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11840 return JIM_ERR;
11841 Jim_SetResult(interp, objPtr);
11842 return JIM_OK;
11843 }
11844
11845 /* [env] */
11846 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11847 Jim_Obj *const *argv)
11848 {
11849 const char *key;
11850 char *val;
11851
11852 if (argc != 2) {
11853 Jim_WrongNumArgs(interp, 1, argv, "varName");
11854 return JIM_ERR;
11855 }
11856 key = Jim_GetString(argv[1], NULL);
11857 val = getenv(key);
11858 if (val == NULL) {
11859 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11860 Jim_AppendStrings(interp, Jim_GetResult(interp),
11861 "environment variable \"",
11862 key, "\" does not exist", NULL);
11863 return JIM_ERR;
11864 }
11865 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
11866 return JIM_OK;
11867 }
11868
11869 /* [source] */
11870 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
11871 Jim_Obj *const *argv)
11872 {
11873 int retval;
11874
11875 if (argc != 2) {
11876 Jim_WrongNumArgs(interp, 1, argv, "fileName");
11877 return JIM_ERR;
11878 }
11879 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
11880 if (retval == JIM_RETURN)
11881 return JIM_OK;
11882 return retval;
11883 }
11884
11885 /* [lreverse] */
11886 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
11887 Jim_Obj *const *argv)
11888 {
11889 Jim_Obj *revObjPtr, **ele;
11890 int len;
11891
11892 if (argc != 2) {
11893 Jim_WrongNumArgs(interp, 1, argv, "list");
11894 return JIM_ERR;
11895 }
11896 JimListGetElements(interp, argv[1], &len, &ele);
11897 len--;
11898 revObjPtr = Jim_NewListObj(interp, NULL, 0);
11899 while (len >= 0)
11900 ListAppendElement(revObjPtr, ele[len--]);
11901 Jim_SetResult(interp, revObjPtr);
11902 return JIM_OK;
11903 }
11904
11905 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
11906 {
11907 jim_wide len;
11908
11909 if (step == 0) return -1;
11910 if (start == end) return 0;
11911 else if (step > 0 && start > end) return -1;
11912 else if (step < 0 && end > start) return -1;
11913 len = end-start;
11914 if (len < 0) len = -len; /* abs(len) */
11915 if (step < 0) step = -step; /* abs(step) */
11916 len = 1 + ((len-1)/step);
11917 /* We can truncate safely to INT_MAX, the range command
11918 * will always return an error for a such long range
11919 * because Tcl lists can't be so long. */
11920 if (len > INT_MAX) len = INT_MAX;
11921 return (int)((len < 0) ? -1 : len);
11922 }
11923
11924 /* [range] */
11925 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
11926 Jim_Obj *const *argv)
11927 {
11928 jim_wide start = 0, end, step = 1;
11929 int len, i;
11930 Jim_Obj *objPtr;
11931
11932 if (argc < 2 || argc > 4) {
11933 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
11934 return JIM_ERR;
11935 }
11936 if (argc == 2) {
11937 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
11938 return JIM_ERR;
11939 } else {
11940 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
11941 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
11942 return JIM_ERR;
11943 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
11944 return JIM_ERR;
11945 }
11946 if ((len = JimRangeLen(start, end, step)) == -1) {
11947 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
11948 return JIM_ERR;
11949 }
11950 objPtr = Jim_NewListObj(interp, NULL, 0);
11951 for (i = 0; i < len; i++)
11952 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
11953 Jim_SetResult(interp, objPtr);
11954 return JIM_OK;
11955 }
11956
11957 /* [rand] */
11958 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
11959 Jim_Obj *const *argv)
11960 {
11961 jim_wide min = 0, max, len, maxMul;
11962
11963 if (argc < 1 || argc > 3) {
11964 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
11965 return JIM_ERR;
11966 }
11967 if (argc == 1) {
11968 max = JIM_WIDE_MAX;
11969 } else if (argc == 2) {
11970 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
11971 return JIM_ERR;
11972 } else if (argc == 3) {
11973 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
11974 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
11975 return JIM_ERR;
11976 }
11977 len = max-min;
11978 if (len < 0) {
11979 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
11980 return JIM_ERR;
11981 }
11982 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
11983 while (1) {
11984 jim_wide r;
11985
11986 JimRandomBytes(interp, &r, sizeof(jim_wide));
11987 if (r < 0 || r >= maxMul) continue;
11988 r = (len == 0) ? 0 : r%len;
11989 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
11990 return JIM_OK;
11991 }
11992 }
11993
11994 /* [package] */
11995 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
11996 Jim_Obj *const *argv)
11997 {
11998 int option;
11999 const char *options[] = {
12000 "require", "provide", NULL
12001 };
12002 enum {OPT_REQUIRE, OPT_PROVIDE};
12003
12004 if (argc < 2) {
12005 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12006 return JIM_ERR;
12007 }
12008 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12009 JIM_ERRMSG) != JIM_OK)
12010 return JIM_ERR;
12011
12012 if (option == OPT_REQUIRE) {
12013 int exact = 0;
12014 const char *ver;
12015
12016 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12017 exact = 1;
12018 argv++;
12019 argc--;
12020 }
12021 if (argc != 3 && argc != 4) {
12022 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12023 return JIM_ERR;
12024 }
12025 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12026 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12027 JIM_ERRMSG);
12028 if (ver == NULL)
12029 return JIM_ERR;
12030 Jim_SetResultString(interp, ver, -1);
12031 } else if (option == OPT_PROVIDE) {
12032 if (argc != 4) {
12033 Jim_WrongNumArgs(interp, 2, argv, "package version");
12034 return JIM_ERR;
12035 }
12036 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12037 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12038 }
12039 return JIM_OK;
12040 }
12041
12042 static struct {
12043 const char *name;
12044 Jim_CmdProc cmdProc;
12045 } Jim_CoreCommandsTable[] = {
12046 {"set", Jim_SetCoreCommand},
12047 {"unset", Jim_UnsetCoreCommand},
12048 {"puts", Jim_PutsCoreCommand},
12049 {"+", Jim_AddCoreCommand},
12050 {"*", Jim_MulCoreCommand},
12051 {"-", Jim_SubCoreCommand},
12052 {"/", Jim_DivCoreCommand},
12053 {"incr", Jim_IncrCoreCommand},
12054 {"while", Jim_WhileCoreCommand},
12055 {"for", Jim_ForCoreCommand},
12056 {"foreach", Jim_ForeachCoreCommand},
12057 {"lmap", Jim_LmapCoreCommand},
12058 {"if", Jim_IfCoreCommand},
12059 {"switch", Jim_SwitchCoreCommand},
12060 {"list", Jim_ListCoreCommand},
12061 {"lindex", Jim_LindexCoreCommand},
12062 {"lset", Jim_LsetCoreCommand},
12063 {"llength", Jim_LlengthCoreCommand},
12064 {"lappend", Jim_LappendCoreCommand},
12065 {"linsert", Jim_LinsertCoreCommand},
12066 {"lsort", Jim_LsortCoreCommand},
12067 {"append", Jim_AppendCoreCommand},
12068 {"debug", Jim_DebugCoreCommand},
12069 {"eval", Jim_EvalCoreCommand},
12070 {"uplevel", Jim_UplevelCoreCommand},
12071 {"expr", Jim_ExprCoreCommand},
12072 {"break", Jim_BreakCoreCommand},
12073 {"continue", Jim_ContinueCoreCommand},
12074 {"proc", Jim_ProcCoreCommand},
12075 {"concat", Jim_ConcatCoreCommand},
12076 {"return", Jim_ReturnCoreCommand},
12077 {"upvar", Jim_UpvarCoreCommand},
12078 {"global", Jim_GlobalCoreCommand},
12079 {"string", Jim_StringCoreCommand},
12080 {"time", Jim_TimeCoreCommand},
12081 {"exit", Jim_ExitCoreCommand},
12082 {"catch", Jim_CatchCoreCommand},
12083 {"ref", Jim_RefCoreCommand},
12084 {"getref", Jim_GetrefCoreCommand},
12085 {"setref", Jim_SetrefCoreCommand},
12086 {"finalize", Jim_FinalizeCoreCommand},
12087 {"collect", Jim_CollectCoreCommand},
12088 {"rename", Jim_RenameCoreCommand},
12089 {"dict", Jim_DictCoreCommand},
12090 {"load", Jim_LoadCoreCommand},
12091 {"subst", Jim_SubstCoreCommand},
12092 {"info", Jim_InfoCoreCommand},
12093 {"split", Jim_SplitCoreCommand},
12094 {"join", Jim_JoinCoreCommand},
12095 {"format", Jim_FormatCoreCommand},
12096 {"scan", Jim_ScanCoreCommand},
12097 {"error", Jim_ErrorCoreCommand},
12098 {"lrange", Jim_LrangeCoreCommand},
12099 {"env", Jim_EnvCoreCommand},
12100 {"source", Jim_SourceCoreCommand},
12101 {"lreverse", Jim_LreverseCoreCommand},
12102 {"range", Jim_RangeCoreCommand},
12103 {"rand", Jim_RandCoreCommand},
12104 {"package", Jim_PackageCoreCommand},
12105 {"tailcall", Jim_TailcallCoreCommand},
12106 {NULL, NULL},
12107 };
12108
12109 /* Some Jim core command is actually a procedure written in Jim itself. */
12110 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12111 {
12112 Jim_Eval(interp, (char*)
12113 "proc lambda {arglist args} {\n"
12114 " set name [ref {} function lambdaFinalizer]\n"
12115 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12116 " return $name\n"
12117 "}\n"
12118 "proc lambdaFinalizer {name val} {\n"
12119 " rename $name {}\n"
12120 "}\n"
12121 );
12122 }
12123
12124 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12125 {
12126 int i = 0;
12127
12128 while(Jim_CoreCommandsTable[i].name != NULL) {
12129 Jim_CreateCommand(interp,
12130 Jim_CoreCommandsTable[i].name,
12131 Jim_CoreCommandsTable[i].cmdProc,
12132 NULL, NULL);
12133 i++;
12134 }
12135 Jim_RegisterCoreProcedures(interp);
12136 }
12137
12138 /* -----------------------------------------------------------------------------
12139 * Interactive prompt
12140 * ---------------------------------------------------------------------------*/
12141 void Jim_PrintErrorMessage(Jim_Interp *interp)
12142 {
12143 int len, i;
12144
12145 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL,
12146 interp->errorFileName, interp->errorLine);
12147 Jim_fprintf(interp,interp->cookie_stderr, " %s" JIM_NL,
12148 Jim_GetString(interp->result, NULL));
12149 Jim_ListLength(interp, interp->stackTrace, &len);
12150 for (i = len-3; i >= 0; i-= 3) {
12151 Jim_Obj *objPtr;
12152 const char *proc, *file, *line;
12153
12154 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12155 proc = Jim_GetString(objPtr, NULL);
12156 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12157 JIM_NONE);
12158 file = Jim_GetString(objPtr, NULL);
12159 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12160 JIM_NONE);
12161 line = Jim_GetString(objPtr, NULL);
12162 Jim_fprintf( interp, interp->cookie_stderr,
12163 "In procedure '%s' called at file \"%s\", line %s" JIM_NL,
12164 proc, file, line);
12165 }
12166 }
12167
12168 int Jim_InteractivePrompt(Jim_Interp *interp)
12169 {
12170 int retcode = JIM_OK;
12171 Jim_Obj *scriptObjPtr;
12172
12173 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12174 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12175 JIM_VERSION / 100, JIM_VERSION % 100);
12176 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12177 while (1) {
12178 char buf[1024];
12179 const char *result;
12180 const char *retcodestr[] = {
12181 "ok", "error", "return", "break", "continue", "eval", "exit"
12182 };
12183 int reslen;
12184
12185 if (retcode != 0) {
12186 if (retcode >= 2 && retcode <= 6)
12187 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12188 else
12189 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12190 } else
12191 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12192 Jim_fflush( interp, interp->cookie_stdout);
12193 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12194 Jim_IncrRefCount(scriptObjPtr);
12195 while(1) {
12196 const char *str;
12197 char state;
12198 int len;
12199
12200 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12201 Jim_DecrRefCount(interp, scriptObjPtr);
12202 goto out;
12203 }
12204 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12205 str = Jim_GetString(scriptObjPtr, &len);
12206 if (Jim_ScriptIsComplete(str, len, &state))
12207 break;
12208 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12209 Jim_fflush( interp, interp->cookie_stdout);
12210 }
12211 retcode = Jim_EvalObj(interp, scriptObjPtr);
12212 Jim_DecrRefCount(interp, scriptObjPtr);
12213 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12214 if (retcode == JIM_ERR) {
12215 Jim_PrintErrorMessage(interp);
12216 } else if (retcode == JIM_EXIT) {
12217 exit(Jim_GetExitCode(interp));
12218 } else {
12219 if (reslen) {
12220 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12221 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12222 }
12223 }
12224 }
12225 out:
12226 return 0;
12227 }
12228
12229 /* -----------------------------------------------------------------------------
12230 * Jim's idea of STDIO..
12231 * ---------------------------------------------------------------------------*/
12232
12233 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12234 {
12235 int r;
12236
12237 va_list ap;
12238 va_start(ap,fmt);
12239 r = Jim_vfprintf( interp, cookie, fmt,ap );
12240 va_end(ap);
12241 return r;
12242 }
12243
12244 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12245 {
12246 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12247 errno = ENOTSUP;
12248 return -1;
12249 }
12250 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12251 }
12252
12253 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12254 {
12255 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12256 errno = ENOTSUP;
12257 return 0;
12258 }
12259 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12260 }
12261
12262 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12263 {
12264 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12265 errno = ENOTSUP;
12266 return 0;
12267 }
12268 return (*(interp->cb_fread))( ptr, size, n, cookie);
12269 }
12270
12271 int Jim_fflush( Jim_Interp *interp, void *cookie )
12272 {
12273 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12274 /* pretend all is well */
12275 return 0;
12276 }
12277 return (*(interp->cb_fflush))( cookie );
12278 }
12279
12280 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12281 {
12282 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12283 errno = ENOTSUP;
12284 return NULL;
12285 }
12286 return (*(interp->cb_fgets))( s, size, cookie );
12287 }
12288
12289 Jim_Nvp *
12290 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12291 {
12292 while( p->name ){
12293 if( 0 == strcmp( name, p->name ) ){
12294 break;
12295 }
12296 p++;
12297 }
12298 return ((Jim_Nvp *)(p));
12299 }
12300
12301 Jim_Nvp *
12302 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12303 {
12304 while( p->name ){
12305 if( 0 == strcasecmp( name, p->name ) ){
12306 break;
12307 }
12308 p++;
12309 }
12310 return ((Jim_Nvp *)(p));
12311 }
12312
12313 int
12314 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12315 const Jim_Nvp *p,
12316 Jim_Obj *o,
12317 Jim_Nvp **result )
12318 {
12319 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12320 }
12321
12322
12323 int
12324 Jim_Nvp_name2value( Jim_Interp *interp,
12325 const Jim_Nvp *_p,
12326 const char *name,
12327 Jim_Nvp **result)
12328 {
12329 const Jim_Nvp *p;
12330
12331 p = Jim_Nvp_name2value_simple( _p, name );
12332
12333 /* result */
12334 if( result ){
12335 *result = (Jim_Nvp *)(p);
12336 }
12337
12338 /* found? */
12339 if( p->name ){
12340 return JIM_OK;
12341 } else {
12342 return JIM_ERR;
12343 }
12344 }
12345
12346 int
12347 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12348 {
12349 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12350 }
12351
12352 int
12353 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12354 {
12355 const Jim_Nvp *p;
12356
12357 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12358
12359 if( puthere ){
12360 *puthere = (Jim_Nvp *)(p);
12361 }
12362 /* found */
12363 if( p->name ){
12364 return JIM_OK;
12365 } else {
12366 return JIM_ERR;
12367 }
12368 }
12369
12370
12371 int
12372 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12373 {
12374 int e;;
12375 jim_wide w;
12376
12377 e = Jim_GetWide( interp, o, &w );
12378 if( e != JIM_OK ){
12379 return e;
12380 }
12381
12382 return Jim_Nvp_value2name( interp, p, w, result );
12383 }
12384
12385 Jim_Nvp *
12386 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12387 {
12388 while( p->name ){
12389 if( value == p->value ){
12390 break;
12391 }
12392 p++;
12393 }
12394 return ((Jim_Nvp *)(p));
12395 }
12396
12397
12398 int
12399 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12400 {
12401 const Jim_Nvp *p;
12402
12403 p = Jim_Nvp_value2name_simple( _p, value );
12404
12405 if( result ){
12406 *result = (Jim_Nvp *)(p);
12407 }
12408
12409 if( p->name ){
12410 return JIM_OK;
12411 } else {
12412 return JIM_ERR;
12413 }
12414 }
12415
12416
12417 int
12418 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12419 {
12420 memset( p, 0, sizeof(*p) );
12421 p->interp = interp;
12422 p->argc = argc;
12423 p->argv = argv;
12424
12425 return JIM_OK;
12426 }
12427
12428 void
12429 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12430 {
12431 int x;
12432
12433 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12434 for( x = 0 ; x < p->argc ; x++ ){
12435 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12436 "%2d) %s\n",
12437 x,
12438 Jim_GetString( p->argv[x], NULL ) );
12439 }
12440 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12441 }
12442
12443
12444 int
12445 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12446 {
12447 Jim_Obj *o;
12448
12449 o = NULL; // failure
12450 if( goi->argc ){
12451 // success
12452 o = goi->argv[0];
12453 goi->argc -= 1;
12454 goi->argv += 1;
12455 }
12456 if( puthere ){
12457 *puthere = o;
12458 }
12459 if( o != NULL ){
12460 return JIM_OK;
12461 } else {
12462 return JIM_ERR;
12463 }
12464 }
12465
12466 int
12467 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12468 {
12469 int r;
12470 Jim_Obj *o;
12471 const char *cp;
12472
12473
12474 r = Jim_GetOpt_Obj( goi, &o );
12475 if( r == JIM_OK ){
12476 cp = Jim_GetString( o, len );
12477 if( puthere ){
12478 /* remove const */
12479 *puthere = (char *)(cp);
12480 }
12481 }
12482 return r;
12483 }
12484
12485 int
12486 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12487 {
12488 int r;
12489 Jim_Obj *o;
12490 double _safe;
12491
12492 if( puthere == NULL ){
12493 puthere = &_safe;
12494 }
12495
12496 r = Jim_GetOpt_Obj( goi, &o );
12497 if( r == JIM_OK ){
12498 r = Jim_GetDouble( goi->interp, o, puthere );
12499 if( r != JIM_OK ){
12500 Jim_SetResult_sprintf( goi->interp,
12501 "not a number: %s",
12502 Jim_GetString( o, NULL ) );
12503 }
12504 }
12505 return r;
12506 }
12507
12508 int
12509 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12510 {
12511 int r;
12512 Jim_Obj *o;
12513 jim_wide _safe;
12514
12515 if( puthere == NULL ){
12516 puthere = &_safe;
12517 }
12518
12519 r = Jim_GetOpt_Obj( goi, &o );
12520 if( r == JIM_OK ){
12521 r = Jim_GetWide( goi->interp, o, puthere );
12522 }
12523 return r;
12524 }
12525
12526 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12527 const Jim_Nvp *nvp,
12528 Jim_Nvp **puthere)
12529 {
12530 Jim_Nvp *_safe;
12531 Jim_Obj *o;
12532 int e;
12533
12534 if( puthere == NULL ){
12535 puthere = &_safe;
12536 }
12537
12538 e = Jim_GetOpt_Obj( goi, &o );
12539 if( e == JIM_OK ){
12540 e = Jim_Nvp_name2value_obj( goi->interp,
12541 nvp,
12542 o,
12543 puthere );
12544 }
12545
12546 return e;
12547 }
12548
12549 void
12550 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12551 const Jim_Nvp *nvptable,
12552 int hadprefix )
12553 {
12554 if( hadprefix ){
12555 Jim_SetResult_NvpUnknown( goi->interp,
12556 goi->argv[-2],
12557 goi->argv[-1],
12558 nvptable );
12559 } else {
12560 Jim_SetResult_NvpUnknown( goi->interp,
12561 NULL,
12562 goi->argv[-1],
12563 nvptable );
12564 }
12565 }
12566
12567
12568 int
12569 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12570 const char * const * lookup,
12571 int *puthere)
12572 {
12573 int _safe;
12574 Jim_Obj *o;
12575 int e;
12576
12577 if( puthere == NULL ){
12578 puthere = &_safe;
12579 }
12580 e = Jim_GetOpt_Obj( goi, &o );
12581 if( e == JIM_OK ){
12582 e = Jim_GetEnum( goi->interp,
12583 o,
12584 lookup,
12585 puthere,
12586 "option",
12587 JIM_ERRMSG );
12588 }
12589 return e;
12590 }
12591
12592
12593
12594 int
12595 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12596 {
12597 va_list ap;
12598 char *buf;
12599
12600 va_start(ap,fmt);
12601 buf = jim_vasprintf( fmt, ap );
12602 va_end(ap);
12603 if( buf ){
12604 Jim_SetResultString( interp, buf, -1 );
12605 jim_vasprintf_done(buf);
12606 }
12607 return JIM_OK;
12608 }
12609
12610
12611 void
12612 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12613 Jim_Obj *param_name,
12614 Jim_Obj *param_value,
12615 const Jim_Nvp *nvp )
12616 {
12617 if( param_name ){
12618 Jim_SetResult_sprintf( interp,
12619 "%s: Unknown: %s, try one of: ",
12620 Jim_GetString( param_name, NULL ),
12621 Jim_GetString( param_value, NULL ) );
12622 } else {
12623 Jim_SetResult_sprintf( interp,
12624 "Unknown param: %s, try one of: ",
12625 Jim_GetString( param_value, NULL ) );
12626 }
12627 while( nvp->name ){
12628 const char *a;
12629 const char *b;
12630
12631 if( (nvp+1)->name ){
12632 a = nvp->name;
12633 b = ", ";
12634 } else {
12635 a = "or ";
12636 b = nvp->name;
12637 }
12638 Jim_AppendStrings( interp,
12639 Jim_GetResult(interp),
12640 a, b, NULL );
12641 nvp++;
12642 }
12643 }
12644
12645
12646 static Jim_Obj *debug_string_obj;
12647
12648 const char *
12649 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12650 {
12651 int x;
12652
12653 if( debug_string_obj ){
12654 Jim_FreeObj( interp, debug_string_obj );
12655 }
12656
12657 debug_string_obj = Jim_NewEmptyStringObj( interp );
12658 for( x = 0 ; x < argc ; x++ ){
12659 Jim_AppendStrings( interp,
12660 debug_string_obj,
12661 Jim_GetString( argv[x], NULL ),
12662 " ",
12663 NULL );
12664 }
12665
12666 return Jim_GetString( debug_string_obj, NULL );
12667 }
12668
12669
12670
12671 /*
12672 * Local Variables: ***
12673 * c-basic-offset: 4 ***
12674 * tab-width: 4 ***
12675 * End: ***
12676 */

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)