Audit and remove redundant uses of replacements.h in the tree.
[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 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 *
12 * The FreeBSD license
13 *
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
16 * are met:
17 *
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 *
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
41 **/
42 #ifdef HAVE_CONFIG_H
43 #include "config.h"
44 #endif
45
46 #define __JIM_CORE__
47 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
48
49 #ifdef __ECOS
50 #include <pkgconf/jimtcl.h>
51 #endif
52 #ifndef JIM_ANSIC
53 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
54 #endif /* JIM_ANSIC */
55
56 #include <stdarg.h>
57 #include <limits.h>
58
59 /* Include the platform dependent libraries for
60 * dynamic loading of libraries. */
61 #ifdef JIM_DYNLIB
62 #if defined(_WIN32) || defined(WIN32)
63 #ifndef WIN32
64 #define WIN32 1
65 #endif
66 #ifndef STRICT
67 #define STRICT
68 #endif
69 #define WIN32_LEAN_AND_MEAN
70 #include <windows.h>
71 #if _MSC_VER >= 1000
72 #pragma warning(disable:4146)
73 #endif /* _MSC_VER */
74 #else
75 #include <dlfcn.h>
76 #endif /* WIN32 */
77 #endif /* JIM_DYNLIB */
78
79 #ifdef __ECOS
80 #include <cyg/jimtcl/jim.h>
81 #else
82 #include "jim.h"
83 #endif
84
85 #ifdef HAVE_BACKTRACE
86 #include <execinfo.h>
87 #endif
88
89 /* -----------------------------------------------------------------------------
90 * Global variables
91 * ---------------------------------------------------------------------------*/
92
93 /* A shared empty string for the objects string representation.
94 * Jim_InvalidateStringRep knows about it and don't try to free. */
95 static char *JimEmptyStringRep = (char*) "";
96
97 /* -----------------------------------------------------------------------------
98 * Required prototypes of not exported functions
99 * ---------------------------------------------------------------------------*/
100 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
101 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
102 static void JimRegisterCoreApi(Jim_Interp *interp);
103
104 static Jim_HashTableType *getJimVariablesHashTableType(void);
105
106 /* -----------------------------------------------------------------------------
107 * Utility functions
108 * ---------------------------------------------------------------------------*/
109
110 static char *
111 jim_vasprintf( const char *fmt, va_list ap )
112 {
113 #ifndef HAVE_VASPRINTF
114 /* yucky way */
115 static char buf[2048];
116 vsnprintf( buf, sizeof(buf), fmt, ap );
117 /* garentee termination */
118 buf[sizeof(buf)-1] = 0;
119 #else
120 char *buf;
121 int result;
122 result = vasprintf( &buf, fmt, ap );
123 if (result < 0) exit(-1);
124 #endif
125 return buf;
126 }
127
128 static void
129 jim_vasprintf_done( void *buf )
130 {
131 #ifndef HAVE_VASPRINTF
132 (void)(buf);
133 #else
134 free(buf);
135 #endif
136 }
137
138
139 /*
140 * Convert a string to a jim_wide INTEGER.
141 * This function originates from BSD.
142 *
143 * Ignores `locale' stuff. Assumes that the upper and lower case
144 * alphabets and digits are each contiguous.
145 */
146 #ifdef HAVE_LONG_LONG_INT
147 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
148 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
149 {
150 register const char *s;
151 register unsigned jim_wide acc;
152 register unsigned char c;
153 register unsigned jim_wide qbase, cutoff;
154 register int neg, any, cutlim;
155
156 /*
157 * Skip white space and pick up leading +/- sign if any.
158 * If base is 0, allow 0x for hex and 0 for octal, else
159 * assume decimal; if base is already 16, allow 0x.
160 */
161 s = nptr;
162 do {
163 c = *s++;
164 } while (isspace(c));
165 if (c == '-') {
166 neg = 1;
167 c = *s++;
168 } else {
169 neg = 0;
170 if (c == '+')
171 c = *s++;
172 }
173 if ((base == 0 || base == 16) &&
174 c == '0' && (*s == 'x' || *s == 'X')) {
175 c = s[1];
176 s += 2;
177 base = 16;
178 }
179 if (base == 0)
180 base = c == '0' ? 8 : 10;
181
182 /*
183 * Compute the cutoff value between legal numbers and illegal
184 * numbers. That is the largest legal value, divided by the
185 * base. An input number that is greater than this value, if
186 * followed by a legal input character, is too big. One that
187 * is equal to this value may be valid or not; the limit
188 * between valid and invalid numbers is then based on the last
189 * digit. For instance, if the range for quads is
190 * [-9223372036854775808..9223372036854775807] and the input base
191 * is 10, cutoff will be set to 922337203685477580 and cutlim to
192 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
193 * accumulated a value > 922337203685477580, or equal but the
194 * next digit is > 7 (or 8), the number is too big, and we will
195 * return a range error.
196 *
197 * Set any if any `digits' consumed; make it negative to indicate
198 * overflow.
199 */
200 qbase = (unsigned)base;
201 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
202 : LLONG_MAX;
203 cutlim = (int)(cutoff % qbase);
204 cutoff /= qbase;
205 for (acc = 0, any = 0;; c = *s++) {
206 if (!JimIsAscii(c))
207 break;
208 if (isdigit(c))
209 c -= '0';
210 else if (isalpha(c))
211 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
212 else
213 break;
214 if (c >= base)
215 break;
216 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
217 any = -1;
218 else {
219 any = 1;
220 acc *= qbase;
221 acc += c;
222 }
223 }
224 if (any < 0) {
225 acc = neg ? LLONG_MIN : LLONG_MAX;
226 errno = ERANGE;
227 } else if (neg)
228 acc = -acc;
229 if (endptr != 0)
230 *endptr = (char *)(any ? s - 1 : nptr);
231 return (acc);
232 }
233 #endif
234
235 /* Glob-style pattern matching. */
236 static int JimStringMatch(const char *pattern, int patternLen,
237 const char *string, int stringLen, int nocase)
238 {
239 while(patternLen) {
240 switch(pattern[0]) {
241 case '*':
242 while (pattern[1] == '*') {
243 pattern++;
244 patternLen--;
245 }
246 if (patternLen == 1)
247 return 1; /* match */
248 while(stringLen) {
249 if (JimStringMatch(pattern+1, patternLen-1,
250 string, stringLen, nocase))
251 return 1; /* match */
252 string++;
253 stringLen--;
254 }
255 return 0; /* no match */
256 break;
257 case '?':
258 if (stringLen == 0)
259 return 0; /* no match */
260 string++;
261 stringLen--;
262 break;
263 case '[':
264 {
265 int not, match;
266
267 pattern++;
268 patternLen--;
269 not = pattern[0] == '^';
270 if (not) {
271 pattern++;
272 patternLen--;
273 }
274 match = 0;
275 while(1) {
276 if (pattern[0] == '\\') {
277 pattern++;
278 patternLen--;
279 if (pattern[0] == string[0])
280 match = 1;
281 } else if (pattern[0] == ']') {
282 break;
283 } else if (patternLen == 0) {
284 pattern--;
285 patternLen++;
286 break;
287 } else if (pattern[1] == '-' && patternLen >= 3) {
288 int start = pattern[0];
289 int end = pattern[2];
290 int c = string[0];
291 if (start > end) {
292 int t = start;
293 start = end;
294 end = t;
295 }
296 if (nocase) {
297 start = tolower(start);
298 end = tolower(end);
299 c = tolower(c);
300 }
301 pattern += 2;
302 patternLen -= 2;
303 if (c >= start && c <= end)
304 match = 1;
305 } else {
306 if (!nocase) {
307 if (pattern[0] == string[0])
308 match = 1;
309 } else {
310 if (tolower((int)pattern[0]) == tolower((int)string[0]))
311 match = 1;
312 }
313 }
314 pattern++;
315 patternLen--;
316 }
317 if (not)
318 match = !match;
319 if (!match)
320 return 0; /* no match */
321 string++;
322 stringLen--;
323 break;
324 }
325 case '\\':
326 if (patternLen >= 2) {
327 pattern++;
328 patternLen--;
329 }
330 /* fall through */
331 default:
332 if (!nocase) {
333 if (pattern[0] != string[0])
334 return 0; /* no match */
335 } else {
336 if (tolower((int)pattern[0]) != tolower((int)string[0]))
337 return 0; /* no match */
338 }
339 string++;
340 stringLen--;
341 break;
342 }
343 pattern++;
344 patternLen--;
345 if (stringLen == 0) {
346 while(*pattern == '*') {
347 pattern++;
348 patternLen--;
349 }
350 break;
351 }
352 }
353 if (patternLen == 0 && stringLen == 0)
354 return 1;
355 return 0;
356 }
357
358 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
359 int nocase)
360 {
361 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
362
363 if (nocase == 0) {
364 while(l1 && l2) {
365 if (*u1 != *u2)
366 return (int)*u1-*u2;
367 u1++; u2++; l1--; l2--;
368 }
369 if (!l1 && !l2) return 0;
370 return l1-l2;
371 } else {
372 while(l1 && l2) {
373 if (tolower((int)*u1) != tolower((int)*u2))
374 return tolower((int)*u1)-tolower((int)*u2);
375 u1++; u2++; l1--; l2--;
376 }
377 if (!l1 && !l2) return 0;
378 return l1-l2;
379 }
380 }
381
382 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
383 * The index of the first occurrence of s1 in s2 is returned.
384 * If s1 is not found inside s2, -1 is returned. */
385 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
386 {
387 int i;
388
389 if (!l1 || !l2 || l1 > l2) return -1;
390 if (index < 0) index = 0;
391 s2 += index;
392 for (i = index; i <= l2-l1; i++) {
393 if (memcmp(s2, s1, l1) == 0)
394 return i;
395 s2++;
396 }
397 return -1;
398 }
399
400 int Jim_WideToString(char *buf, jim_wide wideValue)
401 {
402 const char *fmt = "%" JIM_WIDE_MODIFIER;
403 return sprintf(buf, fmt, wideValue);
404 }
405
406 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
407 {
408 char *endptr;
409
410 #ifdef HAVE_LONG_LONG_INT
411 *widePtr = JimStrtoll(str, &endptr, base);
412 #else
413 *widePtr = strtol(str, &endptr, base);
414 #endif
415 if ((str[0] == '\0') || (str == endptr) )
416 return JIM_ERR;
417 if (endptr[0] != '\0') {
418 while(*endptr) {
419 if (!isspace((int)*endptr))
420 return JIM_ERR;
421 endptr++;
422 }
423 }
424 return JIM_OK;
425 }
426
427 int Jim_StringToIndex(const char *str, int *intPtr)
428 {
429 char *endptr;
430
431 *intPtr = strtol(str, &endptr, 10);
432 if ( (str[0] == '\0') || (str == endptr) )
433 return JIM_ERR;
434 if (endptr[0] != '\0') {
435 while(*endptr) {
436 if (!isspace((int)*endptr))
437 return JIM_ERR;
438 endptr++;
439 }
440 }
441 return JIM_OK;
442 }
443
444 /* The string representation of references has two features in order
445 * to make the GC faster. The first is that every reference starts
446 * with a non common character '~', in order to make the string matching
447 * fater. The second is that the reference string rep his 32 characters
448 * in length, this allows to avoid to check every object with a string
449 * repr < 32, and usually there are many of this objects. */
450
451 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
452
453 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
454 {
455 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
456 sprintf(buf, fmt, refPtr->tag, id);
457 return JIM_REFERENCE_SPACE;
458 }
459
460 int Jim_DoubleToString(char *buf, double doubleValue)
461 {
462 char *s;
463 int len;
464
465 len = sprintf(buf, "%.17g", doubleValue);
466 s = buf;
467 while(*s) {
468 if (*s == '.') return len;
469 s++;
470 }
471 /* Add a final ".0" if it's a number. But not
472 * for NaN or InF */
473 if (isdigit((int)buf[0])
474 || ((buf[0] == '-' || buf[0] == '+')
475 && isdigit((int)buf[1]))) {
476 s[0] = '.';
477 s[1] = '0';
478 s[2] = '\0';
479 return len+2;
480 }
481 return len;
482 }
483
484 int Jim_StringToDouble(const char *str, double *doublePtr)
485 {
486 char *endptr;
487
488 *doublePtr = strtod(str, &endptr);
489 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
490 return JIM_ERR;
491 return JIM_OK;
492 }
493
494 static jim_wide JimPowWide(jim_wide b, jim_wide e)
495 {
496 jim_wide i, res = 1;
497 if ((b==0 && e!=0) || (e<0)) return 0;
498 for(i=0; i<e; i++) {res *= b;}
499 return res;
500 }
501
502 /* -----------------------------------------------------------------------------
503 * Special functions
504 * ---------------------------------------------------------------------------*/
505
506 /* Note that 'interp' may be NULL if not available in the
507 * context of the panic. It's only useful to get the error
508 * file descriptor, it will default to stderr otherwise. */
509 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
510 {
511 va_list ap;
512
513 va_start(ap, fmt);
514 /*
515 * Send it here first.. Assuming STDIO still works
516 */
517 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
518 vfprintf(stderr, fmt, ap);
519 fprintf(stderr, JIM_NL JIM_NL);
520 va_end(ap);
521
522 #ifdef HAVE_BACKTRACE
523 {
524 void *array[40];
525 int size, i;
526 char **strings;
527
528 size = backtrace(array, 40);
529 strings = backtrace_symbols(array, size);
530 for (i = 0; i < size; i++)
531 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
532 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
533 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
534 }
535 #endif
536
537 /* This may actually crash... we do it last */
538 if( interp && interp->cookie_stderr ){
539 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
540 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
541 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
542 }
543 abort();
544 }
545
546 /* -----------------------------------------------------------------------------
547 * Memory allocation
548 * ---------------------------------------------------------------------------*/
549
550 /* Macro used for memory debugging.
551 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
552 * and similary for Jim_Realloc and Jim_Free */
553 #if 0
554 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
555 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
556 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
557 #endif
558
559 void *Jim_Alloc(int size)
560 {
561 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
562 if (size==0)
563 size=1;
564 void *p = malloc(size);
565 if (p == NULL)
566 Jim_Panic(NULL,"malloc: Out of memory");
567 return p;
568 }
569
570 void Jim_Free(void *ptr) {
571 free(ptr);
572 }
573
574 void *Jim_Realloc(void *ptr, int size)
575 {
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
577 if (size==0)
578 size=1;
579 void *p = realloc(ptr, size);
580 if (p == NULL)
581 Jim_Panic(NULL,"realloc: Out of memory");
582 return p;
583 }
584
585 char *Jim_StrDup(const char *s)
586 {
587 int l = strlen(s);
588 char *copy = Jim_Alloc(l+1);
589
590 memcpy(copy, s, l+1);
591 return copy;
592 }
593
594 char *Jim_StrDupLen(const char *s, int l)
595 {
596 char *copy = Jim_Alloc(l+1);
597
598 memcpy(copy, s, l+1);
599 copy[l] = 0; /* Just to be sure, original could be substring */
600 return copy;
601 }
602
603 /* -----------------------------------------------------------------------------
604 * Time related functions
605 * ---------------------------------------------------------------------------*/
606 /* Returns microseconds of CPU used since start. */
607 static jim_wide JimClock(void)
608 {
609 #if (defined WIN32) && !(defined JIM_ANSIC)
610 LARGE_INTEGER t, f;
611 QueryPerformanceFrequency(&f);
612 QueryPerformanceCounter(&t);
613 return (long)((t.QuadPart * 1000000) / f.QuadPart);
614 #else /* !WIN32 */
615 clock_t clocks = clock();
616
617 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
618 #endif /* WIN32 */
619 }
620
621 /* -----------------------------------------------------------------------------
622 * Hash Tables
623 * ---------------------------------------------------------------------------*/
624
625 /* -------------------------- private prototypes ---------------------------- */
626 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
627 static unsigned int JimHashTableNextPower(unsigned int size);
628 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
629
630 /* -------------------------- hash functions -------------------------------- */
631
632 /* Thomas Wang's 32 bit Mix Function */
633 unsigned int Jim_IntHashFunction(unsigned int key)
634 {
635 key += ~(key << 15);
636 key ^= (key >> 10);
637 key += (key << 3);
638 key ^= (key >> 6);
639 key += ~(key << 11);
640 key ^= (key >> 16);
641 return key;
642 }
643
644 /* Identity hash function for integer keys */
645 unsigned int Jim_IdentityHashFunction(unsigned int key)
646 {
647 return key;
648 }
649
650 /* Generic hash function (we are using to multiply by 9 and add the byte
651 * as Tcl) */
652 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
653 {
654 unsigned int h = 0;
655 while(len--)
656 h += (h<<3)+*buf++;
657 return h;
658 }
659
660 /* ----------------------------- API implementation ------------------------- */
661 /* reset an hashtable already initialized with ht_init().
662 * NOTE: This function should only called by ht_destroy(). */
663 static void JimResetHashTable(Jim_HashTable *ht)
664 {
665 ht->table = NULL;
666 ht->size = 0;
667 ht->sizemask = 0;
668 ht->used = 0;
669 ht->collisions = 0;
670 }
671
672 /* Initialize the hash table */
673 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
674 void *privDataPtr)
675 {
676 JimResetHashTable(ht);
677 ht->type = type;
678 ht->privdata = privDataPtr;
679 return JIM_OK;
680 }
681
682 /* Resize the table to the minimal size that contains all the elements,
683 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
684 int Jim_ResizeHashTable(Jim_HashTable *ht)
685 {
686 int minimal = ht->used;
687
688 if (minimal < JIM_HT_INITIAL_SIZE)
689 minimal = JIM_HT_INITIAL_SIZE;
690 return Jim_ExpandHashTable(ht, minimal);
691 }
692
693 /* Expand or create the hashtable */
694 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
695 {
696 Jim_HashTable n; /* the new hashtable */
697 unsigned int realsize = JimHashTableNextPower(size), i;
698
699 /* the size is invalid if it is smaller than the number of
700 * elements already inside the hashtable */
701 if (ht->used >= size)
702 return JIM_ERR;
703
704 Jim_InitHashTable(&n, ht->type, ht->privdata);
705 n.size = realsize;
706 n.sizemask = realsize-1;
707 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
708
709 /* Initialize all the pointers to NULL */
710 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
711
712 /* Copy all the elements from the old to the new table:
713 * note that if the old hash table is empty ht->size is zero,
714 * so Jim_ExpandHashTable just creates an hash table. */
715 n.used = ht->used;
716 for (i = 0; i < ht->size && ht->used > 0; i++) {
717 Jim_HashEntry *he, *nextHe;
718
719 if (ht->table[i] == NULL) continue;
720
721 /* For each hash entry on this slot... */
722 he = ht->table[i];
723 while(he) {
724 unsigned int h;
725
726 nextHe = he->next;
727 /* Get the new element index */
728 h = Jim_HashKey(ht, he->key) & n.sizemask;
729 he->next = n.table[h];
730 n.table[h] = he;
731 ht->used--;
732 /* Pass to the next element */
733 he = nextHe;
734 }
735 }
736 assert(ht->used == 0);
737 Jim_Free(ht->table);
738
739 /* Remap the new hashtable in the old */
740 *ht = n;
741 return JIM_OK;
742 }
743
744 /* Add an element to the target hash table */
745 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
746 {
747 int index;
748 Jim_HashEntry *entry;
749
750 /* Get the index of the new element, or -1 if
751 * the element already exists. */
752 if ((index = JimInsertHashEntry(ht, key)) == -1)
753 return JIM_ERR;
754
755 /* Allocates the memory and stores key */
756 entry = Jim_Alloc(sizeof(*entry));
757 entry->next = ht->table[index];
758 ht->table[index] = entry;
759
760 /* Set the hash entry fields. */
761 Jim_SetHashKey(ht, entry, key);
762 Jim_SetHashVal(ht, entry, val);
763 ht->used++;
764 return JIM_OK;
765 }
766
767 /* Add an element, discarding the old if the key already exists */
768 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
769 {
770 Jim_HashEntry *entry;
771
772 /* Try to add the element. If the key
773 * does not exists Jim_AddHashEntry will suceed. */
774 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
775 return JIM_OK;
776 /* It already exists, get the entry */
777 entry = Jim_FindHashEntry(ht, key);
778 /* Free the old value and set the new one */
779 Jim_FreeEntryVal(ht, entry);
780 Jim_SetHashVal(ht, entry, val);
781 return JIM_OK;
782 }
783
784 /* Search and remove an element */
785 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
786 {
787 unsigned int h;
788 Jim_HashEntry *he, *prevHe;
789
790 if (ht->size == 0)
791 return JIM_ERR;
792 h = Jim_HashKey(ht, key) & ht->sizemask;
793 he = ht->table[h];
794
795 prevHe = NULL;
796 while(he) {
797 if (Jim_CompareHashKeys(ht, key, he->key)) {
798 /* Unlink the element from the list */
799 if (prevHe)
800 prevHe->next = he->next;
801 else
802 ht->table[h] = he->next;
803 Jim_FreeEntryKey(ht, he);
804 Jim_FreeEntryVal(ht, he);
805 Jim_Free(he);
806 ht->used--;
807 return JIM_OK;
808 }
809 prevHe = he;
810 he = he->next;
811 }
812 return JIM_ERR; /* not found */
813 }
814
815 /* Destroy an entire hash table */
816 int Jim_FreeHashTable(Jim_HashTable *ht)
817 {
818 unsigned int i;
819
820 /* Free all the elements */
821 for (i = 0; i < ht->size && ht->used > 0; i++) {
822 Jim_HashEntry *he, *nextHe;
823
824 if ((he = ht->table[i]) == NULL) continue;
825 while(he) {
826 nextHe = he->next;
827 Jim_FreeEntryKey(ht, he);
828 Jim_FreeEntryVal(ht, he);
829 Jim_Free(he);
830 ht->used--;
831 he = nextHe;
832 }
833 }
834 /* Free the table and the allocated cache structure */
835 Jim_Free(ht->table);
836 /* Re-initialize the table */
837 JimResetHashTable(ht);
838 return JIM_OK; /* never fails */
839 }
840
841 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
842 {
843 Jim_HashEntry *he;
844 unsigned int h;
845
846 if (ht->size == 0) return NULL;
847 h = Jim_HashKey(ht, key) & ht->sizemask;
848 he = ht->table[h];
849 while(he) {
850 if (Jim_CompareHashKeys(ht, key, he->key))
851 return he;
852 he = he->next;
853 }
854 return NULL;
855 }
856
857 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
858 {
859 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
860
861 iter->ht = ht;
862 iter->index = -1;
863 iter->entry = NULL;
864 iter->nextEntry = NULL;
865 return iter;
866 }
867
868 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
869 {
870 while (1) {
871 if (iter->entry == NULL) {
872 iter->index++;
873 if (iter->index >=
874 (signed)iter->ht->size) break;
875 iter->entry = iter->ht->table[iter->index];
876 } else {
877 iter->entry = iter->nextEntry;
878 }
879 if (iter->entry) {
880 /* We need to save the 'next' here, the iterator user
881 * may delete the entry we are returning. */
882 iter->nextEntry = iter->entry->next;
883 return iter->entry;
884 }
885 }
886 return NULL;
887 }
888
889 /* ------------------------- private functions ------------------------------ */
890
891 /* Expand the hash table if needed */
892 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
893 {
894 /* If the hash table is empty expand it to the intial size,
895 * if the table is "full" dobule its size. */
896 if (ht->size == 0)
897 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
898 if (ht->size == ht->used)
899 return Jim_ExpandHashTable(ht, ht->size*2);
900 return JIM_OK;
901 }
902
903 /* Our hash table capability is a power of two */
904 static unsigned int JimHashTableNextPower(unsigned int size)
905 {
906 unsigned int i = JIM_HT_INITIAL_SIZE;
907
908 if (size >= 2147483648U)
909 return 2147483648U;
910 while(1) {
911 if (i >= size)
912 return i;
913 i *= 2;
914 }
915 }
916
917 /* Returns the index of a free slot that can be populated with
918 * an hash entry for the given 'key'.
919 * If the key already exists, -1 is returned. */
920 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
921 {
922 unsigned int h;
923 Jim_HashEntry *he;
924
925 /* Expand the hashtable if needed */
926 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
927 return -1;
928 /* Compute the key hash value */
929 h = Jim_HashKey(ht, key) & ht->sizemask;
930 /* Search if this slot does not already contain the given key */
931 he = ht->table[h];
932 while(he) {
933 if (Jim_CompareHashKeys(ht, key, he->key))
934 return -1;
935 he = he->next;
936 }
937 return h;
938 }
939
940 /* ----------------------- StringCopy Hash Table Type ------------------------*/
941
942 static unsigned int JimStringCopyHTHashFunction(const void *key)
943 {
944 return Jim_GenHashFunction(key, strlen(key));
945 }
946
947 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
948 {
949 int len = strlen(key);
950 char *copy = Jim_Alloc(len+1);
951 JIM_NOTUSED(privdata);
952
953 memcpy(copy, key, len);
954 copy[len] = '\0';
955 return copy;
956 }
957
958 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
959 {
960 int len = strlen(val);
961 char *copy = Jim_Alloc(len+1);
962 JIM_NOTUSED(privdata);
963
964 memcpy(copy, val, len);
965 copy[len] = '\0';
966 return copy;
967 }
968
969 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
970 const void *key2)
971 {
972 JIM_NOTUSED(privdata);
973
974 return strcmp(key1, key2) == 0;
975 }
976
977 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
978 {
979 JIM_NOTUSED(privdata);
980
981 Jim_Free((void*)key); /* ATTENTION: const cast */
982 }
983
984 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
985 {
986 JIM_NOTUSED(privdata);
987
988 Jim_Free((void*)val); /* ATTENTION: const cast */
989 }
990
991 static Jim_HashTableType JimStringCopyHashTableType = {
992 JimStringCopyHTHashFunction, /* hash function */
993 JimStringCopyHTKeyDup, /* key dup */
994 NULL, /* val dup */
995 JimStringCopyHTKeyCompare, /* key compare */
996 JimStringCopyHTKeyDestructor, /* key destructor */
997 NULL /* val destructor */
998 };
999
1000 /* This is like StringCopy but does not auto-duplicate the key.
1001 * It's used for intepreter's shared strings. */
1002 static Jim_HashTableType JimSharedStringsHashTableType = {
1003 JimStringCopyHTHashFunction, /* hash function */
1004 NULL, /* key dup */
1005 NULL, /* val dup */
1006 JimStringCopyHTKeyCompare, /* key compare */
1007 JimStringCopyHTKeyDestructor, /* key destructor */
1008 NULL /* val destructor */
1009 };
1010
1011 /* This is like StringCopy but also automatically handle dynamic
1012 * allocated C strings as values. */
1013 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1014 JimStringCopyHTHashFunction, /* hash function */
1015 JimStringCopyHTKeyDup, /* key dup */
1016 JimStringKeyValCopyHTValDup, /* val dup */
1017 JimStringCopyHTKeyCompare, /* key compare */
1018 JimStringCopyHTKeyDestructor, /* key destructor */
1019 JimStringKeyValCopyHTValDestructor, /* val destructor */
1020 };
1021
1022 typedef struct AssocDataValue {
1023 Jim_InterpDeleteProc *delProc;
1024 void *data;
1025 } AssocDataValue;
1026
1027 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1028 {
1029 AssocDataValue *assocPtr = (AssocDataValue *)data;
1030 if (assocPtr->delProc != NULL)
1031 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1032 Jim_Free(data);
1033 }
1034
1035 static Jim_HashTableType JimAssocDataHashTableType = {
1036 JimStringCopyHTHashFunction, /* hash function */
1037 JimStringCopyHTKeyDup, /* key dup */
1038 NULL, /* val dup */
1039 JimStringCopyHTKeyCompare, /* key compare */
1040 JimStringCopyHTKeyDestructor, /* key destructor */
1041 JimAssocDataHashTableValueDestructor /* val destructor */
1042 };
1043
1044 /* -----------------------------------------------------------------------------
1045 * Stack - This is a simple generic stack implementation. It is used for
1046 * example in the 'expr' expression compiler.
1047 * ---------------------------------------------------------------------------*/
1048 void Jim_InitStack(Jim_Stack *stack)
1049 {
1050 stack->len = 0;
1051 stack->maxlen = 0;
1052 stack->vector = NULL;
1053 }
1054
1055 void Jim_FreeStack(Jim_Stack *stack)
1056 {
1057 Jim_Free(stack->vector);
1058 }
1059
1060 int Jim_StackLen(Jim_Stack *stack)
1061 {
1062 return stack->len;
1063 }
1064
1065 void Jim_StackPush(Jim_Stack *stack, void *element) {
1066 int neededLen = stack->len+1;
1067 if (neededLen > stack->maxlen) {
1068 stack->maxlen = neededLen*2;
1069 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1070 }
1071 stack->vector[stack->len] = element;
1072 stack->len++;
1073 }
1074
1075 void *Jim_StackPop(Jim_Stack *stack)
1076 {
1077 if (stack->len == 0) return NULL;
1078 stack->len--;
1079 return stack->vector[stack->len];
1080 }
1081
1082 void *Jim_StackPeek(Jim_Stack *stack)
1083 {
1084 if (stack->len == 0) return NULL;
1085 return stack->vector[stack->len-1];
1086 }
1087
1088 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1089 {
1090 int i;
1091
1092 for (i = 0; i < stack->len; i++)
1093 freeFunc(stack->vector[i]);
1094 }
1095
1096 /* -----------------------------------------------------------------------------
1097 * Parser
1098 * ---------------------------------------------------------------------------*/
1099
1100 /* Token types */
1101 #define JIM_TT_NONE -1 /* No token returned */
1102 #define JIM_TT_STR 0 /* simple string */
1103 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1104 #define JIM_TT_VAR 2 /* var substitution */
1105 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1106 #define JIM_TT_CMD 4 /* command substitution */
1107 #define JIM_TT_SEP 5 /* word separator */
1108 #define JIM_TT_EOL 6 /* line separator */
1109
1110 /* Additional token types needed for expressions */
1111 #define JIM_TT_SUBEXPR_START 7
1112 #define JIM_TT_SUBEXPR_END 8
1113 #define JIM_TT_EXPR_NUMBER 9
1114 #define JIM_TT_EXPR_OPERATOR 10
1115
1116 /* Parser states */
1117 #define JIM_PS_DEF 0 /* Default state */
1118 #define JIM_PS_QUOTE 1 /* Inside "" */
1119
1120 /* Parser context structure. The same context is used both to parse
1121 * Tcl scripts and lists. */
1122 struct JimParserCtx {
1123 const char *prg; /* Program text */
1124 const char *p; /* Pointer to the point of the program we are parsing */
1125 int len; /* Left length of 'prg' */
1126 int linenr; /* Current line number */
1127 const char *tstart;
1128 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1129 int tline; /* Line number of the returned token */
1130 int tt; /* Token type */
1131 int eof; /* Non zero if EOF condition is true. */
1132 int state; /* Parser state */
1133 int comment; /* Non zero if the next chars may be a comment. */
1134 };
1135
1136 #define JimParserEof(c) ((c)->eof)
1137 #define JimParserTstart(c) ((c)->tstart)
1138 #define JimParserTend(c) ((c)->tend)
1139 #define JimParserTtype(c) ((c)->tt)
1140 #define JimParserTline(c) ((c)->tline)
1141
1142 static int JimParseScript(struct JimParserCtx *pc);
1143 static int JimParseSep(struct JimParserCtx *pc);
1144 static int JimParseEol(struct JimParserCtx *pc);
1145 static int JimParseCmd(struct JimParserCtx *pc);
1146 static int JimParseVar(struct JimParserCtx *pc);
1147 static int JimParseBrace(struct JimParserCtx *pc);
1148 static int JimParseStr(struct JimParserCtx *pc);
1149 static int JimParseComment(struct JimParserCtx *pc);
1150 static char *JimParserGetToken(struct JimParserCtx *pc,
1151 int *lenPtr, int *typePtr, int *linePtr);
1152
1153 /* Initialize a parser context.
1154 * 'prg' is a pointer to the program text, linenr is the line
1155 * number of the first line contained in the program. */
1156 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1157 int len, int linenr)
1158 {
1159 pc->prg = prg;
1160 pc->p = prg;
1161 pc->len = len;
1162 pc->tstart = NULL;
1163 pc->tend = NULL;
1164 pc->tline = 0;
1165 pc->tt = JIM_TT_NONE;
1166 pc->eof = 0;
1167 pc->state = JIM_PS_DEF;
1168 pc->linenr = linenr;
1169 pc->comment = 1;
1170 }
1171
1172 int JimParseScript(struct JimParserCtx *pc)
1173 {
1174 while(1) { /* the while is used to reiterate with continue if needed */
1175 if (!pc->len) {
1176 pc->tstart = pc->p;
1177 pc->tend = pc->p-1;
1178 pc->tline = pc->linenr;
1179 pc->tt = JIM_TT_EOL;
1180 pc->eof = 1;
1181 return JIM_OK;
1182 }
1183 switch(*(pc->p)) {
1184 case '\\':
1185 if (*(pc->p+1) == '\n')
1186 return JimParseSep(pc);
1187 else {
1188 pc->comment = 0;
1189 return JimParseStr(pc);
1190 }
1191 break;
1192 case ' ':
1193 case '\t':
1194 case '\r':
1195 if (pc->state == JIM_PS_DEF)
1196 return JimParseSep(pc);
1197 else {
1198 pc->comment = 0;
1199 return JimParseStr(pc);
1200 }
1201 break;
1202 case '\n':
1203 case ';':
1204 pc->comment = 1;
1205 if (pc->state == JIM_PS_DEF)
1206 return JimParseEol(pc);
1207 else
1208 return JimParseStr(pc);
1209 break;
1210 case '[':
1211 pc->comment = 0;
1212 return JimParseCmd(pc);
1213 break;
1214 case '$':
1215 pc->comment = 0;
1216 if (JimParseVar(pc) == JIM_ERR) {
1217 pc->tstart = pc->tend = pc->p++; pc->len--;
1218 pc->tline = pc->linenr;
1219 pc->tt = JIM_TT_STR;
1220 return JIM_OK;
1221 } else
1222 return JIM_OK;
1223 break;
1224 case '#':
1225 if (pc->comment) {
1226 JimParseComment(pc);
1227 continue;
1228 } else {
1229 return JimParseStr(pc);
1230 }
1231 default:
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 break;
1235 }
1236 return JIM_OK;
1237 }
1238 }
1239
1240 int JimParseSep(struct JimParserCtx *pc)
1241 {
1242 pc->tstart = pc->p;
1243 pc->tline = pc->linenr;
1244 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1245 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1246 if (*pc->p == '\\') {
1247 pc->p++; pc->len--;
1248 pc->linenr++;
1249 }
1250 pc->p++; pc->len--;
1251 }
1252 pc->tend = pc->p-1;
1253 pc->tt = JIM_TT_SEP;
1254 return JIM_OK;
1255 }
1256
1257 int JimParseEol(struct JimParserCtx *pc)
1258 {
1259 pc->tstart = pc->p;
1260 pc->tline = pc->linenr;
1261 while (*pc->p == ' ' || *pc->p == '\n' ||
1262 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1263 if (*pc->p == '\n')
1264 pc->linenr++;
1265 pc->p++; pc->len--;
1266 }
1267 pc->tend = pc->p-1;
1268 pc->tt = JIM_TT_EOL;
1269 return JIM_OK;
1270 }
1271
1272 /* Todo. Don't stop if ']' appears inside {} or quoted.
1273 * Also should handle the case of puts [string length "]"] */
1274 int JimParseCmd(struct JimParserCtx *pc)
1275 {
1276 int level = 1;
1277 int blevel = 0;
1278
1279 pc->tstart = ++pc->p; pc->len--;
1280 pc->tline = pc->linenr;
1281 while (1) {
1282 if (pc->len == 0) {
1283 break;
1284 } else if (*pc->p == '[' && blevel == 0) {
1285 level++;
1286 } else if (*pc->p == ']' && blevel == 0) {
1287 level--;
1288 if (!level) break;
1289 } else if (*pc->p == '\\') {
1290 pc->p++; pc->len--;
1291 } else if (*pc->p == '{') {
1292 blevel++;
1293 } else if (*pc->p == '}') {
1294 if (blevel != 0)
1295 blevel--;
1296 } else if (*pc->p == '\n')
1297 pc->linenr++;
1298 pc->p++; pc->len--;
1299 }
1300 pc->tend = pc->p-1;
1301 pc->tt = JIM_TT_CMD;
1302 if (*pc->p == ']') {
1303 pc->p++; pc->len--;
1304 }
1305 return JIM_OK;
1306 }
1307
1308 int JimParseVar(struct JimParserCtx *pc)
1309 {
1310 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1311
1312 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1313 pc->tline = pc->linenr;
1314 if (*pc->p == '{') {
1315 pc->tstart = ++pc->p; pc->len--;
1316 brace = 1;
1317 }
1318 if (brace) {
1319 while (!stop) {
1320 if (*pc->p == '}' || pc->len == 0) {
1321 pc->tend = pc->p-1;
1322 stop = 1;
1323 if (pc->len == 0)
1324 break;
1325 }
1326 else if (*pc->p == '\n')
1327 pc->linenr++;
1328 pc->p++; pc->len--;
1329 }
1330 } else {
1331 /* Include leading colons */
1332 while (*pc->p == ':') {
1333 pc->p++;
1334 pc->len--;
1335 }
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;
2196 int i;
2197 if (strObjPtr->typePtr != &stringObjType) {
2198 SetStringFromAny(interp, strObjPtr);
2199 }
2200
2201 buf = Jim_Alloc(strObjPtr->length+1);
2202
2203 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2204 for (i = 0; i < strObjPtr->length; i++)
2205 buf[i] = tolower(buf[i]);
2206 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2207 }
2208
2209 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2210 {
2211 char *buf;
2212 int i;
2213 if (strObjPtr->typePtr != &stringObjType) {
2214 SetStringFromAny(interp, strObjPtr);
2215 }
2216
2217 buf = Jim_Alloc(strObjPtr->length+1);
2218
2219 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2220 for (i = 0; i < strObjPtr->length; i++)
2221 buf[i] = toupper(buf[i]);
2222 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2223 }
2224
2225 /* This is the core of the [format] command.
2226 * TODO: Lots of things work - via a hack
2227 * However, no format item can be >= JIM_MAX_FMT
2228 */
2229 #define JIM_MAX_FMT 2048
2230 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2231 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2232 {
2233 const char *fmt, *_fmt;
2234 int fmtLen;
2235 Jim_Obj *resObjPtr;
2236
2237
2238 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2239 _fmt = fmt;
2240 resObjPtr = Jim_NewStringObj(interp, "", 0);
2241 while (fmtLen) {
2242 const char *p = fmt;
2243 char spec[2], c;
2244 jim_wide wideValue;
2245 double doubleValue;
2246 /* we cheat and use Sprintf()! */
2247 char fmt_str[100];
2248 char *cp;
2249 int width;
2250 int ljust;
2251 int zpad;
2252 int spad;
2253 int altfm;
2254 int forceplus;
2255 int prec;
2256 int inprec;
2257 int haveprec;
2258 int accum;
2259
2260 while (*fmt != '%' && fmtLen) {
2261 fmt++; fmtLen--;
2262 }
2263 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2264 if (fmtLen == 0)
2265 break;
2266 fmt++; fmtLen--; /* skip '%' */
2267 zpad = 0;
2268 spad = 0;
2269 width = -1;
2270 ljust = 0;
2271 altfm = 0;
2272 forceplus = 0;
2273 inprec = 0;
2274 haveprec = 0;
2275 prec = -1; /* not found yet */
2276 next_fmt:
2277 if( fmtLen <= 0 ){
2278 break;
2279 }
2280 switch( *fmt ){
2281 /* terminals */
2282 case 'b': /* binary - not all printfs() do this */
2283 case 's': /* string */
2284 case 'i': /* integer */
2285 case 'd': /* decimal */
2286 case 'x': /* hex */
2287 case 'X': /* CAP hex */
2288 case 'c': /* char */
2289 case 'o': /* octal */
2290 case 'u': /* unsigned */
2291 case 'f': /* float */
2292 break;
2293
2294 /* non-terminals */
2295 case '0': /* zero pad */
2296 zpad = 1;
2297 fmt++; fmtLen--;
2298 goto next_fmt;
2299 break;
2300 case '+':
2301 forceplus = 1;
2302 fmt++; fmtLen--;
2303 goto next_fmt;
2304 break;
2305 case ' ': /* sign space */
2306 spad = 1;
2307 fmt++; fmtLen--;
2308 goto next_fmt;
2309 break;
2310 case '-':
2311 ljust = 1;
2312 fmt++; fmtLen--;
2313 goto next_fmt;
2314 break;
2315 case '#':
2316 altfm = 1;
2317 fmt++; fmtLen--;
2318 goto next_fmt;
2319
2320 case '.':
2321 inprec = 1;
2322 fmt++; fmtLen--;
2323 goto next_fmt;
2324 break;
2325 case '1':
2326 case '2':
2327 case '3':
2328 case '4':
2329 case '5':
2330 case '6':
2331 case '7':
2332 case '8':
2333 case '9':
2334 accum = 0;
2335 while( isdigit(*fmt) && (fmtLen > 0) ){
2336 accum = (accum * 10) + (*fmt - '0');
2337 fmt++; fmtLen--;
2338 }
2339 if( inprec ){
2340 haveprec = 1;
2341 prec = accum;
2342 } else {
2343 width = accum;
2344 }
2345 goto next_fmt;
2346 case '*':
2347 /* suck up the next item as an integer */
2348 fmt++; fmtLen--;
2349 objc--;
2350 if( objc <= 0 ){
2351 goto not_enough_args;
2352 }
2353 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2354 Jim_FreeNewObj(interp, resObjPtr );
2355 return NULL;
2356 }
2357 if( inprec ){
2358 haveprec = 1;
2359 prec = wideValue;
2360 if( prec < 0 ){
2361 /* man 3 printf says */
2362 /* if prec is negative, it is zero */
2363 prec = 0;
2364 }
2365 } else {
2366 width = wideValue;
2367 if( width < 0 ){
2368 ljust = 1;
2369 width = -width;
2370 }
2371 }
2372 objv++;
2373 goto next_fmt;
2374 break;
2375 }
2376
2377
2378 if (*fmt != '%') {
2379 if (objc == 0) {
2380 not_enough_args:
2381 Jim_FreeNewObj(interp, resObjPtr);
2382 Jim_SetResultString(interp,
2383 "not enough arguments for all format specifiers", -1);
2384 return NULL;
2385 } else {
2386 objc--;
2387 }
2388 }
2389
2390 /*
2391 * Create the formatter
2392 * cause we cheat and use sprintf()
2393 */
2394 cp = fmt_str;
2395 *cp++ = '%';
2396 if( altfm ){
2397 *cp++ = '#';
2398 }
2399 if( forceplus ){
2400 *cp++ = '+';
2401 } else if( spad ){
2402 /* PLUS overrides */
2403 *cp++ = ' ';
2404 }
2405 if( ljust ){
2406 *cp++ = '-';
2407 }
2408 if( zpad ){
2409 *cp++ = '0';
2410 }
2411 if( width > 0 ){
2412 sprintf( cp, "%d", width );
2413 /* skip ahead */
2414 cp = strchr(cp,0);
2415 }
2416 /* did we find a period? */
2417 if( inprec ){
2418 /* then add it */
2419 *cp++ = '.';
2420 /* did something occur after the period? */
2421 if( haveprec ){
2422 sprintf( cp, "%d", prec );
2423 }
2424 cp = strchr(cp,0);
2425 }
2426 *cp = 0;
2427
2428 /* here we do the work */
2429 /* actually - we make sprintf() do it for us */
2430 switch(*fmt) {
2431 case 's':
2432 *cp++ = 's';
2433 *cp = 0;
2434 /* BUG: we do not handled embeded NULLs */
2435 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2436 break;
2437 case 'c':
2438 *cp++ = 'c';
2439 *cp = 0;
2440 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2441 Jim_FreeNewObj(interp, resObjPtr);
2442 return NULL;
2443 }
2444 c = (char) wideValue;
2445 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2446 break;
2447 case 'f':
2448 case 'F':
2449 case 'g':
2450 case 'G':
2451 case 'e':
2452 case 'E':
2453 *cp++ = *fmt;
2454 *cp = 0;
2455 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2456 Jim_FreeNewObj( interp, resObjPtr );
2457 return NULL;
2458 }
2459 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2460 break;
2461 case 'b':
2462 case 'd':
2463 case 'o':
2464 case 'i':
2465 case 'u':
2466 case 'x':
2467 case 'X':
2468 /* jim widevaluse are 64bit */
2469 if( sizeof(jim_wide) == sizeof(long long) ){
2470 *cp++ = 'l';
2471 *cp++ = 'l';
2472 } else {
2473 *cp++ = 'l';
2474 }
2475 *cp++ = *fmt;
2476 *cp = 0;
2477 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2478 Jim_FreeNewObj(interp, resObjPtr);
2479 return NULL;
2480 }
2481 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2482 break;
2483 case '%':
2484 sprintf_buf[0] = '%';
2485 sprintf_buf[1] = 0;
2486 objv--; /* undo the objv++ below */
2487 break;
2488 default:
2489 spec[0] = *fmt; spec[1] = '\0';
2490 Jim_FreeNewObj(interp, resObjPtr);
2491 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2492 Jim_AppendStrings(interp, Jim_GetResult(interp),
2493 "bad field specifier \"", spec, "\"", NULL);
2494 return NULL;
2495 }
2496 /* force terminate */
2497 #if 0
2498 printf("FMT was: %s\n", fmt_str );
2499 printf("RES was: |%s|\n", sprintf_buf );
2500 #endif
2501
2502 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2503 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2504 /* next obj */
2505 objv++;
2506 fmt++;
2507 fmtLen--;
2508 }
2509 return resObjPtr;
2510 }
2511
2512 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2513 int objc, Jim_Obj *const *objv)
2514 {
2515 char *sprintf_buf=malloc(JIM_MAX_FMT);
2516 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2517 free(sprintf_buf);
2518 return t;
2519 }
2520
2521 /* -----------------------------------------------------------------------------
2522 * Compared String Object
2523 * ---------------------------------------------------------------------------*/
2524
2525 /* This is strange object that allows to compare a C literal string
2526 * with a Jim object in very short time if the same comparison is done
2527 * multiple times. For example every time the [if] command is executed,
2528 * Jim has to check if a given argument is "else". This comparions if
2529 * the code has no errors are true most of the times, so we can cache
2530 * inside the object the pointer of the string of the last matching
2531 * comparison. Because most C compilers perform literal sharing,
2532 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2533 * this works pretty well even if comparisons are at different places
2534 * inside the C code. */
2535
2536 static Jim_ObjType comparedStringObjType = {
2537 "compared-string",
2538 NULL,
2539 NULL,
2540 NULL,
2541 JIM_TYPE_REFERENCES,
2542 };
2543
2544 /* The only way this object is exposed to the API is via the following
2545 * function. Returns true if the string and the object string repr.
2546 * are the same, otherwise zero is returned.
2547 *
2548 * Note: this isn't binary safe, but it hardly needs to be.*/
2549 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2550 const char *str)
2551 {
2552 if (objPtr->typePtr == &comparedStringObjType &&
2553 objPtr->internalRep.ptr == str)
2554 return 1;
2555 else {
2556 const char *objStr = Jim_GetString(objPtr, NULL);
2557 if (strcmp(str, objStr) != 0) return 0;
2558 if (objPtr->typePtr != &comparedStringObjType) {
2559 Jim_FreeIntRep(interp, objPtr);
2560 objPtr->typePtr = &comparedStringObjType;
2561 }
2562 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2563 return 1;
2564 }
2565 }
2566
2567 int qsortCompareStringPointers(const void *a, const void *b)
2568 {
2569 char * const *sa = (char * const *)a;
2570 char * const *sb = (char * const *)b;
2571 return strcmp(*sa, *sb);
2572 }
2573
2574 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2575 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2576 {
2577 const char * const *entryPtr = NULL;
2578 char **tablePtrSorted;
2579 int i, count = 0;
2580
2581 *indexPtr = -1;
2582 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2583 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2584 *indexPtr = i;
2585 return JIM_OK;
2586 }
2587 count++; /* If nothing matches, this will reach the len of tablePtr */
2588 }
2589 if (flags & JIM_ERRMSG) {
2590 if (name == NULL)
2591 name = "option";
2592 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2593 Jim_AppendStrings(interp, Jim_GetResult(interp),
2594 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2595 NULL);
2596 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2597 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2598 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2599 for (i = 0; i < count; i++) {
2600 if (i+1 == count && count > 1)
2601 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2602 Jim_AppendString(interp, Jim_GetResult(interp),
2603 tablePtrSorted[i], -1);
2604 if (i+1 != count)
2605 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2606 }
2607 Jim_Free(tablePtrSorted);
2608 }
2609 return JIM_ERR;
2610 }
2611
2612 int Jim_GetNvp(Jim_Interp *interp,
2613 Jim_Obj *objPtr,
2614 const Jim_Nvp *nvp_table,
2615 const Jim_Nvp ** result)
2616 {
2617 Jim_Nvp *n;
2618 int e;
2619
2620 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2621 if( e == JIM_ERR ){
2622 return e;
2623 }
2624
2625 /* Success? found? */
2626 if( n->name ){
2627 /* remove const */
2628 *result = (Jim_Nvp *)n;
2629 return JIM_OK;
2630 } else {
2631 return JIM_ERR;
2632 }
2633 }
2634
2635 /* -----------------------------------------------------------------------------
2636 * Source Object
2637 *
2638 * This object is just a string from the language point of view, but
2639 * in the internal representation it contains the filename and line number
2640 * where this given token was read. This information is used by
2641 * Jim_EvalObj() if the object passed happens to be of type "source".
2642 *
2643 * This allows to propagate the information about line numbers and file
2644 * names and give error messages with absolute line numbers.
2645 *
2646 * Note that this object uses shared strings for filenames, and the
2647 * pointer to the filename together with the line number is taken into
2648 * the space for the "inline" internal represenation of the Jim_Object,
2649 * so there is almost memory zero-overhead.
2650 *
2651 * Also the object will be converted to something else if the given
2652 * token it represents in the source file is not something to be
2653 * evaluated (not a script), and will be specialized in some other way,
2654 * so the time overhead is alzo null.
2655 * ---------------------------------------------------------------------------*/
2656
2657 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2658 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2659
2660 static Jim_ObjType sourceObjType = {
2661 "source",
2662 FreeSourceInternalRep,
2663 DupSourceInternalRep,
2664 NULL,
2665 JIM_TYPE_REFERENCES,
2666 };
2667
2668 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2669 {
2670 Jim_ReleaseSharedString(interp,
2671 objPtr->internalRep.sourceValue.fileName);
2672 }
2673
2674 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2675 {
2676 dupPtr->internalRep.sourceValue.fileName =
2677 Jim_GetSharedString(interp,
2678 srcPtr->internalRep.sourceValue.fileName);
2679 dupPtr->internalRep.sourceValue.lineNumber =
2680 dupPtr->internalRep.sourceValue.lineNumber;
2681 dupPtr->typePtr = &sourceObjType;
2682 }
2683
2684 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2685 const char *fileName, int lineNumber)
2686 {
2687 if (Jim_IsShared(objPtr))
2688 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2689 if (objPtr->typePtr != NULL)
2690 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2691 objPtr->internalRep.sourceValue.fileName =
2692 Jim_GetSharedString(interp, fileName);
2693 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2694 objPtr->typePtr = &sourceObjType;
2695 }
2696
2697 /* -----------------------------------------------------------------------------
2698 * Script Object
2699 * ---------------------------------------------------------------------------*/
2700
2701 #define JIM_CMDSTRUCT_EXPAND -1
2702
2703 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2704 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2705 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2706
2707 static Jim_ObjType scriptObjType = {
2708 "script",
2709 FreeScriptInternalRep,
2710 DupScriptInternalRep,
2711 NULL,
2712 JIM_TYPE_REFERENCES,
2713 };
2714
2715 /* The ScriptToken structure represents every token into a scriptObj.
2716 * Every token contains an associated Jim_Obj that can be specialized
2717 * by commands operating on it. */
2718 typedef struct ScriptToken {
2719 int type;
2720 Jim_Obj *objPtr;
2721 int linenr;
2722 } ScriptToken;
2723
2724 /* This is the script object internal representation. An array of
2725 * ScriptToken structures, with an associated command structure array.
2726 * The command structure is a pre-computed representation of the
2727 * command length and arguments structure as a simple liner array
2728 * of integers.
2729 *
2730 * For example the script:
2731 *
2732 * puts hello
2733 * set $i $x$y [foo]BAR
2734 *
2735 * will produce a ScriptObj with the following Tokens:
2736 *
2737 * ESC puts
2738 * SEP
2739 * ESC hello
2740 * EOL
2741 * ESC set
2742 * EOL
2743 * VAR i
2744 * SEP
2745 * VAR x
2746 * VAR y
2747 * SEP
2748 * CMD foo
2749 * ESC BAR
2750 * EOL
2751 *
2752 * This is a description of the tokens, separators, and of lines.
2753 * The command structure instead represents the number of arguments
2754 * of every command, followed by the tokens of which every argument
2755 * is composed. So for the example script, the cmdstruct array will
2756 * contain:
2757 *
2758 * 2 1 1 4 1 1 2 2
2759 *
2760 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2761 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2762 * composed of single tokens (1 1) and the last two of double tokens
2763 * (2 2).
2764 *
2765 * The precomputation of the command structure makes Jim_Eval() faster,
2766 * and simpler because there aren't dynamic lengths / allocations.
2767 *
2768 * -- {expand} handling --
2769 *
2770 * Expand is handled in a special way. When a command
2771 * contains at least an argument with the {expand} prefix,
2772 * the command structure presents a -1 before the integer
2773 * describing the number of arguments. This is used in order
2774 * to send the command exection to a different path in case
2775 * of {expand} and guarantee a fast path for the more common
2776 * case. Also, the integers describing the number of tokens
2777 * are expressed with negative sign, to allow for fast check
2778 * of what's an {expand}-prefixed argument and what not.
2779 *
2780 * For example the command:
2781 *
2782 * list {expand}{1 2}
2783 *
2784 * Will produce the following cmdstruct array:
2785 *
2786 * -1 2 1 -2
2787 *
2788 * -- the substFlags field of the structure --
2789 *
2790 * The scriptObj structure is used to represent both "script" objects
2791 * and "subst" objects. In the second case, the cmdStruct related
2792 * fields are not used at all, but there is an additional field used
2793 * that is 'substFlags': this represents the flags used to turn
2794 * the string into the intenral representation used to perform the
2795 * substitution. If this flags are not what the application requires
2796 * the scriptObj is created again. For example the script:
2797 *
2798 * subst -nocommands $string
2799 * subst -novariables $string
2800 *
2801 * Will recreate the internal representation of the $string object
2802 * two times.
2803 */
2804 typedef struct ScriptObj {
2805 int len; /* Length as number of tokens. */
2806 int commands; /* number of top-level commands in script. */
2807 ScriptToken *token; /* Tokens array. */
2808 int *cmdStruct; /* commands structure */
2809 int csLen; /* length of the cmdStruct array. */
2810 int substFlags; /* flags used for the compilation of "subst" objects */
2811 int inUse; /* Used to share a ScriptObj. Currently
2812 only used by Jim_EvalObj() as protection against
2813 shimmering of the currently evaluated object. */
2814 char *fileName;
2815 } ScriptObj;
2816
2817 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2818 {
2819 int i;
2820 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2821
2822 script->inUse--;
2823 if (script->inUse != 0) return;
2824 for (i = 0; i < script->len; i++) {
2825 if (script->token[i].objPtr != NULL)
2826 Jim_DecrRefCount(interp, script->token[i].objPtr);
2827 }
2828 Jim_Free(script->token);
2829 Jim_Free(script->cmdStruct);
2830 Jim_Free(script->fileName);
2831 Jim_Free(script);
2832 }
2833
2834 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2835 {
2836 JIM_NOTUSED(interp);
2837 JIM_NOTUSED(srcPtr);
2838
2839 /* Just returns an simple string. */
2840 dupPtr->typePtr = NULL;
2841 }
2842
2843 /* Add a new token to the internal repr of a script object */
2844 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2845 char *strtoken, int len, int type, char *filename, int linenr)
2846 {
2847 int prevtype;
2848 struct ScriptToken *token;
2849
2850 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2851 script->token[script->len-1].type;
2852 /* Skip tokens without meaning, like words separators
2853 * following a word separator or an end of command and
2854 * so on. */
2855 if (prevtype == JIM_TT_EOL) {
2856 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2857 Jim_Free(strtoken);
2858 return;
2859 }
2860 } else if (prevtype == JIM_TT_SEP) {
2861 if (type == JIM_TT_SEP) {
2862 Jim_Free(strtoken);
2863 return;
2864 } else if (type == JIM_TT_EOL) {
2865 /* If an EOL is following by a SEP, drop the previous
2866 * separator. */
2867 script->len--;
2868 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2869 }
2870 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2871 type == JIM_TT_ESC && len == 0)
2872 {
2873 /* Don't add empty tokens used in interpolation */
2874 Jim_Free(strtoken);
2875 return;
2876 }
2877 /* Make space for a new istruction */
2878 script->len++;
2879 script->token = Jim_Realloc(script->token,
2880 sizeof(ScriptToken)*script->len);
2881 /* Initialize the new token */
2882 token = script->token+(script->len-1);
2883 token->type = type;
2884 /* Every object is intially as a string, but the
2885 * internal type may be specialized during execution of the
2886 * script. */
2887 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2888 /* To add source info to SEP and EOL tokens is useless because
2889 * they will never by called as arguments of Jim_EvalObj(). */
2890 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2891 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2892 Jim_IncrRefCount(token->objPtr);
2893 token->linenr = linenr;
2894 }
2895
2896 /* Add an integer into the command structure field of the script object. */
2897 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2898 {
2899 script->csLen++;
2900 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2901 sizeof(int)*script->csLen);
2902 script->cmdStruct[script->csLen-1] = val;
2903 }
2904
2905 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2906 * of objPtr. Search nested script objects recursively. */
2907 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2908 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2909 {
2910 int i;
2911
2912 for (i = 0; i < script->len; i++) {
2913 if (script->token[i].objPtr != objPtr &&
2914 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2915 return script->token[i].objPtr;
2916 }
2917 /* Enter recursively on scripts only if the object
2918 * is not the same as the one we are searching for
2919 * shared occurrences. */
2920 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2921 script->token[i].objPtr != objPtr) {
2922 Jim_Obj *foundObjPtr;
2923
2924 ScriptObj *subScript =
2925 script->token[i].objPtr->internalRep.ptr;
2926 /* Don't recursively enter the script we are trying
2927 * to make shared to avoid circular references. */
2928 if (subScript == scriptBarrier) continue;
2929 if (subScript != script) {
2930 foundObjPtr =
2931 ScriptSearchLiteral(interp, subScript,
2932 scriptBarrier, objPtr);
2933 if (foundObjPtr != NULL)
2934 return foundObjPtr;
2935 }
2936 }
2937 }
2938 return NULL;
2939 }
2940
2941 /* Share literals of a script recursively sharing sub-scripts literals. */
2942 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2943 ScriptObj *topLevelScript)
2944 {
2945 int i, j;
2946
2947 return;
2948 /* Try to share with toplevel object. */
2949 if (topLevelScript != NULL) {
2950 for (i = 0; i < script->len; i++) {
2951 Jim_Obj *foundObjPtr;
2952 char *str = script->token[i].objPtr->bytes;
2953
2954 if (script->token[i].objPtr->refCount != 1) continue;
2955 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2956 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2957 foundObjPtr = ScriptSearchLiteral(interp,
2958 topLevelScript,
2959 script, /* barrier */
2960 script->token[i].objPtr);
2961 if (foundObjPtr != NULL) {
2962 Jim_IncrRefCount(foundObjPtr);
2963 Jim_DecrRefCount(interp,
2964 script->token[i].objPtr);
2965 script->token[i].objPtr = foundObjPtr;
2966 }
2967 }
2968 }
2969 /* Try to share locally */
2970 for (i = 0; i < script->len; i++) {
2971 char *str = script->token[i].objPtr->bytes;
2972
2973 if (script->token[i].objPtr->refCount != 1) continue;
2974 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2975 for (j = 0; j < script->len; j++) {
2976 if (script->token[i].objPtr !=
2977 script->token[j].objPtr &&
2978 Jim_StringEqObj(script->token[i].objPtr,
2979 script->token[j].objPtr, 0))
2980 {
2981 Jim_IncrRefCount(script->token[j].objPtr);
2982 Jim_DecrRefCount(interp,
2983 script->token[i].objPtr);
2984 script->token[i].objPtr =
2985 script->token[j].objPtr;
2986 }
2987 }
2988 }
2989 }
2990
2991 /* This method takes the string representation of an object
2992 * as a Tcl script, and generates the pre-parsed internal representation
2993 * of the script. */
2994 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2995 {
2996 int scriptTextLen;
2997 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
2998 struct JimParserCtx parser;
2999 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3000 ScriptToken *token;
3001 int args, tokens, start, end, i;
3002 int initialLineNumber;
3003 int propagateSourceInfo = 0;
3004
3005 script->len = 0;
3006 script->csLen = 0;
3007 script->commands = 0;
3008 script->token = NULL;
3009 script->cmdStruct = NULL;
3010 script->inUse = 1;
3011 /* Try to get information about filename / line number */
3012 if (objPtr->typePtr == &sourceObjType) {
3013 script->fileName =
3014 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3015 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3016 propagateSourceInfo = 1;
3017 } else {
3018 script->fileName = Jim_StrDup("");
3019 initialLineNumber = 1;
3020 }
3021
3022 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3023 while(!JimParserEof(&parser)) {
3024 char *token;
3025 int len, type, linenr;
3026
3027 JimParseScript(&parser);
3028 token = JimParserGetToken(&parser, &len, &type, &linenr);
3029 ScriptObjAddToken(interp, script, token, len, type,
3030 propagateSourceInfo ? script->fileName : NULL,
3031 linenr);
3032 }
3033 token = script->token;
3034
3035 /* Compute the command structure array
3036 * (see the ScriptObj struct definition for more info) */
3037 start = 0; /* Current command start token index */
3038 end = -1; /* Current command end token index */
3039 while (1) {
3040 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3041 int interpolation = 0; /* set to 1 if there is at least one
3042 argument of the command obtained via
3043 interpolation of more tokens. */
3044 /* Search for the end of command, while
3045 * count the number of args. */
3046 start = ++end;
3047 if (start >= script->len) break;
3048 args = 1; /* Number of args in current command */
3049 while (token[end].type != JIM_TT_EOL) {
3050 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3051 token[end-1].type == JIM_TT_EOL)
3052 {
3053 if (token[end].type == JIM_TT_STR &&
3054 token[end+1].type != JIM_TT_SEP &&
3055 token[end+1].type != JIM_TT_EOL &&
3056 (!strcmp(token[end].objPtr->bytes, "expand") ||
3057 !strcmp(token[end].objPtr->bytes, "*")))
3058 expand++;
3059 }
3060 if (token[end].type == JIM_TT_SEP)
3061 args++;
3062 end++;
3063 }
3064 interpolation = !((end-start+1) == args*2);
3065 /* Add the 'number of arguments' info into cmdstruct.
3066 * Negative value if there is list expansion involved. */
3067 if (expand)
3068 ScriptObjAddInt(script, -1);
3069 ScriptObjAddInt(script, args);
3070 /* Now add info about the number of tokens. */
3071 tokens = 0; /* Number of tokens in current argument. */
3072 expand = 0;
3073 for (i = start; i <= end; i++) {
3074 if (token[i].type == JIM_TT_SEP ||
3075 token[i].type == JIM_TT_EOL)
3076 {
3077 if (tokens == 1 && expand)
3078 expand = 0;
3079 ScriptObjAddInt(script,
3080 expand ? -tokens : tokens);
3081
3082 expand = 0;
3083 tokens = 0;
3084 continue;
3085 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3086 (!strcmp(token[i].objPtr->bytes, "expand") ||
3087 !strcmp(token[i].objPtr->bytes, "*")))
3088 {
3089 expand++;
3090 }
3091 tokens++;
3092 }
3093 }
3094 /* Perform literal sharing, but only for objects that appear
3095 * to be scripts written as literals inside the source code,
3096 * and not computed at runtime. Literal sharing is a costly
3097 * operation that should be done only against objects that
3098 * are likely to require compilation only the first time, and
3099 * then are executed multiple times. */
3100 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3101 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3102 if (bodyObjPtr->typePtr == &scriptObjType) {
3103 ScriptObj *bodyScript =
3104 bodyObjPtr->internalRep.ptr;
3105 ScriptShareLiterals(interp, script, bodyScript);
3106 }
3107 } else if (propagateSourceInfo) {
3108 ScriptShareLiterals(interp, script, NULL);
3109 }
3110 /* Free the old internal rep and set the new one. */
3111 Jim_FreeIntRep(interp, objPtr);
3112 Jim_SetIntRepPtr(objPtr, script);
3113 objPtr->typePtr = &scriptObjType;
3114 return JIM_OK;
3115 }
3116
3117 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3118 {
3119 if (objPtr->typePtr != &scriptObjType) {
3120 SetScriptFromAny(interp, objPtr);
3121 }
3122 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3123 }
3124
3125 /* -----------------------------------------------------------------------------
3126 * Commands
3127 * ---------------------------------------------------------------------------*/
3128
3129 /* Commands HashTable Type.
3130 *
3131 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3132 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3133 {
3134 Jim_Cmd *cmdPtr = (void*) val;
3135
3136 if (cmdPtr->cmdProc == NULL) {
3137 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3138 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3139 if (cmdPtr->staticVars) {
3140 Jim_FreeHashTable(cmdPtr->staticVars);
3141 Jim_Free(cmdPtr->staticVars);
3142 }
3143 } else if (cmdPtr->delProc != NULL) {
3144 /* If it was a C coded command, call the delProc if any */
3145 cmdPtr->delProc(interp, cmdPtr->privData);
3146 }
3147 Jim_Free(val);
3148 }
3149
3150 static Jim_HashTableType JimCommandsHashTableType = {
3151 JimStringCopyHTHashFunction, /* hash function */
3152 JimStringCopyHTKeyDup, /* key dup */
3153 NULL, /* val dup */
3154 JimStringCopyHTKeyCompare, /* key compare */
3155 JimStringCopyHTKeyDestructor, /* key destructor */
3156 Jim_CommandsHT_ValDestructor /* val destructor */
3157 };
3158
3159 /* ------------------------- Commands related functions --------------------- */
3160
3161 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3162 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3163 {
3164 Jim_HashEntry *he;
3165 Jim_Cmd *cmdPtr;
3166
3167 he = Jim_FindHashEntry(&interp->commands, cmdName);
3168 if (he == NULL) { /* New command to create */
3169 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3170 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3171 } else {
3172 Jim_InterpIncrProcEpoch(interp);
3173 /* Free the arglist/body objects if it was a Tcl procedure */
3174 cmdPtr = he->val;
3175 if (cmdPtr->cmdProc == NULL) {
3176 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3177 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3178 if (cmdPtr->staticVars) {
3179 Jim_FreeHashTable(cmdPtr->staticVars);
3180 Jim_Free(cmdPtr->staticVars);
3181 }
3182 cmdPtr->staticVars = NULL;
3183 } else if (cmdPtr->delProc != NULL) {
3184 /* If it was a C coded command, call the delProc if any */
3185 cmdPtr->delProc(interp, cmdPtr->privData);
3186 }
3187 }
3188
3189 /* Store the new details for this proc */
3190 cmdPtr->delProc = delProc;
3191 cmdPtr->cmdProc = cmdProc;
3192 cmdPtr->privData = privData;
3193
3194 /* There is no need to increment the 'proc epoch' because
3195 * creation of a new procedure can never affect existing
3196 * cached commands. We don't do negative caching. */
3197 return JIM_OK;
3198 }
3199
3200 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3201 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3202 int arityMin, int arityMax)
3203 {
3204 Jim_Cmd *cmdPtr;
3205
3206 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3207 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3208 cmdPtr->argListObjPtr = argListObjPtr;
3209 cmdPtr->bodyObjPtr = bodyObjPtr;
3210 Jim_IncrRefCount(argListObjPtr);
3211 Jim_IncrRefCount(bodyObjPtr);
3212 cmdPtr->arityMin = arityMin;
3213 cmdPtr->arityMax = arityMax;
3214 cmdPtr->staticVars = NULL;
3215
3216 /* Create the statics hash table. */
3217 if (staticsListObjPtr) {
3218 int len, i;
3219
3220 Jim_ListLength(interp, staticsListObjPtr, &len);
3221 if (len != 0) {
3222 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3223 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3224 interp);
3225 for (i = 0; i < len; i++) {
3226 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3227 Jim_Var *varPtr;
3228 int subLen;
3229
3230 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3231 /* Check if it's composed of two elements. */
3232 Jim_ListLength(interp, objPtr, &subLen);
3233 if (subLen == 1 || subLen == 2) {
3234 /* Try to get the variable value from the current
3235 * environment. */
3236 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3237 if (subLen == 1) {
3238 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3239 JIM_NONE);
3240 if (initObjPtr == NULL) {
3241 Jim_SetResult(interp,
3242 Jim_NewEmptyStringObj(interp));
3243 Jim_AppendStrings(interp, Jim_GetResult(interp),
3244 "variable for initialization of static \"",
3245 Jim_GetString(nameObjPtr, NULL),
3246 "\" not found in the local context",
3247 NULL);
3248 goto err;
3249 }
3250 } else {
3251 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3252 }
3253 varPtr = Jim_Alloc(sizeof(*varPtr));
3254 varPtr->objPtr = initObjPtr;
3255 Jim_IncrRefCount(initObjPtr);
3256 varPtr->linkFramePtr = NULL;
3257 if (Jim_AddHashEntry(cmdPtr->staticVars,
3258 Jim_GetString(nameObjPtr, NULL),
3259 varPtr) != JIM_OK)
3260 {
3261 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3262 Jim_AppendStrings(interp, Jim_GetResult(interp),
3263 "static variable name \"",
3264 Jim_GetString(objPtr, NULL), "\"",
3265 " duplicated in statics list", NULL);
3266 Jim_DecrRefCount(interp, initObjPtr);
3267 Jim_Free(varPtr);
3268 goto err;
3269 }
3270 } else {
3271 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3272 Jim_AppendStrings(interp, Jim_GetResult(interp),
3273 "too many fields in static specifier \"",
3274 objPtr, "\"", NULL);
3275 goto err;
3276 }
3277 }
3278 }
3279 }
3280
3281 /* Add the new command */
3282
3283 /* it may already exist, so we try to delete the old one */
3284 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3285 /* There was an old procedure with the same name, this requires
3286 * a 'proc epoch' update. */
3287 Jim_InterpIncrProcEpoch(interp);
3288 }
3289 /* If a procedure with the same name didn't existed there is no need
3290 * to increment the 'proc epoch' because creation of a new procedure
3291 * can never affect existing cached commands. We don't do
3292 * negative caching. */
3293 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3294 return JIM_OK;
3295
3296 err:
3297 Jim_FreeHashTable(cmdPtr->staticVars);
3298 Jim_Free(cmdPtr->staticVars);
3299 Jim_DecrRefCount(interp, argListObjPtr);
3300 Jim_DecrRefCount(interp, bodyObjPtr);
3301 Jim_Free(cmdPtr);
3302 return JIM_ERR;
3303 }
3304
3305 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3306 {
3307 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3308 return JIM_ERR;
3309 Jim_InterpIncrProcEpoch(interp);
3310 return JIM_OK;
3311 }
3312
3313 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3314 const char *newName)
3315 {
3316 Jim_Cmd *cmdPtr;
3317 Jim_HashEntry *he;
3318 Jim_Cmd *copyCmdPtr;
3319
3320 if (newName[0] == '\0') /* Delete! */
3321 return Jim_DeleteCommand(interp, oldName);
3322 /* Rename */
3323 he = Jim_FindHashEntry(&interp->commands, oldName);
3324 if (he == NULL)
3325 return JIM_ERR; /* Invalid command name */
3326 cmdPtr = he->val;
3327 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3328 *copyCmdPtr = *cmdPtr;
3329 /* In order to avoid that a procedure will get arglist/body/statics
3330 * freed by the hash table methods, fake a C-coded command
3331 * setting cmdPtr->cmdProc as not NULL */
3332 cmdPtr->cmdProc = (void*)1;
3333 /* Also make sure delProc is NULL. */
3334 cmdPtr->delProc = NULL;
3335 /* Destroy the old command, and make sure the new is freed
3336 * as well. */
3337 Jim_DeleteHashEntry(&interp->commands, oldName);
3338 Jim_DeleteHashEntry(&interp->commands, newName);
3339 /* Now the new command. We are sure it can't fail because
3340 * the target name was already freed. */
3341 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3342 /* Increment the epoch */
3343 Jim_InterpIncrProcEpoch(interp);
3344 return JIM_OK;
3345 }
3346
3347 /* -----------------------------------------------------------------------------
3348 * Command object
3349 * ---------------------------------------------------------------------------*/
3350
3351 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3352
3353 static Jim_ObjType commandObjType = {
3354 "command",
3355 NULL,
3356 NULL,
3357 NULL,
3358 JIM_TYPE_REFERENCES,
3359 };
3360
3361 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3362 {
3363 Jim_HashEntry *he;
3364 const char *cmdName;
3365
3366 /* Get the string representation */
3367 cmdName = Jim_GetString(objPtr, NULL);
3368 /* Lookup this name into the commands hash table */
3369 he = Jim_FindHashEntry(&interp->commands, cmdName);
3370 if (he == NULL)
3371 return JIM_ERR;
3372
3373 /* Free the old internal repr and set the new one. */
3374 Jim_FreeIntRep(interp, objPtr);
3375 objPtr->typePtr = &commandObjType;
3376 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3377 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3378 return JIM_OK;
3379 }
3380
3381 /* This function returns the command structure for the command name
3382 * stored in objPtr. It tries to specialize the objPtr to contain
3383 * a cached info instead to perform the lookup into the hash table
3384 * every time. The information cached may not be uptodate, in such
3385 * a case the lookup is performed and the cache updated. */
3386 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3387 {
3388 if ((objPtr->typePtr != &commandObjType ||
3389 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3390 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3391 if (flags & JIM_ERRMSG) {
3392 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3393 Jim_AppendStrings(interp, Jim_GetResult(interp),
3394 "invalid command name \"", objPtr->bytes, "\"",
3395 NULL);
3396 }
3397 return NULL;
3398 }
3399 return objPtr->internalRep.cmdValue.cmdPtr;
3400 }
3401
3402 /* -----------------------------------------------------------------------------
3403 * Variables
3404 * ---------------------------------------------------------------------------*/
3405
3406 /* Variables HashTable Type.
3407 *
3408 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3409 static void JimVariablesHTValDestructor(void *interp, void *val)
3410 {
3411 Jim_Var *varPtr = (void*) val;
3412
3413 Jim_DecrRefCount(interp, varPtr->objPtr);
3414 Jim_Free(val);
3415 }
3416
3417 static Jim_HashTableType JimVariablesHashTableType = {
3418 JimStringCopyHTHashFunction, /* hash function */
3419 JimStringCopyHTKeyDup, /* key dup */
3420 NULL, /* val dup */
3421 JimStringCopyHTKeyCompare, /* key compare */
3422 JimStringCopyHTKeyDestructor, /* key destructor */
3423 JimVariablesHTValDestructor /* val destructor */
3424 };
3425
3426 static Jim_HashTableType *getJimVariablesHashTableType(void)
3427 {
3428 return &JimVariablesHashTableType;
3429 }
3430
3431 /* -----------------------------------------------------------------------------
3432 * Variable object
3433 * ---------------------------------------------------------------------------*/
3434
3435 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3436
3437 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3438
3439 static Jim_ObjType variableObjType = {
3440 "variable",
3441 NULL,
3442 NULL,
3443 NULL,
3444 JIM_TYPE_REFERENCES,
3445 };
3446
3447 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3448 * is in the form "varname(key)". */
3449 static int Jim_NameIsDictSugar(const char *str, int len)
3450 {
3451 if (len == -1)
3452 len = strlen(str);
3453 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3454 return 1;
3455 return 0;
3456 }
3457
3458 /* This method should be called only by the variable API.
3459 * It returns JIM_OK on success (variable already exists),
3460 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3461 * a variable name, but syntax glue for [dict] i.e. the last
3462 * character is ')' */
3463 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3464 {
3465 Jim_HashEntry *he;
3466 const char *varName;
3467 int len;
3468
3469 /* Check if the object is already an uptodate variable */
3470 if (objPtr->typePtr == &variableObjType &&
3471 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3472 return JIM_OK; /* nothing to do */
3473 /* Get the string representation */
3474 varName = Jim_GetString(objPtr, &len);
3475 /* Make sure it's not syntax glue to get/set dict. */
3476 if (Jim_NameIsDictSugar(varName, len))
3477 return JIM_DICT_SUGAR;
3478 if (varName[0] == ':' && varName[1] == ':') {
3479 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3480 if (he == NULL) {
3481 return JIM_ERR;
3482 }
3483 }
3484 else {
3485 /* Lookup this name into the variables hash table */
3486 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3487 if (he == NULL) {
3488 /* Try with static vars. */
3489 if (interp->framePtr->staticVars == NULL)
3490 return JIM_ERR;
3491 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3492 return JIM_ERR;
3493 }
3494 }
3495 /* Free the old internal repr and set the new one. */
3496 Jim_FreeIntRep(interp, objPtr);
3497 objPtr->typePtr = &variableObjType;
3498 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3499 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3500 return JIM_OK;
3501 }
3502
3503 /* -------------------- Variables related functions ------------------------- */
3504 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3505 Jim_Obj *valObjPtr);
3506 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3507
3508 /* For now that's dummy. Variables lookup should be optimized
3509 * in many ways, with caching of lookups, and possibly with
3510 * a table of pre-allocated vars in every CallFrame for local vars.
3511 * All the caching should also have an 'epoch' mechanism similar
3512 * to the one used by Tcl for procedures lookup caching. */
3513
3514 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3515 {
3516 const char *name;
3517 Jim_Var *var;
3518 int err;
3519
3520 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3521 /* Check for [dict] syntax sugar. */
3522 if (err == JIM_DICT_SUGAR)
3523 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3524 /* New variable to create */
3525 name = Jim_GetString(nameObjPtr, NULL);
3526
3527 var = Jim_Alloc(sizeof(*var));
3528 var->objPtr = valObjPtr;
3529 Jim_IncrRefCount(valObjPtr);
3530 var->linkFramePtr = NULL;
3531 /* Insert the new variable */
3532 if (name[0] == ':' && name[1] == ':') {
3533 /* Into to the top evel frame */
3534 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3535 }
3536 else {
3537 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3538 }
3539 /* Make the object int rep a variable */
3540 Jim_FreeIntRep(interp, nameObjPtr);
3541 nameObjPtr->typePtr = &variableObjType;
3542 nameObjPtr->internalRep.varValue.callFrameId =
3543 interp->framePtr->id;
3544 nameObjPtr->internalRep.varValue.varPtr = var;
3545 } else {
3546 var = nameObjPtr->internalRep.varValue.varPtr;
3547 if (var->linkFramePtr == NULL) {
3548 Jim_IncrRefCount(valObjPtr);
3549 Jim_DecrRefCount(interp, var->objPtr);
3550 var->objPtr = valObjPtr;
3551 } else { /* Else handle the link */
3552 Jim_CallFrame *savedCallFrame;
3553
3554 savedCallFrame = interp->framePtr;
3555 interp->framePtr = var->linkFramePtr;
3556 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3557 interp->framePtr = savedCallFrame;
3558 if (err != JIM_OK)
3559 return err;
3560 }
3561 }
3562 return JIM_OK;
3563 }
3564
3565 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3566 {
3567 Jim_Obj *nameObjPtr;
3568 int result;
3569
3570 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3571 Jim_IncrRefCount(nameObjPtr);
3572 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3573 Jim_DecrRefCount(interp, nameObjPtr);
3574 return result;
3575 }
3576
3577 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3578 {
3579 Jim_CallFrame *savedFramePtr;
3580 int result;
3581
3582 savedFramePtr = interp->framePtr;
3583 interp->framePtr = interp->topFramePtr;
3584 result = Jim_SetVariableStr(interp, name, objPtr);
3585 interp->framePtr = savedFramePtr;
3586 return result;
3587 }
3588
3589 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3590 {
3591 Jim_Obj *nameObjPtr, *valObjPtr;
3592 int result;
3593
3594 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3595 valObjPtr = Jim_NewStringObj(interp, val, -1);
3596 Jim_IncrRefCount(nameObjPtr);
3597 Jim_IncrRefCount(valObjPtr);
3598 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3599 Jim_DecrRefCount(interp, nameObjPtr);
3600 Jim_DecrRefCount(interp, valObjPtr);
3601 return result;
3602 }
3603
3604 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3605 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3606 {
3607 const char *varName;
3608 int len;
3609
3610 /* Check for cycles. */
3611 if (interp->framePtr == targetCallFrame) {
3612 Jim_Obj *objPtr = targetNameObjPtr;
3613 Jim_Var *varPtr;
3614 /* Cycles are only possible with 'uplevel 0' */
3615 while(1) {
3616 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3617 Jim_SetResultString(interp,
3618 "can't upvar from variable to itself", -1);
3619 return JIM_ERR;
3620 }
3621 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3622 break;
3623 varPtr = objPtr->internalRep.varValue.varPtr;
3624 if (varPtr->linkFramePtr != targetCallFrame) break;
3625 objPtr = varPtr->objPtr;
3626 }
3627 }
3628 varName = Jim_GetString(nameObjPtr, &len);
3629 if (Jim_NameIsDictSugar(varName, len)) {
3630 Jim_SetResultString(interp,
3631 "Dict key syntax invalid as link source", -1);
3632 return JIM_ERR;
3633 }
3634 /* Perform the binding */
3635 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3636 /* We are now sure 'nameObjPtr' type is variableObjType */
3637 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3638 return JIM_OK;
3639 }
3640
3641 /* Return the Jim_Obj pointer associated with a variable name,
3642 * or NULL if the variable was not found in the current context.
3643 * The same optimization discussed in the comment to the
3644 * 'SetVariable' function should apply here. */
3645 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3646 {
3647 int err;
3648
3649 /* All the rest is handled here */
3650 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3651 /* Check for [dict] syntax sugar. */
3652 if (err == JIM_DICT_SUGAR)
3653 return JimDictSugarGet(interp, nameObjPtr);
3654 if (flags & JIM_ERRMSG) {
3655 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3656 Jim_AppendStrings(interp, Jim_GetResult(interp),
3657 "can't read \"", nameObjPtr->bytes,
3658 "\": no such variable", NULL);
3659 }
3660 return NULL;
3661 } else {
3662 Jim_Var *varPtr;
3663 Jim_Obj *objPtr;
3664 Jim_CallFrame *savedCallFrame;
3665
3666 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3667 if (varPtr->linkFramePtr == NULL)
3668 return varPtr->objPtr;
3669 /* The variable is a link? Resolve it. */
3670 savedCallFrame = interp->framePtr;
3671 interp->framePtr = varPtr->linkFramePtr;
3672 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3673 if (objPtr == NULL && flags & JIM_ERRMSG) {
3674 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3675 Jim_AppendStrings(interp, Jim_GetResult(interp),
3676 "can't read \"", nameObjPtr->bytes,
3677 "\": no such variable", NULL);
3678 }
3679 interp->framePtr = savedCallFrame;
3680 return objPtr;
3681 }
3682 }
3683
3684 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3685 int flags)
3686 {
3687 Jim_CallFrame *savedFramePtr;
3688 Jim_Obj *objPtr;
3689
3690 savedFramePtr = interp->framePtr;
3691 interp->framePtr = interp->topFramePtr;
3692 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3693 interp->framePtr = savedFramePtr;
3694
3695 return objPtr;
3696 }
3697
3698 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3699 {
3700 Jim_Obj *nameObjPtr, *varObjPtr;
3701
3702 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3703 Jim_IncrRefCount(nameObjPtr);
3704 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3705 Jim_DecrRefCount(interp, nameObjPtr);
3706 return varObjPtr;
3707 }
3708
3709 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3710 int flags)
3711 {
3712 Jim_CallFrame *savedFramePtr;
3713 Jim_Obj *objPtr;
3714
3715 savedFramePtr = interp->framePtr;
3716 interp->framePtr = interp->topFramePtr;
3717 objPtr = Jim_GetVariableStr(interp, name, flags);
3718 interp->framePtr = savedFramePtr;
3719
3720 return objPtr;
3721 }
3722
3723 /* Unset a variable.
3724 * Note: On success unset invalidates all the variable objects created
3725 * in the current call frame incrementing. */
3726 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3727 {
3728 const char *name;
3729 Jim_Var *varPtr;
3730 int err;
3731
3732 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3733 /* Check for [dict] syntax sugar. */
3734 if (err == JIM_DICT_SUGAR)
3735 return JimDictSugarSet(interp, nameObjPtr, NULL);
3736 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3737 Jim_AppendStrings(interp, Jim_GetResult(interp),
3738 "can't unset \"", nameObjPtr->bytes,
3739 "\": no such variable", NULL);
3740 return JIM_ERR; /* var not found */
3741 }
3742 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3743 /* If it's a link call UnsetVariable recursively */
3744 if (varPtr->linkFramePtr) {
3745 int retval;
3746
3747 Jim_CallFrame *savedCallFrame;
3748
3749 savedCallFrame = interp->framePtr;
3750 interp->framePtr = varPtr->linkFramePtr;
3751 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3752 interp->framePtr = savedCallFrame;
3753 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3754 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3755 Jim_AppendStrings(interp, Jim_GetResult(interp),
3756 "can't unset \"", nameObjPtr->bytes,
3757 "\": no such variable", NULL);
3758 }
3759 return retval;
3760 } else {
3761 name = Jim_GetString(nameObjPtr, NULL);
3762 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3763 != JIM_OK) return JIM_ERR;
3764 /* Change the callframe id, invalidating var lookup caching */
3765 JimChangeCallFrameId(interp, interp->framePtr);
3766 return JIM_OK;
3767 }
3768 }
3769
3770 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3771
3772 /* Given a variable name for [dict] operation syntax sugar,
3773 * this function returns two objects, the first with the name
3774 * of the variable to set, and the second with the rispective key.
3775 * For example "foo(bar)" will return objects with string repr. of
3776 * "foo" and "bar".
3777 *
3778 * The returned objects have refcount = 1. The function can't fail. */
3779 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3780 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3781 {
3782 const char *str, *p;
3783 char *t;
3784 int len, keyLen, nameLen;
3785 Jim_Obj *varObjPtr, *keyObjPtr;
3786
3787 str = Jim_GetString(objPtr, &len);
3788 p = strchr(str, '(');
3789 p++;
3790 keyLen = len-((p-str)+1);
3791 nameLen = (p-str)-1;
3792 /* Create the objects with the variable name and key. */
3793 t = Jim_Alloc(nameLen+1);
3794 memcpy(t, str, nameLen);
3795 t[nameLen] = '\0';
3796 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3797
3798 t = Jim_Alloc(keyLen+1);
3799 memcpy(t, p, keyLen);
3800 t[keyLen] = '\0';
3801 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3802
3803 Jim_IncrRefCount(varObjPtr);
3804 Jim_IncrRefCount(keyObjPtr);
3805 *varPtrPtr = varObjPtr;
3806 *keyPtrPtr = keyObjPtr;
3807 }
3808
3809 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3810 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3811 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3812 Jim_Obj *valObjPtr)
3813 {
3814 Jim_Obj *varObjPtr, *keyObjPtr;
3815 int err = JIM_OK;
3816
3817 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3818 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3819 valObjPtr);
3820 Jim_DecrRefCount(interp, varObjPtr);
3821 Jim_DecrRefCount(interp, keyObjPtr);
3822 return err;
3823 }
3824
3825 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3826 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3827 {
3828 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3829
3830 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3831 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3832 if (!dictObjPtr) {
3833 resObjPtr = NULL;
3834 goto err;
3835 }
3836 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3837 != JIM_OK) {
3838 resObjPtr = NULL;
3839 }
3840 err:
3841 Jim_DecrRefCount(interp, varObjPtr);
3842 Jim_DecrRefCount(interp, keyObjPtr);
3843 return resObjPtr;
3844 }
3845
3846 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3847
3848 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3849 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3850 Jim_Obj *dupPtr);
3851
3852 static Jim_ObjType dictSubstObjType = {
3853 "dict-substitution",
3854 FreeDictSubstInternalRep,
3855 DupDictSubstInternalRep,
3856 NULL,
3857 JIM_TYPE_NONE,
3858 };
3859
3860 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3861 {
3862 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3863 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3864 }
3865
3866 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3867 Jim_Obj *dupPtr)
3868 {
3869 JIM_NOTUSED(interp);
3870
3871 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3872 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3873 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3874 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3875 dupPtr->typePtr = &dictSubstObjType;
3876 }
3877
3878 /* This function is used to expand [dict get] sugar in the form
3879 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3880 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3881 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3882 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3883 * the [dict]ionary contained in variable VARNAME. */
3884 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3885 {
3886 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3887 Jim_Obj *substKeyObjPtr = NULL;
3888
3889 if (objPtr->typePtr != &dictSubstObjType) {
3890 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3891 Jim_FreeIntRep(interp, objPtr);
3892 objPtr->typePtr = &dictSubstObjType;
3893 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3894 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3895 }
3896 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3897 &substKeyObjPtr, JIM_NONE)
3898 != JIM_OK) {
3899 substKeyObjPtr = NULL;
3900 goto err;
3901 }
3902 Jim_IncrRefCount(substKeyObjPtr);
3903 dictObjPtr = Jim_GetVariable(interp,
3904 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3905 if (!dictObjPtr) {
3906 resObjPtr = NULL;
3907 goto err;
3908 }
3909 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3910 != JIM_OK) {
3911 resObjPtr = NULL;
3912 goto err;
3913 }
3914 err:
3915 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3916 return resObjPtr;
3917 }
3918
3919 /* -----------------------------------------------------------------------------
3920 * CallFrame
3921 * ---------------------------------------------------------------------------*/
3922
3923 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3924 {
3925 Jim_CallFrame *cf;
3926 if (interp->freeFramesList) {
3927 cf = interp->freeFramesList;
3928 interp->freeFramesList = cf->nextFramePtr;
3929 } else {
3930 cf = Jim_Alloc(sizeof(*cf));
3931 cf->vars.table = NULL;
3932 }
3933
3934 cf->id = interp->callFrameEpoch++;
3935 cf->parentCallFrame = NULL;
3936 cf->argv = NULL;
3937 cf->argc = 0;
3938 cf->procArgsObjPtr = NULL;
3939 cf->procBodyObjPtr = NULL;
3940 cf->nextFramePtr = NULL;
3941 cf->staticVars = NULL;
3942 if (cf->vars.table == NULL)
3943 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3944 return cf;
3945 }
3946
3947 /* Used to invalidate every caching related to callframe stability. */
3948 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3949 {
3950 cf->id = interp->callFrameEpoch++;
3951 }
3952
3953 #define JIM_FCF_NONE 0 /* no flags */
3954 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3955 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3956 int flags)
3957 {
3958 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3959 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3960 if (!(flags & JIM_FCF_NOHT))
3961 Jim_FreeHashTable(&cf->vars);
3962 else {
3963 int i;
3964 Jim_HashEntry **table = cf->vars.table, *he;
3965
3966 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3967 he = table[i];
3968 while (he != NULL) {
3969 Jim_HashEntry *nextEntry = he->next;
3970 Jim_Var *varPtr = (void*) he->val;
3971
3972 Jim_DecrRefCount(interp, varPtr->objPtr);
3973 Jim_Free(he->val);
3974 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3975 Jim_Free(he);
3976 table[i] = NULL;
3977 he = nextEntry;
3978 }
3979 }
3980 cf->vars.used = 0;
3981 }
3982 cf->nextFramePtr = interp->freeFramesList;
3983 interp->freeFramesList = cf;
3984 }
3985
3986 /* -----------------------------------------------------------------------------
3987 * References
3988 * ---------------------------------------------------------------------------*/
3989
3990 /* References HashTable Type.
3991 *
3992 * Keys are jim_wide integers, dynamically allocated for now but in the
3993 * future it's worth to cache this 8 bytes objects. Values are poitners
3994 * to Jim_References. */
3995 static void JimReferencesHTValDestructor(void *interp, void *val)
3996 {
3997 Jim_Reference *refPtr = (void*) val;
3998
3999 Jim_DecrRefCount(interp, refPtr->objPtr);
4000 if (refPtr->finalizerCmdNamePtr != NULL) {
4001 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4002 }
4003 Jim_Free(val);
4004 }
4005
4006 unsigned int JimReferencesHTHashFunction(const void *key)
4007 {
4008 /* Only the least significant bits are used. */
4009 const jim_wide *widePtr = key;
4010 unsigned int intValue = (unsigned int) *widePtr;
4011 return Jim_IntHashFunction(intValue);
4012 }
4013
4014 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4015 {
4016 /* Only the least significant bits are used. */
4017 const jim_wide *widePtr = key;
4018 unsigned int intValue = (unsigned int) *widePtr;
4019 return intValue; /* identity function. */
4020 }
4021
4022 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4023 {
4024 void *copy = Jim_Alloc(sizeof(jim_wide));
4025 JIM_NOTUSED(privdata);
4026
4027 memcpy(copy, key, sizeof(jim_wide));
4028 return copy;
4029 }
4030
4031 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4032 const void *key2)
4033 {
4034 JIM_NOTUSED(privdata);
4035
4036 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4037 }
4038
4039 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4040 {
4041 JIM_NOTUSED(privdata);
4042
4043 Jim_Free((void*)key);
4044 }
4045
4046 static Jim_HashTableType JimReferencesHashTableType = {
4047 JimReferencesHTHashFunction, /* hash function */
4048 JimReferencesHTKeyDup, /* key dup */
4049 NULL, /* val dup */
4050 JimReferencesHTKeyCompare, /* key compare */
4051 JimReferencesHTKeyDestructor, /* key destructor */
4052 JimReferencesHTValDestructor /* val destructor */
4053 };
4054
4055 /* -----------------------------------------------------------------------------
4056 * Reference object type and References API
4057 * ---------------------------------------------------------------------------*/
4058
4059 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4060
4061 static Jim_ObjType referenceObjType = {
4062 "reference",
4063 NULL,
4064 NULL,
4065 UpdateStringOfReference,
4066 JIM_TYPE_REFERENCES,
4067 };
4068
4069 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4070 {
4071 int len;
4072 char buf[JIM_REFERENCE_SPACE+1];
4073 Jim_Reference *refPtr;
4074
4075 refPtr = objPtr->internalRep.refValue.refPtr;
4076 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4077 objPtr->bytes = Jim_Alloc(len+1);
4078 memcpy(objPtr->bytes, buf, len+1);
4079 objPtr->length = len;
4080 }
4081
4082 /* returns true if 'c' is a valid reference tag character.
4083 * i.e. inside the range [_a-zA-Z0-9] */
4084 static int isrefchar(int c)
4085 {
4086 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4087 (c >= '0' && c <= '9')) return 1;
4088 return 0;
4089 }
4090
4091 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4092 {
4093 jim_wide wideValue;
4094 int i, len;
4095 const char *str, *start, *end;
4096 char refId[21];
4097 Jim_Reference *refPtr;
4098 Jim_HashEntry *he;
4099
4100 /* Get the string representation */
4101 str = Jim_GetString(objPtr, &len);
4102 /* Check if it looks like a reference */
4103 if (len < JIM_REFERENCE_SPACE) goto badformat;
4104 /* Trim spaces */
4105 start = str;
4106 end = str+len-1;
4107 while (*start == ' ') start++;
4108 while (*end == ' ' && end > start) end--;
4109 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4110 /* <reference.<1234567>.%020> */
4111 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4112 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4113 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4114 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4115 if (!isrefchar(start[12+i])) goto badformat;
4116 }
4117 /* Extract info from the refernece. */
4118 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4119 refId[20] = '\0';
4120 /* Try to convert the ID into a jim_wide */
4121 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4122 /* Check if the reference really exists! */
4123 he = Jim_FindHashEntry(&interp->references, &wideValue);
4124 if (he == NULL) {
4125 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4126 Jim_AppendStrings(interp, Jim_GetResult(interp),
4127 "Invalid reference ID \"", str, "\"", NULL);
4128 return JIM_ERR;
4129 }
4130 refPtr = he->val;
4131 /* Free the old internal repr and set the new one. */
4132 Jim_FreeIntRep(interp, objPtr);
4133 objPtr->typePtr = &referenceObjType;
4134 objPtr->internalRep.refValue.id = wideValue;
4135 objPtr->internalRep.refValue.refPtr = refPtr;
4136 return JIM_OK;
4137
4138 badformat:
4139 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4140 Jim_AppendStrings(interp, Jim_GetResult(interp),
4141 "expected reference but got \"", str, "\"", NULL);
4142 return JIM_ERR;
4143 }
4144
4145 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4146 * as finalizer command (or NULL if there is no finalizer).
4147 * The returned reference object has refcount = 0. */
4148 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4149 Jim_Obj *cmdNamePtr)
4150 {
4151 struct Jim_Reference *refPtr;
4152 jim_wide wideValue = interp->referenceNextId;
4153 Jim_Obj *refObjPtr;
4154 const char *tag;
4155 int tagLen, i;
4156
4157 /* Perform the Garbage Collection if needed. */
4158 Jim_CollectIfNeeded(interp);
4159
4160 refPtr = Jim_Alloc(sizeof(*refPtr));
4161 refPtr->objPtr = objPtr;
4162 Jim_IncrRefCount(objPtr);
4163 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4164 if (cmdNamePtr)
4165 Jim_IncrRefCount(cmdNamePtr);
4166 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4167 refObjPtr = Jim_NewObj(interp);
4168 refObjPtr->typePtr = &referenceObjType;
4169 refObjPtr->bytes = NULL;
4170 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4171 refObjPtr->internalRep.refValue.refPtr = refPtr;
4172 interp->referenceNextId++;
4173 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4174 * that does not pass the 'isrefchar' test is replaced with '_' */
4175 tag = Jim_GetString(tagPtr, &tagLen);
4176 if (tagLen > JIM_REFERENCE_TAGLEN)
4177 tagLen = JIM_REFERENCE_TAGLEN;
4178 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4179 if (i < tagLen)
4180 refPtr->tag[i] = tag[i];
4181 else
4182 refPtr->tag[i] = '_';
4183 }
4184 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4185 return refObjPtr;
4186 }
4187
4188 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4189 {
4190 if (objPtr->typePtr != &referenceObjType &&
4191 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4192 return NULL;
4193 return objPtr->internalRep.refValue.refPtr;
4194 }
4195
4196 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4197 {
4198 Jim_Reference *refPtr;
4199
4200 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4201 return JIM_ERR;
4202 Jim_IncrRefCount(cmdNamePtr);
4203 if (refPtr->finalizerCmdNamePtr)
4204 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4205 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4206 return JIM_OK;
4207 }
4208
4209 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4210 {
4211 Jim_Reference *refPtr;
4212
4213 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4214 return JIM_ERR;
4215 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4216 return JIM_OK;
4217 }
4218
4219 /* -----------------------------------------------------------------------------
4220 * References Garbage Collection
4221 * ---------------------------------------------------------------------------*/
4222
4223 /* This the hash table type for the "MARK" phase of the GC */
4224 static Jim_HashTableType JimRefMarkHashTableType = {
4225 JimReferencesHTHashFunction, /* hash function */
4226 JimReferencesHTKeyDup, /* key dup */
4227 NULL, /* val dup */
4228 JimReferencesHTKeyCompare, /* key compare */
4229 JimReferencesHTKeyDestructor, /* key destructor */
4230 NULL /* val destructor */
4231 };
4232
4233 /* #define JIM_DEBUG_GC 1 */
4234
4235 /* Performs the garbage collection. */
4236 int Jim_Collect(Jim_Interp *interp)
4237 {
4238 Jim_HashTable marks;
4239 Jim_HashTableIterator *htiter;
4240 Jim_HashEntry *he;
4241 Jim_Obj *objPtr;
4242 int collected = 0;
4243
4244 /* Avoid recursive calls */
4245 if (interp->lastCollectId == -1) {
4246 /* Jim_Collect() already running. Return just now. */
4247 return 0;
4248 }
4249 interp->lastCollectId = -1;
4250
4251 /* Mark all the references found into the 'mark' hash table.
4252 * The references are searched in every live object that
4253 * is of a type that can contain references. */
4254 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4255 objPtr = interp->liveList;
4256 while(objPtr) {
4257 if (objPtr->typePtr == NULL ||
4258 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4259 const char *str, *p;
4260 int len;
4261
4262 /* If the object is of type reference, to get the
4263 * Id is simple... */
4264 if (objPtr->typePtr == &referenceObjType) {
4265 Jim_AddHashEntry(&marks,
4266 &objPtr->internalRep.refValue.id, NULL);
4267 #ifdef JIM_DEBUG_GC
4268 Jim_fprintf(interp,interp->cookie_stdout,
4269 "MARK (reference): %d refcount: %d" JIM_NL,
4270 (int) objPtr->internalRep.refValue.id,
4271 objPtr->refCount);
4272 #endif
4273 objPtr = objPtr->nextObjPtr;
4274 continue;
4275 }
4276 /* Get the string repr of the object we want
4277 * to scan for references. */
4278 p = str = Jim_GetString(objPtr, &len);
4279 /* Skip objects too little to contain references. */
4280 if (len < JIM_REFERENCE_SPACE) {
4281 objPtr = objPtr->nextObjPtr;
4282 continue;
4283 }
4284 /* Extract references from the object string repr. */
4285 while(1) {
4286 int i;
4287 jim_wide id;
4288 char buf[21];
4289
4290 if ((p = strstr(p, "<reference.<")) == NULL)
4291 break;
4292 /* Check if it's a valid reference. */
4293 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4294 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4295 for (i = 21; i <= 40; i++)
4296 if (!isdigit((int)p[i]))
4297 break;
4298 /* Get the ID */
4299 memcpy(buf, p+21, 20);
4300 buf[20] = '\0';
4301 Jim_StringToWide(buf, &id, 10);
4302
4303 /* Ok, a reference for the given ID
4304 * was found. Mark it. */
4305 Jim_AddHashEntry(&marks, &id, NULL);
4306 #ifdef JIM_DEBUG_GC
4307 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4308 #endif
4309 p += JIM_REFERENCE_SPACE;
4310 }
4311 }
4312 objPtr = objPtr->nextObjPtr;
4313 }
4314
4315 /* Run the references hash table to destroy every reference that
4316 * is not referenced outside (not present in the mark HT). */
4317 htiter = Jim_GetHashTableIterator(&interp->references);
4318 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4319 const jim_wide *refId;
4320 Jim_Reference *refPtr;
4321
4322 refId = he->key;
4323 /* Check if in the mark phase we encountered
4324 * this reference. */
4325 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4326 #ifdef JIM_DEBUG_GC
4327 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4328 #endif
4329 collected++;
4330 /* Drop the reference, but call the
4331 * finalizer first if registered. */
4332 refPtr = he->val;
4333 if (refPtr->finalizerCmdNamePtr) {
4334 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4335 Jim_Obj *objv[3], *oldResult;
4336
4337 JimFormatReference(refstr, refPtr, *refId);
4338
4339 objv[0] = refPtr->finalizerCmdNamePtr;
4340 objv[1] = Jim_NewStringObjNoAlloc(interp,
4341 refstr, 32);
4342 objv[2] = refPtr->objPtr;
4343 Jim_IncrRefCount(objv[0]);
4344 Jim_IncrRefCount(objv[1]);
4345 Jim_IncrRefCount(objv[2]);
4346
4347 /* Drop the reference itself */
4348 Jim_DeleteHashEntry(&interp->references, refId);
4349
4350 /* Call the finalizer. Errors ignored. */
4351 oldResult = interp->result;
4352 Jim_IncrRefCount(oldResult);
4353 Jim_EvalObjVector(interp, 3, objv);
4354 Jim_SetResult(interp, oldResult);
4355 Jim_DecrRefCount(interp, oldResult);
4356
4357 Jim_DecrRefCount(interp, objv[0]);
4358 Jim_DecrRefCount(interp, objv[1]);
4359 Jim_DecrRefCount(interp, objv[2]);
4360 } else {
4361 Jim_DeleteHashEntry(&interp->references, refId);
4362 }
4363 }
4364 }
4365 Jim_FreeHashTableIterator(htiter);
4366 Jim_FreeHashTable(&marks);
4367 interp->lastCollectId = interp->referenceNextId;
4368 interp->lastCollectTime = time(NULL);
4369 return collected;
4370 }
4371
4372 #define JIM_COLLECT_ID_PERIOD 5000
4373 #define JIM_COLLECT_TIME_PERIOD 300
4374
4375 void Jim_CollectIfNeeded(Jim_Interp *interp)
4376 {
4377 jim_wide elapsedId;
4378 int elapsedTime;
4379
4380 elapsedId = interp->referenceNextId - interp->lastCollectId;
4381 elapsedTime = time(NULL) - interp->lastCollectTime;
4382
4383
4384 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4385 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4386 Jim_Collect(interp);
4387 }
4388 }
4389
4390 /* -----------------------------------------------------------------------------
4391 * Interpreter related functions
4392 * ---------------------------------------------------------------------------*/
4393
4394 Jim_Interp *Jim_CreateInterp(void)
4395 {
4396 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4397 Jim_Obj *pathPtr;
4398
4399 i->errorLine = 0;
4400 i->errorFileName = Jim_StrDup("");
4401 i->numLevels = 0;
4402 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4403 i->returnCode = JIM_OK;
4404 i->exitCode = 0;
4405 i->procEpoch = 0;
4406 i->callFrameEpoch = 0;
4407 i->liveList = i->freeList = NULL;
4408 i->scriptFileName = Jim_StrDup("");
4409 i->referenceNextId = 0;
4410 i->lastCollectId = 0;
4411 i->lastCollectTime = time(NULL);
4412 i->freeFramesList = NULL;
4413 i->prngState = NULL;
4414 i->evalRetcodeLevel = -1;
4415 i->cookie_stdin = stdin;
4416 i->cookie_stdout = stdout;
4417 i->cookie_stderr = stderr;
4418 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4419 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4420 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4421 i->cb_fflush = ((int (*)( void *))(fflush));
4422 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4423
4424 /* Note that we can create objects only after the
4425 * interpreter liveList and freeList pointers are
4426 * initialized to NULL. */
4427 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4428 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4429 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4430 NULL);
4431 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4432 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4433 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4434 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4435 i->emptyObj = Jim_NewEmptyStringObj(i);
4436 i->result = i->emptyObj;
4437 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4438 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4439 i->unknown_called = 0;
4440 Jim_IncrRefCount(i->emptyObj);
4441 Jim_IncrRefCount(i->result);
4442 Jim_IncrRefCount(i->stackTrace);
4443 Jim_IncrRefCount(i->unknown);
4444
4445 /* Initialize key variables every interpreter should contain */
4446 pathPtr = Jim_NewStringObj(i, "./", -1);
4447 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4448 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4449
4450 /* Export the core API to extensions */
4451 JimRegisterCoreApi(i);
4452 return i;
4453 }
4454
4455 /* This is the only function Jim exports directly without
4456 * to use the STUB system. It is only used by embedders
4457 * in order to get an interpreter with the Jim API pointers
4458 * registered. */
4459 Jim_Interp *ExportedJimCreateInterp(void)
4460 {
4461 return Jim_CreateInterp();
4462 }
4463
4464 void Jim_FreeInterp(Jim_Interp *i)
4465 {
4466 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4467 Jim_Obj *objPtr, *nextObjPtr;
4468
4469 Jim_DecrRefCount(i, i->emptyObj);
4470 Jim_DecrRefCount(i, i->result);
4471 Jim_DecrRefCount(i, i->stackTrace);
4472 Jim_DecrRefCount(i, i->unknown);
4473 Jim_Free((void*)i->errorFileName);
4474 Jim_Free((void*)i->scriptFileName);
4475 Jim_FreeHashTable(&i->commands);
4476 Jim_FreeHashTable(&i->references);
4477 Jim_FreeHashTable(&i->stub);
4478 Jim_FreeHashTable(&i->assocData);
4479 Jim_FreeHashTable(&i->packages);
4480 Jim_Free(i->prngState);
4481 /* Free the call frames list */
4482 while(cf) {
4483 prevcf = cf->parentCallFrame;
4484 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4485 cf = prevcf;
4486 }
4487 /* Check that the live object list is empty, otherwise
4488 * there is a memory leak. */
4489 if (i->liveList != NULL) {
4490 Jim_Obj *objPtr = i->liveList;
4491
4492 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4493 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4494 while(objPtr) {
4495 const char *type = objPtr->typePtr ?
4496 objPtr->typePtr->name : "";
4497 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4498 objPtr, type,
4499 objPtr->bytes ? objPtr->bytes
4500 : "(null)", objPtr->refCount);
4501 if (objPtr->typePtr == &sourceObjType) {
4502 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4503 objPtr->internalRep.sourceValue.fileName,
4504 objPtr->internalRep.sourceValue.lineNumber);
4505 }
4506 objPtr = objPtr->nextObjPtr;
4507 }
4508 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4509 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4510 }
4511 /* Free all the freed objects. */
4512 objPtr = i->freeList;
4513 while (objPtr) {
4514 nextObjPtr = objPtr->nextObjPtr;
4515 Jim_Free(objPtr);
4516 objPtr = nextObjPtr;
4517 }
4518 /* Free cached CallFrame structures */
4519 cf = i->freeFramesList;
4520 while(cf) {
4521 nextcf = cf->nextFramePtr;
4522 if (cf->vars.table != NULL)
4523 Jim_Free(cf->vars.table);
4524 Jim_Free(cf);
4525 cf = nextcf;
4526 }
4527 /* Free the sharedString hash table. Make sure to free it
4528 * after every other Jim_Object was freed. */
4529 Jim_FreeHashTable(&i->sharedStrings);
4530 /* Free the interpreter structure. */
4531 Jim_Free(i);
4532 }
4533
4534 /* Store the call frame relative to the level represented by
4535 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4536 * level is assumed to be '1'.
4537 *
4538 * If a newLevelptr int pointer is specified, the function stores
4539 * the absolute level integer value of the new target callframe into
4540 * *newLevelPtr. (this is used to adjust interp->numLevels
4541 * in the implementation of [uplevel], so that [info level] will
4542 * return a correct information).
4543 *
4544 * This function accepts the 'level' argument in the form
4545 * of the commands [uplevel] and [upvar].
4546 *
4547 * For a function accepting a relative integer as level suitable
4548 * for implementation of [info level ?level?] check the
4549 * GetCallFrameByInteger() function. */
4550 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4551 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4552 {
4553 long level;
4554 const char *str;
4555 Jim_CallFrame *framePtr;
4556
4557 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4558 if (levelObjPtr) {
4559 str = Jim_GetString(levelObjPtr, NULL);
4560 if (str[0] == '#') {
4561 char *endptr;
4562 /* speedup for the toplevel (level #0) */
4563 if (str[1] == '0' && str[2] == '\0') {
4564 if (newLevelPtr) *newLevelPtr = 0;
4565 *framePtrPtr = interp->topFramePtr;
4566 return JIM_OK;
4567 }
4568
4569 level = strtol(str+1, &endptr, 0);
4570 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4571 goto badlevel;
4572 /* An 'absolute' level is converted into the
4573 * 'number of levels to go back' format. */
4574 level = interp->numLevels - level;
4575 if (level < 0) goto badlevel;
4576 } else {
4577 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4578 goto badlevel;
4579 }
4580 } else {
4581 str = "1"; /* Needed to format the error message. */
4582 level = 1;
4583 }
4584 /* Lookup */
4585 framePtr = interp->framePtr;
4586 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4587 while (level--) {
4588 framePtr = framePtr->parentCallFrame;
4589 if (framePtr == NULL) goto badlevel;
4590 }
4591 *framePtrPtr = framePtr;
4592 return JIM_OK;
4593 badlevel:
4594 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4595 Jim_AppendStrings(interp, Jim_GetResult(interp),
4596 "bad level \"", str, "\"", NULL);
4597 return JIM_ERR;
4598 }
4599
4600 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4601 * as a relative integer like in the [info level ?level?] command. */
4602 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4603 Jim_CallFrame **framePtrPtr)
4604 {
4605 jim_wide level;
4606 jim_wide relLevel; /* level relative to the current one. */
4607 Jim_CallFrame *framePtr;
4608
4609 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4610 goto badlevel;
4611 if (level > 0) {
4612 /* An 'absolute' level is converted into the
4613 * 'number of levels to go back' format. */
4614 relLevel = interp->numLevels - level;
4615 } else {
4616 relLevel = -level;
4617 }
4618 /* Lookup */
4619 framePtr = interp->framePtr;
4620 while (relLevel--) {
4621 framePtr = framePtr->parentCallFrame;
4622 if (framePtr == NULL) goto badlevel;
4623 }
4624 *framePtrPtr = framePtr;
4625 return JIM_OK;
4626 badlevel:
4627 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4628 Jim_AppendStrings(interp, Jim_GetResult(interp),
4629 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4630 return JIM_ERR;
4631 }
4632
4633 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4634 {
4635 Jim_Free((void*)interp->errorFileName);
4636 interp->errorFileName = Jim_StrDup(filename);
4637 }
4638
4639 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4640 {
4641 interp->errorLine = linenr;
4642 }
4643
4644 static void JimResetStackTrace(Jim_Interp *interp)
4645 {
4646 Jim_DecrRefCount(interp, interp->stackTrace);
4647 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4648 Jim_IncrRefCount(interp->stackTrace);
4649 }
4650
4651 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4652 const char *filename, int linenr)
4653 {
4654 /* No need to add this dummy entry to the stack trace */
4655 if (strcmp(procname, "unknown") == 0) {
4656 return;
4657 }
4658
4659 if (Jim_IsShared(interp->stackTrace)) {
4660 interp->stackTrace =
4661 Jim_DuplicateObj(interp, interp->stackTrace);
4662 Jim_IncrRefCount(interp->stackTrace);
4663 }
4664 Jim_ListAppendElement(interp, interp->stackTrace,
4665 Jim_NewStringObj(interp, procname, -1));
4666 Jim_ListAppendElement(interp, interp->stackTrace,
4667 Jim_NewStringObj(interp, filename, -1));
4668 Jim_ListAppendElement(interp, interp->stackTrace,
4669 Jim_NewIntObj(interp, linenr));
4670 }
4671
4672 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4673 {
4674 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4675 assocEntryPtr->delProc = delProc;
4676 assocEntryPtr->data = data;
4677 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4678 }
4679
4680 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4681 {
4682 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4683 if (entryPtr != NULL) {
4684 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4685 return assocEntryPtr->data;
4686 }
4687 return NULL;
4688 }
4689
4690 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4691 {
4692 return Jim_DeleteHashEntry(&interp->assocData, key);
4693 }
4694
4695 int Jim_GetExitCode(Jim_Interp *interp) {
4696 return interp->exitCode;
4697 }
4698
4699 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4700 {
4701 if (fp != NULL) interp->cookie_stdin = fp;
4702 return interp->cookie_stdin;
4703 }
4704
4705 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4706 {
4707 if (fp != NULL) interp->cookie_stdout = fp;
4708 return interp->cookie_stdout;
4709 }
4710
4711 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4712 {
4713 if (fp != NULL) interp->cookie_stderr = fp;
4714 return interp->cookie_stderr;
4715 }
4716
4717 /* -----------------------------------------------------------------------------
4718 * Shared strings.
4719 * Every interpreter has an hash table where to put shared dynamically
4720 * allocate strings that are likely to be used a lot of times.
4721 * For example, in the 'source' object type, there is a pointer to
4722 * the filename associated with that object. Every script has a lot
4723 * of this objects with the identical file name, so it is wise to share
4724 * this info.
4725 *
4726 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4727 * returns the pointer to the shared string. Every time a reference
4728 * to the string is no longer used, the user should call
4729 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4730 * a given string, it is removed from the hash table.
4731 * ---------------------------------------------------------------------------*/
4732 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4733 {
4734 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4735
4736 if (he == NULL) {
4737 char *strCopy = Jim_StrDup(str);
4738
4739 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4740 return strCopy;
4741 } else {
4742 long refCount = (long) he->val;
4743
4744 refCount++;
4745 he->val = (void*) refCount;
4746 return he->key;
4747 }
4748 }
4749
4750 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4751 {
4752 long refCount;
4753 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4754
4755 if (he == NULL)
4756 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4757 "unknown shared string '%s'", str);
4758 refCount = (long) he->val;
4759 refCount--;
4760 if (refCount == 0) {
4761 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4762 } else {
4763 he->val = (void*) refCount;
4764 }
4765 }
4766
4767 /* -----------------------------------------------------------------------------
4768 * Integer object
4769 * ---------------------------------------------------------------------------*/
4770 #define JIM_INTEGER_SPACE 24
4771
4772 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4773 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4774
4775 static Jim_ObjType intObjType = {
4776 "int",
4777 NULL,
4778 NULL,
4779 UpdateStringOfInt,
4780 JIM_TYPE_NONE,
4781 };
4782
4783 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4784 {
4785 int len;
4786 char buf[JIM_INTEGER_SPACE+1];
4787
4788 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4789 objPtr->bytes = Jim_Alloc(len+1);
4790 memcpy(objPtr->bytes, buf, len+1);
4791 objPtr->length = len;
4792 }
4793
4794 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4795 {
4796 jim_wide wideValue;
4797 const char *str;
4798
4799 /* Get the string representation */
4800 str = Jim_GetString(objPtr, NULL);
4801 /* Try to convert into a jim_wide */
4802 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4803 if (flags & JIM_ERRMSG) {
4804 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4805 Jim_AppendStrings(interp, Jim_GetResult(interp),
4806 "expected integer but got \"", str, "\"", NULL);
4807 }
4808 return JIM_ERR;
4809 }
4810 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4811 errno == ERANGE) {
4812 Jim_SetResultString(interp,
4813 "Integer value too big to be represented", -1);
4814 return JIM_ERR;
4815 }
4816 /* Free the old internal repr and set the new one. */
4817 Jim_FreeIntRep(interp, objPtr);
4818 objPtr->typePtr = &intObjType;
4819 objPtr->internalRep.wideValue = wideValue;
4820 return JIM_OK;
4821 }
4822
4823 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4824 {
4825 if (objPtr->typePtr != &intObjType &&
4826 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4827 return JIM_ERR;
4828 *widePtr = objPtr->internalRep.wideValue;
4829 return JIM_OK;
4830 }
4831
4832 /* Get a wide but does not set an error if the format is bad. */
4833 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4834 jim_wide *widePtr)
4835 {
4836 if (objPtr->typePtr != &intObjType &&
4837 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4838 return JIM_ERR;
4839 *widePtr = objPtr->internalRep.wideValue;
4840 return JIM_OK;
4841 }
4842
4843 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4844 {
4845 jim_wide wideValue;
4846 int retval;
4847
4848 retval = Jim_GetWide(interp, objPtr, &wideValue);
4849 if (retval == JIM_OK) {
4850 *longPtr = (long) wideValue;
4851 return JIM_OK;
4852 }
4853 return JIM_ERR;
4854 }
4855
4856 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4857 {
4858 if (Jim_IsShared(objPtr))
4859 Jim_Panic(interp,"Jim_SetWide called with shared object");
4860 if (objPtr->typePtr != &intObjType) {
4861 Jim_FreeIntRep(interp, objPtr);
4862 objPtr->typePtr = &intObjType;
4863 }
4864 Jim_InvalidateStringRep(objPtr);
4865 objPtr->internalRep.wideValue = wideValue;
4866 }
4867
4868 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4869 {
4870 Jim_Obj *objPtr;
4871
4872 objPtr = Jim_NewObj(interp);
4873 objPtr->typePtr = &intObjType;
4874 objPtr->bytes = NULL;
4875 objPtr->internalRep.wideValue = wideValue;
4876 return objPtr;
4877 }
4878
4879 /* -----------------------------------------------------------------------------
4880 * Double object
4881 * ---------------------------------------------------------------------------*/
4882 #define JIM_DOUBLE_SPACE 30
4883
4884 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4885 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4886
4887 static Jim_ObjType doubleObjType = {
4888 "double",
4889 NULL,
4890 NULL,
4891 UpdateStringOfDouble,
4892 JIM_TYPE_NONE,
4893 };
4894
4895 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4896 {
4897 int len;
4898 char buf[JIM_DOUBLE_SPACE+1];
4899
4900 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4901 objPtr->bytes = Jim_Alloc(len+1);
4902 memcpy(objPtr->bytes, buf, len+1);
4903 objPtr->length = len;
4904 }
4905
4906 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4907 {
4908 double doubleValue;
4909 const char *str;
4910
4911 /* Get the string representation */
4912 str = Jim_GetString(objPtr, NULL);
4913 /* Try to convert into a double */
4914 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4915 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4916 Jim_AppendStrings(interp, Jim_GetResult(interp),
4917 "expected number but got '", str, "'", NULL);
4918 return JIM_ERR;
4919 }
4920 /* Free the old internal repr and set the new one. */
4921 Jim_FreeIntRep(interp, objPtr);
4922 objPtr->typePtr = &doubleObjType;
4923 objPtr->internalRep.doubleValue = doubleValue;
4924 return JIM_OK;
4925 }
4926
4927 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4928 {
4929 if (objPtr->typePtr != &doubleObjType &&
4930 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4931 return JIM_ERR;
4932 *doublePtr = objPtr->internalRep.doubleValue;
4933 return JIM_OK;
4934 }
4935
4936 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4937 {
4938 if (Jim_IsShared(objPtr))
4939 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4940 if (objPtr->typePtr != &doubleObjType) {
4941 Jim_FreeIntRep(interp, objPtr);
4942 objPtr->typePtr = &doubleObjType;
4943 }
4944 Jim_InvalidateStringRep(objPtr);
4945 objPtr->internalRep.doubleValue = doubleValue;
4946 }
4947
4948 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4949 {
4950 Jim_Obj *objPtr;
4951
4952 objPtr = Jim_NewObj(interp);
4953 objPtr->typePtr = &doubleObjType;
4954 objPtr->bytes = NULL;
4955 objPtr->internalRep.doubleValue = doubleValue;
4956 return objPtr;
4957 }
4958
4959 /* -----------------------------------------------------------------------------
4960 * List object
4961 * ---------------------------------------------------------------------------*/
4962 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4963 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4964 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4965 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4966 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4967
4968 /* Note that while the elements of the list may contain references,
4969 * the list object itself can't. This basically means that the
4970 * list object string representation as a whole can't contain references
4971 * that are not presents in the single elements. */
4972 static Jim_ObjType listObjType = {
4973 "list",
4974 FreeListInternalRep,
4975 DupListInternalRep,
4976 UpdateStringOfList,
4977 JIM_TYPE_NONE,
4978 };
4979
4980 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4981 {
4982 int i;
4983
4984 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4985 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4986 }
4987 Jim_Free(objPtr->internalRep.listValue.ele);
4988 }
4989
4990 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4991 {
4992 int i;
4993 JIM_NOTUSED(interp);
4994
4995 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4996 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4997 dupPtr->internalRep.listValue.ele =
4998 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4999 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5000 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5001 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5002 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5003 }
5004 dupPtr->typePtr = &listObjType;
5005 }
5006
5007 /* The following function checks if a given string can be encoded
5008 * into a list element without any kind of quoting, surrounded by braces,
5009 * or using escapes to quote. */
5010 #define JIM_ELESTR_SIMPLE 0
5011 #define JIM_ELESTR_BRACE 1
5012 #define JIM_ELESTR_QUOTE 2
5013 static int ListElementQuotingType(const char *s, int len)
5014 {
5015 int i, level, trySimple = 1;
5016
5017 /* Try with the SIMPLE case */
5018 if (len == 0) return JIM_ELESTR_BRACE;
5019 if (s[0] == '"' || s[0] == '{') {
5020 trySimple = 0;
5021 goto testbrace;
5022 }
5023 for (i = 0; i < len; i++) {
5024 switch(s[i]) {
5025 case ' ':
5026 case '$':
5027 case '"':
5028 case '[':
5029 case ']':
5030 case ';':
5031 case '\\':
5032 case '\r':
5033 case '\n':
5034 case '\t':
5035 case '\f':
5036 case '\v':
5037 trySimple = 0;
5038 case '{':
5039 case '}':
5040 goto testbrace;
5041 }
5042 }
5043 return JIM_ELESTR_SIMPLE;
5044
5045 testbrace:
5046 /* Test if it's possible to do with braces */
5047 if (s[len-1] == '\\' ||
5048 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5049 level = 0;
5050 for (i = 0; i < len; i++) {
5051 switch(s[i]) {
5052 case '{': level++; break;
5053 case '}': level--;
5054 if (level < 0) return JIM_ELESTR_QUOTE;
5055 break;
5056 case '\\':
5057 if (s[i+1] == '\n')
5058 return JIM_ELESTR_QUOTE;
5059 else
5060 if (s[i+1] != '\0') i++;
5061 break;
5062 }
5063 }
5064 if (level == 0) {
5065 if (!trySimple) return JIM_ELESTR_BRACE;
5066 for (i = 0; i < len; i++) {
5067 switch(s[i]) {
5068 case ' ':
5069 case '$':
5070 case '"':
5071 case '[':
5072 case ']':
5073 case ';':
5074 case '\\':
5075 case '\r':
5076 case '\n':
5077 case '\t':
5078 case '\f':
5079 case '\v':
5080 return JIM_ELESTR_BRACE;
5081 break;
5082 }
5083 }
5084 return JIM_ELESTR_SIMPLE;
5085 }
5086 return JIM_ELESTR_QUOTE;
5087 }
5088
5089 /* Returns the malloc-ed representation of a string
5090 * using backslash to quote special chars. */
5091 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5092 {
5093 char *q = Jim_Alloc(len*2+1), *p;
5094
5095 p = q;
5096 while(*s) {
5097 switch (*s) {
5098 case ' ':
5099 case '$':
5100 case '"':
5101 case '[':
5102 case ']':
5103 case '{':
5104 case '}':
5105 case ';':
5106 case '\\':
5107 *p++ = '\\';
5108 *p++ = *s++;
5109 break;
5110 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5111 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5112 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5113 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5114 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5115 default:
5116 *p++ = *s++;
5117 break;
5118 }
5119 }
5120 *p = '\0';
5121 *qlenPtr = p-q;
5122 return q;
5123 }
5124
5125 void UpdateStringOfList(struct Jim_Obj *objPtr)
5126 {
5127 int i, bufLen, realLength;
5128 const char *strRep;
5129 char *p;
5130 int *quotingType;
5131 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5132
5133 /* (Over) Estimate the space needed. */
5134 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5135 bufLen = 0;
5136 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5137 int len;
5138
5139 strRep = Jim_GetString(ele[i], &len);
5140 quotingType[i] = ListElementQuotingType(strRep, len);
5141 switch (quotingType[i]) {
5142 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5143 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5144 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5145 }
5146 bufLen++; /* elements separator. */
5147 }
5148 bufLen++;
5149
5150 /* Generate the string rep. */
5151 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5152 realLength = 0;
5153 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5154 int len, qlen;
5155 const char *strRep = Jim_GetString(ele[i], &len);
5156 char *q;
5157
5158 switch(quotingType[i]) {
5159 case JIM_ELESTR_SIMPLE:
5160 memcpy(p, strRep, len);
5161 p += len;
5162 realLength += len;
5163 break;
5164 case JIM_ELESTR_BRACE:
5165 *p++ = '{';
5166 memcpy(p, strRep, len);
5167 p += len;
5168 *p++ = '}';
5169 realLength += len+2;
5170 break;
5171 case JIM_ELESTR_QUOTE:
5172 q = BackslashQuoteString(strRep, len, &qlen);
5173 memcpy(p, q, qlen);
5174 Jim_Free(q);
5175 p += qlen;
5176 realLength += qlen;
5177 break;
5178 }
5179 /* Add a separating space */
5180 if (i+1 != objPtr->internalRep.listValue.len) {
5181 *p++ = ' ';
5182 realLength ++;
5183 }
5184 }
5185 *p = '\0'; /* nul term. */
5186 objPtr->length = realLength;
5187 Jim_Free(quotingType);
5188 }
5189
5190 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5191 {
5192 struct JimParserCtx parser;
5193 const char *str;
5194 int strLen;
5195
5196 /* Get the string representation */
5197 str = Jim_GetString(objPtr, &strLen);
5198
5199 /* Free the old internal repr just now and initialize the
5200 * new one just now. The string->list conversion can't fail. */
5201 Jim_FreeIntRep(interp, objPtr);
5202 objPtr->typePtr = &listObjType;
5203 objPtr->internalRep.listValue.len = 0;
5204 objPtr->internalRep.listValue.maxLen = 0;
5205 objPtr->internalRep.listValue.ele = NULL;
5206
5207 /* Convert into a list */
5208 JimParserInit(&parser, str, strLen, 1);
5209 while(!JimParserEof(&parser)) {
5210 char *token;
5211 int tokenLen, type;
5212 Jim_Obj *elementPtr;
5213
5214 JimParseList(&parser);
5215 if (JimParserTtype(&parser) != JIM_TT_STR &&
5216 JimParserTtype(&parser) != JIM_TT_ESC)
5217 continue;
5218 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5219 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5220 ListAppendElement(objPtr, elementPtr);
5221 }
5222 return JIM_OK;
5223 }
5224
5225 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5226 int len)
5227 {
5228 Jim_Obj *objPtr;
5229 int i;
5230
5231 objPtr = Jim_NewObj(interp);
5232 objPtr->typePtr = &listObjType;
5233 objPtr->bytes = NULL;
5234 objPtr->internalRep.listValue.ele = NULL;
5235 objPtr->internalRep.listValue.len = 0;
5236 objPtr->internalRep.listValue.maxLen = 0;
5237 for (i = 0; i < len; i++) {
5238 ListAppendElement(objPtr, elements[i]);
5239 }
5240 return objPtr;
5241 }
5242
5243 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5244 * length of the vector. Note that the user of this function should make
5245 * sure that the list object can't shimmer while the vector returned
5246 * is in use, this vector is the one stored inside the internal representation
5247 * of the list object. This function is not exported, extensions should
5248 * always access to the List object elements using Jim_ListIndex(). */
5249 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5250 Jim_Obj ***listVec)
5251 {
5252 Jim_ListLength(interp, listObj, argc);
5253 assert(listObj->typePtr == &listObjType);
5254 *listVec = listObj->internalRep.listValue.ele;
5255 }
5256
5257 /* ListSortElements type values */
5258 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5259 JIM_LSORT_NOCASE_DECR};
5260
5261 /* Sort the internal rep of a list. */
5262 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5263 {
5264 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5265 }
5266
5267 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5268 {
5269 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5270 }
5271
5272 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5273 {
5274 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5275 }
5276
5277 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5278 {
5279 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5280 }
5281
5282 /* Sort a list *in place*. MUST be called with non-shared objects. */
5283 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5284 {
5285 typedef int (qsort_comparator)(const void *, const void *);
5286 int (*fn)(Jim_Obj**, Jim_Obj**);
5287 Jim_Obj **vector;
5288 int len;
5289
5290 if (Jim_IsShared(listObjPtr))
5291 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5292 if (listObjPtr->typePtr != &listObjType)
5293 SetListFromAny(interp, listObjPtr);
5294
5295 vector = listObjPtr->internalRep.listValue.ele;
5296 len = listObjPtr->internalRep.listValue.len;
5297 switch (type) {
5298 case JIM_LSORT_ASCII: fn = ListSortString; break;
5299 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5300 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5301 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5302 default:
5303 fn = NULL; /* avoid warning */
5304 Jim_Panic(interp,"ListSort called with invalid sort type");
5305 }
5306 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5307 Jim_InvalidateStringRep(listObjPtr);
5308 }
5309
5310 /* This is the low-level function to append an element to a list.
5311 * The higher-level Jim_ListAppendElement() performs shared object
5312 * check and invalidate the string repr. This version is used
5313 * in the internals of the List Object and is not exported.
5314 *
5315 * NOTE: this function can be called only against objects
5316 * with internal type of List. */
5317 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5318 {
5319 int requiredLen = listPtr->internalRep.listValue.len + 1;
5320
5321 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5322 int maxLen = requiredLen * 2;
5323
5324 listPtr->internalRep.listValue.ele =
5325 Jim_Realloc(listPtr->internalRep.listValue.ele,
5326 sizeof(Jim_Obj*)*maxLen);
5327 listPtr->internalRep.listValue.maxLen = maxLen;
5328 }
5329 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5330 objPtr;
5331 listPtr->internalRep.listValue.len ++;
5332 Jim_IncrRefCount(objPtr);
5333 }
5334
5335 /* This is the low-level function to insert elements into a list.
5336 * The higher-level Jim_ListInsertElements() performs shared object
5337 * check and invalidate the string repr. This version is used
5338 * in the internals of the List Object and is not exported.
5339 *
5340 * NOTE: this function can be called only against objects
5341 * with internal type of List. */
5342 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5343 Jim_Obj *const *elemVec)
5344 {
5345 int currentLen = listPtr->internalRep.listValue.len;
5346 int requiredLen = currentLen + elemc;
5347 int i;
5348 Jim_Obj **point;
5349
5350 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5351 int maxLen = requiredLen * 2;
5352
5353 listPtr->internalRep.listValue.ele =
5354 Jim_Realloc(listPtr->internalRep.listValue.ele,
5355 sizeof(Jim_Obj*)*maxLen);
5356 listPtr->internalRep.listValue.maxLen = maxLen;
5357 }
5358 point = listPtr->internalRep.listValue.ele + index;
5359 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5360 for (i=0; i < elemc; ++i) {
5361 point[i] = elemVec[i];
5362 Jim_IncrRefCount(point[i]);
5363 }
5364 listPtr->internalRep.listValue.len += elemc;
5365 }
5366
5367 /* Appends every element of appendListPtr into listPtr.
5368 * Both have to be of the list type. */
5369 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5370 {
5371 int i, oldLen = listPtr->internalRep.listValue.len;
5372 int appendLen = appendListPtr->internalRep.listValue.len;
5373 int requiredLen = oldLen + appendLen;
5374
5375 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5376 int maxLen = requiredLen * 2;
5377
5378 listPtr->internalRep.listValue.ele =
5379 Jim_Realloc(listPtr->internalRep.listValue.ele,
5380 sizeof(Jim_Obj*)*maxLen);
5381 listPtr->internalRep.listValue.maxLen = maxLen;
5382 }
5383 for (i = 0; i < appendLen; i++) {
5384 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5385 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5386 Jim_IncrRefCount(objPtr);
5387 }
5388 listPtr->internalRep.listValue.len += appendLen;
5389 }
5390
5391 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5392 {
5393 if (Jim_IsShared(listPtr))
5394 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5395 if (listPtr->typePtr != &listObjType)
5396 SetListFromAny(interp, listPtr);
5397 Jim_InvalidateStringRep(listPtr);
5398 ListAppendElement(listPtr, objPtr);
5399 }
5400
5401 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5402 {
5403 if (Jim_IsShared(listPtr))
5404 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5405 if (listPtr->typePtr != &listObjType)
5406 SetListFromAny(interp, listPtr);
5407 Jim_InvalidateStringRep(listPtr);
5408 ListAppendList(listPtr, appendListPtr);
5409 }
5410
5411 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5412 {
5413 if (listPtr->typePtr != &listObjType)
5414 SetListFromAny(interp, listPtr);
5415 *intPtr = listPtr->internalRep.listValue.len;
5416 }
5417
5418 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5419 int objc, Jim_Obj *const *objVec)
5420 {
5421 if (Jim_IsShared(listPtr))
5422 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5423 if (listPtr->typePtr != &listObjType)
5424 SetListFromAny(interp, listPtr);
5425 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5426 index = listPtr->internalRep.listValue.len;
5427 else if (index < 0 )
5428 index = 0;
5429 Jim_InvalidateStringRep(listPtr);
5430 ListInsertElements(listPtr, index, objc, objVec);
5431 }
5432
5433 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5434 Jim_Obj **objPtrPtr, int flags)
5435 {
5436 if (listPtr->typePtr != &listObjType)
5437 SetListFromAny(interp, listPtr);
5438 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5439 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5440 if (flags & JIM_ERRMSG) {
5441 Jim_SetResultString(interp,
5442 "list index out of range", -1);
5443 }
5444 return JIM_ERR;
5445 }
5446 if (index < 0)
5447 index = listPtr->internalRep.listValue.len+index;
5448 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5449 return JIM_OK;
5450 }
5451
5452 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5453 Jim_Obj *newObjPtr, int flags)
5454 {
5455 if (listPtr->typePtr != &listObjType)
5456 SetListFromAny(interp, listPtr);
5457 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5458 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5459 if (flags & JIM_ERRMSG) {
5460 Jim_SetResultString(interp,
5461 "list index out of range", -1);
5462 }
5463 return JIM_ERR;
5464 }
5465 if (index < 0)
5466 index = listPtr->internalRep.listValue.len+index;
5467 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5468 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5469 Jim_IncrRefCount(newObjPtr);
5470 return JIM_OK;
5471 }
5472
5473 /* Modify the list stored into the variable named 'varNamePtr'
5474 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5475 * with the new element 'newObjptr'. */
5476 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5477 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5478 {
5479 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5480 int shared, i, index;
5481
5482 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5483 if (objPtr == NULL)
5484 return JIM_ERR;
5485 if ((shared = Jim_IsShared(objPtr)))
5486 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5487 for (i = 0; i < indexc-1; i++) {
5488 listObjPtr = objPtr;
5489 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5490 goto err;
5491 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5492 JIM_ERRMSG) != JIM_OK) {
5493 goto err;
5494 }
5495 if (Jim_IsShared(objPtr)) {
5496 objPtr = Jim_DuplicateObj(interp, objPtr);
5497 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5498 }
5499 Jim_InvalidateStringRep(listObjPtr);
5500 }
5501 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5502 goto err;
5503 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5504 goto err;
5505 Jim_InvalidateStringRep(objPtr);
5506 Jim_InvalidateStringRep(varObjPtr);
5507 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5508 goto err;
5509 Jim_SetResult(interp, varObjPtr);
5510 return JIM_OK;
5511 err:
5512 if (shared) {
5513 Jim_FreeNewObj(interp, varObjPtr);
5514 }
5515 return JIM_ERR;
5516 }
5517
5518 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5519 {
5520 int i;
5521
5522 /* If all the objects in objv are lists without string rep.
5523 * it's possible to return a list as result, that's the
5524 * concatenation of all the lists. */
5525 for (i = 0; i < objc; i++) {
5526 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5527 break;
5528 }
5529 if (i == objc) {
5530 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5531 for (i = 0; i < objc; i++)
5532 Jim_ListAppendList(interp, objPtr, objv[i]);
5533 return objPtr;
5534 } else {
5535 /* Else... we have to glue strings together */
5536 int len = 0, objLen;
5537 char *bytes, *p;
5538
5539 /* Compute the length */
5540 for (i = 0; i < objc; i++) {
5541 Jim_GetString(objv[i], &objLen);
5542 len += objLen;
5543 }
5544 if (objc) len += objc-1;
5545 /* Create the string rep, and a stinrg object holding it. */
5546 p = bytes = Jim_Alloc(len+1);
5547 for (i = 0; i < objc; i++) {
5548 const char *s = Jim_GetString(objv[i], &objLen);
5549 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5550 {
5551 s++; objLen--; len--;
5552 }
5553 while (objLen && (s[objLen-1] == ' ' ||
5554 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5555 objLen--; len--;
5556 }
5557 memcpy(p, s, objLen);
5558 p += objLen;
5559 if (objLen && i+1 != objc) {
5560 *p++ = ' ';
5561 } else if (i+1 != objc) {
5562 /* Drop the space calcuated for this
5563 * element that is instead null. */
5564 len--;
5565 }
5566 }
5567 *p = '\0';
5568 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5569 }
5570 }
5571
5572 /* Returns a list composed of the elements in the specified range.
5573 * first and start are directly accepted as Jim_Objects and
5574 * processed for the end?-index? case. */
5575 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5576 {
5577 int first, last;
5578 int len, rangeLen;
5579
5580 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5581 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5582 return NULL;
5583 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5584 first = JimRelToAbsIndex(len, first);
5585 last = JimRelToAbsIndex(len, last);
5586 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5587 return Jim_NewListObj(interp,
5588 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5589 }
5590
5591 /* -----------------------------------------------------------------------------
5592 * Dict object
5593 * ---------------------------------------------------------------------------*/
5594 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5595 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5596 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5597 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5598
5599 /* Dict HashTable Type.
5600 *
5601 * Keys and Values are Jim objects. */
5602
5603 unsigned int JimObjectHTHashFunction(const void *key)
5604 {
5605 const char *str;
5606 Jim_Obj *objPtr = (Jim_Obj*) key;
5607 int len, h;
5608
5609 str = Jim_GetString(objPtr, &len);
5610 h = Jim_GenHashFunction((unsigned char*)str, len);
5611 return h;
5612 }
5613
5614 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5615 {
5616 JIM_NOTUSED(privdata);
5617
5618 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5619 }
5620
5621 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5622 {
5623 Jim_Obj *objPtr = val;
5624
5625 Jim_DecrRefCount(interp, objPtr);
5626 }
5627
5628 static Jim_HashTableType JimDictHashTableType = {
5629 JimObjectHTHashFunction, /* hash function */
5630 NULL, /* key dup */
5631 NULL, /* val dup */
5632 JimObjectHTKeyCompare, /* key compare */
5633 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5634 JimObjectHTKeyValDestructor, /* key destructor */
5635 JimObjectHTKeyValDestructor /* val destructor */
5636 };
5637
5638 /* Note that while the elements of the dict may contain references,
5639 * the list object itself can't. This basically means that the
5640 * dict object string representation as a whole can't contain references
5641 * that are not presents in the single elements. */
5642 static Jim_ObjType dictObjType = {
5643 "dict",
5644 FreeDictInternalRep,
5645 DupDictInternalRep,
5646 UpdateStringOfDict,
5647 JIM_TYPE_NONE,
5648 };
5649
5650 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5651 {
5652 JIM_NOTUSED(interp);
5653
5654 Jim_FreeHashTable(objPtr->internalRep.ptr);
5655 Jim_Free(objPtr->internalRep.ptr);
5656 }
5657
5658 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5659 {
5660 Jim_HashTable *ht, *dupHt;
5661 Jim_HashTableIterator *htiter;
5662 Jim_HashEntry *he;
5663
5664 /* Create a new hash table */
5665 ht = srcPtr->internalRep.ptr;
5666 dupHt = Jim_Alloc(sizeof(*dupHt));
5667 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5668 if (ht->size != 0)
5669 Jim_ExpandHashTable(dupHt, ht->size);
5670 /* Copy every element from the source to the dup hash table */
5671 htiter = Jim_GetHashTableIterator(ht);
5672 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5673 const Jim_Obj *keyObjPtr = he->key;
5674 Jim_Obj *valObjPtr = he->val;
5675
5676 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5677 Jim_IncrRefCount(valObjPtr);
5678 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5679 }
5680 Jim_FreeHashTableIterator(htiter);
5681
5682 dupPtr->internalRep.ptr = dupHt;
5683 dupPtr->typePtr = &dictObjType;
5684 }
5685
5686 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5687 {
5688 int i, bufLen, realLength;
5689 const char *strRep;
5690 char *p;
5691 int *quotingType, objc;
5692 Jim_HashTable *ht;
5693 Jim_HashTableIterator *htiter;
5694 Jim_HashEntry *he;
5695 Jim_Obj **objv;
5696
5697 /* Trun the hash table into a flat vector of Jim_Objects. */
5698 ht = objPtr->internalRep.ptr;
5699 objc = ht->used*2;
5700 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5701 htiter = Jim_GetHashTableIterator(ht);
5702 i = 0;
5703 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5704 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5705 objv[i++] = he->val;
5706 }
5707 Jim_FreeHashTableIterator(htiter);
5708 /* (Over) Estimate the space needed. */
5709 quotingType = Jim_Alloc(sizeof(int)*objc);
5710 bufLen = 0;
5711 for (i = 0; i < objc; i++) {
5712 int len;
5713
5714 strRep = Jim_GetString(objv[i], &len);
5715 quotingType[i] = ListElementQuotingType(strRep, len);
5716 switch (quotingType[i]) {
5717 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5718 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5719 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5720 }
5721 bufLen++; /* elements separator. */
5722 }
5723 bufLen++;
5724
5725 /* Generate the string rep. */
5726 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5727 realLength = 0;
5728 for (i = 0; i < objc; i++) {
5729 int len, qlen;
5730 const char *strRep = Jim_GetString(objv[i], &len);
5731 char *q;
5732
5733 switch(quotingType[i]) {
5734 case JIM_ELESTR_SIMPLE:
5735 memcpy(p, strRep, len);
5736 p += len;
5737 realLength += len;
5738 break;
5739 case JIM_ELESTR_BRACE:
5740 *p++ = '{';
5741 memcpy(p, strRep, len);
5742 p += len;
5743 *p++ = '}';
5744 realLength += len+2;
5745 break;
5746 case JIM_ELESTR_QUOTE:
5747 q = BackslashQuoteString(strRep, len, &qlen);
5748 memcpy(p, q, qlen);
5749 Jim_Free(q);
5750 p += qlen;
5751 realLength += qlen;
5752 break;
5753 }
5754 /* Add a separating space */
5755 if (i+1 != objc) {
5756 *p++ = ' ';
5757 realLength ++;
5758 }
5759 }
5760 *p = '\0'; /* nul term. */
5761 objPtr->length = realLength;
5762 Jim_Free(quotingType);
5763 Jim_Free(objv);
5764 }
5765
5766 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5767 {
5768 struct JimParserCtx parser;
5769 Jim_HashTable *ht;
5770 Jim_Obj *objv[2];
5771 const char *str;
5772 int i, strLen;
5773
5774 /* Get the string representation */
5775 str = Jim_GetString(objPtr, &strLen);
5776
5777 /* Free the old internal repr just now and initialize the
5778 * new one just now. The string->list conversion can't fail. */
5779 Jim_FreeIntRep(interp, objPtr);
5780 ht = Jim_Alloc(sizeof(*ht));
5781 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5782 objPtr->typePtr = &dictObjType;
5783 objPtr->internalRep.ptr = ht;
5784
5785 /* Convert into a dict */
5786 JimParserInit(&parser, str, strLen, 1);
5787 i = 0;
5788 while(!JimParserEof(&parser)) {
5789 char *token;
5790 int tokenLen, type;
5791
5792 JimParseList(&parser);
5793 if (JimParserTtype(&parser) != JIM_TT_STR &&
5794 JimParserTtype(&parser) != JIM_TT_ESC)
5795 continue;
5796 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5797 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5798 if (i == 2) {
5799 i = 0;
5800 Jim_IncrRefCount(objv[0]);
5801 Jim_IncrRefCount(objv[1]);
5802 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5803 Jim_HashEntry *he;
5804 he = Jim_FindHashEntry(ht, objv[0]);
5805 Jim_DecrRefCount(interp, objv[0]);
5806 /* ATTENTION: const cast */
5807 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5808 he->val = objv[1];
5809 }
5810 }
5811 }
5812 if (i) {
5813 Jim_FreeNewObj(interp, objv[0]);
5814 objPtr->typePtr = NULL;
5815 Jim_FreeHashTable(ht);
5816 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5817 return JIM_ERR;
5818 }
5819 return JIM_OK;
5820 }
5821
5822 /* Dict object API */
5823
5824 /* Add an element to a dict. objPtr must be of the "dict" type.
5825 * The higer-level exported function is Jim_DictAddElement().
5826 * If an element with the specified key already exists, the value
5827 * associated is replaced with the new one.
5828 *
5829 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5830 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5831 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5832 {
5833 Jim_HashTable *ht = objPtr->internalRep.ptr;
5834
5835 if (valueObjPtr == NULL) { /* unset */
5836 Jim_DeleteHashEntry(ht, keyObjPtr);
5837 return;
5838 }
5839 Jim_IncrRefCount(keyObjPtr);
5840 Jim_IncrRefCount(valueObjPtr);
5841 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5842 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5843 Jim_DecrRefCount(interp, keyObjPtr);
5844 /* ATTENTION: const cast */
5845 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5846 he->val = valueObjPtr;
5847 }
5848 }
5849
5850 /* Add an element, higher-level interface for DictAddElement().
5851 * If valueObjPtr == NULL, the key is removed if it exists. */
5852 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5853 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5854 {
5855 if (Jim_IsShared(objPtr))
5856 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5857 if (objPtr->typePtr != &dictObjType) {
5858 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5859 return JIM_ERR;
5860 }
5861 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5862 Jim_InvalidateStringRep(objPtr);
5863 return JIM_OK;
5864 }
5865
5866 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5867 {
5868 Jim_Obj *objPtr;
5869 int i;
5870
5871 if (len % 2)
5872 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5873
5874 objPtr = Jim_NewObj(interp);
5875 objPtr->typePtr = &dictObjType;
5876 objPtr->bytes = NULL;
5877 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5878 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5879 for (i = 0; i < len; i += 2)
5880 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5881 return objPtr;
5882 }
5883
5884 /* Return the value associated to the specified dict key */
5885 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5886 Jim_Obj **objPtrPtr, int flags)
5887 {
5888 Jim_HashEntry *he;
5889 Jim_HashTable *ht;
5890
5891 if (dictPtr->typePtr != &dictObjType) {
5892 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5893 return JIM_ERR;
5894 }
5895 ht = dictPtr->internalRep.ptr;
5896 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5897 if (flags & JIM_ERRMSG) {
5898 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5899 Jim_AppendStrings(interp, Jim_GetResult(interp),
5900 "key \"", Jim_GetString(keyPtr, NULL),
5901 "\" not found in dictionary", NULL);
5902 }
5903 return JIM_ERR;
5904 }
5905 *objPtrPtr = he->val;
5906 return JIM_OK;
5907 }
5908
5909 /* Return the value associated to the specified dict keys */
5910 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5911 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5912 {
5913 Jim_Obj *objPtr;
5914 int i;
5915
5916 if (keyc == 0) {
5917 *objPtrPtr = dictPtr;
5918 return JIM_OK;
5919 }
5920
5921 for (i = 0; i < keyc; i++) {
5922 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5923 != JIM_OK)
5924 return JIM_ERR;
5925 dictPtr = objPtr;
5926 }
5927 *objPtrPtr = objPtr;
5928 return JIM_OK;
5929 }
5930
5931 /* Modify the dict stored into the variable named 'varNamePtr'
5932 * setting the element specified by the 'keyc' keys objects in 'keyv',
5933 * with the new value of the element 'newObjPtr'.
5934 *
5935 * If newObjPtr == NULL the operation is to remove the given key
5936 * from the dictionary. */
5937 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5938 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5939 {
5940 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5941 int shared, i;
5942
5943 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5944 if (objPtr == NULL) {
5945 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5946 return JIM_ERR;
5947 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5948 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5949 Jim_FreeNewObj(interp, varObjPtr);
5950 return JIM_ERR;
5951 }
5952 }
5953 if ((shared = Jim_IsShared(objPtr)))
5954 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5955 for (i = 0; i < keyc-1; i++) {
5956 dictObjPtr = objPtr;
5957
5958 /* Check if it's a valid dictionary */
5959 if (dictObjPtr->typePtr != &dictObjType) {
5960 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5961 goto err;
5962 }
5963 /* Check if the given key exists. */
5964 Jim_InvalidateStringRep(dictObjPtr);
5965 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5966 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5967 {
5968 /* This key exists at the current level.
5969 * Make sure it's not shared!. */
5970 if (Jim_IsShared(objPtr)) {
5971 objPtr = Jim_DuplicateObj(interp, objPtr);
5972 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5973 }
5974 } else {
5975 /* Key not found. If it's an [unset] operation
5976 * this is an error. Only the last key may not
5977 * exist. */
5978 if (newObjPtr == NULL)
5979 goto err;
5980 /* Otherwise set an empty dictionary
5981 * as key's value. */
5982 objPtr = Jim_NewDictObj(interp, NULL, 0);
5983 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5984 }
5985 }
5986 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5987 != JIM_OK)
5988 goto err;
5989 Jim_InvalidateStringRep(objPtr);
5990 Jim_InvalidateStringRep(varObjPtr);
5991 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5992 goto err;
5993 Jim_SetResult(interp, varObjPtr);
5994 return JIM_OK;
5995 err:
5996 if (shared) {
5997 Jim_FreeNewObj(interp, varObjPtr);
5998 }
5999 return JIM_ERR;
6000 }
6001
6002 /* -----------------------------------------------------------------------------
6003 * Index object
6004 * ---------------------------------------------------------------------------*/
6005 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6006 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6007
6008 static Jim_ObjType indexObjType = {
6009 "index",
6010 NULL,
6011 NULL,
6012 UpdateStringOfIndex,
6013 JIM_TYPE_NONE,
6014 };
6015
6016 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6017 {
6018 int len;
6019 char buf[JIM_INTEGER_SPACE+1];
6020
6021 if (objPtr->internalRep.indexValue >= 0)
6022 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6023 else if (objPtr->internalRep.indexValue == -1)
6024 len = sprintf(buf, "end");
6025 else {
6026 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6027 }
6028 objPtr->bytes = Jim_Alloc(len+1);
6029 memcpy(objPtr->bytes, buf, len+1);
6030 objPtr->length = len;
6031 }
6032
6033 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6034 {
6035 int index, end = 0;
6036 const char *str;
6037
6038 /* Get the string representation */
6039 str = Jim_GetString(objPtr, NULL);
6040 /* Try to convert into an index */
6041 if (!strcmp(str, "end")) {
6042 index = 0;
6043 end = 1;
6044 } else {
6045 if (!strncmp(str, "end-", 4)) {
6046 str += 4;
6047 end = 1;
6048 }
6049 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6050 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6051 Jim_AppendStrings(interp, Jim_GetResult(interp),
6052 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6053 "must be integer or end?-integer?", NULL);
6054 return JIM_ERR;
6055 }
6056 }
6057 if (end) {
6058 if (index < 0)
6059 index = INT_MAX;
6060 else
6061 index = -(index+1);
6062 } else if (!end && index < 0)
6063 index = -INT_MAX;
6064 /* Free the old internal repr and set the new one. */
6065 Jim_FreeIntRep(interp, objPtr);
6066 objPtr->typePtr = &indexObjType;
6067 objPtr->internalRep.indexValue = index;
6068 return JIM_OK;
6069 }
6070
6071 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6072 {
6073 /* Avoid shimmering if the object is an integer. */
6074 if (objPtr->typePtr == &intObjType) {
6075 jim_wide val = objPtr->internalRep.wideValue;
6076 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6077 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6078 return JIM_OK;
6079 }
6080 }
6081 if (objPtr->typePtr != &indexObjType &&
6082 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6083 return JIM_ERR;
6084 *indexPtr = objPtr->internalRep.indexValue;
6085 return JIM_OK;
6086 }
6087
6088 /* -----------------------------------------------------------------------------
6089 * Return Code Object.
6090 * ---------------------------------------------------------------------------*/
6091
6092 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6093
6094 static Jim_ObjType returnCodeObjType = {
6095 "return-code",
6096 NULL,
6097 NULL,
6098 NULL,
6099 JIM_TYPE_NONE,
6100 };
6101
6102 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6103 {
6104 const char *str;
6105 int strLen, returnCode;
6106 jim_wide wideValue;
6107
6108 /* Get the string representation */
6109 str = Jim_GetString(objPtr, &strLen);
6110 /* Try to convert into an integer */
6111 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6112 returnCode = (int) wideValue;
6113 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6114 returnCode = JIM_OK;
6115 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6116 returnCode = JIM_ERR;
6117 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6118 returnCode = JIM_RETURN;
6119 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6120 returnCode = JIM_BREAK;
6121 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6122 returnCode = JIM_CONTINUE;
6123 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6124 returnCode = JIM_EVAL;
6125 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6126 returnCode = JIM_EXIT;
6127 else {
6128 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6129 Jim_AppendStrings(interp, Jim_GetResult(interp),
6130 "expected return code but got '", str, "'",
6131 NULL);
6132 return JIM_ERR;
6133 }
6134 /* Free the old internal repr and set the new one. */
6135 Jim_FreeIntRep(interp, objPtr);
6136 objPtr->typePtr = &returnCodeObjType;
6137 objPtr->internalRep.returnCode = returnCode;
6138 return JIM_OK;
6139 }
6140
6141 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6142 {
6143 if (objPtr->typePtr != &returnCodeObjType &&
6144 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6145 return JIM_ERR;
6146 *intPtr = objPtr->internalRep.returnCode;
6147 return JIM_OK;
6148 }
6149
6150 /* -----------------------------------------------------------------------------
6151 * Expression Parsing
6152 * ---------------------------------------------------------------------------*/
6153 static int JimParseExprOperator(struct JimParserCtx *pc);
6154 static int JimParseExprNumber(struct JimParserCtx *pc);
6155 static int JimParseExprIrrational(struct JimParserCtx *pc);
6156
6157 /* Exrp's Stack machine operators opcodes. */
6158
6159 /* Binary operators (numbers) */
6160 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6161 #define JIM_EXPROP_MUL 0
6162 #define JIM_EXPROP_DIV 1
6163 #define JIM_EXPROP_MOD 2
6164 #define JIM_EXPROP_SUB 3
6165 #define JIM_EXPROP_ADD 4
6166 #define JIM_EXPROP_LSHIFT 5
6167 #define JIM_EXPROP_RSHIFT 6
6168 #define JIM_EXPROP_ROTL 7
6169 #define JIM_EXPROP_ROTR 8
6170 #define JIM_EXPROP_LT 9
6171 #define JIM_EXPROP_GT 10
6172 #define JIM_EXPROP_LTE 11
6173 #define JIM_EXPROP_GTE 12
6174 #define JIM_EXPROP_NUMEQ 13
6175 #define JIM_EXPROP_NUMNE 14
6176 #define JIM_EXPROP_BITAND 15
6177 #define JIM_EXPROP_BITXOR 16
6178 #define JIM_EXPROP_BITOR 17
6179 #define JIM_EXPROP_LOGICAND 18
6180 #define JIM_EXPROP_LOGICOR 19
6181 #define JIM_EXPROP_LOGICAND_LEFT 20
6182 #define JIM_EXPROP_LOGICOR_LEFT 21
6183 #define JIM_EXPROP_POW 22
6184 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6185
6186 /* Binary operators (strings) */
6187 #define JIM_EXPROP_STREQ 23
6188 #define JIM_EXPROP_STRNE 24
6189
6190 /* Unary operators (numbers) */
6191 #define JIM_EXPROP_NOT 25
6192 #define JIM_EXPROP_BITNOT 26
6193 #define JIM_EXPROP_UNARYMINUS 27
6194 #define JIM_EXPROP_UNARYPLUS 28
6195 #define JIM_EXPROP_LOGICAND_RIGHT 29
6196 #define JIM_EXPROP_LOGICOR_RIGHT 30
6197
6198 /* Ternary operators */
6199 #define JIM_EXPROP_TERNARY 31
6200
6201 /* Operands */
6202 #define JIM_EXPROP_NUMBER 32
6203 #define JIM_EXPROP_COMMAND 33
6204 #define JIM_EXPROP_VARIABLE 34
6205 #define JIM_EXPROP_DICTSUGAR 35
6206 #define JIM_EXPROP_SUBST 36
6207 #define JIM_EXPROP_STRING 37
6208
6209 /* Operators table */
6210 typedef struct Jim_ExprOperator {
6211 const char *name;
6212 int precedence;
6213 int arity;
6214 int opcode;
6215 } Jim_ExprOperator;
6216
6217 /* name - precedence - arity - opcode */
6218 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6219 {"!", 300, 1, JIM_EXPROP_NOT},
6220 {"~", 300, 1, JIM_EXPROP_BITNOT},
6221 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6222 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6223
6224 {"**", 250, 2, JIM_EXPROP_POW},
6225
6226 {"*", 200, 2, JIM_EXPROP_MUL},
6227 {"/", 200, 2, JIM_EXPROP_DIV},
6228 {"%", 200, 2, JIM_EXPROP_MOD},
6229
6230 {"-", 100, 2, JIM_EXPROP_SUB},
6231 {"+", 100, 2, JIM_EXPROP_ADD},
6232
6233 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6234 {">>>", 90, 3, JIM_EXPROP_ROTR},
6235 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6236 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6237
6238 {"<", 80, 2, JIM_EXPROP_LT},
6239 {">", 80, 2, JIM_EXPROP_GT},
6240 {"<=", 80, 2, JIM_EXPROP_LTE},
6241 {">=", 80, 2, JIM_EXPROP_GTE},
6242
6243 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6244 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6245
6246 {"eq", 60, 2, JIM_EXPROP_STREQ},
6247 {"ne", 60, 2, JIM_EXPROP_STRNE},
6248
6249 {"&", 50, 2, JIM_EXPROP_BITAND},
6250 {"^", 49, 2, JIM_EXPROP_BITXOR},
6251 {"|", 48, 2, JIM_EXPROP_BITOR},
6252
6253 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6254 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6255
6256 {"?", 5, 3, JIM_EXPROP_TERNARY},
6257 /* private operators */
6258 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6259 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6260 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6261 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6262 };
6263
6264 #define JIM_EXPR_OPERATORS_NUM \
6265 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6266
6267 int JimParseExpression(struct JimParserCtx *pc)
6268 {
6269 /* Discard spaces and quoted newline */
6270 while(*(pc->p) == ' ' ||
6271 *(pc->p) == '\t' ||
6272 *(pc->p) == '\r' ||
6273 *(pc->p) == '\n' ||
6274 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6275 pc->p++; pc->len--;
6276 }
6277
6278 if (pc->len == 0) {
6279 pc->tstart = pc->tend = pc->p;
6280 pc->tline = pc->linenr;
6281 pc->tt = JIM_TT_EOL;
6282 pc->eof = 1;
6283 return JIM_OK;
6284 }
6285 switch(*(pc->p)) {
6286 case '(':
6287 pc->tstart = pc->tend = pc->p;
6288 pc->tline = pc->linenr;
6289 pc->tt = JIM_TT_SUBEXPR_START;
6290 pc->p++; pc->len--;
6291 break;
6292 case ')':
6293 pc->tstart = pc->tend = pc->p;
6294 pc->tline = pc->linenr;
6295 pc->tt = JIM_TT_SUBEXPR_END;
6296 pc->p++; pc->len--;
6297 break;
6298 case '[':
6299 return JimParseCmd(pc);
6300 break;
6301 case '$':
6302 if (JimParseVar(pc) == JIM_ERR)
6303 return JimParseExprOperator(pc);
6304 else
6305 return JIM_OK;
6306 break;
6307 case '-':
6308 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6309 isdigit((int)*(pc->p+1)))
6310 return JimParseExprNumber(pc);
6311 else
6312 return JimParseExprOperator(pc);
6313 break;
6314 case '0': case '1': case '2': case '3': case '4':
6315 case '5': case '6': case '7': case '8': case '9': case '.':
6316 return JimParseExprNumber(pc);
6317 break;
6318 case '"':
6319 case '{':
6320 /* Here it's possible to reuse the List String parsing. */
6321 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6322 return JimParseListStr(pc);
6323 break;
6324 case 'N': case 'I':
6325 case 'n': case 'i':
6326 if (JimParseExprIrrational(pc) == JIM_ERR)
6327 return JimParseExprOperator(pc);
6328 break;
6329 default:
6330 return JimParseExprOperator(pc);
6331 break;
6332 }
6333 return JIM_OK;
6334 }
6335
6336 int JimParseExprNumber(struct JimParserCtx *pc)
6337 {
6338 int allowdot = 1;
6339 int allowhex = 0;
6340
6341 pc->tstart = pc->p;
6342 pc->tline = pc->linenr;
6343 if (*pc->p == '-') {
6344 pc->p++; pc->len--;
6345 }
6346 while ( isdigit((int)*pc->p)
6347 || (allowhex && isxdigit((int)*pc->p) )
6348 || (allowdot && *pc->p == '.')
6349 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6350 (*pc->p == 'x' || *pc->p == 'X'))
6351 )
6352 {
6353 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6354 allowhex = 1;
6355 allowdot = 0;
6356 }
6357 if (*pc->p == '.')
6358 allowdot = 0;
6359 pc->p++; pc->len--;
6360 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6361 pc->p += 2; pc->len -= 2;
6362 }
6363 }
6364 pc->tend = pc->p-1;
6365 pc->tt = JIM_TT_EXPR_NUMBER;
6366 return JIM_OK;
6367 }
6368
6369 int JimParseExprIrrational(struct JimParserCtx *pc)
6370 {
6371 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6372 const char **token;
6373 for (token = Tokens; *token != NULL; token++) {
6374 int len = strlen(*token);
6375 if (strncmp(*token, pc->p, len) == 0) {
6376 pc->tstart = pc->p;
6377 pc->tend = pc->p + len - 1;
6378 pc->p += len; pc->len -= len;
6379 pc->tline = pc->linenr;
6380 pc->tt = JIM_TT_EXPR_NUMBER;
6381 return JIM_OK;
6382 }
6383 }
6384 return JIM_ERR;
6385 }
6386
6387 int JimParseExprOperator(struct JimParserCtx *pc)
6388 {
6389 int i;
6390 int bestIdx = -1, bestLen = 0;
6391
6392 /* Try to get the longest match. */
6393 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6394 const char *opname;
6395 int oplen;
6396
6397 opname = Jim_ExprOperators[i].name;
6398 if (opname == NULL) continue;
6399 oplen = strlen(opname);
6400
6401 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6402 bestIdx = i;
6403 bestLen = oplen;
6404 }
6405 }
6406 if (bestIdx == -1) return JIM_ERR;
6407 pc->tstart = pc->p;
6408 pc->tend = pc->p + bestLen - 1;
6409 pc->p += bestLen; pc->len -= bestLen;
6410 pc->tline = pc->linenr;
6411 pc->tt = JIM_TT_EXPR_OPERATOR;
6412 return JIM_OK;
6413 }
6414
6415 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6416 {
6417 int i;
6418 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6419 if (Jim_ExprOperators[i].name &&
6420 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6421 return &Jim_ExprOperators[i];
6422 return NULL;
6423 }
6424
6425 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6426 {
6427 int i;
6428 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6429 if (Jim_ExprOperators[i].opcode == opcode)
6430 return &Jim_ExprOperators[i];
6431 return NULL;
6432 }
6433
6434 /* -----------------------------------------------------------------------------
6435 * Expression Object
6436 * ---------------------------------------------------------------------------*/
6437 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6438 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6439 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6440
6441 static Jim_ObjType exprObjType = {
6442 "expression",
6443 FreeExprInternalRep,
6444 DupExprInternalRep,
6445 NULL,
6446 JIM_TYPE_REFERENCES,
6447 };
6448
6449 /* Expr bytecode structure */
6450 typedef struct ExprByteCode {
6451 int *opcode; /* Integer array of opcodes. */
6452 Jim_Obj **obj; /* Array of associated Jim Objects. */
6453 int len; /* Bytecode length */
6454 int inUse; /* Used for sharing. */
6455 } ExprByteCode;
6456
6457 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6458 {
6459 int i;
6460 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6461
6462 expr->inUse--;
6463 if (expr->inUse != 0) return;
6464 for (i = 0; i < expr->len; i++)
6465 Jim_DecrRefCount(interp, expr->obj[i]);
6466 Jim_Free(expr->opcode);
6467 Jim_Free(expr->obj);
6468 Jim_Free(expr);
6469 }
6470
6471 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6472 {
6473 JIM_NOTUSED(interp);
6474 JIM_NOTUSED(srcPtr);
6475
6476 /* Just returns an simple string. */
6477 dupPtr->typePtr = NULL;
6478 }
6479
6480 /* Add a new instruction to an expression bytecode structure. */
6481 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6482 int opcode, char *str, int len)
6483 {
6484 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6485 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6486 expr->opcode[expr->len] = opcode;
6487 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6488 Jim_IncrRefCount(expr->obj[expr->len]);
6489 expr->len++;
6490 }
6491
6492 /* Check if an expr program looks correct. */
6493 static int ExprCheckCorrectness(ExprByteCode *expr)
6494 {
6495 int i;
6496 int stacklen = 0;
6497
6498 /* Try to check if there are stack underflows,
6499 * and make sure at the end of the program there is
6500 * a single result on the stack. */
6501 for (i = 0; i < expr->len; i++) {
6502 switch(expr->opcode[i]) {
6503 case JIM_EXPROP_NUMBER:
6504 case JIM_EXPROP_STRING:
6505 case JIM_EXPROP_SUBST:
6506 case JIM_EXPROP_VARIABLE:
6507 case JIM_EXPROP_DICTSUGAR:
6508 case JIM_EXPROP_COMMAND:
6509 stacklen++;
6510 break;
6511 case JIM_EXPROP_NOT:
6512 case JIM_EXPROP_BITNOT:
6513 case JIM_EXPROP_UNARYMINUS:
6514 case JIM_EXPROP_UNARYPLUS:
6515 /* Unary operations */
6516 if (stacklen < 1) return JIM_ERR;
6517 break;
6518 case JIM_EXPROP_ADD:
6519 case JIM_EXPROP_SUB:
6520 case JIM_EXPROP_MUL:
6521 case JIM_EXPROP_DIV:
6522 case JIM_EXPROP_MOD:
6523 case JIM_EXPROP_LT:
6524 case JIM_EXPROP_GT:
6525 case JIM_EXPROP_LTE:
6526 case JIM_EXPROP_GTE:
6527 case JIM_EXPROP_ROTL:
6528 case JIM_EXPROP_ROTR:
6529 case JIM_EXPROP_LSHIFT:
6530 case JIM_EXPROP_RSHIFT:
6531 case JIM_EXPROP_NUMEQ:
6532 case JIM_EXPROP_NUMNE:
6533 case JIM_EXPROP_STREQ:
6534 case JIM_EXPROP_STRNE:
6535 case JIM_EXPROP_BITAND:
6536 case JIM_EXPROP_BITXOR:
6537 case JIM_EXPROP_BITOR:
6538 case JIM_EXPROP_LOGICAND:
6539 case JIM_EXPROP_LOGICOR:
6540 case JIM_EXPROP_POW:
6541 /* binary operations */
6542 if (stacklen < 2) return JIM_ERR;
6543 stacklen--;
6544 break;
6545 default:
6546 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6547 break;
6548 }
6549 }
6550 if (stacklen != 1) return JIM_ERR;
6551 return JIM_OK;
6552 }
6553
6554 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6555 ScriptObj *topLevelScript)
6556 {
6557 int i;
6558
6559 return;
6560 for (i = 0; i < expr->len; i++) {
6561 Jim_Obj *foundObjPtr;
6562
6563 if (expr->obj[i] == NULL) continue;
6564 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6565 NULL, expr->obj[i]);
6566 if (foundObjPtr != NULL) {
6567 Jim_IncrRefCount(foundObjPtr);
6568 Jim_DecrRefCount(interp, expr->obj[i]);
6569 expr->obj[i] = foundObjPtr;
6570 }
6571 }
6572 }
6573
6574 /* This procedure converts every occurrence of || and && opereators
6575 * in lazy unary versions.
6576 *
6577 * a b || is converted into:
6578 *
6579 * a <offset> |L b |R
6580 *
6581 * a b && is converted into:
6582 *
6583 * a <offset> &L b &R
6584 *
6585 * "|L" checks if 'a' is true:
6586 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6587 * the opcode just after |R.
6588 * 2) if it is false does nothing.
6589 * "|R" checks if 'b' is true:
6590 * 1) if it is true pushes 1, otherwise pushes 0.
6591 *
6592 * "&L" checks if 'a' is true:
6593 * 1) if it is true does nothing.
6594 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6595 * the opcode just after &R
6596 * "&R" checks if 'a' is true:
6597 * if it is true pushes 1, otherwise pushes 0.
6598 */
6599 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6600 {
6601 while (1) {
6602 int index = -1, leftindex, arity, i, offset;
6603 Jim_ExprOperator *op;
6604
6605 /* Search for || or && */
6606 for (i = 0; i < expr->len; i++) {
6607 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6608 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6609 index = i;
6610 break;
6611 }
6612 }
6613 if (index == -1) return;
6614 /* Search for the end of the first operator */
6615 leftindex = index-1;
6616 arity = 1;
6617 while(arity) {
6618 switch(expr->opcode[leftindex]) {
6619 case JIM_EXPROP_NUMBER:
6620 case JIM_EXPROP_COMMAND:
6621 case JIM_EXPROP_VARIABLE:
6622 case JIM_EXPROP_DICTSUGAR:
6623 case JIM_EXPROP_SUBST:
6624 case JIM_EXPROP_STRING:
6625 break;
6626 default:
6627 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6628 if (op == NULL) {
6629 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6630 }
6631 arity += op->arity;
6632 break;
6633 }
6634 arity--;
6635 leftindex--;
6636 }
6637 leftindex++;
6638 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6639 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6640 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6641 sizeof(int)*(expr->len-leftindex));
6642 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6643 sizeof(Jim_Obj*)*(expr->len-leftindex));
6644 expr->len += 2;
6645 index += 2;
6646 offset = (index-leftindex)-1;
6647 Jim_DecrRefCount(interp, expr->obj[index]);
6648 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6649 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6650 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6651 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6652 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6653 } else {
6654 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6655 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6656 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6657 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6658 }
6659 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6660 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6661 Jim_IncrRefCount(expr->obj[index]);
6662 Jim_IncrRefCount(expr->obj[leftindex]);
6663 Jim_IncrRefCount(expr->obj[leftindex+1]);
6664 }
6665 }
6666
6667 /* This method takes the string representation of an expression
6668 * and generates a program for the Expr's stack-based VM. */
6669 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6670 {
6671 int exprTextLen;
6672 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6673 struct JimParserCtx parser;
6674 int i, shareLiterals;
6675 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6676 Jim_Stack stack;
6677 Jim_ExprOperator *op;
6678
6679 /* Perform literal sharing with the current procedure
6680 * running only if this expression appears to be not generated
6681 * at runtime. */
6682 shareLiterals = objPtr->typePtr == &sourceObjType;
6683
6684 expr->opcode = NULL;
6685 expr->obj = NULL;
6686 expr->len = 0;
6687 expr->inUse = 1;
6688
6689 Jim_InitStack(&stack);
6690 JimParserInit(&parser, exprText, exprTextLen, 1);
6691 while(!JimParserEof(&parser)) {
6692 char *token;
6693 int len, type;
6694
6695 if (JimParseExpression(&parser) != JIM_OK) {
6696 Jim_SetResultString(interp, "Syntax error in expression", -1);
6697 goto err;
6698 }
6699 token = JimParserGetToken(&parser, &len, &type, NULL);
6700 if (type == JIM_TT_EOL) {
6701 Jim_Free(token);
6702 break;
6703 }
6704 switch(type) {
6705 case JIM_TT_STR:
6706 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6707 break;
6708 case JIM_TT_ESC:
6709 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6710 break;
6711 case JIM_TT_VAR:
6712 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6713 break;
6714 case JIM_TT_DICTSUGAR:
6715 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6716 break;
6717 case JIM_TT_CMD:
6718 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6719 break;
6720 case JIM_TT_EXPR_NUMBER:
6721 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6722 break;
6723 case JIM_TT_EXPR_OPERATOR:
6724 op = JimExprOperatorInfo(token);
6725 while(1) {
6726 Jim_ExprOperator *stackTopOp;
6727
6728 if (Jim_StackPeek(&stack) != NULL) {
6729 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6730 } else {
6731 stackTopOp = NULL;
6732 }
6733 if (Jim_StackLen(&stack) && op->arity != 1 &&
6734 stackTopOp && stackTopOp->precedence >= op->precedence)
6735 {
6736 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6737 Jim_StackPeek(&stack), -1);
6738 Jim_StackPop(&stack);
6739 } else {
6740 break;
6741 }
6742 }
6743 Jim_StackPush(&stack, token);
6744 break;
6745 case JIM_TT_SUBEXPR_START:
6746 Jim_StackPush(&stack, Jim_StrDup("("));
6747 Jim_Free(token);
6748 break;
6749 case JIM_TT_SUBEXPR_END:
6750 {
6751 int found = 0;
6752 while(Jim_StackLen(&stack)) {
6753 char *opstr = Jim_StackPop(&stack);
6754 if (!strcmp(opstr, "(")) {
6755 Jim_Free(opstr);
6756 found = 1;
6757 break;
6758 }
6759 op = JimExprOperatorInfo(opstr);
6760 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6761 }
6762 if (!found) {
6763 Jim_SetResultString(interp,
6764 "Unexpected close parenthesis", -1);
6765 goto err;
6766 }
6767 }
6768 Jim_Free(token);
6769 break;
6770 default:
6771 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6772 break;
6773 }
6774 }
6775 while (Jim_StackLen(&stack)) {
6776 char *opstr = Jim_StackPop(&stack);
6777 op = JimExprOperatorInfo(opstr);
6778 if (op == NULL && !strcmp(opstr, "(")) {
6779 Jim_Free(opstr);
6780 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6781 goto err;
6782 }
6783 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6784 }
6785 /* Check program correctness. */
6786 if (ExprCheckCorrectness(expr) != JIM_OK) {
6787 Jim_SetResultString(interp, "Invalid expression", -1);
6788 goto err;
6789 }
6790
6791 /* Free the stack used for the compilation. */
6792 Jim_FreeStackElements(&stack, Jim_Free);
6793 Jim_FreeStack(&stack);
6794
6795 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6796 ExprMakeLazy(interp, expr);
6797
6798 /* Perform literal sharing */
6799 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6800 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6801 if (bodyObjPtr->typePtr == &scriptObjType) {
6802 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6803 ExprShareLiterals(interp, expr, bodyScript);
6804 }
6805 }
6806
6807 /* Free the old internal rep and set the new one. */
6808 Jim_FreeIntRep(interp, objPtr);
6809 Jim_SetIntRepPtr(objPtr, expr);
6810 objPtr->typePtr = &exprObjType;
6811 return JIM_OK;
6812
6813 err: /* we jump here on syntax/compile errors. */
6814 Jim_FreeStackElements(&stack, Jim_Free);
6815 Jim_FreeStack(&stack);
6816 Jim_Free(expr->opcode);
6817 for (i = 0; i < expr->len; i++) {
6818 Jim_DecrRefCount(interp,expr->obj[i]);
6819 }
6820 Jim_Free(expr->obj);
6821 Jim_Free(expr);
6822 return JIM_ERR;
6823 }
6824
6825 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6826 {
6827 if (objPtr->typePtr != &exprObjType) {
6828 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6829 return NULL;
6830 }
6831 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6832 }
6833
6834 /* -----------------------------------------------------------------------------
6835 * Expressions evaluation.
6836 * Jim uses a specialized stack-based virtual machine for expressions,
6837 * that takes advantage of the fact that expr's operators
6838 * can't be redefined.
6839 *
6840 * Jim_EvalExpression() uses the bytecode compiled by
6841 * SetExprFromAny() method of the "expression" object.
6842 *
6843 * On success a Tcl Object containing the result of the evaluation
6844 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6845 * returned.
6846 * On error the function returns a retcode != to JIM_OK and set a suitable
6847 * error on the interp.
6848 * ---------------------------------------------------------------------------*/
6849 #define JIM_EE_STATICSTACK_LEN 10
6850
6851 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6852 Jim_Obj **exprResultPtrPtr)
6853 {
6854 ExprByteCode *expr;
6855 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6856 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6857
6858 Jim_IncrRefCount(exprObjPtr);
6859 expr = Jim_GetExpression(interp, exprObjPtr);
6860 if (!expr) {
6861 Jim_DecrRefCount(interp, exprObjPtr);
6862 return JIM_ERR; /* error in expression. */
6863 }
6864 /* In order to avoid that the internal repr gets freed due to
6865 * shimmering of the exprObjPtr's object, we make the internal rep
6866 * shared. */
6867 expr->inUse++;
6868
6869 /* The stack-based expr VM itself */
6870
6871 /* Stack allocation. Expr programs have the feature that
6872 * a program of length N can't require a stack longer than
6873 * N. */
6874 if (expr->len > JIM_EE_STATICSTACK_LEN)
6875 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6876 else
6877 stack = staticStack;
6878
6879 /* Execute every istruction */
6880 for (i = 0; i < expr->len; i++) {
6881 Jim_Obj *A, *B, *objPtr;
6882 jim_wide wA, wB, wC;
6883 double dA, dB, dC;
6884 const char *sA, *sB;
6885 int Alen, Blen, retcode;
6886 int opcode = expr->opcode[i];
6887
6888 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6889 stack[stacklen++] = expr->obj[i];
6890 Jim_IncrRefCount(expr->obj[i]);
6891 } else if (opcode == JIM_EXPROP_VARIABLE) {
6892 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6893 if (objPtr == NULL) {
6894 error = 1;
6895 goto err;
6896 }
6897 stack[stacklen++] = objPtr;
6898 Jim_IncrRefCount(objPtr);
6899 } else if (opcode == JIM_EXPROP_SUBST) {
6900 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6901 &objPtr, JIM_NONE)) != JIM_OK)
6902 {
6903 error = 1;
6904 errRetCode = retcode;
6905 goto err;
6906 }
6907 stack[stacklen++] = objPtr;
6908 Jim_IncrRefCount(objPtr);
6909 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6910 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6911 if (objPtr == NULL) {
6912 error = 1;
6913 goto err;
6914 }
6915 stack[stacklen++] = objPtr;
6916 Jim_IncrRefCount(objPtr);
6917 } else if (opcode == JIM_EXPROP_COMMAND) {
6918 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6919 error = 1;
6920 errRetCode = retcode;
6921 goto err;
6922 }
6923 stack[stacklen++] = interp->result;
6924 Jim_IncrRefCount(interp->result);
6925 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6926 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6927 {
6928 /* Note that there isn't to increment the
6929 * refcount of objects. the references are moved
6930 * from stack to A and B. */
6931 B = stack[--stacklen];
6932 A = stack[--stacklen];
6933
6934 /* --- Integer --- */
6935 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6936 (B->typePtr == &doubleObjType && !B->bytes) ||
6937 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6938 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6939 goto trydouble;
6940 }
6941 Jim_DecrRefCount(interp, A);
6942 Jim_DecrRefCount(interp, B);
6943 switch(expr->opcode[i]) {
6944 case JIM_EXPROP_ADD: wC = wA+wB; break;
6945 case JIM_EXPROP_SUB: wC = wA-wB; break;
6946 case JIM_EXPROP_MUL: wC = wA*wB; break;
6947 case JIM_EXPROP_LT: wC = wA<wB; break;
6948 case JIM_EXPROP_GT: wC = wA>wB; break;
6949 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6950 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6951 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6952 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6953 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6954 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6955 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6956 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6957 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6958 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6959 case JIM_EXPROP_LOGICAND_LEFT:
6960 if (wA == 0) {
6961 i += (int)wB;
6962 wC = 0;
6963 } else {
6964 continue;
6965 }
6966 break;
6967 case JIM_EXPROP_LOGICOR_LEFT:
6968 if (wA != 0) {
6969 i += (int)wB;
6970 wC = 1;
6971 } else {
6972 continue;
6973 }
6974 break;
6975 case JIM_EXPROP_DIV:
6976 if (wB == 0) goto divbyzero;
6977 wC = wA/wB;
6978 break;
6979 case JIM_EXPROP_MOD:
6980 if (wB == 0) goto divbyzero;
6981 wC = wA%wB;
6982 break;
6983 case JIM_EXPROP_ROTL: {
6984 /* uint32_t would be better. But not everyone has inttypes.h?*/
6985 unsigned long uA = (unsigned long)wA;
6986 #ifdef _MSC_VER
6987 wC = _rotl(uA,(unsigned long)wB);
6988 #else
6989 const unsigned int S = sizeof(unsigned long) * 8;
6990 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6991 #endif
6992 break;
6993 }
6994 case JIM_EXPROP_ROTR: {
6995 unsigned long uA = (unsigned long)wA;
6996 #ifdef _MSC_VER
6997 wC = _rotr(uA,(unsigned long)wB);
6998 #else
6999 const unsigned int S = sizeof(unsigned long) * 8;
7000 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7001 #endif
7002 break;
7003 }
7004
7005 default:
7006 wC = 0; /* avoid gcc warning */
7007 break;
7008 }
7009 stack[stacklen] = Jim_NewIntObj(interp, wC);
7010 Jim_IncrRefCount(stack[stacklen]);
7011 stacklen++;
7012 continue;
7013 trydouble:
7014 /* --- Double --- */
7015 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7016 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7017
7018 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7019 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7020 opcode = JIM_EXPROP_STRNE;
7021 goto retry_as_string;
7022 }
7023 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7024 opcode = JIM_EXPROP_STREQ;
7025 goto retry_as_string;
7026 }
7027 Jim_DecrRefCount(interp, A);
7028 Jim_DecrRefCount(interp, B);
7029 error = 1;
7030 goto err;
7031 }
7032 Jim_DecrRefCount(interp, A);
7033 Jim_DecrRefCount(interp, B);
7034 switch(expr->opcode[i]) {
7035 case JIM_EXPROP_ROTL:
7036 case JIM_EXPROP_ROTR:
7037 case JIM_EXPROP_LSHIFT:
7038 case JIM_EXPROP_RSHIFT:
7039 case JIM_EXPROP_BITAND:
7040 case JIM_EXPROP_BITXOR:
7041 case JIM_EXPROP_BITOR:
7042 case JIM_EXPROP_MOD:
7043 case JIM_EXPROP_POW:
7044 Jim_SetResultString(interp,
7045 "Got floating-point value where integer was expected", -1);
7046 error = 1;
7047 goto err;
7048 break;
7049 case JIM_EXPROP_ADD: dC = dA+dB; break;
7050 case JIM_EXPROP_SUB: dC = dA-dB; break;
7051 case JIM_EXPROP_MUL: dC = dA*dB; break;
7052 case JIM_EXPROP_LT: dC = dA<dB; break;
7053 case JIM_EXPROP_GT: dC = dA>dB; break;
7054 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7055 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7056 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7057 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7058 case JIM_EXPROP_LOGICAND_LEFT:
7059 if (dA == 0) {
7060 i += (int)dB;
7061 dC = 0;
7062 } else {
7063 continue;
7064 }
7065 break;
7066 case JIM_EXPROP_LOGICOR_LEFT:
7067 if (dA != 0) {
7068 i += (int)dB;
7069 dC = 1;
7070 } else {
7071 continue;
7072 }
7073 break;
7074 case JIM_EXPROP_DIV:
7075 if (dB == 0) goto divbyzero;
7076 dC = dA/dB;
7077 break;
7078 default:
7079 dC = 0; /* avoid gcc warning */
7080 break;
7081 }
7082 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7083 Jim_IncrRefCount(stack[stacklen]);
7084 stacklen++;
7085 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7086 B = stack[--stacklen];
7087 A = stack[--stacklen];
7088 retry_as_string:
7089 sA = Jim_GetString(A, &Alen);
7090 sB = Jim_GetString(B, &Blen);
7091 switch(opcode) {
7092 case JIM_EXPROP_STREQ:
7093 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7094 wC = 1;
7095 else
7096 wC = 0;
7097 break;
7098 case JIM_EXPROP_STRNE:
7099 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7100 wC = 1;
7101 else
7102 wC = 0;
7103 break;
7104 default:
7105 wC = 0; /* avoid gcc warning */
7106 break;
7107 }
7108 Jim_DecrRefCount(interp, A);
7109 Jim_DecrRefCount(interp, B);
7110 stack[stacklen] = Jim_NewIntObj(interp, wC);
7111 Jim_IncrRefCount(stack[stacklen]);
7112 stacklen++;
7113 } else if (opcode == JIM_EXPROP_NOT ||
7114 opcode == JIM_EXPROP_BITNOT ||
7115 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7116 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7117 /* Note that there isn't to increment the
7118 * refcount of objects. the references are moved
7119 * from stack to A and B. */
7120 A = stack[--stacklen];
7121
7122 /* --- Integer --- */
7123 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7124 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7125 goto trydouble_unary;
7126 }
7127 Jim_DecrRefCount(interp, A);
7128 switch(expr->opcode[i]) {
7129 case JIM_EXPROP_NOT: wC = !wA; break;
7130 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7131 case JIM_EXPROP_LOGICAND_RIGHT:
7132 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7133 default:
7134 wC = 0; /* avoid gcc warning */
7135 break;
7136 }
7137 stack[stacklen] = Jim_NewIntObj(interp, wC);
7138 Jim_IncrRefCount(stack[stacklen]);
7139 stacklen++;
7140 continue;
7141 trydouble_unary:
7142 /* --- Double --- */
7143 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7144 Jim_DecrRefCount(interp, A);
7145 error = 1;
7146 goto err;
7147 }
7148 Jim_DecrRefCount(interp, A);
7149 switch(expr->opcode[i]) {
7150 case JIM_EXPROP_NOT: dC = !dA; break;
7151 case JIM_EXPROP_LOGICAND_RIGHT:
7152 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7153 case JIM_EXPROP_BITNOT:
7154 Jim_SetResultString(interp,
7155 "Got floating-point value where integer was expected", -1);
7156 error = 1;
7157 goto err;
7158 break;
7159 default:
7160 dC = 0; /* avoid gcc warning */
7161 break;
7162 }
7163 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7164 Jim_IncrRefCount(stack[stacklen]);
7165 stacklen++;
7166 } else {
7167 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7168 }
7169 }
7170 err:
7171 /* There is no need to decerement the inUse field because
7172 * this reference is transfered back into the exprObjPtr. */
7173 Jim_FreeIntRep(interp, exprObjPtr);
7174 exprObjPtr->typePtr = &exprObjType;
7175 Jim_SetIntRepPtr(exprObjPtr, expr);
7176 Jim_DecrRefCount(interp, exprObjPtr);
7177 if (!error) {
7178 *exprResultPtrPtr = stack[0];
7179 Jim_IncrRefCount(stack[0]);
7180 errRetCode = JIM_OK;
7181 }
7182 for (i = 0; i < stacklen; i++) {
7183 Jim_DecrRefCount(interp, stack[i]);
7184 }
7185 if (stack != staticStack)
7186 Jim_Free(stack);
7187 return errRetCode;
7188 divbyzero:
7189 error = 1;
7190 Jim_SetResultString(interp, "Division by zero", -1);
7191 goto err;
7192 }
7193
7194 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7195 {
7196 int retcode;
7197 jim_wide wideValue;
7198 double doubleValue;
7199 Jim_Obj *exprResultPtr;
7200
7201 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7202 if (retcode != JIM_OK)
7203 return retcode;
7204 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7205 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7206 {
7207 Jim_DecrRefCount(interp, exprResultPtr);
7208 return JIM_ERR;
7209 } else {
7210 Jim_DecrRefCount(interp, exprResultPtr);
7211 *boolPtr = doubleValue != 0;
7212 return JIM_OK;
7213 }
7214 }
7215 Jim_DecrRefCount(interp, exprResultPtr);
7216 *boolPtr = wideValue != 0;
7217 return JIM_OK;
7218 }
7219
7220 /* -----------------------------------------------------------------------------
7221 * ScanFormat String Object
7222 * ---------------------------------------------------------------------------*/
7223
7224 /* This Jim_Obj will held a parsed representation of a format string passed to
7225 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7226 * to be parsed in its entirely first and then, if correct, can be used for
7227 * scanning. To avoid endless re-parsing, the parsed representation will be
7228 * stored in an internal representation and re-used for performance reason. */
7229
7230 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7231 * scanformat string. This part will later be used to extract information
7232 * out from the string to be parsed by Jim_ScanString */
7233
7234 typedef struct ScanFmtPartDescr {
7235 char type; /* Type of conversion (e.g. c, d, f) */
7236 char modifier; /* Modify type (e.g. l - long, h - short */
7237 size_t width; /* Maximal width of input to be converted */
7238 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7239 char *arg; /* Specification of a CHARSET conversion */
7240 char *prefix; /* Prefix to be scanned literally before conversion */
7241 } ScanFmtPartDescr;
7242
7243 /* The ScanFmtStringObj will held the internal representation of a scanformat
7244 * string parsed and separated in part descriptions. Furthermore it contains
7245 * the original string representation of the scanformat string to allow for
7246 * fast update of the Jim_Obj's string representation part.
7247 *
7248 * As add-on the internal object representation add some scratch pad area
7249 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7250 * memory for purpose of string scanning.
7251 *
7252 * The error member points to a static allocated string in case of a mal-
7253 * formed scanformat string or it contains '0' (NULL) in case of a valid
7254 * parse representation.
7255 *
7256 * The whole memory of the internal representation is allocated as a single
7257 * area of memory that will be internally separated. So freeing and duplicating
7258 * of such an object is cheap */
7259
7260 typedef struct ScanFmtStringObj {
7261 jim_wide size; /* Size of internal repr in bytes */
7262 char *stringRep; /* Original string representation */
7263 size_t count; /* Number of ScanFmtPartDescr contained */
7264 size_t convCount; /* Number of conversions that will assign */
7265 size_t maxPos; /* Max position index if XPG3 is used */
7266 const char *error; /* Ptr to error text (NULL if no error */
7267 char *scratch; /* Some scratch pad used by Jim_ScanString */
7268 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7269 } ScanFmtStringObj;
7270
7271
7272 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7273 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7274 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7275
7276 static Jim_ObjType scanFmtStringObjType = {
7277 "scanformatstring",
7278 FreeScanFmtInternalRep,
7279 DupScanFmtInternalRep,
7280 UpdateStringOfScanFmt,
7281 JIM_TYPE_NONE,
7282 };
7283
7284 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7285 {
7286 JIM_NOTUSED(interp);
7287 Jim_Free((char*)objPtr->internalRep.ptr);
7288 objPtr->internalRep.ptr = 0;
7289 }
7290
7291 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7292 {
7293 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7294 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7295
7296 JIM_NOTUSED(interp);
7297 memcpy(newVec, srcPtr->internalRep.ptr, size);
7298 dupPtr->internalRep.ptr = newVec;
7299 dupPtr->typePtr = &scanFmtStringObjType;
7300 }
7301
7302 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7303 {
7304 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7305
7306 objPtr->bytes = Jim_StrDup(bytes);
7307 objPtr->length = strlen(bytes);
7308 }
7309
7310 /* SetScanFmtFromAny will parse a given string and create the internal
7311 * representation of the format specification. In case of an error
7312 * the error data member of the internal representation will be set
7313 * to an descriptive error text and the function will be left with
7314 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7315 * specification */
7316
7317 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7318 {
7319 ScanFmtStringObj *fmtObj;
7320 char *buffer;
7321 int maxCount, i, approxSize, lastPos = -1;
7322 const char *fmt = objPtr->bytes;
7323 int maxFmtLen = objPtr->length;
7324 const char *fmtEnd = fmt + maxFmtLen;
7325 int curr;
7326
7327 Jim_FreeIntRep(interp, objPtr);
7328 /* Count how many conversions could take place maximally */
7329 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7330 if (fmt[i] == '%')
7331 ++maxCount;
7332 /* Calculate an approximation of the memory necessary */
7333 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7334 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7335 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7336 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7337 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7338 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7339 + 1; /* safety byte */
7340 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7341 memset(fmtObj, 0, approxSize);
7342 fmtObj->size = approxSize;
7343 fmtObj->maxPos = 0;
7344 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7345 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7346 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7347 buffer = fmtObj->stringRep + maxFmtLen + 1;
7348 objPtr->internalRep.ptr = fmtObj;
7349 objPtr->typePtr = &scanFmtStringObjType;
7350 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7351 int width=0, skip;
7352 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7353 fmtObj->count++;
7354 descr->width = 0; /* Assume width unspecified */
7355 /* Overread and store any "literal" prefix */
7356 if (*fmt != '%' || fmt[1] == '%') {
7357 descr->type = 0;
7358 descr->prefix = &buffer[i];
7359 for (; fmt < fmtEnd; ++fmt) {
7360 if (*fmt == '%') {
7361 if (fmt[1] != '%') break;
7362 ++fmt;
7363 }
7364 buffer[i++] = *fmt;
7365 }
7366 buffer[i++] = 0;
7367 }
7368 /* Skip the conversion introducing '%' sign */
7369 ++fmt;
7370 /* End reached due to non-conversion literal only? */
7371 if (fmt >= fmtEnd)
7372 goto done;
7373 descr->pos = 0; /* Assume "natural" positioning */
7374 if (*fmt == '*') {
7375 descr->pos = -1; /* Okay, conversion will not be assigned */
7376 ++fmt;
7377 } else
7378 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7379 /* Check if next token is a number (could be width or pos */
7380 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7381 fmt += skip;
7382 /* Was the number a XPG3 position specifier? */
7383 if (descr->pos != -1 && *fmt == '$') {
7384 int prev;
7385 ++fmt;
7386 descr->pos = width;
7387 width = 0;
7388 /* Look if "natural" postioning and XPG3 one was mixed */
7389 if ((lastPos == 0 && descr->pos > 0)
7390 || (lastPos > 0 && descr->pos == 0)) {
7391 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7392 return JIM_ERR;
7393 }
7394 /* Look if this position was already used */
7395 for (prev=0; prev < curr; ++prev) {
7396 if (fmtObj->descr[prev].pos == -1) continue;
7397 if (fmtObj->descr[prev].pos == descr->pos) {
7398 fmtObj->error = "same \"%n$\" conversion specifier "
7399 "used more than once";
7400 return JIM_ERR;
7401 }
7402 }
7403 /* Try to find a width after the XPG3 specifier */
7404 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7405 descr->width = width;
7406 fmt += skip;
7407 }
7408 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7409 fmtObj->maxPos = descr->pos;
7410 } else {
7411 /* Number was not a XPG3, so it has to be a width */
7412 descr->width = width;
7413 }
7414 }
7415 /* If positioning mode was undetermined yet, fix this */
7416 if (lastPos == -1)
7417 lastPos = descr->pos;
7418 /* Handle CHARSET conversion type ... */
7419 if (*fmt == '[') {
7420 int swapped = 1, beg = i, end, j;
7421 descr->type = '[';
7422 descr->arg = &buffer[i];
7423 ++fmt;
7424 if (*fmt == '^') buffer[i++] = *fmt++;
7425 if (*fmt == ']') buffer[i++] = *fmt++;
7426 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7427 if (*fmt != ']') {
7428 fmtObj->error = "unmatched [ in format string";
7429 return JIM_ERR;
7430 }
7431 end = i;
7432 buffer[i++] = 0;
7433 /* In case a range fence was given "backwards", swap it */
7434 while (swapped) {
7435 swapped = 0;
7436 for (j=beg+1; j < end-1; ++j) {
7437 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7438 char tmp = buffer[j-1];
7439 buffer[j-1] = buffer[j+1];
7440 buffer[j+1] = tmp;
7441 swapped = 1;
7442 }
7443 }
7444 }
7445 } else {
7446 /* Remember any valid modifier if given */
7447 if (strchr("hlL", *fmt) != 0)
7448 descr->modifier = tolower((int)*fmt++);
7449
7450 descr->type = *fmt;
7451 if (strchr("efgcsndoxui", *fmt) == 0) {
7452 fmtObj->error = "bad scan conversion character";
7453 return JIM_ERR;
7454 } else if (*fmt == 'c' && descr->width != 0) {
7455 fmtObj->error = "field width may not be specified in %c "
7456 "conversion";
7457 return JIM_ERR;
7458 } else if (*fmt == 'u' && descr->modifier == 'l') {
7459 fmtObj->error = "unsigned wide not supported";
7460 return JIM_ERR;
7461 }
7462 }
7463 curr++;
7464 }
7465 done:
7466 if (fmtObj->convCount == 0) {
7467 fmtObj->error = "no any conversion specifier given";
7468 return JIM_ERR;
7469 }
7470 return JIM_OK;
7471 }
7472
7473 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7474
7475 #define FormatGetCnvCount(_fo_) \
7476 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7477 #define FormatGetMaxPos(_fo_) \
7478 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7479 #define FormatGetError(_fo_) \
7480 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7481
7482 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7483 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7484 * bitvector implementation in Jim? */
7485
7486 static int JimTestBit(const char *bitvec, char ch)
7487 {
7488 div_t pos = div(ch-1, 8);
7489 return bitvec[pos.quot] & (1 << pos.rem);
7490 }
7491
7492 static void JimSetBit(char *bitvec, char ch)
7493 {
7494 div_t pos = div(ch-1, 8);
7495 bitvec[pos.quot] |= (1 << pos.rem);
7496 }
7497
7498 #if 0 /* currently not used */
7499 static void JimClearBit(char *bitvec, char ch)
7500 {
7501 div_t pos = div(ch-1, 8);
7502 bitvec[pos.quot] &= ~(1 << pos.rem);
7503 }
7504 #endif
7505
7506 /* JimScanAString is used to scan an unspecified string that ends with
7507 * next WS, or a string that is specified via a charset. The charset
7508 * is currently implemented in a way to only allow for usage with
7509 * ASCII. Whenever we will switch to UNICODE, another idea has to
7510 * be born :-/
7511 *
7512 * FIXME: Works only with ASCII */
7513
7514 static Jim_Obj *
7515 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7516 {
7517 size_t i;
7518 Jim_Obj *result;
7519 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7520 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7521
7522 /* First init charset to nothing or all, depending if a specified
7523 * or an unspecified string has to be parsed */
7524 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7525 if (sdescr) {
7526 /* There was a set description given, that means we are parsing
7527 * a specified string. So we have to build a corresponding
7528 * charset reflecting the description */
7529 int notFlag = 0;
7530 /* Should the set be negated at the end? */
7531 if (*sdescr == '^') {
7532 notFlag = 1;
7533 ++sdescr;
7534 }
7535 /* Here '-' is meant literally and not to define a range */
7536 if (*sdescr == '-') {
7537 JimSetBit(charset, '-');
7538 ++sdescr;
7539 }
7540 while (*sdescr) {
7541 if (sdescr[1] == '-' && sdescr[2] != 0) {
7542 /* Handle range definitions */
7543 int i;
7544 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7545 JimSetBit(charset, (char)i);
7546 sdescr += 3;
7547 } else {
7548 /* Handle verbatim character definitions */
7549 JimSetBit(charset, *sdescr++);
7550 }
7551 }
7552 /* Negate the charset if there was a NOT given */
7553 for (i=0; notFlag && i < sizeof(charset); ++i)
7554 charset[i] = ~charset[i];
7555 }
7556 /* And after all the mess above, the real work begin ... */
7557 while (str && *str) {
7558 if (!sdescr && isspace((int)*str))
7559 break; /* EOS via WS if unspecified */
7560 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7561 else break; /* EOS via mismatch if specified scanning */
7562 }
7563 *buffer = 0; /* Close the string properly ... */
7564 result = Jim_NewStringObj(interp, anchor, -1);
7565 Jim_Free(anchor); /* ... and free it afer usage */
7566 return result;
7567 }
7568
7569 /* ScanOneEntry will scan one entry out of the string passed as argument.
7570 * It use the sscanf() function for this task. After extracting and
7571 * converting of the value, the count of scanned characters will be
7572 * returned of -1 in case of no conversion tool place and string was
7573 * already scanned thru */
7574
7575 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7576 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7577 {
7578 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7579 ? sizeof(jim_wide) \
7580 : sizeof(double))
7581 char buffer[MAX_SIZE];
7582 char *value = buffer;
7583 const char *tok;
7584 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7585 size_t sLen = strlen(&str[pos]), scanned = 0;
7586 size_t anchor = pos;
7587 int i;
7588
7589 /* First pessimiticly assume, we will not scan anything :-) */
7590 *valObjPtr = 0;
7591 if (descr->prefix) {
7592 /* There was a prefix given before the conversion, skip it and adjust
7593 * the string-to-be-parsed accordingly */
7594 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7595 /* If prefix require, skip WS */
7596 if (isspace((int)descr->prefix[i]))
7597 while (str[pos] && isspace((int)str[pos])) ++pos;
7598 else if (descr->prefix[i] != str[pos])
7599 break; /* Prefix do not match here, leave the loop */
7600 else
7601 ++pos; /* Prefix matched so far, next round */
7602 }
7603 if (str[pos] == 0)
7604 return -1; /* All of str consumed: EOF condition */
7605 else if (descr->prefix[i] != 0)
7606 return 0; /* Not whole prefix consumed, no conversion possible */
7607 }
7608 /* For all but following conversion, skip leading WS */
7609 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7610 while (isspace((int)str[pos])) ++pos;
7611 /* Determine how much skipped/scanned so far */
7612 scanned = pos - anchor;
7613 if (descr->type == 'n') {
7614 /* Return pseudo conversion means: how much scanned so far? */
7615 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7616 } else if (str[pos] == 0) {
7617 /* Cannot scan anything, as str is totally consumed */
7618 return -1;
7619 } else {
7620 /* Processing of conversions follows ... */
7621 if (descr->width > 0) {
7622 /* Do not try to scan as fas as possible but only the given width.
7623 * To ensure this, we copy the part that should be scanned. */
7624 size_t tLen = descr->width > sLen ? sLen : descr->width;
7625 tok = Jim_StrDupLen(&str[pos], tLen);
7626 } else {
7627 /* As no width was given, simply refer to the original string */
7628 tok = &str[pos];
7629 }
7630 switch (descr->type) {
7631 case 'c':
7632 *valObjPtr = Jim_NewIntObj(interp, *tok);
7633 scanned += 1;
7634 break;
7635 case 'd': case 'o': case 'x': case 'u': case 'i': {
7636 jim_wide jwvalue;
7637 long lvalue;
7638 char *endp; /* Position where the number finished */
7639 int base = descr->type == 'o' ? 8
7640 : descr->type == 'x' ? 16
7641 : descr->type == 'i' ? 0
7642 : 10;
7643
7644 do {
7645 /* Try to scan a number with the given base */
7646 if (descr->modifier == 'l')
7647 {
7648 #ifdef HAVE_LONG_LONG_INT
7649 jwvalue = JimStrtoll(tok, &endp, base),
7650 #else
7651 jwvalue = strtol(tok, &endp, base),
7652 #endif
7653 memcpy(value, &jwvalue, sizeof(jim_wide));
7654 }
7655 else
7656 {
7657 if (descr->type == 'u')
7658 lvalue = strtoul(tok, &endp, base);
7659 else
7660 lvalue = strtol(tok, &endp, base);
7661 memcpy(value, &lvalue, sizeof(lvalue));
7662 }
7663 /* If scanning failed, and base was undetermined, simply
7664 * put it to 10 and try once more. This should catch the
7665 * case where %i begin to parse a number prefix (e.g.
7666 * '0x' but no further digits follows. This will be
7667 * handled as a ZERO followed by a char 'x' by Tcl */
7668 if (endp == tok && base == 0) base = 10;
7669 else break;
7670 } while (1);
7671 if (endp != tok) {
7672 /* There was some number sucessfully scanned! */
7673 if (descr->modifier == 'l')
7674 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7675 else
7676 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7677 /* Adjust the number-of-chars scanned so far */
7678 scanned += endp - tok;
7679 } else {
7680 /* Nothing was scanned. We have to determine if this
7681 * happened due to e.g. prefix mismatch or input str
7682 * exhausted */
7683 scanned = *tok ? 0 : -1;
7684 }
7685 break;
7686 }
7687 case 's': case '[': {
7688 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7689 scanned += Jim_Length(*valObjPtr);
7690 break;
7691 }
7692 case 'e': case 'f': case 'g': {
7693 char *endp;
7694
7695 double dvalue = strtod(tok, &endp);
7696 memcpy(value, &dvalue, sizeof(double));
7697 if (endp != tok) {
7698 /* There was some number sucessfully scanned! */
7699 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7700 /* Adjust the number-of-chars scanned so far */
7701 scanned += endp - tok;
7702 } else {
7703 /* Nothing was scanned. We have to determine if this
7704 * happened due to e.g. prefix mismatch or input str
7705 * exhausted */
7706 scanned = *tok ? 0 : -1;
7707 }
7708 break;
7709 }
7710 }
7711 /* If a substring was allocated (due to pre-defined width) do not
7712 * forget to free it */
7713 if (tok != &str[pos])
7714 Jim_Free((char*)tok);
7715 }
7716 return scanned;
7717 }
7718
7719 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7720 * string and returns all converted (and not ignored) values in a list back
7721 * to the caller. If an error occured, a NULL pointer will be returned */
7722
7723 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7724 Jim_Obj *fmtObjPtr, int flags)
7725 {
7726 size_t i, pos;
7727 int scanned = 1;
7728 const char *str = Jim_GetString(strObjPtr, 0);
7729 Jim_Obj *resultList = 0;
7730 Jim_Obj **resultVec;
7731 int resultc;
7732 Jim_Obj *emptyStr = 0;
7733 ScanFmtStringObj *fmtObj;
7734
7735 /* If format specification is not an object, convert it! */
7736 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7737 SetScanFmtFromAny(interp, fmtObjPtr);
7738 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7739 /* Check if format specification was valid */
7740 if (fmtObj->error != 0) {
7741 if (flags & JIM_ERRMSG)
7742 Jim_SetResultString(interp, fmtObj->error, -1);
7743 return 0;
7744 }
7745 /* Allocate a new "shared" empty string for all unassigned conversions */
7746 emptyStr = Jim_NewEmptyStringObj(interp);
7747 Jim_IncrRefCount(emptyStr);
7748 /* Create a list and fill it with empty strings up to max specified XPG3 */
7749 resultList = Jim_NewListObj(interp, 0, 0);
7750 if (fmtObj->maxPos > 0) {
7751 for (i=0; i < fmtObj->maxPos; ++i)
7752 Jim_ListAppendElement(interp, resultList, emptyStr);
7753 JimListGetElements(interp, resultList, &resultc, &resultVec);
7754 }
7755 /* Now handle every partial format description */
7756 for (i=0, pos=0; i < fmtObj->count; ++i) {
7757 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7758 Jim_Obj *value = 0;
7759 /* Only last type may be "literal" w/o conversion - skip it! */
7760 if (descr->type == 0) continue;
7761 /* As long as any conversion could be done, we will proceed */
7762 if (scanned > 0)
7763 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7764 /* In case our first try results in EOF, we will leave */
7765 if (scanned == -1 && i == 0)
7766 goto eof;
7767 /* Advance next pos-to-be-scanned for the amount scanned already */
7768 pos += scanned;
7769 /* value == 0 means no conversion took place so take empty string */
7770 if (value == 0)
7771 value = Jim_NewEmptyStringObj(interp);
7772 /* If value is a non-assignable one, skip it */
7773 if (descr->pos == -1) {
7774 Jim_FreeNewObj(interp, value);
7775 } else if (descr->pos == 0)
7776 /* Otherwise append it to the result list if no XPG3 was given */
7777 Jim_ListAppendElement(interp, resultList, value);
7778 else if (resultVec[descr->pos-1] == emptyStr) {
7779 /* But due to given XPG3, put the value into the corr. slot */
7780 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7781 Jim_IncrRefCount(value);
7782 resultVec[descr->pos-1] = value;
7783 } else {
7784 /* Otherwise, the slot was already used - free obj and ERROR */
7785 Jim_FreeNewObj(interp, value);
7786 goto err;
7787 }
7788 }
7789 Jim_DecrRefCount(interp, emptyStr);
7790 return resultList;
7791 eof:
7792 Jim_DecrRefCount(interp, emptyStr);
7793 Jim_FreeNewObj(interp, resultList);
7794 return (Jim_Obj*)EOF;
7795 err:
7796 Jim_DecrRefCount(interp, emptyStr);
7797 Jim_FreeNewObj(interp, resultList);
7798 return 0;
7799 }
7800
7801 /* -----------------------------------------------------------------------------
7802 * Pseudo Random Number Generation
7803 * ---------------------------------------------------------------------------*/
7804 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7805 int seedLen);
7806
7807 /* Initialize the sbox with the numbers from 0 to 255 */
7808 static void JimPrngInit(Jim_Interp *interp)
7809 {
7810 int i;
7811 unsigned int seed[256];
7812
7813 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7814 for (i = 0; i < 256; i++)
7815 seed[i] = (rand() ^ time(NULL) ^ clock());
7816 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7817 }
7818
7819 /* Generates N bytes of random data */
7820 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7821 {
7822 Jim_PrngState *prng;
7823 unsigned char *destByte = (unsigned char*) dest;
7824 unsigned int si, sj, x;
7825
7826 /* initialization, only needed the first time */
7827 if (interp->prngState == NULL)
7828 JimPrngInit(interp);
7829 prng = interp->prngState;
7830 /* generates 'len' bytes of pseudo-random numbers */
7831 for (x = 0; x < len; x++) {
7832 prng->i = (prng->i+1) & 0xff;
7833 si = prng->sbox[prng->i];
7834 prng->j = (prng->j + si) & 0xff;
7835 sj = prng->sbox[prng->j];
7836 prng->sbox[prng->i] = sj;
7837 prng->sbox[prng->j] = si;
7838 *destByte++ = prng->sbox[(si+sj)&0xff];
7839 }
7840 }
7841
7842 /* Re-seed the generator with user-provided bytes */
7843 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7844 int seedLen)
7845 {
7846 int i;
7847 unsigned char buf[256];
7848 Jim_PrngState *prng;
7849
7850 /* initialization, only needed the first time */
7851 if (interp->prngState == NULL)
7852 JimPrngInit(interp);
7853 prng = interp->prngState;
7854
7855 /* Set the sbox[i] with i */
7856 for (i = 0; i < 256; i++)
7857 prng->sbox[i] = i;
7858 /* Now use the seed to perform a random permutation of the sbox */
7859 for (i = 0; i < seedLen; i++) {
7860 unsigned char t;
7861
7862 t = prng->sbox[i&0xFF];
7863 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7864 prng->sbox[seed[i]] = t;
7865 }
7866 prng->i = prng->j = 0;
7867 /* discard the first 256 bytes of stream. */
7868 JimRandomBytes(interp, buf, 256);
7869 }
7870
7871 /* -----------------------------------------------------------------------------
7872 * Dynamic libraries support (WIN32 not supported)
7873 * ---------------------------------------------------------------------------*/
7874
7875 #ifdef JIM_DYNLIB
7876 #ifdef WIN32
7877 #define RTLD_LAZY 0
7878 void * dlopen(const char *path, int mode)
7879 {
7880 JIM_NOTUSED(mode);
7881
7882 return (void *)LoadLibraryA(path);
7883 }
7884 int dlclose(void *handle)
7885 {
7886 FreeLibrary((HANDLE)handle);
7887 return 0;
7888 }
7889 void *dlsym(void *handle, const char *symbol)
7890 {
7891 return GetProcAddress((HMODULE)handle, symbol);
7892 }
7893 static char win32_dlerror_string[121];
7894 const char *dlerror(void)
7895 {
7896 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7897 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7898 return win32_dlerror_string;
7899 }
7900 #endif /* WIN32 */
7901
7902 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7903 {
7904 Jim_Obj *libPathObjPtr;
7905 int prefixc, i;
7906 void *handle;
7907 int (*onload)(Jim_Interp *interp);
7908
7909 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7910 if (libPathObjPtr == NULL) {
7911 prefixc = 0;
7912 libPathObjPtr = NULL;
7913 } else {
7914 Jim_IncrRefCount(libPathObjPtr);
7915 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7916 }
7917
7918 for (i = -1; i < prefixc; i++) {
7919 if (i < 0) {
7920 handle = dlopen(pathName, RTLD_LAZY);
7921 } else {
7922 FILE *fp;
7923 char buf[JIM_PATH_LEN];
7924 const char *prefix;
7925 int prefixlen;
7926 Jim_Obj *prefixObjPtr;
7927
7928 buf[0] = '\0';
7929 if (Jim_ListIndex(interp, libPathObjPtr, i,
7930 &prefixObjPtr, JIM_NONE) != JIM_OK)
7931 continue;
7932 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7933 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7934 continue;
7935 if (*pathName == '/') {
7936 strcpy(buf, pathName);
7937 }
7938 else if (prefixlen && prefix[prefixlen-1] == '/')
7939 sprintf(buf, "%s%s", prefix, pathName);
7940 else
7941 sprintf(buf, "%s/%s", prefix, pathName);
7942 fp = fopen(buf, "r");
7943 if (fp == NULL)
7944 continue;
7945 fclose(fp);
7946 handle = dlopen(buf, RTLD_LAZY);
7947 }
7948 if (handle == NULL) {
7949 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7950 Jim_AppendStrings(interp, Jim_GetResult(interp),
7951 "error loading extension \"", pathName,
7952 "\": ", dlerror(), NULL);
7953 if (i < 0)
7954 continue;
7955 goto err;
7956 }
7957 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7958 Jim_SetResultString(interp,
7959 "No Jim_OnLoad symbol found on extension", -1);
7960 goto err;
7961 }
7962 if (onload(interp) == JIM_ERR) {
7963 dlclose(handle);
7964 goto err;
7965 }
7966 Jim_SetEmptyResult(interp);
7967 if (libPathObjPtr != NULL)
7968 Jim_DecrRefCount(interp, libPathObjPtr);
7969 return JIM_OK;
7970 }
7971 err:
7972 if (libPathObjPtr != NULL)
7973 Jim_DecrRefCount(interp, libPathObjPtr);
7974 return JIM_ERR;
7975 }
7976 #else /* JIM_DYNLIB */
7977 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7978 {
7979 JIM_NOTUSED(interp);
7980 JIM_NOTUSED(pathName);
7981
7982 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7983 return JIM_ERR;
7984 }
7985 #endif/* JIM_DYNLIB */
7986
7987 /* -----------------------------------------------------------------------------
7988 * Packages handling
7989 * ---------------------------------------------------------------------------*/
7990
7991 #define JIM_PKG_ANY_VERSION -1
7992
7993 /* Convert a string of the type "1.2" into an integer.
7994 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7995 * to the integer with value 102 */
7996 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7997 int *intPtr, int flags)
7998 {
7999 char *copy;
8000 jim_wide major, minor;
8001 char *majorStr, *minorStr, *p;
8002
8003 if (v[0] == '\0') {
8004 *intPtr = JIM_PKG_ANY_VERSION;
8005 return JIM_OK;
8006 }
8007
8008 copy = Jim_StrDup(v);
8009 p = strchr(copy, '.');
8010 if (p == NULL) goto badfmt;
8011 *p = '\0';
8012 majorStr = copy;
8013 minorStr = p+1;
8014
8015 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8016 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8017 goto badfmt;
8018 *intPtr = (int)(major*100+minor);
8019 Jim_Free(copy);
8020 return JIM_OK;
8021
8022 badfmt:
8023 Jim_Free(copy);
8024 if (flags & JIM_ERRMSG) {
8025 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8026 Jim_AppendStrings(interp, Jim_GetResult(interp),
8027 "invalid package version '", v, "'", NULL);
8028 }
8029 return JIM_ERR;
8030 }
8031
8032 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8033 static int JimPackageMatchVersion(int needed, int actual, int flags)
8034 {
8035 if (needed == JIM_PKG_ANY_VERSION) return 1;
8036 if (flags & JIM_MATCHVER_EXACT) {
8037 return needed == actual;
8038 } else {
8039 return needed/100 == actual/100 && (needed <= actual);
8040 }
8041 }
8042
8043 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8044 int flags)
8045 {
8046 int intVersion;
8047 /* Check if the version format is ok */
8048 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8049 return JIM_ERR;
8050 /* If the package was already provided returns an error. */
8051 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8052 if (flags & JIM_ERRMSG) {
8053 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8054 Jim_AppendStrings(interp, Jim_GetResult(interp),
8055 "package '", name, "' was already provided", NULL);
8056 }
8057 return JIM_ERR;
8058 }
8059 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8060 return JIM_OK;
8061 }
8062
8063 #ifndef JIM_ANSIC
8064
8065 #ifndef WIN32
8066 # include <sys/types.h>
8067 # include <dirent.h>
8068 #else
8069 # include <io.h>
8070 /* Posix dirent.h compatiblity layer for WIN32.
8071 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8072 * Copyright Salvatore Sanfilippo ,2005.
8073 *
8074 * Permission to use, copy, modify, and distribute this software and its
8075 * documentation for any purpose is hereby granted without fee, provided
8076 * that this copyright and permissions notice appear in all copies and
8077 * derivatives.
8078 *
8079 * This software is supplied "as is" without express or implied warranty.
8080 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8081 */
8082
8083 struct dirent {
8084 char *d_name;
8085 };
8086
8087 typedef struct DIR {
8088 long handle; /* -1 for failed rewind */
8089 struct _finddata_t info;
8090 struct dirent result; /* d_name null iff first time */
8091 char *name; /* null-terminated char string */
8092 } DIR;
8093
8094 DIR *opendir(const char *name)
8095 {
8096 DIR *dir = 0;
8097
8098 if(name && name[0]) {
8099 size_t base_length = strlen(name);
8100 const char *all = /* search pattern must end with suitable wildcard */
8101 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8102
8103 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8104 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8105 {
8106 strcat(strcpy(dir->name, name), all);
8107
8108 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8109 dir->result.d_name = 0;
8110 else { /* rollback */
8111 Jim_Free(dir->name);
8112 Jim_Free(dir);
8113 dir = 0;
8114 }
8115 } else { /* rollback */
8116 Jim_Free(dir);
8117 dir = 0;
8118 errno = ENOMEM;
8119 }
8120 } else {
8121 errno = EINVAL;
8122 }
8123 return dir;
8124 }
8125
8126 int closedir(DIR *dir)
8127 {
8128 int result = -1;
8129
8130 if(dir) {
8131 if(dir->handle != -1)
8132 result = _findclose(dir->handle);
8133 Jim_Free(dir->name);
8134 Jim_Free(dir);
8135 }
8136 if(result == -1) /* map all errors to EBADF */
8137 errno = EBADF;
8138 return result;
8139 }
8140
8141 struct dirent *readdir(DIR *dir)
8142 {
8143 struct dirent *result = 0;
8144
8145 if(dir && dir->handle != -1) {
8146 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8147 result = &dir->result;
8148 result->d_name = dir->info.name;
8149 }
8150 } else {
8151 errno = EBADF;
8152 }
8153 return result;
8154 }
8155
8156 #endif /* WIN32 */
8157
8158 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8159 int prefixc, const char *pkgName, int pkgVer, int flags)
8160 {
8161 int bestVer = -1, i;
8162 int pkgNameLen = strlen(pkgName);
8163 char *bestPackage = NULL;
8164 struct dirent *de;
8165
8166 for (i = 0; i < prefixc; i++) {
8167 DIR *dir;
8168 char buf[JIM_PATH_LEN];
8169 int prefixLen;
8170
8171 if (prefixes[i] == NULL) continue;
8172 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8173 buf[JIM_PATH_LEN-1] = '\0';
8174 prefixLen = strlen(buf);
8175 if (prefixLen && buf[prefixLen-1] == '/')
8176 buf[prefixLen-1] = '\0';
8177
8178 if ((dir = opendir(buf)) == NULL) continue;
8179 while ((de = readdir(dir)) != NULL) {
8180 char *fileName = de->d_name;
8181 int fileNameLen = strlen(fileName);
8182
8183 if (strncmp(fileName, "jim-", 4) == 0 &&
8184 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8185 *(fileName+4+pkgNameLen) == '-' &&
8186 fileNameLen > 4 && /* note that this is not really useful */
8187 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8188 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8189 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8190 {
8191 char ver[6]; /* xx.yy<nulterm> */
8192 char *p = strrchr(fileName, '.');
8193 int verLen, fileVer;
8194
8195 verLen = p - (fileName+4+pkgNameLen+1);
8196 if (verLen < 3 || verLen > 5) continue;
8197 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8198 ver[verLen] = '\0';
8199 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8200 != JIM_OK) continue;
8201 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8202 (bestVer == -1 || bestVer < fileVer))
8203 {
8204 bestVer = fileVer;
8205 Jim_Free(bestPackage);
8206 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8207 sprintf(bestPackage, "%s/%s", buf, fileName);
8208 }
8209 }
8210 }
8211 closedir(dir);
8212 }
8213 return bestPackage;
8214 }
8215
8216 #else /* JIM_ANSIC */
8217
8218 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8219 int prefixc, const char *pkgName, int pkgVer, int flags)
8220 {
8221 JIM_NOTUSED(interp);
8222 JIM_NOTUSED(prefixes);
8223 JIM_NOTUSED(prefixc);
8224 JIM_NOTUSED(pkgName);
8225 JIM_NOTUSED(pkgVer);
8226 JIM_NOTUSED(flags);
8227 return NULL;
8228 }
8229
8230 #endif /* JIM_ANSIC */
8231
8232 /* Search for a suitable package under every dir specified by jim_libpath
8233 * and load it if possible. If a suitable package was loaded with success
8234 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8235 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8236 int flags)
8237 {
8238 Jim_Obj *libPathObjPtr;
8239 char **prefixes, *best;
8240 int prefixc, i, retCode = JIM_OK;
8241
8242 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8243 if (libPathObjPtr == NULL) {
8244 prefixc = 0;
8245 libPathObjPtr = NULL;
8246 } else {
8247 Jim_IncrRefCount(libPathObjPtr);
8248 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8249 }
8250
8251 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8252 for (i = 0; i < prefixc; i++) {
8253 Jim_Obj *prefixObjPtr;
8254 if (Jim_ListIndex(interp, libPathObjPtr, i,
8255 &prefixObjPtr, JIM_NONE) != JIM_OK)
8256 {
8257 prefixes[i] = NULL;
8258 continue;
8259 }
8260 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8261 }
8262 /* Scan every directory to find the "best" package. */
8263 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8264 if (best != NULL) {
8265 char *p = strrchr(best, '.');
8266 /* Try to load/source it */
8267 if (p && strcmp(p, ".tcl") == 0) {
8268 retCode = Jim_EvalFile(interp, best);
8269 } else {
8270 retCode = Jim_LoadLibrary(interp, best);
8271 }
8272 } else {
8273 retCode = JIM_ERR;
8274 }
8275 Jim_Free(best);
8276 for (i = 0; i < prefixc; i++)
8277 Jim_Free(prefixes[i]);
8278 Jim_Free(prefixes);
8279 if (libPathObjPtr)
8280 Jim_DecrRefCount(interp, libPathObjPtr);
8281 return retCode;
8282 }
8283
8284 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8285 const char *ver, int flags)
8286 {
8287 Jim_HashEntry *he;
8288 int requiredVer;
8289
8290 /* Start with an empty error string */
8291 Jim_SetResultString(interp, "", 0);
8292
8293 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8294 return NULL;
8295 he = Jim_FindHashEntry(&interp->packages, name);
8296 if (he == NULL) {
8297 /* Try to load the package. */
8298 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8299 he = Jim_FindHashEntry(&interp->packages, name);
8300 if (he == NULL) {
8301 return "?";
8302 }
8303 return he->val;
8304 }
8305 /* No way... return an error. */
8306 if (flags & JIM_ERRMSG) {
8307 int len;
8308 Jim_GetString(Jim_GetResult(interp), &len);
8309 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8310 "Can't find package '", name, "'", NULL);
8311 }
8312 return NULL;
8313 } else {
8314 int actualVer;
8315 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8316 != JIM_OK)
8317 {
8318 return NULL;
8319 }
8320 /* Check if version matches. */
8321 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8322 Jim_AppendStrings(interp, Jim_GetResult(interp),
8323 "Package '", name, "' already loaded, but with version ",
8324 he->val, NULL);
8325 return NULL;
8326 }
8327 return he->val;
8328 }
8329 }
8330
8331 /* -----------------------------------------------------------------------------
8332 * Eval
8333 * ---------------------------------------------------------------------------*/
8334 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8335 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8336
8337 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8338 Jim_Obj *const *argv);
8339
8340 /* Handle calls to the [unknown] command */
8341 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8342 {
8343 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8344 int retCode;
8345
8346 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8347 * done here
8348 */
8349 if (interp->unknown_called) {
8350 return JIM_ERR;
8351 }
8352
8353 /* If the [unknown] command does not exists returns
8354 * just now */
8355 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8356 return JIM_ERR;
8357
8358 /* The object interp->unknown just contains
8359 * the "unknown" string, it is used in order to
8360 * avoid to lookup the unknown command every time
8361 * but instread to cache the result. */
8362 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8363 v = sv;
8364 else
8365 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8366 /* Make a copy of the arguments vector, but shifted on
8367 * the right of one position. The command name of the
8368 * command will be instead the first argument of the
8369 * [unknonw] call. */
8370 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8371 v[0] = interp->unknown;
8372 /* Call it */
8373 interp->unknown_called++;
8374 retCode = Jim_EvalObjVector(interp, argc+1, v);
8375 interp->unknown_called--;
8376
8377 /* Clean up */
8378 if (v != sv)
8379 Jim_Free(v);
8380 return retCode;
8381 }
8382
8383 /* Eval the object vector 'objv' composed of 'objc' elements.
8384 * Every element is used as single argument.
8385 * Jim_EvalObj() will call this function every time its object
8386 * argument is of "list" type, with no string representation.
8387 *
8388 * This is possible because the string representation of a
8389 * list object generated by the UpdateStringOfList is made
8390 * in a way that ensures that every list element is a different
8391 * command argument. */
8392 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8393 {
8394 int i, retcode;
8395 Jim_Cmd *cmdPtr;
8396
8397 /* Incr refcount of arguments. */
8398 for (i = 0; i < objc; i++)
8399 Jim_IncrRefCount(objv[i]);
8400 /* Command lookup */
8401 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8402 if (cmdPtr == NULL) {
8403 retcode = JimUnknown(interp, objc, objv);
8404 } else {
8405 /* Call it -- Make sure result is an empty object. */
8406 Jim_SetEmptyResult(interp);
8407 if (cmdPtr->cmdProc) {
8408 interp->cmdPrivData = cmdPtr->privData;
8409 retcode = cmdPtr->cmdProc(interp, objc, objv);
8410 if (retcode == JIM_ERR_ADDSTACK) {
8411 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8412 retcode = JIM_ERR;
8413 }
8414 } else {
8415 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8416 if (retcode == JIM_ERR) {
8417 JimAppendStackTrace(interp,
8418 Jim_GetString(objv[0], NULL), "", 1);
8419 }
8420 }
8421 }
8422 /* Decr refcount of arguments and return the retcode */
8423 for (i = 0; i < objc; i++)
8424 Jim_DecrRefCount(interp, objv[i]);
8425 return retcode;
8426 }
8427
8428 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8429 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8430 * The returned object has refcount = 0. */
8431 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8432 int tokens, Jim_Obj **objPtrPtr)
8433 {
8434 int totlen = 0, i, retcode;
8435 Jim_Obj **intv;
8436 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8437 Jim_Obj *objPtr;
8438 char *s;
8439
8440 if (tokens <= JIM_EVAL_SINTV_LEN)
8441 intv = sintv;
8442 else
8443 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8444 tokens);
8445 /* Compute every token forming the argument
8446 * in the intv objects vector. */
8447 for (i = 0; i < tokens; i++) {
8448 switch(token[i].type) {
8449 case JIM_TT_ESC:
8450 case JIM_TT_STR:
8451 intv[i] = token[i].objPtr;
8452 break;
8453 case JIM_TT_VAR:
8454 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8455 if (!intv[i]) {
8456 retcode = JIM_ERR;
8457 goto err;
8458 }
8459 break;
8460 case JIM_TT_DICTSUGAR:
8461 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8462 if (!intv[i]) {
8463 retcode = JIM_ERR;
8464 goto err;
8465 }
8466 break;
8467 case JIM_TT_CMD:
8468 retcode = Jim_EvalObj(interp, token[i].objPtr);
8469 if (retcode != JIM_OK)
8470 goto err;
8471 intv[i] = Jim_GetResult(interp);
8472 break;
8473 default:
8474 Jim_Panic(interp,
8475 "default token type reached "
8476 "in Jim_InterpolateTokens().");
8477 break;
8478 }
8479 Jim_IncrRefCount(intv[i]);
8480 /* Make sure there is a valid
8481 * string rep, and add the string
8482 * length to the total legnth. */
8483 Jim_GetString(intv[i], NULL);
8484 totlen += intv[i]->length;
8485 }
8486 /* Concatenate every token in an unique
8487 * object. */
8488 objPtr = Jim_NewStringObjNoAlloc(interp,
8489 NULL, 0);
8490 s = objPtr->bytes = Jim_Alloc(totlen+1);
8491 objPtr->length = totlen;
8492 for (i = 0; i < tokens; i++) {
8493 memcpy(s, intv[i]->bytes, intv[i]->length);
8494 s += intv[i]->length;
8495 Jim_DecrRefCount(interp, intv[i]);
8496 }
8497 objPtr->bytes[totlen] = '\0';
8498 /* Free the intv vector if not static. */
8499 if (tokens > JIM_EVAL_SINTV_LEN)
8500 Jim_Free(intv);
8501 *objPtrPtr = objPtr;
8502 return JIM_OK;
8503 err:
8504 i--;
8505 for (; i >= 0; i--)
8506 Jim_DecrRefCount(interp, intv[i]);
8507 if (tokens > JIM_EVAL_SINTV_LEN)
8508 Jim_Free(intv);
8509 return retcode;
8510 }
8511
8512 /* Helper of Jim_EvalObj() to perform argument expansion.
8513 * Basically this function append an argument to 'argv'
8514 * (and increments argc by reference accordingly), performing
8515 * expansion of the list object if 'expand' is non-zero, or
8516 * just adding objPtr to argv if 'expand' is zero. */
8517 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8518 int *argcPtr, int expand, Jim_Obj *objPtr)
8519 {
8520 if (!expand) {
8521 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8522 /* refcount of objPtr not incremented because
8523 * we are actually transfering a reference from
8524 * the old 'argv' to the expanded one. */
8525 (*argv)[*argcPtr] = objPtr;
8526 (*argcPtr)++;
8527 } else {
8528 int len, i;
8529
8530 Jim_ListLength(interp, objPtr, &len);
8531 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8532 for (i = 0; i < len; i++) {
8533 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8534 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8535 (*argcPtr)++;
8536 }
8537 /* The original object reference is no longer needed,
8538 * after the expansion it is no longer present on
8539 * the argument vector, but the single elements are
8540 * in its place. */
8541 Jim_DecrRefCount(interp, objPtr);
8542 }
8543 }
8544
8545 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8546 {
8547 int i, j = 0, len;
8548 ScriptObj *script;
8549 ScriptToken *token;
8550 int *cs; /* command structure array */
8551 int retcode = JIM_OK;
8552 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8553
8554 interp->errorFlag = 0;
8555
8556 /* If the object is of type "list" and there is no
8557 * string representation for this object, we can call
8558 * a specialized version of Jim_EvalObj() */
8559 if (scriptObjPtr->typePtr == &listObjType &&
8560 scriptObjPtr->internalRep.listValue.len &&
8561 scriptObjPtr->bytes == NULL) {
8562 Jim_IncrRefCount(scriptObjPtr);
8563 retcode = Jim_EvalObjVector(interp,
8564 scriptObjPtr->internalRep.listValue.len,
8565 scriptObjPtr->internalRep.listValue.ele);
8566 Jim_DecrRefCount(interp, scriptObjPtr);
8567 return retcode;
8568 }
8569
8570 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8571 script = Jim_GetScript(interp, scriptObjPtr);
8572 /* Now we have to make sure the internal repr will not be
8573 * freed on shimmering.
8574 *
8575 * Think for example to this:
8576 *
8577 * set x {llength $x; ... some more code ...}; eval $x
8578 *
8579 * In order to preserve the internal rep, we increment the
8580 * inUse field of the script internal rep structure. */
8581 script->inUse++;
8582
8583 token = script->token;
8584 len = script->len;
8585 cs = script->cmdStruct;
8586 i = 0; /* 'i' is the current token index. */
8587
8588 /* Reset the interpreter result. This is useful to
8589 * return the emtpy result in the case of empty program. */
8590 Jim_SetEmptyResult(interp);
8591
8592 /* Execute every command sequentially, returns on
8593 * error (i.e. if a command does not return JIM_OK) */
8594 while (i < len) {
8595 int expand = 0;
8596 int argc = *cs++; /* Get the number of arguments */
8597 Jim_Cmd *cmd;
8598
8599 /* Set the expand flag if needed. */
8600 if (argc == -1) {
8601 expand++;
8602 argc = *cs++;
8603 }
8604 /* Allocate the arguments vector */
8605 if (argc <= JIM_EVAL_SARGV_LEN)
8606 argv = sargv;
8607 else
8608 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8609 /* Populate the arguments objects. */
8610 for (j = 0; j < argc; j++) {
8611 int tokens = *cs++;
8612
8613 /* tokens is negative if expansion is needed.
8614 * for this argument. */
8615 if (tokens < 0) {
8616 tokens = (-tokens)-1;
8617 i++;
8618 }
8619 if (tokens == 1) {
8620 /* Fast path if the token does not
8621 * need interpolation */
8622 switch(token[i].type) {
8623 case JIM_TT_ESC:
8624 case JIM_TT_STR:
8625 argv[j] = token[i].objPtr;
8626 break;
8627 case JIM_TT_VAR:
8628 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8629 JIM_ERRMSG);
8630 if (!tmpObjPtr) {
8631 retcode = JIM_ERR;
8632 goto err;
8633 }
8634 argv[j] = tmpObjPtr;
8635 break;
8636 case JIM_TT_DICTSUGAR:
8637 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8638 if (!tmpObjPtr) {
8639 retcode = JIM_ERR;
8640 goto err;
8641 }
8642 argv[j] = tmpObjPtr;
8643 break;
8644 case JIM_TT_CMD:
8645 retcode = Jim_EvalObj(interp, token[i].objPtr);
8646 if (retcode != JIM_OK)
8647 goto err;
8648 argv[j] = Jim_GetResult(interp);
8649 break;
8650 default:
8651 Jim_Panic(interp,
8652 "default token type reached "
8653 "in Jim_EvalObj().");
8654 break;
8655 }
8656 Jim_IncrRefCount(argv[j]);
8657 i += 2;
8658 } else {
8659 /* For interpolation we call an helper
8660 * function doing the work for us. */
8661 if ((retcode = Jim_InterpolateTokens(interp,
8662 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8663 {
8664 goto err;
8665 }
8666 argv[j] = tmpObjPtr;
8667 Jim_IncrRefCount(argv[j]);
8668 i += tokens+1;
8669 }
8670 }
8671 /* Handle {expand} expansion */
8672 if (expand) {
8673 int *ecs = cs - argc;
8674 int eargc = 0;
8675 Jim_Obj **eargv = NULL;
8676
8677 for (j = 0; j < argc; j++) {
8678 Jim_ExpandArgument( interp, &eargv, &eargc,
8679 ecs[j] < 0, argv[j]);
8680 }
8681 if (argv != sargv)
8682 Jim_Free(argv);
8683 argc = eargc;
8684 argv = eargv;
8685 j = argc;
8686 if (argc == 0) {
8687 /* Nothing to do with zero args. */
8688 Jim_Free(eargv);
8689 continue;
8690 }
8691 }
8692 /* Lookup the command to call */
8693 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8694 if (cmd != NULL) {
8695 /* Call it -- Make sure result is an empty object. */
8696 Jim_SetEmptyResult(interp);
8697 if (cmd->cmdProc) {
8698 interp->cmdPrivData = cmd->privData;
8699 retcode = cmd->cmdProc(interp, argc, argv);
8700 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8701 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8702 retcode = JIM_ERR;
8703 }
8704 } else {
8705 retcode = JimCallProcedure(interp, cmd, argc, argv);
8706 if (retcode == JIM_ERR) {
8707 JimAppendStackTrace(interp,
8708 Jim_GetString(argv[0], NULL), script->fileName,
8709 token[i-argc*2].linenr);
8710 }
8711 }
8712 } else {
8713 /* Call [unknown] */
8714 retcode = JimUnknown(interp, argc, argv);
8715 if (retcode == JIM_ERR) {
8716 JimAppendStackTrace(interp,
8717 "", script->fileName,
8718 token[i-argc*2].linenr);
8719 }
8720 }
8721 if (retcode != JIM_OK) {
8722 i -= argc*2; /* point to the command name. */
8723 goto err;
8724 }
8725 /* Decrement the arguments count */
8726 for (j = 0; j < argc; j++) {
8727 Jim_DecrRefCount(interp, argv[j]);
8728 }
8729
8730 if (argv != sargv) {
8731 Jim_Free(argv);
8732 argv = NULL;
8733 }
8734 }
8735 /* Note that we don't have to decrement inUse, because the
8736 * following code transfers our use of the reference again to
8737 * the script object. */
8738 j = 0; /* on normal termination, the argv array is already
8739 Jim_DecrRefCount-ed. */
8740 err:
8741 /* Handle errors. */
8742 if (retcode == JIM_ERR && !interp->errorFlag) {
8743 interp->errorFlag = 1;
8744 JimSetErrorFileName(interp, script->fileName);
8745 JimSetErrorLineNumber(interp, token[i].linenr);
8746 JimResetStackTrace(interp);
8747 }
8748 Jim_FreeIntRep(interp, scriptObjPtr);
8749 scriptObjPtr->typePtr = &scriptObjType;
8750 Jim_SetIntRepPtr(scriptObjPtr, script);
8751 Jim_DecrRefCount(interp, scriptObjPtr);
8752 for (i = 0; i < j; i++) {
8753 Jim_DecrRefCount(interp, argv[i]);
8754 }
8755 if (argv != sargv)
8756 Jim_Free(argv);
8757 return retcode;
8758 }
8759
8760 /* Call a procedure implemented in Tcl.
8761 * It's possible to speed-up a lot this function, currently
8762 * the callframes are not cached, but allocated and
8763 * destroied every time. What is expecially costly is
8764 * to create/destroy the local vars hash table every time.
8765 *
8766 * This can be fixed just implementing callframes caching
8767 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8768 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8769 Jim_Obj *const *argv)
8770 {
8771 int i, retcode;
8772 Jim_CallFrame *callFramePtr;
8773 int num_args;
8774
8775 /* Check arity */
8776 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8777 argc > cmd->arityMax)) {
8778 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8779 Jim_AppendStrings(interp, objPtr,
8780 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8781 (cmd->arityMin > 1) ? " " : "",
8782 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8783 Jim_SetResult(interp, objPtr);
8784 return JIM_ERR;
8785 }
8786 /* Check if there are too nested calls */
8787 if (interp->numLevels == interp->maxNestingDepth) {
8788 Jim_SetResultString(interp,
8789 "Too many nested calls. Infinite recursion?", -1);
8790 return JIM_ERR;
8791 }
8792 /* Create a new callframe */
8793 callFramePtr = JimCreateCallFrame(interp);
8794 callFramePtr->parentCallFrame = interp->framePtr;
8795 callFramePtr->argv = argv;
8796 callFramePtr->argc = argc;
8797 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8798 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8799 callFramePtr->staticVars = cmd->staticVars;
8800 Jim_IncrRefCount(cmd->argListObjPtr);
8801 Jim_IncrRefCount(cmd->bodyObjPtr);
8802 interp->framePtr = callFramePtr;
8803 interp->numLevels ++;
8804
8805 /* Set arguments */
8806 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8807
8808 /* If last argument is 'args', don't set it here */
8809 if (cmd->arityMax == -1) {
8810 num_args--;
8811 }
8812
8813 for (i = 0; i < num_args; i++) {
8814 Jim_Obj *argObjPtr;
8815 Jim_Obj *nameObjPtr;
8816 Jim_Obj *valueObjPtr;
8817
8818 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8819 if (i + 1 >= cmd->arityMin) {
8820 /* The name is the first element of the list */
8821 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8822 }
8823 else {
8824 /* The element arg is the name */
8825 nameObjPtr = argObjPtr;
8826 }
8827
8828 if (i + 1 >= argc) {
8829 /* No more values, so use default */
8830 /* The value is the second element of the list */
8831 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8832 }
8833 else {
8834 valueObjPtr = argv[i+1];
8835 }
8836 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8837 }
8838 /* Set optional arguments */
8839 if (cmd->arityMax == -1) {
8840 Jim_Obj *listObjPtr, *objPtr;
8841
8842 i++;
8843 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8844 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8845 Jim_SetVariable(interp, objPtr, listObjPtr);
8846 }
8847 /* Eval the body */
8848 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8849
8850 /* Destroy the callframe */
8851 interp->numLevels --;
8852 interp->framePtr = interp->framePtr->parentCallFrame;
8853 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8854 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8855 } else {
8856 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8857 }
8858 /* Handle the JIM_EVAL return code */
8859 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8860 int savedLevel = interp->evalRetcodeLevel;
8861
8862 interp->evalRetcodeLevel = interp->numLevels;
8863 while (retcode == JIM_EVAL) {
8864 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8865 Jim_IncrRefCount(resultScriptObjPtr);
8866 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8867 Jim_DecrRefCount(interp, resultScriptObjPtr);
8868 }
8869 interp->evalRetcodeLevel = savedLevel;
8870 }
8871 /* Handle the JIM_RETURN return code */
8872 if (retcode == JIM_RETURN) {
8873 retcode = interp->returnCode;
8874 interp->returnCode = JIM_OK;
8875 }
8876 return retcode;
8877 }
8878
8879 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8880 {
8881 int retval;
8882 Jim_Obj *scriptObjPtr;
8883
8884 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8885 Jim_IncrRefCount(scriptObjPtr);
8886
8887
8888 if( filename ){
8889 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8890 }
8891
8892 retval = Jim_EvalObj(interp, scriptObjPtr);
8893 Jim_DecrRefCount(interp, scriptObjPtr);
8894 return retval;
8895 }
8896
8897 int Jim_Eval(Jim_Interp *interp, const char *script)
8898 {
8899 return Jim_Eval_Named( interp, script, NULL, 0 );
8900 }
8901
8902
8903
8904 /* Execute script in the scope of the global level */
8905 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8906 {
8907 Jim_CallFrame *savedFramePtr;
8908 int retval;
8909
8910 savedFramePtr = interp->framePtr;
8911 interp->framePtr = interp->topFramePtr;
8912 retval = Jim_Eval(interp, script);
8913 interp->framePtr = savedFramePtr;
8914 return retval;
8915 }
8916
8917 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8918 {
8919 Jim_CallFrame *savedFramePtr;
8920 int retval;
8921
8922 savedFramePtr = interp->framePtr;
8923 interp->framePtr = interp->topFramePtr;
8924 retval = Jim_EvalObj(interp, scriptObjPtr);
8925 interp->framePtr = savedFramePtr;
8926 /* Try to report the error (if any) via the bgerror proc */
8927 if (retval != JIM_OK) {
8928 Jim_Obj *objv[2];
8929
8930 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8931 objv[1] = Jim_GetResult(interp);
8932 Jim_IncrRefCount(objv[0]);
8933 Jim_IncrRefCount(objv[1]);
8934 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8935 /* Report the error to stderr. */
8936 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8937 Jim_PrintErrorMessage(interp);
8938 }
8939 Jim_DecrRefCount(interp, objv[0]);
8940 Jim_DecrRefCount(interp, objv[1]);
8941 }
8942 return retval;
8943 }
8944
8945 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8946 {
8947 char *prg = NULL;
8948 FILE *fp;
8949 int nread, totread, maxlen, buflen;
8950 int retval;
8951 Jim_Obj *scriptObjPtr;
8952
8953 if ((fp = fopen(filename, "r")) == NULL) {
8954 const int cwd_len=2048;
8955 char *cwd=malloc(cwd_len);
8956 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8957 if (!getcwd( cwd, cwd_len )) strcpy(cwd, "unknown");
8958 Jim_AppendStrings(interp, Jim_GetResult(interp),
8959 "Error loading script \"", filename, "\"",
8960 " cwd: ", cwd,
8961 " err: ", strerror(errno), NULL);
8962 free(cwd);
8963 return JIM_ERR;
8964 }
8965 buflen = 1024;
8966 maxlen = totread = 0;
8967 while (1) {
8968 if (maxlen < totread+buflen+1) {
8969 maxlen = totread+buflen+1;
8970 prg = Jim_Realloc(prg, maxlen);
8971 }
8972 /* do not use Jim_fread() - this is really a file */
8973 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8974 totread += nread;
8975 }
8976 prg[totread] = '\0';
8977 /* do not use Jim_fclose() - this is really a file */
8978 fclose(fp);
8979
8980 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8981 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8982 Jim_IncrRefCount(scriptObjPtr);
8983 retval = Jim_EvalObj(interp, scriptObjPtr);
8984 Jim_DecrRefCount(interp, scriptObjPtr);
8985 return retval;
8986 }
8987
8988 /* -----------------------------------------------------------------------------
8989 * Subst
8990 * ---------------------------------------------------------------------------*/
8991 static int JimParseSubstStr(struct JimParserCtx *pc)
8992 {
8993 pc->tstart = pc->p;
8994 pc->tline = pc->linenr;
8995 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8996 pc->p++; pc->len--;
8997 }
8998 pc->tend = pc->p-1;
8999 pc->tt = JIM_TT_ESC;
9000 return JIM_OK;
9001 }
9002
9003 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9004 {
9005 int retval;
9006
9007 if (pc->len == 0) {
9008 pc->tstart = pc->tend = pc->p;
9009 pc->tline = pc->linenr;
9010 pc->tt = JIM_TT_EOL;
9011 pc->eof = 1;
9012 return JIM_OK;
9013 }
9014 switch(*pc->p) {
9015 case '[':
9016 retval = JimParseCmd(pc);
9017 if (flags & JIM_SUBST_NOCMD) {
9018 pc->tstart--;
9019 pc->tend++;
9020 pc->tt = (flags & JIM_SUBST_NOESC) ?
9021 JIM_TT_STR : JIM_TT_ESC;
9022 }
9023 return retval;
9024 break;
9025 case '$':
9026 if (JimParseVar(pc) == JIM_ERR) {
9027 pc->tstart = pc->tend = pc->p++; pc->len--;
9028 pc->tline = pc->linenr;
9029 pc->tt = JIM_TT_STR;
9030 } else {
9031 if (flags & JIM_SUBST_NOVAR) {
9032 pc->tstart--;
9033 if (flags & JIM_SUBST_NOESC)
9034 pc->tt = JIM_TT_STR;
9035 else
9036 pc->tt = JIM_TT_ESC;
9037 if (*pc->tstart == '{') {
9038 pc->tstart--;
9039 if (*(pc->tend+1))
9040 pc->tend++;
9041 }
9042 }
9043 }
9044 break;
9045 default:
9046 retval = JimParseSubstStr(pc);
9047 if (flags & JIM_SUBST_NOESC)
9048 pc->tt = JIM_TT_STR;
9049 return retval;
9050 break;
9051 }
9052 return JIM_OK;
9053 }
9054
9055 /* The subst object type reuses most of the data structures and functions
9056 * of the script object. Script's data structures are a bit more complex
9057 * for what is needed for [subst]itution tasks, but the reuse helps to
9058 * deal with a single data structure at the cost of some more memory
9059 * usage for substitutions. */
9060 static Jim_ObjType substObjType = {
9061 "subst",
9062 FreeScriptInternalRep,
9063 DupScriptInternalRep,
9064 NULL,
9065 JIM_TYPE_REFERENCES,
9066 };
9067
9068 /* This method takes the string representation of an object
9069 * as a Tcl string where to perform [subst]itution, and generates
9070 * the pre-parsed internal representation. */
9071 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9072 {
9073 int scriptTextLen;
9074 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9075 struct JimParserCtx parser;
9076 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9077
9078 script->len = 0;
9079 script->csLen = 0;
9080 script->commands = 0;
9081 script->token = NULL;
9082 script->cmdStruct = NULL;
9083 script->inUse = 1;
9084 script->substFlags = flags;
9085 script->fileName = NULL;
9086
9087 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9088 while(1) {
9089 char *token;
9090 int len, type, linenr;
9091
9092 JimParseSubst(&parser, flags);
9093 if (JimParserEof(&parser)) break;
9094 token = JimParserGetToken(&parser, &len, &type, &linenr);
9095 ScriptObjAddToken(interp, script, token, len, type,
9096 NULL, linenr);
9097 }
9098 /* Free the old internal rep and set the new one. */
9099 Jim_FreeIntRep(interp, objPtr);
9100 Jim_SetIntRepPtr(objPtr, script);
9101 objPtr->typePtr = &scriptObjType;
9102 return JIM_OK;
9103 }
9104
9105 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9106 {
9107 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9108
9109 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9110 SetSubstFromAny(interp, objPtr, flags);
9111 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9112 }
9113
9114 /* Performs commands,variables,blackslashes substitution,
9115 * storing the result object (with refcount 0) into
9116 * resObjPtrPtr. */
9117 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9118 Jim_Obj **resObjPtrPtr, int flags)
9119 {
9120 ScriptObj *script;
9121 ScriptToken *token;
9122 int i, len, retcode = JIM_OK;
9123 Jim_Obj *resObjPtr, *savedResultObjPtr;
9124
9125 script = Jim_GetSubst(interp, substObjPtr, flags);
9126 #ifdef JIM_OPTIMIZATION
9127 /* Fast path for a very common case with array-alike syntax,
9128 * that's: $foo($bar) */
9129 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9130 Jim_Obj *varObjPtr = script->token[0].objPtr;
9131
9132 Jim_IncrRefCount(varObjPtr);
9133 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9134 if (resObjPtr == NULL) {
9135 Jim_DecrRefCount(interp, varObjPtr);
9136 return JIM_ERR;
9137 }
9138 Jim_DecrRefCount(interp, varObjPtr);
9139 *resObjPtrPtr = resObjPtr;
9140 return JIM_OK;
9141 }
9142 #endif
9143
9144 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9145 /* In order to preserve the internal rep, we increment the
9146 * inUse field of the script internal rep structure. */
9147 script->inUse++;
9148
9149 token = script->token;
9150 len = script->len;
9151
9152 /* Save the interp old result, to set it again before
9153 * to return. */
9154 savedResultObjPtr = interp->result;
9155 Jim_IncrRefCount(savedResultObjPtr);
9156
9157 /* Perform the substitution. Starts with an empty object
9158 * and adds every token (performing the appropriate
9159 * var/command/escape substitution). */
9160 resObjPtr = Jim_NewStringObj(interp, "", 0);
9161 for (i = 0; i < len; i++) {
9162 Jim_Obj *objPtr;
9163
9164 switch(token[i].type) {
9165 case JIM_TT_STR:
9166 case JIM_TT_ESC:
9167 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9168 break;
9169 case JIM_TT_VAR:
9170 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9171 if (objPtr == NULL) goto err;
9172 Jim_IncrRefCount(objPtr);
9173 Jim_AppendObj(interp, resObjPtr, objPtr);
9174 Jim_DecrRefCount(interp, objPtr);
9175 break;
9176 case JIM_TT_DICTSUGAR:
9177 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9178 if (!objPtr) {
9179 retcode = JIM_ERR;
9180 goto err;
9181 }
9182 break;
9183 case JIM_TT_CMD:
9184 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9185 goto err;
9186 Jim_AppendObj(interp, resObjPtr, interp->result);
9187 break;
9188 default:
9189 Jim_Panic(interp,
9190 "default token type (%d) reached "
9191 "in Jim_SubstObj().", token[i].type);
9192 break;
9193 }
9194 }
9195 ok:
9196 if (retcode == JIM_OK)
9197 Jim_SetResult(interp, savedResultObjPtr);
9198 Jim_DecrRefCount(interp, savedResultObjPtr);
9199 /* Note that we don't have to decrement inUse, because the
9200 * following code transfers our use of the reference again to
9201 * the script object. */
9202 Jim_FreeIntRep(interp, substObjPtr);
9203 substObjPtr->typePtr = &scriptObjType;
9204 Jim_SetIntRepPtr(substObjPtr, script);
9205 Jim_DecrRefCount(interp, substObjPtr);
9206 *resObjPtrPtr = resObjPtr;
9207 return retcode;
9208 err:
9209 Jim_FreeNewObj(interp, resObjPtr);
9210 retcode = JIM_ERR;
9211 goto ok;
9212 }
9213
9214 /* -----------------------------------------------------------------------------
9215 * API Input/Export functions
9216 * ---------------------------------------------------------------------------*/
9217
9218 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9219 {
9220 Jim_HashEntry *he;
9221
9222 he = Jim_FindHashEntry(&interp->stub, funcname);
9223 if (!he)
9224 return JIM_ERR;
9225 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9226 return JIM_OK;
9227 }
9228
9229 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9230 {
9231 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9232 }
9233
9234 #define JIM_REGISTER_API(name) \
9235 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9236
9237 void JimRegisterCoreApi(Jim_Interp *interp)
9238 {
9239 interp->getApiFuncPtr = Jim_GetApi;
9240 JIM_REGISTER_API(Alloc);
9241 JIM_REGISTER_API(Free);
9242 JIM_REGISTER_API(Eval);
9243 JIM_REGISTER_API(Eval_Named);
9244 JIM_REGISTER_API(EvalGlobal);
9245 JIM_REGISTER_API(EvalFile);
9246 JIM_REGISTER_API(EvalObj);
9247 JIM_REGISTER_API(EvalObjBackground);
9248 JIM_REGISTER_API(EvalObjVector);
9249 JIM_REGISTER_API(InitHashTable);
9250 JIM_REGISTER_API(ExpandHashTable);
9251 JIM_REGISTER_API(AddHashEntry);
9252 JIM_REGISTER_API(ReplaceHashEntry);
9253 JIM_REGISTER_API(DeleteHashEntry);
9254 JIM_REGISTER_API(FreeHashTable);
9255 JIM_REGISTER_API(FindHashEntry);
9256 JIM_REGISTER_API(ResizeHashTable);
9257 JIM_REGISTER_API(GetHashTableIterator);
9258 JIM_REGISTER_API(NextHashEntry);
9259 JIM_REGISTER_API(NewObj);
9260 JIM_REGISTER_API(FreeObj);
9261 JIM_REGISTER_API(InvalidateStringRep);
9262 JIM_REGISTER_API(InitStringRep);
9263 JIM_REGISTER_API(DuplicateObj);
9264 JIM_REGISTER_API(GetString);
9265 JIM_REGISTER_API(Length);
9266 JIM_REGISTER_API(InvalidateStringRep);
9267 JIM_REGISTER_API(NewStringObj);
9268 JIM_REGISTER_API(NewStringObjNoAlloc);
9269 JIM_REGISTER_API(AppendString);
9270 JIM_REGISTER_API(AppendString_sprintf);
9271 JIM_REGISTER_API(AppendObj);
9272 JIM_REGISTER_API(AppendStrings);
9273 JIM_REGISTER_API(StringEqObj);
9274 JIM_REGISTER_API(StringMatchObj);
9275 JIM_REGISTER_API(StringRangeObj);
9276 JIM_REGISTER_API(FormatString);
9277 JIM_REGISTER_API(CompareStringImmediate);
9278 JIM_REGISTER_API(NewReference);
9279 JIM_REGISTER_API(GetReference);
9280 JIM_REGISTER_API(SetFinalizer);
9281 JIM_REGISTER_API(GetFinalizer);
9282 JIM_REGISTER_API(CreateInterp);
9283 JIM_REGISTER_API(FreeInterp);
9284 JIM_REGISTER_API(GetExitCode);
9285 JIM_REGISTER_API(SetStdin);
9286 JIM_REGISTER_API(SetStdout);
9287 JIM_REGISTER_API(SetStderr);
9288 JIM_REGISTER_API(CreateCommand);
9289 JIM_REGISTER_API(CreateProcedure);
9290 JIM_REGISTER_API(DeleteCommand);
9291 JIM_REGISTER_API(RenameCommand);
9292 JIM_REGISTER_API(GetCommand);
9293 JIM_REGISTER_API(SetVariable);
9294 JIM_REGISTER_API(SetVariableStr);
9295 JIM_REGISTER_API(SetGlobalVariableStr);
9296 JIM_REGISTER_API(SetVariableStrWithStr);
9297 JIM_REGISTER_API(SetVariableLink);
9298 JIM_REGISTER_API(GetVariable);
9299 JIM_REGISTER_API(GetCallFrameByLevel);
9300 JIM_REGISTER_API(Collect);
9301 JIM_REGISTER_API(CollectIfNeeded);
9302 JIM_REGISTER_API(GetIndex);
9303 JIM_REGISTER_API(NewListObj);
9304 JIM_REGISTER_API(ListAppendElement);
9305 JIM_REGISTER_API(ListAppendList);
9306 JIM_REGISTER_API(ListLength);
9307 JIM_REGISTER_API(ListIndex);
9308 JIM_REGISTER_API(SetListIndex);
9309 JIM_REGISTER_API(ConcatObj);
9310 JIM_REGISTER_API(NewDictObj);
9311 JIM_REGISTER_API(DictKey);
9312 JIM_REGISTER_API(DictKeysVector);
9313 JIM_REGISTER_API(GetIndex);
9314 JIM_REGISTER_API(GetReturnCode);
9315 JIM_REGISTER_API(EvalExpression);
9316 JIM_REGISTER_API(GetBoolFromExpr);
9317 JIM_REGISTER_API(GetWide);
9318 JIM_REGISTER_API(GetLong);
9319 JIM_REGISTER_API(SetWide);
9320 JIM_REGISTER_API(NewIntObj);
9321 JIM_REGISTER_API(GetDouble);
9322 JIM_REGISTER_API(SetDouble);
9323 JIM_REGISTER_API(NewDoubleObj);
9324 JIM_REGISTER_API(WrongNumArgs);
9325 JIM_REGISTER_API(SetDictKeysVector);
9326 JIM_REGISTER_API(SubstObj);
9327 JIM_REGISTER_API(RegisterApi);
9328 JIM_REGISTER_API(PrintErrorMessage);
9329 JIM_REGISTER_API(InteractivePrompt);
9330 JIM_REGISTER_API(RegisterCoreCommands);
9331 JIM_REGISTER_API(GetSharedString);
9332 JIM_REGISTER_API(ReleaseSharedString);
9333 JIM_REGISTER_API(Panic);
9334 JIM_REGISTER_API(StrDup);
9335 JIM_REGISTER_API(UnsetVariable);
9336 JIM_REGISTER_API(GetVariableStr);
9337 JIM_REGISTER_API(GetGlobalVariable);
9338 JIM_REGISTER_API(GetGlobalVariableStr);
9339 JIM_REGISTER_API(GetAssocData);
9340 JIM_REGISTER_API(SetAssocData);
9341 JIM_REGISTER_API(DeleteAssocData);
9342 JIM_REGISTER_API(GetEnum);
9343 JIM_REGISTER_API(ScriptIsComplete);
9344 JIM_REGISTER_API(PackageRequire);
9345 JIM_REGISTER_API(PackageProvide);
9346 JIM_REGISTER_API(InitStack);
9347 JIM_REGISTER_API(FreeStack);
9348 JIM_REGISTER_API(StackLen);
9349 JIM_REGISTER_API(StackPush);
9350 JIM_REGISTER_API(StackPop);
9351 JIM_REGISTER_API(StackPeek);
9352 JIM_REGISTER_API(FreeStackElements);
9353 JIM_REGISTER_API(fprintf );
9354 JIM_REGISTER_API(vfprintf );
9355 JIM_REGISTER_API(fwrite );
9356 JIM_REGISTER_API(fread );
9357 JIM_REGISTER_API(fflush );
9358 JIM_REGISTER_API(fgets );
9359 JIM_REGISTER_API(GetNvp);
9360 JIM_REGISTER_API(Nvp_name2value);
9361 JIM_REGISTER_API(Nvp_name2value_simple);
9362 JIM_REGISTER_API(Nvp_name2value_obj);
9363 JIM_REGISTER_API(Nvp_name2value_nocase);
9364 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9365
9366 JIM_REGISTER_API(Nvp_value2name);
9367 JIM_REGISTER_API(Nvp_value2name_simple);
9368 JIM_REGISTER_API(Nvp_value2name_obj);
9369
9370 JIM_REGISTER_API(GetOpt_Setup);
9371 JIM_REGISTER_API(GetOpt_Debug);
9372 JIM_REGISTER_API(GetOpt_Obj);
9373 JIM_REGISTER_API(GetOpt_String);
9374 JIM_REGISTER_API(GetOpt_Double);
9375 JIM_REGISTER_API(GetOpt_Wide);
9376 JIM_REGISTER_API(GetOpt_Nvp);
9377 JIM_REGISTER_API(GetOpt_NvpUnknown);
9378 JIM_REGISTER_API(GetOpt_Enum);
9379
9380 JIM_REGISTER_API(Debug_ArgvString);
9381 JIM_REGISTER_API(SetResult_sprintf);
9382 JIM_REGISTER_API(SetResult_NvpUnknown);
9383
9384 }
9385
9386 /* -----------------------------------------------------------------------------
9387 * Core commands utility functions
9388 * ---------------------------------------------------------------------------*/
9389 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9390 const char *msg)
9391 {
9392 int i;
9393 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9394
9395 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9396 for (i = 0; i < argc; i++) {
9397 Jim_AppendObj(interp, objPtr, argv[i]);
9398 if (!(i+1 == argc && msg[0] == '\0'))
9399 Jim_AppendString(interp, objPtr, " ", 1);
9400 }
9401 Jim_AppendString(interp, objPtr, msg, -1);
9402 Jim_AppendString(interp, objPtr, "\"", 1);
9403 Jim_SetResult(interp, objPtr);
9404 }
9405
9406 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9407 {
9408 Jim_HashTableIterator *htiter;
9409 Jim_HashEntry *he;
9410 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9411 const char *pattern;
9412 int patternLen;
9413
9414 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9415 htiter = Jim_GetHashTableIterator(&interp->commands);
9416 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9417 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9418 strlen((const char*)he->key), 0))
9419 continue;
9420 Jim_ListAppendElement(interp, listObjPtr,
9421 Jim_NewStringObj(interp, he->key, -1));
9422 }
9423 Jim_FreeHashTableIterator(htiter);
9424 return listObjPtr;
9425 }
9426
9427 #define JIM_VARLIST_GLOBALS 0
9428 #define JIM_VARLIST_LOCALS 1
9429 #define JIM_VARLIST_VARS 2
9430
9431 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9432 int mode)
9433 {
9434 Jim_HashTableIterator *htiter;
9435 Jim_HashEntry *he;
9436 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9437 const char *pattern;
9438 int patternLen;
9439
9440 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9441 if (mode == JIM_VARLIST_GLOBALS) {
9442 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9443 } else {
9444 /* For [info locals], if we are at top level an emtpy list
9445 * is returned. I don't agree, but we aim at compatibility (SS) */
9446 if (mode == JIM_VARLIST_LOCALS &&
9447 interp->framePtr == interp->topFramePtr)
9448 return listObjPtr;
9449 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9450 }
9451 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9452 Jim_Var *varPtr = (Jim_Var*) he->val;
9453 if (mode == JIM_VARLIST_LOCALS) {
9454 if (varPtr->linkFramePtr != NULL)
9455 continue;
9456 }
9457 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9458 strlen((const char*)he->key), 0))
9459 continue;
9460 Jim_ListAppendElement(interp, listObjPtr,
9461 Jim_NewStringObj(interp, he->key, -1));
9462 }
9463 Jim_FreeHashTableIterator(htiter);
9464 return listObjPtr;
9465 }
9466
9467 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9468 Jim_Obj **objPtrPtr)
9469 {
9470 Jim_CallFrame *targetCallFrame;
9471
9472 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9473 != JIM_OK)
9474 return JIM_ERR;
9475 /* No proc call at toplevel callframe */
9476 if (targetCallFrame == interp->topFramePtr) {
9477 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9478 Jim_AppendStrings(interp, Jim_GetResult(interp),
9479 "bad level \"",
9480 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9481 return JIM_ERR;
9482 }
9483 *objPtrPtr = Jim_NewListObj(interp,
9484 targetCallFrame->argv,
9485 targetCallFrame->argc);
9486 return JIM_OK;
9487 }
9488
9489 /* -----------------------------------------------------------------------------
9490 * Core commands
9491 * ---------------------------------------------------------------------------*/
9492
9493 /* fake [puts] -- not the real puts, just for debugging. */
9494 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9495 Jim_Obj *const *argv)
9496 {
9497 const char *str;
9498 int len, nonewline = 0;
9499
9500 if (argc != 2 && argc != 3) {
9501 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9502 return JIM_ERR;
9503 }
9504 if (argc == 3) {
9505 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9506 {
9507 Jim_SetResultString(interp, "The second argument must "
9508 "be -nonewline", -1);
9509 return JIM_OK;
9510 } else {
9511 nonewline = 1;
9512 argv++;
9513 }
9514 }
9515 str = Jim_GetString(argv[1], &len);
9516 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9517 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9518 return JIM_OK;
9519 }
9520
9521 /* Helper for [+] and [*] */
9522 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9523 Jim_Obj *const *argv, int op)
9524 {
9525 jim_wide wideValue, res;
9526 double doubleValue, doubleRes;
9527 int i;
9528
9529 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9530
9531 for (i = 1; i < argc; i++) {
9532 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9533 goto trydouble;
9534 if (op == JIM_EXPROP_ADD)
9535 res += wideValue;
9536 else
9537 res *= wideValue;
9538 }
9539 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9540 return JIM_OK;
9541 trydouble:
9542 doubleRes = (double) res;
9543 for (;i < argc; i++) {
9544 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9545 return JIM_ERR;
9546 if (op == JIM_EXPROP_ADD)
9547 doubleRes += doubleValue;
9548 else
9549 doubleRes *= doubleValue;
9550 }
9551 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9552 return JIM_OK;
9553 }
9554
9555 /* Helper for [-] and [/] */
9556 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9557 Jim_Obj *const *argv, int op)
9558 {
9559 jim_wide wideValue, res = 0;
9560 double doubleValue, doubleRes = 0;
9561 int i = 2;
9562
9563 if (argc < 2) {
9564 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9565 return JIM_ERR;
9566 } else if (argc == 2) {
9567 /* The arity = 2 case is different. For [- x] returns -x,
9568 * while [/ x] returns 1/x. */
9569 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9570 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9571 JIM_OK)
9572 {
9573 return JIM_ERR;
9574 } else {
9575 if (op == JIM_EXPROP_SUB)
9576 doubleRes = -doubleValue;
9577 else
9578 doubleRes = 1.0/doubleValue;
9579 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9580 doubleRes));
9581 return JIM_OK;
9582 }
9583 }
9584 if (op == JIM_EXPROP_SUB) {
9585 res = -wideValue;
9586 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9587 } else {
9588 doubleRes = 1.0/wideValue;
9589 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9590 doubleRes));
9591 }
9592 return JIM_OK;
9593 } else {
9594 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9595 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9596 != JIM_OK) {
9597 return JIM_ERR;
9598 } else {
9599 goto trydouble;
9600 }
9601 }
9602 }
9603 for (i = 2; i < argc; i++) {
9604 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9605 doubleRes = (double) res;
9606 goto trydouble;
9607 }
9608 if (op == JIM_EXPROP_SUB)
9609 res -= wideValue;
9610 else
9611 res /= wideValue;
9612 }
9613 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9614 return JIM_OK;
9615 trydouble:
9616 for (;i < argc; i++) {
9617 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9618 return JIM_ERR;
9619 if (op == JIM_EXPROP_SUB)
9620 doubleRes -= doubleValue;
9621 else
9622 doubleRes /= doubleValue;
9623 }
9624 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9625 return JIM_OK;
9626 }
9627
9628
9629 /* [+] */
9630 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9631 Jim_Obj *const *argv)
9632 {
9633 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9634 }
9635
9636 /* [*] */
9637 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9638 Jim_Obj *const *argv)
9639 {
9640 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9641 }
9642
9643 /* [-] */
9644 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9645 Jim_Obj *const *argv)
9646 {
9647 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9648 }
9649
9650 /* [/] */
9651 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9652 Jim_Obj *const *argv)
9653 {
9654 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9655 }
9656
9657 /* [set] */
9658 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9659 Jim_Obj *const *argv)
9660 {
9661 if (argc != 2 && argc != 3) {
9662 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9663 return JIM_ERR;
9664 }
9665 if (argc == 2) {
9666 Jim_Obj *objPtr;
9667 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9668 if (!objPtr)
9669 return JIM_ERR;
9670 Jim_SetResult(interp, objPtr);
9671 return JIM_OK;
9672 }
9673 /* argc == 3 case. */
9674 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9675 return JIM_ERR;
9676 Jim_SetResult(interp, argv[2]);
9677 return JIM_OK;
9678 }
9679
9680 /* [unset] */
9681 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9682 Jim_Obj *const *argv)
9683 {
9684 int i;
9685
9686 if (argc < 2) {
9687 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9688 return JIM_ERR;
9689 }
9690 for (i = 1; i < argc; i++) {
9691 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9692 return JIM_ERR;
9693 }
9694 return JIM_OK;
9695 }
9696
9697 /* [incr] */
9698 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9699 Jim_Obj *const *argv)
9700 {
9701 jim_wide wideValue, increment = 1;
9702 Jim_Obj *intObjPtr;
9703
9704 if (argc != 2 && argc != 3) {
9705 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9706 return JIM_ERR;
9707 }
9708 if (argc == 3) {
9709 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9710 return JIM_ERR;
9711 }
9712 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9713 if (!intObjPtr) return JIM_ERR;
9714 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9715 return JIM_ERR;
9716 if (Jim_IsShared(intObjPtr)) {
9717 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9718 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9719 Jim_FreeNewObj(interp, intObjPtr);
9720 return JIM_ERR;
9721 }
9722 } else {
9723 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9724 /* The following step is required in order to invalidate the
9725 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9726 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9727 return JIM_ERR;
9728 }
9729 }
9730 Jim_SetResult(interp, intObjPtr);
9731 return JIM_OK;
9732 }
9733
9734 /* [while] */
9735 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9736 Jim_Obj *const *argv)
9737 {
9738 if (argc != 3) {
9739 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9740 return JIM_ERR;
9741 }
9742 /* Try to run a specialized version of while if the expression
9743 * is in one of the following forms:
9744 *
9745 * $a < CONST, $a < $b
9746 * $a <= CONST, $a <= $b
9747 * $a > CONST, $a > $b
9748 * $a >= CONST, $a >= $b
9749 * $a != CONST, $a != $b
9750 * $a == CONST, $a == $b
9751 * $a
9752 * !$a
9753 * CONST
9754 */
9755
9756 #ifdef JIM_OPTIMIZATION
9757 {
9758 ExprByteCode *expr;
9759 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9760 int exprLen, retval;
9761
9762 /* STEP 1 -- Check if there are the conditions to run the specialized
9763 * version of while */
9764
9765 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9766 if (expr->len <= 0 || expr->len > 3) goto noopt;
9767 switch(expr->len) {
9768 case 1:
9769 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9770 expr->opcode[0] != JIM_EXPROP_NUMBER)
9771 goto noopt;
9772 break;
9773 case 2:
9774 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9775 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9776 goto noopt;
9777 break;
9778 case 3:
9779 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9780 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9781 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9782 goto noopt;
9783 switch(expr->opcode[2]) {
9784 case JIM_EXPROP_LT:
9785 case JIM_EXPROP_LTE:
9786 case JIM_EXPROP_GT:
9787 case JIM_EXPROP_GTE:
9788 case JIM_EXPROP_NUMEQ:
9789 case JIM_EXPROP_NUMNE:
9790 /* nothing to do */
9791 break;
9792 default:
9793 goto noopt;
9794 }
9795 break;
9796 default:
9797 Jim_Panic(interp,
9798 "Unexpected default reached in Jim_WhileCoreCommand()");
9799 break;
9800 }
9801
9802 /* STEP 2 -- conditions meet. Initialization. Take different
9803 * branches for different expression lengths. */
9804 exprLen = expr->len;
9805
9806 if (exprLen == 1) {
9807 jim_wide wideValue;
9808
9809 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9810 varAObjPtr = expr->obj[0];
9811 Jim_IncrRefCount(varAObjPtr);
9812 } else {
9813 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9814 goto noopt;
9815 }
9816 while (1) {
9817 if (varAObjPtr) {
9818 if (!(objPtr =
9819 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9820 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9821 {
9822 Jim_DecrRefCount(interp, varAObjPtr);
9823 goto noopt;
9824 }
9825 }
9826 if (!wideValue) break;
9827 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9828 switch(retval) {
9829 case JIM_BREAK:
9830 if (varAObjPtr)
9831 Jim_DecrRefCount(interp, varAObjPtr);
9832 goto out;
9833 break;
9834 case JIM_CONTINUE:
9835 continue;
9836 break;
9837 default:
9838 if (varAObjPtr)
9839 Jim_DecrRefCount(interp, varAObjPtr);
9840 return retval;
9841 }
9842 }
9843 }
9844 if (varAObjPtr)
9845 Jim_DecrRefCount(interp, varAObjPtr);
9846 } else if (exprLen == 3) {
9847 jim_wide wideValueA, wideValueB, cmpRes = 0;
9848 int cmpType = expr->opcode[2];
9849
9850 varAObjPtr = expr->obj[0];
9851 Jim_IncrRefCount(varAObjPtr);
9852 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9853 varBObjPtr = expr->obj[1];
9854 Jim_IncrRefCount(varBObjPtr);
9855 } else {
9856 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9857 goto noopt;
9858 }
9859 while (1) {
9860 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9861 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9862 {
9863 Jim_DecrRefCount(interp, varAObjPtr);
9864 if (varBObjPtr)
9865 Jim_DecrRefCount(interp, varBObjPtr);
9866 goto noopt;
9867 }
9868 if (varBObjPtr) {
9869 if (!(objPtr =
9870 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9871 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9872 {
9873 Jim_DecrRefCount(interp, varAObjPtr);
9874 if (varBObjPtr)
9875 Jim_DecrRefCount(interp, varBObjPtr);
9876 goto noopt;
9877 }
9878 }
9879 switch(cmpType) {
9880 case JIM_EXPROP_LT:
9881 cmpRes = wideValueA < wideValueB; break;
9882 case JIM_EXPROP_LTE:
9883 cmpRes = wideValueA <= wideValueB; break;
9884 case JIM_EXPROP_GT:
9885 cmpRes = wideValueA > wideValueB; break;
9886 case JIM_EXPROP_GTE:
9887 cmpRes = wideValueA >= wideValueB; break;
9888 case JIM_EXPROP_NUMEQ:
9889 cmpRes = wideValueA == wideValueB; break;
9890 case JIM_EXPROP_NUMNE:
9891 cmpRes = wideValueA != wideValueB; break;
9892 }
9893 if (!cmpRes) break;
9894 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9895 switch(retval) {
9896 case JIM_BREAK:
9897 Jim_DecrRefCount(interp, varAObjPtr);
9898 if (varBObjPtr)
9899 Jim_DecrRefCount(interp, varBObjPtr);
9900 goto out;
9901 break;
9902 case JIM_CONTINUE:
9903 continue;
9904 break;
9905 default:
9906 Jim_DecrRefCount(interp, varAObjPtr);
9907 if (varBObjPtr)
9908 Jim_DecrRefCount(interp, varBObjPtr);
9909 return retval;
9910 }
9911 }
9912 }
9913 Jim_DecrRefCount(interp, varAObjPtr);
9914 if (varBObjPtr)
9915 Jim_DecrRefCount(interp, varBObjPtr);
9916 } else {
9917 /* TODO: case for len == 2 */
9918 goto noopt;
9919 }
9920 Jim_SetEmptyResult(interp);
9921 return JIM_OK;
9922 }
9923 noopt:
9924 #endif
9925
9926 /* The general purpose implementation of while starts here */
9927 while (1) {
9928 int boolean, retval;
9929
9930 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9931 &boolean)) != JIM_OK)
9932 return retval;
9933 if (!boolean) break;
9934 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9935 switch(retval) {
9936 case JIM_BREAK:
9937 goto out;
9938 break;
9939 case JIM_CONTINUE:
9940 continue;
9941 break;
9942 default:
9943 return retval;
9944 }
9945 }
9946 }
9947 out:
9948 Jim_SetEmptyResult(interp);
9949 return JIM_OK;
9950 }
9951
9952 /* [for] */
9953 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9954 Jim_Obj *const *argv)
9955 {
9956 int retval;
9957
9958 if (argc != 5) {
9959 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9960 return JIM_ERR;
9961 }
9962 /* Check if the for is on the form:
9963 * for {set i CONST} {$i < CONST} {incr i}
9964 * for {set i CONST} {$i < $j} {incr i}
9965 * for {set i CONST} {$i <= CONST} {incr i}
9966 * for {set i CONST} {$i <= $j} {incr i}
9967 * XXX: NOTE: if variable traces are implemented, this optimization
9968 * need to be modified to check for the proc epoch at every variable
9969 * update. */
9970 #ifdef JIM_OPTIMIZATION
9971 {
9972 ScriptObj *initScript, *incrScript;
9973 ExprByteCode *expr;
9974 jim_wide start, stop, currentVal;
9975 unsigned jim_wide procEpoch = interp->procEpoch;
9976 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9977 int cmpType;
9978 struct Jim_Cmd *cmdPtr;
9979
9980 /* Do it only if there aren't shared arguments */
9981 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9982 goto evalstart;
9983 initScript = Jim_GetScript(interp, argv[1]);
9984 expr = Jim_GetExpression(interp, argv[2]);
9985 incrScript = Jim_GetScript(interp, argv[3]);
9986
9987 /* Ensure proper lengths to start */
9988 if (initScript->len != 6) goto evalstart;
9989 if (incrScript->len != 4) goto evalstart;
9990 if (expr->len != 3) goto evalstart;
9991 /* Ensure proper token types. */
9992 if (initScript->token[2].type != JIM_TT_ESC ||
9993 initScript->token[4].type != JIM_TT_ESC ||
9994 incrScript->token[2].type != JIM_TT_ESC ||
9995 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9996 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9997 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9998 (expr->opcode[2] != JIM_EXPROP_LT &&
9999 expr->opcode[2] != JIM_EXPROP_LTE))
10000 goto evalstart;
10001 cmpType = expr->opcode[2];
10002 /* Initialization command must be [set] */
10003 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10004 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10005 goto evalstart;
10006 /* Update command must be incr */
10007 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10008 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10009 goto evalstart;
10010 /* set, incr, expression must be about the same variable */
10011 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10012 incrScript->token[2].objPtr, 0))
10013 goto evalstart;
10014 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10015 expr->obj[0], 0))
10016 goto evalstart;
10017 /* Check that the initialization and comparison are valid integers */
10018 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10019 goto evalstart;
10020 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10021 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10022 {
10023 goto evalstart;
10024 }
10025
10026 /* Initialization */
10027 varNamePtr = expr->obj[0];
10028 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10029 stopVarNamePtr = expr->obj[1];
10030 Jim_IncrRefCount(stopVarNamePtr);
10031 }
10032 Jim_IncrRefCount(varNamePtr);
10033
10034 /* --- OPTIMIZED FOR --- */
10035 /* Start to loop */
10036 objPtr = Jim_NewIntObj(interp, start);
10037 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10038 Jim_DecrRefCount(interp, varNamePtr);
10039 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10040 Jim_FreeNewObj(interp, objPtr);
10041 goto evalstart;
10042 }
10043 while (1) {
10044 /* === Check condition === */
10045 /* Common code: */
10046 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10047 if (objPtr == NULL ||
10048 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10049 {
10050 Jim_DecrRefCount(interp, varNamePtr);
10051 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10052 goto testcond;
10053 }
10054 /* Immediate or Variable? get the 'stop' value if the latter. */
10055 if (stopVarNamePtr) {
10056 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10057 if (objPtr == NULL ||
10058 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10059 {
10060 Jim_DecrRefCount(interp, varNamePtr);
10061 Jim_DecrRefCount(interp, stopVarNamePtr);
10062 goto testcond;
10063 }
10064 }
10065 if (cmpType == JIM_EXPROP_LT) {
10066 if (currentVal >= stop) break;
10067 } else {
10068 if (currentVal > stop) break;
10069 }
10070 /* Eval body */
10071 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10072 switch(retval) {
10073 case JIM_BREAK:
10074 if (stopVarNamePtr)
10075 Jim_DecrRefCount(interp, stopVarNamePtr);
10076 Jim_DecrRefCount(interp, varNamePtr);
10077 goto out;
10078 case JIM_CONTINUE:
10079 /* nothing to do */
10080 break;
10081 default:
10082 if (stopVarNamePtr)
10083 Jim_DecrRefCount(interp, stopVarNamePtr);
10084 Jim_DecrRefCount(interp, varNamePtr);
10085 return retval;
10086 }
10087 }
10088 /* If there was a change in procedures/command continue
10089 * with the usual [for] command implementation */
10090 if (procEpoch != interp->procEpoch) {
10091 if (stopVarNamePtr)
10092 Jim_DecrRefCount(interp, stopVarNamePtr);
10093 Jim_DecrRefCount(interp, varNamePtr);
10094 goto evalnext;
10095 }
10096 /* Increment */
10097 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10098 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10099 objPtr->internalRep.wideValue ++;
10100 Jim_InvalidateStringRep(objPtr);
10101 } else {
10102 Jim_Obj *auxObjPtr;
10103
10104 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10105 if (stopVarNamePtr)
10106 Jim_DecrRefCount(interp, stopVarNamePtr);
10107 Jim_DecrRefCount(interp, varNamePtr);
10108 goto evalnext;
10109 }
10110 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10111 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10112 if (stopVarNamePtr)
10113 Jim_DecrRefCount(interp, stopVarNamePtr);
10114 Jim_DecrRefCount(interp, varNamePtr);
10115 Jim_FreeNewObj(interp, auxObjPtr);
10116 goto evalnext;
10117 }
10118 }
10119 }
10120 if (stopVarNamePtr)
10121 Jim_DecrRefCount(interp, stopVarNamePtr);
10122 Jim_DecrRefCount(interp, varNamePtr);
10123 Jim_SetEmptyResult(interp);
10124 return JIM_OK;
10125 }
10126 #endif
10127 evalstart:
10128 /* Eval start */
10129 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10130 return retval;
10131 while (1) {
10132 int boolean;
10133 testcond:
10134 /* Test the condition */
10135 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10136 != JIM_OK)
10137 return retval;
10138 if (!boolean) break;
10139 /* Eval body */
10140 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10141 switch(retval) {
10142 case JIM_BREAK:
10143 goto out;
10144 break;
10145 case JIM_CONTINUE:
10146 /* Nothing to do */
10147 break;
10148 default:
10149 return retval;
10150 }
10151 }
10152 evalnext:
10153 /* Eval next */
10154 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10155 switch(retval) {
10156 case JIM_BREAK:
10157 goto out;
10158 break;
10159 case JIM_CONTINUE:
10160 continue;
10161 break;
10162 default:
10163 return retval;
10164 }
10165 }
10166 }
10167 out:
10168 Jim_SetEmptyResult(interp);
10169 return JIM_OK;
10170 }
10171
10172 /* foreach + lmap implementation. */
10173 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10174 Jim_Obj *const *argv, int doMap)
10175 {
10176 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10177 int nbrOfLoops = 0;
10178 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10179
10180 if (argc < 4 || argc % 2 != 0) {
10181 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10182 return JIM_ERR;
10183 }
10184 if (doMap) {
10185 mapRes = Jim_NewListObj(interp, NULL, 0);
10186 Jim_IncrRefCount(mapRes);
10187 }
10188 emptyStr = Jim_NewEmptyStringObj(interp);
10189 Jim_IncrRefCount(emptyStr);
10190 script = argv[argc-1]; /* Last argument is a script */
10191 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10192 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10193 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10194 /* Initialize iterators and remember max nbr elements each list */
10195 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10196 /* Remember lengths of all lists and calculate how much rounds to loop */
10197 for (i=0; i < nbrOfLists*2; i += 2) {
10198 div_t cnt;
10199 int count;
10200 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10201 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10202 if (listsEnd[i] == 0) {
10203 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10204 goto err;
10205 }
10206 cnt = div(listsEnd[i+1], listsEnd[i]);
10207 count = cnt.quot + (cnt.rem ? 1 : 0);
10208 if (count > nbrOfLoops)
10209 nbrOfLoops = count;
10210 }
10211 for (; nbrOfLoops-- > 0; ) {
10212 for (i=0; i < nbrOfLists; ++i) {
10213 int varIdx = 0, var = i * 2;
10214 while (varIdx < listsEnd[var]) {
10215 Jim_Obj *varName, *ele;
10216 int lst = i * 2 + 1;
10217 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10218 != JIM_OK)
10219 goto err;
10220 if (listsIdx[i] < listsEnd[lst]) {
10221 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10222 != JIM_OK)
10223 goto err;
10224 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10225 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10226 goto err;
10227 }
10228 ++listsIdx[i]; /* Remember next iterator of current list */
10229 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10230 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10231 goto err;
10232 }
10233 ++varIdx; /* Next variable */
10234 }
10235 }
10236 switch (result = Jim_EvalObj(interp, script)) {
10237 case JIM_OK:
10238 if (doMap)
10239 Jim_ListAppendElement(interp, mapRes, interp->result);
10240 break;
10241 case JIM_CONTINUE:
10242 break;
10243 case JIM_BREAK:
10244 goto out;
10245 break;
10246 default:
10247 goto err;
10248 }
10249 }
10250 out:
10251 result = JIM_OK;
10252 if (doMap)
10253 Jim_SetResult(interp, mapRes);
10254 else
10255 Jim_SetEmptyResult(interp);
10256 err:
10257 if (doMap)
10258 Jim_DecrRefCount(interp, mapRes);
10259 Jim_DecrRefCount(interp, emptyStr);
10260 Jim_Free(listsIdx);
10261 Jim_Free(listsEnd);
10262 return result;
10263 }
10264
10265 /* [foreach] */
10266 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10267 Jim_Obj *const *argv)
10268 {
10269 return JimForeachMapHelper(interp, argc, argv, 0);
10270 }
10271
10272 /* [lmap] */
10273 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10274 Jim_Obj *const *argv)
10275 {
10276 return JimForeachMapHelper(interp, argc, argv, 1);
10277 }
10278
10279 /* [if] */
10280 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10281 Jim_Obj *const *argv)
10282 {
10283 int boolean, retval, current = 1, falsebody = 0;
10284 if (argc >= 3) {
10285 while (1) {
10286 /* Far not enough arguments given! */
10287 if (current >= argc) goto err;
10288 if ((retval = Jim_GetBoolFromExpr(interp,
10289 argv[current++], &boolean))
10290 != JIM_OK)
10291 return retval;
10292 /* There lacks something, isn't it? */
10293 if (current >= argc) goto err;
10294 if (Jim_CompareStringImmediate(interp, argv[current],
10295 "then")) current++;
10296 /* Tsk tsk, no then-clause? */
10297 if (current >= argc) goto err;
10298 if (boolean)
10299 return Jim_EvalObj(interp, argv[current]);
10300 /* Ok: no else-clause follows */
10301 if (++current >= argc) {
10302 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10303 return JIM_OK;
10304 }
10305 falsebody = current++;
10306 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10307 "else")) {
10308 /* IIICKS - else-clause isn't last cmd? */
10309 if (current != argc-1) goto err;
10310 return Jim_EvalObj(interp, argv[current]);
10311 } else if (Jim_CompareStringImmediate(interp,
10312 argv[falsebody], "elseif"))
10313 /* Ok: elseif follows meaning all the stuff
10314 * again (how boring...) */
10315 continue;
10316 /* OOPS - else-clause is not last cmd?*/
10317 else if (falsebody != argc-1)
10318 goto err;
10319 return Jim_EvalObj(interp, argv[falsebody]);
10320 }
10321 return JIM_OK;
10322 }
10323 err:
10324 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10325 return JIM_ERR;
10326 }
10327
10328 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10329
10330 /* [switch] */
10331 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10332 Jim_Obj *const *argv)
10333 {
10334 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10335 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10336 Jim_Obj *script = 0;
10337 if (argc < 3) goto wrongnumargs;
10338 for (opt=1; opt < argc; ++opt) {
10339 const char *option = Jim_GetString(argv[opt], 0);
10340 if (*option != '-') break;
10341 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10342 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10343 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10344 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10345 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10346 if ((argc - opt) < 2) goto wrongnumargs;
10347 command = argv[++opt];
10348 } else {
10349 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10350 Jim_AppendStrings(interp, Jim_GetResult(interp),
10351 "bad option \"", option, "\": must be -exact, -glob, "
10352 "-regexp, -command procname or --", 0);
10353 goto err;
10354 }
10355 if ((argc - opt) < 2) goto wrongnumargs;
10356 }
10357 strObj = argv[opt++];
10358 patCount = argc - opt;
10359 if (patCount == 1) {
10360 Jim_Obj **vector;
10361 JimListGetElements(interp, argv[opt], &patCount, &vector);
10362 caseList = vector;
10363 } else
10364 caseList = &argv[opt];
10365 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10366 for (i=0; script == 0 && i < patCount; i += 2) {
10367 Jim_Obj *patObj = caseList[i];
10368 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10369 || i < (patCount-2)) {
10370 switch (matchOpt) {
10371 case SWITCH_EXACT:
10372 if (Jim_StringEqObj(strObj, patObj, 0))
10373 script = caseList[i+1];
10374 break;
10375 case SWITCH_GLOB:
10376 if (Jim_StringMatchObj(patObj, strObj, 0))
10377 script = caseList[i+1];
10378 break;
10379 case SWITCH_RE:
10380 command = Jim_NewStringObj(interp, "regexp", -1);
10381 /* Fall thru intentionally */
10382 case SWITCH_CMD: {
10383 Jim_Obj *parms[] = {command, patObj, strObj};
10384 int rc = Jim_EvalObjVector(interp, 3, parms);
10385 long matching;
10386 /* After the execution of a command we need to
10387 * make sure to reconvert the object into a list
10388 * again. Only for the single-list style [switch]. */
10389 if (argc-opt == 1) {
10390 Jim_Obj **vector;
10391 JimListGetElements(interp, argv[opt], &patCount,
10392 &vector);
10393 caseList = vector;
10394 }
10395 /* command is here already decref'd */
10396 if (rc != JIM_OK) {
10397 retcode = rc;
10398 goto err;
10399 }
10400 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10401 if (rc != JIM_OK) {
10402 retcode = rc;
10403 goto err;
10404 }
10405 if (matching)
10406 script = caseList[i+1];
10407 break;
10408 }
10409 default:
10410 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10411 Jim_AppendStrings(interp, Jim_GetResult(interp),
10412 "internal error: no such option implemented", 0);
10413 goto err;
10414 }
10415 } else {
10416 script = caseList[i+1];
10417 }
10418 }
10419 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10420 i += 2)
10421 script = caseList[i+1];
10422 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10423 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10424 Jim_AppendStrings(interp, Jim_GetResult(interp),
10425 "no body specified for pattern \"",
10426 Jim_GetString(caseList[i-2], 0), "\"", 0);
10427 goto err;
10428 }
10429 retcode = JIM_OK;
10430 Jim_SetEmptyResult(interp);
10431 if (script != 0)
10432 retcode = Jim_EvalObj(interp, script);
10433 return retcode;
10434 wrongnumargs:
10435 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10436 "pattern body ... ?default body? or "
10437 "{pattern body ?pattern body ...?}");
10438 err:
10439 return retcode;
10440 }
10441
10442 /* [list] */
10443 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10444 Jim_Obj *const *argv)
10445 {
10446 Jim_Obj *listObjPtr;
10447
10448 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10449 Jim_SetResult(interp, listObjPtr);
10450 return JIM_OK;
10451 }
10452
10453 /* [lindex] */
10454 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10455 Jim_Obj *const *argv)
10456 {
10457 Jim_Obj *objPtr, *listObjPtr;
10458 int i;
10459 int index;
10460
10461 if (argc < 3) {
10462 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10463 return JIM_ERR;
10464 }
10465 objPtr = argv[1];
10466 Jim_IncrRefCount(objPtr);
10467 for (i = 2; i < argc; i++) {
10468 listObjPtr = objPtr;
10469 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10470 Jim_DecrRefCount(interp, listObjPtr);
10471 return JIM_ERR;
10472 }
10473 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10474 JIM_NONE) != JIM_OK) {
10475 /* Returns an empty object if the index
10476 * is out of range. */
10477 Jim_DecrRefCount(interp, listObjPtr);
10478 Jim_SetEmptyResult(interp);
10479 return JIM_OK;
10480 }
10481 Jim_IncrRefCount(objPtr);
10482 Jim_DecrRefCount(interp, listObjPtr);
10483 }
10484 Jim_SetResult(interp, objPtr);
10485 Jim_DecrRefCount(interp, objPtr);
10486 return JIM_OK;
10487 }
10488
10489 /* [llength] */
10490 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10491 Jim_Obj *const *argv)
10492 {
10493 int len;
10494
10495 if (argc != 2) {
10496 Jim_WrongNumArgs(interp, 1, argv, "list");
10497 return JIM_ERR;
10498 }
10499 Jim_ListLength(interp, argv[1], &len);
10500 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10501 return JIM_OK;
10502 }
10503
10504 /* [lappend] */
10505 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10506 Jim_Obj *const *argv)
10507 {
10508 Jim_Obj *listObjPtr;
10509 int shared, i;
10510
10511 if (argc < 2) {
10512 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10513 return JIM_ERR;
10514 }
10515 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10516 if (!listObjPtr) {
10517 /* Create the list if it does not exists */
10518 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10519 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10520 Jim_FreeNewObj(interp, listObjPtr);
10521 return JIM_ERR;
10522 }
10523 }
10524 shared = Jim_IsShared(listObjPtr);
10525 if (shared)
10526 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10527 for (i = 2; i < argc; i++)
10528 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10529 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10530 if (shared)
10531 Jim_FreeNewObj(interp, listObjPtr);
10532 return JIM_ERR;
10533 }
10534 Jim_SetResult(interp, listObjPtr);
10535 return JIM_OK;
10536 }
10537
10538 /* [linsert] */
10539 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10540 Jim_Obj *const *argv)
10541 {
10542 int index, len;
10543 Jim_Obj *listPtr;
10544
10545 if (argc < 4) {
10546 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10547 "?element ...?");
10548 return JIM_ERR;
10549 }
10550 listPtr = argv[1];
10551 if (Jim_IsShared(listPtr))
10552 listPtr = Jim_DuplicateObj(interp, listPtr);
10553 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10554 goto err;
10555 Jim_ListLength(interp, listPtr, &len);
10556 if (index >= len)
10557 index = len;
10558 else if (index < 0)
10559 index = len + index + 1;
10560 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10561 Jim_SetResult(interp, listPtr);
10562 return JIM_OK;
10563 err:
10564 if (listPtr != argv[1]) {
10565 Jim_FreeNewObj(interp, listPtr);
10566 }
10567 return JIM_ERR;
10568 }
10569
10570 /* [lset] */
10571 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10572 Jim_Obj *const *argv)
10573 {
10574 if (argc < 3) {
10575 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10576 return JIM_ERR;
10577 } else if (argc == 3) {
10578 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10579 return JIM_ERR;
10580 Jim_SetResult(interp, argv[2]);
10581 return JIM_OK;
10582 }
10583 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10584 == JIM_ERR) return JIM_ERR;
10585 return JIM_OK;
10586 }
10587
10588 /* [lsort] */
10589 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10590 {
10591 const char *options[] = {
10592 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10593 };
10594 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10595 Jim_Obj *resObj;
10596 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10597 int decreasing = 0;
10598
10599 if (argc < 2) {
10600 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10601 return JIM_ERR;
10602 }
10603 for (i = 1; i < (argc-1); i++) {
10604 int option;
10605
10606 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10607 != JIM_OK)
10608 return JIM_ERR;
10609 switch(option) {
10610 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10611 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10612 case OPT_INCREASING: decreasing = 0; break;
10613 case OPT_DECREASING: decreasing = 1; break;
10614 }
10615 }
10616 if (decreasing) {
10617 switch(lsortType) {
10618 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10619 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10620 }
10621 }
10622 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10623 ListSortElements(interp, resObj, lsortType);
10624 Jim_SetResult(interp, resObj);
10625 return JIM_OK;
10626 }
10627
10628 /* [append] */
10629 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10630 Jim_Obj *const *argv)
10631 {
10632 Jim_Obj *stringObjPtr;
10633 int shared, i;
10634
10635 if (argc < 2) {
10636 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10637 return JIM_ERR;
10638 }
10639 if (argc == 2) {
10640 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10641 if (!stringObjPtr) return JIM_ERR;
10642 } else {
10643 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10644 if (!stringObjPtr) {
10645 /* Create the string if it does not exists */
10646 stringObjPtr = Jim_NewEmptyStringObj(interp);
10647 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10648 != JIM_OK) {
10649 Jim_FreeNewObj(interp, stringObjPtr);
10650 return JIM_ERR;
10651 }
10652 }
10653 }
10654 shared = Jim_IsShared(stringObjPtr);
10655 if (shared)
10656 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10657 for (i = 2; i < argc; i++)
10658 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10659 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10660 if (shared)
10661 Jim_FreeNewObj(interp, stringObjPtr);
10662 return JIM_ERR;
10663 }
10664 Jim_SetResult(interp, stringObjPtr);
10665 return JIM_OK;
10666 }
10667
10668 /* [debug] */
10669 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10670 Jim_Obj *const *argv)
10671 {
10672 const char *options[] = {
10673 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10674 "exprbc",
10675 NULL
10676 };
10677 enum {
10678 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10679 OPT_EXPRLEN, OPT_EXPRBC
10680 };
10681 int option;
10682
10683 if (argc < 2) {
10684 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10685 return JIM_ERR;
10686 }
10687 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10688 JIM_ERRMSG) != JIM_OK)
10689 return JIM_ERR;
10690 if (option == OPT_REFCOUNT) {
10691 if (argc != 3) {
10692 Jim_WrongNumArgs(interp, 2, argv, "object");
10693 return JIM_ERR;
10694 }
10695 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10696 return JIM_OK;
10697 } else if (option == OPT_OBJCOUNT) {
10698 int freeobj = 0, liveobj = 0;
10699 char buf[256];
10700 Jim_Obj *objPtr;
10701
10702 if (argc != 2) {
10703 Jim_WrongNumArgs(interp, 2, argv, "");
10704 return JIM_ERR;
10705 }
10706 /* Count the number of free objects. */
10707 objPtr = interp->freeList;
10708 while (objPtr) {
10709 freeobj++;
10710 objPtr = objPtr->nextObjPtr;
10711 }
10712 /* Count the number of live objects. */
10713 objPtr = interp->liveList;
10714 while (objPtr) {
10715 liveobj++;
10716 objPtr = objPtr->nextObjPtr;
10717 }
10718 /* Set the result string and return. */
10719 sprintf(buf, "free %d used %d", freeobj, liveobj);
10720 Jim_SetResultString(interp, buf, -1);
10721 return JIM_OK;
10722 } else if (option == OPT_OBJECTS) {
10723 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10724 /* Count the number of live objects. */
10725 objPtr = interp->liveList;
10726 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10727 while (objPtr) {
10728 char buf[128];
10729 const char *type = objPtr->typePtr ?
10730 objPtr->typePtr->name : "";
10731 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10732 sprintf(buf, "%p", objPtr);
10733 Jim_ListAppendElement(interp, subListObjPtr,
10734 Jim_NewStringObj(interp, buf, -1));
10735 Jim_ListAppendElement(interp, subListObjPtr,
10736 Jim_NewStringObj(interp, type, -1));
10737 Jim_ListAppendElement(interp, subListObjPtr,
10738 Jim_NewIntObj(interp, objPtr->refCount));
10739 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10740 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10741 objPtr = objPtr->nextObjPtr;
10742 }
10743 Jim_SetResult(interp, listObjPtr);
10744 return JIM_OK;
10745 } else if (option == OPT_INVSTR) {
10746 Jim_Obj *objPtr;
10747
10748 if (argc != 3) {
10749 Jim_WrongNumArgs(interp, 2, argv, "object");
10750 return JIM_ERR;
10751 }
10752 objPtr = argv[2];
10753 if (objPtr->typePtr != NULL)
10754 Jim_InvalidateStringRep(objPtr);
10755 Jim_SetEmptyResult(interp);
10756 return JIM_OK;
10757 } else if (option == OPT_SCRIPTLEN) {
10758 ScriptObj *script;
10759 if (argc != 3) {
10760 Jim_WrongNumArgs(interp, 2, argv, "script");
10761 return JIM_ERR;
10762 }
10763 script = Jim_GetScript(interp, argv[2]);
10764 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10765 return JIM_OK;
10766 } else if (option == OPT_EXPRLEN) {
10767 ExprByteCode *expr;
10768 if (argc != 3) {
10769 Jim_WrongNumArgs(interp, 2, argv, "expression");
10770 return JIM_ERR;
10771 }
10772 expr = Jim_GetExpression(interp, argv[2]);
10773 if (expr == NULL)
10774 return JIM_ERR;
10775 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10776 return JIM_OK;
10777 } else if (option == OPT_EXPRBC) {
10778 Jim_Obj *objPtr;
10779 ExprByteCode *expr;
10780 int i;
10781
10782 if (argc != 3) {
10783 Jim_WrongNumArgs(interp, 2, argv, "expression");
10784 return JIM_ERR;
10785 }
10786 expr = Jim_GetExpression(interp, argv[2]);
10787 if (expr == NULL)
10788 return JIM_ERR;
10789 objPtr = Jim_NewListObj(interp, NULL, 0);
10790 for (i = 0; i < expr->len; i++) {
10791 const char *type;
10792 Jim_ExprOperator *op;
10793
10794 switch(expr->opcode[i]) {
10795 case JIM_EXPROP_NUMBER: type = "number"; break;
10796 case JIM_EXPROP_COMMAND: type = "command"; break;
10797 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10798 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10799 case JIM_EXPROP_SUBST: type = "subst"; break;
10800 case JIM_EXPROP_STRING: type = "string"; break;
10801 default:
10802 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10803 if (op == NULL) {
10804 type = "private";
10805 } else {
10806 type = "operator";
10807 }
10808 break;
10809 }
10810 Jim_ListAppendElement(interp, objPtr,
10811 Jim_NewStringObj(interp, type, -1));
10812 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10813 }
10814 Jim_SetResult(interp, objPtr);
10815 return JIM_OK;
10816 } else {
10817 Jim_SetResultString(interp,
10818 "bad option. Valid options are refcount, "
10819 "objcount, objects, invstr", -1);
10820 return JIM_ERR;
10821 }
10822 return JIM_OK; /* unreached */
10823 }
10824
10825 /* [eval] */
10826 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10827 Jim_Obj *const *argv)
10828 {
10829 if (argc == 2) {
10830 return Jim_EvalObj(interp, argv[1]);
10831 } else if (argc > 2) {
10832 Jim_Obj *objPtr;
10833 int retcode;
10834
10835 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10836 Jim_IncrRefCount(objPtr);
10837 retcode = Jim_EvalObj(interp, objPtr);
10838 Jim_DecrRefCount(interp, objPtr);
10839 return retcode;
10840 } else {
10841 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10842 return JIM_ERR;
10843 }
10844 }
10845
10846 /* [uplevel] */
10847 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10848 Jim_Obj *const *argv)
10849 {
10850 if (argc >= 2) {
10851 int retcode, newLevel, oldLevel;
10852 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10853 Jim_Obj *objPtr;
10854 const char *str;
10855
10856 /* Save the old callframe pointer */
10857 savedCallFrame = interp->framePtr;
10858
10859 /* Lookup the target frame pointer */
10860 str = Jim_GetString(argv[1], NULL);
10861 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10862 {
10863 if (Jim_GetCallFrameByLevel(interp, argv[1],
10864 &targetCallFrame,
10865 &newLevel) != JIM_OK)
10866 return JIM_ERR;
10867 argc--;
10868 argv++;
10869 } else {
10870 if (Jim_GetCallFrameByLevel(interp, NULL,
10871 &targetCallFrame,
10872 &newLevel) != JIM_OK)
10873 return JIM_ERR;
10874 }
10875 if (argc < 2) {
10876 argc++;
10877 argv--;
10878 Jim_WrongNumArgs(interp, 1, argv,
10879 "?level? command ?arg ...?");
10880 return JIM_ERR;
10881 }
10882 /* Eval the code in the target callframe. */
10883 interp->framePtr = targetCallFrame;
10884 oldLevel = interp->numLevels;
10885 interp->numLevels = newLevel;
10886 if (argc == 2) {
10887 retcode = Jim_EvalObj(interp, argv[1]);
10888 } else {
10889 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10890 Jim_IncrRefCount(objPtr);
10891 retcode = Jim_EvalObj(interp, objPtr);
10892 Jim_DecrRefCount(interp, objPtr);
10893 }
10894 interp->numLevels = oldLevel;
10895 interp->framePtr = savedCallFrame;
10896 return retcode;
10897 } else {
10898 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10899 return JIM_ERR;
10900 }
10901 }
10902
10903 /* [expr] */
10904 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10905 Jim_Obj *const *argv)
10906 {
10907 Jim_Obj *exprResultPtr;
10908 int retcode;
10909
10910 if (argc == 2) {
10911 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10912 } else if (argc > 2) {
10913 Jim_Obj *objPtr;
10914
10915 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10916 Jim_IncrRefCount(objPtr);
10917 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10918 Jim_DecrRefCount(interp, objPtr);
10919 } else {
10920 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10921 return JIM_ERR;
10922 }
10923 if (retcode != JIM_OK) return retcode;
10924 Jim_SetResult(interp, exprResultPtr);
10925 Jim_DecrRefCount(interp, exprResultPtr);
10926 return JIM_OK;
10927 }
10928
10929 /* [break] */
10930 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10931 Jim_Obj *const *argv)
10932 {
10933 if (argc != 1) {
10934 Jim_WrongNumArgs(interp, 1, argv, "");
10935 return JIM_ERR;
10936 }
10937 return JIM_BREAK;
10938 }
10939
10940 /* [continue] */
10941 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10942 Jim_Obj *const *argv)
10943 {
10944 if (argc != 1) {
10945 Jim_WrongNumArgs(interp, 1, argv, "");
10946 return JIM_ERR;
10947 }
10948 return JIM_CONTINUE;
10949 }
10950
10951 /* [return] */
10952 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10953 Jim_Obj *const *argv)
10954 {
10955 if (argc == 1) {
10956 return JIM_RETURN;
10957 } else if (argc == 2) {
10958 Jim_SetResult(interp, argv[1]);
10959 interp->returnCode = JIM_OK;
10960 return JIM_RETURN;
10961 } else if (argc == 3 || argc == 4) {
10962 int returnCode;
10963 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10964 return JIM_ERR;
10965 interp->returnCode = returnCode;
10966 if (argc == 4)
10967 Jim_SetResult(interp, argv[3]);
10968 return JIM_RETURN;
10969 } else {
10970 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10971 return JIM_ERR;
10972 }
10973 return JIM_RETURN; /* unreached */
10974 }
10975
10976 /* [tailcall] */
10977 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10978 Jim_Obj *const *argv)
10979 {
10980 Jim_Obj *objPtr;
10981
10982 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10983 Jim_SetResult(interp, objPtr);
10984 return JIM_EVAL;
10985 }
10986
10987 /* [proc] */
10988 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10989 Jim_Obj *const *argv)
10990 {
10991 int argListLen;
10992 int arityMin, arityMax;
10993
10994 if (argc != 4 && argc != 5) {
10995 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10996 return JIM_ERR;
10997 }
10998 Jim_ListLength(interp, argv[2], &argListLen);
10999 arityMin = arityMax = argListLen+1;
11000
11001 if (argListLen) {
11002 const char *str;
11003 int len;
11004 Jim_Obj *argPtr;
11005
11006 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11007 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11008 str = Jim_GetString(argPtr, &len);
11009 if (len == 4 && memcmp(str, "args", 4) == 0) {
11010 arityMin--;
11011 arityMax = -1;
11012 }
11013
11014 /* Check for default arguments and reduce arityMin if necessary */
11015 while (arityMin > 1) {
11016 int len;
11017 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11018 Jim_ListLength(interp, argPtr, &len);
11019 if (len != 2) {
11020 /* No default argument */
11021 break;
11022 }
11023 arityMin--;
11024 }
11025 }
11026 if (argc == 4) {
11027 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11028 argv[2], NULL, argv[3], arityMin, arityMax);
11029 } else {
11030 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11031 argv[2], argv[3], argv[4], arityMin, arityMax);
11032 }
11033 }
11034
11035 /* [concat] */
11036 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11037 Jim_Obj *const *argv)
11038 {
11039 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11040 return JIM_OK;
11041 }
11042
11043 /* [upvar] */
11044 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11045 Jim_Obj *const *argv)
11046 {
11047 const char *str;
11048 int i;
11049 Jim_CallFrame *targetCallFrame;
11050
11051 /* Lookup the target frame pointer */
11052 str = Jim_GetString(argv[1], NULL);
11053 if (argc > 3 &&
11054 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11055 {
11056 if (Jim_GetCallFrameByLevel(interp, argv[1],
11057 &targetCallFrame, NULL) != JIM_OK)
11058 return JIM_ERR;
11059 argc--;
11060 argv++;
11061 } else {
11062 if (Jim_GetCallFrameByLevel(interp, NULL,
11063 &targetCallFrame, NULL) != JIM_OK)
11064 return JIM_ERR;
11065 }
11066 /* Check for arity */
11067 if (argc < 3 || ((argc-1)%2) != 0) {
11068 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11069 return JIM_ERR;
11070 }
11071 /* Now... for every other/local couple: */
11072 for (i = 1; i < argc; i += 2) {
11073 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11074 targetCallFrame) != JIM_OK) return JIM_ERR;
11075 }
11076 return JIM_OK;
11077 }
11078
11079 /* [global] */
11080 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11081 Jim_Obj *const *argv)
11082 {
11083 int i;
11084
11085 if (argc < 2) {
11086 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11087 return JIM_ERR;
11088 }
11089 /* Link every var to the toplevel having the same name */
11090 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11091 for (i = 1; i < argc; i++) {
11092 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11093 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11094 }
11095 return JIM_OK;
11096 }
11097
11098 /* does the [string map] operation. On error NULL is returned,
11099 * otherwise a new string object with the result, having refcount = 0,
11100 * is returned. */
11101 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11102 Jim_Obj *objPtr, int nocase)
11103 {
11104 int numMaps;
11105 const char **key, *str, *noMatchStart = NULL;
11106 Jim_Obj **value;
11107 int *keyLen, strLen, i;
11108 Jim_Obj *resultObjPtr;
11109
11110 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11111 if (numMaps % 2) {
11112 Jim_SetResultString(interp,
11113 "list must contain an even number of elements", -1);
11114 return NULL;
11115 }
11116 /* Initialization */
11117 numMaps /= 2;
11118 key = Jim_Alloc(sizeof(char*)*numMaps);
11119 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11120 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11121 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11122 for (i = 0; i < numMaps; i++) {
11123 Jim_Obj *eleObjPtr;
11124
11125 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11126 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11127 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11128 value[i] = eleObjPtr;
11129 }
11130 str = Jim_GetString(objPtr, &strLen);
11131 /* Map it */
11132 while(strLen) {
11133 for (i = 0; i < numMaps; i++) {
11134 if (strLen >= keyLen[i] && keyLen[i]) {
11135 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11136 nocase))
11137 {
11138 if (noMatchStart) {
11139 Jim_AppendString(interp, resultObjPtr,
11140 noMatchStart, str-noMatchStart);
11141 noMatchStart = NULL;
11142 }
11143 Jim_AppendObj(interp, resultObjPtr, value[i]);
11144 str += keyLen[i];
11145 strLen -= keyLen[i];
11146 break;
11147 }
11148 }
11149 }
11150 if (i == numMaps) { /* no match */
11151 if (noMatchStart == NULL)
11152 noMatchStart = str;
11153 str ++;
11154 strLen --;
11155 }
11156 }
11157 if (noMatchStart) {
11158 Jim_AppendString(interp, resultObjPtr,
11159 noMatchStart, str-noMatchStart);
11160 }
11161 Jim_Free((void*)key);
11162 Jim_Free(keyLen);
11163 Jim_Free(value);
11164 return resultObjPtr;
11165 }
11166
11167 /* [string] */
11168 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11169 Jim_Obj *const *argv)
11170 {
11171 int option;
11172 const char *options[] = {
11173 "length", "compare", "match", "equal", "range", "map", "repeat",
11174 "index", "first", "tolower", "toupper", NULL
11175 };
11176 enum {
11177 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11178 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11179 };
11180
11181 if (argc < 2) {
11182 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11183 return JIM_ERR;
11184 }
11185 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11186 JIM_ERRMSG) != JIM_OK)
11187 return JIM_ERR;
11188
11189 if (option == OPT_LENGTH) {
11190 int len;
11191
11192 if (argc != 3) {
11193 Jim_WrongNumArgs(interp, 2, argv, "string");
11194 return JIM_ERR;
11195 }
11196 Jim_GetString(argv[2], &len);
11197 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11198 return JIM_OK;
11199 } else if (option == OPT_COMPARE) {
11200 int nocase = 0;
11201 if ((argc != 4 && argc != 5) ||
11202 (argc == 5 && Jim_CompareStringImmediate(interp,
11203 argv[2], "-nocase") == 0)) {
11204 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11205 return JIM_ERR;
11206 }
11207 if (argc == 5) {
11208 nocase = 1;
11209 argv++;
11210 }
11211 Jim_SetResult(interp, Jim_NewIntObj(interp,
11212 Jim_StringCompareObj(argv[2],
11213 argv[3], nocase)));
11214 return JIM_OK;
11215 } else if (option == OPT_MATCH) {
11216 int nocase = 0;
11217 if ((argc != 4 && argc != 5) ||
11218 (argc == 5 && Jim_CompareStringImmediate(interp,
11219 argv[2], "-nocase") == 0)) {
11220 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11221 "string");
11222 return JIM_ERR;
11223 }
11224 if (argc == 5) {
11225 nocase = 1;
11226 argv++;
11227 }
11228 Jim_SetResult(interp,
11229 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11230 argv[3], nocase)));
11231 return JIM_OK;
11232 } else if (option == OPT_EQUAL) {
11233 if (argc != 4) {
11234 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11235 return JIM_ERR;
11236 }
11237 Jim_SetResult(interp,
11238 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11239 argv[3], 0)));
11240 return JIM_OK;
11241 } else if (option == OPT_RANGE) {
11242 Jim_Obj *objPtr;
11243
11244 if (argc != 5) {
11245 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11246 return JIM_ERR;
11247 }
11248 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11249 if (objPtr == NULL)
11250 return JIM_ERR;
11251 Jim_SetResult(interp, objPtr);
11252 return JIM_OK;
11253 } else if (option == OPT_MAP) {
11254 int nocase = 0;
11255 Jim_Obj *objPtr;
11256
11257 if ((argc != 4 && argc != 5) ||
11258 (argc == 5 && Jim_CompareStringImmediate(interp,
11259 argv[2], "-nocase") == 0)) {
11260 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11261 "string");
11262 return JIM_ERR;
11263 }
11264 if (argc == 5) {
11265 nocase = 1;
11266 argv++;
11267 }
11268 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11269 if (objPtr == NULL)
11270 return JIM_ERR;
11271 Jim_SetResult(interp, objPtr);
11272 return JIM_OK;
11273 } else if (option == OPT_REPEAT) {
11274 Jim_Obj *objPtr;
11275 jim_wide count;
11276
11277 if (argc != 4) {
11278 Jim_WrongNumArgs(interp, 2, argv, "string count");
11279 return JIM_ERR;
11280 }
11281 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11282 return JIM_ERR;
11283 objPtr = Jim_NewStringObj(interp, "", 0);
11284 while (count--) {
11285 Jim_AppendObj(interp, objPtr, argv[2]);
11286 }
11287 Jim_SetResult(interp, objPtr);
11288 return JIM_OK;
11289 } else if (option == OPT_INDEX) {
11290 int index, len;
11291 const char *str;
11292
11293 if (argc != 4) {
11294 Jim_WrongNumArgs(interp, 2, argv, "string index");
11295 return JIM_ERR;
11296 }
11297 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11298 return JIM_ERR;
11299 str = Jim_GetString(argv[2], &len);
11300 if (index != INT_MIN && index != INT_MAX)
11301 index = JimRelToAbsIndex(len, index);
11302 if (index < 0 || index >= len) {
11303 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11304 return JIM_OK;
11305 } else {
11306 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11307 return JIM_OK;
11308 }
11309 } else if (option == OPT_FIRST) {
11310 int index = 0, l1, l2;
11311 const char *s1, *s2;
11312
11313 if (argc != 4 && argc != 5) {
11314 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11315 return JIM_ERR;
11316 }
11317 s1 = Jim_GetString(argv[2], &l1);
11318 s2 = Jim_GetString(argv[3], &l2);
11319 if (argc == 5) {
11320 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11321 return JIM_ERR;
11322 index = JimRelToAbsIndex(l2, index);
11323 }
11324 Jim_SetResult(interp, Jim_NewIntObj(interp,
11325 JimStringFirst(s1, l1, s2, l2, index)));
11326 return JIM_OK;
11327 } else if (option == OPT_TOLOWER) {
11328 if (argc != 3) {
11329 Jim_WrongNumArgs(interp, 2, argv, "string");
11330 return JIM_ERR;
11331 }
11332 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11333 } else if (option == OPT_TOUPPER) {
11334 if (argc != 3) {
11335 Jim_WrongNumArgs(interp, 2, argv, "string");
11336 return JIM_ERR;
11337 }
11338 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11339 }
11340 return JIM_OK;
11341 }
11342
11343 /* [time] */
11344 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11345 Jim_Obj *const *argv)
11346 {
11347 long i, count = 1;
11348 jim_wide start, elapsed;
11349 char buf [256];
11350 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11351
11352 if (argc < 2) {
11353 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11354 return JIM_ERR;
11355 }
11356 if (argc == 3) {
11357 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11358 return JIM_ERR;
11359 }
11360 if (count < 0)
11361 return JIM_OK;
11362 i = count;
11363 start = JimClock();
11364 while (i-- > 0) {
11365 int retval;
11366
11367 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11368 return retval;
11369 }
11370 elapsed = JimClock() - start;
11371 sprintf(buf, fmt, elapsed/count);
11372 Jim_SetResultString(interp, buf, -1);
11373 return JIM_OK;
11374 }
11375
11376 /* [exit] */
11377 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11378 Jim_Obj *const *argv)
11379 {
11380 long exitCode = 0;
11381
11382 if (argc > 2) {
11383 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11384 return JIM_ERR;
11385 }
11386 if (argc == 2) {
11387 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11388 return JIM_ERR;
11389 }
11390 interp->exitCode = exitCode;
11391 return JIM_EXIT;
11392 }
11393
11394 /* [catch] */
11395 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11396 Jim_Obj *const *argv)
11397 {
11398 int exitCode = 0;
11399
11400 if (argc != 2 && argc != 3) {
11401 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11402 return JIM_ERR;
11403 }
11404 exitCode = Jim_EvalObj(interp, argv[1]);
11405 if (argc == 3) {
11406 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11407 != JIM_OK)
11408 return JIM_ERR;
11409 }
11410 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11411 return JIM_OK;
11412 }
11413
11414 /* [ref] */
11415 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11416 Jim_Obj *const *argv)
11417 {
11418 if (argc != 3 && argc != 4) {
11419 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11420 return JIM_ERR;
11421 }
11422 if (argc == 3) {
11423 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11424 } else {
11425 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11426 argv[3]));
11427 }
11428 return JIM_OK;
11429 }
11430
11431 /* [getref] */
11432 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11433 Jim_Obj *const *argv)
11434 {
11435 Jim_Reference *refPtr;
11436
11437 if (argc != 2) {
11438 Jim_WrongNumArgs(interp, 1, argv, "reference");
11439 return JIM_ERR;
11440 }
11441 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11442 return JIM_ERR;
11443 Jim_SetResult(interp, refPtr->objPtr);
11444 return JIM_OK;
11445 }
11446
11447 /* [setref] */
11448 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11449 Jim_Obj *const *argv)
11450 {
11451 Jim_Reference *refPtr;
11452
11453 if (argc != 3) {
11454 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11455 return JIM_ERR;
11456 }
11457 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11458 return JIM_ERR;
11459 Jim_IncrRefCount(argv[2]);
11460 Jim_DecrRefCount(interp, refPtr->objPtr);
11461 refPtr->objPtr = argv[2];
11462 Jim_SetResult(interp, argv[2]);
11463 return JIM_OK;
11464 }
11465
11466 /* [collect] */
11467 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11468 Jim_Obj *const *argv)
11469 {
11470 if (argc != 1) {
11471 Jim_WrongNumArgs(interp, 1, argv, "");
11472 return JIM_ERR;
11473 }
11474 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11475 return JIM_OK;
11476 }
11477
11478 /* [finalize] reference ?newValue? */
11479 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11480 Jim_Obj *const *argv)
11481 {
11482 if (argc != 2 && argc != 3) {
11483 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11484 return JIM_ERR;
11485 }
11486 if (argc == 2) {
11487 Jim_Obj *cmdNamePtr;
11488
11489 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11490 return JIM_ERR;
11491 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11492 Jim_SetResult(interp, cmdNamePtr);
11493 } else {
11494 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11495 return JIM_ERR;
11496 Jim_SetResult(interp, argv[2]);
11497 }
11498 return JIM_OK;
11499 }
11500
11501 /* TODO */
11502 /* [info references] (list of all the references/finalizers) */
11503
11504 /* [rename] */
11505 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11506 Jim_Obj *const *argv)
11507 {
11508 const char *oldName, *newName;
11509
11510 if (argc != 3) {
11511 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11512 return JIM_ERR;
11513 }
11514 oldName = Jim_GetString(argv[1], NULL);
11515 newName = Jim_GetString(argv[2], NULL);
11516 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11517 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11518 Jim_AppendStrings(interp, Jim_GetResult(interp),
11519 "can't rename \"", oldName, "\": ",
11520 "command doesn't exist", NULL);
11521 return JIM_ERR;
11522 }
11523 return JIM_OK;
11524 }
11525
11526 /* [dict] */
11527 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11528 Jim_Obj *const *argv)
11529 {
11530 int option;
11531 const char *options[] = {
11532 "create", "get", "set", "unset", "exists", NULL
11533 };
11534 enum {
11535 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11536 };
11537
11538 if (argc < 2) {
11539 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11540 return JIM_ERR;
11541 }
11542
11543 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11544 JIM_ERRMSG) != JIM_OK)
11545 return JIM_ERR;
11546
11547 if (option == OPT_CREATE) {
11548 Jim_Obj *objPtr;
11549
11550 if (argc % 2) {
11551 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11552 return JIM_ERR;
11553 }
11554 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11555 Jim_SetResult(interp, objPtr);
11556 return JIM_OK;
11557 } else if (option == OPT_GET) {
11558 Jim_Obj *objPtr;
11559
11560 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11561 JIM_ERRMSG) != JIM_OK)
11562 return JIM_ERR;
11563 Jim_SetResult(interp, objPtr);
11564 return JIM_OK;
11565 } else if (option == OPT_SET) {
11566 if (argc < 5) {
11567 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11568 return JIM_ERR;
11569 }
11570 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11571 argv[argc-1]);
11572 } else if (option == OPT_UNSET) {
11573 if (argc < 4) {
11574 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11575 return JIM_ERR;
11576 }
11577 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11578 NULL);
11579 } else if (option == OPT_EXIST) {
11580 Jim_Obj *objPtr;
11581 int exists;
11582
11583 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11584 JIM_ERRMSG) == JIM_OK)
11585 exists = 1;
11586 else
11587 exists = 0;
11588 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11589 return JIM_OK;
11590 } else {
11591 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11592 Jim_AppendStrings(interp, Jim_GetResult(interp),
11593 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11594 " must be create, get, set", NULL);
11595 return JIM_ERR;
11596 }
11597 return JIM_OK;
11598 }
11599
11600 /* [load] */
11601 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11602 Jim_Obj *const *argv)
11603 {
11604 if (argc < 2) {
11605 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11606 return JIM_ERR;
11607 }
11608 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11609 }
11610
11611 /* [subst] */
11612 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11613 Jim_Obj *const *argv)
11614 {
11615 int i, flags = 0;
11616 Jim_Obj *objPtr;
11617
11618 if (argc < 2) {
11619 Jim_WrongNumArgs(interp, 1, argv,
11620 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11621 return JIM_ERR;
11622 }
11623 i = argc-2;
11624 while(i--) {
11625 if (Jim_CompareStringImmediate(interp, argv[i+1],
11626 "-nobackslashes"))
11627 flags |= JIM_SUBST_NOESC;
11628 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11629 "-novariables"))
11630 flags |= JIM_SUBST_NOVAR;
11631 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11632 "-nocommands"))
11633 flags |= JIM_SUBST_NOCMD;
11634 else {
11635 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11636 Jim_AppendStrings(interp, Jim_GetResult(interp),
11637 "bad option \"", Jim_GetString(argv[i+1], NULL),
11638 "\": must be -nobackslashes, -nocommands, or "
11639 "-novariables", NULL);
11640 return JIM_ERR;
11641 }
11642 }
11643 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11644 return JIM_ERR;
11645 Jim_SetResult(interp, objPtr);
11646 return JIM_OK;
11647 }
11648
11649 /* [info] */
11650 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11651 Jim_Obj *const *argv)
11652 {
11653 int cmd, result = JIM_OK;
11654 static const char *commands[] = {
11655 "body", "commands", "exists", "globals", "level", "locals",
11656 "vars", "version", "complete", "args", "hostname", NULL
11657 };
11658 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11659 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11660
11661 if (argc < 2) {
11662 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11663 return JIM_ERR;
11664 }
11665 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11666 != JIM_OK) {
11667 return JIM_ERR;
11668 }
11669
11670 if (cmd == INFO_COMMANDS) {
11671 if (argc != 2 && argc != 3) {
11672 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11673 return JIM_ERR;
11674 }
11675 if (argc == 3)
11676 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11677 else
11678 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11679 } else if (cmd == INFO_EXISTS) {
11680 Jim_Obj *exists;
11681 if (argc != 3) {
11682 Jim_WrongNumArgs(interp, 2, argv, "varName");
11683 return JIM_ERR;
11684 }
11685 exists = Jim_GetVariable(interp, argv[2], 0);
11686 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11687 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11688 int mode;
11689 switch (cmd) {
11690 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11691 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11692 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11693 default: mode = 0; /* avoid warning */; break;
11694 }
11695 if (argc != 2 && argc != 3) {
11696 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11697 return JIM_ERR;
11698 }
11699 if (argc == 3)
11700 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11701 else
11702 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11703 } else if (cmd == INFO_LEVEL) {
11704 Jim_Obj *objPtr;
11705 switch (argc) {
11706 case 2:
11707 Jim_SetResult(interp,
11708 Jim_NewIntObj(interp, interp->numLevels));
11709 break;
11710 case 3:
11711 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11712 return JIM_ERR;
11713 Jim_SetResult(interp, objPtr);
11714 break;
11715 default:
11716 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11717 return JIM_ERR;
11718 }
11719 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11720 Jim_Cmd *cmdPtr;
11721
11722 if (argc != 3) {
11723 Jim_WrongNumArgs(interp, 2, argv, "procname");
11724 return JIM_ERR;
11725 }
11726 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11727 return JIM_ERR;
11728 if (cmdPtr->cmdProc != NULL) {
11729 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11730 Jim_AppendStrings(interp, Jim_GetResult(interp),
11731 "command \"", Jim_GetString(argv[2], NULL),
11732 "\" is not a procedure", NULL);
11733 return JIM_ERR;
11734 }
11735 if (cmd == INFO_BODY)
11736 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11737 else
11738 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11739 } else if (cmd == INFO_VERSION) {
11740 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11741 sprintf(buf, "%d.%d",
11742 JIM_VERSION / 100, JIM_VERSION % 100);
11743 Jim_SetResultString(interp, buf, -1);
11744 } else if (cmd == INFO_COMPLETE) {
11745 const char *s;
11746 int len;
11747
11748 if (argc != 3) {
11749 Jim_WrongNumArgs(interp, 2, argv, "script");
11750 return JIM_ERR;
11751 }
11752 s = Jim_GetString(argv[2], &len);
11753 Jim_SetResult(interp,
11754 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11755 } else if (cmd == INFO_HOSTNAME) {
11756 /* Redirect to os.hostname if it exists */
11757 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11758 result = Jim_EvalObjVector(interp, 1, &command);
11759 }
11760 return result;
11761 }
11762
11763 /* [split] */
11764 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11765 Jim_Obj *const *argv)
11766 {
11767 const char *str, *splitChars, *noMatchStart;
11768 int splitLen, strLen, i;
11769 Jim_Obj *resObjPtr;
11770
11771 if (argc != 2 && argc != 3) {
11772 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11773 return JIM_ERR;
11774 }
11775 /* Init */
11776 if (argc == 2) {
11777 splitChars = " \n\t\r";
11778 splitLen = 4;
11779 } else {
11780 splitChars = Jim_GetString(argv[2], &splitLen);
11781 }
11782 str = Jim_GetString(argv[1], &strLen);
11783 if (!strLen) return JIM_OK;
11784 noMatchStart = str;
11785 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11786 /* Split */
11787 if (splitLen) {
11788 while (strLen) {
11789 for (i = 0; i < splitLen; i++) {
11790 if (*str == splitChars[i]) {
11791 Jim_Obj *objPtr;
11792
11793 objPtr = Jim_NewStringObj(interp, noMatchStart,
11794 (str-noMatchStart));
11795 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11796 noMatchStart = str+1;
11797 break;
11798 }
11799 }
11800 str ++;
11801 strLen --;
11802 }
11803 Jim_ListAppendElement(interp, resObjPtr,
11804 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11805 } else {
11806 /* This handles the special case of splitchars eq {}. This
11807 * is trivial but we want to perform object sharing as Tcl does. */
11808 Jim_Obj *objCache[256];
11809 const unsigned char *u = (unsigned char*) str;
11810 memset(objCache, 0, sizeof(objCache));
11811 for (i = 0; i < strLen; i++) {
11812 int c = u[i];
11813
11814 if (objCache[c] == NULL)
11815 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11816 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11817 }
11818 }
11819 Jim_SetResult(interp, resObjPtr);
11820 return JIM_OK;
11821 }
11822
11823 /* [join] */
11824 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11825 Jim_Obj *const *argv)
11826 {
11827 const char *joinStr;
11828 int joinStrLen, i, listLen;
11829 Jim_Obj *resObjPtr;
11830
11831 if (argc != 2 && argc != 3) {
11832 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11833 return JIM_ERR;
11834 }
11835 /* Init */
11836 if (argc == 2) {
11837 joinStr = " ";
11838 joinStrLen = 1;
11839 } else {
11840 joinStr = Jim_GetString(argv[2], &joinStrLen);
11841 }
11842 Jim_ListLength(interp, argv[1], &listLen);
11843 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11844 /* Split */
11845 for (i = 0; i < listLen; i++) {
11846 Jim_Obj *objPtr;
11847
11848 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11849 Jim_AppendObj(interp, resObjPtr, objPtr);
11850 if (i+1 != listLen) {
11851 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11852 }
11853 }
11854 Jim_SetResult(interp, resObjPtr);
11855 return JIM_OK;
11856 }
11857
11858 /* [format] */
11859 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11860 Jim_Obj *const *argv)
11861 {
11862 Jim_Obj *objPtr;
11863
11864 if (argc < 2) {
11865 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11866 return JIM_ERR;
11867 }
11868 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11869 if (objPtr == NULL)
11870 return JIM_ERR;
11871 Jim_SetResult(interp, objPtr);
11872 return JIM_OK;
11873 }
11874
11875 /* [scan] */
11876 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11877 Jim_Obj *const *argv)
11878 {
11879 Jim_Obj *listPtr, **outVec;
11880 int outc, i, count = 0;
11881
11882 if (argc < 3) {
11883 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11884 return JIM_ERR;
11885 }
11886 if (argv[2]->typePtr != &scanFmtStringObjType)
11887 SetScanFmtFromAny(interp, argv[2]);
11888 if (FormatGetError(argv[2]) != 0) {
11889 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11890 return JIM_ERR;
11891 }
11892 if (argc > 3) {
11893 int maxPos = FormatGetMaxPos(argv[2]);
11894 int count = FormatGetCnvCount(argv[2]);
11895 if (maxPos > argc-3) {
11896 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11897 return JIM_ERR;
11898 } else if (count != 0 && count < argc-3) {
11899 Jim_SetResultString(interp, "variable is not assigned by any "
11900 "conversion specifiers", -1);
11901 return JIM_ERR;
11902 } else if (count > argc-3) {
11903 Jim_SetResultString(interp, "different numbers of variable names and "
11904 "field specifiers", -1);
11905 return JIM_ERR;
11906 }
11907 }
11908 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11909 if (listPtr == 0)
11910 return JIM_ERR;
11911 if (argc > 3) {
11912 int len = 0;
11913 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11914 Jim_ListLength(interp, listPtr, &len);
11915 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11916 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11917 return JIM_OK;
11918 }
11919 JimListGetElements(interp, listPtr, &outc, &outVec);
11920 for (i = 0; i < outc; ++i) {
11921 if (Jim_Length(outVec[i]) > 0) {
11922 ++count;
11923 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11924 goto err;
11925 }
11926 }
11927 Jim_FreeNewObj(interp, listPtr);
11928 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11929 } else {
11930 if (listPtr == (Jim_Obj*)EOF) {
11931 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11932 return JIM_OK;
11933 }
11934 Jim_SetResult(interp, listPtr);
11935 }
11936 return JIM_OK;
11937 err:
11938 Jim_FreeNewObj(interp, listPtr);
11939 return JIM_ERR;
11940 }
11941
11942 /* [error] */
11943 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11944 Jim_Obj *const *argv)
11945 {
11946 if (argc != 2) {
11947 Jim_WrongNumArgs(interp, 1, argv, "message");
11948 return JIM_ERR;
11949 }
11950 Jim_SetResult(interp, argv[1]);
11951 return JIM_ERR;
11952 }
11953
11954 /* [lrange] */
11955 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11956 Jim_Obj *const *argv)
11957 {
11958 Jim_Obj *objPtr;
11959
11960 if (argc != 4) {
11961 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11962 return JIM_ERR;
11963 }
11964 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11965 return JIM_ERR;
11966 Jim_SetResult(interp, objPtr);
11967 return JIM_OK;
11968 }
11969
11970 /* [env] */
11971 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11972 Jim_Obj *const *argv)
11973 {
11974 const char *key;
11975 char *val;
11976
11977 if (argc == 1) {
11978
11979 #ifdef NEED_ENVIRON_EXTERN
11980 extern char **environ;
11981 #endif
11982
11983 int i;
11984 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11985
11986 for (i = 0; environ[i]; i++) {
11987 const char *equals = strchr(environ[i], '=');
11988 if (equals) {
11989 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11990 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11991 }
11992 }
11993
11994 Jim_SetResult(interp, listObjPtr);
11995 return JIM_OK;
11996 }
11997
11998 if (argc != 2) {
11999 Jim_WrongNumArgs(interp, 1, argv, "varName");
12000 return JIM_ERR;
12001 }
12002 key = Jim_GetString(argv[1], NULL);
12003 val = getenv(key);
12004 if (val == NULL) {
12005 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12006 Jim_AppendStrings(interp, Jim_GetResult(interp),
12007 "environment variable \"",
12008 key, "\" does not exist", NULL);
12009 return JIM_ERR;
12010 }
12011 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12012 return JIM_OK;
12013 }
12014
12015 /* [source] */
12016 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12017 Jim_Obj *const *argv)
12018 {
12019 int retval;
12020
12021 if (argc != 2) {
12022 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12023 return JIM_ERR;
12024 }
12025 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12026 if (retval == JIM_ERR) {
12027 return JIM_ERR_ADDSTACK;
12028 }
12029 if (retval == JIM_RETURN)
12030 return JIM_OK;
12031 return retval;
12032 }
12033
12034 /* [lreverse] */
12035 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12036 Jim_Obj *const *argv)
12037 {
12038 Jim_Obj *revObjPtr, **ele;
12039 int len;
12040
12041 if (argc != 2) {
12042 Jim_WrongNumArgs(interp, 1, argv, "list");
12043 return JIM_ERR;
12044 }
12045 JimListGetElements(interp, argv[1], &len, &ele);
12046 len--;
12047 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12048 while (len >= 0)
12049 ListAppendElement(revObjPtr, ele[len--]);
12050 Jim_SetResult(interp, revObjPtr);
12051 return JIM_OK;
12052 }
12053
12054 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12055 {
12056 jim_wide len;
12057
12058 if (step == 0) return -1;
12059 if (start == end) return 0;
12060 else if (step > 0 && start > end) return -1;
12061 else if (step < 0 && end > start) return -1;
12062 len = end-start;
12063 if (len < 0) len = -len; /* abs(len) */
12064 if (step < 0) step = -step; /* abs(step) */
12065 len = 1 + ((len-1)/step);
12066 /* We can truncate safely to INT_MAX, the range command
12067 * will always return an error for a such long range
12068 * because Tcl lists can't be so long. */
12069 if (len > INT_MAX) len = INT_MAX;
12070 return (int)((len < 0) ? -1 : len);
12071 }
12072
12073 /* [range] */
12074 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12075 Jim_Obj *const *argv)
12076 {
12077 jim_wide start = 0, end, step = 1;
12078 int len, i;
12079 Jim_Obj *objPtr;
12080
12081 if (argc < 2 || argc > 4) {
12082 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12083 return JIM_ERR;
12084 }
12085 if (argc == 2) {
12086 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12087 return JIM_ERR;
12088 } else {
12089 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12090 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12091 return JIM_ERR;
12092 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12093 return JIM_ERR;
12094 }
12095 if ((len = JimRangeLen(start, end, step)) == -1) {
12096 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12097 return JIM_ERR;
12098 }
12099 objPtr = Jim_NewListObj(interp, NULL, 0);
12100 for (i = 0; i < len; i++)
12101 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12102 Jim_SetResult(interp, objPtr);
12103 return JIM_OK;
12104 }
12105
12106 /* [rand] */
12107 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12108 Jim_Obj *const *argv)
12109 {
12110 jim_wide min = 0, max, len, maxMul;
12111
12112 if (argc < 1 || argc > 3) {
12113 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12114 return JIM_ERR;
12115 }
12116 if (argc == 1) {
12117 max = JIM_WIDE_MAX;
12118 } else if (argc == 2) {
12119 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12120 return JIM_ERR;
12121 } else if (argc == 3) {
12122 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12123 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12124 return JIM_ERR;
12125 }
12126 len = max-min;
12127 if (len < 0) {
12128 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12129 return JIM_ERR;
12130 }
12131 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12132 while (1) {
12133 jim_wide r;
12134
12135 JimRandomBytes(interp, &r, sizeof(jim_wide));
12136 if (r < 0 || r >= maxMul) continue;
12137 r = (len == 0) ? 0 : r%len;
12138 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12139 return JIM_OK;
12140 }
12141 }
12142
12143 /* [package] */
12144 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12145 Jim_Obj *const *argv)
12146 {
12147 int option;
12148 const char *options[] = {
12149 "require", "provide", NULL
12150 };
12151 enum {OPT_REQUIRE, OPT_PROVIDE};
12152
12153 if (argc < 2) {
12154 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12155 return JIM_ERR;
12156 }
12157 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12158 JIM_ERRMSG) != JIM_OK)
12159 return JIM_ERR;
12160
12161 if (option == OPT_REQUIRE) {
12162 int exact = 0;
12163 const char *ver;
12164
12165 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12166 exact = 1;
12167 argv++;
12168 argc--;
12169 }
12170 if (argc != 3 && argc != 4) {
12171 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12172 return JIM_ERR;
12173 }
12174 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12175 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12176 JIM_ERRMSG);
12177 if (ver == NULL)
12178 return JIM_ERR_ADDSTACK;
12179 Jim_SetResultString(interp, ver, -1);
12180 } else if (option == OPT_PROVIDE) {
12181 if (argc != 4) {
12182 Jim_WrongNumArgs(interp, 2, argv, "package version");
12183 return JIM_ERR;
12184 }
12185 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12186 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12187 }
12188 return JIM_OK;
12189 }
12190
12191 static struct {
12192 const char *name;
12193 Jim_CmdProc cmdProc;
12194 } Jim_CoreCommandsTable[] = {
12195 {"set", Jim_SetCoreCommand},
12196 {"unset", Jim_UnsetCoreCommand},
12197 {"puts", Jim_PutsCoreCommand},
12198 {"+", Jim_AddCoreCommand},
12199 {"*", Jim_MulCoreCommand},
12200 {"-", Jim_SubCoreCommand},
12201 {"/", Jim_DivCoreCommand},
12202 {"incr", Jim_IncrCoreCommand},
12203 {"while", Jim_WhileCoreCommand},
12204 {"for", Jim_ForCoreCommand},
12205 {"foreach", Jim_ForeachCoreCommand},
12206 {"lmap", Jim_LmapCoreCommand},
12207 {"if", Jim_IfCoreCommand},
12208 {"switch", Jim_SwitchCoreCommand},
12209 {"list", Jim_ListCoreCommand},
12210 {"lindex", Jim_LindexCoreCommand},
12211 {"lset", Jim_LsetCoreCommand},
12212 {"llength", Jim_LlengthCoreCommand},
12213 {"lappend", Jim_LappendCoreCommand},
12214 {"linsert", Jim_LinsertCoreCommand},
12215 {"lsort", Jim_LsortCoreCommand},
12216 {"append", Jim_AppendCoreCommand},
12217 {"debug", Jim_DebugCoreCommand},
12218 {"eval", Jim_EvalCoreCommand},
12219 {"uplevel", Jim_UplevelCoreCommand},
12220 {"expr", Jim_ExprCoreCommand},
12221 {"break", Jim_BreakCoreCommand},
12222 {"continue", Jim_ContinueCoreCommand},
12223 {"proc", Jim_ProcCoreCommand},
12224 {"concat", Jim_ConcatCoreCommand},
12225 {"return", Jim_ReturnCoreCommand},
12226 {"upvar", Jim_UpvarCoreCommand},
12227 {"global", Jim_GlobalCoreCommand},
12228 {"string", Jim_StringCoreCommand},
12229 {"time", Jim_TimeCoreCommand},
12230 {"exit", Jim_ExitCoreCommand},
12231 {"catch", Jim_CatchCoreCommand},
12232 {"ref", Jim_RefCoreCommand},
12233 {"getref", Jim_GetrefCoreCommand},
12234 {"setref", Jim_SetrefCoreCommand},
12235 {"finalize", Jim_FinalizeCoreCommand},
12236 {"collect", Jim_CollectCoreCommand},
12237 {"rename", Jim_RenameCoreCommand},
12238 {"dict", Jim_DictCoreCommand},
12239 {"load", Jim_LoadCoreCommand},
12240 {"subst", Jim_SubstCoreCommand},
12241 {"info", Jim_InfoCoreCommand},
12242 {"split", Jim_SplitCoreCommand},
12243 {"join", Jim_JoinCoreCommand},
12244 {"format", Jim_FormatCoreCommand},
12245 {"scan", Jim_ScanCoreCommand},
12246 {"error", Jim_ErrorCoreCommand},
12247 {"lrange", Jim_LrangeCoreCommand},
12248 {"env", Jim_EnvCoreCommand},
12249 {"source", Jim_SourceCoreCommand},
12250 {"lreverse", Jim_LreverseCoreCommand},
12251 {"range", Jim_RangeCoreCommand},
12252 {"rand", Jim_RandCoreCommand},
12253 {"package", Jim_PackageCoreCommand},
12254 {"tailcall", Jim_TailcallCoreCommand},
12255 {NULL, NULL},
12256 };
12257
12258 /* Some Jim core command is actually a procedure written in Jim itself. */
12259 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12260 {
12261 Jim_Eval(interp, (char*)
12262 "proc lambda {arglist args} {\n"
12263 " set name [ref {} function lambdaFinalizer]\n"
12264 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12265 " return $name\n"
12266 "}\n"
12267 "proc lambdaFinalizer {name val} {\n"
12268 " rename $name {}\n"
12269 "}\n"
12270 );
12271 }
12272
12273 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12274 {
12275 int i = 0;
12276
12277 while(Jim_CoreCommandsTable[i].name != NULL) {
12278 Jim_CreateCommand(interp,
12279 Jim_CoreCommandsTable[i].name,
12280 Jim_CoreCommandsTable[i].cmdProc,
12281 NULL, NULL);
12282 i++;
12283 }
12284 Jim_RegisterCoreProcedures(interp);
12285 }
12286
12287 /* -----------------------------------------------------------------------------
12288 * Interactive prompt
12289 * ---------------------------------------------------------------------------*/
12290 void Jim_PrintErrorMessage(Jim_Interp *interp)
12291 {
12292 int len, i;
12293
12294 if (*interp->errorFileName) {
12295 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12296 interp->errorFileName, interp->errorLine);
12297 }
12298 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12299 Jim_GetString(interp->result, NULL));
12300 Jim_ListLength(interp, interp->stackTrace, &len);
12301 for (i = len-3; i >= 0; i-= 3) {
12302 Jim_Obj *objPtr;
12303 const char *proc, *file, *line;
12304
12305 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12306 proc = Jim_GetString(objPtr, NULL);
12307 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12308 JIM_NONE);
12309 file = Jim_GetString(objPtr, NULL);
12310 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12311 JIM_NONE);
12312 line = Jim_GetString(objPtr, NULL);
12313 if (*proc) {
12314 Jim_fprintf( interp, interp->cookie_stderr,
12315 "in procedure '%s' ", proc);
12316 }
12317 if (*file) {
12318 Jim_fprintf( interp, interp->cookie_stderr,
12319 "called at file \"%s\", line %s",
12320 file, line);
12321 }
12322 if (*file || *proc) {
12323 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12324 }
12325 }
12326 }
12327
12328 int Jim_InteractivePrompt(Jim_Interp *interp)
12329 {
12330 int retcode = JIM_OK;
12331 Jim_Obj *scriptObjPtr;
12332
12333 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12334 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12335 JIM_VERSION / 100, JIM_VERSION % 100);
12336 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12337 while (1) {
12338 char buf[1024];
12339 const char *result;
12340 const char *retcodestr[] = {
12341 "ok", "error", "return", "break", "continue", "eval", "exit"
12342 };
12343 int reslen;
12344
12345 if (retcode != 0) {
12346 if (retcode >= 2 && retcode <= 6)
12347 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12348 else
12349 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12350 } else
12351 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12352 Jim_fflush( interp, interp->cookie_stdout);
12353 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12354 Jim_IncrRefCount(scriptObjPtr);
12355 while(1) {
12356 const char *str;
12357 char state;
12358 int len;
12359
12360 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12361 Jim_DecrRefCount(interp, scriptObjPtr);
12362 goto out;
12363 }
12364 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12365 str = Jim_GetString(scriptObjPtr, &len);
12366 if (Jim_ScriptIsComplete(str, len, &state))
12367 break;
12368 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12369 Jim_fflush( interp, interp->cookie_stdout);
12370 }
12371 retcode = Jim_EvalObj(interp, scriptObjPtr);
12372 Jim_DecrRefCount(interp, scriptObjPtr);
12373 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12374 if (retcode == JIM_ERR) {
12375 Jim_PrintErrorMessage(interp);
12376 } else if (retcode == JIM_EXIT) {
12377 exit(Jim_GetExitCode(interp));
12378 } else {
12379 if (reslen) {
12380 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12381 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12382 }
12383 }
12384 }
12385 out:
12386 return 0;
12387 }
12388
12389 /* -----------------------------------------------------------------------------
12390 * Jim's idea of STDIO..
12391 * ---------------------------------------------------------------------------*/
12392
12393 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12394 {
12395 int r;
12396
12397 va_list ap;
12398 va_start(ap,fmt);
12399 r = Jim_vfprintf( interp, cookie, fmt,ap );
12400 va_end(ap);
12401 return r;
12402 }
12403
12404 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12405 {
12406 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12407 errno = ENOTSUP;
12408 return -1;
12409 }
12410 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12411 }
12412
12413 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12414 {
12415 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12416 errno = ENOTSUP;
12417 return 0;
12418 }
12419 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12420 }
12421
12422 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12423 {
12424 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12425 errno = ENOTSUP;
12426 return 0;
12427 }
12428 return (*(interp->cb_fread))( ptr, size, n, cookie);
12429 }
12430
12431 int Jim_fflush( Jim_Interp *interp, void *cookie )
12432 {
12433 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12434 /* pretend all is well */
12435 return 0;
12436 }
12437 return (*(interp->cb_fflush))( cookie );
12438 }
12439
12440 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12441 {
12442 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12443 errno = ENOTSUP;
12444 return NULL;
12445 }
12446 return (*(interp->cb_fgets))( s, size, cookie );
12447 }
12448 Jim_Nvp *
12449 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12450 {
12451 while( p->name ){
12452 if( 0 == strcmp( name, p->name ) ){
12453 break;
12454 }
12455 p++;
12456 }
12457 return ((Jim_Nvp *)(p));
12458 }
12459
12460 Jim_Nvp *
12461 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12462 {
12463 while( p->name ){
12464 if( 0 == strcasecmp( name, p->name ) ){
12465 break;
12466 }
12467 p++;
12468 }
12469 return ((Jim_Nvp *)(p));
12470 }
12471
12472 int
12473 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12474 const Jim_Nvp *p,
12475 Jim_Obj *o,
12476 Jim_Nvp **result )
12477 {
12478 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12479 }
12480
12481
12482 int
12483 Jim_Nvp_name2value( Jim_Interp *interp,
12484 const Jim_Nvp *_p,
12485 const char *name,
12486 Jim_Nvp **result)
12487 {
12488 const Jim_Nvp *p;
12489
12490 p = Jim_Nvp_name2value_simple( _p, name );
12491
12492 /* result */
12493 if( result ){
12494 *result = (Jim_Nvp *)(p);
12495 }
12496
12497 /* found? */
12498 if( p->name ){
12499 return JIM_OK;
12500 } else {
12501 return JIM_ERR;
12502 }
12503 }
12504
12505 int
12506 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12507 {
12508 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12509 }
12510
12511 int
12512 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12513 {
12514 const Jim_Nvp *p;
12515
12516 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12517
12518 if( puthere ){
12519 *puthere = (Jim_Nvp *)(p);
12520 }
12521 /* found */
12522 if( p->name ){
12523 return JIM_OK;
12524 } else {
12525 return JIM_ERR;
12526 }
12527 }
12528
12529
12530 int
12531 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12532 {
12533 int e;;
12534 jim_wide w;
12535
12536 e = Jim_GetWide( interp, o, &w );
12537 if( e != JIM_OK ){
12538 return e;
12539 }
12540
12541 return Jim_Nvp_value2name( interp, p, w, result );
12542 }
12543
12544 Jim_Nvp *
12545 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12546 {
12547 while( p->name ){
12548 if( value == p->value ){
12549 break;
12550 }
12551 p++;
12552 }
12553 return ((Jim_Nvp *)(p));
12554 }
12555
12556
12557 int
12558 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12559 {
12560 const Jim_Nvp *p;
12561
12562 p = Jim_Nvp_value2name_simple( _p, value );
12563
12564 if( result ){
12565 *result = (Jim_Nvp *)(p);
12566 }
12567
12568 if( p->name ){
12569 return JIM_OK;
12570 } else {
12571 return JIM_ERR;
12572 }
12573 }
12574
12575
12576 int
12577 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12578 {
12579 memset( p, 0, sizeof(*p) );
12580 p->interp = interp;
12581 p->argc = argc;
12582 p->argv = argv;
12583
12584 return JIM_OK;
12585 }
12586
12587 void
12588 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12589 {
12590 int x;
12591
12592 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12593 for( x = 0 ; x < p->argc ; x++ ){
12594 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12595 "%2d) %s\n",
12596 x,
12597 Jim_GetString( p->argv[x], NULL ) );
12598 }
12599 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12600 }
12601
12602
12603 int
12604 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12605 {
12606 Jim_Obj *o;
12607
12608 o = NULL; // failure
12609 if( goi->argc ){
12610 // success
12611 o = goi->argv[0];
12612 goi->argc -= 1;
12613 goi->argv += 1;
12614 }
12615 if( puthere ){
12616 *puthere = o;
12617 }
12618 if( o != NULL ){
12619 return JIM_OK;
12620 } else {
12621 return JIM_ERR;
12622 }
12623 }
12624
12625 int
12626 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12627 {
12628 int r;
12629 Jim_Obj *o;
12630 const char *cp;
12631
12632
12633 r = Jim_GetOpt_Obj( goi, &o );
12634 if( r == JIM_OK ){
12635 cp = Jim_GetString( o, len );
12636 if( puthere ){
12637 /* remove const */
12638 *puthere = (char *)(cp);
12639 }
12640 }
12641 return r;
12642 }
12643
12644 int
12645 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12646 {
12647 int r;
12648 Jim_Obj *o;
12649 double _safe;
12650
12651 if( puthere == NULL ){
12652 puthere = &_safe;
12653 }
12654
12655 r = Jim_GetOpt_Obj( goi, &o );
12656 if( r == JIM_OK ){
12657 r = Jim_GetDouble( goi->interp, o, puthere );
12658 if( r != JIM_OK ){
12659 Jim_SetResult_sprintf( goi->interp,
12660 "not a number: %s",
12661 Jim_GetString( o, NULL ) );
12662 }
12663 }
12664 return r;
12665 }
12666
12667 int
12668 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12669 {
12670 int r;
12671 Jim_Obj *o;
12672 jim_wide _safe;
12673
12674 if( puthere == NULL ){
12675 puthere = &_safe;
12676 }
12677
12678 r = Jim_GetOpt_Obj( goi, &o );
12679 if( r == JIM_OK ){
12680 r = Jim_GetWide( goi->interp, o, puthere );
12681 }
12682 return r;
12683 }
12684
12685 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12686 const Jim_Nvp *nvp,
12687 Jim_Nvp **puthere)
12688 {
12689 Jim_Nvp *_safe;
12690 Jim_Obj *o;
12691 int e;
12692
12693 if( puthere == NULL ){
12694 puthere = &_safe;
12695 }
12696
12697 e = Jim_GetOpt_Obj( goi, &o );
12698 if( e == JIM_OK ){
12699 e = Jim_Nvp_name2value_obj( goi->interp,
12700 nvp,
12701 o,
12702 puthere );
12703 }
12704
12705 return e;
12706 }
12707
12708 void
12709 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12710 const Jim_Nvp *nvptable,
12711 int hadprefix )
12712 {
12713 if( hadprefix ){
12714 Jim_SetResult_NvpUnknown( goi->interp,
12715 goi->argv[-2],
12716 goi->argv[-1],
12717 nvptable );
12718 } else {
12719 Jim_SetResult_NvpUnknown( goi->interp,
12720 NULL,
12721 goi->argv[-1],
12722 nvptable );
12723 }
12724 }
12725
12726
12727 int
12728 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12729 const char * const * lookup,
12730 int *puthere)
12731 {
12732 int _safe;
12733 Jim_Obj *o;
12734 int e;
12735
12736 if( puthere == NULL ){
12737 puthere = &_safe;
12738 }
12739 e = Jim_GetOpt_Obj( goi, &o );
12740 if( e == JIM_OK ){
12741 e = Jim_GetEnum( goi->interp,
12742 o,
12743 lookup,
12744 puthere,
12745 "option",
12746 JIM_ERRMSG );
12747 }
12748 return e;
12749 }
12750
12751
12752
12753 int
12754 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12755 {
12756 va_list ap;
12757 char *buf;
12758
12759 va_start(ap,fmt);
12760 buf = jim_vasprintf( fmt, ap );
12761 va_end(ap);
12762 if( buf ){
12763 Jim_SetResultString( interp, buf, -1 );
12764 jim_vasprintf_done(buf);
12765 }
12766 return JIM_OK;
12767 }
12768
12769
12770 void
12771 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12772 Jim_Obj *param_name,
12773 Jim_Obj *param_value,
12774 const Jim_Nvp *nvp )
12775 {
12776 if( param_name ){
12777 Jim_SetResult_sprintf( interp,
12778 "%s: Unknown: %s, try one of: ",
12779 Jim_GetString( param_name, NULL ),
12780 Jim_GetString( param_value, NULL ) );
12781 } else {
12782 Jim_SetResult_sprintf( interp,
12783 "Unknown param: %s, try one of: ",
12784 Jim_GetString( param_value, NULL ) );
12785 }
12786 while( nvp->name ){
12787 const char *a;
12788 const char *b;
12789
12790 if( (nvp+1)->name ){
12791 a = nvp->name;
12792 b = ", ";
12793 } else {
12794 a = "or ";
12795 b = nvp->name;
12796 }
12797 Jim_AppendStrings( interp,
12798 Jim_GetResult(interp),
12799 a, b, NULL );
12800 nvp++;
12801 }
12802 }
12803
12804
12805 static Jim_Obj *debug_string_obj;
12806
12807 const char *
12808 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12809 {
12810 int x;
12811
12812 if( debug_string_obj ){
12813 Jim_FreeObj( interp, debug_string_obj );
12814 }
12815
12816 debug_string_obj = Jim_NewEmptyStringObj( interp );
12817 for( x = 0 ; x < argc ; x++ ){
12818 Jim_AppendStrings( interp,
12819 debug_string_obj,
12820 Jim_GetString( argv[x], NULL ),
12821 " ",
12822 NULL );
12823 }
12824
12825 return Jim_GetString( debug_string_obj, NULL );
12826 }
12827
12828
12829
12830 /*
12831 * Local Variables: ***
12832 * c-basic-offset: 4 ***
12833 * tab-width: 4 ***
12834 * End: ***
12835 */

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)