src: add loader src description
[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,2009 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 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
14 *
15 * The FreeBSD license
16 *
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
19 * are met:
20 *
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
27 *
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 *
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
44 **/
45 #ifdef HAVE_CONFIG_H
46 #include "config.h"
47 #endif
48
49 #define __JIM_CORE__
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
51
52 #ifdef __ECOS
53 #include <pkgconf/jimtcl.h>
54 #include <stdio.h>
55 #include <stdlib.h>
56
57 typedef CYG_ADDRWORD intptr_t;
58
59 #include <string.h>
60 #include <stdarg.h>
61 #include <ctype.h>
62 #include <limits.h>
63 #include <assert.h>
64 #include <errno.h>
65 #include <time.h>
66 #endif
67 #ifndef JIM_ANSIC
68 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
69 #endif /* JIM_ANSIC */
70
71 #include <stdarg.h>
72 #include <limits.h>
73
74 /* Include the platform dependent libraries for
75 * dynamic loading of libraries. */
76 #ifdef JIM_DYNLIB
77 #if defined(_WIN32) || defined(WIN32)
78 #ifndef WIN32
79 #define WIN32 1
80 #endif
81 #ifndef STRICT
82 #define STRICT
83 #endif
84 #define WIN32_LEAN_AND_MEAN
85 #include <windows.h>
86 #if _MSC_VER >= 1000
87 #pragma warning(disable:4146)
88 #endif /* _MSC_VER */
89 #else
90 #include <dlfcn.h>
91 #endif /* WIN32 */
92 #endif /* JIM_DYNLIB */
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType *getJimVariablesHashTableType(void);
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf(const char *fmt, va_list ap)
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf(buf, sizeof(buf), fmt, ap);
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 int result;
137 result = vasprintf(&buf, fmt, ap);
138 if (result < 0) exit(-1);
139 #endif
140 return buf;
141 }
142
143 static void
144 jim_vasprintf_done(void *buf)
145 {
146 #ifndef HAVE_VASPRINTF
147 (void)(buf);
148 #else
149 free(buf);
150 #endif
151 }
152
153
154 /*
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
157 *
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
160 */
161 #ifdef HAVE_LONG_LONG_INT
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
164 {
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
170
171 /*
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
175 */
176 s = nptr;
177 do {
178 c = *s++;
179 } while (isspace(c));
180 if (c == '-') {
181 neg = 1;
182 c = *s++;
183 } else {
184 neg = 0;
185 if (c == '+')
186 c = *s++;
187 }
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
190 c = s[1];
191 s += 2;
192 base = 16;
193 }
194 if (base == 0)
195 base = c == '0' ? 8 : 10;
196
197 /*
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
211 *
212 * Set any if any `digits' consumed; make it negative to indicate
213 * overflow.
214 */
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
217 : LLONG_MAX;
218 cutlim = (int)(cutoff % qbase);
219 cutoff /= qbase;
220 for (acc = 0, any = 0;; c = *s++) {
221 if (!JimIsAscii(c))
222 break;
223 if (isdigit(c))
224 c -= '0';
225 else if (isalpha(c))
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
227 else
228 break;
229 if (c >= base)
230 break;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
232 any = -1;
233 else {
234 any = 1;
235 acc *= qbase;
236 acc += c;
237 }
238 }
239 if (any < 0) {
240 acc = neg ? LLONG_MIN : LLONG_MAX;
241 errno = ERANGE;
242 } else if (neg)
243 acc = -acc;
244 if (endptr != 0)
245 *endptr = (char *)(any ? s - 1 : nptr);
246 return (acc);
247 }
248 #endif
249
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
253 {
254 while (patternLen) {
255 switch (pattern[0]) {
256 case '*':
257 while (pattern[1] == '*') {
258 pattern++;
259 patternLen--;
260 }
261 if (patternLen == 1)
262 return 1; /* match */
263 while (stringLen) {
264 if (JimStringMatch(pattern + 1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
267 string++;
268 stringLen--;
269 }
270 return 0; /* no match */
271 break;
272 case '?':
273 if (stringLen == 0)
274 return 0; /* no match */
275 string++;
276 stringLen--;
277 break;
278 case '[':
279 {
280 int not, match;
281
282 pattern++;
283 patternLen--;
284 not = pattern[0] == '^';
285 if (not) {
286 pattern++;
287 patternLen--;
288 }
289 match = 0;
290 while (1) {
291 if (pattern[0] == '\\') {
292 pattern++;
293 patternLen--;
294 if (pattern[0] == string[0])
295 match = 1;
296 } else if (pattern[0] == ']') {
297 break;
298 } else if (patternLen == 0) {
299 pattern--;
300 patternLen++;
301 break;
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
305 int c = string[0];
306 if (start > end) {
307 int t = start;
308 start = end;
309 end = t;
310 }
311 if (nocase) {
312 start = tolower(start);
313 end = tolower(end);
314 c = tolower(c);
315 }
316 pattern += 2;
317 patternLen -= 2;
318 if (c >= start && c <= end)
319 match = 1;
320 } else {
321 if (!nocase) {
322 if (pattern[0] == string[0])
323 match = 1;
324 } else {
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
326 match = 1;
327 }
328 }
329 pattern++;
330 patternLen--;
331 }
332 if (not)
333 match = !match;
334 if (!match)
335 return 0; /* no match */
336 string++;
337 stringLen--;
338 break;
339 }
340 case '\\':
341 if (patternLen >= 2) {
342 pattern++;
343 patternLen--;
344 }
345 /* fall through */
346 default:
347 if (!nocase) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
350 } else {
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
353 }
354 string++;
355 stringLen--;
356 break;
357 }
358 pattern++;
359 patternLen--;
360 if (stringLen == 0) {
361 while (*pattern == '*') {
362 pattern++;
363 patternLen--;
364 }
365 break;
366 }
367 }
368 if (patternLen == 0 && stringLen == 0)
369 return 1;
370 return 0;
371 }
372
373 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
374 int nocase)
375 {
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
377
378 if (nocase == 0) {
379 while (l1 && l2) {
380 if (*u1 != *u2)
381 return (int)*u1-*u2;
382 u1++; u2++; l1--; l2--;
383 }
384 if (!l1 && !l2) return 0;
385 return l1-l2;
386 } else {
387 while (l1 && l2) {
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
391 }
392 if (!l1 && !l2) return 0;
393 return l1-l2;
394 }
395 }
396
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index_t)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index_t < 0) index_t = 0;
406 s2 += index_t;
407 for (i = index_t; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 static int Jim_WideToString(char *buf, jim_wide wideValue)
416 {
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
419 }
420
421 static int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
422 {
423 char *endptr;
424
425 #ifdef HAVE_LONG_LONG_INT
426 *widePtr = JimStrtoll(str, &endptr, base);
427 #else
428 *widePtr = strtol(str, &endptr, base);
429 #endif
430 if ((str[0] == '\0') || (str == endptr))
431 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace((int)*endptr))
435 return JIM_ERR;
436 endptr++;
437 }
438 }
439 return JIM_OK;
440 }
441
442 static int Jim_StringToIndex(const char *str, int *intPtr)
443 {
444 char *endptr;
445
446 *intPtr = strtol(str, &endptr, 10);
447 if ((str[0] == '\0') || (str == endptr))
448 return JIM_ERR;
449 if (endptr[0] != '\0') {
450 while (*endptr) {
451 if (!isspace((int)*endptr))
452 return JIM_ERR;
453 endptr++;
454 }
455 }
456 return JIM_OK;
457 }
458
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
465
466 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
467
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
469 {
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
473 }
474
475 static int Jim_DoubleToString(char *buf, double doubleValue)
476 {
477 char *s;
478 int len;
479
480 len = sprintf(buf, "%.17g", doubleValue);
481 s = buf;
482 while (*s) {
483 if (*s == '.') return len;
484 s++;
485 }
486 /* Add a final ".0" if it's a number. But not
487 * for NaN or InF */
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
491 s[0] = '.';
492 s[1] = '0';
493 s[2] = '\0';
494 return len + 2;
495 }
496 return len;
497 }
498
499 static int Jim_StringToDouble(const char *str, double *doublePtr)
500 {
501 char *endptr;
502
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
505 return JIM_ERR;
506 return JIM_OK;
507 }
508
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
510 {
511 jim_wide i, res = 1;
512 if ((b == 0 && e != 0) || (e < 0)) return 0;
513 for (i = 0; i < e; i++) {res *= b;}
514 return res;
515 }
516
517 /* -----------------------------------------------------------------------------
518 * Special functions
519 * ---------------------------------------------------------------------------*/
520
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
525 {
526 va_list ap;
527
528 va_start(ap, fmt);
529 /*
530 * Send it here first.. Assuming STDIO still works
531 */
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
535 va_end(ap);
536
537 #ifdef HAVE_BACKTRACE
538 {
539 void *array[40];
540 int size, i;
541 char **strings;
542
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
549 }
550 #endif
551
552 /* This may actually crash... we do it last */
553 if (interp && interp->cookie_stderr) {
554 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
556 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
557 }
558 abort();
559 }
560
561 /* -----------------------------------------------------------------------------
562 * Memory allocation
563 * ---------------------------------------------------------------------------*/
564
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
568 #if 0
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
572 #endif
573
574 void *Jim_Alloc(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 = malloc(size);
580 if (p == NULL)
581 Jim_Panic(NULL,"malloc: Out of memory");
582 return p;
583 }
584
585 void Jim_Free(void *ptr) {
586 free(ptr);
587 }
588
589 static void *Jim_Realloc(void *ptr, int size)
590 {
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
592 if (size == 0)
593 size = 1;
594 void *p = realloc(ptr, size);
595 if (p == NULL)
596 Jim_Panic(NULL,"realloc: Out of memory");
597 return p;
598 }
599
600 char *Jim_StrDup(const char *s)
601 {
602 int l = strlen(s);
603 char *copy = Jim_Alloc(l + 1);
604
605 memcpy(copy, s, l + 1);
606 return copy;
607 }
608
609 static char *Jim_StrDupLen(const char *s, int l)
610 {
611 char *copy = Jim_Alloc(l + 1);
612
613 memcpy(copy, s, l + 1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
615 return copy;
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
623 {
624 #if (defined WIN32) && !(defined JIM_ANSIC)
625 LARGE_INTEGER t, f;
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
629 #else /* !WIN32 */
630 clock_t clocks = clock();
631
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
633 #endif /* WIN32 */
634 }
635
636 /* -----------------------------------------------------------------------------
637 * Hash Tables
638 * ---------------------------------------------------------------------------*/
639
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
644
645 /* -------------------------- hash functions -------------------------------- */
646
647 /* Thomas Wang's 32 bit Mix Function */
648 static unsigned int Jim_IntHashFunction(unsigned int key)
649 {
650 key += ~(key << 15);
651 key ^= (key >> 10);
652 key += (key << 3);
653 key ^= (key >> 6);
654 key += ~(key << 11);
655 key ^= (key >> 16);
656 return key;
657 }
658
659 /* Generic hash function (we are using to multiply by 9 and add the byte
660 * as Tcl) */
661 static unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
662 {
663 unsigned int h = 0;
664 while (len--)
665 h += (h << 3)+*buf++;
666 return h;
667 }
668
669 /* ----------------------------- API implementation ------------------------- */
670 /* reset an hashtable already initialized with ht_init().
671 * NOTE: This function should only called by ht_destroy(). */
672 static void JimResetHashTable(Jim_HashTable *ht)
673 {
674 ht->table = NULL;
675 ht->size = 0;
676 ht->sizemask = 0;
677 ht->used = 0;
678 ht->collisions = 0;
679 }
680
681 /* Initialize the hash table */
682 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
683 void *privDataPtr)
684 {
685 JimResetHashTable(ht);
686 ht->type = type;
687 ht->privdata = privDataPtr;
688 return JIM_OK;
689 }
690
691 /* Resize the table to the minimal size that contains all the elements,
692 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
693 int Jim_ResizeHashTable(Jim_HashTable *ht)
694 {
695 int minimal = ht->used;
696
697 if (minimal < JIM_HT_INITIAL_SIZE)
698 minimal = JIM_HT_INITIAL_SIZE;
699 return Jim_ExpandHashTable(ht, minimal);
700 }
701
702 /* Expand or create the hashtable */
703 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
704 {
705 Jim_HashTable n; /* the new hashtable */
706 unsigned int realsize = JimHashTableNextPower(size), i;
707
708 /* the size is invalid if it is smaller than the number of
709 * elements already inside the hashtable */
710 if (ht->used >= size)
711 return JIM_ERR;
712
713 Jim_InitHashTable(&n, ht->type, ht->privdata);
714 n.size = realsize;
715 n.sizemask = realsize-1;
716 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
717
718 /* Initialize all the pointers to NULL */
719 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
720
721 /* Copy all the elements from the old to the new table:
722 * note that if the old hash table is empty ht->size is zero,
723 * so Jim_ExpandHashTable just creates an hash table. */
724 n.used = ht->used;
725 for (i = 0; i < ht->size && ht->used > 0; i++) {
726 Jim_HashEntry *he, *nextHe;
727
728 if (ht->table[i] == NULL) continue;
729
730 /* For each hash entry on this slot... */
731 he = ht->table[i];
732 while (he) {
733 unsigned int h;
734
735 nextHe = he->next;
736 /* Get the new element index */
737 h = Jim_HashKey(ht, he->key) & n.sizemask;
738 he->next = n.table[h];
739 n.table[h] = he;
740 ht->used--;
741 /* Pass to the next element */
742 he = nextHe;
743 }
744 }
745 assert(ht->used == 0);
746 Jim_Free(ht->table);
747
748 /* Remap the new hashtable in the old */
749 *ht = n;
750 return JIM_OK;
751 }
752
753 /* Add an element to the target hash table */
754 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
755 {
756 int index_t;
757 Jim_HashEntry *entry;
758
759 /* Get the index of the new element, or -1 if
760 * the element already exists. */
761 if ((index_t = JimInsertHashEntry(ht, key)) == -1)
762 return JIM_ERR;
763
764 /* Allocates the memory and stores key */
765 entry = Jim_Alloc(sizeof(*entry));
766 entry->next = ht->table[index_t];
767 ht->table[index_t] = entry;
768
769 /* Set the hash entry fields. */
770 Jim_SetHashKey(ht, entry, key);
771 Jim_SetHashVal(ht, entry, val);
772 ht->used++;
773 return JIM_OK;
774 }
775
776 /* Add an element, discarding the old if the key already exists */
777 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
778 {
779 Jim_HashEntry *entry;
780
781 /* Try to add the element. If the key
782 * does not exists Jim_AddHashEntry will suceed. */
783 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
784 return JIM_OK;
785 /* It already exists, get the entry */
786 entry = Jim_FindHashEntry(ht, key);
787 /* Free the old value and set the new one */
788 Jim_FreeEntryVal(ht, entry);
789 Jim_SetHashVal(ht, entry, val);
790 return JIM_OK;
791 }
792
793 /* Search and remove an element */
794 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
795 {
796 unsigned int h;
797 Jim_HashEntry *he, *prevHe;
798
799 if (ht->size == 0)
800 return JIM_ERR;
801 h = Jim_HashKey(ht, key) & ht->sizemask;
802 he = ht->table[h];
803
804 prevHe = NULL;
805 while (he) {
806 if (Jim_CompareHashKeys(ht, key, he->key)) {
807 /* Unlink the element from the list */
808 if (prevHe)
809 prevHe->next = he->next;
810 else
811 ht->table[h] = he->next;
812 Jim_FreeEntryKey(ht, he);
813 Jim_FreeEntryVal(ht, he);
814 Jim_Free(he);
815 ht->used--;
816 return JIM_OK;
817 }
818 prevHe = he;
819 he = he->next;
820 }
821 return JIM_ERR; /* not found */
822 }
823
824 /* Destroy an entire hash table */
825 int Jim_FreeHashTable(Jim_HashTable *ht)
826 {
827 unsigned int i;
828
829 /* Free all the elements */
830 for (i = 0; i < ht->size && ht->used > 0; i++) {
831 Jim_HashEntry *he, *nextHe;
832
833 if ((he = ht->table[i]) == NULL) continue;
834 while (he) {
835 nextHe = he->next;
836 Jim_FreeEntryKey(ht, he);
837 Jim_FreeEntryVal(ht, he);
838 Jim_Free(he);
839 ht->used--;
840 he = nextHe;
841 }
842 }
843 /* Free the table and the allocated cache structure */
844 Jim_Free(ht->table);
845 /* Re-initialize the table */
846 JimResetHashTable(ht);
847 return JIM_OK; /* never fails */
848 }
849
850 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
851 {
852 Jim_HashEntry *he;
853 unsigned int h;
854
855 if (ht->size == 0) return NULL;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
858 while (he) {
859 if (Jim_CompareHashKeys(ht, key, he->key))
860 return he;
861 he = he->next;
862 }
863 return NULL;
864 }
865
866 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
867 {
868 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
869
870 iter->ht = ht;
871 iter->index = -1;
872 iter->entry = NULL;
873 iter->nextEntry = NULL;
874 return iter;
875 }
876
877 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
878 {
879 while (1) {
880 if (iter->entry == NULL) {
881 iter->index++;
882 if (iter->index >=
883 (signed)iter->ht->size) break;
884 iter->entry = iter->ht->table[iter->index];
885 } else {
886 iter->entry = iter->nextEntry;
887 }
888 if (iter->entry) {
889 /* We need to save the 'next' here, the iterator user
890 * may delete the entry we are returning. */
891 iter->nextEntry = iter->entry->next;
892 return iter->entry;
893 }
894 }
895 return NULL;
896 }
897
898 /* ------------------------- private functions ------------------------------ */
899
900 /* Expand the hash table if needed */
901 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
902 {
903 /* If the hash table is empty expand it to the intial size,
904 * if the table is "full" dobule its size. */
905 if (ht->size == 0)
906 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
907 if (ht->size == ht->used)
908 return Jim_ExpandHashTable(ht, ht->size*2);
909 return JIM_OK;
910 }
911
912 /* Our hash table capability is a power of two */
913 static unsigned int JimHashTableNextPower(unsigned int size)
914 {
915 unsigned int i = JIM_HT_INITIAL_SIZE;
916
917 if (size >= 2147483648U)
918 return 2147483648U;
919 while (1) {
920 if (i >= size)
921 return i;
922 i *= 2;
923 }
924 }
925
926 /* Returns the index of a free slot that can be populated with
927 * an hash entry for the given 'key'.
928 * If the key already exists, -1 is returned. */
929 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
930 {
931 unsigned int h;
932 Jim_HashEntry *he;
933
934 /* Expand the hashtable if needed */
935 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
936 return -1;
937 /* Compute the key hash value */
938 h = Jim_HashKey(ht, key) & ht->sizemask;
939 /* Search if this slot does not already contain the given key */
940 he = ht->table[h];
941 while (he) {
942 if (Jim_CompareHashKeys(ht, key, he->key))
943 return -1;
944 he = he->next;
945 }
946 return h;
947 }
948
949 /* ----------------------- StringCopy Hash Table Type ------------------------*/
950
951 static unsigned int JimStringCopyHTHashFunction(const void *key)
952 {
953 return Jim_GenHashFunction(key, strlen(key));
954 }
955
956 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
957 {
958 int len = strlen(key);
959 char *copy = Jim_Alloc(len + 1);
960 JIM_NOTUSED(privdata);
961
962 memcpy(copy, key, len);
963 copy[len] = '\0';
964 return copy;
965 }
966
967 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
968 {
969 int len = strlen(val);
970 char *copy = Jim_Alloc(len + 1);
971 JIM_NOTUSED(privdata);
972
973 memcpy(copy, val, len);
974 copy[len] = '\0';
975 return copy;
976 }
977
978 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
979 const void *key2)
980 {
981 JIM_NOTUSED(privdata);
982
983 return strcmp(key1, key2) == 0;
984 }
985
986 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
987 {
988 JIM_NOTUSED(privdata);
989
990 Jim_Free((void*)key); /* ATTENTION: const cast */
991 }
992
993 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
994 {
995 JIM_NOTUSED(privdata);
996
997 Jim_Free((void*)val); /* ATTENTION: const cast */
998 }
999
1000 static Jim_HashTableType JimStringCopyHashTableType = {
1001 JimStringCopyHTHashFunction, /* hash function */
1002 JimStringCopyHTKeyDup, /* key dup */
1003 NULL, /* val dup */
1004 JimStringCopyHTKeyCompare, /* key compare */
1005 JimStringCopyHTKeyDestructor, /* key destructor */
1006 NULL /* val destructor */
1007 };
1008
1009 /* This is like StringCopy but does not auto-duplicate the key.
1010 * It's used for intepreter's shared strings. */
1011 static Jim_HashTableType JimSharedStringsHashTableType = {
1012 JimStringCopyHTHashFunction, /* hash function */
1013 NULL, /* key dup */
1014 NULL, /* val dup */
1015 JimStringCopyHTKeyCompare, /* key compare */
1016 JimStringCopyHTKeyDestructor, /* key destructor */
1017 NULL /* val destructor */
1018 };
1019
1020 /* This is like StringCopy but also automatically handle dynamic
1021 * allocated C strings as values. */
1022 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1023 JimStringCopyHTHashFunction, /* hash function */
1024 JimStringCopyHTKeyDup, /* key dup */
1025 JimStringKeyValCopyHTValDup, /* val dup */
1026 JimStringCopyHTKeyCompare, /* key compare */
1027 JimStringCopyHTKeyDestructor, /* key destructor */
1028 JimStringKeyValCopyHTValDestructor, /* val destructor */
1029 };
1030
1031 typedef struct AssocDataValue {
1032 Jim_InterpDeleteProc *delProc;
1033 void *data;
1034 } AssocDataValue;
1035
1036 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1037 {
1038 AssocDataValue *assocPtr = (AssocDataValue *)data;
1039 if (assocPtr->delProc != NULL)
1040 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1041 Jim_Free(data);
1042 }
1043
1044 static Jim_HashTableType JimAssocDataHashTableType = {
1045 JimStringCopyHTHashFunction, /* hash function */
1046 JimStringCopyHTKeyDup, /* key dup */
1047 NULL, /* val dup */
1048 JimStringCopyHTKeyCompare, /* key compare */
1049 JimStringCopyHTKeyDestructor, /* key destructor */
1050 JimAssocDataHashTableValueDestructor /* val destructor */
1051 };
1052
1053 /* -----------------------------------------------------------------------------
1054 * Stack - This is a simple generic stack implementation. It is used for
1055 * example in the 'expr' expression compiler.
1056 * ---------------------------------------------------------------------------*/
1057 void Jim_InitStack(Jim_Stack *stack)
1058 {
1059 stack->len = 0;
1060 stack->maxlen = 0;
1061 stack->vector = NULL;
1062 }
1063
1064 void Jim_FreeStack(Jim_Stack *stack)
1065 {
1066 Jim_Free(stack->vector);
1067 }
1068
1069 int Jim_StackLen(Jim_Stack *stack)
1070 {
1071 return stack->len;
1072 }
1073
1074 void Jim_StackPush(Jim_Stack *stack, void *element) {
1075 int neededLen = stack->len + 1;
1076 if (neededLen > stack->maxlen) {
1077 stack->maxlen = neededLen*2;
1078 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1079 }
1080 stack->vector[stack->len] = element;
1081 stack->len++;
1082 }
1083
1084 void *Jim_StackPop(Jim_Stack *stack)
1085 {
1086 if (stack->len == 0) return NULL;
1087 stack->len--;
1088 return stack->vector[stack->len];
1089 }
1090
1091 void *Jim_StackPeek(Jim_Stack *stack)
1092 {
1093 if (stack->len == 0) return NULL;
1094 return stack->vector[stack->len-1];
1095 }
1096
1097 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1098 {
1099 int i;
1100
1101 for (i = 0; i < stack->len; i++)
1102 freeFunc(stack->vector[i]);
1103 }
1104
1105 /* -----------------------------------------------------------------------------
1106 * Parser
1107 * ---------------------------------------------------------------------------*/
1108
1109 /* Token types */
1110 #define JIM_TT_NONE -1 /* No token returned */
1111 #define JIM_TT_STR 0 /* simple string */
1112 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1113 #define JIM_TT_VAR 2 /* var substitution */
1114 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1115 #define JIM_TT_CMD 4 /* command substitution */
1116 #define JIM_TT_SEP 5 /* word separator */
1117 #define JIM_TT_EOL 6 /* line separator */
1118
1119 /* Additional token types needed for expressions */
1120 #define JIM_TT_SUBEXPR_START 7
1121 #define JIM_TT_SUBEXPR_END 8
1122 #define JIM_TT_EXPR_NUMBER 9
1123 #define JIM_TT_EXPR_OPERATOR 10
1124
1125 /* Parser states */
1126 #define JIM_PS_DEF 0 /* Default state */
1127 #define JIM_PS_QUOTE 1 /* Inside "" */
1128
1129 /* Parser context structure. The same context is used both to parse
1130 * Tcl scripts and lists. */
1131 struct JimParserCtx {
1132 const char *prg; /* Program text */
1133 const char *p; /* Pointer to the point of the program we are parsing */
1134 int len; /* Left length of 'prg' */
1135 int linenr; /* Current line number */
1136 const char *tstart;
1137 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1138 int tline; /* Line number of the returned token */
1139 int tt; /* Token type */
1140 int eof; /* Non zero if EOF condition is true. */
1141 int state; /* Parser state */
1142 int comment; /* Non zero if the next chars may be a comment. */
1143 };
1144
1145 #define JimParserEof(c) ((c)->eof)
1146 #define JimParserTstart(c) ((c)->tstart)
1147 #define JimParserTend(c) ((c)->tend)
1148 #define JimParserTtype(c) ((c)->tt)
1149 #define JimParserTline(c) ((c)->tline)
1150
1151 static int JimParseScript(struct JimParserCtx *pc);
1152 static int JimParseSep(struct JimParserCtx *pc);
1153 static int JimParseEol(struct JimParserCtx *pc);
1154 static int JimParseCmd(struct JimParserCtx *pc);
1155 static int JimParseVar(struct JimParserCtx *pc);
1156 static int JimParseBrace(struct JimParserCtx *pc);
1157 static int JimParseStr(struct JimParserCtx *pc);
1158 static int JimParseComment(struct JimParserCtx *pc);
1159 static char *JimParserGetToken(struct JimParserCtx *pc,
1160 int *lenPtr, int *typePtr, int *linePtr);
1161
1162 /* Initialize a parser context.
1163 * 'prg' is a pointer to the program text, linenr is the line
1164 * number of the first line contained in the program. */
1165 static void JimParserInit(struct JimParserCtx *pc, const char *prg,
1166 int len, int linenr)
1167 {
1168 pc->prg = prg;
1169 pc->p = prg;
1170 pc->len = len;
1171 pc->tstart = NULL;
1172 pc->tend = NULL;
1173 pc->tline = 0;
1174 pc->tt = JIM_TT_NONE;
1175 pc->eof = 0;
1176 pc->state = JIM_PS_DEF;
1177 pc->linenr = linenr;
1178 pc->comment = 1;
1179 }
1180
1181 int JimParseScript(struct JimParserCtx *pc)
1182 {
1183 while (1) { /* the while is used to reiterate with continue if needed */
1184 if (!pc->len) {
1185 pc->tstart = pc->p;
1186 pc->tend = pc->p-1;
1187 pc->tline = pc->linenr;
1188 pc->tt = JIM_TT_EOL;
1189 pc->eof = 1;
1190 return JIM_OK;
1191 }
1192 switch (*(pc->p)) {
1193 case '\\':
1194 if (*(pc->p + 1) == '\n')
1195 return JimParseSep(pc);
1196 else {
1197 pc->comment = 0;
1198 return JimParseStr(pc);
1199 }
1200 break;
1201 case ' ':
1202 case '\t':
1203 case '\r':
1204 if (pc->state == JIM_PS_DEF)
1205 return JimParseSep(pc);
1206 else {
1207 pc->comment = 0;
1208 return JimParseStr(pc);
1209 }
1210 break;
1211 case '\n':
1212 case ';':
1213 pc->comment = 1;
1214 if (pc->state == JIM_PS_DEF)
1215 return JimParseEol(pc);
1216 else
1217 return JimParseStr(pc);
1218 break;
1219 case '[':
1220 pc->comment = 0;
1221 return JimParseCmd(pc);
1222 break;
1223 case '$':
1224 pc->comment = 0;
1225 if (JimParseVar(pc) == JIM_ERR) {
1226 pc->tstart = pc->tend = pc->p++; pc->len--;
1227 pc->tline = pc->linenr;
1228 pc->tt = JIM_TT_STR;
1229 return JIM_OK;
1230 } else
1231 return JIM_OK;
1232 break;
1233 case '#':
1234 if (pc->comment) {
1235 JimParseComment(pc);
1236 continue;
1237 } else {
1238 return JimParseStr(pc);
1239 }
1240 default:
1241 pc->comment = 0;
1242 return JimParseStr(pc);
1243 break;
1244 }
1245 return JIM_OK;
1246 }
1247 }
1248
1249 int JimParseSep(struct JimParserCtx *pc)
1250 {
1251 pc->tstart = pc->p;
1252 pc->tline = pc->linenr;
1253 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1254 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1255 if (*pc->p == '\\') {
1256 pc->p++; pc->len--;
1257 pc->linenr++;
1258 }
1259 pc->p++; pc->len--;
1260 }
1261 pc->tend = pc->p-1;
1262 pc->tt = JIM_TT_SEP;
1263 return JIM_OK;
1264 }
1265
1266 int JimParseEol(struct JimParserCtx *pc)
1267 {
1268 pc->tstart = pc->p;
1269 pc->tline = pc->linenr;
1270 while (*pc->p == ' ' || *pc->p == '\n' ||
1271 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1272 if (*pc->p == '\n')
1273 pc->linenr++;
1274 pc->p++; pc->len--;
1275 }
1276 pc->tend = pc->p-1;
1277 pc->tt = JIM_TT_EOL;
1278 return JIM_OK;
1279 }
1280
1281 /* Todo. Don't stop if ']' appears inside {} or quoted.
1282 * Also should handle the case of puts [string length "]"] */
1283 int JimParseCmd(struct JimParserCtx *pc)
1284 {
1285 int level = 1;
1286 int blevel = 0;
1287
1288 pc->tstart = ++pc->p; pc->len--;
1289 pc->tline = pc->linenr;
1290 while (1) {
1291 if (pc->len == 0) {
1292 break;
1293 } else if (*pc->p == '[' && blevel == 0) {
1294 level++;
1295 } else if (*pc->p == ']' && blevel == 0) {
1296 level--;
1297 if (!level) break;
1298 } else if (*pc->p == '\\') {
1299 pc->p++; pc->len--;
1300 } else if (*pc->p == '{') {
1301 blevel++;
1302 } else if (*pc->p == '}') {
1303 if (blevel != 0)
1304 blevel--;
1305 } else if (*pc->p == '\n')
1306 pc->linenr++;
1307 pc->p++; pc->len--;
1308 }
1309 pc->tend = pc->p-1;
1310 pc->tt = JIM_TT_CMD;
1311 if (*pc->p == ']') {
1312 pc->p++; pc->len--;
1313 }
1314 return JIM_OK;
1315 }
1316
1317 int JimParseVar(struct JimParserCtx *pc)
1318 {
1319 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1320
1321 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1322 pc->tline = pc->linenr;
1323 if (*pc->p == '{') {
1324 pc->tstart = ++pc->p; pc->len--;
1325 brace = 1;
1326 }
1327 if (brace) {
1328 while (!stop) {
1329 if (*pc->p == '}' || pc->len == 0) {
1330 pc->tend = pc->p-1;
1331 stop = 1;
1332 if (pc->len == 0)
1333 break;
1334 }
1335 else if (*pc->p == '\n')
1336 pc->linenr++;
1337 pc->p++; pc->len--;
1338 }
1339 } else {
1340 /* Include leading colons */
1341 while (*pc->p == ':') {
1342 pc->p++;
1343 pc->len--;
1344 }
1345 while (!stop) {
1346 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1347 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1348 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1349 stop = 1;
1350 else {
1351 pc->p++; pc->len--;
1352 }
1353 }
1354 /* Parse [dict get] syntax sugar. */
1355 if (*pc->p == '(') {
1356 while (*pc->p != ')' && pc->len) {
1357 pc->p++; pc->len--;
1358 if (*pc->p == '\\' && pc->len >= 2) {
1359 pc->p += 2; pc->len -= 2;
1360 }
1361 }
1362 if (*pc->p != '\0') {
1363 pc->p++; pc->len--;
1364 }
1365 ttype = JIM_TT_DICTSUGAR;
1366 }
1367 pc->tend = pc->p-1;
1368 }
1369 /* Check if we parsed just the '$' character.
1370 * That's not a variable so an error is returned
1371 * to tell the state machine to consider this '$' just
1372 * a string. */
1373 if (pc->tstart == pc->p) {
1374 pc->p--; pc->len++;
1375 return JIM_ERR;
1376 }
1377 pc->tt = ttype;
1378 return JIM_OK;
1379 }
1380
1381 int JimParseBrace(struct JimParserCtx *pc)
1382 {
1383 int level = 1;
1384
1385 pc->tstart = ++pc->p; pc->len--;
1386 pc->tline = pc->linenr;
1387 while (1) {
1388 if (*pc->p == '\\' && pc->len >= 2) {
1389 pc->p++; pc->len--;
1390 if (*pc->p == '\n')
1391 pc->linenr++;
1392 } else if (*pc->p == '{') {
1393 level++;
1394 } else if (pc->len == 0 || *pc->p == '}') {
1395 level--;
1396 if (pc->len == 0 || level == 0) {
1397 pc->tend = pc->p-1;
1398 if (pc->len != 0) {
1399 pc->p++; pc->len--;
1400 }
1401 pc->tt = JIM_TT_STR;
1402 return JIM_OK;
1403 }
1404 } else if (*pc->p == '\n') {
1405 pc->linenr++;
1406 }
1407 pc->p++; pc->len--;
1408 }
1409 return JIM_OK; /* unreached */
1410 }
1411
1412 int JimParseStr(struct JimParserCtx *pc)
1413 {
1414 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1415 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1416 if (newword && *pc->p == '{') {
1417 return JimParseBrace(pc);
1418 } else if (newword && *pc->p == '"') {
1419 pc->state = JIM_PS_QUOTE;
1420 pc->p++; pc->len--;
1421 }
1422 pc->tstart = pc->p;
1423 pc->tline = pc->linenr;
1424 while (1) {
1425 if (pc->len == 0) {
1426 pc->tend = pc->p-1;
1427 pc->tt = JIM_TT_ESC;
1428 return JIM_OK;
1429 }
1430 switch (*pc->p) {
1431 case '\\':
1432 if (pc->state == JIM_PS_DEF &&
1433 *(pc->p + 1) == '\n') {
1434 pc->tend = pc->p-1;
1435 pc->tt = JIM_TT_ESC;
1436 return JIM_OK;
1437 }
1438 if (pc->len >= 2) {
1439 pc->p++; pc->len--;
1440 }
1441 break;
1442 case '$':
1443 case '[':
1444 pc->tend = pc->p-1;
1445 pc->tt = JIM_TT_ESC;
1446 return JIM_OK;
1447 case ' ':
1448 case '\t':
1449 case '\n':
1450 case '\r':
1451 case ';':
1452 if (pc->state == JIM_PS_DEF) {
1453 pc->tend = pc->p-1;
1454 pc->tt = JIM_TT_ESC;
1455 return JIM_OK;
1456 } else if (*pc->p == '\n') {
1457 pc->linenr++;
1458 }
1459 break;
1460 case '"':
1461 if (pc->state == JIM_PS_QUOTE) {
1462 pc->tend = pc->p-1;
1463 pc->tt = JIM_TT_ESC;
1464 pc->p++; pc->len--;
1465 pc->state = JIM_PS_DEF;
1466 return JIM_OK;
1467 }
1468 break;
1469 }
1470 pc->p++; pc->len--;
1471 }
1472 return JIM_OK; /* unreached */
1473 }
1474
1475 int JimParseComment(struct JimParserCtx *pc)
1476 {
1477 while (*pc->p) {
1478 if (*pc->p == '\n') {
1479 pc->linenr++;
1480 if (*(pc->p-1) != '\\') {
1481 pc->p++; pc->len--;
1482 return JIM_OK;
1483 }
1484 }
1485 pc->p++; pc->len--;
1486 }
1487 return JIM_OK;
1488 }
1489
1490 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1491 static int xdigitval(int c)
1492 {
1493 if (c >= '0' && c <= '9') return c-'0';
1494 if (c >= 'a' && c <= 'f') return c-'a'+10;
1495 if (c >= 'A' && c <= 'F') return c-'A'+10;
1496 return -1;
1497 }
1498
1499 static int odigitval(int c)
1500 {
1501 if (c >= '0' && c <= '7') return c-'0';
1502 return -1;
1503 }
1504
1505 /* Perform Tcl escape substitution of 's', storing the result
1506 * string into 'dest'. The escaped string is guaranteed to
1507 * be the same length or shorted than the source string.
1508 * Slen is the length of the string at 's', if it's -1 the string
1509 * length will be calculated by the function.
1510 *
1511 * The function returns the length of the resulting string. */
1512 static int JimEscape(char *dest, const char *s, int slen)
1513 {
1514 char *p = dest;
1515 int i, len;
1516
1517 if (slen == -1)
1518 slen = strlen(s);
1519
1520 for (i = 0; i < slen; i++) {
1521 switch (s[i]) {
1522 case '\\':
1523 switch (s[i + 1]) {
1524 case 'a': *p++ = 0x7; i++; break;
1525 case 'b': *p++ = 0x8; i++; break;
1526 case 'f': *p++ = 0xc; i++; break;
1527 case 'n': *p++ = 0xa; i++; break;
1528 case 'r': *p++ = 0xd; i++; break;
1529 case 't': *p++ = 0x9; i++; break;
1530 case 'v': *p++ = 0xb; i++; break;
1531 case '\0': *p++ = '\\'; i++; break;
1532 case '\n': *p++ = ' '; i++; break;
1533 default:
1534 if (s[i + 1] == 'x') {
1535 int val = 0;
1536 int c = xdigitval(s[i + 2]);
1537 if (c == -1) {
1538 *p++ = 'x';
1539 i++;
1540 break;
1541 }
1542 val = c;
1543 c = xdigitval(s[i + 3]);
1544 if (c == -1) {
1545 *p++ = val;
1546 i += 2;
1547 break;
1548 }
1549 val = (val*16) + c;
1550 *p++ = val;
1551 i += 3;
1552 break;
1553 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1554 {
1555 int val = 0;
1556 int c = odigitval(s[i + 1]);
1557 val = c;
1558 c = odigitval(s[i + 2]);
1559 if (c == -1) {
1560 *p++ = val;
1561 i ++;
1562 break;
1563 }
1564 val = (val*8) + c;
1565 c = odigitval(s[i + 3]);
1566 if (c == -1) {
1567 *p++ = val;
1568 i += 2;
1569 break;
1570 }
1571 val = (val*8) + c;
1572 *p++ = val;
1573 i += 3;
1574 } else {
1575 *p++ = s[i + 1];
1576 i++;
1577 }
1578 break;
1579 }
1580 break;
1581 default:
1582 *p++ = s[i];
1583 break;
1584 }
1585 }
1586 len = p-dest;
1587 *p++ = '\0';
1588 return len;
1589 }
1590
1591 /* Returns a dynamically allocated copy of the current token in the
1592 * parser context. The function perform conversion of escapes if
1593 * the token is of type JIM_TT_ESC.
1594 *
1595 * Note that after the conversion, tokens that are grouped with
1596 * braces in the source code, are always recognizable from the
1597 * identical string obtained in a different way from the type.
1598 *
1599 * For exmple the string:
1600 *
1601 * {expand}$a
1602 *
1603 * will return as first token "expand", of type JIM_TT_STR
1604 *
1605 * While the string:
1606 *
1607 * expand$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_ESC
1610 */
1611 char *JimParserGetToken(struct JimParserCtx *pc,
1612 int *lenPtr, int *typePtr, int *linePtr)
1613 {
1614 const char *start, *end;
1615 char *token;
1616 int len;
1617
1618 start = JimParserTstart(pc);
1619 end = JimParserTend(pc);
1620 if (start > end) {
1621 if (lenPtr) *lenPtr = 0;
1622 if (typePtr) *typePtr = JimParserTtype(pc);
1623 if (linePtr) *linePtr = JimParserTline(pc);
1624 token = Jim_Alloc(1);
1625 token[0] = '\0';
1626 return token;
1627 }
1628 len = (end-start) + 1;
1629 token = Jim_Alloc(len + 1);
1630 if (JimParserTtype(pc) != JIM_TT_ESC) {
1631 /* No escape conversion needed? Just copy it. */
1632 memcpy(token, start, len);
1633 token[len] = '\0';
1634 } else {
1635 /* Else convert the escape chars. */
1636 len = JimEscape(token, start, len);
1637 }
1638 if (lenPtr) *lenPtr = len;
1639 if (typePtr) *typePtr = JimParserTtype(pc);
1640 if (linePtr) *linePtr = JimParserTline(pc);
1641 return token;
1642 }
1643
1644 /* The following functin is not really part of the parsing engine of Jim,
1645 * but it somewhat related. Given an string and its length, it tries
1646 * to guess if the script is complete or there are instead " " or { }
1647 * open and not completed. This is useful for interactive shells
1648 * implementation and for [info complete].
1649 *
1650 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1651 * '{' on scripts incomplete missing one or more '}' to be balanced.
1652 * '"' on scripts incomplete missing a '"' char.
1653 *
1654 * If the script is complete, 1 is returned, otherwise 0. */
1655 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1656 {
1657 int level = 0;
1658 int state = ' ';
1659
1660 while (len) {
1661 switch (*s) {
1662 case '\\':
1663 if (len > 1)
1664 s++;
1665 break;
1666 case '"':
1667 if (state == ' ') {
1668 state = '"';
1669 } else if (state == '"') {
1670 state = ' ';
1671 }
1672 break;
1673 case '{':
1674 if (state == '{') {
1675 level++;
1676 } else if (state == ' ') {
1677 state = '{';
1678 level++;
1679 }
1680 break;
1681 case '}':
1682 if (state == '{') {
1683 level--;
1684 if (level == 0)
1685 state = ' ';
1686 }
1687 break;
1688 }
1689 s++;
1690 len--;
1691 }
1692 if (stateCharPtr)
1693 *stateCharPtr = state;
1694 return state == ' ';
1695 }
1696
1697 /* -----------------------------------------------------------------------------
1698 * Tcl Lists parsing
1699 * ---------------------------------------------------------------------------*/
1700 static int JimParseListSep(struct JimParserCtx *pc);
1701 static int JimParseListStr(struct JimParserCtx *pc);
1702
1703 static int JimParseList(struct JimParserCtx *pc)
1704 {
1705 if (pc->len == 0) {
1706 pc->tstart = pc->tend = pc->p;
1707 pc->tline = pc->linenr;
1708 pc->tt = JIM_TT_EOL;
1709 pc->eof = 1;
1710 return JIM_OK;
1711 }
1712 switch (*pc->p) {
1713 case ' ':
1714 case '\n':
1715 case '\t':
1716 case '\r':
1717 if (pc->state == JIM_PS_DEF)
1718 return JimParseListSep(pc);
1719 else
1720 return JimParseListStr(pc);
1721 break;
1722 default:
1723 return JimParseListStr(pc);
1724 break;
1725 }
1726 return JIM_OK;
1727 }
1728
1729 int JimParseListSep(struct JimParserCtx *pc)
1730 {
1731 pc->tstart = pc->p;
1732 pc->tline = pc->linenr;
1733 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1734 {
1735 pc->p++; pc->len--;
1736 }
1737 pc->tend = pc->p-1;
1738 pc->tt = JIM_TT_SEP;
1739 return JIM_OK;
1740 }
1741
1742 int JimParseListStr(struct JimParserCtx *pc)
1743 {
1744 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1745 pc->tt == JIM_TT_NONE);
1746 if (newword && *pc->p == '{') {
1747 return JimParseBrace(pc);
1748 } else if (newword && *pc->p == '"') {
1749 pc->state = JIM_PS_QUOTE;
1750 pc->p++; pc->len--;
1751 }
1752 pc->tstart = pc->p;
1753 pc->tline = pc->linenr;
1754 while (1) {
1755 if (pc->len == 0) {
1756 pc->tend = pc->p-1;
1757 pc->tt = JIM_TT_ESC;
1758 return JIM_OK;
1759 }
1760 switch (*pc->p) {
1761 case '\\':
1762 pc->p++; pc->len--;
1763 break;
1764 case ' ':
1765 case '\t':
1766 case '\n':
1767 case '\r':
1768 if (pc->state == JIM_PS_DEF) {
1769 pc->tend = pc->p-1;
1770 pc->tt = JIM_TT_ESC;
1771 return JIM_OK;
1772 } else if (*pc->p == '\n') {
1773 pc->linenr++;
1774 }
1775 break;
1776 case '"':
1777 if (pc->state == JIM_PS_QUOTE) {
1778 pc->tend = pc->p-1;
1779 pc->tt = JIM_TT_ESC;
1780 pc->p++; pc->len--;
1781 pc->state = JIM_PS_DEF;
1782 return JIM_OK;
1783 }
1784 break;
1785 }
1786 pc->p++; pc->len--;
1787 }
1788 return JIM_OK; /* unreached */
1789 }
1790
1791 /* -----------------------------------------------------------------------------
1792 * Jim_Obj related functions
1793 * ---------------------------------------------------------------------------*/
1794
1795 /* Return a new initialized object. */
1796 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1797 {
1798 Jim_Obj *objPtr;
1799
1800 /* -- Check if there are objects in the free list -- */
1801 if (interp->freeList != NULL) {
1802 /* -- Unlink the object from the free list -- */
1803 objPtr = interp->freeList;
1804 interp->freeList = objPtr->nextObjPtr;
1805 } else {
1806 /* -- No ready to use objects: allocate a new one -- */
1807 objPtr = Jim_Alloc(sizeof(*objPtr));
1808 }
1809
1810 /* Object is returned with refCount of 0. Every
1811 * kind of GC implemented should take care to don't try
1812 * to scan objects with refCount == 0. */
1813 objPtr->refCount = 0;
1814 /* All the other fields are left not initialized to save time.
1815 * The caller will probably want set they to the right
1816 * value anyway. */
1817
1818 /* -- Put the object into the live list -- */
1819 objPtr->prevObjPtr = NULL;
1820 objPtr->nextObjPtr = interp->liveList;
1821 if (interp->liveList)
1822 interp->liveList->prevObjPtr = objPtr;
1823 interp->liveList = objPtr;
1824
1825 return objPtr;
1826 }
1827
1828 /* Free an object. Actually objects are never freed, but
1829 * just moved to the free objects list, where they will be
1830 * reused by Jim_NewObj(). */
1831 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1832 {
1833 /* Check if the object was already freed, panic. */
1834 if (objPtr->refCount != 0) {
1835 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1836 objPtr->refCount);
1837 }
1838 /* Free the internal representation */
1839 Jim_FreeIntRep(interp, objPtr);
1840 /* Free the string representation */
1841 if (objPtr->bytes != NULL) {
1842 if (objPtr->bytes != JimEmptyStringRep)
1843 Jim_Free(objPtr->bytes);
1844 }
1845 /* Unlink the object from the live objects list */
1846 if (objPtr->prevObjPtr)
1847 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1848 if (objPtr->nextObjPtr)
1849 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1850 if (interp->liveList == objPtr)
1851 interp->liveList = objPtr->nextObjPtr;
1852 /* Link the object into the free objects list */
1853 objPtr->prevObjPtr = NULL;
1854 objPtr->nextObjPtr = interp->freeList;
1855 if (interp->freeList)
1856 interp->freeList->prevObjPtr = objPtr;
1857 interp->freeList = objPtr;
1858 objPtr->refCount = -1;
1859 }
1860
1861 /* Invalidate the string representation of an object. */
1862 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1863 {
1864 if (objPtr->bytes != NULL) {
1865 if (objPtr->bytes != JimEmptyStringRep)
1866 Jim_Free(objPtr->bytes);
1867 }
1868 objPtr->bytes = NULL;
1869 }
1870
1871 #define Jim_SetStringRep(o, b, l) \
1872 do { (o)->bytes = b; (o)->length = l; } while (0)
1873
1874 /* Set the initial string representation for an object.
1875 * Does not try to free an old one. */
1876 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1877 {
1878 if (length == 0) {
1879 objPtr->bytes = JimEmptyStringRep;
1880 objPtr->length = 0;
1881 } else {
1882 objPtr->bytes = Jim_Alloc(length + 1);
1883 objPtr->length = length;
1884 memcpy(objPtr->bytes, bytes, length);
1885 objPtr->bytes[length] = '\0';
1886 }
1887 }
1888
1889 /* Duplicate an object. The returned object has refcount = 0. */
1890 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1891 {
1892 Jim_Obj *dupPtr;
1893
1894 dupPtr = Jim_NewObj(interp);
1895 if (objPtr->bytes == NULL) {
1896 /* Object does not have a valid string representation. */
1897 dupPtr->bytes = NULL;
1898 } else {
1899 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1900 }
1901 if (objPtr->typePtr != NULL) {
1902 if (objPtr->typePtr->dupIntRepProc == NULL) {
1903 dupPtr->internalRep = objPtr->internalRep;
1904 } else {
1905 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1906 }
1907 dupPtr->typePtr = objPtr->typePtr;
1908 } else {
1909 dupPtr->typePtr = NULL;
1910 }
1911 return dupPtr;
1912 }
1913
1914 /* Return the string representation for objPtr. If the object
1915 * string representation is invalid, calls the method to create
1916 * a new one starting from the internal representation of the object. */
1917 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1918 {
1919 if (objPtr->bytes == NULL) {
1920 /* Invalid string repr. Generate it. */
1921 if (objPtr->typePtr->updateStringProc == NULL) {
1922 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1923 objPtr->typePtr->name);
1924 }
1925 objPtr->typePtr->updateStringProc(objPtr);
1926 }
1927 if (lenPtr)
1928 *lenPtr = objPtr->length;
1929 return objPtr->bytes;
1930 }
1931
1932 /* Just returns the length of the object's string rep */
1933 int Jim_Length(Jim_Obj *objPtr)
1934 {
1935 int len;
1936
1937 Jim_GetString(objPtr, &len);
1938 return len;
1939 }
1940
1941 /* -----------------------------------------------------------------------------
1942 * String Object
1943 * ---------------------------------------------------------------------------*/
1944 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1945 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1946
1947 static Jim_ObjType stringObjType = {
1948 "string",
1949 NULL,
1950 DupStringInternalRep,
1951 NULL,
1952 JIM_TYPE_REFERENCES,
1953 };
1954
1955 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1956 {
1957 JIM_NOTUSED(interp);
1958
1959 /* This is a bit subtle: the only caller of this function
1960 * should be Jim_DuplicateObj(), that will copy the
1961 * string representaion. After the copy, the duplicated
1962 * object will not have more room in teh buffer than
1963 * srcPtr->length bytes. So we just set it to length. */
1964 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1965 }
1966
1967 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1968 {
1969 /* Get a fresh string representation. */
1970 (void) Jim_GetString(objPtr, NULL);
1971 /* Free any other internal representation. */
1972 Jim_FreeIntRep(interp, objPtr);
1973 /* Set it as string, i.e. just set the maxLength field. */
1974 objPtr->typePtr = &stringObjType;
1975 objPtr->internalRep.strValue.maxLength = objPtr->length;
1976 return JIM_OK;
1977 }
1978
1979 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1980 {
1981 Jim_Obj *objPtr = Jim_NewObj(interp);
1982
1983 if (len == -1)
1984 len = strlen(s);
1985 /* Alloc/Set the string rep. */
1986 if (len == 0) {
1987 objPtr->bytes = JimEmptyStringRep;
1988 objPtr->length = 0;
1989 } else {
1990 objPtr->bytes = Jim_Alloc(len + 1);
1991 objPtr->length = len;
1992 memcpy(objPtr->bytes, s, len);
1993 objPtr->bytes[len] = '\0';
1994 }
1995
1996 /* No typePtr field for the vanilla string object. */
1997 objPtr->typePtr = NULL;
1998 return objPtr;
1999 }
2000
2001 /* This version does not try to duplicate the 's' pointer, but
2002 * use it directly. */
2003 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2004 {
2005 Jim_Obj *objPtr = Jim_NewObj(interp);
2006
2007 if (len == -1)
2008 len = strlen(s);
2009 Jim_SetStringRep(objPtr, s, len);
2010 objPtr->typePtr = NULL;
2011 return objPtr;
2012 }
2013
2014 /* Low-level string append. Use it only against objects
2015 * of type "string". */
2016 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2017 {
2018 int needlen;
2019
2020 if (len == -1)
2021 len = strlen(str);
2022 needlen = objPtr->length + len;
2023 if (objPtr->internalRep.strValue.maxLength < needlen ||
2024 objPtr->internalRep.strValue.maxLength == 0) {
2025 if (objPtr->bytes == JimEmptyStringRep) {
2026 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2027 } else {
2028 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2029 }
2030 objPtr->internalRep.strValue.maxLength = needlen*2;
2031 }
2032 memcpy(objPtr->bytes + objPtr->length, str, len);
2033 objPtr->bytes[objPtr->length + len] = '\0';
2034 objPtr->length += len;
2035 }
2036
2037 /* Higher level API to append strings to objects. */
2038 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2039 int len)
2040 {
2041 if (Jim_IsShared(objPtr))
2042 Jim_Panic(interp,"Jim_AppendString called with shared object");
2043 if (objPtr->typePtr != &stringObjType)
2044 SetStringFromAny(interp, objPtr);
2045 StringAppendString(objPtr, str, len);
2046 }
2047
2048 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2049 {
2050 char *buf;
2051 va_list ap;
2052
2053 va_start(ap, fmt);
2054 buf = jim_vasprintf(fmt, ap);
2055 va_end(ap);
2056
2057 if (buf) {
2058 Jim_AppendString(interp, objPtr, buf, -1);
2059 jim_vasprintf_done(buf);
2060 }
2061 }
2062
2063
2064 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2065 Jim_Obj *appendObjPtr)
2066 {
2067 int len;
2068 const char *str;
2069
2070 str = Jim_GetString(appendObjPtr, &len);
2071 Jim_AppendString(interp, objPtr, str, len);
2072 }
2073
2074 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2075 {
2076 va_list ap;
2077
2078 if (objPtr->typePtr != &stringObjType)
2079 SetStringFromAny(interp, objPtr);
2080 va_start(ap, objPtr);
2081 while (1) {
2082 char *s = va_arg(ap, char*);
2083
2084 if (s == NULL) break;
2085 Jim_AppendString(interp, objPtr, s, -1);
2086 }
2087 va_end(ap);
2088 }
2089
2090 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2091 {
2092 const char *aStr, *bStr;
2093 int aLen, bLen, i;
2094
2095 if (aObjPtr == bObjPtr) return 1;
2096 aStr = Jim_GetString(aObjPtr, &aLen);
2097 bStr = Jim_GetString(bObjPtr, &bLen);
2098 if (aLen != bLen) return 0;
2099 if (nocase == 0)
2100 return memcmp(aStr, bStr, aLen) == 0;
2101 for (i = 0; i < aLen; i++) {
2102 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2103 return 0;
2104 }
2105 return 1;
2106 }
2107
2108 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2109 int nocase)
2110 {
2111 const char *pattern, *string;
2112 int patternLen, stringLen;
2113
2114 pattern = Jim_GetString(patternObjPtr, &patternLen);
2115 string = Jim_GetString(objPtr, &stringLen);
2116 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2117 }
2118
2119 static int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2120 Jim_Obj *secondObjPtr, int nocase)
2121 {
2122 const char *s1, *s2;
2123 int l1, l2;
2124
2125 s1 = Jim_GetString(firstObjPtr, &l1);
2126 s2 = Jim_GetString(secondObjPtr, &l2);
2127 return JimStringCompare(s1, l1, s2, l2, nocase);
2128 }
2129
2130 /* Convert a range, as returned by Jim_GetRange(), into
2131 * an absolute index into an object of the specified length.
2132 * This function may return negative values, or values
2133 * bigger or equal to the length of the list if the index
2134 * is out of range. */
2135 static int JimRelToAbsIndex(int len, int index_t)
2136 {
2137 if (index_t < 0)
2138 return len + index_t;
2139 return index_t;
2140 }
2141
2142 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2143 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2144 * for implementation of commands like [string range] and [lrange].
2145 *
2146 * The resulting range is guaranteed to address valid elements of
2147 * the structure. */
2148 static void JimRelToAbsRange(int len, int first, int last,
2149 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2150 {
2151 int rangeLen;
2152
2153 if (first > last) {
2154 rangeLen = 0;
2155 } else {
2156 rangeLen = last-first + 1;
2157 if (rangeLen) {
2158 if (first < 0) {
2159 rangeLen += first;
2160 first = 0;
2161 }
2162 if (last >= len) {
2163 rangeLen -= (last-(len-1));
2164 last = len-1;
2165 }
2166 }
2167 }
2168 if (rangeLen < 0) rangeLen = 0;
2169
2170 *firstPtr = first;
2171 *lastPtr = last;
2172 *rangeLenPtr = rangeLen;
2173 }
2174
2175 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2176 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2177 {
2178 int first, last;
2179 const char *str;
2180 int len, rangeLen;
2181
2182 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2183 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2184 return NULL;
2185 str = Jim_GetString(strObjPtr, &len);
2186 first = JimRelToAbsIndex(len, first);
2187 last = JimRelToAbsIndex(len, last);
2188 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2189 return Jim_NewStringObj(interp, str + first, rangeLen);
2190 }
2191
2192 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2193 {
2194 char *buf;
2195 int i;
2196 if (strObjPtr->typePtr != &stringObjType) {
2197 SetStringFromAny(interp, strObjPtr);
2198 }
2199
2200 buf = Jim_Alloc(strObjPtr->length + 1);
2201
2202 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2203 for (i = 0; i < strObjPtr->length; i++)
2204 buf[i] = tolower((unsigned)buf[i]);
2205 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2206 }
2207
2208 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2209 {
2210 char *buf;
2211 int i;
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2214 }
2215
2216 buf = Jim_Alloc(strObjPtr->length + 1);
2217
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = toupper((unsigned)buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2222 }
2223
2224 /* This is the core of the [format] command.
2225 * TODO: Lots of things work - via a hack
2226 * However, no format item can be >= JIM_MAX_FMT
2227 */
2228 #define JIM_MAX_FMT 2048
2229 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2230 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2231 {
2232 const char *fmt, *_fmt;
2233 int fmtLen;
2234 Jim_Obj *resObjPtr;
2235
2236
2237 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2238 _fmt = fmt;
2239 resObjPtr = Jim_NewStringObj(interp, "", 0);
2240 while (fmtLen) {
2241 const char *p = fmt;
2242 char spec[2], c;
2243 jim_wide wideValue;
2244 double doubleValue;
2245 /* we cheat and use Sprintf()! */
2246 char fmt_str[100];
2247 char *cp;
2248 int width;
2249 int ljust;
2250 int zpad;
2251 int spad;
2252 int altfm;
2253 int forceplus;
2254 int prec;
2255 int inprec;
2256 int haveprec;
2257 int accum;
2258
2259 while (*fmt != '%' && fmtLen) {
2260 fmt++; fmtLen--;
2261 }
2262 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2263 if (fmtLen == 0)
2264 break;
2265 fmt++; fmtLen--; /* skip '%' */
2266 zpad = 0;
2267 spad = 0;
2268 width = -1;
2269 ljust = 0;
2270 altfm = 0;
2271 forceplus = 0;
2272 inprec = 0;
2273 haveprec = 0;
2274 prec = -1; /* not found yet */
2275 next_fmt:
2276 if (fmtLen <= 0) {
2277 break;
2278 }
2279 switch (*fmt) {
2280 /* terminals */
2281 case 'b': /* binary - not all printfs() do this */
2282 case 's': /* string */
2283 case 'i': /* integer */
2284 case 'd': /* decimal */
2285 case 'x': /* hex */
2286 case 'X': /* CAP hex */
2287 case 'c': /* char */
2288 case 'o': /* octal */
2289 case 'u': /* unsigned */
2290 case 'f': /* float */
2291 break;
2292
2293 /* non-terminals */
2294 case '0': /* zero pad */
2295 zpad = 1;
2296 fmt++; fmtLen--;
2297 goto next_fmt;
2298 break;
2299 case '+':
2300 forceplus = 1;
2301 fmt++; fmtLen--;
2302 goto next_fmt;
2303 break;
2304 case ' ': /* sign space */
2305 spad = 1;
2306 fmt++; fmtLen--;
2307 goto next_fmt;
2308 break;
2309 case '-':
2310 ljust = 1;
2311 fmt++; fmtLen--;
2312 goto next_fmt;
2313 break;
2314 case '#':
2315 altfm = 1;
2316 fmt++; fmtLen--;
2317 goto next_fmt;
2318
2319 case '.':
2320 inprec = 1;
2321 fmt++; fmtLen--;
2322 goto next_fmt;
2323 break;
2324 case '1':
2325 case '2':
2326 case '3':
2327 case '4':
2328 case '5':
2329 case '6':
2330 case '7':
2331 case '8':
2332 case '9':
2333 accum = 0;
2334 while (isdigit((unsigned)*fmt) && (fmtLen > 0)) {
2335 accum = (accum * 10) + (*fmt - '0');
2336 fmt++; fmtLen--;
2337 }
2338 if (inprec) {
2339 haveprec = 1;
2340 prec = accum;
2341 } else {
2342 width = accum;
2343 }
2344 goto next_fmt;
2345 case '*':
2346 /* suck up the next item as an integer */
2347 fmt++; fmtLen--;
2348 objc--;
2349 if (objc <= 0) {
2350 goto not_enough_args;
2351 }
2352 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2353 Jim_FreeNewObj(interp, resObjPtr);
2354 return NULL;
2355 }
2356 if (inprec) {
2357 haveprec = 1;
2358 prec = wideValue;
2359 if (prec < 0) {
2360 /* man 3 printf says */
2361 /* if prec is negative, it is zero */
2362 prec = 0;
2363 }
2364 } else {
2365 width = wideValue;
2366 if (width < 0) {
2367 ljust = 1;
2368 width = -width;
2369 }
2370 }
2371 objv++;
2372 goto next_fmt;
2373 break;
2374 }
2375
2376
2377 if (*fmt != '%') {
2378 if (objc == 0) {
2379 not_enough_args:
2380 Jim_FreeNewObj(interp, resObjPtr);
2381 Jim_SetResultString(interp,
2382 "not enough arguments for all format specifiers", -1);
2383 return NULL;
2384 } else {
2385 objc--;
2386 }
2387 }
2388
2389 /*
2390 * Create the formatter
2391 * cause we cheat and use sprintf()
2392 */
2393 cp = fmt_str;
2394 *cp++ = '%';
2395 if (altfm) {
2396 *cp++ = '#';
2397 }
2398 if (forceplus) {
2399 *cp++ = '+';
2400 } else if (spad) {
2401 /* PLUS overrides */
2402 *cp++ = ' ';
2403 }
2404 if (ljust) {
2405 *cp++ = '-';
2406 }
2407 if (zpad) {
2408 *cp++ = '0';
2409 }
2410 if (width > 0) {
2411 sprintf(cp, "%d", width);
2412 /* skip ahead */
2413 cp = strchr(cp,0);
2414 }
2415 /* did we find a period? */
2416 if (inprec) {
2417 /* then add it */
2418 *cp++ = '.';
2419 /* did something occur after the period? */
2420 if (haveprec) {
2421 sprintf(cp, "%d", prec);
2422 }
2423 cp = strchr(cp,0);
2424 }
2425 *cp = 0;
2426
2427 /* here we do the work */
2428 /* actually - we make sprintf() do it for us */
2429 switch (*fmt) {
2430 case 's':
2431 *cp++ = 's';
2432 *cp = 0;
2433 /* BUG: we do not handled embeded NULLs */
2434 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2435 break;
2436 case 'c':
2437 *cp++ = 'c';
2438 *cp = 0;
2439 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2440 Jim_FreeNewObj(interp, resObjPtr);
2441 return NULL;
2442 }
2443 c = (char) wideValue;
2444 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2445 break;
2446 case 'f':
2447 case 'F':
2448 case 'g':
2449 case 'G':
2450 case 'e':
2451 case 'E':
2452 *cp++ = *fmt;
2453 *cp = 0;
2454 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2455 Jim_FreeNewObj(interp, resObjPtr);
2456 return NULL;
2457 }
2458 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2459 break;
2460 case 'b':
2461 case 'd':
2462 case 'o':
2463 case 'i':
2464 case 'u':
2465 case 'x':
2466 case 'X':
2467 /* jim widevaluse are 64bit */
2468 if (sizeof(jim_wide) == sizeof(long long)) {
2469 *cp++ = 'l';
2470 *cp++ = 'l';
2471 } else {
2472 *cp++ = 'l';
2473 }
2474 *cp++ = *fmt;
2475 *cp = 0;
2476 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2477 Jim_FreeNewObj(interp, resObjPtr);
2478 return NULL;
2479 }
2480 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2481 break;
2482 case '%':
2483 sprintf_buf[0] = '%';
2484 sprintf_buf[1] = 0;
2485 objv--; /* undo the objv++ below */
2486 break;
2487 default:
2488 spec[0] = *fmt; spec[1] = '\0';
2489 Jim_FreeNewObj(interp, resObjPtr);
2490 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2491 Jim_AppendStrings(interp, Jim_GetResult(interp),
2492 "bad field specifier \"", spec, "\"", NULL);
2493 return NULL;
2494 }
2495 /* force terminate */
2496 #if 0
2497 printf("FMT was: %s\n", fmt_str);
2498 printf("RES was: |%s|\n", sprintf_buf);
2499 #endif
2500
2501 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2502 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2503 /* next obj */
2504 objv++;
2505 fmt++;
2506 fmtLen--;
2507 }
2508 return resObjPtr;
2509 }
2510
2511 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2512 int objc, Jim_Obj *const *objv)
2513 {
2514 char *sprintf_buf = malloc(JIM_MAX_FMT);
2515 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2516 free(sprintf_buf);
2517 return t;
2518 }
2519
2520 /* -----------------------------------------------------------------------------
2521 * Compared String Object
2522 * ---------------------------------------------------------------------------*/
2523
2524 /* This is strange object that allows to compare a C literal string
2525 * with a Jim object in very short time if the same comparison is done
2526 * multiple times. For example every time the [if] command is executed,
2527 * Jim has to check if a given argument is "else". This comparions if
2528 * the code has no errors are true most of the times, so we can cache
2529 * inside the object the pointer of the string of the last matching
2530 * comparison. Because most C compilers perform literal sharing,
2531 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2532 * this works pretty well even if comparisons are at different places
2533 * inside the C code. */
2534
2535 static Jim_ObjType comparedStringObjType = {
2536 "compared-string",
2537 NULL,
2538 NULL,
2539 NULL,
2540 JIM_TYPE_REFERENCES,
2541 };
2542
2543 /* The only way this object is exposed to the API is via the following
2544 * function. Returns true if the string and the object string repr.
2545 * are the same, otherwise zero is returned.
2546 *
2547 * Note: this isn't binary safe, but it hardly needs to be.*/
2548 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2549 const char *str)
2550 {
2551 if (objPtr->typePtr == &comparedStringObjType &&
2552 objPtr->internalRep.ptr == str)
2553 return 1;
2554 else {
2555 const char *objStr = Jim_GetString(objPtr, NULL);
2556 if (strcmp(str, objStr) != 0) return 0;
2557 if (objPtr->typePtr != &comparedStringObjType) {
2558 Jim_FreeIntRep(interp, objPtr);
2559 objPtr->typePtr = &comparedStringObjType;
2560 }
2561 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2562 return 1;
2563 }
2564 }
2565
2566 static int qsortCompareStringPointers(const void *a, const void *b)
2567 {
2568 char * const *sa = (char * const *)a;
2569 char * const *sb = (char * const *)b;
2570 return strcmp(*sa, *sb);
2571 }
2572
2573 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2574 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2575 {
2576 const char * const *entryPtr = NULL;
2577 char **tablePtrSorted;
2578 int i, count = 0;
2579
2580 *indexPtr = -1;
2581 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2582 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2583 *indexPtr = i;
2584 return JIM_OK;
2585 }
2586 count++; /* If nothing matches, this will reach the len of tablePtr */
2587 }
2588 if (flags & JIM_ERRMSG) {
2589 if (name == NULL)
2590 name = "option";
2591 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2592 Jim_AppendStrings(interp, Jim_GetResult(interp),
2593 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2594 NULL);
2595 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2596 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2597 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2598 for (i = 0; i < count; i++) {
2599 if (i + 1 == count && count > 1)
2600 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2601 Jim_AppendString(interp, Jim_GetResult(interp),
2602 tablePtrSorted[i], -1);
2603 if (i + 1 != count)
2604 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2605 }
2606 Jim_Free(tablePtrSorted);
2607 }
2608 return JIM_ERR;
2609 }
2610
2611 int Jim_GetNvp(Jim_Interp *interp,
2612 Jim_Obj *objPtr,
2613 const Jim_Nvp *nvp_table,
2614 const Jim_Nvp ** result)
2615 {
2616 Jim_Nvp *n;
2617 int e;
2618
2619 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2620 if (e == JIM_ERR) {
2621 return e;
2622 }
2623
2624 /* Success? found? */
2625 if (n->name) {
2626 /* remove const */
2627 *result = (Jim_Nvp *)n;
2628 return JIM_OK;
2629 } else {
2630 return JIM_ERR;
2631 }
2632 }
2633
2634 /* -----------------------------------------------------------------------------
2635 * Source Object
2636 *
2637 * This object is just a string from the language point of view, but
2638 * in the internal representation it contains the filename and line number
2639 * where this given token was read. This information is used by
2640 * Jim_EvalObj() if the object passed happens to be of type "source".
2641 *
2642 * This allows to propagate the information about line numbers and file
2643 * names and give error messages with absolute line numbers.
2644 *
2645 * Note that this object uses shared strings for filenames, and the
2646 * pointer to the filename together with the line number is taken into
2647 * the space for the "inline" internal represenation of the Jim_Object,
2648 * so there is almost memory zero-overhead.
2649 *
2650 * Also the object will be converted to something else if the given
2651 * token it represents in the source file is not something to be
2652 * evaluated (not a script), and will be specialized in some other way,
2653 * so the time overhead is alzo null.
2654 * ---------------------------------------------------------------------------*/
2655
2656 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2657 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2658
2659 static Jim_ObjType sourceObjType = {
2660 "source",
2661 FreeSourceInternalRep,
2662 DupSourceInternalRep,
2663 NULL,
2664 JIM_TYPE_REFERENCES,
2665 };
2666
2667 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2668 {
2669 Jim_ReleaseSharedString(interp,
2670 objPtr->internalRep.sourceValue.fileName);
2671 }
2672
2673 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2674 {
2675 dupPtr->internalRep.sourceValue.fileName =
2676 Jim_GetSharedString(interp,
2677 srcPtr->internalRep.sourceValue.fileName);
2678 dupPtr->internalRep.sourceValue.lineNumber =
2679 dupPtr->internalRep.sourceValue.lineNumber;
2680 dupPtr->typePtr = &sourceObjType;
2681 }
2682
2683 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2684 const char *fileName, int lineNumber)
2685 {
2686 if (Jim_IsShared(objPtr))
2687 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2688 if (objPtr->typePtr != NULL)
2689 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2690 objPtr->internalRep.sourceValue.fileName =
2691 Jim_GetSharedString(interp, fileName);
2692 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2693 objPtr->typePtr = &sourceObjType;
2694 }
2695
2696 /* -----------------------------------------------------------------------------
2697 * Script Object
2698 * ---------------------------------------------------------------------------*/
2699
2700 #define JIM_CMDSTRUCT_EXPAND -1
2701
2702 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2703 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2704 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2705
2706 static Jim_ObjType scriptObjType = {
2707 "script",
2708 FreeScriptInternalRep,
2709 DupScriptInternalRep,
2710 NULL,
2711 JIM_TYPE_REFERENCES,
2712 };
2713
2714 /* The ScriptToken structure represents every token into a scriptObj.
2715 * Every token contains an associated Jim_Obj that can be specialized
2716 * by commands operating on it. */
2717 typedef struct ScriptToken {
2718 int type;
2719 Jim_Obj *objPtr;
2720 int linenr;
2721 } ScriptToken;
2722
2723 /* This is the script object internal representation. An array of
2724 * ScriptToken structures, with an associated command structure array.
2725 * The command structure is a pre-computed representation of the
2726 * command length and arguments structure as a simple liner array
2727 * of integers.
2728 *
2729 * For example the script:
2730 *
2731 * puts hello
2732 * set $i $x$y [foo]BAR
2733 *
2734 * will produce a ScriptObj with the following Tokens:
2735 *
2736 * ESC puts
2737 * SEP
2738 * ESC hello
2739 * EOL
2740 * ESC set
2741 * EOL
2742 * VAR i
2743 * SEP
2744 * VAR x
2745 * VAR y
2746 * SEP
2747 * CMD foo
2748 * ESC BAR
2749 * EOL
2750 *
2751 * This is a description of the tokens, separators, and of lines.
2752 * The command structure instead represents the number of arguments
2753 * of every command, followed by the tokens of which every argument
2754 * is composed. So for the example script, the cmdstruct array will
2755 * contain:
2756 *
2757 * 2 1 1 4 1 1 2 2
2758 *
2759 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2760 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2761 * composed of single tokens (1 1) and the last two of double tokens
2762 * (2 2).
2763 *
2764 * The precomputation of the command structure makes Jim_Eval() faster,
2765 * and simpler because there aren't dynamic lengths / allocations.
2766 *
2767 * -- {expand} handling --
2768 *
2769 * Expand is handled in a special way. When a command
2770 * contains at least an argument with the {expand} prefix,
2771 * the command structure presents a -1 before the integer
2772 * describing the number of arguments. This is used in order
2773 * to send the command exection to a different path in case
2774 * of {expand} and guarantee a fast path for the more common
2775 * case. Also, the integers describing the number of tokens
2776 * are expressed with negative sign, to allow for fast check
2777 * of what's an {expand}-prefixed argument and what not.
2778 *
2779 * For example the command:
2780 *
2781 * list {expand}{1 2}
2782 *
2783 * Will produce the following cmdstruct array:
2784 *
2785 * -1 2 1 -2
2786 *
2787 * -- the substFlags field of the structure --
2788 *
2789 * The scriptObj structure is used to represent both "script" objects
2790 * and "subst" objects. In the second case, the cmdStruct related
2791 * fields are not used at all, but there is an additional field used
2792 * that is 'substFlags': this represents the flags used to turn
2793 * the string into the intenral representation used to perform the
2794 * substitution. If this flags are not what the application requires
2795 * the scriptObj is created again. For example the script:
2796 *
2797 * subst -nocommands $string
2798 * subst -novariables $string
2799 *
2800 * Will recreate the internal representation of the $string object
2801 * two times.
2802 */
2803 typedef struct ScriptObj {
2804 int len; /* Length as number of tokens. */
2805 int commands; /* number of top-level commands in script. */
2806 ScriptToken *token; /* Tokens array. */
2807 int *cmdStruct; /* commands structure */
2808 int csLen; /* length of the cmdStruct array. */
2809 int substFlags; /* flags used for the compilation of "subst" objects */
2810 int inUse; /* Used to share a ScriptObj. Currently
2811 only used by Jim_EvalObj() as protection against
2812 shimmering of the currently evaluated object. */
2813 char *fileName;
2814 } ScriptObj;
2815
2816 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2817 {
2818 int i;
2819 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2820
2821 if (!script)
2822 return;
2823
2824 script->inUse--;
2825 if (script->inUse != 0) return;
2826 for (i = 0; i < script->len; i++) {
2827 if (script->token[i].objPtr != NULL)
2828 Jim_DecrRefCount(interp, script->token[i].objPtr);
2829 }
2830 Jim_Free(script->token);
2831 Jim_Free(script->cmdStruct);
2832 Jim_Free(script->fileName);
2833 Jim_Free(script);
2834 }
2835
2836 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2837 {
2838 JIM_NOTUSED(interp);
2839 JIM_NOTUSED(srcPtr);
2840
2841 /* Just returns an simple string. */
2842 dupPtr->typePtr = NULL;
2843 }
2844
2845 /* Add a new token to the internal repr of a script object */
2846 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2847 char *strtoken, int len, int type, char *filename, int linenr)
2848 {
2849 int prevtype;
2850 struct ScriptToken *token;
2851
2852 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2853 script->token[script->len-1].type;
2854 /* Skip tokens without meaning, like words separators
2855 * following a word separator or an end of command and
2856 * so on. */
2857 if (prevtype == JIM_TT_EOL) {
2858 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2859 Jim_Free(strtoken);
2860 return;
2861 }
2862 } else if (prevtype == JIM_TT_SEP) {
2863 if (type == JIM_TT_SEP) {
2864 Jim_Free(strtoken);
2865 return;
2866 } else if (type == JIM_TT_EOL) {
2867 /* If an EOL is following by a SEP, drop the previous
2868 * separator. */
2869 script->len--;
2870 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2871 }
2872 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2873 type == JIM_TT_ESC && len == 0)
2874 {
2875 /* Don't add empty tokens used in interpolation */
2876 Jim_Free(strtoken);
2877 return;
2878 }
2879 /* Make space for a new istruction */
2880 script->len++;
2881 script->token = Jim_Realloc(script->token,
2882 sizeof(ScriptToken)*script->len);
2883 /* Initialize the new token */
2884 token = script->token + (script->len-1);
2885 token->type = type;
2886 /* Every object is intially as a string, but the
2887 * internal type may be specialized during execution of the
2888 * script. */
2889 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2890 /* To add source info to SEP and EOL tokens is useless because
2891 * they will never by called as arguments of Jim_EvalObj(). */
2892 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2893 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2894 Jim_IncrRefCount(token->objPtr);
2895 token->linenr = linenr;
2896 }
2897
2898 /* Add an integer into the command structure field of the script object. */
2899 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2900 {
2901 script->csLen++;
2902 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2903 sizeof(int)*script->csLen);
2904 script->cmdStruct[script->csLen-1] = val;
2905 }
2906
2907 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2908 * of objPtr. Search nested script objects recursively. */
2909 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2910 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2911 {
2912 int i;
2913
2914 for (i = 0; i < script->len; i++) {
2915 if (script->token[i].objPtr != objPtr &&
2916 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2917 return script->token[i].objPtr;
2918 }
2919 /* Enter recursively on scripts only if the object
2920 * is not the same as the one we are searching for
2921 * shared occurrences. */
2922 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2923 script->token[i].objPtr != objPtr) {
2924 Jim_Obj *foundObjPtr;
2925
2926 ScriptObj *subScript =
2927 script->token[i].objPtr->internalRep.ptr;
2928 /* Don't recursively enter the script we are trying
2929 * to make shared to avoid circular references. */
2930 if (subScript == scriptBarrier) continue;
2931 if (subScript != script) {
2932 foundObjPtr =
2933 ScriptSearchLiteral(interp, subScript,
2934 scriptBarrier, objPtr);
2935 if (foundObjPtr != NULL)
2936 return foundObjPtr;
2937 }
2938 }
2939 }
2940 return NULL;
2941 }
2942
2943 /* Share literals of a script recursively sharing sub-scripts literals. */
2944 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2945 ScriptObj *topLevelScript)
2946 {
2947 int i, j;
2948
2949 return;
2950 /* Try to share with toplevel object. */
2951 if (topLevelScript != NULL) {
2952 for (i = 0; i < script->len; i++) {
2953 Jim_Obj *foundObjPtr;
2954 char *str = script->token[i].objPtr->bytes;
2955
2956 if (script->token[i].objPtr->refCount != 1) continue;
2957 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2958 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2959 foundObjPtr = ScriptSearchLiteral(interp,
2960 topLevelScript,
2961 script, /* barrier */
2962 script->token[i].objPtr);
2963 if (foundObjPtr != NULL) {
2964 Jim_IncrRefCount(foundObjPtr);
2965 Jim_DecrRefCount(interp,
2966 script->token[i].objPtr);
2967 script->token[i].objPtr = foundObjPtr;
2968 }
2969 }
2970 }
2971 /* Try to share locally */
2972 for (i = 0; i < script->len; i++) {
2973 char *str = script->token[i].objPtr->bytes;
2974
2975 if (script->token[i].objPtr->refCount != 1) continue;
2976 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2977 for (j = 0; j < script->len; j++) {
2978 if (script->token[i].objPtr !=
2979 script->token[j].objPtr &&
2980 Jim_StringEqObj(script->token[i].objPtr,
2981 script->token[j].objPtr, 0))
2982 {
2983 Jim_IncrRefCount(script->token[j].objPtr);
2984 Jim_DecrRefCount(interp,
2985 script->token[i].objPtr);
2986 script->token[i].objPtr =
2987 script->token[j].objPtr;
2988 }
2989 }
2990 }
2991 }
2992
2993 /* This method takes the string representation of an object
2994 * as a Tcl script, and generates the pre-parsed internal representation
2995 * of the script. */
2996 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2997 {
2998 int scriptTextLen;
2999 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3000 struct JimParserCtx parser;
3001 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3002 ScriptToken *token;
3003 int args, tokens, start, end, i;
3004 int initialLineNumber;
3005 int propagateSourceInfo = 0;
3006
3007 script->len = 0;
3008 script->csLen = 0;
3009 script->commands = 0;
3010 script->token = NULL;
3011 script->cmdStruct = NULL;
3012 script->inUse = 1;
3013 /* Try to get information about filename / line number */
3014 if (objPtr->typePtr == &sourceObjType) {
3015 script->fileName =
3016 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3017 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3018 propagateSourceInfo = 1;
3019 } else {
3020 script->fileName = Jim_StrDup("");
3021 initialLineNumber = 1;
3022 }
3023
3024 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3025 while (!JimParserEof(&parser)) {
3026 char *token_t;
3027 int len, type, linenr;
3028
3029 JimParseScript(&parser);
3030 token_t = JimParserGetToken(&parser, &len, &type, &linenr);
3031 ScriptObjAddToken(interp, script, token_t, len, type,
3032 propagateSourceInfo ? script->fileName : NULL,
3033 linenr);
3034 }
3035 token = script->token;
3036
3037 /* Compute the command structure array
3038 * (see the ScriptObj struct definition for more info) */
3039 start = 0; /* Current command start token index */
3040 end = -1; /* Current command end token index */
3041 while (1) {
3042 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3043 int interpolation = 0; /* set to 1 if there is at least one
3044 argument of the command obtained via
3045 interpolation of more tokens. */
3046 /* Search for the end of command, while
3047 * count the number of args. */
3048 start = ++end;
3049 if (start >= script->len) break;
3050 args = 1; /* Number of args in current command */
3051 while (token[end].type != JIM_TT_EOL) {
3052 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3053 token[end-1].type == JIM_TT_EOL)
3054 {
3055 if (token[end].type == JIM_TT_STR &&
3056 token[end + 1].type != JIM_TT_SEP &&
3057 token[end + 1].type != JIM_TT_EOL &&
3058 (!strcmp(token[end].objPtr->bytes, "expand") ||
3059 !strcmp(token[end].objPtr->bytes, "*")))
3060 expand++;
3061 }
3062 if (token[end].type == JIM_TT_SEP)
3063 args++;
3064 end++;
3065 }
3066 interpolation = !((end-start + 1) == args*2);
3067 /* Add the 'number of arguments' info into cmdstruct.
3068 * Negative value if there is list expansion involved. */
3069 if (expand)
3070 ScriptObjAddInt(script, -1);
3071 ScriptObjAddInt(script, args);
3072 /* Now add info about the number of tokens. */
3073 tokens = 0; /* Number of tokens in current argument. */
3074 expand = 0;
3075 for (i = start; i <= end; i++) {
3076 if (token[i].type == JIM_TT_SEP ||
3077 token[i].type == JIM_TT_EOL)
3078 {
3079 if (tokens == 1 && expand)
3080 expand = 0;
3081 ScriptObjAddInt(script,
3082 expand ? -tokens : tokens);
3083
3084 expand = 0;
3085 tokens = 0;
3086 continue;
3087 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3088 (!strcmp(token[i].objPtr->bytes, "expand") ||
3089 !strcmp(token[i].objPtr->bytes, "*")))
3090 {
3091 expand++;
3092 }
3093 tokens++;
3094 }
3095 }
3096 /* Perform literal sharing, but only for objects that appear
3097 * to be scripts written as literals inside the source code,
3098 * and not computed at runtime. Literal sharing is a costly
3099 * operation that should be done only against objects that
3100 * are likely to require compilation only the first time, and
3101 * then are executed multiple times. */
3102 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3103 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3104 if (bodyObjPtr->typePtr == &scriptObjType) {
3105 ScriptObj *bodyScript =
3106 bodyObjPtr->internalRep.ptr;
3107 ScriptShareLiterals(interp, script, bodyScript);
3108 }
3109 } else if (propagateSourceInfo) {
3110 ScriptShareLiterals(interp, script, NULL);
3111 }
3112 /* Free the old internal rep and set the new one. */
3113 Jim_FreeIntRep(interp, objPtr);
3114 Jim_SetIntRepPtr(objPtr, script);
3115 objPtr->typePtr = &scriptObjType;
3116 return JIM_OK;
3117 }
3118
3119 static ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3120 {
3121 if (objPtr->typePtr != &scriptObjType) {
3122 SetScriptFromAny(interp, objPtr);
3123 }
3124 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3125 }
3126
3127 /* -----------------------------------------------------------------------------
3128 * Commands
3129 * ---------------------------------------------------------------------------*/
3130
3131 /* Commands HashTable Type.
3132 *
3133 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3134 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3135 {
3136 Jim_Cmd *cmdPtr = (void*) val;
3137
3138 if (cmdPtr->cmdProc == NULL) {
3139 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3140 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3141 if (cmdPtr->staticVars) {
3142 Jim_FreeHashTable(cmdPtr->staticVars);
3143 Jim_Free(cmdPtr->staticVars);
3144 }
3145 } else if (cmdPtr->delProc != NULL) {
3146 /* If it was a C coded command, call the delProc if any */
3147 cmdPtr->delProc(interp, cmdPtr->privData);
3148 }
3149 Jim_Free(val);
3150 }
3151
3152 static Jim_HashTableType JimCommandsHashTableType = {
3153 JimStringCopyHTHashFunction, /* hash function */
3154 JimStringCopyHTKeyDup, /* key dup */
3155 NULL, /* val dup */
3156 JimStringCopyHTKeyCompare, /* key compare */
3157 JimStringCopyHTKeyDestructor, /* key destructor */
3158 Jim_CommandsHT_ValDestructor /* val destructor */
3159 };
3160
3161 /* ------------------------- Commands related functions --------------------- */
3162
3163 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3164 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3165 {
3166 Jim_HashEntry *he;
3167 Jim_Cmd *cmdPtr;
3168
3169 he = Jim_FindHashEntry(&interp->commands, cmdName);
3170 if (he == NULL) { /* New command to create */
3171 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3172 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3173 } else {
3174 Jim_InterpIncrProcEpoch(interp);
3175 /* Free the arglist/body objects if it was a Tcl procedure */
3176 cmdPtr = he->val;
3177 if (cmdPtr->cmdProc == NULL) {
3178 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3179 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3180 if (cmdPtr->staticVars) {
3181 Jim_FreeHashTable(cmdPtr->staticVars);
3182 Jim_Free(cmdPtr->staticVars);
3183 }
3184 cmdPtr->staticVars = NULL;
3185 } else if (cmdPtr->delProc != NULL) {
3186 /* If it was a C coded command, call the delProc if any */
3187 cmdPtr->delProc(interp, cmdPtr->privData);
3188 }
3189 }
3190
3191 /* Store the new details for this proc */
3192 cmdPtr->delProc = delProc;
3193 cmdPtr->cmdProc = cmdProc;
3194 cmdPtr->privData = privData;
3195
3196 /* There is no need to increment the 'proc epoch' because
3197 * creation of a new procedure can never affect existing
3198 * cached commands. We don't do negative caching. */
3199 return JIM_OK;
3200 }
3201
3202 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3203 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3204 int arityMin, int arityMax)
3205 {
3206 Jim_Cmd *cmdPtr;
3207
3208 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3209 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3210 cmdPtr->argListObjPtr = argListObjPtr;
3211 cmdPtr->bodyObjPtr = bodyObjPtr;
3212 Jim_IncrRefCount(argListObjPtr);
3213 Jim_IncrRefCount(bodyObjPtr);
3214 cmdPtr->arityMin = arityMin;
3215 cmdPtr->arityMax = arityMax;
3216 cmdPtr->staticVars = NULL;
3217
3218 /* Create the statics hash table. */
3219 if (staticsListObjPtr) {
3220 int len, i;
3221
3222 Jim_ListLength(interp, staticsListObjPtr, &len);
3223 if (len != 0) {
3224 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3225 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3226 interp);
3227 for (i = 0; i < len; i++) {
3228 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3229 Jim_Var *varPtr;
3230 int subLen;
3231
3232 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3233 /* Check if it's composed of two elements. */
3234 Jim_ListLength(interp, objPtr, &subLen);
3235 if (subLen == 1 || subLen == 2) {
3236 /* Try to get the variable value from the current
3237 * environment. */
3238 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3239 if (subLen == 1) {
3240 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3241 JIM_NONE);
3242 if (initObjPtr == NULL) {
3243 Jim_SetResult(interp,
3244 Jim_NewEmptyStringObj(interp));
3245 Jim_AppendStrings(interp, Jim_GetResult(interp),
3246 "variable for initialization of static \"",
3247 Jim_GetString(nameObjPtr, NULL),
3248 "\" not found in the local context",
3249 NULL);
3250 goto err;
3251 }
3252 } else {
3253 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3254 }
3255 varPtr = Jim_Alloc(sizeof(*varPtr));
3256 varPtr->objPtr = initObjPtr;
3257 Jim_IncrRefCount(initObjPtr);
3258 varPtr->linkFramePtr = NULL;
3259 if (Jim_AddHashEntry(cmdPtr->staticVars,
3260 Jim_GetString(nameObjPtr, NULL),
3261 varPtr) != JIM_OK)
3262 {
3263 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3264 Jim_AppendStrings(interp, Jim_GetResult(interp),
3265 "static variable name \"",
3266 Jim_GetString(objPtr, NULL), "\"",
3267 " duplicated in statics list", NULL);
3268 Jim_DecrRefCount(interp, initObjPtr);
3269 Jim_Free(varPtr);
3270 goto err;
3271 }
3272 } else {
3273 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274 Jim_AppendStrings(interp, Jim_GetResult(interp),
3275 "too many fields in static specifier \"",
3276 objPtr, "\"", NULL);
3277 goto err;
3278 }
3279 }
3280 }
3281 }
3282
3283 /* Add the new command */
3284
3285 /* it may already exist, so we try to delete the old one */
3286 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3287 /* There was an old procedure with the same name, this requires
3288 * a 'proc epoch' update. */
3289 Jim_InterpIncrProcEpoch(interp);
3290 }
3291 /* If a procedure with the same name didn't existed there is no need
3292 * to increment the 'proc epoch' because creation of a new procedure
3293 * can never affect existing cached commands. We don't do
3294 * negative caching. */
3295 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3296 return JIM_OK;
3297
3298 err:
3299 Jim_FreeHashTable(cmdPtr->staticVars);
3300 Jim_Free(cmdPtr->staticVars);
3301 Jim_DecrRefCount(interp, argListObjPtr);
3302 Jim_DecrRefCount(interp, bodyObjPtr);
3303 Jim_Free(cmdPtr);
3304 return JIM_ERR;
3305 }
3306
3307 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3308 {
3309 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3310 return JIM_ERR;
3311 Jim_InterpIncrProcEpoch(interp);
3312 return JIM_OK;
3313 }
3314
3315 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3316 const char *newName)
3317 {
3318 Jim_Cmd *cmdPtr;
3319 Jim_HashEntry *he;
3320 Jim_Cmd *copyCmdPtr;
3321
3322 if (newName[0] == '\0') /* Delete! */
3323 return Jim_DeleteCommand(interp, oldName);
3324 /* Rename */
3325 he = Jim_FindHashEntry(&interp->commands, oldName);
3326 if (he == NULL)
3327 return JIM_ERR; /* Invalid command name */
3328 cmdPtr = he->val;
3329 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3330 *copyCmdPtr = *cmdPtr;
3331 /* In order to avoid that a procedure will get arglist/body/statics
3332 * freed by the hash table methods, fake a C-coded command
3333 * setting cmdPtr->cmdProc as not NULL */
3334 cmdPtr->cmdProc = (void*)1;
3335 /* Also make sure delProc is NULL. */
3336 cmdPtr->delProc = NULL;
3337 /* Destroy the old command, and make sure the new is freed
3338 * as well. */
3339 Jim_DeleteHashEntry(&interp->commands, oldName);
3340 Jim_DeleteHashEntry(&interp->commands, newName);
3341 /* Now the new command. We are sure it can't fail because
3342 * the target name was already freed. */
3343 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3344 /* Increment the epoch */
3345 Jim_InterpIncrProcEpoch(interp);
3346 return JIM_OK;
3347 }
3348
3349 /* -----------------------------------------------------------------------------
3350 * Command object
3351 * ---------------------------------------------------------------------------*/
3352
3353 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3354
3355 static Jim_ObjType commandObjType = {
3356 "command",
3357 NULL,
3358 NULL,
3359 NULL,
3360 JIM_TYPE_REFERENCES,
3361 };
3362
3363 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3364 {
3365 Jim_HashEntry *he;
3366 const char *cmdName;
3367
3368 /* Get the string representation */
3369 cmdName = Jim_GetString(objPtr, NULL);
3370 /* Lookup this name into the commands hash table */
3371 he = Jim_FindHashEntry(&interp->commands, cmdName);
3372 if (he == NULL)
3373 return JIM_ERR;
3374
3375 /* Free the old internal repr and set the new one. */
3376 Jim_FreeIntRep(interp, objPtr);
3377 objPtr->typePtr = &commandObjType;
3378 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3379 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3380 return JIM_OK;
3381 }
3382
3383 /* This function returns the command structure for the command name
3384 * stored in objPtr. It tries to specialize the objPtr to contain
3385 * a cached info instead to perform the lookup into the hash table
3386 * every time. The information cached may not be uptodate, in such
3387 * a case the lookup is performed and the cache updated. */
3388 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3389 {
3390 if ((objPtr->typePtr != &commandObjType ||
3391 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3392 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3393 if (flags & JIM_ERRMSG) {
3394 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3395 Jim_AppendStrings(interp, Jim_GetResult(interp),
3396 "invalid command name \"", objPtr->bytes, "\"",
3397 NULL);
3398 }
3399 return NULL;
3400 }
3401 return objPtr->internalRep.cmdValue.cmdPtr;
3402 }
3403
3404 /* -----------------------------------------------------------------------------
3405 * Variables
3406 * ---------------------------------------------------------------------------*/
3407
3408 /* Variables HashTable Type.
3409 *
3410 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3411 static void JimVariablesHTValDestructor(void *interp, void *val)
3412 {
3413 Jim_Var *varPtr = (void*) val;
3414
3415 Jim_DecrRefCount(interp, varPtr->objPtr);
3416 Jim_Free(val);
3417 }
3418
3419 static Jim_HashTableType JimVariablesHashTableType = {
3420 JimStringCopyHTHashFunction, /* hash function */
3421 JimStringCopyHTKeyDup, /* key dup */
3422 NULL, /* val dup */
3423 JimStringCopyHTKeyCompare, /* key compare */
3424 JimStringCopyHTKeyDestructor, /* key destructor */
3425 JimVariablesHTValDestructor /* val destructor */
3426 };
3427
3428 static Jim_HashTableType *getJimVariablesHashTableType(void)
3429 {
3430 return &JimVariablesHashTableType;
3431 }
3432
3433 /* -----------------------------------------------------------------------------
3434 * Variable object
3435 * ---------------------------------------------------------------------------*/
3436
3437 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3438
3439 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3440
3441 static Jim_ObjType variableObjType = {
3442 "variable",
3443 NULL,
3444 NULL,
3445 NULL,
3446 JIM_TYPE_REFERENCES,
3447 };
3448
3449 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3450 * is in the form "varname(key)". */
3451 static int Jim_NameIsDictSugar(const char *str, int len)
3452 {
3453 if (len == -1)
3454 len = strlen(str);
3455 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3456 return 1;
3457 return 0;
3458 }
3459
3460 /* This method should be called only by the variable API.
3461 * It returns JIM_OK on success (variable already exists),
3462 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3463 * a variable name, but syntax glue for [dict] i.e. the last
3464 * character is ')' */
3465 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3466 {
3467 Jim_HashEntry *he;
3468 const char *varName;
3469 int len;
3470
3471 /* Check if the object is already an uptodate variable */
3472 if (objPtr->typePtr == &variableObjType &&
3473 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3474 return JIM_OK; /* nothing to do */
3475 /* Get the string representation */
3476 varName = Jim_GetString(objPtr, &len);
3477 /* Make sure it's not syntax glue to get/set dict. */
3478 if (Jim_NameIsDictSugar(varName, len))
3479 return JIM_DICT_SUGAR;
3480 if (varName[0] == ':' && varName[1] == ':') {
3481 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3482 if (he == NULL) {
3483 return JIM_ERR;
3484 }
3485 }
3486 else {
3487 /* Lookup this name into the variables hash table */
3488 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3489 if (he == NULL) {
3490 /* Try with static vars. */
3491 if (interp->framePtr->staticVars == NULL)
3492 return JIM_ERR;
3493 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3494 return JIM_ERR;
3495 }
3496 }
3497 /* Free the old internal repr and set the new one. */
3498 Jim_FreeIntRep(interp, objPtr);
3499 objPtr->typePtr = &variableObjType;
3500 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3501 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3502 return JIM_OK;
3503 }
3504
3505 /* -------------------- Variables related functions ------------------------- */
3506 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3507 Jim_Obj *valObjPtr);
3508 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3509
3510 /* For now that's dummy. Variables lookup should be optimized
3511 * in many ways, with caching of lookups, and possibly with
3512 * a table of pre-allocated vars in every CallFrame for local vars.
3513 * All the caching should also have an 'epoch' mechanism similar
3514 * to the one used by Tcl for procedures lookup caching. */
3515
3516 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3517 {
3518 const char *name;
3519 Jim_Var *var;
3520 int err;
3521
3522 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3523 /* Check for [dict] syntax sugar. */
3524 if (err == JIM_DICT_SUGAR)
3525 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3526 /* New variable to create */
3527 name = Jim_GetString(nameObjPtr, NULL);
3528
3529 var = Jim_Alloc(sizeof(*var));
3530 var->objPtr = valObjPtr;
3531 Jim_IncrRefCount(valObjPtr);
3532 var->linkFramePtr = NULL;
3533 /* Insert the new variable */
3534 if (name[0] == ':' && name[1] == ':') {
3535 /* Into to the top evel frame */
3536 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3537 }
3538 else {
3539 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3540 }
3541 /* Make the object int rep a variable */
3542 Jim_FreeIntRep(interp, nameObjPtr);
3543 nameObjPtr->typePtr = &variableObjType;
3544 nameObjPtr->internalRep.varValue.callFrameId =
3545 interp->framePtr->id;
3546 nameObjPtr->internalRep.varValue.varPtr = var;
3547 } else {
3548 var = nameObjPtr->internalRep.varValue.varPtr;
3549 if (var->linkFramePtr == NULL) {
3550 Jim_IncrRefCount(valObjPtr);
3551 Jim_DecrRefCount(interp, var->objPtr);
3552 var->objPtr = valObjPtr;
3553 } else { /* Else handle the link */
3554 Jim_CallFrame *savedCallFrame;
3555
3556 savedCallFrame = interp->framePtr;
3557 interp->framePtr = var->linkFramePtr;
3558 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3559 interp->framePtr = savedCallFrame;
3560 if (err != JIM_OK)
3561 return err;
3562 }
3563 }
3564 return JIM_OK;
3565 }
3566
3567 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3568 {
3569 Jim_Obj *nameObjPtr;
3570 int result;
3571
3572 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3573 Jim_IncrRefCount(nameObjPtr);
3574 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3575 Jim_DecrRefCount(interp, nameObjPtr);
3576 return result;
3577 }
3578
3579 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3580 {
3581 Jim_CallFrame *savedFramePtr;
3582 int result;
3583
3584 savedFramePtr = interp->framePtr;
3585 interp->framePtr = interp->topFramePtr;
3586 result = Jim_SetVariableStr(interp, name, objPtr);
3587 interp->framePtr = savedFramePtr;
3588 return result;
3589 }
3590
3591 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3592 {
3593 Jim_Obj *nameObjPtr, *valObjPtr;
3594 int result;
3595
3596 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3597 valObjPtr = Jim_NewStringObj(interp, val, -1);
3598 Jim_IncrRefCount(nameObjPtr);
3599 Jim_IncrRefCount(valObjPtr);
3600 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3601 Jim_DecrRefCount(interp, nameObjPtr);
3602 Jim_DecrRefCount(interp, valObjPtr);
3603 return result;
3604 }
3605
3606 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3607 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3608 {
3609 const char *varName;
3610 int len;
3611
3612 /* Check for cycles. */
3613 if (interp->framePtr == targetCallFrame) {
3614 Jim_Obj *objPtr = targetNameObjPtr;
3615 Jim_Var *varPtr;
3616 /* Cycles are only possible with 'uplevel 0' */
3617 while (1) {
3618 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3619 Jim_SetResultString(interp,
3620 "can't upvar from variable to itself", -1);
3621 return JIM_ERR;
3622 }
3623 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3624 break;
3625 varPtr = objPtr->internalRep.varValue.varPtr;
3626 if (varPtr->linkFramePtr != targetCallFrame) break;
3627 objPtr = varPtr->objPtr;
3628 }
3629 }
3630 varName = Jim_GetString(nameObjPtr, &len);
3631 if (Jim_NameIsDictSugar(varName, len)) {
3632 Jim_SetResultString(interp,
3633 "Dict key syntax invalid as link source", -1);
3634 return JIM_ERR;
3635 }
3636 /* Perform the binding */
3637 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3638 /* We are now sure 'nameObjPtr' type is variableObjType */
3639 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3640 return JIM_OK;
3641 }
3642
3643 /* Return the Jim_Obj pointer associated with a variable name,
3644 * or NULL if the variable was not found in the current context.
3645 * The same optimization discussed in the comment to the
3646 * 'SetVariable' function should apply here. */
3647 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3648 {
3649 int err;
3650
3651 /* All the rest is handled here */
3652 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3653 /* Check for [dict] syntax sugar. */
3654 if (err == JIM_DICT_SUGAR)
3655 return JimDictSugarGet(interp, nameObjPtr);
3656 if (flags & JIM_ERRMSG) {
3657 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3658 Jim_AppendStrings(interp, Jim_GetResult(interp),
3659 "can't read \"", nameObjPtr->bytes,
3660 "\": no such variable", NULL);
3661 }
3662 return NULL;
3663 } else {
3664 Jim_Var *varPtr;
3665 Jim_Obj *objPtr;
3666 Jim_CallFrame *savedCallFrame;
3667
3668 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3669 if (varPtr->linkFramePtr == NULL)
3670 return varPtr->objPtr;
3671 /* The variable is a link? Resolve it. */
3672 savedCallFrame = interp->framePtr;
3673 interp->framePtr = varPtr->linkFramePtr;
3674 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3675 if (objPtr == NULL && flags & JIM_ERRMSG) {
3676 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3677 Jim_AppendStrings(interp, Jim_GetResult(interp),
3678 "can't read \"", nameObjPtr->bytes,
3679 "\": no such variable", NULL);
3680 }
3681 interp->framePtr = savedCallFrame;
3682 return objPtr;
3683 }
3684 }
3685
3686 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3687 int flags)
3688 {
3689 Jim_CallFrame *savedFramePtr;
3690 Jim_Obj *objPtr;
3691
3692 savedFramePtr = interp->framePtr;
3693 interp->framePtr = interp->topFramePtr;
3694 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3695 interp->framePtr = savedFramePtr;
3696
3697 return objPtr;
3698 }
3699
3700 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3701 {
3702 Jim_Obj *nameObjPtr, *varObjPtr;
3703
3704 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3705 Jim_IncrRefCount(nameObjPtr);
3706 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3707 Jim_DecrRefCount(interp, nameObjPtr);
3708 return varObjPtr;
3709 }
3710
3711 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3712 int flags)
3713 {
3714 Jim_CallFrame *savedFramePtr;
3715 Jim_Obj *objPtr;
3716
3717 savedFramePtr = interp->framePtr;
3718 interp->framePtr = interp->topFramePtr;
3719 objPtr = Jim_GetVariableStr(interp, name, flags);
3720 interp->framePtr = savedFramePtr;
3721
3722 return objPtr;
3723 }
3724
3725 /* Unset a variable.
3726 * Note: On success unset invalidates all the variable objects created
3727 * in the current call frame incrementing. */
3728 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3729 {
3730 const char *name;
3731 Jim_Var *varPtr;
3732 int err;
3733
3734 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3735 /* Check for [dict] syntax sugar. */
3736 if (err == JIM_DICT_SUGAR)
3737 return JimDictSugarSet(interp, nameObjPtr, NULL);
3738 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3739 Jim_AppendStrings(interp, Jim_GetResult(interp),
3740 "can't unset \"", nameObjPtr->bytes,
3741 "\": no such variable", NULL);
3742 return JIM_ERR; /* var not found */
3743 }
3744 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3745 /* If it's a link call UnsetVariable recursively */
3746 if (varPtr->linkFramePtr) {
3747 int retval;
3748
3749 Jim_CallFrame *savedCallFrame;
3750
3751 savedCallFrame = interp->framePtr;
3752 interp->framePtr = varPtr->linkFramePtr;
3753 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3754 interp->framePtr = savedCallFrame;
3755 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3756 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3757 Jim_AppendStrings(interp, Jim_GetResult(interp),
3758 "can't unset \"", nameObjPtr->bytes,
3759 "\": no such variable", NULL);
3760 }
3761 return retval;
3762 } else {
3763 name = Jim_GetString(nameObjPtr, NULL);
3764 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3765 != JIM_OK) return JIM_ERR;
3766 /* Change the callframe id, invalidating var lookup caching */
3767 JimChangeCallFrameId(interp, interp->framePtr);
3768 return JIM_OK;
3769 }
3770 }
3771
3772 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3773
3774 /* Given a variable name for [dict] operation syntax sugar,
3775 * this function returns two objects, the first with the name
3776 * of the variable to set, and the second with the rispective key.
3777 * For example "foo(bar)" will return objects with string repr. of
3778 * "foo" and "bar".
3779 *
3780 * The returned objects have refcount = 1. The function can't fail. */
3781 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3782 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3783 {
3784 const char *str, *p;
3785 char *t;
3786 int len, keyLen, nameLen;
3787 Jim_Obj *varObjPtr, *keyObjPtr;
3788
3789 str = Jim_GetString(objPtr, &len);
3790 p = strchr(str, '(');
3791 p++;
3792 keyLen = len-((p-str) + 1);
3793 nameLen = (p-str)-1;
3794 /* Create the objects with the variable name and key. */
3795 t = Jim_Alloc(nameLen + 1);
3796 memcpy(t, str, nameLen);
3797 t[nameLen] = '\0';
3798 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3799
3800 t = Jim_Alloc(keyLen + 1);
3801 memcpy(t, p, keyLen);
3802 t[keyLen] = '\0';
3803 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3804
3805 Jim_IncrRefCount(varObjPtr);
3806 Jim_IncrRefCount(keyObjPtr);
3807 *varPtrPtr = varObjPtr;
3808 *keyPtrPtr = keyObjPtr;
3809 }
3810
3811 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3812 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3813 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3814 Jim_Obj *valObjPtr)
3815 {
3816 Jim_Obj *varObjPtr, *keyObjPtr;
3817 int err = JIM_OK;
3818
3819 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3820 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3821 valObjPtr);
3822 Jim_DecrRefCount(interp, varObjPtr);
3823 Jim_DecrRefCount(interp, keyObjPtr);
3824 return err;
3825 }
3826
3827 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3828 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3829 {
3830 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3831
3832 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3833 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3834 if (!dictObjPtr) {
3835 resObjPtr = NULL;
3836 goto err;
3837 }
3838 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3839 != JIM_OK) {
3840 resObjPtr = NULL;
3841 }
3842 err:
3843 Jim_DecrRefCount(interp, varObjPtr);
3844 Jim_DecrRefCount(interp, keyObjPtr);
3845 return resObjPtr;
3846 }
3847
3848 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3849
3850 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3851 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3852 Jim_Obj *dupPtr);
3853
3854 static Jim_ObjType dictSubstObjType = {
3855 "dict-substitution",
3856 FreeDictSubstInternalRep,
3857 DupDictSubstInternalRep,
3858 NULL,
3859 JIM_TYPE_NONE,
3860 };
3861
3862 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3863 {
3864 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3865 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3866 }
3867
3868 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3869 Jim_Obj *dupPtr)
3870 {
3871 JIM_NOTUSED(interp);
3872
3873 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3874 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3875 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3876 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3877 dupPtr->typePtr = &dictSubstObjType;
3878 }
3879
3880 /* This function is used to expand [dict get] sugar in the form
3881 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3882 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3883 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3884 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3885 * the [dict]ionary contained in variable VARNAME. */
3886 static Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3887 {
3888 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3889 Jim_Obj *substKeyObjPtr = NULL;
3890
3891 if (objPtr->typePtr != &dictSubstObjType) {
3892 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3893 Jim_FreeIntRep(interp, objPtr);
3894 objPtr->typePtr = &dictSubstObjType;
3895 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3896 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3897 }
3898 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3899 &substKeyObjPtr, JIM_NONE)
3900 != JIM_OK) {
3901 substKeyObjPtr = NULL;
3902 goto err;
3903 }
3904 Jim_IncrRefCount(substKeyObjPtr);
3905 dictObjPtr = Jim_GetVariable(interp,
3906 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3907 if (!dictObjPtr) {
3908 resObjPtr = NULL;
3909 goto err;
3910 }
3911 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3912 != JIM_OK) {
3913 resObjPtr = NULL;
3914 goto err;
3915 }
3916 err:
3917 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3918 return resObjPtr;
3919 }
3920
3921 /* -----------------------------------------------------------------------------
3922 * CallFrame
3923 * ---------------------------------------------------------------------------*/
3924
3925 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3926 {
3927 Jim_CallFrame *cf;
3928 if (interp->freeFramesList) {
3929 cf = interp->freeFramesList;
3930 interp->freeFramesList = cf->nextFramePtr;
3931 } else {
3932 cf = Jim_Alloc(sizeof(*cf));
3933 cf->vars.table = NULL;
3934 }
3935
3936 cf->id = interp->callFrameEpoch++;
3937 cf->parentCallFrame = NULL;
3938 cf->argv = NULL;
3939 cf->argc = 0;
3940 cf->procArgsObjPtr = NULL;
3941 cf->procBodyObjPtr = NULL;
3942 cf->nextFramePtr = NULL;
3943 cf->staticVars = NULL;
3944 if (cf->vars.table == NULL)
3945 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3946 return cf;
3947 }
3948
3949 /* Used to invalidate every caching related to callframe stability. */
3950 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3951 {
3952 cf->id = interp->callFrameEpoch++;
3953 }
3954
3955 #define JIM_FCF_NONE 0 /* no flags */
3956 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3957 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3958 int flags)
3959 {
3960 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3961 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3962 if (!(flags & JIM_FCF_NOHT))
3963 Jim_FreeHashTable(&cf->vars);
3964 else {
3965 int i;
3966 Jim_HashEntry **table = cf->vars.table, *he;
3967
3968 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3969 he = table[i];
3970 while (he != NULL) {
3971 Jim_HashEntry *nextEntry = he->next;
3972 Jim_Var *varPtr = (void*) he->val;
3973
3974 Jim_DecrRefCount(interp, varPtr->objPtr);
3975 Jim_Free(he->val);
3976 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3977 Jim_Free(he);
3978 table[i] = NULL;
3979 he = nextEntry;
3980 }
3981 }
3982 cf->vars.used = 0;
3983 }
3984 cf->nextFramePtr = interp->freeFramesList;
3985 interp->freeFramesList = cf;
3986 }
3987
3988 /* -----------------------------------------------------------------------------
3989 * References
3990 * ---------------------------------------------------------------------------*/
3991
3992 /* References HashTable Type.
3993 *
3994 * Keys are jim_wide integers, dynamically allocated for now but in the
3995 * future it's worth to cache this 8 bytes objects. Values are poitners
3996 * to Jim_References. */
3997 static void JimReferencesHTValDestructor(void *interp, void *val)
3998 {
3999 Jim_Reference *refPtr = (void*) val;
4000
4001 Jim_DecrRefCount(interp, refPtr->objPtr);
4002 if (refPtr->finalizerCmdNamePtr != NULL) {
4003 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4004 }
4005 Jim_Free(val);
4006 }
4007
4008 static unsigned int JimReferencesHTHashFunction(const void *key)
4009 {
4010 /* Only the least significant bits are used. */
4011 const jim_wide *widePtr = key;
4012 unsigned int intValue = (unsigned int) *widePtr;
4013 return Jim_IntHashFunction(intValue);
4014 }
4015
4016 static const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4017 {
4018 void *copy = Jim_Alloc(sizeof(jim_wide));
4019 JIM_NOTUSED(privdata);
4020
4021 memcpy(copy, key, sizeof(jim_wide));
4022 return copy;
4023 }
4024
4025 static int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4026 const void *key2)
4027 {
4028 JIM_NOTUSED(privdata);
4029
4030 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4031 }
4032
4033 static void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4034 {
4035 JIM_NOTUSED(privdata);
4036
4037 Jim_Free((void*)key);
4038 }
4039
4040 static Jim_HashTableType JimReferencesHashTableType = {
4041 JimReferencesHTHashFunction, /* hash function */
4042 JimReferencesHTKeyDup, /* key dup */
4043 NULL, /* val dup */
4044 JimReferencesHTKeyCompare, /* key compare */
4045 JimReferencesHTKeyDestructor, /* key destructor */
4046 JimReferencesHTValDestructor /* val destructor */
4047 };
4048
4049 /* -----------------------------------------------------------------------------
4050 * Reference object type and References API
4051 * ---------------------------------------------------------------------------*/
4052
4053 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4054
4055 static Jim_ObjType referenceObjType = {
4056 "reference",
4057 NULL,
4058 NULL,
4059 UpdateStringOfReference,
4060 JIM_TYPE_REFERENCES,
4061 };
4062
4063 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4064 {
4065 int len;
4066 char buf[JIM_REFERENCE_SPACE + 1];
4067 Jim_Reference *refPtr;
4068
4069 refPtr = objPtr->internalRep.refValue.refPtr;
4070 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4071 objPtr->bytes = Jim_Alloc(len + 1);
4072 memcpy(objPtr->bytes, buf, len + 1);
4073 objPtr->length = len;
4074 }
4075
4076 /* returns true if 'c' is a valid reference tag character.
4077 * i.e. inside the range [_a-zA-Z0-9] */
4078 static int isrefchar(int c)
4079 {
4080 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4081 (c >= '0' && c <= '9')) return 1;
4082 return 0;
4083 }
4084
4085 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4086 {
4087 jim_wide wideValue;
4088 int i, len;
4089 const char *str, *start, *end;
4090 char refId[21];
4091 Jim_Reference *refPtr;
4092 Jim_HashEntry *he;
4093
4094 /* Get the string representation */
4095 str = Jim_GetString(objPtr, &len);
4096 /* Check if it looks like a reference */
4097 if (len < JIM_REFERENCE_SPACE) goto badformat;
4098 /* Trim spaces */
4099 start = str;
4100 end = str + len-1;
4101 while (*start == ' ') start++;
4102 while (*end == ' ' && end > start) end--;
4103 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4104 /* <reference.<1234567>.%020> */
4105 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4106 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4107 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4108 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4109 if (!isrefchar(start[12 + i])) goto badformat;
4110 }
4111 /* Extract info from the refernece. */
4112 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4113 refId[20] = '\0';
4114 /* Try to convert the ID into a jim_wide */
4115 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4116 /* Check if the reference really exists! */
4117 he = Jim_FindHashEntry(&interp->references, &wideValue);
4118 if (he == NULL) {
4119 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4120 Jim_AppendStrings(interp, Jim_GetResult(interp),
4121 "Invalid reference ID \"", str, "\"", NULL);
4122 return JIM_ERR;
4123 }
4124 refPtr = he->val;
4125 /* Free the old internal repr and set the new one. */
4126 Jim_FreeIntRep(interp, objPtr);
4127 objPtr->typePtr = &referenceObjType;
4128 objPtr->internalRep.refValue.id = wideValue;
4129 objPtr->internalRep.refValue.refPtr = refPtr;
4130 return JIM_OK;
4131
4132 badformat:
4133 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4134 Jim_AppendStrings(interp, Jim_GetResult(interp),
4135 "expected reference but got \"", str, "\"", NULL);
4136 return JIM_ERR;
4137 }
4138
4139 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4140 * as finalizer command (or NULL if there is no finalizer).
4141 * The returned reference object has refcount = 0. */
4142 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4143 Jim_Obj *cmdNamePtr)
4144 {
4145 struct Jim_Reference *refPtr;
4146 jim_wide wideValue = interp->referenceNextId;
4147 Jim_Obj *refObjPtr;
4148 const char *tag;
4149 int tagLen, i;
4150
4151 /* Perform the Garbage Collection if needed. */
4152 Jim_CollectIfNeeded(interp);
4153
4154 refPtr = Jim_Alloc(sizeof(*refPtr));
4155 refPtr->objPtr = objPtr;
4156 Jim_IncrRefCount(objPtr);
4157 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4158 if (cmdNamePtr)
4159 Jim_IncrRefCount(cmdNamePtr);
4160 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4161 refObjPtr = Jim_NewObj(interp);
4162 refObjPtr->typePtr = &referenceObjType;
4163 refObjPtr->bytes = NULL;
4164 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4165 refObjPtr->internalRep.refValue.refPtr = refPtr;
4166 interp->referenceNextId++;
4167 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4168 * that does not pass the 'isrefchar' test is replaced with '_' */
4169 tag = Jim_GetString(tagPtr, &tagLen);
4170 if (tagLen > JIM_REFERENCE_TAGLEN)
4171 tagLen = JIM_REFERENCE_TAGLEN;
4172 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4173 if (i < tagLen)
4174 refPtr->tag[i] = tag[i];
4175 else
4176 refPtr->tag[i] = '_';
4177 }
4178 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4179 return refObjPtr;
4180 }
4181
4182 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4183 {
4184 if (objPtr->typePtr != &referenceObjType &&
4185 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4186 return NULL;
4187 return objPtr->internalRep.refValue.refPtr;
4188 }
4189
4190 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4191 {
4192 Jim_Reference *refPtr;
4193
4194 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4195 return JIM_ERR;
4196 Jim_IncrRefCount(cmdNamePtr);
4197 if (refPtr->finalizerCmdNamePtr)
4198 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4199 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4200 return JIM_OK;
4201 }
4202
4203 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4204 {
4205 Jim_Reference *refPtr;
4206
4207 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4208 return JIM_ERR;
4209 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4210 return JIM_OK;
4211 }
4212
4213 /* -----------------------------------------------------------------------------
4214 * References Garbage Collection
4215 * ---------------------------------------------------------------------------*/
4216
4217 /* This the hash table type for the "MARK" phase of the GC */
4218 static Jim_HashTableType JimRefMarkHashTableType = {
4219 JimReferencesHTHashFunction, /* hash function */
4220 JimReferencesHTKeyDup, /* key dup */
4221 NULL, /* val dup */
4222 JimReferencesHTKeyCompare, /* key compare */
4223 JimReferencesHTKeyDestructor, /* key destructor */
4224 NULL /* val destructor */
4225 };
4226
4227 /* #define JIM_DEBUG_GC 1 */
4228
4229 /* Performs the garbage collection. */
4230 int Jim_Collect(Jim_Interp *interp)
4231 {
4232 Jim_HashTable marks;
4233 Jim_HashTableIterator *htiter;
4234 Jim_HashEntry *he;
4235 Jim_Obj *objPtr;
4236 int collected = 0;
4237
4238 /* Avoid recursive calls */
4239 if (interp->lastCollectId == -1) {
4240 /* Jim_Collect() already running. Return just now. */
4241 return 0;
4242 }
4243 interp->lastCollectId = -1;
4244
4245 /* Mark all the references found into the 'mark' hash table.
4246 * The references are searched in every live object that
4247 * is of a type that can contain references. */
4248 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4249 objPtr = interp->liveList;
4250 while (objPtr) {
4251 if (objPtr->typePtr == NULL ||
4252 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4253 const char *str, *p;
4254 int len;
4255
4256 /* If the object is of type reference, to get the
4257 * Id is simple... */
4258 if (objPtr->typePtr == &referenceObjType) {
4259 Jim_AddHashEntry(&marks,
4260 &objPtr->internalRep.refValue.id, NULL);
4261 #ifdef JIM_DEBUG_GC
4262 Jim_fprintf(interp,interp->cookie_stdout,
4263 "MARK (reference): %d refcount: %d" JIM_NL,
4264 (int) objPtr->internalRep.refValue.id,
4265 objPtr->refCount);
4266 #endif
4267 objPtr = objPtr->nextObjPtr;
4268 continue;
4269 }
4270 /* Get the string repr of the object we want
4271 * to scan for references. */
4272 p = str = Jim_GetString(objPtr, &len);
4273 /* Skip objects too little to contain references. */
4274 if (len < JIM_REFERENCE_SPACE) {
4275 objPtr = objPtr->nextObjPtr;
4276 continue;
4277 }
4278 /* Extract references from the object string repr. */
4279 while (1) {
4280 int i;
4281 jim_wide id;
4282 char buf[21];
4283
4284 if ((p = strstr(p, "<reference.<")) == NULL)
4285 break;
4286 /* Check if it's a valid reference. */
4287 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4288 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4289 for (i = 21; i <= 40; i++)
4290 if (!isdigit((int)p[i]))
4291 break;
4292 /* Get the ID */
4293 memcpy(buf, p + 21, 20);
4294 buf[20] = '\0';
4295 Jim_StringToWide(buf, &id, 10);
4296
4297 /* Ok, a reference for the given ID
4298 * was found. Mark it. */
4299 Jim_AddHashEntry(&marks, &id, NULL);
4300 #ifdef JIM_DEBUG_GC
4301 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4302 #endif
4303 p += JIM_REFERENCE_SPACE;
4304 }
4305 }
4306 objPtr = objPtr->nextObjPtr;
4307 }
4308
4309 /* Run the references hash table to destroy every reference that
4310 * is not referenced outside (not present in the mark HT). */
4311 htiter = Jim_GetHashTableIterator(&interp->references);
4312 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4313 const jim_wide *refId;
4314 Jim_Reference *refPtr;
4315
4316 refId = he->key;
4317 /* Check if in the mark phase we encountered
4318 * this reference. */
4319 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4320 #ifdef JIM_DEBUG_GC
4321 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4322 #endif
4323 collected++;
4324 /* Drop the reference, but call the
4325 * finalizer first if registered. */
4326 refPtr = he->val;
4327 if (refPtr->finalizerCmdNamePtr) {
4328 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4329 Jim_Obj *objv[3], *oldResult;
4330
4331 JimFormatReference(refstr, refPtr, *refId);
4332
4333 objv[0] = refPtr->finalizerCmdNamePtr;
4334 objv[1] = Jim_NewStringObjNoAlloc(interp,
4335 refstr, 32);
4336 objv[2] = refPtr->objPtr;
4337 Jim_IncrRefCount(objv[0]);
4338 Jim_IncrRefCount(objv[1]);
4339 Jim_IncrRefCount(objv[2]);
4340
4341 /* Drop the reference itself */
4342 Jim_DeleteHashEntry(&interp->references, refId);
4343
4344 /* Call the finalizer. Errors ignored. */
4345 oldResult = interp->result;
4346 Jim_IncrRefCount(oldResult);
4347 Jim_EvalObjVector(interp, 3, objv);
4348 Jim_SetResult(interp, oldResult);
4349 Jim_DecrRefCount(interp, oldResult);
4350
4351 Jim_DecrRefCount(interp, objv[0]);
4352 Jim_DecrRefCount(interp, objv[1]);
4353 Jim_DecrRefCount(interp, objv[2]);
4354 } else {
4355 Jim_DeleteHashEntry(&interp->references, refId);
4356 }
4357 }
4358 }
4359 Jim_FreeHashTableIterator(htiter);
4360 Jim_FreeHashTable(&marks);
4361 interp->lastCollectId = interp->referenceNextId;
4362 interp->lastCollectTime = time(NULL);
4363 return collected;
4364 }
4365
4366 #define JIM_COLLECT_ID_PERIOD 5000
4367 #define JIM_COLLECT_TIME_PERIOD 300
4368
4369 void Jim_CollectIfNeeded(Jim_Interp *interp)
4370 {
4371 jim_wide elapsedId;
4372 int elapsedTime;
4373
4374 elapsedId = interp->referenceNextId - interp->lastCollectId;
4375 elapsedTime = time(NULL) - interp->lastCollectTime;
4376
4377
4378 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4379 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4380 Jim_Collect(interp);
4381 }
4382 }
4383
4384 /* -----------------------------------------------------------------------------
4385 * Interpreter related functions
4386 * ---------------------------------------------------------------------------*/
4387
4388 Jim_Interp *Jim_CreateInterp(void)
4389 {
4390 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4391 Jim_Obj *pathPtr;
4392
4393 i->errorLine = 0;
4394 i->errorFileName = Jim_StrDup("");
4395 i->numLevels = 0;
4396 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4397 i->returnCode = JIM_OK;
4398 i->exitCode = 0;
4399 i->procEpoch = 0;
4400 i->callFrameEpoch = 0;
4401 i->liveList = i->freeList = NULL;
4402 i->scriptFileName = Jim_StrDup("");
4403 i->referenceNextId = 0;
4404 i->lastCollectId = 0;
4405 i->lastCollectTime = time(NULL);
4406 i->freeFramesList = NULL;
4407 i->prngState = NULL;
4408 i->evalRetcodeLevel = -1;
4409 i->cookie_stdin = stdin;
4410 i->cookie_stdout = stdout;
4411 i->cookie_stderr = stderr;
4412 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4413 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4414 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4415 i->cb_fflush = ((int (*)(void *))(fflush));
4416 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4417
4418 /* Note that we can create objects only after the
4419 * interpreter liveList and freeList pointers are
4420 * initialized to NULL. */
4421 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4422 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4423 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4424 NULL);
4425 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4426 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4427 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4428 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4429 i->emptyObj = Jim_NewEmptyStringObj(i);
4430 i->result = i->emptyObj;
4431 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4432 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4433 i->unknown_called = 0;
4434 Jim_IncrRefCount(i->emptyObj);
4435 Jim_IncrRefCount(i->result);
4436 Jim_IncrRefCount(i->stackTrace);
4437 Jim_IncrRefCount(i->unknown);
4438
4439 /* Initialize key variables every interpreter should contain */
4440 pathPtr = Jim_NewStringObj(i, "./", -1);
4441 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4442 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4443
4444 /* Export the core API to extensions */
4445 JimRegisterCoreApi(i);
4446 return i;
4447 }
4448
4449 /* This is the only function Jim exports directly without
4450 * to use the STUB system. It is only used by embedders
4451 * in order to get an interpreter with the Jim API pointers
4452 * registered. */
4453 Jim_Interp *ExportedJimCreateInterp(void)
4454 {
4455 return Jim_CreateInterp();
4456 }
4457
4458 void Jim_FreeInterp(Jim_Interp *i)
4459 {
4460 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4461 Jim_Obj *objPtr, *nextObjPtr;
4462
4463 Jim_DecrRefCount(i, i->emptyObj);
4464 Jim_DecrRefCount(i, i->result);
4465 Jim_DecrRefCount(i, i->stackTrace);
4466 Jim_DecrRefCount(i, i->unknown);
4467 Jim_Free((void*)i->errorFileName);
4468 Jim_Free((void*)i->scriptFileName);
4469 Jim_FreeHashTable(&i->commands);
4470 Jim_FreeHashTable(&i->references);
4471 Jim_FreeHashTable(&i->stub);
4472 Jim_FreeHashTable(&i->assocData);
4473 Jim_FreeHashTable(&i->packages);
4474 Jim_Free(i->prngState);
4475 /* Free the call frames list */
4476 while (cf) {
4477 prevcf = cf->parentCallFrame;
4478 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4479 cf = prevcf;
4480 }
4481 /* Check that the live object list is empty, otherwise
4482 * there is a memory leak. */
4483 if (i->liveList != NULL) {
4484 objPtr = i->liveList;
4485
4486 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4487 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4488 while (objPtr) {
4489 const char *type = objPtr->typePtr ?
4490 objPtr->typePtr->name : "";
4491 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4492 objPtr, type,
4493 objPtr->bytes ? objPtr->bytes
4494 : "(null)", objPtr->refCount);
4495 if (objPtr->typePtr == &sourceObjType) {
4496 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4497 objPtr->internalRep.sourceValue.fileName,
4498 objPtr->internalRep.sourceValue.lineNumber);
4499 }
4500 objPtr = objPtr->nextObjPtr;
4501 }
4502 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4503 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4504 }
4505 /* Free all the freed objects. */
4506 objPtr = i->freeList;
4507 while (objPtr) {
4508 nextObjPtr = objPtr->nextObjPtr;
4509 Jim_Free(objPtr);
4510 objPtr = nextObjPtr;
4511 }
4512 /* Free cached CallFrame structures */
4513 cf = i->freeFramesList;
4514 while (cf) {
4515 nextcf = cf->nextFramePtr;
4516 if (cf->vars.table != NULL)
4517 Jim_Free(cf->vars.table);
4518 Jim_Free(cf);
4519 cf = nextcf;
4520 }
4521 /* Free the sharedString hash table. Make sure to free it
4522 * after every other Jim_Object was freed. */
4523 Jim_FreeHashTable(&i->sharedStrings);
4524 /* Free the interpreter structure. */
4525 Jim_Free(i);
4526 }
4527
4528 /* Store the call frame relative to the level represented by
4529 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4530 * level is assumed to be '1'.
4531 *
4532 * If a newLevelptr int pointer is specified, the function stores
4533 * the absolute level integer value of the new target callframe into
4534 * *newLevelPtr. (this is used to adjust interp->numLevels
4535 * in the implementation of [uplevel], so that [info level] will
4536 * return a correct information).
4537 *
4538 * This function accepts the 'level' argument in the form
4539 * of the commands [uplevel] and [upvar].
4540 *
4541 * For a function accepting a relative integer as level suitable
4542 * for implementation of [info level ?level?] check the
4543 * GetCallFrameByInteger() function. */
4544 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4545 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4546 {
4547 long level;
4548 const char *str;
4549 Jim_CallFrame *framePtr;
4550
4551 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4552 if (levelObjPtr) {
4553 str = Jim_GetString(levelObjPtr, NULL);
4554 if (str[0] == '#') {
4555 char *endptr;
4556 /* speedup for the toplevel (level #0) */
4557 if (str[1] == '0' && str[2] == '\0') {
4558 if (newLevelPtr) *newLevelPtr = 0;
4559 *framePtrPtr = interp->topFramePtr;
4560 return JIM_OK;
4561 }
4562
4563 level = strtol(str + 1, &endptr, 0);
4564 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4565 goto badlevel;
4566 /* An 'absolute' level is converted into the
4567 * 'number of levels to go back' format. */
4568 level = interp->numLevels - level;
4569 if (level < 0) goto badlevel;
4570 } else {
4571 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4572 goto badlevel;
4573 }
4574 } else {
4575 str = "1"; /* Needed to format the error message. */
4576 level = 1;
4577 }
4578 /* Lookup */
4579 framePtr = interp->framePtr;
4580 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4581 while (level--) {
4582 framePtr = framePtr->parentCallFrame;
4583 if (framePtr == NULL) goto badlevel;
4584 }
4585 *framePtrPtr = framePtr;
4586 return JIM_OK;
4587 badlevel:
4588 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4589 Jim_AppendStrings(interp, Jim_GetResult(interp),
4590 "bad level \"", str, "\"", NULL);
4591 return JIM_ERR;
4592 }
4593
4594 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4595 * as a relative integer like in the [info level ?level?] command. */
4596 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4597 Jim_CallFrame **framePtrPtr)
4598 {
4599 jim_wide level;
4600 jim_wide relLevel; /* level relative to the current one. */
4601 Jim_CallFrame *framePtr;
4602
4603 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4604 goto badlevel;
4605 if (level > 0) {
4606 /* An 'absolute' level is converted into the
4607 * 'number of levels to go back' format. */
4608 relLevel = interp->numLevels - level;
4609 } else {
4610 relLevel = -level;
4611 }
4612 /* Lookup */
4613 framePtr = interp->framePtr;
4614 while (relLevel--) {
4615 framePtr = framePtr->parentCallFrame;
4616 if (framePtr == NULL) goto badlevel;
4617 }
4618 *framePtrPtr = framePtr;
4619 return JIM_OK;
4620 badlevel:
4621 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4622 Jim_AppendStrings(interp, Jim_GetResult(interp),
4623 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4624 return JIM_ERR;
4625 }
4626
4627 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4628 {
4629 Jim_Free((void*)interp->errorFileName);
4630 interp->errorFileName = Jim_StrDup(filename);
4631 }
4632
4633 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4634 {
4635 interp->errorLine = linenr;
4636 }
4637
4638 static void JimResetStackTrace(Jim_Interp *interp)
4639 {
4640 Jim_DecrRefCount(interp, interp->stackTrace);
4641 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4642 Jim_IncrRefCount(interp->stackTrace);
4643 }
4644
4645 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4646 const char *filename, int linenr)
4647 {
4648 /* No need to add this dummy entry to the stack trace */
4649 if (strcmp(procname, "unknown") == 0) {
4650 return;
4651 }
4652
4653 if (Jim_IsShared(interp->stackTrace)) {
4654 interp->stackTrace =
4655 Jim_DuplicateObj(interp, interp->stackTrace);
4656 Jim_IncrRefCount(interp->stackTrace);
4657 }
4658 Jim_ListAppendElement(interp, interp->stackTrace,
4659 Jim_NewStringObj(interp, procname, -1));
4660 Jim_ListAppendElement(interp, interp->stackTrace,
4661 Jim_NewStringObj(interp, filename, -1));
4662 Jim_ListAppendElement(interp, interp->stackTrace,
4663 Jim_NewIntObj(interp, linenr));
4664 }
4665
4666 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4667 {
4668 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4669 assocEntryPtr->delProc = delProc;
4670 assocEntryPtr->data = data;
4671 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4672 }
4673
4674 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4675 {
4676 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4677 if (entryPtr != NULL) {
4678 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4679 return assocEntryPtr->data;
4680 }
4681 return NULL;
4682 }
4683
4684 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4685 {
4686 return Jim_DeleteHashEntry(&interp->assocData, key);
4687 }
4688
4689 int Jim_GetExitCode(Jim_Interp *interp) {
4690 return interp->exitCode;
4691 }
4692
4693 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4694 {
4695 if (fp != NULL) interp->cookie_stdin = fp;
4696 return interp->cookie_stdin;
4697 }
4698
4699 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4700 {
4701 if (fp != NULL) interp->cookie_stdout = fp;
4702 return interp->cookie_stdout;
4703 }
4704
4705 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4706 {
4707 if (fp != NULL) interp->cookie_stderr = fp;
4708 return interp->cookie_stderr;
4709 }
4710
4711 /* -----------------------------------------------------------------------------
4712 * Shared strings.
4713 * Every interpreter has an hash table where to put shared dynamically
4714 * allocate strings that are likely to be used a lot of times.
4715 * For example, in the 'source' object type, there is a pointer to
4716 * the filename associated with that object. Every script has a lot
4717 * of this objects with the identical file name, so it is wise to share
4718 * this info.
4719 *
4720 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4721 * returns the pointer to the shared string. Every time a reference
4722 * to the string is no longer used, the user should call
4723 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4724 * a given string, it is removed from the hash table.
4725 * ---------------------------------------------------------------------------*/
4726 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4727 {
4728 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4729
4730 if (he == NULL) {
4731 char *strCopy = Jim_StrDup(str);
4732
4733 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4734 return strCopy;
4735 } else {
4736 intptr_t refCount = (intptr_t) he->val;
4737
4738 refCount++;
4739 he->val = (void*) refCount;
4740 return he->key;
4741 }
4742 }
4743
4744 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4745 {
4746 intptr_t refCount;
4747 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4748
4749 if (he == NULL)
4750 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4751 "unknown shared string '%s'", str);
4752 refCount = (intptr_t) he->val;
4753 refCount--;
4754 if (refCount == 0) {
4755 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4756 } else {
4757 he->val = (void*) refCount;
4758 }
4759 }
4760
4761 /* -----------------------------------------------------------------------------
4762 * Integer object
4763 * ---------------------------------------------------------------------------*/
4764 #define JIM_INTEGER_SPACE 24
4765
4766 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4767 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4768
4769 static Jim_ObjType intObjType = {
4770 "int",
4771 NULL,
4772 NULL,
4773 UpdateStringOfInt,
4774 JIM_TYPE_NONE,
4775 };
4776
4777 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4778 {
4779 int len;
4780 char buf[JIM_INTEGER_SPACE + 1];
4781
4782 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4783 objPtr->bytes = Jim_Alloc(len + 1);
4784 memcpy(objPtr->bytes, buf, len + 1);
4785 objPtr->length = len;
4786 }
4787
4788 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4789 {
4790 jim_wide wideValue;
4791 const char *str;
4792
4793 /* Get the string representation */
4794 str = Jim_GetString(objPtr, NULL);
4795 /* Try to convert into a jim_wide */
4796 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4797 if (flags & JIM_ERRMSG) {
4798 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4799 Jim_AppendStrings(interp, Jim_GetResult(interp),
4800 "expected integer but got \"", str, "\"", NULL);
4801 }
4802 return JIM_ERR;
4803 }
4804 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4805 errno == ERANGE) {
4806 Jim_SetResultString(interp,
4807 "Integer value too big to be represented", -1);
4808 return JIM_ERR;
4809 }
4810 /* Free the old internal repr and set the new one. */
4811 Jim_FreeIntRep(interp, objPtr);
4812 objPtr->typePtr = &intObjType;
4813 objPtr->internalRep.wideValue = wideValue;
4814 return JIM_OK;
4815 }
4816
4817 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4818 {
4819 if (objPtr->typePtr != &intObjType &&
4820 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4821 return JIM_ERR;
4822 *widePtr = objPtr->internalRep.wideValue;
4823 return JIM_OK;
4824 }
4825
4826 /* Get a wide but does not set an error if the format is bad. */
4827 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4828 jim_wide *widePtr)
4829 {
4830 if (objPtr->typePtr != &intObjType &&
4831 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4832 return JIM_ERR;
4833 *widePtr = objPtr->internalRep.wideValue;
4834 return JIM_OK;
4835 }
4836
4837 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4838 {
4839 jim_wide wideValue;
4840 int retval;
4841
4842 retval = Jim_GetWide(interp, objPtr, &wideValue);
4843 if (retval == JIM_OK) {
4844 *longPtr = (long) wideValue;
4845 return JIM_OK;
4846 }
4847 return JIM_ERR;
4848 }
4849
4850 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4851 {
4852 if (Jim_IsShared(objPtr))
4853 Jim_Panic(interp,"Jim_SetWide called with shared object");
4854 if (objPtr->typePtr != &intObjType) {
4855 Jim_FreeIntRep(interp, objPtr);
4856 objPtr->typePtr = &intObjType;
4857 }
4858 Jim_InvalidateStringRep(objPtr);
4859 objPtr->internalRep.wideValue = wideValue;
4860 }
4861
4862 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4863 {
4864 Jim_Obj *objPtr;
4865
4866 objPtr = Jim_NewObj(interp);
4867 objPtr->typePtr = &intObjType;
4868 objPtr->bytes = NULL;
4869 objPtr->internalRep.wideValue = wideValue;
4870 return objPtr;
4871 }
4872
4873 /* -----------------------------------------------------------------------------
4874 * Double object
4875 * ---------------------------------------------------------------------------*/
4876 #define JIM_DOUBLE_SPACE 30
4877
4878 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4879 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4880
4881 static Jim_ObjType doubleObjType = {
4882 "double",
4883 NULL,
4884 NULL,
4885 UpdateStringOfDouble,
4886 JIM_TYPE_NONE,
4887 };
4888
4889 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4890 {
4891 int len;
4892 char buf[JIM_DOUBLE_SPACE + 1];
4893
4894 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4895 objPtr->bytes = Jim_Alloc(len + 1);
4896 memcpy(objPtr->bytes, buf, len + 1);
4897 objPtr->length = len;
4898 }
4899
4900 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4901 {
4902 double doubleValue;
4903 const char *str;
4904
4905 /* Get the string representation */
4906 str = Jim_GetString(objPtr, NULL);
4907 /* Try to convert into a double */
4908 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4909 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4910 Jim_AppendStrings(interp, Jim_GetResult(interp),
4911 "expected number but got '", str, "'", NULL);
4912 return JIM_ERR;
4913 }
4914 /* Free the old internal repr and set the new one. */
4915 Jim_FreeIntRep(interp, objPtr);
4916 objPtr->typePtr = &doubleObjType;
4917 objPtr->internalRep.doubleValue = doubleValue;
4918 return JIM_OK;
4919 }
4920
4921 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4922 {
4923 if (objPtr->typePtr != &doubleObjType &&
4924 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4925 return JIM_ERR;
4926 *doublePtr = objPtr->internalRep.doubleValue;
4927 return JIM_OK;
4928 }
4929
4930 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4931 {
4932 if (Jim_IsShared(objPtr))
4933 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4934 if (objPtr->typePtr != &doubleObjType) {
4935 Jim_FreeIntRep(interp, objPtr);
4936 objPtr->typePtr = &doubleObjType;
4937 }
4938 Jim_InvalidateStringRep(objPtr);
4939 objPtr->internalRep.doubleValue = doubleValue;
4940 }
4941
4942 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4943 {
4944 Jim_Obj *objPtr;
4945
4946 objPtr = Jim_NewObj(interp);
4947 objPtr->typePtr = &doubleObjType;
4948 objPtr->bytes = NULL;
4949 objPtr->internalRep.doubleValue = doubleValue;
4950 return objPtr;
4951 }
4952
4953 /* -----------------------------------------------------------------------------
4954 * List object
4955 * ---------------------------------------------------------------------------*/
4956 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4957 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4958 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4959 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4960 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4961
4962 /* Note that while the elements of the list may contain references,
4963 * the list object itself can't. This basically means that the
4964 * list object string representation as a whole can't contain references
4965 * that are not presents in the single elements. */
4966 static Jim_ObjType listObjType = {
4967 "list",
4968 FreeListInternalRep,
4969 DupListInternalRep,
4970 UpdateStringOfList,
4971 JIM_TYPE_NONE,
4972 };
4973
4974 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4975 {
4976 int i;
4977
4978 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4979 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4980 }
4981 Jim_Free(objPtr->internalRep.listValue.ele);
4982 }
4983
4984 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4985 {
4986 int i;
4987 JIM_NOTUSED(interp);
4988
4989 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4990 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4991 dupPtr->internalRep.listValue.ele =
4992 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4993 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4994 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4995 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4996 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4997 }
4998 dupPtr->typePtr = &listObjType;
4999 }
5000
5001 /* The following function checks if a given string can be encoded
5002 * into a list element without any kind of quoting, surrounded by braces,
5003 * or using escapes to quote. */
5004 #define JIM_ELESTR_SIMPLE 0
5005 #define JIM_ELESTR_BRACE 1
5006 #define JIM_ELESTR_QUOTE 2
5007 static int ListElementQuotingType(const char *s, int len)
5008 {
5009 int i, level, trySimple = 1;
5010
5011 /* Try with the SIMPLE case */
5012 if (len == 0) return JIM_ELESTR_BRACE;
5013 if (s[0] == '"' || s[0] == '{') {
5014 trySimple = 0;
5015 goto testbrace;
5016 }
5017 for (i = 0; i < len; i++) {
5018 switch (s[i]) {
5019 case ' ':
5020 case '$':
5021 case '"':
5022 case '[':
5023 case ']':
5024 case ';':
5025 case '\\':
5026 case '\r':
5027 case '\n':
5028 case '\t':
5029 case '\f':
5030 case '\v':
5031 trySimple = 0;
5032 case '{':
5033 case '}':
5034 goto testbrace;
5035 }
5036 }
5037 return JIM_ELESTR_SIMPLE;
5038
5039 testbrace:
5040 /* Test if it's possible to do with braces */
5041 if (s[len-1] == '\\' ||
5042 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5043 level = 0;
5044 for (i = 0; i < len; i++) {
5045 switch (s[i]) {
5046 case '{': level++; break;
5047 case '}': level--;
5048 if (level < 0) return JIM_ELESTR_QUOTE;
5049 break;
5050 case '\\':
5051 if (s[i + 1] == '\n')
5052 return JIM_ELESTR_QUOTE;
5053 else
5054 if (s[i + 1] != '\0') i++;
5055 break;
5056 }
5057 }
5058 if (level == 0) {
5059 if (!trySimple) return JIM_ELESTR_BRACE;
5060 for (i = 0; i < len; i++) {
5061 switch (s[i]) {
5062 case ' ':
5063 case '$':
5064 case '"':
5065 case '[':
5066 case ']':
5067 case ';':
5068 case '\\':
5069 case '\r':
5070 case '\n':
5071 case '\t':
5072 case '\f':
5073 case '\v':
5074 return JIM_ELESTR_BRACE;
5075 break;
5076 }
5077 }
5078 return JIM_ELESTR_SIMPLE;
5079 }
5080 return JIM_ELESTR_QUOTE;
5081 }
5082
5083 /* Returns the malloc-ed representation of a string
5084 * using backslash to quote special chars. */
5085 static char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5086 {
5087 char *q = Jim_Alloc(len*2 + 1), *p;
5088
5089 p = q;
5090 while (*s) {
5091 switch (*s) {
5092 case ' ':
5093 case '$':
5094 case '"':
5095 case '[':
5096 case ']':
5097 case '{':
5098 case '}':
5099 case ';':
5100 case '\\':
5101 *p++ = '\\';
5102 *p++ = *s++;
5103 break;
5104 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5105 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5106 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5107 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5108 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5109 default:
5110 *p++ = *s++;
5111 break;
5112 }
5113 }
5114 *p = '\0';
5115 *qlenPtr = p-q;
5116 return q;
5117 }
5118
5119 void UpdateStringOfList(struct Jim_Obj *objPtr)
5120 {
5121 int i, bufLen, realLength;
5122 const char *strRep;
5123 char *p;
5124 int *quotingType;
5125 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5126
5127 /* (Over) Estimate the space needed. */
5128 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5129 bufLen = 0;
5130 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5131 int len;
5132
5133 strRep = Jim_GetString(ele[i], &len);
5134 quotingType[i] = ListElementQuotingType(strRep, len);
5135 switch (quotingType[i]) {
5136 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5137 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5138 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5139 }
5140 bufLen++; /* elements separator. */
5141 }
5142 bufLen++;
5143
5144 /* Generate the string rep. */
5145 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5146 realLength = 0;
5147 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5148 int len, qlen;
5149 strRep = Jim_GetString(ele[i], &len);
5150 char *q;
5151
5152 switch (quotingType[i]) {
5153 case JIM_ELESTR_SIMPLE:
5154 memcpy(p, strRep, len);
5155 p += len;
5156 realLength += len;
5157 break;
5158 case JIM_ELESTR_BRACE:
5159 *p++ = '{';
5160 memcpy(p, strRep, len);
5161 p += len;
5162 *p++ = '}';
5163 realLength += len + 2;
5164 break;
5165 case JIM_ELESTR_QUOTE:
5166 q = BackslashQuoteString(strRep, len, &qlen);
5167 memcpy(p, q, qlen);
5168 Jim_Free(q);
5169 p += qlen;
5170 realLength += qlen;
5171 break;
5172 }
5173 /* Add a separating space */
5174 if (i + 1 != objPtr->internalRep.listValue.len) {
5175 *p++ = ' ';
5176 realLength ++;
5177 }
5178 }
5179 *p = '\0'; /* nul term. */
5180 objPtr->length = realLength;
5181 Jim_Free(quotingType);
5182 }
5183
5184 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5185 {
5186 struct JimParserCtx parser;
5187 const char *str;
5188 int strLen;
5189
5190 /* Get the string representation */
5191 str = Jim_GetString(objPtr, &strLen);
5192
5193 /* Free the old internal repr just now and initialize the
5194 * new one just now. The string->list conversion can't fail. */
5195 Jim_FreeIntRep(interp, objPtr);
5196 objPtr->typePtr = &listObjType;
5197 objPtr->internalRep.listValue.len = 0;
5198 objPtr->internalRep.listValue.maxLen = 0;
5199 objPtr->internalRep.listValue.ele = NULL;
5200
5201 /* Convert into a list */
5202 JimParserInit(&parser, str, strLen, 1);
5203 while (!JimParserEof(&parser)) {
5204 char *token;
5205 int tokenLen, type;
5206 Jim_Obj *elementPtr;
5207
5208 JimParseList(&parser);
5209 if (JimParserTtype(&parser) != JIM_TT_STR &&
5210 JimParserTtype(&parser) != JIM_TT_ESC)
5211 continue;
5212 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5213 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5214 ListAppendElement(objPtr, elementPtr);
5215 }
5216 return JIM_OK;
5217 }
5218
5219 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5220 int len)
5221 {
5222 Jim_Obj *objPtr;
5223 int i;
5224
5225 objPtr = Jim_NewObj(interp);
5226 objPtr->typePtr = &listObjType;
5227 objPtr->bytes = NULL;
5228 objPtr->internalRep.listValue.ele = NULL;
5229 objPtr->internalRep.listValue.len = 0;
5230 objPtr->internalRep.listValue.maxLen = 0;
5231 for (i = 0; i < len; i++) {
5232 ListAppendElement(objPtr, elements[i]);
5233 }
5234 return objPtr;
5235 }
5236
5237 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5238 * length of the vector. Note that the user of this function should make
5239 * sure that the list object can't shimmer while the vector returned
5240 * is in use, this vector is the one stored inside the internal representation
5241 * of the list object. This function is not exported, extensions should
5242 * always access to the List object elements using Jim_ListIndex(). */
5243 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5244 Jim_Obj ***listVec)
5245 {
5246 Jim_ListLength(interp, listObj, argc);
5247 assert(listObj->typePtr == &listObjType);
5248 *listVec = listObj->internalRep.listValue.ele;
5249 }
5250
5251 /* ListSortElements type values */
5252 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5253 JIM_LSORT_NOCASE_DECR};
5254
5255 /* Sort the internal rep of a list. */
5256 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5257 {
5258 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5259 }
5260
5261 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5262 {
5263 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5264 }
5265
5266 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5267 {
5268 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5269 }
5270
5271 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5272 {
5273 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5274 }
5275
5276 /* Sort a list *in place*. MUST be called with non-shared objects. */
5277 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5278 {
5279 typedef int (qsort_comparator)(const void *, const void *);
5280 int (*fn)(Jim_Obj**, Jim_Obj**);
5281 Jim_Obj **vector;
5282 int len;
5283
5284 if (Jim_IsShared(listObjPtr))
5285 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5286 if (listObjPtr->typePtr != &listObjType)
5287 SetListFromAny(interp, listObjPtr);
5288
5289 vector = listObjPtr->internalRep.listValue.ele;
5290 len = listObjPtr->internalRep.listValue.len;
5291 switch (type) {
5292 case JIM_LSORT_ASCII: fn = ListSortString; break;
5293 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5294 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5295 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5296 default:
5297 fn = NULL; /* avoid warning */
5298 Jim_Panic(interp,"ListSort called with invalid sort type");
5299 }
5300 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5301 Jim_InvalidateStringRep(listObjPtr);
5302 }
5303
5304 /* This is the low-level function to append an element to a list.
5305 * The higher-level Jim_ListAppendElement() performs shared object
5306 * check and invalidate the string repr. This version is used
5307 * in the internals of the List Object and is not exported.
5308 *
5309 * NOTE: this function can be called only against objects
5310 * with internal type of List. */
5311 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5312 {
5313 int requiredLen = listPtr->internalRep.listValue.len + 1;
5314
5315 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5316 int maxLen = requiredLen * 2;
5317
5318 listPtr->internalRep.listValue.ele =
5319 Jim_Realloc(listPtr->internalRep.listValue.ele,
5320 sizeof(Jim_Obj*)*maxLen);
5321 listPtr->internalRep.listValue.maxLen = maxLen;
5322 }
5323 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5324 objPtr;
5325 listPtr->internalRep.listValue.len ++;
5326 Jim_IncrRefCount(objPtr);
5327 }
5328
5329 /* This is the low-level function to insert elements into a list.
5330 * The higher-level Jim_ListInsertElements() performs shared object
5331 * check and invalidate the string repr. This version is used
5332 * in the internals of the List Object and is not exported.
5333 *
5334 * NOTE: this function can be called only against objects
5335 * with internal type of List. */
5336 static void ListInsertElements(Jim_Obj *listPtr, int index_t, int elemc,
5337 Jim_Obj *const *elemVec)
5338 {
5339 int currentLen = listPtr->internalRep.listValue.len;
5340 int requiredLen = currentLen + elemc;
5341 int i;
5342 Jim_Obj **point;
5343
5344 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5345 int maxLen = requiredLen * 2;
5346
5347 listPtr->internalRep.listValue.ele =
5348 Jim_Realloc(listPtr->internalRep.listValue.ele,
5349 sizeof(Jim_Obj*)*maxLen);
5350 listPtr->internalRep.listValue.maxLen = maxLen;
5351 }
5352 point = listPtr->internalRep.listValue.ele + index_t;
5353 memmove(point + elemc, point, (currentLen-index_t) * sizeof(Jim_Obj*));
5354 for (i = 0; i < elemc; ++i) {
5355 point[i] = elemVec[i];
5356 Jim_IncrRefCount(point[i]);
5357 }
5358 listPtr->internalRep.listValue.len += elemc;
5359 }
5360
5361 /* Appends every element of appendListPtr into listPtr.
5362 * Both have to be of the list type. */
5363 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5364 {
5365 int i, oldLen = listPtr->internalRep.listValue.len;
5366 int appendLen = appendListPtr->internalRep.listValue.len;
5367 int requiredLen = oldLen + appendLen;
5368
5369 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5370 int maxLen = requiredLen * 2;
5371
5372 listPtr->internalRep.listValue.ele =
5373 Jim_Realloc(listPtr->internalRep.listValue.ele,
5374 sizeof(Jim_Obj*)*maxLen);
5375 listPtr->internalRep.listValue.maxLen = maxLen;
5376 }
5377 for (i = 0; i < appendLen; i++) {
5378 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5379 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5380 Jim_IncrRefCount(objPtr);
5381 }
5382 listPtr->internalRep.listValue.len += appendLen;
5383 }
5384
5385 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5386 {
5387 if (Jim_IsShared(listPtr))
5388 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5389 if (listPtr->typePtr != &listObjType)
5390 SetListFromAny(interp, listPtr);
5391 Jim_InvalidateStringRep(listPtr);
5392 ListAppendElement(listPtr, objPtr);
5393 }
5394
5395 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5396 {
5397 if (Jim_IsShared(listPtr))
5398 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5399 if (listPtr->typePtr != &listObjType)
5400 SetListFromAny(interp, listPtr);
5401 Jim_InvalidateStringRep(listPtr);
5402 ListAppendList(listPtr, appendListPtr);
5403 }
5404
5405 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5406 {
5407 if (listPtr->typePtr != &listObjType)
5408 SetListFromAny(interp, listPtr);
5409 *intPtr = listPtr->internalRep.listValue.len;
5410 }
5411
5412 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5413 int objc, Jim_Obj *const *objVec)
5414 {
5415 if (Jim_IsShared(listPtr))
5416 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5417 if (listPtr->typePtr != &listObjType)
5418 SetListFromAny(interp, listPtr);
5419 if (index_t >= 0 && index_t > listPtr->internalRep.listValue.len)
5420 index_t = listPtr->internalRep.listValue.len;
5421 else if (index_t < 0)
5422 index_t = 0;
5423 Jim_InvalidateStringRep(listPtr);
5424 ListInsertElements(listPtr, index_t, objc, objVec);
5425 }
5426
5427 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5428 Jim_Obj **objPtrPtr, int flags)
5429 {
5430 if (listPtr->typePtr != &listObjType)
5431 SetListFromAny(interp, listPtr);
5432 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5433 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5434 if (flags & JIM_ERRMSG) {
5435 Jim_SetResultString(interp,
5436 "list index out of range", -1);
5437 }
5438 return JIM_ERR;
5439 }
5440 if (index_t < 0)
5441 index_t = listPtr->internalRep.listValue.len + index_t;
5442 *objPtrPtr = listPtr->internalRep.listValue.ele[index_t];
5443 return JIM_OK;
5444 }
5445
5446 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5447 Jim_Obj *newObjPtr, int flags)
5448 {
5449 if (listPtr->typePtr != &listObjType)
5450 SetListFromAny(interp, listPtr);
5451 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5452 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5453 if (flags & JIM_ERRMSG) {
5454 Jim_SetResultString(interp,
5455 "list index_t out of range", -1);
5456 }
5457 return JIM_ERR;
5458 }
5459 if (index_t < 0)
5460 index_t = listPtr->internalRep.listValue.len + index_t;
5461 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index_t]);
5462 listPtr->internalRep.listValue.ele[index_t] = newObjPtr;
5463 Jim_IncrRefCount(newObjPtr);
5464 return JIM_OK;
5465 }
5466
5467 /* Modify the list stored into the variable named 'varNamePtr'
5468 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5469 * with the new element 'newObjptr'. */
5470 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5471 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5472 {
5473 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5474 int shared, i, index_t;
5475
5476 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5477 if (objPtr == NULL)
5478 return JIM_ERR;
5479 if ((shared = Jim_IsShared(objPtr)))
5480 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5481 for (i = 0; i < indexc-1; i++) {
5482 listObjPtr = objPtr;
5483 if (Jim_GetIndex(interp, indexv[i], &index_t) != JIM_OK)
5484 goto err;
5485 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
5486 JIM_ERRMSG) != JIM_OK) {
5487 goto err;
5488 }
5489 if (Jim_IsShared(objPtr)) {
5490 objPtr = Jim_DuplicateObj(interp, objPtr);
5491 ListSetIndex(interp, listObjPtr, index_t, objPtr, JIM_NONE);
5492 }
5493 Jim_InvalidateStringRep(listObjPtr);
5494 }
5495 if (Jim_GetIndex(interp, indexv[indexc-1], &index_t) != JIM_OK)
5496 goto err;
5497 if (ListSetIndex(interp, objPtr, index_t, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5498 goto err;
5499 Jim_InvalidateStringRep(objPtr);
5500 Jim_InvalidateStringRep(varObjPtr);
5501 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5502 goto err;
5503 Jim_SetResult(interp, varObjPtr);
5504 return JIM_OK;
5505 err:
5506 if (shared) {
5507 Jim_FreeNewObj(interp, varObjPtr);
5508 }
5509 return JIM_ERR;
5510 }
5511
5512 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5513 {
5514 int i;
5515
5516 /* If all the objects in objv are lists without string rep.
5517 * it's possible to return a list as result, that's the
5518 * concatenation of all the lists. */
5519 for (i = 0; i < objc; i++) {
5520 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5521 break;
5522 }
5523 if (i == objc) {
5524 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5525 for (i = 0; i < objc; i++)
5526 Jim_ListAppendList(interp, objPtr, objv[i]);
5527 return objPtr;
5528 } else {
5529 /* Else... we have to glue strings together */
5530 int len = 0, objLen;
5531 char *bytes, *p;
5532
5533 /* Compute the length */
5534 for (i = 0; i < objc; i++) {
5535 Jim_GetString(objv[i], &objLen);
5536 len += objLen;
5537 }
5538 if (objc) len += objc-1;
5539 /* Create the string rep, and a stinrg object holding it. */
5540 p = bytes = Jim_Alloc(len + 1);
5541 for (i = 0; i < objc; i++) {
5542 const char *s = Jim_GetString(objv[i], &objLen);
5543 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5544 {
5545 s++; objLen--; len--;
5546 }
5547 while (objLen && (s[objLen-1] == ' ' ||
5548 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5549 objLen--; len--;
5550 }
5551 memcpy(p, s, objLen);
5552 p += objLen;
5553 if (objLen && i + 1 != objc) {
5554 *p++ = ' ';
5555 } else if (i + 1 != objc) {
5556 /* Drop the space calcuated for this
5557 * element that is instead null. */
5558 len--;
5559 }
5560 }
5561 *p = '\0';
5562 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5563 }
5564 }
5565
5566 /* Returns a list composed of the elements in the specified range.
5567 * first and start are directly accepted as Jim_Objects and
5568 * processed for the end?-index? case. */
5569 static Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr,
5570 Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5571 {
5572 int first, last;
5573 int len, rangeLen;
5574
5575 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5576 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5577 return NULL;
5578 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5579 first = JimRelToAbsIndex(len, first);
5580 last = JimRelToAbsIndex(len, last);
5581 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5582 return Jim_NewListObj(interp,
5583 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5584 }
5585
5586 /* -----------------------------------------------------------------------------
5587 * Dict object
5588 * ---------------------------------------------------------------------------*/
5589 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5590 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5591 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5592 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5593
5594 /* Dict HashTable Type.
5595 *
5596 * Keys and Values are Jim objects. */
5597
5598 static unsigned int JimObjectHTHashFunction(const void *key)
5599 {
5600 const char *str;
5601 Jim_Obj *objPtr = (Jim_Obj*) key;
5602 int len, h;
5603
5604 str = Jim_GetString(objPtr, &len);
5605 h = Jim_GenHashFunction((unsigned char*)str, len);
5606 return h;
5607 }
5608
5609 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5610 {
5611 JIM_NOTUSED(privdata);
5612
5613 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5614 }
5615
5616 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5617 {
5618 Jim_Obj *objPtr = val;
5619
5620 Jim_DecrRefCount(interp, objPtr);
5621 }
5622
5623 static Jim_HashTableType JimDictHashTableType = {
5624 JimObjectHTHashFunction, /* hash function */
5625 NULL, /* key dup */
5626 NULL, /* val dup */
5627 JimObjectHTKeyCompare, /* key compare */
5628 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5629 JimObjectHTKeyValDestructor, /* key destructor */
5630 JimObjectHTKeyValDestructor /* val destructor */
5631 };
5632
5633 /* Note that while the elements of the dict may contain references,
5634 * the list object itself can't. This basically means that the
5635 * dict object string representation as a whole can't contain references
5636 * that are not presents in the single elements. */
5637 static Jim_ObjType dictObjType = {
5638 "dict",
5639 FreeDictInternalRep,
5640 DupDictInternalRep,
5641 UpdateStringOfDict,
5642 JIM_TYPE_NONE,
5643 };
5644
5645 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5646 {
5647 JIM_NOTUSED(interp);
5648
5649 Jim_FreeHashTable(objPtr->internalRep.ptr);
5650 Jim_Free(objPtr->internalRep.ptr);
5651 }
5652
5653 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5654 {
5655 Jim_HashTable *ht, *dupHt;
5656 Jim_HashTableIterator *htiter;
5657 Jim_HashEntry *he;
5658
5659 /* Create a new hash table */
5660 ht = srcPtr->internalRep.ptr;
5661 dupHt = Jim_Alloc(sizeof(*dupHt));
5662 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5663 if (ht->size != 0)
5664 Jim_ExpandHashTable(dupHt, ht->size);
5665 /* Copy every element from the source to the dup hash table */
5666 htiter = Jim_GetHashTableIterator(ht);
5667 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5668 const Jim_Obj *keyObjPtr = he->key;
5669 Jim_Obj *valObjPtr = he->val;
5670
5671 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5672 Jim_IncrRefCount(valObjPtr);
5673 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5674 }
5675 Jim_FreeHashTableIterator(htiter);
5676
5677 dupPtr->internalRep.ptr = dupHt;
5678 dupPtr->typePtr = &dictObjType;
5679 }
5680
5681 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5682 {
5683 int i, bufLen, realLength;
5684 const char *strRep;
5685 char *p;
5686 int *quotingType, objc;
5687 Jim_HashTable *ht;
5688 Jim_HashTableIterator *htiter;
5689 Jim_HashEntry *he;
5690 Jim_Obj **objv;
5691
5692 /* Trun the hash table into a flat vector of Jim_Objects. */
5693 ht = objPtr->internalRep.ptr;
5694 objc = ht->used*2;
5695 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5696 htiter = Jim_GetHashTableIterator(ht);
5697 i = 0;
5698 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5699 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5700 objv[i++] = he->val;
5701 }
5702 Jim_FreeHashTableIterator(htiter);
5703 /* (Over) Estimate the space needed. */
5704 quotingType = Jim_Alloc(sizeof(int)*objc);
5705 bufLen = 0;
5706 for (i = 0; i < objc; i++) {
5707 int len;
5708
5709 strRep = Jim_GetString(objv[i], &len);
5710 quotingType[i] = ListElementQuotingType(strRep, len);
5711 switch (quotingType[i]) {
5712 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5713 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5714 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5715 }
5716 bufLen++; /* elements separator. */
5717 }
5718 bufLen++;
5719
5720 /* Generate the string rep. */
5721 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5722 realLength = 0;
5723 for (i = 0; i < objc; i++) {
5724 int len, qlen;
5725 strRep = Jim_GetString(objv[i], &len);
5726 char *q;
5727
5728 switch (quotingType[i]) {
5729 case JIM_ELESTR_SIMPLE:
5730 memcpy(p, strRep, len);
5731 p += len;
5732 realLength += len;
5733 break;
5734 case JIM_ELESTR_BRACE:
5735 *p++ = '{';
5736 memcpy(p, strRep, len);
5737 p += len;
5738 *p++ = '}';
5739 realLength += len + 2;
5740 break;
5741 case JIM_ELESTR_QUOTE:
5742 q = BackslashQuoteString(strRep, len, &qlen);
5743 memcpy(p, q, qlen);
5744 Jim_Free(q);
5745 p += qlen;
5746 realLength += qlen;
5747 break;
5748 }
5749 /* Add a separating space */
5750 if (i + 1 != objc) {
5751 *p++ = ' ';
5752 realLength ++;
5753 }
5754 }
5755 *p = '\0'; /* nul term. */
5756 objPtr->length = realLength;
5757 Jim_Free(quotingType);
5758 Jim_Free(objv);
5759 }
5760
5761 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5762 {
5763 struct JimParserCtx parser;
5764 Jim_HashTable *ht;
5765 Jim_Obj *objv[2];
5766 const char *str;
5767 int i, strLen;
5768
5769 /* Get the string representation */
5770 str = Jim_GetString(objPtr, &strLen);
5771
5772 /* Free the old internal repr just now and initialize the
5773 * new one just now. The string->list conversion can't fail. */
5774 Jim_FreeIntRep(interp, objPtr);
5775 ht = Jim_Alloc(sizeof(*ht));
5776 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5777 objPtr->typePtr = &dictObjType;
5778 objPtr->internalRep.ptr = ht;
5779
5780 /* Convert into a dict */
5781 JimParserInit(&parser, str, strLen, 1);
5782 i = 0;
5783 while (!JimParserEof(&parser)) {
5784 char *token;
5785 int tokenLen, type;
5786
5787 JimParseList(&parser);
5788 if (JimParserTtype(&parser) != JIM_TT_STR &&
5789 JimParserTtype(&parser) != JIM_TT_ESC)
5790 continue;
5791 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5792 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5793 if (i == 2) {
5794 i = 0;
5795 Jim_IncrRefCount(objv[0]);
5796 Jim_IncrRefCount(objv[1]);
5797 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5798 Jim_HashEntry *he;
5799 he = Jim_FindHashEntry(ht, objv[0]);
5800 Jim_DecrRefCount(interp, objv[0]);
5801 /* ATTENTION: const cast */
5802 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5803 he->val = objv[1];
5804 }
5805 }
5806 }
5807 if (i) {
5808 Jim_FreeNewObj(interp, objv[0]);
5809 objPtr->typePtr = NULL;
5810 Jim_FreeHashTable(ht);
5811 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5812 return JIM_ERR;
5813 }
5814 return JIM_OK;
5815 }
5816
5817 /* Dict object API */
5818
5819 /* Add an element to a dict. objPtr must be of the "dict" type.
5820 * The higer-level exported function is Jim_DictAddElement().
5821 * If an element with the specified key already exists, the value
5822 * associated is replaced with the new one.
5823 *
5824 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5825 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5826 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5827 {
5828 Jim_HashTable *ht = objPtr->internalRep.ptr;
5829
5830 if (valueObjPtr == NULL) { /* unset */
5831 Jim_DeleteHashEntry(ht, keyObjPtr);
5832 return;
5833 }
5834 Jim_IncrRefCount(keyObjPtr);
5835 Jim_IncrRefCount(valueObjPtr);
5836 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5837 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5838 Jim_DecrRefCount(interp, keyObjPtr);
5839 /* ATTENTION: const cast */
5840 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5841 he->val = valueObjPtr;
5842 }
5843 }
5844
5845 /* Add an element, higher-level interface for DictAddElement().
5846 * If valueObjPtr == NULL, the key is removed if it exists. */
5847 static int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5848 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5849 {
5850 if (Jim_IsShared(objPtr))
5851 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5852 if (objPtr->typePtr != &dictObjType) {
5853 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5854 return JIM_ERR;
5855 }
5856 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5857 Jim_InvalidateStringRep(objPtr);
5858 return JIM_OK;
5859 }
5860
5861 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5862 {
5863 Jim_Obj *objPtr;
5864 int i;
5865
5866 if (len % 2)
5867 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5868
5869 objPtr = Jim_NewObj(interp);
5870 objPtr->typePtr = &dictObjType;
5871 objPtr->bytes = NULL;
5872 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5873 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5874 for (i = 0; i < len; i += 2)
5875 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5876 return objPtr;
5877 }
5878
5879 /* Return the value associated to the specified dict key */
5880 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5881 Jim_Obj **objPtrPtr, int flags)
5882 {
5883 Jim_HashEntry *he;
5884 Jim_HashTable *ht;
5885
5886 if (dictPtr->typePtr != &dictObjType) {
5887 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5888 return JIM_ERR;
5889 }
5890 ht = dictPtr->internalRep.ptr;
5891 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5892 if (flags & JIM_ERRMSG) {
5893 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5894 Jim_AppendStrings(interp, Jim_GetResult(interp),
5895 "key \"", Jim_GetString(keyPtr, NULL),
5896 "\" not found in dictionary", NULL);
5897 }
5898 return JIM_ERR;
5899 }
5900 *objPtrPtr = he->val;
5901 return JIM_OK;
5902 }
5903
5904 /* Return the value associated to the specified dict keys */
5905 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5906 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5907 {
5908 Jim_Obj *objPtr = NULL;
5909 int i;
5910
5911 if (keyc == 0) {
5912 *objPtrPtr = dictPtr;
5913 return JIM_OK;
5914 }
5915
5916 for (i = 0; i < keyc; i++) {
5917 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5918 != JIM_OK)
5919 return JIM_ERR;
5920 dictPtr = objPtr;
5921 }
5922 *objPtrPtr = objPtr;
5923 return JIM_OK;
5924 }
5925
5926 /* Modify the dict stored into the variable named 'varNamePtr'
5927 * setting the element specified by the 'keyc' keys objects in 'keyv',
5928 * with the new value of the element 'newObjPtr'.
5929 *
5930 * If newObjPtr == NULL the operation is to remove the given key
5931 * from the dictionary. */
5932 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5933 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5934 {
5935 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5936 int shared, i;
5937
5938 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5939 if (objPtr == NULL) {
5940 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5941 return JIM_ERR;
5942 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5943 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5944 Jim_FreeNewObj(interp, varObjPtr);
5945 return JIM_ERR;
5946 }
5947 }
5948 if ((shared = Jim_IsShared(objPtr)))
5949 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5950 for (i = 0; i < keyc-1; i++) {
5951 dictObjPtr = objPtr;
5952
5953 /* Check if it's a valid dictionary */
5954 if (dictObjPtr->typePtr != &dictObjType) {
5955 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5956 goto err;
5957 }
5958 /* Check if the given key exists. */
5959 Jim_InvalidateStringRep(dictObjPtr);
5960 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5961 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5962 {
5963 /* This key exists at the current level.
5964 * Make sure it's not shared!. */
5965 if (Jim_IsShared(objPtr)) {
5966 objPtr = Jim_DuplicateObj(interp, objPtr);
5967 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5968 }
5969 } else {
5970 /* Key not found. If it's an [unset] operation
5971 * this is an error. Only the last key may not
5972 * exist. */
5973 if (newObjPtr == NULL)
5974 goto err;
5975 /* Otherwise set an empty dictionary
5976 * as key's value. */
5977 objPtr = Jim_NewDictObj(interp, NULL, 0);
5978 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5979 }
5980 }
5981 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5982 != JIM_OK)
5983 goto err;
5984 Jim_InvalidateStringRep(objPtr);
5985 Jim_InvalidateStringRep(varObjPtr);
5986 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5987 goto err;
5988 Jim_SetResult(interp, varObjPtr);
5989 return JIM_OK;
5990 err:
5991 if (shared) {
5992 Jim_FreeNewObj(interp, varObjPtr);
5993 }
5994 return JIM_ERR;
5995 }
5996
5997 /* -----------------------------------------------------------------------------
5998 * Index object
5999 * ---------------------------------------------------------------------------*/
6000 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6001 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6002
6003 static Jim_ObjType indexObjType = {
6004 "index",
6005 NULL,
6006 NULL,
6007 UpdateStringOfIndex,
6008 JIM_TYPE_NONE,
6009 };
6010
6011 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6012 {
6013 int len;
6014 char buf[JIM_INTEGER_SPACE + 1];
6015
6016 if (objPtr->internalRep.indexValue >= 0)
6017 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6018 else if (objPtr->internalRep.indexValue == -1)
6019 len = sprintf(buf, "end");
6020 else {
6021 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6022 }
6023 objPtr->bytes = Jim_Alloc(len + 1);
6024 memcpy(objPtr->bytes, buf, len + 1);
6025 objPtr->length = len;
6026 }
6027
6028 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6029 {
6030 int index_t, end = 0;
6031 const char *str;
6032
6033 /* Get the string representation */
6034 str = Jim_GetString(objPtr, NULL);
6035 /* Try to convert into an index */
6036 if (!strcmp(str, "end")) {
6037 index_t = 0;
6038 end = 1;
6039 } else {
6040 if (!strncmp(str, "end-", 4)) {
6041 str += 4;
6042 end = 1;
6043 }
6044 if (Jim_StringToIndex(str, &index_t) != JIM_OK) {
6045 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6046 Jim_AppendStrings(interp, Jim_GetResult(interp),
6047 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6048 "must be integer or end?-integer?", NULL);
6049 return JIM_ERR;
6050 }
6051 }
6052 if (end) {
6053 if (index_t < 0)
6054 index_t = INT_MAX;
6055 else
6056 index_t = -(index_t + 1);
6057 } else if (index_t < 0)
6058 index_t = -INT_MAX;
6059 /* Free the old internal repr and set the new one. */
6060 Jim_FreeIntRep(interp, objPtr);
6061 objPtr->typePtr = &indexObjType;
6062 objPtr->internalRep.indexValue = index_t;
6063 return JIM_OK;
6064 }
6065
6066 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6067 {
6068 /* Avoid shimmering if the object is an integer. */
6069 if (objPtr->typePtr == &intObjType) {
6070 jim_wide val = objPtr->internalRep.wideValue;
6071 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6072 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6073 return JIM_OK;
6074 }
6075 }
6076 if (objPtr->typePtr != &indexObjType &&
6077 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6078 return JIM_ERR;
6079 *indexPtr = objPtr->internalRep.indexValue;
6080 return JIM_OK;
6081 }
6082
6083 /* -----------------------------------------------------------------------------
6084 * Return Code Object.
6085 * ---------------------------------------------------------------------------*/
6086
6087 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6088
6089 static Jim_ObjType returnCodeObjType = {
6090 "return-code",
6091 NULL,
6092 NULL,
6093 NULL,
6094 JIM_TYPE_NONE,
6095 };
6096
6097 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6098 {
6099 const char *str;
6100 int strLen, returnCode;
6101 jim_wide wideValue;
6102
6103 /* Get the string representation */
6104 str = Jim_GetString(objPtr, &strLen);
6105 /* Try to convert into an integer */
6106 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6107 returnCode = (int) wideValue;
6108 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6109 returnCode = JIM_OK;
6110 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6111 returnCode = JIM_ERR;
6112 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6113 returnCode = JIM_RETURN;
6114 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6115 returnCode = JIM_BREAK;
6116 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6117 returnCode = JIM_CONTINUE;
6118 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6119 returnCode = JIM_EVAL;
6120 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6121 returnCode = JIM_EXIT;
6122 else {
6123 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6124 Jim_AppendStrings(interp, Jim_GetResult(interp),
6125 "expected return code but got '", str, "'",
6126 NULL);
6127 return JIM_ERR;
6128 }
6129 /* Free the old internal repr and set the new one. */
6130 Jim_FreeIntRep(interp, objPtr);
6131 objPtr->typePtr = &returnCodeObjType;
6132 objPtr->internalRep.returnCode = returnCode;
6133 return JIM_OK;
6134 }
6135
6136 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6137 {
6138 if (objPtr->typePtr != &returnCodeObjType &&
6139 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6140 return JIM_ERR;
6141 *intPtr = objPtr->internalRep.returnCode;
6142 return JIM_OK;
6143 }
6144
6145 /* -----------------------------------------------------------------------------
6146 * Expression Parsing
6147 * ---------------------------------------------------------------------------*/
6148 static int JimParseExprOperator(struct JimParserCtx *pc);
6149 static int JimParseExprNumber(struct JimParserCtx *pc);
6150 static int JimParseExprIrrational(struct JimParserCtx *pc);
6151
6152 /* Exrp's Stack machine operators opcodes. */
6153
6154 /* Binary operators (numbers) */
6155 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6156 #define JIM_EXPROP_MUL 0
6157 #define JIM_EXPROP_DIV 1
6158 #define JIM_EXPROP_MOD 2
6159 #define JIM_EXPROP_SUB 3
6160 #define JIM_EXPROP_ADD 4
6161 #define JIM_EXPROP_LSHIFT 5
6162 #define JIM_EXPROP_RSHIFT 6
6163 #define JIM_EXPROP_ROTL 7
6164 #define JIM_EXPROP_ROTR 8
6165 #define JIM_EXPROP_LT 9
6166 #define JIM_EXPROP_GT 10
6167 #define JIM_EXPROP_LTE 11
6168 #define JIM_EXPROP_GTE 12
6169 #define JIM_EXPROP_NUMEQ 13
6170 #define JIM_EXPROP_NUMNE 14
6171 #define JIM_EXPROP_BITAND 15
6172 #define JIM_EXPROP_BITXOR 16
6173 #define JIM_EXPROP_BITOR 17
6174 #define JIM_EXPROP_LOGICAND 18
6175 #define JIM_EXPROP_LOGICOR 19
6176 #define JIM_EXPROP_LOGICAND_LEFT 20
6177 #define JIM_EXPROP_LOGICOR_LEFT 21
6178 #define JIM_EXPROP_POW 22
6179 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6180
6181 /* Binary operators (strings) */
6182 #define JIM_EXPROP_STREQ 23
6183 #define JIM_EXPROP_STRNE 24
6184
6185 /* Unary operators (numbers) */
6186 #define JIM_EXPROP_NOT 25
6187 #define JIM_EXPROP_BITNOT 26
6188 #define JIM_EXPROP_UNARYMINUS 27
6189 #define JIM_EXPROP_UNARYPLUS 28
6190 #define JIM_EXPROP_LOGICAND_RIGHT 29
6191 #define JIM_EXPROP_LOGICOR_RIGHT 30
6192
6193 /* Ternary operators */
6194 #define JIM_EXPROP_TERNARY 31
6195
6196 /* Operands */
6197 #define JIM_EXPROP_NUMBER 32
6198 #define JIM_EXPROP_COMMAND 33
6199 #define JIM_EXPROP_VARIABLE 34
6200 #define JIM_EXPROP_DICTSUGAR 35
6201 #define JIM_EXPROP_SUBST 36
6202 #define JIM_EXPROP_STRING 37
6203
6204 /* Operators table */
6205 typedef struct Jim_ExprOperator {
6206 const char *name;
6207 int precedence;
6208 int arity;
6209 int opcode;
6210 } Jim_ExprOperator;
6211
6212 /* name - precedence - arity - opcode */
6213 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6214 {"!", 300, 1, JIM_EXPROP_NOT},
6215 {"~", 300, 1, JIM_EXPROP_BITNOT},
6216 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6217 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6218
6219 {"**", 250, 2, JIM_EXPROP_POW},
6220
6221 {"*", 200, 2, JIM_EXPROP_MUL},
6222 {"/", 200, 2, JIM_EXPROP_DIV},
6223 {"%", 200, 2, JIM_EXPROP_MOD},
6224
6225 {"-", 100, 2, JIM_EXPROP_SUB},
6226 {"+", 100, 2, JIM_EXPROP_ADD},
6227
6228 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6229 {">>>", 90, 3, JIM_EXPROP_ROTR},
6230 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6231 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6232
6233 {"<", 80, 2, JIM_EXPROP_LT},
6234 {">", 80, 2, JIM_EXPROP_GT},
6235 {"<=", 80, 2, JIM_EXPROP_LTE},
6236 {">=", 80, 2, JIM_EXPROP_GTE},
6237
6238 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6239 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6240
6241 {"eq", 60, 2, JIM_EXPROP_STREQ},
6242 {"ne", 60, 2, JIM_EXPROP_STRNE},
6243
6244 {"&", 50, 2, JIM_EXPROP_BITAND},
6245 {"^", 49, 2, JIM_EXPROP_BITXOR},
6246 {"|", 48, 2, JIM_EXPROP_BITOR},
6247
6248 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6249 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6250
6251 {"?", 5, 3, JIM_EXPROP_TERNARY},
6252 /* private operators */
6253 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6254 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6255 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6256 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6257 };
6258
6259 #define JIM_EXPR_OPERATORS_NUM \
6260 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6261
6262 static int JimParseExpression(struct JimParserCtx *pc)
6263 {
6264 /* Discard spaces and quoted newline */
6265 while (*(pc->p) == ' ' ||
6266 *(pc->p) == '\t' ||
6267 *(pc->p) == '\r' ||
6268 *(pc->p) == '\n' ||
6269 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6270 pc->p++; pc->len--;
6271 }
6272
6273 if (pc->len == 0) {
6274 pc->tstart = pc->tend = pc->p;
6275 pc->tline = pc->linenr;
6276 pc->tt = JIM_TT_EOL;
6277 pc->eof = 1;
6278 return JIM_OK;
6279 }
6280 switch (*(pc->p)) {
6281 case '(':
6282 pc->tstart = pc->tend = pc->p;
6283 pc->tline = pc->linenr;
6284 pc->tt = JIM_TT_SUBEXPR_START;
6285 pc->p++; pc->len--;
6286 break;
6287 case ')':
6288 pc->tstart = pc->tend = pc->p;
6289 pc->tline = pc->linenr;
6290 pc->tt = JIM_TT_SUBEXPR_END;
6291 pc->p++; pc->len--;
6292 break;
6293 case '[':
6294 return JimParseCmd(pc);
6295 break;
6296 case '$':
6297 if (JimParseVar(pc) == JIM_ERR)
6298 return JimParseExprOperator(pc);
6299 else
6300 return JIM_OK;
6301 break;
6302 case '-':
6303 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6304 isdigit((int)*(pc->p + 1)))
6305 return JimParseExprNumber(pc);
6306 else
6307 return JimParseExprOperator(pc);
6308 break;
6309 case '0': case '1': case '2': case '3': case '4':
6310 case '5': case '6': case '7': case '8': case '9': case '.':
6311 return JimParseExprNumber(pc);
6312 break;
6313 case '"':
6314 case '{':
6315 /* Here it's possible to reuse the List String parsing. */
6316 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6317 return JimParseListStr(pc);
6318 break;
6319 case 'N': case 'I':
6320 case 'n': case 'i':
6321 if (JimParseExprIrrational(pc) == JIM_ERR)
6322 return JimParseExprOperator(pc);
6323 break;
6324 default:
6325 return JimParseExprOperator(pc);
6326 break;
6327 }
6328 return JIM_OK;
6329 }
6330
6331 int JimParseExprNumber(struct JimParserCtx *pc)
6332 {
6333 int allowdot = 1;
6334 int allowhex = 0;
6335
6336 pc->tstart = pc->p;
6337 pc->tline = pc->linenr;
6338 if (*pc->p == '-') {
6339 pc->p++; pc->len--;
6340 }
6341 while (isdigit((int)*pc->p)
6342 || (allowhex && isxdigit((int)*pc->p))
6343 || (allowdot && *pc->p == '.')
6344 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6345 (*pc->p == 'x' || *pc->p == 'X'))
6346 )
6347 {
6348 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6349 allowhex = 1;
6350 allowdot = 0;
6351 }
6352 if (*pc->p == '.')
6353 allowdot = 0;
6354 pc->p++; pc->len--;
6355 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6356 pc->p += 2; pc->len -= 2;
6357 }
6358 }
6359 pc->tend = pc->p-1;
6360 pc->tt = JIM_TT_EXPR_NUMBER;
6361 return JIM_OK;
6362 }
6363
6364 int JimParseExprIrrational(struct JimParserCtx *pc)
6365 {
6366 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6367 const char **token;
6368 for (token = Tokens; *token != NULL; token++) {
6369 int len = strlen(*token);
6370 if (strncmp(*token, pc->p, len) == 0) {
6371 pc->tstart = pc->p;
6372 pc->tend = pc->p + len - 1;
6373 pc->p += len; pc->len -= len;
6374 pc->tline = pc->linenr;
6375 pc->tt = JIM_TT_EXPR_NUMBER;
6376 return JIM_OK;
6377 }
6378 }
6379 return JIM_ERR;
6380 }
6381
6382 int JimParseExprOperator(struct JimParserCtx *pc)
6383 {
6384 int i;
6385 int bestIdx = -1, bestLen = 0;
6386
6387 /* Try to get the longest match. */
6388 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6389 const char *opname;
6390 int oplen;
6391
6392 opname = Jim_ExprOperators[i].name;
6393 if (opname == NULL) continue;
6394 oplen = strlen(opname);
6395
6396 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6397 bestIdx = i;
6398 bestLen = oplen;
6399 }
6400 }
6401 if (bestIdx == -1) return JIM_ERR;
6402 pc->tstart = pc->p;
6403 pc->tend = pc->p + bestLen - 1;
6404 pc->p += bestLen; pc->len -= bestLen;
6405 pc->tline = pc->linenr;
6406 pc->tt = JIM_TT_EXPR_OPERATOR;
6407 return JIM_OK;
6408 }
6409
6410 static struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6411 {
6412 int i;
6413 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6414 if (Jim_ExprOperators[i].name &&
6415 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6416 return &Jim_ExprOperators[i];
6417 return NULL;
6418 }
6419
6420 static struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6421 {
6422 int i;
6423 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6424 if (Jim_ExprOperators[i].opcode == opcode)
6425 return &Jim_ExprOperators[i];
6426 return NULL;
6427 }
6428
6429 /* -----------------------------------------------------------------------------
6430 * Expression Object
6431 * ---------------------------------------------------------------------------*/
6432 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6433 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6434 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6435
6436 static Jim_ObjType exprObjType = {
6437 "expression",
6438 FreeExprInternalRep,
6439 DupExprInternalRep,
6440 NULL,
6441 JIM_TYPE_REFERENCES,
6442 };
6443
6444 /* Expr bytecode structure */
6445 typedef struct ExprByteCode {
6446 int *opcode; /* Integer array of opcodes. */
6447 Jim_Obj **obj; /* Array of associated Jim Objects. */
6448 int len; /* Bytecode length */
6449 int inUse; /* Used for sharing. */
6450 } ExprByteCode;
6451
6452 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6453 {
6454 int i;
6455 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6456
6457 expr->inUse--;
6458 if (expr->inUse != 0) return;
6459 for (i = 0; i < expr->len; i++)
6460 Jim_DecrRefCount(interp, expr->obj[i]);
6461 Jim_Free(expr->opcode);
6462 Jim_Free(expr->obj);
6463 Jim_Free(expr);
6464 }
6465
6466 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6467 {
6468 JIM_NOTUSED(interp);
6469 JIM_NOTUSED(srcPtr);
6470
6471 /* Just returns an simple string. */
6472 dupPtr->typePtr = NULL;
6473 }
6474
6475 /* Add a new instruction to an expression bytecode structure. */
6476 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6477 int opcode, char *str, int len)
6478 {
6479 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6480 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6481 expr->opcode[expr->len] = opcode;
6482 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6483 Jim_IncrRefCount(expr->obj[expr->len]);
6484 expr->len++;
6485 }
6486
6487 /* Check if an expr program looks correct. */
6488 static int ExprCheckCorrectness(ExprByteCode *expr)
6489 {
6490 int i;
6491 int stacklen = 0;
6492
6493 /* Try to check if there are stack underflows,
6494 * and make sure at the end of the program there is
6495 * a single result on the stack. */
6496 for (i = 0; i < expr->len; i++) {
6497 switch (expr->opcode[i]) {
6498 case JIM_EXPROP_NUMBER:
6499 case JIM_EXPROP_STRING:
6500 case JIM_EXPROP_SUBST:
6501 case JIM_EXPROP_VARIABLE:
6502 case JIM_EXPROP_DICTSUGAR:
6503 case JIM_EXPROP_COMMAND:
6504 stacklen++;
6505 break;
6506 case JIM_EXPROP_NOT:
6507 case JIM_EXPROP_BITNOT:
6508 case JIM_EXPROP_UNARYMINUS:
6509 case JIM_EXPROP_UNARYPLUS:
6510 /* Unary operations */
6511 if (stacklen < 1) return JIM_ERR;
6512 break;
6513 case JIM_EXPROP_ADD:
6514 case JIM_EXPROP_SUB:
6515 case JIM_EXPROP_MUL:
6516 case JIM_EXPROP_DIV:
6517 case JIM_EXPROP_MOD:
6518 case JIM_EXPROP_LT:
6519 case JIM_EXPROP_GT:
6520 case JIM_EXPROP_LTE:
6521 case JIM_EXPROP_GTE:
6522 case JIM_EXPROP_ROTL:
6523 case JIM_EXPROP_ROTR:
6524 case JIM_EXPROP_LSHIFT:
6525 case JIM_EXPROP_RSHIFT:
6526 case JIM_EXPROP_NUMEQ:
6527 case JIM_EXPROP_NUMNE:
6528 case JIM_EXPROP_STREQ:
6529 case JIM_EXPROP_STRNE:
6530 case JIM_EXPROP_BITAND:
6531 case JIM_EXPROP_BITXOR:
6532 case JIM_EXPROP_BITOR:
6533 case JIM_EXPROP_LOGICAND:
6534 case JIM_EXPROP_LOGICOR:
6535 case JIM_EXPROP_POW:
6536 /* binary operations */
6537 if (stacklen < 2) return JIM_ERR;
6538 stacklen--;
6539 break;
6540 default:
6541 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6542 break;
6543 }
6544 }
6545 if (stacklen != 1) return JIM_ERR;
6546 return JIM_OK;
6547 }
6548
6549 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6550 ScriptObj *topLevelScript)
6551 {
6552 int i;
6553
6554 return;
6555 for (i = 0; i < expr->len; i++) {
6556 Jim_Obj *foundObjPtr;
6557
6558 if (expr->obj[i] == NULL) continue;
6559 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6560 NULL, expr->obj[i]);
6561 if (foundObjPtr != NULL) {
6562 Jim_IncrRefCount(foundObjPtr);
6563 Jim_DecrRefCount(interp, expr->obj[i]);
6564 expr->obj[i] = foundObjPtr;
6565 }
6566 }
6567 }
6568
6569 /* This procedure converts every occurrence of || and && opereators
6570 * in lazy unary versions.
6571 *
6572 * a b || is converted into:
6573 *
6574 * a <offset> |L b |R
6575 *
6576 * a b && is converted into:
6577 *
6578 * a <offset> &L b &R
6579 *
6580 * "|L" checks if 'a' is true:
6581 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6582 * the opcode just after |R.
6583 * 2) if it is false does nothing.
6584 * "|R" checks if 'b' is true:
6585 * 1) if it is true pushes 1, otherwise pushes 0.
6586 *
6587 * "&L" checks if 'a' is true:
6588 * 1) if it is true does nothing.
6589 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6590 * the opcode just after &R
6591 * "&R" checks if 'a' is true:
6592 * if it is true pushes 1, otherwise pushes 0.
6593 */
6594 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6595 {
6596 while (1) {
6597 int index_t = -1, leftindex, arity, i, offset;
6598 Jim_ExprOperator *op;
6599
6600 /* Search for || or && */
6601 for (i = 0; i < expr->len; i++) {
6602 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6603 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6604 index_t = i;
6605 break;
6606 }
6607 }
6608 if (index_t == -1) return;
6609 /* Search for the end of the first operator */
6610 leftindex = index_t-1;
6611 arity = 1;
6612 while (arity) {
6613 switch (expr->opcode[leftindex]) {
6614 case JIM_EXPROP_NUMBER:
6615 case JIM_EXPROP_COMMAND:
6616 case JIM_EXPROP_VARIABLE:
6617 case JIM_EXPROP_DICTSUGAR:
6618 case JIM_EXPROP_SUBST:
6619 case JIM_EXPROP_STRING:
6620 break;
6621 default:
6622 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6623 if (op == NULL) {
6624 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6625 }
6626 arity += op->arity;
6627 break;
6628 }
6629 arity--;
6630 leftindex--;
6631 }
6632 leftindex++;
6633 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6634 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6635 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6636 sizeof(int)*(expr->len-leftindex));
6637 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6638 sizeof(Jim_Obj*)*(expr->len-leftindex));
6639 expr->len += 2;
6640 index_t += 2;
6641 offset = (index_t-leftindex)-1;
6642 Jim_DecrRefCount(interp, expr->obj[index_t]);
6643 if (expr->opcode[index_t] == JIM_EXPROP_LOGICAND) {
6644 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6645 expr->opcode[index_t] = JIM_EXPROP_LOGICAND_RIGHT;
6646 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6647 expr->obj[index_t] = Jim_NewStringObj(interp, "&R", -1);
6648 } else {
6649 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6650 expr->opcode[index_t] = JIM_EXPROP_LOGICOR_RIGHT;
6651 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6652 expr->obj[index_t] = Jim_NewStringObj(interp, "|R", -1);
6653 }
6654 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6655 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6656 Jim_IncrRefCount(expr->obj[index_t]);
6657 Jim_IncrRefCount(expr->obj[leftindex]);
6658 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6659 }
6660 }
6661
6662 /* This method takes the string representation of an expression
6663 * and generates a program for the Expr's stack-based VM. */
6664 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6665 {
6666 int exprTextLen;
6667 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6668 struct JimParserCtx parser;
6669 int i, shareLiterals;
6670 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6671 Jim_Stack stack;
6672 Jim_ExprOperator *op;
6673
6674 /* Perform literal sharing with the current procedure
6675 * running only if this expression appears to be not generated
6676 * at runtime. */
6677 shareLiterals = objPtr->typePtr == &sourceObjType;
6678
6679 expr->opcode = NULL;
6680 expr->obj = NULL;
6681 expr->len = 0;
6682 expr->inUse = 1;
6683
6684 Jim_InitStack(&stack);
6685 JimParserInit(&parser, exprText, exprTextLen, 1);
6686 while (!JimParserEof(&parser)) {
6687 char *token;
6688 int len, type;
6689
6690 if (JimParseExpression(&parser) != JIM_OK) {
6691 Jim_SetResultString(interp, "Syntax error in expression", -1);
6692 goto err;
6693 }
6694 token = JimParserGetToken(&parser, &len, &type, NULL);
6695 if (type == JIM_TT_EOL) {
6696 Jim_Free(token);
6697 break;
6698 }
6699 switch (type) {
6700 case JIM_TT_STR:
6701 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6702 break;
6703 case JIM_TT_ESC:
6704 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6705 break;
6706 case JIM_TT_VAR:
6707 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6708 break;
6709 case JIM_TT_DICTSUGAR:
6710 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6711 break;
6712 case JIM_TT_CMD:
6713 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6714 break;
6715 case JIM_TT_EXPR_NUMBER:
6716 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6717 break;
6718 case JIM_TT_EXPR_OPERATOR:
6719 op = JimExprOperatorInfo(token);
6720 while (1) {
6721 Jim_ExprOperator *stackTopOp;
6722
6723 if (Jim_StackPeek(&stack) != NULL) {
6724 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6725 } else {
6726 stackTopOp = NULL;
6727 }
6728 if (Jim_StackLen(&stack) && op->arity != 1 &&
6729 stackTopOp && stackTopOp->precedence >= op->precedence)
6730 {
6731 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6732 Jim_StackPeek(&stack), -1);
6733 Jim_StackPop(&stack);
6734 } else {
6735 break;
6736 }
6737 }
6738 Jim_StackPush(&stack, token);
6739 break;
6740 case JIM_TT_SUBEXPR_START:
6741 Jim_StackPush(&stack, Jim_StrDup("("));
6742 Jim_Free(token);
6743 break;
6744 case JIM_TT_SUBEXPR_END:
6745 {
6746 int found = 0;
6747 while (Jim_StackLen(&stack)) {
6748 char *opstr = Jim_StackPop(&stack);
6749 if (!strcmp(opstr, "(")) {
6750 Jim_Free(opstr);
6751 found = 1;
6752 break;
6753 }
6754 op = JimExprOperatorInfo(opstr);
6755 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6756 }
6757 if (!found) {
6758 Jim_SetResultString(interp,
6759 "Unexpected close parenthesis", -1);
6760 goto err;
6761 }
6762 }
6763 Jim_Free(token);
6764 break;
6765 default:
6766 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6767 break;
6768 }
6769 }
6770 while (Jim_StackLen(&stack)) {
6771 char *opstr = Jim_StackPop(&stack);
6772 op = JimExprOperatorInfo(opstr);
6773 if (op == NULL && !strcmp(opstr, "(")) {
6774 Jim_Free(opstr);
6775 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6776 goto err;
6777 }
6778 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6779 }
6780 /* Check program correctness. */
6781 if (ExprCheckCorrectness(expr) != JIM_OK) {
6782 Jim_SetResultString(interp, "Invalid expression", -1);
6783 goto err;
6784 }
6785
6786 /* Free the stack used for the compilation. */
6787 Jim_FreeStackElements(&stack, Jim_Free);
6788 Jim_FreeStack(&stack);
6789
6790 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6791 ExprMakeLazy(interp, expr);
6792
6793 /* Perform literal sharing */
6794 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6795 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6796 if (bodyObjPtr->typePtr == &scriptObjType) {
6797 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6798 ExprShareLiterals(interp, expr, bodyScript);
6799 }
6800 }
6801
6802 /* Free the old internal rep and set the new one. */
6803 Jim_FreeIntRep(interp, objPtr);
6804 Jim_SetIntRepPtr(objPtr, expr);
6805 objPtr->typePtr = &exprObjType;
6806 return JIM_OK;
6807
6808 err: /* we jump here on syntax/compile errors. */
6809 Jim_FreeStackElements(&stack, Jim_Free);
6810 Jim_FreeStack(&stack);
6811 Jim_Free(expr->opcode);
6812 for (i = 0; i < expr->len; i++) {
6813 Jim_DecrRefCount(interp,expr->obj[i]);
6814 }
6815 Jim_Free(expr->obj);
6816 Jim_Free(expr);
6817 return JIM_ERR;
6818 }
6819
6820 static ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6821 {
6822 if (objPtr->typePtr != &exprObjType) {
6823 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6824 return NULL;
6825 }
6826 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6827 }
6828
6829 /* -----------------------------------------------------------------------------
6830 * Expressions evaluation.
6831 * Jim uses a specialized stack-based virtual machine for expressions,
6832 * that takes advantage of the fact that expr's operators
6833 * can't be redefined.
6834 *
6835 * Jim_EvalExpression() uses the bytecode compiled by
6836 * SetExprFromAny() method of the "expression" object.
6837 *
6838 * On success a Tcl Object containing the result of the evaluation
6839 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6840 * returned.
6841 * On error the function returns a retcode != to JIM_OK and set a suitable
6842 * error on the interp.
6843 * ---------------------------------------------------------------------------*/
6844 #define JIM_EE_STATICSTACK_LEN 10
6845
6846 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6847 Jim_Obj **exprResultPtrPtr)
6848 {
6849 ExprByteCode *expr;
6850 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6851 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6852
6853 Jim_IncrRefCount(exprObjPtr);
6854 expr = Jim_GetExpression(interp, exprObjPtr);
6855 if (!expr) {
6856 Jim_DecrRefCount(interp, exprObjPtr);
6857 return JIM_ERR; /* error in expression. */
6858 }
6859 /* In order to avoid that the internal repr gets freed due to
6860 * shimmering of the exprObjPtr's object, we make the internal rep
6861 * shared. */
6862 expr->inUse++;
6863
6864 /* The stack-based expr VM itself */
6865
6866 /* Stack allocation. Expr programs have the feature that
6867 * a program of length N can't require a stack longer than
6868 * N. */
6869 if (expr->len > JIM_EE_STATICSTACK_LEN)
6870 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6871 else
6872 stack = staticStack;
6873
6874 /* Execute every istruction */
6875 for (i = 0; i < expr->len; i++) {
6876 Jim_Obj *A, *B, *objPtr;
6877 jim_wide wA, wB, wC;
6878 double dA, dB, dC;
6879 const char *sA, *sB;
6880 int Alen, Blen, retcode;
6881 int opcode = expr->opcode[i];
6882
6883 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6884 stack[stacklen++] = expr->obj[i];
6885 Jim_IncrRefCount(expr->obj[i]);
6886 } else if (opcode == JIM_EXPROP_VARIABLE) {
6887 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6888 if (objPtr == NULL) {
6889 error = 1;
6890 goto err;
6891 }
6892 stack[stacklen++] = objPtr;
6893 Jim_IncrRefCount(objPtr);
6894 } else if (opcode == JIM_EXPROP_SUBST) {
6895 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6896 &objPtr, JIM_NONE)) != JIM_OK)
6897 {
6898 error = 1;
6899 errRetCode = retcode;
6900 goto err;
6901 }
6902 stack[stacklen++] = objPtr;
6903 Jim_IncrRefCount(objPtr);
6904 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6905 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6906 if (objPtr == NULL) {
6907 error = 1;
6908 goto err;
6909 }
6910 stack[stacklen++] = objPtr;
6911 Jim_IncrRefCount(objPtr);
6912 } else if (opcode == JIM_EXPROP_COMMAND) {
6913 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6914 error = 1;
6915 errRetCode = retcode;
6916 goto err;
6917 }
6918 stack[stacklen++] = interp->result;
6919 Jim_IncrRefCount(interp->result);
6920 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6921 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6922 {
6923 /* Note that there isn't to increment the
6924 * refcount of objects. the references are moved
6925 * from stack to A and B. */
6926 B = stack[--stacklen];
6927 A = stack[--stacklen];
6928
6929 /* --- Integer --- */
6930 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6931 (B->typePtr == &doubleObjType && !B->bytes) ||
6932 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6933 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6934 goto trydouble;
6935 }
6936 Jim_DecrRefCount(interp, A);
6937 Jim_DecrRefCount(interp, B);
6938 switch (expr->opcode[i]) {
6939 case JIM_EXPROP_ADD: wC = wA + wB; break;
6940 case JIM_EXPROP_SUB: wC = wA-wB; break;
6941 case JIM_EXPROP_MUL: wC = wA*wB; break;
6942 case JIM_EXPROP_LT: wC = wA < wB; break;
6943 case JIM_EXPROP_GT: wC = wA > wB; break;
6944 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6945 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6946 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6947 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6948 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6949 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6950 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6951 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6952 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6953 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6954 case JIM_EXPROP_LOGICAND_LEFT:
6955 if (wA == 0) {
6956 i += (int)wB;
6957 wC = 0;
6958 } else {
6959 continue;
6960 }
6961 break;
6962 case JIM_EXPROP_LOGICOR_LEFT:
6963 if (wA != 0) {
6964 i += (int)wB;
6965 wC = 1;
6966 } else {
6967 continue;
6968 }
6969 break;
6970 case JIM_EXPROP_DIV:
6971 if (wB == 0) goto divbyzero;
6972 wC = wA/wB;
6973 break;
6974 case JIM_EXPROP_MOD:
6975 if (wB == 0) goto divbyzero;
6976 wC = wA%wB;
6977 break;
6978 case JIM_EXPROP_ROTL: {
6979 /* uint32_t would be better. But not everyone has inttypes.h?*/
6980 unsigned long uA = (unsigned long)wA;
6981 #ifdef _MSC_VER
6982 wC = _rotl(uA,(unsigned long)wB);
6983 #else
6984 const unsigned int S = sizeof(unsigned long) * 8;
6985 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
6986 #endif
6987 break;
6988 }
6989 case JIM_EXPROP_ROTR: {
6990 unsigned long uA = (unsigned long)wA;
6991 #ifdef _MSC_VER
6992 wC = _rotr(uA,(unsigned long)wB);
6993 #else
6994 const unsigned int S = sizeof(unsigned long) * 8;
6995 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
6996 #endif
6997 break;
6998 }
6999
7000 default:
7001 wC = 0; /* avoid gcc warning */
7002 break;
7003 }
7004 stack[stacklen] = Jim_NewIntObj(interp, wC);
7005 Jim_IncrRefCount(stack[stacklen]);
7006 stacklen++;
7007 continue;
7008 trydouble:
7009 /* --- Double --- */
7010 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7011 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7012
7013 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7014 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7015 opcode = JIM_EXPROP_STRNE;
7016 goto retry_as_string;
7017 }
7018 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7019 opcode = JIM_EXPROP_STREQ;
7020 goto retry_as_string;
7021 }
7022 Jim_DecrRefCount(interp, A);
7023 Jim_DecrRefCount(interp, B);
7024 error = 1;
7025 goto err;
7026 }
7027 Jim_DecrRefCount(interp, A);
7028 Jim_DecrRefCount(interp, B);
7029 switch (expr->opcode[i]) {
7030 case JIM_EXPROP_ROTL:
7031 case JIM_EXPROP_ROTR:
7032 case JIM_EXPROP_LSHIFT:
7033 case JIM_EXPROP_RSHIFT:
7034 case JIM_EXPROP_BITAND:
7035 case JIM_EXPROP_BITXOR:
7036 case JIM_EXPROP_BITOR:
7037 case JIM_EXPROP_MOD:
7038 case JIM_EXPROP_POW:
7039 Jim_SetResultString(interp,
7040 "Got floating-point value where integer was expected", -1);
7041 error = 1;
7042 goto err;
7043 case JIM_EXPROP_ADD: dC = dA + dB; break;
7044 case JIM_EXPROP_SUB: dC = dA-dB; break;
7045 case JIM_EXPROP_MUL: dC = dA*dB; break;
7046 case JIM_EXPROP_LT: dC = dA < dB; break;
7047 case JIM_EXPROP_GT: dC = dA > dB; break;
7048 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7049 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7050 /* FIXME comparing floats for equality/inequality is bad juju */
7051 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7052 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7053 case JIM_EXPROP_LOGICAND_LEFT:
7054 if (dA == 0) {
7055 i += (int)dB;
7056 dC = 0;
7057 } else {
7058 continue;
7059 }
7060 break;
7061 case JIM_EXPROP_LOGICOR_LEFT:
7062 if (dA != 0) {
7063 i += (int)dB;
7064 dC = 1;
7065 } else {
7066 continue;
7067 }
7068 break;
7069 case JIM_EXPROP_DIV:
7070 if (dB == 0) goto divbyzero;
7071 dC = dA/dB;
7072 break;
7073 default:
7074 dC = 0; /* avoid gcc warning */
7075 break;
7076 }
7077 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7078 Jim_IncrRefCount(stack[stacklen]);
7079 stacklen++;
7080 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7081 B = stack[--stacklen];
7082 A = stack[--stacklen];
7083 retry_as_string:
7084 sA = Jim_GetString(A, &Alen);
7085 sB = Jim_GetString(B, &Blen);
7086 switch (opcode) {
7087 case JIM_EXPROP_STREQ:
7088 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7089 wC = 1;
7090 else
7091 wC = 0;
7092 break;
7093 case JIM_EXPROP_STRNE:
7094 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7095 wC = 1;
7096 else
7097 wC = 0;
7098 break;
7099 default:
7100 wC = 0; /* avoid gcc warning */
7101 break;
7102 }
7103 Jim_DecrRefCount(interp, A);
7104 Jim_DecrRefCount(interp, B);
7105 stack[stacklen] = Jim_NewIntObj(interp, wC);
7106 Jim_IncrRefCount(stack[stacklen]);
7107 stacklen++;
7108 } else if (opcode == JIM_EXPROP_NOT ||
7109 opcode == JIM_EXPROP_BITNOT ||
7110 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7111 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7112 /* Note that there isn't to increment the
7113 * refcount of objects. the references are moved
7114 * from stack to A and B. */
7115 A = stack[--stacklen];
7116
7117 /* --- Integer --- */
7118 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7119 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7120 goto trydouble_unary;
7121 }
7122 Jim_DecrRefCount(interp, A);
7123 switch (expr->opcode[i]) {
7124 case JIM_EXPROP_NOT: wC = !wA; break;
7125 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7126 case JIM_EXPROP_LOGICAND_RIGHT:
7127 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7128 default:
7129 wC = 0; /* avoid gcc warning */
7130 break;
7131 }
7132 stack[stacklen] = Jim_NewIntObj(interp, wC);
7133 Jim_IncrRefCount(stack[stacklen]);
7134 stacklen++;
7135 continue;
7136 trydouble_unary:
7137 /* --- Double --- */
7138 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7139 Jim_DecrRefCount(interp, A);
7140 error = 1;
7141 goto err;
7142 }
7143 Jim_DecrRefCount(interp, A);
7144 switch (expr->opcode[i]) {
7145 case JIM_EXPROP_NOT: dC = !dA; break;
7146 case JIM_EXPROP_LOGICAND_RIGHT:
7147 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7148 case JIM_EXPROP_BITNOT:
7149 Jim_SetResultString(interp,
7150 "Got floating-point value where integer was expected", -1);
7151 error = 1;
7152 goto err;
7153 break;
7154 default:
7155 dC = 0; /* avoid gcc warning */
7156 break;
7157 }
7158 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7159 Jim_IncrRefCount(stack[stacklen]);
7160 stacklen++;
7161 } else {
7162 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7163 }
7164 }
7165 err:
7166 /* There is no need to decerement the inUse field because
7167 * this reference is transfered back into the exprObjPtr. */
7168 Jim_FreeIntRep(interp, exprObjPtr);
7169 exprObjPtr->typePtr = &exprObjType;
7170 Jim_SetIntRepPtr(exprObjPtr, expr);
7171 Jim_DecrRefCount(interp, exprObjPtr);
7172 if (!error) {
7173 *exprResultPtrPtr = stack[0];
7174 Jim_IncrRefCount(stack[0]);
7175 errRetCode = JIM_OK;
7176 }
7177 for (i = 0; i < stacklen; i++) {
7178 Jim_DecrRefCount(interp, stack[i]);
7179 }
7180 if (stack != staticStack)
7181 Jim_Free(stack);
7182 return errRetCode;
7183 divbyzero:
7184 error = 1;
7185 Jim_SetResultString(interp, "Division by zero", -1);
7186 goto err;
7187 }
7188
7189 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7190 {
7191 int retcode;
7192 jim_wide wideValue;
7193 double doubleValue;
7194 Jim_Obj *exprResultPtr;
7195
7196 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7197 if (retcode != JIM_OK)
7198 return retcode;
7199 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7200 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7201 {
7202 Jim_DecrRefCount(interp, exprResultPtr);
7203 return JIM_ERR;
7204 } else {
7205 Jim_DecrRefCount(interp, exprResultPtr);
7206 *boolPtr = doubleValue != 0;
7207 return JIM_OK;
7208 }
7209 }
7210 Jim_DecrRefCount(interp, exprResultPtr);
7211 *boolPtr = wideValue != 0;
7212 return JIM_OK;
7213 }
7214
7215 /* -----------------------------------------------------------------------------
7216 * ScanFormat String Object
7217 * ---------------------------------------------------------------------------*/
7218
7219 /* This Jim_Obj will held a parsed representation of a format string passed to
7220 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7221 * to be parsed in its entirely first and then, if correct, can be used for
7222 * scanning. To avoid endless re-parsing, the parsed representation will be
7223 * stored in an internal representation and re-used for performance reason. */
7224
7225 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7226 * scanformat string. This part will later be used to extract information
7227 * out from the string to be parsed by Jim_ScanString */
7228
7229 typedef struct ScanFmtPartDescr {
7230 char type; /* Type of conversion (e.g. c, d, f) */
7231 char modifier; /* Modify type (e.g. l - long, h - short */
7232 size_t width; /* Maximal width of input to be converted */
7233 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7234 char *arg; /* Specification of a CHARSET conversion */
7235 char *prefix; /* Prefix to be scanned literally before conversion */
7236 } ScanFmtPartDescr;
7237
7238 /* The ScanFmtStringObj will held the internal representation of a scanformat
7239 * string parsed and separated in part descriptions. Furthermore it contains
7240 * the original string representation of the scanformat string to allow for
7241 * fast update of the Jim_Obj's string representation part.
7242 *
7243 * As add-on the internal object representation add some scratch pad area
7244 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7245 * memory for purpose of string scanning.
7246 *
7247 * The error member points to a static allocated string in case of a mal-
7248 * formed scanformat string or it contains '0' (NULL) in case of a valid
7249 * parse representation.
7250 *
7251 * The whole memory of the internal representation is allocated as a single
7252 * area of memory that will be internally separated. So freeing and duplicating
7253 * of such an object is cheap */
7254
7255 typedef struct ScanFmtStringObj {
7256 jim_wide size; /* Size of internal repr in bytes */
7257 char *stringRep; /* Original string representation */
7258 size_t count; /* Number of ScanFmtPartDescr contained */
7259 size_t convCount; /* Number of conversions that will assign */
7260 size_t maxPos; /* Max position index if XPG3 is used */
7261 const char *error; /* Ptr to error text (NULL if no error */
7262 char *scratch; /* Some scratch pad used by Jim_ScanString */
7263 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7264 } ScanFmtStringObj;
7265
7266
7267 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7268 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7269 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7270
7271 static Jim_ObjType scanFmtStringObjType = {
7272 "scanformatstring",
7273 FreeScanFmtInternalRep,
7274 DupScanFmtInternalRep,
7275 UpdateStringOfScanFmt,
7276 JIM_TYPE_NONE,
7277 };
7278
7279 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7280 {
7281 JIM_NOTUSED(interp);
7282 Jim_Free((char*)objPtr->internalRep.ptr);
7283 objPtr->internalRep.ptr = 0;
7284 }
7285
7286 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7287 {
7288 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7289 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7290
7291 JIM_NOTUSED(interp);
7292 memcpy(newVec, srcPtr->internalRep.ptr, size);
7293 dupPtr->internalRep.ptr = newVec;
7294 dupPtr->typePtr = &scanFmtStringObjType;
7295 }
7296
7297 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7298 {
7299 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7300
7301 objPtr->bytes = Jim_StrDup(bytes);
7302 objPtr->length = strlen(bytes);
7303 }
7304
7305 /* SetScanFmtFromAny will parse a given string and create the internal
7306 * representation of the format specification. In case of an error
7307 * the error data member of the internal representation will be set
7308 * to an descriptive error text and the function will be left with
7309 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7310 * specification */
7311
7312 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7313 {
7314 ScanFmtStringObj *fmtObj;
7315 char *buffer;
7316 int maxCount, i, approxSize, lastPos = -1;
7317 const char *fmt = objPtr->bytes;
7318 int maxFmtLen = objPtr->length;
7319 const char *fmtEnd = fmt + maxFmtLen;
7320 int curr;
7321
7322 Jim_FreeIntRep(interp, objPtr);
7323 /* Count how many conversions could take place maximally */
7324 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7325 if (fmt[i] == '%')
7326 ++maxCount;
7327 /* Calculate an approximation of the memory necessary */
7328 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7329 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7330 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7331 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7332 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7333 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7334 + 1; /* safety byte */
7335 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7336 memset(fmtObj, 0, approxSize);
7337 fmtObj->size = approxSize;
7338 fmtObj->maxPos = 0;
7339 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7340 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7341 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7342 buffer = fmtObj->stringRep + maxFmtLen + 1;
7343 objPtr->internalRep.ptr = fmtObj;
7344 objPtr->typePtr = &scanFmtStringObjType;
7345 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7346 int width = 0, skip;
7347 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7348 fmtObj->count++;
7349 descr->width = 0; /* Assume width unspecified */
7350 /* Overread and store any "literal" prefix */
7351 if (*fmt != '%' || fmt[1] == '%') {
7352 descr->type = 0;
7353 descr->prefix = &buffer[i];
7354 for (; fmt < fmtEnd; ++fmt) {
7355 if (*fmt == '%') {
7356 if (fmt[1] != '%') break;
7357 ++fmt;
7358 }
7359 buffer[i++] = *fmt;
7360 }
7361 buffer[i++] = 0;
7362 }
7363 /* Skip the conversion introducing '%' sign */
7364 ++fmt;
7365 /* End reached due to non-conversion literal only? */
7366 if (fmt >= fmtEnd)
7367 goto done;
7368 descr->pos = 0; /* Assume "natural" positioning */
7369 if (*fmt == '*') {
7370 descr->pos = -1; /* Okay, conversion will not be assigned */
7371 ++fmt;
7372 } else
7373 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7374 /* Check if next token is a number (could be width or pos */
7375 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7376 fmt += skip;
7377 /* Was the number a XPG3 position specifier? */
7378 if (descr->pos != -1 && *fmt == '$') {
7379 int prev;
7380 ++fmt;
7381 descr->pos = width;
7382 width = 0;
7383 /* Look if "natural" postioning and XPG3 one was mixed */
7384 if ((lastPos == 0 && descr->pos > 0)
7385 || (lastPos > 0 && descr->pos == 0)) {
7386 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7387 return JIM_ERR;
7388 }
7389 /* Look if this position was already used */
7390 for (prev = 0; prev < curr; ++prev) {
7391 if (fmtObj->descr[prev].pos == -1) continue;
7392 if (fmtObj->descr[prev].pos == descr->pos) {
7393 fmtObj->error = "same \"%n$\" conversion specifier "
7394 "used more than once";
7395 return JIM_ERR;
7396 }
7397 }
7398 /* Try to find a width after the XPG3 specifier */
7399 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7400 descr->width = width;
7401 fmt += skip;
7402 }
7403 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7404 fmtObj->maxPos = descr->pos;
7405 } else {
7406 /* Number was not a XPG3, so it has to be a width */
7407 descr->width = width;
7408 }
7409 }
7410 /* If positioning mode was undetermined yet, fix this */
7411 if (lastPos == -1)
7412 lastPos = descr->pos;
7413 /* Handle CHARSET conversion type ... */
7414 if (*fmt == '[') {
7415 int swapped = 1, beg = i, end, j;
7416 descr->type = '[';
7417 descr->arg = &buffer[i];
7418 ++fmt;
7419 if (*fmt == '^') buffer[i++] = *fmt++;
7420 if (*fmt == ']') buffer[i++] = *fmt++;
7421 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7422 if (*fmt != ']') {
7423 fmtObj->error = "unmatched [ in format string";
7424 return JIM_ERR;
7425 }
7426 end = i;
7427 buffer[i++] = 0;
7428 /* In case a range fence was given "backwards", swap it */
7429 while (swapped) {
7430 swapped = 0;
7431 for (j = beg + 1; j < end-1; ++j) {
7432 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7433 char tmp = buffer[j-1];
7434 buffer[j-1] = buffer[j + 1];
7435 buffer[j + 1] = tmp;
7436 swapped = 1;
7437 }
7438 }
7439 }
7440 } else {
7441 /* Remember any valid modifier if given */
7442 if (strchr("hlL", *fmt) != 0)
7443 descr->modifier = tolower((int)*fmt++);
7444
7445 descr->type = *fmt;
7446 if (strchr("efgcsndoxui", *fmt) == 0) {
7447 fmtObj->error = "bad scan conversion character";
7448 return JIM_ERR;
7449 } else if (*fmt == 'c' && descr->width != 0) {
7450 fmtObj->error = "field width may not be specified in %c "
7451 "conversion";
7452 return JIM_ERR;
7453 } else if (*fmt == 'u' && descr->modifier == 'l') {
7454 fmtObj->error = "unsigned wide not supported";
7455 return JIM_ERR;
7456 }
7457 }
7458 curr++;
7459 }
7460 done:
7461 if (fmtObj->convCount == 0) {
7462 fmtObj->error = "no any conversion specifier given";
7463 return JIM_ERR;
7464 }
7465 return JIM_OK;
7466 }
7467
7468 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7469
7470 #define FormatGetCnvCount(_fo_) \
7471 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7472 #define FormatGetMaxPos(_fo_) \
7473 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7474 #define FormatGetError(_fo_) \
7475 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7476
7477 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7478 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7479 * bitvector implementation in Jim? */
7480
7481 static int JimTestBit(const char *bitvec, char ch)
7482 {
7483 div_t pos = div(ch-1, 8);
7484 return bitvec[pos.quot] & (1 << pos.rem);
7485 }
7486
7487 static void JimSetBit(char *bitvec, char ch)
7488 {
7489 div_t pos = div(ch-1, 8);
7490 bitvec[pos.quot] |= (1 << pos.rem);
7491 }
7492
7493 #if 0 /* currently not used */
7494 static void JimClearBit(char *bitvec, char ch)
7495 {
7496 div_t pos = div(ch-1, 8);
7497 bitvec[pos.quot] &= ~(1 << pos.rem);
7498 }
7499 #endif
7500
7501 /* JimScanAString is used to scan an unspecified string that ends with
7502 * next WS, or a string that is specified via a charset. The charset
7503 * is currently implemented in a way to only allow for usage with
7504 * ASCII. Whenever we will switch to UNICODE, another idea has to
7505 * be born :-/
7506 *
7507 * FIXME: Works only with ASCII */
7508
7509 static Jim_Obj *
7510 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7511 {
7512 size_t i;
7513 Jim_Obj *result;
7514 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7515 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7516
7517 /* First init charset to nothing or all, depending if a specified
7518 * or an unspecified string has to be parsed */
7519 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7520 if (sdescr) {
7521 /* There was a set description given, that means we are parsing
7522 * a specified string. So we have to build a corresponding
7523 * charset reflecting the description */
7524 int notFlag = 0;
7525 /* Should the set be negated at the end? */
7526 if (*sdescr == '^') {
7527 notFlag = 1;
7528 ++sdescr;
7529 }
7530 /* Here '-' is meant literally and not to define a range */
7531 if (*sdescr == '-') {
7532 JimSetBit(charset, '-');
7533 ++sdescr;
7534 }
7535 while (*sdescr) {
7536 if (sdescr[1] == '-' && sdescr[2] != 0) {
7537 /* Handle range definitions */
7538 int i_t;
7539 for (i_t = sdescr[0]; i_t <= sdescr[2]; ++i_t)
7540 JimSetBit(charset, (char)i_t);
7541 sdescr += 3;
7542 } else {
7543 /* Handle verbatim character definitions */
7544 JimSetBit(charset, *sdescr++);
7545 }
7546 }
7547 /* Negate the charset if there was a NOT given */
7548 for (i = 0; notFlag && i < sizeof(charset); ++i)
7549 charset[i] = ~charset[i];
7550 }
7551 /* And after all the mess above, the real work begin ... */
7552 while (str && *str) {
7553 if (!sdescr && isspace((int)*str))
7554 break; /* EOS via WS if unspecified */
7555 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7556 else break; /* EOS via mismatch if specified scanning */
7557 }
7558 *buffer = 0; /* Close the string properly ... */
7559 result = Jim_NewStringObj(interp, anchor, -1);
7560 Jim_Free(anchor); /* ... and free it afer usage */
7561 return result;
7562 }
7563
7564 /* ScanOneEntry will scan one entry out of the string passed as argument.
7565 * It use the sscanf() function for this task. After extracting and
7566 * converting of the value, the count of scanned characters will be
7567 * returned of -1 in case of no conversion tool place and string was
7568 * already scanned thru */
7569
7570 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7571 ScanFmtStringObj *fmtObj, long index_t, Jim_Obj **valObjPtr)
7572 {
7573 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7574 ? sizeof(jim_wide) \
7575 : sizeof(double))
7576 char buffer[MAX_SIZE];
7577 char *value = buffer;
7578 const char *tok;
7579 const ScanFmtPartDescr *descr = &fmtObj->descr[index_t];
7580 size_t sLen = strlen(&str[pos]), scanned = 0;
7581 size_t anchor = pos;
7582 int i;
7583
7584 /* First pessimiticly assume, we will not scan anything :-) */
7585 *valObjPtr = 0;
7586 if (descr->prefix) {
7587 /* There was a prefix given before the conversion, skip it and adjust
7588 * the string-to-be-parsed accordingly */
7589 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7590 /* If prefix require, skip WS */
7591 if (isspace((int)descr->prefix[i]))
7592 while (str[pos] && isspace((int)str[pos])) ++pos;
7593 else if (descr->prefix[i] != str[pos])
7594 break; /* Prefix do not match here, leave the loop */
7595 else
7596 ++pos; /* Prefix matched so far, next round */
7597 }
7598 if (str[pos] == 0)
7599 return -1; /* All of str consumed: EOF condition */
7600 else if (descr->prefix[i] != 0)
7601 return 0; /* Not whole prefix consumed, no conversion possible */
7602 }
7603 /* For all but following conversion, skip leading WS */
7604 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7605 while (isspace((int)str[pos])) ++pos;
7606 /* Determine how much skipped/scanned so far */
7607 scanned = pos - anchor;
7608 if (descr->type == 'n') {
7609 /* Return pseudo conversion means: how much scanned so far? */
7610 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7611 } else if (str[pos] == 0) {
7612 /* Cannot scan anything, as str is totally consumed */
7613 return -1;
7614 } else {
7615 /* Processing of conversions follows ... */
7616 if (descr->width > 0) {
7617 /* Do not try to scan as fas as possible but only the given width.
7618 * To ensure this, we copy the part that should be scanned. */
7619 size_t tLen = descr->width > sLen ? sLen : descr->width;
7620 tok = Jim_StrDupLen(&str[pos], tLen);
7621 } else {
7622 /* As no width was given, simply refer to the original string */
7623 tok = &str[pos];
7624 }
7625 switch (descr->type) {
7626 case 'c':
7627 *valObjPtr = Jim_NewIntObj(interp, *tok);
7628 scanned += 1;
7629 break;
7630 case 'd': case 'o': case 'x': case 'u': case 'i': {
7631 jim_wide jwvalue = 0;
7632 long lvalue = 0;
7633 char *endp; /* Position where the number finished */
7634 int base = descr->type == 'o' ? 8
7635 : descr->type == 'x' ? 16
7636 : descr->type == 'i' ? 0
7637 : 10;
7638
7639 do {
7640 /* Try to scan a number with the given base */
7641 if (descr->modifier == 'l')
7642 {
7643 #ifdef HAVE_LONG_LONG_INT
7644 jwvalue = JimStrtoll(tok, &endp, base),
7645 #else
7646 jwvalue = strtol(tok, &endp, base),
7647 #endif
7648 memcpy(value, &jwvalue, sizeof(jim_wide));
7649 }
7650 else
7651 {
7652 if (descr->type == 'u')
7653 lvalue = strtoul(tok, &endp, base);
7654 else
7655 lvalue = strtol(tok, &endp, base);
7656 memcpy(value, &lvalue, sizeof(lvalue));
7657 }
7658 /* If scanning failed, and base was undetermined, simply
7659 * put it to 10 and try once more. This should catch the
7660 * case where %i begin to parse a number prefix (e.g.
7661 * '0x' but no further digits follows. This will be
7662 * handled as a ZERO followed by a char 'x' by Tcl */
7663 if (endp == tok && base == 0) base = 10;
7664 else break;
7665 } while (1);
7666 if (endp != tok) {
7667 /* There was some number sucessfully scanned! */
7668 if (descr->modifier == 'l')
7669 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7670 else
7671 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7672 /* Adjust the number-of-chars scanned so far */
7673 scanned += endp - tok;
7674 } else {
7675 /* Nothing was scanned. We have to determine if this
7676 * happened due to e.g. prefix mismatch or input str
7677 * exhausted */
7678 scanned = *tok ? 0 : -1;
7679 }
7680 break;
7681 }
7682 case 's': case '[': {
7683 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7684 scanned += Jim_Length(*valObjPtr);
7685 break;
7686 }
7687 case 'e': case 'f': case 'g': {
7688 char *endp;
7689
7690 double dvalue = strtod(tok, &endp);
7691 memcpy(value, &dvalue, sizeof(double));
7692 if (endp != tok) {
7693 /* There was some number sucessfully scanned! */
7694 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7695 /* Adjust the number-of-chars scanned so far */
7696 scanned += endp - tok;
7697 } else {
7698 /* Nothing was scanned. We have to determine if this
7699 * happened due to e.g. prefix mismatch or input str
7700 * exhausted */
7701 scanned = *tok ? 0 : -1;
7702 }
7703 break;
7704 }
7705 }
7706 /* If a substring was allocated (due to pre-defined width) do not
7707 * forget to free it */
7708 if (tok != &str[pos])
7709 Jim_Free((char*)tok);
7710 }
7711 return scanned;
7712 }
7713
7714 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7715 * string and returns all converted (and not ignored) values in a list back
7716 * to the caller. If an error occured, a NULL pointer will be returned */
7717
7718 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7719 Jim_Obj *fmtObjPtr, int flags)
7720 {
7721 size_t i, pos;
7722 int scanned = 1;
7723 const char *str = Jim_GetString(strObjPtr, 0);
7724 Jim_Obj *resultList = 0;
7725 Jim_Obj **resultVec =NULL;
7726 int resultc;
7727 Jim_Obj *emptyStr = 0;
7728 ScanFmtStringObj *fmtObj;
7729
7730 /* If format specification is not an object, convert it! */
7731 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7732 SetScanFmtFromAny(interp, fmtObjPtr);
7733 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7734 /* Check if format specification was valid */
7735 if (fmtObj->error != 0) {
7736 if (flags & JIM_ERRMSG)
7737 Jim_SetResultString(interp, fmtObj->error, -1);
7738 return 0;
7739 }
7740 /* Allocate a new "shared" empty string for all unassigned conversions */
7741 emptyStr = Jim_NewEmptyStringObj(interp);
7742 Jim_IncrRefCount(emptyStr);
7743 /* Create a list and fill it with empty strings up to max specified XPG3 */
7744 resultList = Jim_NewListObj(interp, 0, 0);
7745 if (fmtObj->maxPos > 0) {
7746 for (i = 0; i < fmtObj->maxPos; ++i)
7747 Jim_ListAppendElement(interp, resultList, emptyStr);
7748 JimListGetElements(interp, resultList, &resultc, &resultVec);
7749 }
7750 /* Now handle every partial format description */
7751 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7752 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7753 Jim_Obj *value = 0;
7754 /* Only last type may be "literal" w/o conversion - skip it! */
7755 if (descr->type == 0) continue;
7756 /* As long as any conversion could be done, we will proceed */
7757 if (scanned > 0)
7758 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7759 /* In case our first try results in EOF, we will leave */
7760 if (scanned == -1 && i == 0)
7761 goto eof;
7762 /* Advance next pos-to-be-scanned for the amount scanned already */
7763 pos += scanned;
7764 /* value == 0 means no conversion took place so take empty string */
7765 if (value == 0)
7766 value = Jim_NewEmptyStringObj(interp);
7767 /* If value is a non-assignable one, skip it */
7768 if (descr->pos == -1) {
7769 Jim_FreeNewObj(interp, value);
7770 } else if (descr->pos == 0)
7771 /* Otherwise append it to the result list if no XPG3 was given */
7772 Jim_ListAppendElement(interp, resultList, value);
7773 else if (resultVec[descr->pos-1] == emptyStr) {
7774 /* But due to given XPG3, put the value into the corr. slot */
7775 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7776 Jim_IncrRefCount(value);
7777 resultVec[descr->pos-1] = value;
7778 } else {
7779 /* Otherwise, the slot was already used - free obj and ERROR */
7780 Jim_FreeNewObj(interp, value);
7781 goto err;
7782 }
7783 }
7784 Jim_DecrRefCount(interp, emptyStr);
7785 return resultList;
7786 eof:
7787 Jim_DecrRefCount(interp, emptyStr);
7788 Jim_FreeNewObj(interp, resultList);
7789 return (Jim_Obj*)EOF;
7790 err:
7791 Jim_DecrRefCount(interp, emptyStr);
7792 Jim_FreeNewObj(interp, resultList);
7793 return 0;
7794 }
7795
7796 /* -----------------------------------------------------------------------------
7797 * Pseudo Random Number Generation
7798 * ---------------------------------------------------------------------------*/
7799 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7800 int seedLen);
7801
7802 /* Initialize the sbox with the numbers from 0 to 255 */
7803 static void JimPrngInit(Jim_Interp *interp)
7804 {
7805 int i;
7806 unsigned int seed[256];
7807
7808 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7809 for (i = 0; i < 256; i++)
7810 seed[i] = (rand() ^ time(NULL) ^ clock());
7811 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7812 }
7813
7814 /* Generates N bytes of random data */
7815 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7816 {
7817 Jim_PrngState *prng;
7818 unsigned char *destByte = (unsigned char*) dest;
7819 unsigned int si, sj, x;
7820
7821 /* initialization, only needed the first time */
7822 if (interp->prngState == NULL)
7823 JimPrngInit(interp);
7824 prng = interp->prngState;
7825 /* generates 'len' bytes of pseudo-random numbers */
7826 for (x = 0; x < len; x++) {
7827 prng->i = (prng->i + 1) & 0xff;
7828 si = prng->sbox[prng->i];
7829 prng->j = (prng->j + si) & 0xff;
7830 sj = prng->sbox[prng->j];
7831 prng->sbox[prng->i] = sj;
7832 prng->sbox[prng->j] = si;
7833 *destByte++ = prng->sbox[(si + sj)&0xff];
7834 }
7835 }
7836
7837 /* Re-seed the generator with user-provided bytes */
7838 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7839 int seedLen)
7840 {
7841 int i;
7842 unsigned char buf[256];
7843 Jim_PrngState *prng;
7844
7845 /* initialization, only needed the first time */
7846 if (interp->prngState == NULL)
7847 JimPrngInit(interp);
7848 prng = interp->prngState;
7849
7850 /* Set the sbox[i] with i */
7851 for (i = 0; i < 256; i++)
7852 prng->sbox[i] = i;
7853 /* Now use the seed to perform a random permutation of the sbox */
7854 for (i = 0; i < seedLen; i++) {
7855 unsigned char t;
7856
7857 t = prng->sbox[i&0xFF];
7858 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7859 prng->sbox[seed[i]] = t;
7860 }
7861 prng->i = prng->j = 0;
7862 /* discard the first 256 bytes of stream. */
7863 JimRandomBytes(interp, buf, 256);
7864 }
7865
7866 /* -----------------------------------------------------------------------------
7867 * Dynamic libraries support (WIN32 not supported)
7868 * ---------------------------------------------------------------------------*/
7869
7870 #ifdef JIM_DYNLIB
7871 #ifdef WIN32
7872 #define RTLD_LAZY 0
7873 void * dlopen(const char *path, int mode)
7874 {
7875 JIM_NOTUSED(mode);
7876
7877 return (void *)LoadLibraryA(path);
7878 }
7879 int dlclose(void *handle)
7880 {
7881 FreeLibrary((HANDLE)handle);
7882 return 0;
7883 }
7884 void *dlsym(void *handle, const char *symbol)
7885 {
7886 return GetProcAddress((HMODULE)handle, symbol);
7887 }
7888 static char win32_dlerror_string[121];
7889 const char *dlerror(void)
7890 {
7891 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7892 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7893 return win32_dlerror_string;
7894 }
7895 #endif /* WIN32 */
7896
7897 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7898 {
7899 Jim_Obj *libPathObjPtr;
7900 int prefixc, i;
7901 void *handle;
7902 int (*onload)(Jim_Interp *interp);
7903
7904 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7905 if (libPathObjPtr == NULL) {
7906 prefixc = 0;
7907 libPathObjPtr = NULL;
7908 } else {
7909 Jim_IncrRefCount(libPathObjPtr);
7910 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7911 }
7912
7913 for (i = -1; i < prefixc; i++) {
7914 if (i < 0) {
7915 handle = dlopen(pathName, RTLD_LAZY);
7916 } else {
7917 FILE *fp;
7918 char buf[JIM_PATH_LEN];
7919 const char *prefix;
7920 int prefixlen;
7921 Jim_Obj *prefixObjPtr;
7922
7923 buf[0] = '\0';
7924 if (Jim_ListIndex(interp, libPathObjPtr, i,
7925 &prefixObjPtr, JIM_NONE) != JIM_OK)
7926 continue;
7927 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7928 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7929 continue;
7930 if (*pathName == '/') {
7931 strcpy(buf, pathName);
7932 }
7933 else if (prefixlen && prefix[prefixlen-1] == '/')
7934 sprintf(buf, "%s%s", prefix, pathName);
7935 else
7936 sprintf(buf, "%s/%s", prefix, pathName);
7937 fp = fopen(buf, "r");
7938 if (fp == NULL)
7939 continue;
7940 fclose(fp);
7941 handle = dlopen(buf, RTLD_LAZY);
7942 }
7943 if (handle == NULL) {
7944 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7945 Jim_AppendStrings(interp, Jim_GetResult(interp),
7946 "error loading extension \"", pathName,
7947 "\": ", dlerror(), NULL);
7948 if (i < 0)
7949 continue;
7950 goto err;
7951 }
7952 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7953 Jim_SetResultString(interp,
7954 "No Jim_OnLoad symbol found on extension", -1);
7955 goto err;
7956 }
7957 if (onload(interp) == JIM_ERR) {
7958 dlclose(handle);
7959 goto err;
7960 }
7961 Jim_SetEmptyResult(interp);
7962 if (libPathObjPtr != NULL)
7963 Jim_DecrRefCount(interp, libPathObjPtr);
7964 return JIM_OK;
7965 }
7966 err:
7967 if (libPathObjPtr != NULL)
7968 Jim_DecrRefCount(interp, libPathObjPtr);
7969 return JIM_ERR;
7970 }
7971 #else /* JIM_DYNLIB */
7972 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7973 {
7974 JIM_NOTUSED(interp);
7975 JIM_NOTUSED(pathName);
7976
7977 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7978 return JIM_ERR;
7979 }
7980 #endif/* JIM_DYNLIB */
7981
7982 /* -----------------------------------------------------------------------------
7983 * Packages handling
7984 * ---------------------------------------------------------------------------*/
7985
7986 #define JIM_PKG_ANY_VERSION -1
7987
7988 /* Convert a string of the type "1.2" into an integer.
7989 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
7990 * to the integer with value 102 */
7991 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7992 int *intPtr, int flags)
7993 {
7994 char *copy;
7995 jim_wide major, minor;
7996 char *majorStr, *minorStr, *p;
7997
7998 if (v[0] == '\0') {
7999 *intPtr = JIM_PKG_ANY_VERSION;
8000 return JIM_OK;
8001 }
8002
8003 copy = Jim_StrDup(v);
8004 p = strchr(copy, '.');
8005 if (p == NULL) goto badfmt;
8006 *p = '\0';
8007 majorStr = copy;
8008 minorStr = p + 1;
8009
8010 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8011 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8012 goto badfmt;
8013 *intPtr = (int)(major*100 + minor);
8014 Jim_Free(copy);
8015 return JIM_OK;
8016
8017 badfmt:
8018 Jim_Free(copy);
8019 if (flags & JIM_ERRMSG) {
8020 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8021 Jim_AppendStrings(interp, Jim_GetResult(interp),
8022 "invalid package version '", v, "'", NULL);
8023 }
8024 return JIM_ERR;
8025 }
8026
8027 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8028 static int JimPackageMatchVersion(int needed, int actual, int flags)
8029 {
8030 if (needed == JIM_PKG_ANY_VERSION) return 1;
8031 if (flags & JIM_MATCHVER_EXACT) {
8032 return needed == actual;
8033 } else {
8034 return needed/100 == actual/100 && (needed <= actual);
8035 }
8036 }
8037
8038 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8039 int flags)
8040 {
8041 int intVersion;
8042 /* Check if the version format is ok */
8043 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8044 return JIM_ERR;
8045 /* If the package was already provided returns an error. */
8046 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8047 if (flags & JIM_ERRMSG) {
8048 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8049 Jim_AppendStrings(interp, Jim_GetResult(interp),
8050 "package '", name, "' was already provided", NULL);
8051 }
8052 return JIM_ERR;
8053 }
8054 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8055 return JIM_OK;
8056 }
8057
8058 #ifndef JIM_ANSIC
8059
8060 #ifndef WIN32
8061 # include <sys/types.h>
8062 # include <dirent.h>
8063 #else
8064 # include <io.h>
8065 /* Posix dirent.h compatiblity layer for WIN32.
8066 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8067 * Copyright Salvatore Sanfilippo ,2005.
8068 *
8069 * Permission to use, copy, modify, and distribute this software and its
8070 * documentation for any purpose is hereby granted without fee, provided
8071 * that this copyright and permissions notice appear in all copies and
8072 * derivatives.
8073 *
8074 * This software is supplied "as is" without express or implied warranty.
8075 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8076 */
8077
8078 struct dirent {
8079 char *d_name;
8080 };
8081
8082 typedef struct DIR {
8083 long handle; /* -1 for failed rewind */
8084 struct _finddata_t info;
8085 struct dirent result; /* d_name null iff first time */
8086 char *name; /* null-terminated char string */
8087 } DIR;
8088
8089 DIR *opendir(const char *name)
8090 {
8091 DIR *dir = 0;
8092
8093 if (name && name[0]) {
8094 size_t base_length = strlen(name);
8095 const char *all = /* search pattern must end with suitable wildcard */
8096 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8097
8098 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8099 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8100 {
8101 strcat(strcpy(dir->name, name), all);
8102
8103 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8104 dir->result.d_name = 0;
8105 else { /* rollback */
8106 Jim_Free(dir->name);
8107 Jim_Free(dir);
8108 dir = 0;
8109 }
8110 } else { /* rollback */
8111 Jim_Free(dir);
8112 dir = 0;
8113 errno = ENOMEM;
8114 }
8115 } else {
8116 errno = EINVAL;
8117 }
8118 return dir;
8119 }
8120
8121 int closedir(DIR *dir)
8122 {
8123 int result = -1;
8124
8125 if (dir) {
8126 if (dir->handle != -1)
8127 result = _findclose(dir->handle);
8128 Jim_Free(dir->name);
8129 Jim_Free(dir);
8130 }
8131 if (result == -1) /* map all errors to EBADF */
8132 errno = EBADF;
8133 return result;
8134 }
8135
8136 struct dirent *readdir(DIR *dir)
8137 {
8138 struct dirent *result = 0;
8139
8140 if (dir && dir->handle != -1) {
8141 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8142 result = &dir->result;
8143 result->d_name = dir->info.name;
8144 }
8145 } else {
8146 errno = EBADF;
8147 }
8148 return result;
8149 }
8150
8151 #endif /* WIN32 */
8152
8153 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8154 int prefixc, const char *pkgName, int pkgVer, int flags)
8155 {
8156 int bestVer = -1, i;
8157 int pkgNameLen = strlen(pkgName);
8158 char *bestPackage = NULL;
8159 struct dirent *de;
8160
8161 for (i = 0; i < prefixc; i++) {
8162 DIR *dir;
8163 char buf[JIM_PATH_LEN];
8164 int prefixLen;
8165
8166 if (prefixes[i] == NULL) continue;
8167 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8168 buf[JIM_PATH_LEN-1] = '\0';
8169 prefixLen = strlen(buf);
8170 if (prefixLen && buf[prefixLen-1] == '/')
8171 buf[prefixLen-1] = '\0';
8172
8173 if ((dir = opendir(buf)) == NULL) continue;
8174 while ((de = readdir(dir)) != NULL) {
8175 char *fileName = de->d_name;
8176 int fileNameLen = strlen(fileName);
8177
8178 if (strncmp(fileName, "jim-", 4) == 0 &&
8179 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8180 *(fileName + 4+pkgNameLen) == '-' &&
8181 fileNameLen > 4 && /* note that this is not really useful */
8182 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8183 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8184 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8185 {
8186 char ver[6]; /* xx.yy < nulterm> */
8187 char *p = strrchr(fileName, '.');
8188 int verLen, fileVer;
8189
8190 verLen = p - (fileName + 4+pkgNameLen + 1);
8191 if (verLen < 3 || verLen > 5) continue;
8192 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8193 ver[verLen] = '\0';
8194 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8195 != JIM_OK) continue;
8196 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8197 (bestVer == -1 || bestVer < fileVer))
8198 {
8199 bestVer = fileVer;
8200 Jim_Free(bestPackage);
8201 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8202 sprintf(bestPackage, "%s/%s", buf, fileName);
8203 }
8204 }
8205 }
8206 closedir(dir);
8207 }
8208 return bestPackage;
8209 }
8210
8211 #else /* JIM_ANSIC */
8212
8213 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8214 int prefixc, const char *pkgName, int pkgVer, int flags)
8215 {
8216 JIM_NOTUSED(interp);
8217 JIM_NOTUSED(prefixes);
8218 JIM_NOTUSED(prefixc);
8219 JIM_NOTUSED(pkgName);
8220 JIM_NOTUSED(pkgVer);
8221 JIM_NOTUSED(flags);
8222 return NULL;
8223 }
8224
8225 #endif /* JIM_ANSIC */
8226
8227 /* Search for a suitable package under every dir specified by jim_libpath
8228 * and load it if possible. If a suitable package was loaded with success
8229 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8230 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8231 int flags)
8232 {
8233 Jim_Obj *libPathObjPtr;
8234 char **prefixes, *best;
8235 int prefixc, i, retCode = JIM_OK;
8236
8237 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8238 if (libPathObjPtr == NULL) {
8239 prefixc = 0;
8240 libPathObjPtr = NULL;
8241 } else {
8242 Jim_IncrRefCount(libPathObjPtr);
8243 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8244 }
8245
8246 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8247 for (i = 0; i < prefixc; i++) {
8248 Jim_Obj *prefixObjPtr;
8249 if (Jim_ListIndex(interp, libPathObjPtr, i,
8250 &prefixObjPtr, JIM_NONE) != JIM_OK)
8251 {
8252 prefixes[i] = NULL;
8253 continue;
8254 }
8255 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8256 }
8257 /* Scan every directory to find the "best" package. */
8258 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8259 if (best != NULL) {
8260 char *p = strrchr(best, '.');
8261 /* Try to load/source it */
8262 if (p && strcmp(p, ".tcl") == 0) {
8263 retCode = Jim_EvalFile(interp, best);
8264 } else {
8265 retCode = Jim_LoadLibrary(interp, best);
8266 }
8267 } else {
8268 retCode = JIM_ERR;
8269 }
8270 Jim_Free(best);
8271 for (i = 0; i < prefixc; i++)
8272 Jim_Free(prefixes[i]);
8273 Jim_Free(prefixes);
8274 if (libPathObjPtr)
8275 Jim_DecrRefCount(interp, libPathObjPtr);
8276 return retCode;
8277 }
8278
8279 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8280 const char *ver, int flags)
8281 {
8282 Jim_HashEntry *he;
8283 int requiredVer;
8284
8285 /* Start with an empty error string */
8286 Jim_SetResultString(interp, "", 0);
8287
8288 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8289 return NULL;
8290 he = Jim_FindHashEntry(&interp->packages, name);
8291 if (he == NULL) {
8292 /* Try to load the package. */
8293 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8294 he = Jim_FindHashEntry(&interp->packages, name);
8295 if (he == NULL) {
8296 return "?";
8297 }
8298 return he->val;
8299 }
8300 /* No way... return an error. */
8301 if (flags & JIM_ERRMSG) {
8302 int len;
8303 Jim_GetString(Jim_GetResult(interp), &len);
8304 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8305 "Can't find package '", name, "'", NULL);
8306 }
8307 return NULL;
8308 } else {
8309 int actualVer;
8310 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8311 != JIM_OK)
8312 {
8313 return NULL;
8314 }
8315 /* Check if version matches. */
8316 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8317 Jim_AppendStrings(interp, Jim_GetResult(interp),
8318 "Package '", name, "' already loaded, but with version ",
8319 he->val, NULL);
8320 return NULL;
8321 }
8322 return he->val;
8323 }
8324 }
8325
8326 /* -----------------------------------------------------------------------------
8327 * Eval
8328 * ---------------------------------------------------------------------------*/
8329 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8330 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8331
8332 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8333 Jim_Obj *const *argv);
8334
8335 /* Handle calls to the [unknown] command */
8336 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8337 {
8338 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8339 int retCode;
8340
8341 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8342 * done here
8343 */
8344 if (interp->unknown_called) {
8345 return JIM_ERR;
8346 }
8347
8348 /* If the [unknown] command does not exists returns
8349 * just now */
8350 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8351 return JIM_ERR;
8352
8353 /* The object interp->unknown just contains
8354 * the "unknown" string, it is used in order to
8355 * avoid to lookup the unknown command every time
8356 * but instread to cache the result. */
8357 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8358 v = sv;
8359 else
8360 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8361 /* Make a copy of the arguments vector, but shifted on
8362 * the right of one position. The command name of the
8363 * command will be instead the first argument of the
8364 * [unknonw] call. */
8365 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8366 v[0] = interp->unknown;
8367 /* Call it */
8368 interp->unknown_called++;
8369 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8370 interp->unknown_called--;
8371
8372 /* Clean up */
8373 if (v != sv)
8374 Jim_Free(v);
8375 return retCode;
8376 }
8377
8378 /* Eval the object vector 'objv' composed of 'objc' elements.
8379 * Every element is used as single argument.
8380 * Jim_EvalObj() will call this function every time its object
8381 * argument is of "list" type, with no string representation.
8382 *
8383 * This is possible because the string representation of a
8384 * list object generated by the UpdateStringOfList is made
8385 * in a way that ensures that every list element is a different
8386 * command argument. */
8387 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8388 {
8389 int i, retcode;
8390 Jim_Cmd *cmdPtr;
8391
8392 /* Incr refcount of arguments. */
8393 for (i = 0; i < objc; i++)
8394 Jim_IncrRefCount(objv[i]);
8395 /* Command lookup */
8396 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8397 if (cmdPtr == NULL) {
8398 retcode = JimUnknown(interp, objc, objv);
8399 } else {
8400 /* Call it -- Make sure result is an empty object. */
8401 Jim_SetEmptyResult(interp);
8402 if (cmdPtr->cmdProc) {
8403 interp->cmdPrivData = cmdPtr->privData;
8404 retcode = cmdPtr->cmdProc(interp, objc, objv);
8405 if (retcode == JIM_ERR_ADDSTACK) {
8406 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8407 retcode = JIM_ERR;
8408 }
8409 } else {
8410 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8411 if (retcode == JIM_ERR) {
8412 JimAppendStackTrace(interp,
8413 Jim_GetString(objv[0], NULL), "", 1);
8414 }
8415 }
8416 }
8417 /* Decr refcount of arguments and return the retcode */
8418 for (i = 0; i < objc; i++)
8419 Jim_DecrRefCount(interp, objv[i]);
8420 return retcode;
8421 }
8422
8423 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8424 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8425 * The returned object has refcount = 0. */
8426 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8427 int tokens, Jim_Obj **objPtrPtr)
8428 {
8429 int totlen = 0, i, retcode;
8430 Jim_Obj **intv;
8431 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8432 Jim_Obj *objPtr;
8433 char *s;
8434
8435 if (tokens <= JIM_EVAL_SINTV_LEN)
8436 intv = sintv;
8437 else
8438 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8439 tokens);
8440 /* Compute every token forming the argument
8441 * in the intv objects vector. */
8442 for (i = 0; i < tokens; i++) {
8443 switch (token[i].type) {
8444 case JIM_TT_ESC:
8445 case JIM_TT_STR:
8446 intv[i] = token[i].objPtr;
8447 break;
8448 case JIM_TT_VAR:
8449 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8450 if (!intv[i]) {
8451 retcode = JIM_ERR;
8452 goto err;
8453 }
8454 break;
8455 case JIM_TT_DICTSUGAR:
8456 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8457 if (!intv[i]) {
8458 retcode = JIM_ERR;
8459 goto err;
8460 }
8461 break;
8462 case JIM_TT_CMD:
8463 retcode = Jim_EvalObj(interp, token[i].objPtr);
8464 if (retcode != JIM_OK)
8465 goto err;
8466 intv[i] = Jim_GetResult(interp);
8467 break;
8468 default:
8469 Jim_Panic(interp,
8470 "default token type reached "
8471 "in Jim_InterpolateTokens().");
8472 break;
8473 }
8474 Jim_IncrRefCount(intv[i]);
8475 /* Make sure there is a valid
8476 * string rep, and add the string
8477 * length to the total legnth. */
8478 Jim_GetString(intv[i], NULL);
8479 totlen += intv[i]->length;
8480 }
8481 /* Concatenate every token in an unique
8482 * object. */
8483 objPtr = Jim_NewStringObjNoAlloc(interp,
8484 NULL, 0);
8485 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8486 objPtr->length = totlen;
8487 for (i = 0; i < tokens; i++) {
8488 memcpy(s, intv[i]->bytes, intv[i]->length);
8489 s += intv[i]->length;
8490 Jim_DecrRefCount(interp, intv[i]);
8491 }
8492 objPtr->bytes[totlen] = '\0';
8493 /* Free the intv vector if not static. */
8494 if (tokens > JIM_EVAL_SINTV_LEN)
8495 Jim_Free(intv);
8496 *objPtrPtr = objPtr;
8497 return JIM_OK;
8498 err:
8499 i--;
8500 for (; i >= 0; i--)
8501 Jim_DecrRefCount(interp, intv[i]);
8502 if (tokens > JIM_EVAL_SINTV_LEN)
8503 Jim_Free(intv);
8504 return retcode;
8505 }
8506
8507 /* Helper of Jim_EvalObj() to perform argument expansion.
8508 * Basically this function append an argument to 'argv'
8509 * (and increments argc by reference accordingly), performing
8510 * expansion of the list object if 'expand' is non-zero, or
8511 * just adding objPtr to argv if 'expand' is zero. */
8512 static void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8513 int *argcPtr, int expand, Jim_Obj *objPtr)
8514 {
8515 if (!expand) {
8516 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8517 /* refcount of objPtr not incremented because
8518 * we are actually transfering a reference from
8519 * the old 'argv' to the expanded one. */
8520 (*argv)[*argcPtr] = objPtr;
8521 (*argcPtr)++;
8522 } else {
8523 int len, i;
8524
8525 Jim_ListLength(interp, objPtr, &len);
8526 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8527 for (i = 0; i < len; i++) {
8528 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8529 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8530 (*argcPtr)++;
8531 }
8532 /* The original object reference is no longer needed,
8533 * after the expansion it is no longer present on
8534 * the argument vector, but the single elements are
8535 * in its place. */
8536 Jim_DecrRefCount(interp, objPtr);
8537 }
8538 }
8539
8540 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8541 {
8542 int i, j = 0, len;
8543 ScriptObj *script;
8544 ScriptToken *token;
8545 int *cs; /* command structure array */
8546 int retcode = JIM_OK;
8547 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8548
8549 interp->errorFlag = 0;
8550
8551 /* If the object is of type "list" and there is no
8552 * string representation for this object, we can call
8553 * a specialized version of Jim_EvalObj() */
8554 if (scriptObjPtr->typePtr == &listObjType &&
8555 scriptObjPtr->internalRep.listValue.len &&
8556 scriptObjPtr->bytes == NULL) {
8557 Jim_IncrRefCount(scriptObjPtr);
8558 retcode = Jim_EvalObjVector(interp,
8559 scriptObjPtr->internalRep.listValue.len,
8560 scriptObjPtr->internalRep.listValue.ele);
8561 Jim_DecrRefCount(interp, scriptObjPtr);
8562 return retcode;
8563 }
8564
8565 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8566 script = Jim_GetScript(interp, scriptObjPtr);
8567 /* Now we have to make sure the internal repr will not be
8568 * freed on shimmering.
8569 *
8570 * Think for example to this:
8571 *
8572 * set x {llength $x; ... some more code ...}; eval $x
8573 *
8574 * In order to preserve the internal rep, we increment the
8575 * inUse field of the script internal rep structure. */
8576 script->inUse++;
8577
8578 token = script->token;
8579 len = script->len;
8580 cs = script->cmdStruct;
8581 i = 0; /* 'i' is the current token index. */
8582
8583 /* Reset the interpreter result. This is useful to
8584 * return the emtpy result in the case of empty program. */
8585 Jim_SetEmptyResult(interp);
8586
8587 /* Execute every command sequentially, returns on
8588 * error (i.e. if a command does not return JIM_OK) */
8589 while (i < len) {
8590 int expand = 0;
8591 int argc = *cs++; /* Get the number of arguments */
8592 Jim_Cmd *cmd;
8593
8594 /* Set the expand flag if needed. */
8595 if (argc == -1) {
8596 expand++;
8597 argc = *cs++;
8598 }
8599 /* Allocate the arguments vector */
8600 if (argc <= JIM_EVAL_SARGV_LEN)
8601 argv = sargv;
8602 else
8603 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8604 /* Populate the arguments objects. */
8605 for (j = 0; j < argc; j++) {
8606 int tokens = *cs++;
8607
8608 /* tokens is negative if expansion is needed.
8609 * for this argument. */
8610 if (tokens < 0) {
8611 tokens = (-tokens)-1;
8612 i++;
8613 }
8614 if (tokens == 1) {
8615 /* Fast path if the token does not
8616 * need interpolation */
8617 switch (token[i].type) {
8618 case JIM_TT_ESC:
8619 case JIM_TT_STR:
8620 argv[j] = token[i].objPtr;
8621 break;
8622 case JIM_TT_VAR:
8623 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8624 JIM_ERRMSG);
8625 if (!tmpObjPtr) {
8626 retcode = JIM_ERR;
8627 goto err;
8628 }
8629 argv[j] = tmpObjPtr;
8630 break;
8631 case JIM_TT_DICTSUGAR:
8632 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8633 if (!tmpObjPtr) {
8634 retcode = JIM_ERR;
8635 goto err;
8636 }
8637 argv[j] = tmpObjPtr;
8638 break;
8639 case JIM_TT_CMD:
8640 retcode = Jim_EvalObj(interp, token[i].objPtr);
8641 if (retcode != JIM_OK)
8642 goto err;
8643 argv[j] = Jim_GetResult(interp);
8644 break;
8645 default:
8646 Jim_Panic(interp,
8647 "default token type reached "
8648 "in Jim_EvalObj().");
8649 break;
8650 }
8651 Jim_IncrRefCount(argv[j]);
8652 i += 2;
8653 } else {
8654 /* For interpolation we call an helper
8655 * function doing the work for us. */
8656 if ((retcode = Jim_InterpolateTokens(interp,
8657 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8658 {
8659 goto err;
8660 }
8661 argv[j] = tmpObjPtr;
8662 Jim_IncrRefCount(argv[j]);
8663 i += tokens + 1;
8664 }
8665 }
8666 /* Handle {expand} expansion */
8667 if (expand) {
8668 int *ecs = cs - argc;
8669 int eargc = 0;
8670 Jim_Obj **eargv = NULL;
8671
8672 for (j = 0; j < argc; j++) {
8673 Jim_ExpandArgument(interp, &eargv, &eargc,
8674 ecs[j] < 0, argv[j]);
8675 }
8676 if (argv != sargv)
8677 Jim_Free(argv);
8678 argc = eargc;
8679 argv = eargv;
8680 j = argc;
8681 if (argc == 0) {
8682 /* Nothing to do with zero args. */
8683 Jim_Free(eargv);
8684 continue;
8685 }
8686 }
8687 /* Lookup the command to call */
8688 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8689 if (cmd != NULL) {
8690 /* Call it -- Make sure result is an empty object. */
8691 Jim_SetEmptyResult(interp);
8692 if (cmd->cmdProc) {
8693 interp->cmdPrivData = cmd->privData;
8694 retcode = cmd->cmdProc(interp, argc, argv);
8695 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8696 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8697 retcode = JIM_ERR;
8698 }
8699 } else {
8700 retcode = JimCallProcedure(interp, cmd, argc, argv);
8701 if (retcode == JIM_ERR) {
8702 JimAppendStackTrace(interp,
8703 Jim_GetString(argv[0], NULL), script->fileName,
8704 token[i-argc*2].linenr);
8705 }
8706 }
8707 } else {
8708 /* Call [unknown] */
8709 retcode = JimUnknown(interp, argc, argv);
8710 if (retcode == JIM_ERR) {
8711 JimAppendStackTrace(interp,
8712 "", script->fileName,
8713 token[i-argc*2].linenr);
8714 }
8715 }
8716 if (retcode != JIM_OK) {
8717 i -= argc*2; /* point to the command name. */
8718 goto err;
8719 }
8720 /* Decrement the arguments count */
8721 for (j = 0; j < argc; j++) {
8722 Jim_DecrRefCount(interp, argv[j]);
8723 }
8724
8725 if (argv != sargv) {
8726 Jim_Free(argv);
8727 argv = NULL;
8728 }
8729 }
8730 /* Note that we don't have to decrement inUse, because the
8731 * following code transfers our use of the reference again to
8732 * the script object. */
8733 j = 0; /* on normal termination, the argv array is already
8734 Jim_DecrRefCount-ed. */
8735 err:
8736 /* Handle errors. */
8737 if (retcode == JIM_ERR && !interp->errorFlag) {
8738 interp->errorFlag = 1;
8739 JimSetErrorFileName(interp, script->fileName);
8740 JimSetErrorLineNumber(interp, token[i].linenr);
8741 JimResetStackTrace(interp);
8742 }
8743 Jim_FreeIntRep(interp, scriptObjPtr);
8744 scriptObjPtr->typePtr = &scriptObjType;
8745 Jim_SetIntRepPtr(scriptObjPtr, script);
8746 Jim_DecrRefCount(interp, scriptObjPtr);
8747 for (i = 0; i < j; i++) {
8748 Jim_DecrRefCount(interp, argv[i]);
8749 }
8750 if (argv != sargv)
8751 Jim_Free(argv);
8752 return retcode;
8753 }
8754
8755 /* Call a procedure implemented in Tcl.
8756 * It's possible to speed-up a lot this function, currently
8757 * the callframes are not cached, but allocated and
8758 * destroied every time. What is expecially costly is
8759 * to create/destroy the local vars hash table every time.
8760 *
8761 * This can be fixed just implementing callframes caching
8762 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8763 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8764 Jim_Obj *const *argv)
8765 {
8766 int i, retcode;
8767 Jim_CallFrame *callFramePtr;
8768 int num_args;
8769
8770 /* Check arity */
8771 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8772 argc > cmd->arityMax)) {
8773 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8774 Jim_AppendStrings(interp, objPtr,
8775 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8776 (cmd->arityMin > 1) ? " " : "",
8777 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8778 Jim_SetResult(interp, objPtr);
8779 return JIM_ERR;
8780 }
8781 /* Check if there are too nested calls */
8782 if (interp->numLevels == interp->maxNestingDepth) {
8783 Jim_SetResultString(interp,
8784 "Too many nested calls. Infinite recursion?", -1);
8785 return JIM_ERR;
8786 }
8787 /* Create a new callframe */
8788 callFramePtr = JimCreateCallFrame(interp);
8789 callFramePtr->parentCallFrame = interp->framePtr;
8790 callFramePtr->argv = argv;
8791 callFramePtr->argc = argc;
8792 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8793 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8794 callFramePtr->staticVars = cmd->staticVars;
8795 Jim_IncrRefCount(cmd->argListObjPtr);
8796 Jim_IncrRefCount(cmd->bodyObjPtr);
8797 interp->framePtr = callFramePtr;
8798 interp->numLevels ++;
8799
8800 /* Set arguments */
8801 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8802
8803 /* If last argument is 'args', don't set it here */
8804 if (cmd->arityMax == -1) {
8805 num_args--;
8806 }
8807
8808 for (i = 0; i < num_args; i++) {
8809 Jim_Obj *argObjPtr=NULL;
8810 Jim_Obj *nameObjPtr=NULL;
8811 Jim_Obj *valueObjPtr=NULL;
8812
8813 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8814 if (i + 1 >= cmd->arityMin) {
8815 /* The name is the first element of the list */
8816 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8817 }
8818 else {
8819 /* The element arg is the name */
8820 nameObjPtr = argObjPtr;
8821 }
8822
8823 if (i + 1 >= argc) {
8824 /* No more values, so use default */
8825 /* The value is the second element of the list */
8826 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8827 }
8828 else {
8829 valueObjPtr = argv[i + 1];
8830 }
8831 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8832 }
8833 /* Set optional arguments */
8834 if (cmd->arityMax == -1) {
8835 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8836
8837 i++;
8838 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8839 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8840 Jim_SetVariable(interp, objPtr, listObjPtr);
8841 }
8842 /* Eval the body */
8843 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8844
8845 /* Destroy the callframe */
8846 interp->numLevels --;
8847 interp->framePtr = interp->framePtr->parentCallFrame;
8848 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8849 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8850 } else {
8851 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8852 }
8853 /* Handle the JIM_EVAL return code */
8854 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8855 int savedLevel = interp->evalRetcodeLevel;
8856
8857 interp->evalRetcodeLevel = interp->numLevels;
8858 while (retcode == JIM_EVAL) {
8859 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8860 Jim_IncrRefCount(resultScriptObjPtr);
8861 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8862 Jim_DecrRefCount(interp, resultScriptObjPtr);
8863 }
8864 interp->evalRetcodeLevel = savedLevel;
8865 }
8866 /* Handle the JIM_RETURN return code */
8867 if (retcode == JIM_RETURN) {
8868 retcode = interp->returnCode;
8869 interp->returnCode = JIM_OK;
8870 }
8871 return retcode;
8872 }
8873
8874 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8875 {
8876 int retval;
8877 Jim_Obj *scriptObjPtr;
8878
8879 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8880 Jim_IncrRefCount(scriptObjPtr);
8881
8882
8883 if (filename) {
8884 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8885 }
8886
8887 retval = Jim_EvalObj(interp, scriptObjPtr);
8888 Jim_DecrRefCount(interp, scriptObjPtr);
8889 return retval;
8890 }
8891
8892 int Jim_Eval(Jim_Interp *interp, const char *script)
8893 {
8894 return Jim_Eval_Named(interp, script, NULL, 0);
8895 }
8896
8897
8898
8899 /* Execute script in the scope of the global level */
8900 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8901 {
8902 Jim_CallFrame *savedFramePtr;
8903 int retval;
8904
8905 savedFramePtr = interp->framePtr;
8906 interp->framePtr = interp->topFramePtr;
8907 retval = Jim_Eval(interp, script);
8908 interp->framePtr = savedFramePtr;
8909 return retval;
8910 }
8911
8912 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8913 {
8914 Jim_CallFrame *savedFramePtr;
8915 int retval;
8916
8917 savedFramePtr = interp->framePtr;
8918 interp->framePtr = interp->topFramePtr;
8919 retval = Jim_EvalObj(interp, scriptObjPtr);
8920 interp->framePtr = savedFramePtr;
8921 /* Try to report the error (if any) via the bgerror proc */
8922 if (retval != JIM_OK) {
8923 Jim_Obj *objv[2];
8924
8925 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8926 objv[1] = Jim_GetResult(interp);
8927 Jim_IncrRefCount(objv[0]);
8928 Jim_IncrRefCount(objv[1]);
8929 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8930 /* Report the error to stderr. */
8931 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8932 Jim_PrintErrorMessage(interp);
8933 }
8934 Jim_DecrRefCount(interp, objv[0]);
8935 Jim_DecrRefCount(interp, objv[1]);
8936 }
8937 return retval;
8938 }
8939
8940 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8941 {
8942 char *prg = NULL;
8943 FILE *fp;
8944 int nread, totread, maxlen, buflen;
8945 int retval;
8946 Jim_Obj *scriptObjPtr;
8947
8948 if ((fp = fopen(filename, "r")) == NULL) {
8949 const int cwd_len = 2048;
8950 char *cwd = malloc(cwd_len);
8951 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8952 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8953 Jim_AppendStrings(interp, Jim_GetResult(interp),
8954 "Error loading script \"", filename, "\"",
8955 " cwd: ", cwd,
8956 " err: ", strerror(errno), NULL);
8957 free(cwd);
8958 return JIM_ERR;
8959 }
8960 buflen = 1024;
8961 maxlen = totread = 0;
8962 while (1) {
8963 if (maxlen < totread + buflen + 1) {
8964 maxlen = totread + buflen + 1;
8965 prg = Jim_Realloc(prg, maxlen);
8966 }
8967 /* do not use Jim_fread() - this is really a file */
8968 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8969 totread += nread;
8970 }
8971 prg[totread] = '\0';
8972 /* do not use Jim_fclose() - this is really a file */
8973 fclose(fp);
8974
8975 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8976 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8977 Jim_IncrRefCount(scriptObjPtr);
8978 retval = Jim_EvalObj(interp, scriptObjPtr);
8979 Jim_DecrRefCount(interp, scriptObjPtr);
8980 return retval;
8981 }
8982
8983 /* -----------------------------------------------------------------------------
8984 * Subst
8985 * ---------------------------------------------------------------------------*/
8986 static int JimParseSubstStr(struct JimParserCtx *pc)
8987 {
8988 pc->tstart = pc->p;
8989 pc->tline = pc->linenr;
8990 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8991 pc->p++; pc->len--;
8992 }
8993 pc->tend = pc->p-1;
8994 pc->tt = JIM_TT_ESC;
8995 return JIM_OK;
8996 }
8997
8998 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8999 {
9000 int retval;
9001
9002 if (pc->len == 0) {
9003 pc->tstart = pc->tend = pc->p;
9004 pc->tline = pc->linenr;
9005 pc->tt = JIM_TT_EOL;
9006 pc->eof = 1;
9007 return JIM_OK;
9008 }
9009 switch (*pc->p) {
9010 case '[':
9011 retval = JimParseCmd(pc);
9012 if (flags & JIM_SUBST_NOCMD) {
9013 pc->tstart--;
9014 pc->tend++;
9015 pc->tt = (flags & JIM_SUBST_NOESC) ?
9016 JIM_TT_STR : JIM_TT_ESC;
9017 }
9018 return retval;
9019 break;
9020 case '$':
9021 if (JimParseVar(pc) == JIM_ERR) {
9022 pc->tstart = pc->tend = pc->p++; pc->len--;
9023 pc->tline = pc->linenr;
9024 pc->tt = JIM_TT_STR;
9025 } else {
9026 if (flags & JIM_SUBST_NOVAR) {
9027 pc->tstart--;
9028 if (flags & JIM_SUBST_NOESC)
9029 pc->tt = JIM_TT_STR;
9030 else
9031 pc->tt = JIM_TT_ESC;
9032 if (*pc->tstart == '{') {
9033 pc->tstart--;
9034 if (*(pc->tend + 1))
9035 pc->tend++;
9036 }
9037 }
9038 }
9039 break;
9040 default:
9041 retval = JimParseSubstStr(pc);
9042 if (flags & JIM_SUBST_NOESC)
9043 pc->tt = JIM_TT_STR;
9044 return retval;
9045 break;
9046 }
9047 return JIM_OK;
9048 }
9049
9050 /* The subst object type reuses most of the data structures and functions
9051 * of the script object. Script's data structures are a bit more complex
9052 * for what is needed for [subst]itution tasks, but the reuse helps to
9053 * deal with a single data structure at the cost of some more memory
9054 * usage for substitutions. */
9055 static Jim_ObjType substObjType = {
9056 "subst",
9057 FreeScriptInternalRep,
9058 DupScriptInternalRep,
9059 NULL,
9060 JIM_TYPE_REFERENCES,
9061 };
9062
9063 /* This method takes the string representation of an object
9064 * as a Tcl string where to perform [subst]itution, and generates
9065 * the pre-parsed internal representation. */
9066 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9067 {
9068 int scriptTextLen;
9069 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9070 struct JimParserCtx parser;
9071 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9072
9073 script->len = 0;
9074 script->csLen = 0;
9075 script->commands = 0;
9076 script->token = NULL;
9077 script->cmdStruct = NULL;
9078 script->inUse = 1;
9079 script->substFlags = flags;
9080 script->fileName = NULL;
9081
9082 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9083 while (1) {
9084 char *token;
9085 int len, type, linenr;
9086
9087 JimParseSubst(&parser, flags);
9088 if (JimParserEof(&parser)) break;
9089 token = JimParserGetToken(&parser, &len, &type, &linenr);
9090 ScriptObjAddToken(interp, script, token, len, type,
9091 NULL, linenr);
9092 }
9093 /* Free the old internal rep and set the new one. */
9094 Jim_FreeIntRep(interp, objPtr);
9095 Jim_SetIntRepPtr(objPtr, script);
9096 objPtr->typePtr = &scriptObjType;
9097 return JIM_OK;
9098 }
9099
9100 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9101 {
9102 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9103
9104 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9105 SetSubstFromAny(interp, objPtr, flags);
9106 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9107 }
9108
9109 /* Performs commands,variables,blackslashes substitution,
9110 * storing the result object (with refcount 0) into
9111 * resObjPtrPtr. */
9112 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9113 Jim_Obj **resObjPtrPtr, int flags)
9114 {
9115 ScriptObj *script;
9116 ScriptToken *token;
9117 int i, len, retcode = JIM_OK;
9118 Jim_Obj *resObjPtr, *savedResultObjPtr;
9119
9120 script = Jim_GetSubst(interp, substObjPtr, flags);
9121 #ifdef JIM_OPTIMIZATION
9122 /* Fast path for a very common case with array-alike syntax,
9123 * that's: $foo($bar) */
9124 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9125 Jim_Obj *varObjPtr = script->token[0].objPtr;
9126
9127 Jim_IncrRefCount(varObjPtr);
9128 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9129 if (resObjPtr == NULL) {
9130 Jim_DecrRefCount(interp, varObjPtr);
9131 return JIM_ERR;
9132 }
9133 Jim_DecrRefCount(interp, varObjPtr);
9134 *resObjPtrPtr = resObjPtr;
9135 return JIM_OK;
9136 }
9137 #endif
9138
9139 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9140 /* In order to preserve the internal rep, we increment the
9141 * inUse field of the script internal rep structure. */
9142 script->inUse++;
9143
9144 token = script->token;
9145 len = script->len;
9146
9147 /* Save the interp old result, to set it again before
9148 * to return. */
9149 savedResultObjPtr = interp->result;
9150 Jim_IncrRefCount(savedResultObjPtr);
9151
9152 /* Perform the substitution. Starts with an empty object
9153 * and adds every token (performing the appropriate
9154 * var/command/escape substitution). */
9155 resObjPtr = Jim_NewStringObj(interp, "", 0);
9156 for (i = 0; i < len; i++) {
9157 Jim_Obj *objPtr;
9158
9159 switch (token[i].type) {
9160 case JIM_TT_STR:
9161 case JIM_TT_ESC:
9162 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9163 break;
9164 case JIM_TT_VAR:
9165 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9166 if (objPtr == NULL) goto err;
9167 Jim_IncrRefCount(objPtr);
9168 Jim_AppendObj(interp, resObjPtr, objPtr);
9169 Jim_DecrRefCount(interp, objPtr);
9170 break;
9171 case JIM_TT_DICTSUGAR:
9172 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9173 if (!objPtr) {
9174 retcode = JIM_ERR;
9175 goto err;
9176 }
9177 break;
9178 case JIM_TT_CMD:
9179 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9180 goto err;
9181 Jim_AppendObj(interp, resObjPtr, interp->result);
9182 break;
9183 default:
9184 Jim_Panic(interp,
9185 "default token type (%d) reached "
9186 "in Jim_SubstObj().", token[i].type);
9187 break;
9188 }
9189 }
9190 ok:
9191 if (retcode == JIM_OK)
9192 Jim_SetResult(interp, savedResultObjPtr);
9193 Jim_DecrRefCount(interp, savedResultObjPtr);
9194 /* Note that we don't have to decrement inUse, because the
9195 * following code transfers our use of the reference again to
9196 * the script object. */
9197 Jim_FreeIntRep(interp, substObjPtr);
9198 substObjPtr->typePtr = &scriptObjType;
9199 Jim_SetIntRepPtr(substObjPtr, script);
9200 Jim_DecrRefCount(interp, substObjPtr);
9201 *resObjPtrPtr = resObjPtr;
9202 return retcode;
9203 err:
9204 Jim_FreeNewObj(interp, resObjPtr);
9205 retcode = JIM_ERR;
9206 goto ok;
9207 }
9208
9209 /* -----------------------------------------------------------------------------
9210 * API Input/Export functions
9211 * ---------------------------------------------------------------------------*/
9212
9213 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9214 {
9215 Jim_HashEntry *he;
9216
9217 he = Jim_FindHashEntry(&interp->stub, funcname);
9218 if (!he)
9219 return JIM_ERR;
9220 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9221 return JIM_OK;
9222 }
9223
9224 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9225 {
9226 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9227 }
9228
9229 #define JIM_REGISTER_API(name) \
9230 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9231
9232 void JimRegisterCoreApi(Jim_Interp *interp)
9233 {
9234 interp->getApiFuncPtr = Jim_GetApi;
9235 JIM_REGISTER_API(Alloc);
9236 JIM_REGISTER_API(Free);
9237 JIM_REGISTER_API(Eval);
9238 JIM_REGISTER_API(Eval_Named);
9239 JIM_REGISTER_API(EvalGlobal);
9240 JIM_REGISTER_API(EvalFile);
9241 JIM_REGISTER_API(EvalObj);
9242 JIM_REGISTER_API(EvalObjBackground);
9243 JIM_REGISTER_API(EvalObjVector);
9244 JIM_REGISTER_API(InitHashTable);
9245 JIM_REGISTER_API(ExpandHashTable);
9246 JIM_REGISTER_API(AddHashEntry);
9247 JIM_REGISTER_API(ReplaceHashEntry);
9248 JIM_REGISTER_API(DeleteHashEntry);
9249 JIM_REGISTER_API(FreeHashTable);
9250 JIM_REGISTER_API(FindHashEntry);
9251 JIM_REGISTER_API(ResizeHashTable);
9252 JIM_REGISTER_API(GetHashTableIterator);
9253 JIM_REGISTER_API(NextHashEntry);
9254 JIM_REGISTER_API(NewObj);
9255 JIM_REGISTER_API(FreeObj);
9256 JIM_REGISTER_API(InvalidateStringRep);
9257 JIM_REGISTER_API(InitStringRep);
9258 JIM_REGISTER_API(DuplicateObj);
9259 JIM_REGISTER_API(GetString);
9260 JIM_REGISTER_API(Length);
9261 JIM_REGISTER_API(InvalidateStringRep);
9262 JIM_REGISTER_API(NewStringObj);
9263 JIM_REGISTER_API(NewStringObjNoAlloc);
9264 JIM_REGISTER_API(AppendString);
9265 JIM_REGISTER_API(AppendString_sprintf);
9266 JIM_REGISTER_API(AppendObj);
9267 JIM_REGISTER_API(AppendStrings);
9268 JIM_REGISTER_API(StringEqObj);
9269 JIM_REGISTER_API(StringMatchObj);
9270 JIM_REGISTER_API(StringRangeObj);
9271 JIM_REGISTER_API(FormatString);
9272 JIM_REGISTER_API(CompareStringImmediate);
9273 JIM_REGISTER_API(NewReference);
9274 JIM_REGISTER_API(GetReference);
9275 JIM_REGISTER_API(SetFinalizer);
9276 JIM_REGISTER_API(GetFinalizer);
9277 JIM_REGISTER_API(CreateInterp);
9278 JIM_REGISTER_API(FreeInterp);
9279 JIM_REGISTER_API(GetExitCode);
9280 JIM_REGISTER_API(SetStdin);
9281 JIM_REGISTER_API(SetStdout);
9282 JIM_REGISTER_API(SetStderr);
9283 JIM_REGISTER_API(CreateCommand);
9284 JIM_REGISTER_API(CreateProcedure);
9285 JIM_REGISTER_API(DeleteCommand);
9286 JIM_REGISTER_API(RenameCommand);
9287 JIM_REGISTER_API(GetCommand);
9288 JIM_REGISTER_API(SetVariable);
9289 JIM_REGISTER_API(SetVariableStr);
9290 JIM_REGISTER_API(SetGlobalVariableStr);
9291 JIM_REGISTER_API(SetVariableStrWithStr);
9292 JIM_REGISTER_API(SetVariableLink);
9293 JIM_REGISTER_API(GetVariable);
9294 JIM_REGISTER_API(GetCallFrameByLevel);
9295 JIM_REGISTER_API(Collect);
9296 JIM_REGISTER_API(CollectIfNeeded);
9297 JIM_REGISTER_API(GetIndex);
9298 JIM_REGISTER_API(NewListObj);
9299 JIM_REGISTER_API(ListInsertElements);
9300 JIM_REGISTER_API(ListAppendElement);
9301 JIM_REGISTER_API(ListAppendList);
9302 JIM_REGISTER_API(ListLength);
9303 JIM_REGISTER_API(ListIndex);
9304 JIM_REGISTER_API(SetListIndex);
9305 JIM_REGISTER_API(ConcatObj);
9306 JIM_REGISTER_API(NewDictObj);
9307 JIM_REGISTER_API(DictKey);
9308 JIM_REGISTER_API(DictKeysVector);
9309 JIM_REGISTER_API(GetIndex);
9310 JIM_REGISTER_API(GetReturnCode);
9311 JIM_REGISTER_API(EvalExpression);
9312 JIM_REGISTER_API(GetBoolFromExpr);
9313 JIM_REGISTER_API(GetWide);
9314 JIM_REGISTER_API(GetLong);
9315 JIM_REGISTER_API(SetWide);
9316 JIM_REGISTER_API(NewIntObj);
9317 JIM_REGISTER_API(GetDouble);
9318 JIM_REGISTER_API(SetDouble);
9319 JIM_REGISTER_API(NewDoubleObj);
9320 JIM_REGISTER_API(WrongNumArgs);
9321 JIM_REGISTER_API(SetDictKeysVector);
9322 JIM_REGISTER_API(SubstObj);
9323 JIM_REGISTER_API(RegisterApi);
9324 JIM_REGISTER_API(PrintErrorMessage);
9325 JIM_REGISTER_API(InteractivePrompt);
9326 JIM_REGISTER_API(RegisterCoreCommands);
9327 JIM_REGISTER_API(GetSharedString);
9328 JIM_REGISTER_API(ReleaseSharedString);
9329 JIM_REGISTER_API(Panic);
9330 JIM_REGISTER_API(StrDup);
9331 JIM_REGISTER_API(UnsetVariable);
9332 JIM_REGISTER_API(GetVariableStr);
9333 JIM_REGISTER_API(GetGlobalVariable);
9334 JIM_REGISTER_API(GetGlobalVariableStr);
9335 JIM_REGISTER_API(GetAssocData);
9336 JIM_REGISTER_API(SetAssocData);
9337 JIM_REGISTER_API(DeleteAssocData);
9338 JIM_REGISTER_API(GetEnum);
9339 JIM_REGISTER_API(ScriptIsComplete);
9340 JIM_REGISTER_API(PackageRequire);
9341 JIM_REGISTER_API(PackageProvide);
9342 JIM_REGISTER_API(InitStack);
9343 JIM_REGISTER_API(FreeStack);
9344 JIM_REGISTER_API(StackLen);
9345 JIM_REGISTER_API(StackPush);
9346 JIM_REGISTER_API(StackPop);
9347 JIM_REGISTER_API(StackPeek);
9348 JIM_REGISTER_API(FreeStackElements);
9349 JIM_REGISTER_API(fprintf);
9350 JIM_REGISTER_API(vfprintf);
9351 JIM_REGISTER_API(fwrite);
9352 JIM_REGISTER_API(fread);
9353 JIM_REGISTER_API(fflush);
9354 JIM_REGISTER_API(fgets);
9355 JIM_REGISTER_API(GetNvp);
9356 JIM_REGISTER_API(Nvp_name2value);
9357 JIM_REGISTER_API(Nvp_name2value_simple);
9358 JIM_REGISTER_API(Nvp_name2value_obj);
9359 JIM_REGISTER_API(Nvp_name2value_nocase);
9360 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9361
9362 JIM_REGISTER_API(Nvp_value2name);
9363 JIM_REGISTER_API(Nvp_value2name_simple);
9364 JIM_REGISTER_API(Nvp_value2name_obj);
9365
9366 JIM_REGISTER_API(GetOpt_Setup);
9367 JIM_REGISTER_API(GetOpt_Debug);
9368 JIM_REGISTER_API(GetOpt_Obj);
9369 JIM_REGISTER_API(GetOpt_String);
9370 JIM_REGISTER_API(GetOpt_Double);
9371 JIM_REGISTER_API(GetOpt_Wide);
9372 JIM_REGISTER_API(GetOpt_Nvp);
9373 JIM_REGISTER_API(GetOpt_NvpUnknown);
9374 JIM_REGISTER_API(GetOpt_Enum);
9375
9376 JIM_REGISTER_API(Debug_ArgvString);
9377 JIM_REGISTER_API(SetResult_sprintf);
9378 JIM_REGISTER_API(SetResult_NvpUnknown);
9379
9380 }
9381
9382 /* -----------------------------------------------------------------------------
9383 * Core commands utility functions
9384 * ---------------------------------------------------------------------------*/
9385 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9386 const char *msg)
9387 {
9388 int i;
9389 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9390
9391 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9392 for (i = 0; i < argc; i++) {
9393 Jim_AppendObj(interp, objPtr, argv[i]);
9394 if (!(i + 1 == argc && msg[0] == '\0'))
9395 Jim_AppendString(interp, objPtr, " ", 1);
9396 }
9397 Jim_AppendString(interp, objPtr, msg, -1);
9398 Jim_AppendString(interp, objPtr, "\"", 1);
9399 Jim_SetResult(interp, objPtr);
9400 }
9401
9402 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9403 {
9404 Jim_HashTableIterator *htiter;
9405 Jim_HashEntry *he;
9406 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9407 const char *pattern;
9408 int patternLen=0;
9409
9410 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9411 htiter = Jim_GetHashTableIterator(&interp->commands);
9412 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9413 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9414 strlen((const char*)he->key), 0))
9415 continue;
9416 Jim_ListAppendElement(interp, listObjPtr,
9417 Jim_NewStringObj(interp, he->key, -1));
9418 }
9419 Jim_FreeHashTableIterator(htiter);
9420 return listObjPtr;
9421 }
9422
9423 #define JIM_VARLIST_GLOBALS 0
9424 #define JIM_VARLIST_LOCALS 1
9425 #define JIM_VARLIST_VARS 2
9426
9427 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9428 int mode)
9429 {
9430 Jim_HashTableIterator *htiter;
9431 Jim_HashEntry *he;
9432 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9433 const char *pattern;
9434 int patternLen=0;
9435
9436 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9437 if (mode == JIM_VARLIST_GLOBALS) {
9438 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9439 } else {
9440 /* For [info locals], if we are at top level an emtpy list
9441 * is returned. I don't agree, but we aim at compatibility (SS) */
9442 if (mode == JIM_VARLIST_LOCALS &&
9443 interp->framePtr == interp->topFramePtr)
9444 return listObjPtr;
9445 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9446 }
9447 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9448 Jim_Var *varPtr = (Jim_Var*) he->val;
9449 if (mode == JIM_VARLIST_LOCALS) {
9450 if (varPtr->linkFramePtr != NULL)
9451 continue;
9452 }
9453 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9454 strlen((const char*)he->key), 0))
9455 continue;
9456 Jim_ListAppendElement(interp, listObjPtr,
9457 Jim_NewStringObj(interp, he->key, -1));
9458 }
9459 Jim_FreeHashTableIterator(htiter);
9460 return listObjPtr;
9461 }
9462
9463 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9464 Jim_Obj **objPtrPtr)
9465 {
9466 Jim_CallFrame *targetCallFrame;
9467
9468 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9469 != JIM_OK)
9470 return JIM_ERR;
9471 /* No proc call at toplevel callframe */
9472 if (targetCallFrame == interp->topFramePtr) {
9473 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9474 Jim_AppendStrings(interp, Jim_GetResult(interp),
9475 "bad level \"",
9476 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9477 return JIM_ERR;
9478 }
9479 *objPtrPtr = Jim_NewListObj(interp,
9480 targetCallFrame->argv,
9481 targetCallFrame->argc);
9482 return JIM_OK;
9483 }
9484
9485 /* -----------------------------------------------------------------------------
9486 * Core commands
9487 * ---------------------------------------------------------------------------*/
9488
9489 /* fake [puts] -- not the real puts, just for debugging. */
9490 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9491 Jim_Obj *const *argv)
9492 {
9493 const char *str;
9494 int len, nonewline = 0;
9495
9496 if (argc != 2 && argc != 3) {
9497 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9498 return JIM_ERR;
9499 }
9500 if (argc == 3) {
9501 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9502 {
9503 Jim_SetResultString(interp, "The second argument must "
9504 "be -nonewline", -1);
9505 return JIM_OK;
9506 } else {
9507 nonewline = 1;
9508 argv++;
9509 }
9510 }
9511 str = Jim_GetString(argv[1], &len);
9512 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9513 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9514 return JIM_OK;
9515 }
9516
9517 /* Helper for [+] and [*] */
9518 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9519 Jim_Obj *const *argv, int op)
9520 {
9521 jim_wide wideValue, res;
9522 double doubleValue, doubleRes;
9523 int i;
9524
9525 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9526
9527 for (i = 1; i < argc; i++) {
9528 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9529 goto trydouble;
9530 if (op == JIM_EXPROP_ADD)
9531 res += wideValue;
9532 else
9533 res *= wideValue;
9534 }
9535 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9536 return JIM_OK;
9537 trydouble:
9538 doubleRes = (double) res;
9539 for (;i < argc; i++) {
9540 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9541 return JIM_ERR;
9542 if (op == JIM_EXPROP_ADD)
9543 doubleRes += doubleValue;
9544 else
9545 doubleRes *= doubleValue;
9546 }
9547 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9548 return JIM_OK;
9549 }
9550
9551 /* Helper for [-] and [/] */
9552 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9553 Jim_Obj *const *argv, int op)
9554 {
9555 jim_wide wideValue, res = 0;
9556 double doubleValue, doubleRes = 0;
9557 int i = 2;
9558
9559 if (argc < 2) {
9560 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9561 return JIM_ERR;
9562 } else if (argc == 2) {
9563 /* The arity = 2 case is different. For [- x] returns -x,
9564 * while [/ x] returns 1/x. */
9565 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9566 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9567 JIM_OK)
9568 {
9569 return JIM_ERR;
9570 } else {
9571 if (op == JIM_EXPROP_SUB)
9572 doubleRes = -doubleValue;
9573 else
9574 doubleRes = 1.0/doubleValue;
9575 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9576 doubleRes));
9577 return JIM_OK;
9578 }
9579 }
9580 if (op == JIM_EXPROP_SUB) {
9581 res = -wideValue;
9582 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9583 } else {
9584 doubleRes = 1.0/wideValue;
9585 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9586 doubleRes));
9587 }
9588 return JIM_OK;
9589 } else {
9590 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9591 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9592 != JIM_OK) {
9593 return JIM_ERR;
9594 } else {
9595 goto trydouble;
9596 }
9597 }
9598 }
9599 for (i = 2; i < argc; i++) {
9600 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9601 doubleRes = (double) res;
9602 goto trydouble;
9603 }
9604 if (op == JIM_EXPROP_SUB)
9605 res -= wideValue;
9606 else
9607 res /= wideValue;
9608 }
9609 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9610 return JIM_OK;
9611 trydouble:
9612 for (;i < argc; i++) {
9613 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9614 return JIM_ERR;
9615 if (op == JIM_EXPROP_SUB)
9616 doubleRes -= doubleValue;
9617 else
9618 doubleRes /= doubleValue;
9619 }
9620 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9621 return JIM_OK;
9622 }
9623
9624
9625 /* [+] */
9626 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9627 Jim_Obj *const *argv)
9628 {
9629 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9630 }
9631
9632 /* [*] */
9633 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9634 Jim_Obj *const *argv)
9635 {
9636 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9637 }
9638
9639 /* [-] */
9640 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9641 Jim_Obj *const *argv)
9642 {
9643 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9644 }
9645
9646 /* [/] */
9647 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9648 Jim_Obj *const *argv)
9649 {
9650 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9651 }
9652
9653 /* [set] */
9654 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9655 Jim_Obj *const *argv)
9656 {
9657 if (argc != 2 && argc != 3) {
9658 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9659 return JIM_ERR;
9660 }
9661 if (argc == 2) {
9662 Jim_Obj *objPtr;
9663 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9664 if (!objPtr)
9665 return JIM_ERR;
9666 Jim_SetResult(interp, objPtr);
9667 return JIM_OK;
9668 }
9669 /* argc == 3 case. */
9670 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9671 return JIM_ERR;
9672 Jim_SetResult(interp, argv[2]);
9673 return JIM_OK;
9674 }
9675
9676 /* [unset] */
9677 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9678 Jim_Obj *const *argv)
9679 {
9680 int i;
9681
9682 if (argc < 2) {
9683 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9684 return JIM_ERR;
9685 }
9686 for (i = 1; i < argc; i++) {
9687 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9688 return JIM_ERR;
9689 }
9690 return JIM_OK;
9691 }
9692
9693 /* [incr] */
9694 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9695 Jim_Obj *const *argv)
9696 {
9697 jim_wide wideValue, increment = 1;
9698 Jim_Obj *intObjPtr;
9699
9700 if (argc != 2 && argc != 3) {
9701 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9702 return JIM_ERR;
9703 }
9704 if (argc == 3) {
9705 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9706 return JIM_ERR;
9707 }
9708 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9709 if (!intObjPtr) return JIM_ERR;
9710 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9711 return JIM_ERR;
9712 if (Jim_IsShared(intObjPtr)) {
9713 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9714 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9715 Jim_FreeNewObj(interp, intObjPtr);
9716 return JIM_ERR;
9717 }
9718 } else {
9719 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9720 /* The following step is required in order to invalidate the
9721 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9722 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9723 return JIM_ERR;
9724 }
9725 }
9726 Jim_SetResult(interp, intObjPtr);
9727 return JIM_OK;
9728 }
9729
9730 /* [while] */
9731 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9732 Jim_Obj *const *argv)
9733 {
9734 if (argc != 3) {
9735 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9736 return JIM_ERR;
9737 }
9738 /* Try to run a specialized version of while if the expression
9739 * is in one of the following forms:
9740 *
9741 * $a < CONST, $a < $b
9742 * $a <= CONST, $a <= $b
9743 * $a > CONST, $a > $b
9744 * $a >= CONST, $a >= $b
9745 * $a != CONST, $a != $b
9746 * $a == CONST, $a == $b
9747 * $a
9748 * !$a
9749 * CONST
9750 */
9751
9752 #ifdef JIM_OPTIMIZATION
9753 {
9754 ExprByteCode *expr;
9755 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9756 int exprLen, retval;
9757
9758 /* STEP 1 -- Check if there are the conditions to run the specialized
9759 * version of while */
9760
9761 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9762 if (expr->len <= 0 || expr->len > 3) goto noopt;
9763 switch (expr->len) {
9764 case 1:
9765 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9766 expr->opcode[0] != JIM_EXPROP_NUMBER)
9767 goto noopt;
9768 break;
9769 case 2:
9770 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9771 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9772 goto noopt;
9773 break;
9774 case 3:
9775 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9776 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9777 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9778 goto noopt;
9779 switch (expr->opcode[2]) {
9780 case JIM_EXPROP_LT:
9781 case JIM_EXPROP_LTE:
9782 case JIM_EXPROP_GT:
9783 case JIM_EXPROP_GTE:
9784 case JIM_EXPROP_NUMEQ:
9785 case JIM_EXPROP_NUMNE:
9786 /* nothing to do */
9787 break;
9788 default:
9789 goto noopt;
9790 }
9791 break;
9792 default:
9793 Jim_Panic(interp,
9794 "Unexpected default reached in Jim_WhileCoreCommand()");
9795 break;
9796 }
9797
9798 /* STEP 2 -- conditions meet. Initialization. Take different
9799 * branches for different expression lengths. */
9800 exprLen = expr->len;
9801
9802 if (exprLen == 1) {
9803 jim_wide wideValue=0;
9804
9805 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9806 varAObjPtr = expr->obj[0];
9807 Jim_IncrRefCount(varAObjPtr);
9808 } else {
9809 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9810 goto noopt;
9811 }
9812 while (1) {
9813 if (varAObjPtr) {
9814 if (!(objPtr =
9815 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9816 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9817 {
9818 Jim_DecrRefCount(interp, varAObjPtr);
9819 goto noopt;
9820 }
9821 }
9822 if (!wideValue) break;
9823 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9824 switch (retval) {
9825 case JIM_BREAK:
9826 if (varAObjPtr)
9827 Jim_DecrRefCount(interp, varAObjPtr);
9828 goto out;
9829 break;
9830 case JIM_CONTINUE:
9831 continue;
9832 break;
9833 default:
9834 if (varAObjPtr)
9835 Jim_DecrRefCount(interp, varAObjPtr);
9836 return retval;
9837 }
9838 }
9839 }
9840 if (varAObjPtr)
9841 Jim_DecrRefCount(interp, varAObjPtr);
9842 } else if (exprLen == 3) {
9843 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9844 int cmpType = expr->opcode[2];
9845
9846 varAObjPtr = expr->obj[0];
9847 Jim_IncrRefCount(varAObjPtr);
9848 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9849 varBObjPtr = expr->obj[1];
9850 Jim_IncrRefCount(varBObjPtr);
9851 } else {
9852 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9853 goto noopt;
9854 }
9855 while (1) {
9856 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9857 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9858 {
9859 Jim_DecrRefCount(interp, varAObjPtr);
9860 if (varBObjPtr)
9861 Jim_DecrRefCount(interp, varBObjPtr);
9862 goto noopt;
9863 }
9864 if (varBObjPtr) {
9865 if (!(objPtr =
9866 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9867 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9868 {
9869 Jim_DecrRefCount(interp, varAObjPtr);
9870 Jim_DecrRefCount(interp, varBObjPtr);
9871 goto noopt;
9872 }
9873 }
9874 switch (cmpType) {
9875 case JIM_EXPROP_LT:
9876 cmpRes = wideValueA < wideValueB; break;
9877 case JIM_EXPROP_LTE:
9878 cmpRes = wideValueA <= wideValueB; break;
9879 case JIM_EXPROP_GT:
9880 cmpRes = wideValueA > wideValueB; break;
9881 case JIM_EXPROP_GTE:
9882 cmpRes = wideValueA >= wideValueB; break;
9883 case JIM_EXPROP_NUMEQ:
9884 cmpRes = wideValueA == wideValueB; break;
9885 case JIM_EXPROP_NUMNE:
9886 cmpRes = wideValueA != wideValueB; break;
9887 }
9888 if (!cmpRes) break;
9889 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9890 switch (retval) {
9891 case JIM_BREAK:
9892 Jim_DecrRefCount(interp, varAObjPtr);
9893 if (varBObjPtr)
9894 Jim_DecrRefCount(interp, varBObjPtr);
9895 goto out;
9896 break;
9897 case JIM_CONTINUE:
9898 continue;
9899 break;
9900 default:
9901 Jim_DecrRefCount(interp, varAObjPtr);
9902 if (varBObjPtr)
9903 Jim_DecrRefCount(interp, varBObjPtr);
9904 return retval;
9905 }
9906 }
9907 }
9908 Jim_DecrRefCount(interp, varAObjPtr);
9909 if (varBObjPtr)
9910 Jim_DecrRefCount(interp, varBObjPtr);
9911 } else {
9912 /* TODO: case for len == 2 */
9913 goto noopt;
9914 }
9915 Jim_SetEmptyResult(interp);
9916 return JIM_OK;
9917 }
9918 noopt:
9919 #endif
9920
9921 /* The general purpose implementation of while starts here */
9922 while (1) {
9923 int local_boolean, retval;
9924
9925 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9926 &local_boolean)) != JIM_OK)
9927 return retval;
9928 if (!local_boolean) break;
9929 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9930 switch (retval) {
9931 case JIM_BREAK:
9932 goto out;
9933 break;
9934 case JIM_CONTINUE:
9935 continue;
9936 break;
9937 default:
9938 return retval;
9939 }
9940 }
9941 }
9942 out:
9943 Jim_SetEmptyResult(interp);
9944 return JIM_OK;
9945 }
9946
9947 /* [for] */
9948 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9949 Jim_Obj *const *argv)
9950 {
9951 int retval;
9952
9953 if (argc != 5) {
9954 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9955 return JIM_ERR;
9956 }
9957 /* Check if the for is on the form:
9958 * for {set i CONST} {$i < CONST} {incr i}
9959 * for {set i CONST} {$i < $j} {incr i}
9960 * for {set i CONST} {$i <= CONST} {incr i}
9961 * for {set i CONST} {$i <= $j} {incr i}
9962 * XXX: NOTE: if variable traces are implemented, this optimization
9963 * need to be modified to check for the proc epoch at every variable
9964 * update. */
9965 #ifdef JIM_OPTIMIZATION
9966 {
9967 ScriptObj *initScript, *incrScript;
9968 ExprByteCode *expr;
9969 jim_wide start, stop=0, currentVal;
9970 unsigned jim_wide procEpoch = interp->procEpoch;
9971 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9972 int cmpType;
9973 struct Jim_Cmd *cmdPtr;
9974
9975 /* Do it only if there aren't shared arguments */
9976 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9977 goto evalstart;
9978 initScript = Jim_GetScript(interp, argv[1]);
9979 expr = Jim_GetExpression(interp, argv[2]);
9980 incrScript = Jim_GetScript(interp, argv[3]);
9981
9982 /* Ensure proper lengths to start */
9983 if (initScript->len != 6) goto evalstart;
9984 if (incrScript->len != 4) goto evalstart;
9985 if (expr->len != 3) goto evalstart;
9986 /* Ensure proper token types. */
9987 if (initScript->token[2].type != JIM_TT_ESC ||
9988 initScript->token[4].type != JIM_TT_ESC ||
9989 incrScript->token[2].type != JIM_TT_ESC ||
9990 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9991 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9992 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9993 (expr->opcode[2] != JIM_EXPROP_LT &&
9994 expr->opcode[2] != JIM_EXPROP_LTE))
9995 goto evalstart;
9996 cmpType = expr->opcode[2];
9997 /* Initialization command must be [set] */
9998 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9999 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10000 goto evalstart;
10001 /* Update command must be incr */
10002 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10003 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10004 goto evalstart;
10005 /* set, incr, expression must be about the same variable */
10006 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10007 incrScript->token[2].objPtr, 0))
10008 goto evalstart;
10009 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10010 expr->obj[0], 0))
10011 goto evalstart;
10012 /* Check that the initialization and comparison are valid integers */
10013 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10014 goto evalstart;
10015 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10016 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10017 {
10018 goto evalstart;
10019 }
10020
10021 /* Initialization */
10022 varNamePtr = expr->obj[0];
10023 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10024 stopVarNamePtr = expr->obj[1];
10025 Jim_IncrRefCount(stopVarNamePtr);
10026 }
10027 Jim_IncrRefCount(varNamePtr);
10028
10029 /* --- OPTIMIZED FOR --- */
10030 /* Start to loop */
10031 objPtr = Jim_NewIntObj(interp, start);
10032 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10033 Jim_DecrRefCount(interp, varNamePtr);
10034 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10035 Jim_FreeNewObj(interp, objPtr);
10036 goto evalstart;
10037 }
10038 while (1) {
10039 /* === Check condition === */
10040 /* Common code: */
10041 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10042 if (objPtr == NULL ||
10043 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10044 {
10045 Jim_DecrRefCount(interp, varNamePtr);
10046 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10047 goto testcond;
10048 }
10049 /* Immediate or Variable? get the 'stop' value if the latter. */
10050 if (stopVarNamePtr) {
10051 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10052 if (objPtr == NULL ||
10053 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10054 {
10055 Jim_DecrRefCount(interp, varNamePtr);
10056 Jim_DecrRefCount(interp, stopVarNamePtr);
10057 goto testcond;
10058 }
10059 }
10060 if (cmpType == JIM_EXPROP_LT) {
10061 if (currentVal >= stop) break;
10062 } else {
10063 if (currentVal > stop) break;
10064 }
10065 /* Eval body */
10066 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10067 switch (retval) {
10068 case JIM_BREAK:
10069 if (stopVarNamePtr)
10070 Jim_DecrRefCount(interp, stopVarNamePtr);
10071 Jim_DecrRefCount(interp, varNamePtr);
10072 goto out;
10073 case JIM_CONTINUE:
10074 /* nothing to do */
10075 break;
10076 default:
10077 if (stopVarNamePtr)
10078 Jim_DecrRefCount(interp, stopVarNamePtr);
10079 Jim_DecrRefCount(interp, varNamePtr);
10080 return retval;
10081 }
10082 }
10083 /* If there was a change in procedures/command continue
10084 * with the usual [for] command implementation */
10085 if (procEpoch != interp->procEpoch) {
10086 if (stopVarNamePtr)
10087 Jim_DecrRefCount(interp, stopVarNamePtr);
10088 Jim_DecrRefCount(interp, varNamePtr);
10089 goto evalnext;
10090 }
10091 /* Increment */
10092 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10093 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10094 objPtr->internalRep.wideValue ++;
10095 Jim_InvalidateStringRep(objPtr);
10096 } else {
10097 Jim_Obj *auxObjPtr;
10098
10099 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10100 if (stopVarNamePtr)
10101 Jim_DecrRefCount(interp, stopVarNamePtr);
10102 Jim_DecrRefCount(interp, varNamePtr);
10103 goto evalnext;
10104 }
10105 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10106 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10107 if (stopVarNamePtr)
10108 Jim_DecrRefCount(interp, stopVarNamePtr);
10109 Jim_DecrRefCount(interp, varNamePtr);
10110 Jim_FreeNewObj(interp, auxObjPtr);
10111 goto evalnext;
10112 }
10113 }
10114 }
10115 if (stopVarNamePtr)
10116 Jim_DecrRefCount(interp, stopVarNamePtr);
10117 Jim_DecrRefCount(interp, varNamePtr);
10118 Jim_SetEmptyResult(interp);
10119 return JIM_OK;
10120 }
10121 #endif
10122 evalstart:
10123 /* Eval start */
10124 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10125 return retval;
10126 while (1) {
10127 int local_boolean;
10128 testcond:
10129 /* Test the condition */
10130 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &local_boolean))
10131 != JIM_OK)
10132 return retval;
10133 if (!local_boolean) break;
10134 /* Eval body */
10135 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10136 switch (retval) {
10137 case JIM_BREAK:
10138 goto out;
10139 break;
10140 case JIM_CONTINUE:
10141 /* Nothing to do */
10142 break;
10143 default:
10144 return retval;
10145 }
10146 }
10147 evalnext:
10148 /* Eval next */
10149 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10150 switch (retval) {
10151 case JIM_BREAK:
10152 goto out;
10153 break;
10154 case JIM_CONTINUE:
10155 continue;
10156 break;
10157 default:
10158 return retval;
10159 }
10160 }
10161 }
10162 out:
10163 Jim_SetEmptyResult(interp);
10164 return JIM_OK;
10165 }
10166
10167 /* foreach + lmap implementation. */
10168 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10169 Jim_Obj *const *argv, int doMap)
10170 {
10171 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10172 int nbrOfLoops = 0;
10173 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10174
10175 if (argc < 4 || argc % 2 != 0) {
10176 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10177 return JIM_ERR;
10178 }
10179 if (doMap) {
10180 mapRes = Jim_NewListObj(interp, NULL, 0);
10181 Jim_IncrRefCount(mapRes);
10182 }
10183 emptyStr = Jim_NewEmptyStringObj(interp);
10184 Jim_IncrRefCount(emptyStr);
10185 script = argv[argc-1]; /* Last argument is a script */
10186 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10187 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10188 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10189 /* Initialize iterators and remember max nbr elements each list */
10190 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10191 /* Remember lengths of all lists and calculate how much rounds to loop */
10192 for (i = 0; i < nbrOfLists*2; i += 2) {
10193 div_t cnt;
10194 int count;
10195 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10196 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10197 if (listsEnd[i] == 0) {
10198 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10199 goto err;
10200 }
10201 cnt = div(listsEnd[i + 1], listsEnd[i]);
10202 count = cnt.quot + (cnt.rem ? 1 : 0);
10203 if (count > nbrOfLoops)
10204 nbrOfLoops = count;
10205 }
10206 for (; nbrOfLoops-- > 0;) {
10207 for (i = 0; i < nbrOfLists; ++i) {
10208 int varIdx = 0, var = i * 2;
10209 while (varIdx < listsEnd[var]) {
10210 Jim_Obj *varName, *ele;
10211 int lst = i * 2 + 1;
10212 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10213 != JIM_OK)
10214 goto err;
10215 if (listsIdx[i] < listsEnd[lst]) {
10216 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10217 != JIM_OK)
10218 goto err;
10219 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10220 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10221 goto err;
10222 }
10223 ++listsIdx[i]; /* Remember next iterator of current list */
10224 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10225 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10226 goto err;
10227 }
10228 ++varIdx; /* Next variable */
10229 }
10230 }
10231 switch (result = Jim_EvalObj(interp, script)) {
10232 case JIM_OK:
10233 if (doMap)
10234 Jim_ListAppendElement(interp, mapRes, interp->result);
10235 break;
10236 case JIM_CONTINUE:
10237 break;
10238 case JIM_BREAK:
10239 goto out;
10240 break;
10241 default:
10242 goto err;
10243 }
10244 }
10245 out:
10246 result = JIM_OK;
10247 if (doMap)
10248 Jim_SetResult(interp, mapRes);
10249 else
10250 Jim_SetEmptyResult(interp);
10251 err:
10252 if (doMap)
10253 Jim_DecrRefCount(interp, mapRes);
10254 Jim_DecrRefCount(interp, emptyStr);
10255 Jim_Free(listsIdx);
10256 Jim_Free(listsEnd);
10257 return result;
10258 }
10259
10260 /* [foreach] */
10261 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10262 Jim_Obj *const *argv)
10263 {
10264 return JimForeachMapHelper(interp, argc, argv, 0);
10265 }
10266
10267 /* [lmap] */
10268 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10269 Jim_Obj *const *argv)
10270 {
10271 return JimForeachMapHelper(interp, argc, argv, 1);
10272 }
10273
10274 /* [if] */
10275 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10276 Jim_Obj *const *argv)
10277 {
10278 int local_boolean, retval, current = 1, falsebody = 0;
10279 if (argc >= 3) {
10280 while (1) {
10281 /* Far not enough arguments given! */
10282 if (current >= argc) goto err;
10283 if ((retval = Jim_GetBoolFromExpr(interp,
10284 argv[current++], &local_boolean))
10285 != JIM_OK)
10286 return retval;
10287 /* There lacks something, isn't it? */
10288 if (current >= argc) goto err;
10289 if (Jim_CompareStringImmediate(interp, argv[current],
10290 "then")) current++;
10291 /* Tsk tsk, no then-clause? */
10292 if (current >= argc) goto err;
10293 if (local_boolean)
10294 return Jim_EvalObj(interp, argv[current]);
10295 /* Ok: no else-clause follows */
10296 if (++current >= argc) {
10297 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10298 return JIM_OK;
10299 }
10300 falsebody = current++;
10301 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10302 "else")) {
10303 /* IIICKS - else-clause isn't last cmd? */
10304 if (current != argc-1) goto err;
10305 return Jim_EvalObj(interp, argv[current]);
10306 } else if (Jim_CompareStringImmediate(interp,
10307 argv[falsebody], "elseif"))
10308 /* Ok: elseif follows meaning all the stuff
10309 * again (how boring...) */
10310 continue;
10311 /* OOPS - else-clause is not last cmd?*/
10312 else if (falsebody != argc-1)
10313 goto err;
10314 return Jim_EvalObj(interp, argv[falsebody]);
10315 }
10316 return JIM_OK;
10317 }
10318 err:
10319 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10320 return JIM_ERR;
10321 }
10322
10323 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10324
10325 /* [switch] */
10326 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10327 Jim_Obj *const *argv)
10328 {
10329 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10330 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10331 Jim_Obj *script = 0;
10332 if (argc < 3) goto wrongnumargs;
10333 for (opt = 1; opt < argc; ++opt) {
10334 const char *option = Jim_GetString(argv[opt], 0);
10335 if (*option != '-') break;
10336 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10337 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10338 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10339 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10340 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10341 if ((argc - opt) < 2) goto wrongnumargs;
10342 command = argv[++opt];
10343 } else {
10344 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10345 Jim_AppendStrings(interp, Jim_GetResult(interp),
10346 "bad option \"", option, "\": must be -exact, -glob, "
10347 "-regexp, -command procname or --", 0);
10348 goto err;
10349 }
10350 if ((argc - opt) < 2) goto wrongnumargs;
10351 }
10352 strObj = argv[opt++];
10353 patCount = argc - opt;
10354 if (patCount == 1) {
10355 Jim_Obj **vector;
10356 JimListGetElements(interp, argv[opt], &patCount, &vector);
10357 caseList = vector;
10358 } else
10359 caseList = &argv[opt];
10360 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10361 for (i = 0; script == 0 && i < patCount; i += 2) {
10362 Jim_Obj *patObj = caseList[i];
10363 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10364 || i < (patCount-2)) {
10365 switch (matchOpt) {
10366 case SWITCH_EXACT:
10367 if (Jim_StringEqObj(strObj, patObj, 0))
10368 script = caseList[i + 1];
10369 break;
10370 case SWITCH_GLOB:
10371 if (Jim_StringMatchObj(patObj, strObj, 0))
10372 script = caseList[i + 1];
10373 break;
10374 case SWITCH_RE:
10375 command = Jim_NewStringObj(interp, "regexp", -1);
10376 /* Fall thru intentionally */
10377 case SWITCH_CMD: {
10378 Jim_Obj *parms[] = {command, patObj, strObj};
10379 int rc = Jim_EvalObjVector(interp, 3, parms);
10380 long matching;
10381 /* After the execution of a command we need to
10382 * make sure to reconvert the object into a list
10383 * again. Only for the single-list style [switch]. */
10384 if (argc-opt == 1) {
10385 Jim_Obj **vector;
10386 JimListGetElements(interp, argv[opt], &patCount,
10387 &vector);
10388 caseList = vector;
10389 }
10390 /* command is here already decref'd */
10391 if (rc != JIM_OK) {
10392 retcode = rc;
10393 goto err;
10394 }
10395 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10396 if (rc != JIM_OK) {
10397 retcode = rc;
10398 goto err;
10399 }
10400 if (matching)
10401 script = caseList[i + 1];
10402 break;
10403 }
10404 default:
10405 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10406 Jim_AppendStrings(interp, Jim_GetResult(interp),
10407 "internal error: no such option implemented", 0);
10408 goto err;
10409 }
10410 } else {
10411 script = caseList[i + 1];
10412 }
10413 }
10414 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10415 i += 2)
10416 script = caseList[i + 1];
10417 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10418 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10419 Jim_AppendStrings(interp, Jim_GetResult(interp),
10420 "no body specified for pattern \"",
10421 Jim_GetString(caseList[i-2], 0), "\"", 0);
10422 goto err;
10423 }
10424 retcode = JIM_OK;
10425 Jim_SetEmptyResult(interp);
10426 if (script != 0)
10427 retcode = Jim_EvalObj(interp, script);
10428 return retcode;
10429 wrongnumargs:
10430 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10431 "pattern body ... ?default body? or "
10432 "{pattern body ?pattern body ...?}");
10433 err:
10434 return retcode;
10435 }
10436
10437 /* [list] */
10438 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10439 Jim_Obj *const *argv)
10440 {
10441 Jim_Obj *listObjPtr;
10442
10443 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10444 Jim_SetResult(interp, listObjPtr);
10445 return JIM_OK;
10446 }
10447
10448 /* [lindex] */
10449 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10450 Jim_Obj *const *argv)
10451 {
10452 Jim_Obj *objPtr, *listObjPtr;
10453 int i;
10454 int index_t;
10455
10456 if (argc < 3) {
10457 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10458 return JIM_ERR;
10459 }
10460 objPtr = argv[1];
10461 Jim_IncrRefCount(objPtr);
10462 for (i = 2; i < argc; i++) {
10463 listObjPtr = objPtr;
10464 if (Jim_GetIndex(interp, argv[i], &index_t) != JIM_OK) {
10465 Jim_DecrRefCount(interp, listObjPtr);
10466 return JIM_ERR;
10467 }
10468 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
10469 JIM_NONE) != JIM_OK) {
10470 /* Returns an empty object if the index
10471 * is out of range. */
10472 Jim_DecrRefCount(interp, listObjPtr);
10473 Jim_SetEmptyResult(interp);
10474 return JIM_OK;
10475 }
10476 Jim_IncrRefCount(objPtr);
10477 Jim_DecrRefCount(interp, listObjPtr);
10478 }
10479 Jim_SetResult(interp, objPtr);
10480 Jim_DecrRefCount(interp, objPtr);
10481 return JIM_OK;
10482 }
10483
10484 /* [llength] */
10485 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10486 Jim_Obj *const *argv)
10487 {
10488 int len;
10489
10490 if (argc != 2) {
10491 Jim_WrongNumArgs(interp, 1, argv, "list");
10492 return JIM_ERR;
10493 }
10494 Jim_ListLength(interp, argv[1], &len);
10495 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10496 return JIM_OK;
10497 }
10498
10499 /* [lappend] */
10500 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10501 Jim_Obj *const *argv)
10502 {
10503 Jim_Obj *listObjPtr;
10504 int shared, i;
10505
10506 if (argc < 2) {
10507 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10508 return JIM_ERR;
10509 }
10510 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10511 if (!listObjPtr) {
10512 /* Create the list if it does not exists */
10513 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10514 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10515 Jim_FreeNewObj(interp, listObjPtr);
10516 return JIM_ERR;
10517 }
10518 }
10519 shared = Jim_IsShared(listObjPtr);
10520 if (shared)
10521 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10522 for (i = 2; i < argc; i++)
10523 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10524 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10525 if (shared)
10526 Jim_FreeNewObj(interp, listObjPtr);
10527 return JIM_ERR;
10528 }
10529 Jim_SetResult(interp, listObjPtr);
10530 return JIM_OK;
10531 }
10532
10533 /* [linsert] */
10534 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10535 Jim_Obj *const *argv)
10536 {
10537 int index_t, len;
10538 Jim_Obj *listPtr;
10539
10540 if (argc < 4) {
10541 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10542 "?element ...?");
10543 return JIM_ERR;
10544 }
10545 listPtr = argv[1];
10546 if (Jim_IsShared(listPtr))
10547 listPtr = Jim_DuplicateObj(interp, listPtr);
10548 if (Jim_GetIndex(interp, argv[2], &index_t) != JIM_OK)
10549 goto err;
10550 Jim_ListLength(interp, listPtr, &len);
10551 if (index_t >= len)
10552 index_t = len;
10553 else if (index_t < 0)
10554 index_t = len + index_t + 1;
10555 Jim_ListInsertElements(interp, listPtr, index_t, argc-3, &argv[3]);
10556 Jim_SetResult(interp, listPtr);
10557 return JIM_OK;
10558 err:
10559 if (listPtr != argv[1]) {
10560 Jim_FreeNewObj(interp, listPtr);
10561 }
10562 return JIM_ERR;
10563 }
10564
10565 /* [lset] */
10566 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10567 Jim_Obj *const *argv)
10568 {
10569 if (argc < 3) {
10570 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10571 return JIM_ERR;
10572 } else if (argc == 3) {
10573 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10574 return JIM_ERR;
10575 Jim_SetResult(interp, argv[2]);
10576 return JIM_OK;
10577 }
10578 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10579 == JIM_ERR) return JIM_ERR;
10580 return JIM_OK;
10581 }
10582
10583 /* [lsort] */
10584 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10585 {
10586 const char *options[] = {
10587 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10588 };
10589 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10590 Jim_Obj *resObj;
10591 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10592 int decreasing = 0;
10593
10594 if (argc < 2) {
10595 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10596 return JIM_ERR;
10597 }
10598 for (i = 1; i < (argc-1); i++) {
10599 int option;
10600
10601 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10602 != JIM_OK)
10603 return JIM_ERR;
10604 switch (option) {
10605 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10606 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10607 case OPT_INCREASING: decreasing = 0; break;
10608 case OPT_DECREASING: decreasing = 1; break;
10609 }
10610 }
10611 if (decreasing) {
10612 switch (lsortType) {
10613 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10614 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10615 }
10616 }
10617 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10618 ListSortElements(interp, resObj, lsortType);
10619 Jim_SetResult(interp, resObj);
10620 return JIM_OK;
10621 }
10622
10623 /* [append] */
10624 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10625 Jim_Obj *const *argv)
10626 {
10627 Jim_Obj *stringObjPtr;
10628 int shared, i;
10629
10630 if (argc < 2) {
10631 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10632 return JIM_ERR;
10633 }
10634 if (argc == 2) {
10635 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10636 if (!stringObjPtr) return JIM_ERR;
10637 } else {
10638 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10639 if (!stringObjPtr) {
10640 /* Create the string if it does not exists */
10641 stringObjPtr = Jim_NewEmptyStringObj(interp);
10642 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10643 != JIM_OK) {
10644 Jim_FreeNewObj(interp, stringObjPtr);
10645 return JIM_ERR;
10646 }
10647 }
10648 }
10649 shared = Jim_IsShared(stringObjPtr);
10650 if (shared)
10651 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10652 for (i = 2; i < argc; i++)
10653 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10654 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10655 if (shared)
10656 Jim_FreeNewObj(interp, stringObjPtr);
10657 return JIM_ERR;
10658 }
10659 Jim_SetResult(interp, stringObjPtr);
10660 return JIM_OK;
10661 }
10662
10663 /* [debug] */
10664 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10665 Jim_Obj *const *argv)
10666 {
10667 const char *options[] = {
10668 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10669 "exprbc",
10670 NULL
10671 };
10672 enum {
10673 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10674 OPT_EXPRLEN, OPT_EXPRBC
10675 };
10676 int option;
10677
10678 if (argc < 2) {
10679 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10680 return JIM_ERR;
10681 }
10682 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10683 JIM_ERRMSG) != JIM_OK)
10684 return JIM_ERR;
10685 if (option == OPT_REFCOUNT) {
10686 if (argc != 3) {
10687 Jim_WrongNumArgs(interp, 2, argv, "object");
10688 return JIM_ERR;
10689 }
10690 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10691 return JIM_OK;
10692 } else if (option == OPT_OBJCOUNT) {
10693 int freeobj = 0, liveobj = 0;
10694 char buf[256];
10695 Jim_Obj *objPtr;
10696
10697 if (argc != 2) {
10698 Jim_WrongNumArgs(interp, 2, argv, "");
10699 return JIM_ERR;
10700 }
10701 /* Count the number of free objects. */
10702 objPtr = interp->freeList;
10703 while (objPtr) {
10704 freeobj++;
10705 objPtr = objPtr->nextObjPtr;
10706 }
10707 /* Count the number of live objects. */
10708 objPtr = interp->liveList;
10709 while (objPtr) {
10710 liveobj++;
10711 objPtr = objPtr->nextObjPtr;
10712 }
10713 /* Set the result string and return. */
10714 sprintf(buf, "free %d used %d", freeobj, liveobj);
10715 Jim_SetResultString(interp, buf, -1);
10716 return JIM_OK;
10717 } else if (option == OPT_OBJECTS) {
10718 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10719 /* Count the number of live objects. */
10720 objPtr = interp->liveList;
10721 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10722 while (objPtr) {
10723 char buf[128];
10724 const char *type = objPtr->typePtr ?
10725 objPtr->typePtr->name : "";
10726 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10727 sprintf(buf, "%p", objPtr);
10728 Jim_ListAppendElement(interp, subListObjPtr,
10729 Jim_NewStringObj(interp, buf, -1));
10730 Jim_ListAppendElement(interp, subListObjPtr,
10731 Jim_NewStringObj(interp, type, -1));
10732 Jim_ListAppendElement(interp, subListObjPtr,
10733 Jim_NewIntObj(interp, objPtr->refCount));
10734 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10735 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10736 objPtr = objPtr->nextObjPtr;
10737 }
10738 Jim_SetResult(interp, listObjPtr);
10739 return JIM_OK;
10740 } else if (option == OPT_INVSTR) {
10741 Jim_Obj *objPtr;
10742
10743 if (argc != 3) {
10744 Jim_WrongNumArgs(interp, 2, argv, "object");
10745 return JIM_ERR;
10746 }
10747 objPtr = argv[2];
10748 if (objPtr->typePtr != NULL)
10749 Jim_InvalidateStringRep(objPtr);
10750 Jim_SetEmptyResult(interp);
10751 return JIM_OK;
10752 } else if (option == OPT_SCRIPTLEN) {
10753 ScriptObj *script;
10754 if (argc != 3) {
10755 Jim_WrongNumArgs(interp, 2, argv, "script");
10756 return JIM_ERR;
10757 }
10758 script = Jim_GetScript(interp, argv[2]);
10759 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10760 return JIM_OK;
10761 } else if (option == OPT_EXPRLEN) {
10762 ExprByteCode *expr;
10763 if (argc != 3) {
10764 Jim_WrongNumArgs(interp, 2, argv, "expression");
10765 return JIM_ERR;
10766 }
10767 expr = Jim_GetExpression(interp, argv[2]);
10768 if (expr == NULL)
10769 return JIM_ERR;
10770 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10771 return JIM_OK;
10772 } else if (option == OPT_EXPRBC) {
10773 Jim_Obj *objPtr;
10774 ExprByteCode *expr;
10775 int i;
10776
10777 if (argc != 3) {
10778 Jim_WrongNumArgs(interp, 2, argv, "expression");
10779 return JIM_ERR;
10780 }
10781 expr = Jim_GetExpression(interp, argv[2]);
10782 if (expr == NULL)
10783 return JIM_ERR;
10784 objPtr = Jim_NewListObj(interp, NULL, 0);
10785 for (i = 0; i < expr->len; i++) {
10786 const char *type;
10787 Jim_ExprOperator *op;
10788
10789 switch (expr->opcode[i]) {
10790 case JIM_EXPROP_NUMBER: type = "number"; break;
10791 case JIM_EXPROP_COMMAND: type = "command"; break;
10792 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10793 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10794 case JIM_EXPROP_SUBST: type = "subst"; break;
10795 case JIM_EXPROP_STRING: type = "string"; break;
10796 default:
10797 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10798 if (op == NULL) {
10799 type = "private";
10800 } else {
10801 type = "operator";
10802 }
10803 break;
10804 }
10805 Jim_ListAppendElement(interp, objPtr,
10806 Jim_NewStringObj(interp, type, -1));
10807 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10808 }
10809 Jim_SetResult(interp, objPtr);
10810 return JIM_OK;
10811 } else {
10812 Jim_SetResultString(interp,
10813 "bad option. Valid options are refcount, "
10814 "objcount, objects, invstr", -1);
10815 return JIM_ERR;
10816 }
10817 return JIM_OK; /* unreached */
10818 }
10819
10820 /* [eval] */
10821 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10822 Jim_Obj *const *argv)
10823 {
10824 if (argc == 2) {
10825 return Jim_EvalObj(interp, argv[1]);
10826 } else if (argc > 2) {
10827 Jim_Obj *objPtr;
10828 int retcode;
10829
10830 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10831 Jim_IncrRefCount(objPtr);
10832 retcode = Jim_EvalObj(interp, objPtr);
10833 Jim_DecrRefCount(interp, objPtr);
10834 return retcode;
10835 } else {
10836 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10837 return JIM_ERR;
10838 }
10839 }
10840
10841 /* [uplevel] */
10842 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10843 Jim_Obj *const *argv)
10844 {
10845 if (argc >= 2) {
10846 int retcode, newLevel, oldLevel;
10847 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10848 Jim_Obj *objPtr;
10849 const char *str;
10850
10851 /* Save the old callframe pointer */
10852 savedCallFrame = interp->framePtr;
10853
10854 /* Lookup the target frame pointer */
10855 str = Jim_GetString(argv[1], NULL);
10856 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10857 {
10858 if (Jim_GetCallFrameByLevel(interp, argv[1],
10859 &targetCallFrame,
10860 &newLevel) != JIM_OK)
10861 return JIM_ERR;
10862 argc--;
10863 argv++;
10864 } else {
10865 if (Jim_GetCallFrameByLevel(interp, NULL,
10866 &targetCallFrame,
10867 &newLevel) != JIM_OK)
10868 return JIM_ERR;
10869 }
10870 if (argc < 2) {
10871 argc++;
10872 argv--;
10873 Jim_WrongNumArgs(interp, 1, argv,
10874 "?level? command ?arg ...?");
10875 return JIM_ERR;
10876 }
10877 /* Eval the code in the target callframe. */
10878 interp->framePtr = targetCallFrame;
10879 oldLevel = interp->numLevels;
10880 interp->numLevels = newLevel;
10881 if (argc == 2) {
10882 retcode = Jim_EvalObj(interp, argv[1]);
10883 } else {
10884 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10885 Jim_IncrRefCount(objPtr);
10886 retcode = Jim_EvalObj(interp, objPtr);
10887 Jim_DecrRefCount(interp, objPtr);
10888 }
10889 interp->numLevels = oldLevel;
10890 interp->framePtr = savedCallFrame;
10891 return retcode;
10892 } else {
10893 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10894 return JIM_ERR;
10895 }
10896 }
10897
10898 /* [expr] */
10899 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10900 Jim_Obj *const *argv)
10901 {
10902 Jim_Obj *exprResultPtr;
10903 int retcode;
10904
10905 if (argc == 2) {
10906 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10907 } else if (argc > 2) {
10908 Jim_Obj *objPtr;
10909
10910 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10911 Jim_IncrRefCount(objPtr);
10912 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10913 Jim_DecrRefCount(interp, objPtr);
10914 } else {
10915 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10916 return JIM_ERR;
10917 }
10918 if (retcode != JIM_OK) return retcode;
10919 Jim_SetResult(interp, exprResultPtr);
10920 Jim_DecrRefCount(interp, exprResultPtr);
10921 return JIM_OK;
10922 }
10923
10924 /* [break] */
10925 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10926 Jim_Obj *const *argv)
10927 {
10928 if (argc != 1) {
10929 Jim_WrongNumArgs(interp, 1, argv, "");
10930 return JIM_ERR;
10931 }
10932 return JIM_BREAK;
10933 }
10934
10935 /* [continue] */
10936 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10937 Jim_Obj *const *argv)
10938 {
10939 if (argc != 1) {
10940 Jim_WrongNumArgs(interp, 1, argv, "");
10941 return JIM_ERR;
10942 }
10943 return JIM_CONTINUE;
10944 }
10945
10946 /* [return] */
10947 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10948 Jim_Obj *const *argv)
10949 {
10950 if (argc == 1) {
10951 return JIM_RETURN;
10952 } else if (argc == 2) {
10953 Jim_SetResult(interp, argv[1]);
10954 interp->returnCode = JIM_OK;
10955 return JIM_RETURN;
10956 } else if (argc == 3 || argc == 4) {
10957 int returnCode;
10958 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10959 return JIM_ERR;
10960 interp->returnCode = returnCode;
10961 if (argc == 4)
10962 Jim_SetResult(interp, argv[3]);
10963 return JIM_RETURN;
10964 } else {
10965 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10966 return JIM_ERR;
10967 }
10968 return JIM_RETURN; /* unreached */
10969 }
10970
10971 /* [tailcall] */
10972 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10973 Jim_Obj *const *argv)
10974 {
10975 Jim_Obj *objPtr;
10976
10977 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10978 Jim_SetResult(interp, objPtr);
10979 return JIM_EVAL;
10980 }
10981
10982 /* [proc] */
10983 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10984 Jim_Obj *const *argv)
10985 {
10986 int argListLen;
10987 int arityMin, arityMax;
10988
10989 if (argc != 4 && argc != 5) {
10990 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10991 return JIM_ERR;
10992 }
10993 Jim_ListLength(interp, argv[2], &argListLen);
10994 arityMin = arityMax = argListLen + 1;
10995
10996 if (argListLen) {
10997 const char *str;
10998 int len;
10999 Jim_Obj *argPtr=NULL;
11000
11001 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11002 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11003 str = Jim_GetString(argPtr, &len);
11004 if (len == 4 && memcmp(str, "args", 4) == 0) {
11005 arityMin--;
11006 arityMax = -1;
11007 }
11008
11009 /* Check for default arguments and reduce arityMin if necessary */
11010 while (arityMin > 1) {
11011 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11012 Jim_ListLength(interp, argPtr, &len);
11013 if (len != 2) {
11014 /* No default argument */
11015 break;
11016 }
11017 arityMin--;
11018 }
11019 }
11020 if (argc == 4) {
11021 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11022 argv[2], NULL, argv[3], arityMin, arityMax);
11023 } else {
11024 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11025 argv[2], argv[3], argv[4], arityMin, arityMax);
11026 }
11027 }
11028
11029 /* [concat] */
11030 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11031 Jim_Obj *const *argv)
11032 {
11033 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11034 return JIM_OK;
11035 }
11036
11037 /* [upvar] */
11038 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11039 Jim_Obj *const *argv)
11040 {
11041 const char *str;
11042 int i;
11043 Jim_CallFrame *targetCallFrame;
11044
11045 /* Lookup the target frame pointer */
11046 str = Jim_GetString(argv[1], NULL);
11047 if (argc > 3 &&
11048 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11049 {
11050 if (Jim_GetCallFrameByLevel(interp, argv[1],
11051 &targetCallFrame, NULL) != JIM_OK)
11052 return JIM_ERR;
11053 argc--;
11054 argv++;
11055 } else {
11056 if (Jim_GetCallFrameByLevel(interp, NULL,
11057 &targetCallFrame, NULL) != JIM_OK)
11058 return JIM_ERR;
11059 }
11060 /* Check for arity */
11061 if (argc < 3 || ((argc-1)%2) != 0) {
11062 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11063 return JIM_ERR;
11064 }
11065 /* Now... for every other/local couple: */
11066 for (i = 1; i < argc; i += 2) {
11067 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11068 targetCallFrame) != JIM_OK) return JIM_ERR;
11069 }
11070 return JIM_OK;
11071 }
11072
11073 /* [global] */
11074 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11075 Jim_Obj *const *argv)
11076 {
11077 int i;
11078
11079 if (argc < 2) {
11080 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11081 return JIM_ERR;
11082 }
11083 /* Link every var to the toplevel having the same name */
11084 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11085 for (i = 1; i < argc; i++) {
11086 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11087 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11088 }
11089 return JIM_OK;
11090 }
11091
11092 /* does the [string map] operation. On error NULL is returned,
11093 * otherwise a new string object with the result, having refcount = 0,
11094 * is returned. */
11095 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11096 Jim_Obj *objPtr, int nocase)
11097 {
11098 int numMaps;
11099 const char **key, *str, *noMatchStart = NULL;
11100 Jim_Obj **value;
11101 int *keyLen, strLen, i;
11102 Jim_Obj *resultObjPtr;
11103
11104 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11105 if (numMaps % 2) {
11106 Jim_SetResultString(interp,
11107 "list must contain an even number of elements", -1);
11108 return NULL;
11109 }
11110 /* Initialization */
11111 numMaps /= 2;
11112 key = Jim_Alloc(sizeof(char*)*numMaps);
11113 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11114 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11115 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11116 for (i = 0; i < numMaps; i++) {
11117 Jim_Obj *eleObjPtr=NULL;
11118
11119 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11120 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11121 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11122 value[i] = eleObjPtr;
11123 }
11124 str = Jim_GetString(objPtr, &strLen);
11125 /* Map it */
11126 while (strLen) {
11127 for (i = 0; i < numMaps; i++) {
11128 if (strLen >= keyLen[i] && keyLen[i]) {
11129 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11130 nocase))
11131 {
11132 if (noMatchStart) {
11133 Jim_AppendString(interp, resultObjPtr,
11134 noMatchStart, str-noMatchStart);
11135 noMatchStart = NULL;
11136 }
11137 Jim_AppendObj(interp, resultObjPtr, value[i]);
11138 str += keyLen[i];
11139 strLen -= keyLen[i];
11140 break;
11141 }
11142 }
11143 }
11144 if (i == numMaps) { /* no match */
11145 if (noMatchStart == NULL)
11146 noMatchStart = str;
11147 str ++;
11148 strLen --;
11149 }
11150 }
11151 if (noMatchStart) {
11152 Jim_AppendString(interp, resultObjPtr,
11153 noMatchStart, str-noMatchStart);
11154 }
11155 Jim_Free((void*)key);
11156 Jim_Free(keyLen);
11157 Jim_Free(value);
11158 return resultObjPtr;
11159 }
11160
11161 /* [string] */
11162 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11163 Jim_Obj *const *argv)
11164 {
11165 int option;
11166 const char *options[] = {
11167 "length", "compare", "match", "equal", "range", "map", "repeat",
11168 "index", "first", "tolower", "toupper", NULL
11169 };
11170 enum {
11171 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11172 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11173 };
11174
11175 if (argc < 2) {
11176 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11177 return JIM_ERR;
11178 }
11179 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11180 JIM_ERRMSG) != JIM_OK)
11181 return JIM_ERR;
11182
11183 if (option == OPT_LENGTH) {
11184 int len;
11185
11186 if (argc != 3) {
11187 Jim_WrongNumArgs(interp, 2, argv, "string");
11188 return JIM_ERR;
11189 }
11190 Jim_GetString(argv[2], &len);
11191 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11192 return JIM_OK;
11193 } else if (option == OPT_COMPARE) {
11194 int nocase = 0;
11195 if ((argc != 4 && argc != 5) ||
11196 (argc == 5 && Jim_CompareStringImmediate(interp,
11197 argv[2], "-nocase") == 0)) {
11198 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11199 return JIM_ERR;
11200 }
11201 if (argc == 5) {
11202 nocase = 1;
11203 argv++;
11204 }
11205 Jim_SetResult(interp, Jim_NewIntObj(interp,
11206 Jim_StringCompareObj(argv[2],
11207 argv[3], nocase)));
11208 return JIM_OK;
11209 } else if (option == OPT_MATCH) {
11210 int nocase = 0;
11211 if ((argc != 4 && argc != 5) ||
11212 (argc == 5 && Jim_CompareStringImmediate(interp,
11213 argv[2], "-nocase") == 0)) {
11214 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11215 "string");
11216 return JIM_ERR;
11217 }
11218 if (argc == 5) {
11219 nocase = 1;
11220 argv++;
11221 }
11222 Jim_SetResult(interp,
11223 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11224 argv[3], nocase)));
11225 return JIM_OK;
11226 } else if (option == OPT_EQUAL) {
11227 if (argc != 4) {
11228 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11229 return JIM_ERR;
11230 }
11231 Jim_SetResult(interp,
11232 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11233 argv[3], 0)));
11234 return JIM_OK;
11235 } else if (option == OPT_RANGE) {
11236 Jim_Obj *objPtr;
11237
11238 if (argc != 5) {
11239 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11240 return JIM_ERR;
11241 }
11242 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11243 if (objPtr == NULL)
11244 return JIM_ERR;
11245 Jim_SetResult(interp, objPtr);
11246 return JIM_OK;
11247 } else if (option == OPT_MAP) {
11248 int nocase = 0;
11249 Jim_Obj *objPtr;
11250
11251 if ((argc != 4 && argc != 5) ||
11252 (argc == 5 && Jim_CompareStringImmediate(interp,
11253 argv[2], "-nocase") == 0)) {
11254 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11255 "string");
11256 return JIM_ERR;
11257 }
11258 if (argc == 5) {
11259 nocase = 1;
11260 argv++;
11261 }
11262 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11263 if (objPtr == NULL)
11264 return JIM_ERR;
11265 Jim_SetResult(interp, objPtr);
11266 return JIM_OK;
11267 } else if (option == OPT_REPEAT) {
11268 Jim_Obj *objPtr;
11269 jim_wide count;
11270
11271 if (argc != 4) {
11272 Jim_WrongNumArgs(interp, 2, argv, "string count");
11273 return JIM_ERR;
11274 }
11275 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11276 return JIM_ERR;
11277 objPtr = Jim_NewStringObj(interp, "", 0);
11278 while (count--) {
11279 Jim_AppendObj(interp, objPtr, argv[2]);
11280 }
11281 Jim_SetResult(interp, objPtr);
11282 return JIM_OK;
11283 } else if (option == OPT_INDEX) {
11284 int index_t, len;
11285 const char *str;
11286
11287 if (argc != 4) {
11288 Jim_WrongNumArgs(interp, 2, argv, "string index");
11289 return JIM_ERR;
11290 }
11291 if (Jim_GetIndex(interp, argv[3], &index_t) != JIM_OK)
11292 return JIM_ERR;
11293 str = Jim_GetString(argv[2], &len);
11294 if (index_t != INT_MIN && index_t != INT_MAX)
11295 index_t = JimRelToAbsIndex(len, index_t);
11296 if (index_t < 0 || index_t >= len) {
11297 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11298 return JIM_OK;
11299 } else {
11300 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index_t, 1));
11301 return JIM_OK;
11302 }
11303 } else if (option == OPT_FIRST) {
11304 int index_t = 0, l1, l2;
11305 const char *s1, *s2;
11306
11307 if (argc != 4 && argc != 5) {
11308 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11309 return JIM_ERR;
11310 }
11311 s1 = Jim_GetString(argv[2], &l1);
11312 s2 = Jim_GetString(argv[3], &l2);
11313 if (argc == 5) {
11314 if (Jim_GetIndex(interp, argv[4], &index_t) != JIM_OK)
11315 return JIM_ERR;
11316 index_t = JimRelToAbsIndex(l2, index_t);
11317 }
11318 Jim_SetResult(interp, Jim_NewIntObj(interp,
11319 JimStringFirst(s1, l1, s2, l2, index_t)));
11320 return JIM_OK;
11321 } else if (option == OPT_TOLOWER) {
11322 if (argc != 3) {
11323 Jim_WrongNumArgs(interp, 2, argv, "string");
11324 return JIM_ERR;
11325 }
11326 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11327 } else if (option == OPT_TOUPPER) {
11328 if (argc != 3) {
11329 Jim_WrongNumArgs(interp, 2, argv, "string");
11330 return JIM_ERR;
11331 }
11332 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11333 }
11334 return JIM_OK;
11335 }
11336
11337 /* [time] */
11338 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11339 Jim_Obj *const *argv)
11340 {
11341 long i, count = 1;
11342 jim_wide start, elapsed;
11343 char buf [256];
11344 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11345
11346 if (argc < 2) {
11347 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11348 return JIM_ERR;
11349 }
11350 if (argc == 3) {
11351 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11352 return JIM_ERR;
11353 }
11354 if (count < 0)
11355 return JIM_OK;
11356 i = count;
11357 start = JimClock();
11358 while (i-- > 0) {
11359 int retval;
11360
11361 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11362 return retval;
11363 }
11364 elapsed = JimClock() - start;
11365 sprintf(buf, fmt, elapsed/count);
11366 Jim_SetResultString(interp, buf, -1);
11367 return JIM_OK;
11368 }
11369
11370 /* [exit] */
11371 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11372 Jim_Obj *const *argv)
11373 {
11374 long exitCode = 0;
11375
11376 if (argc > 2) {
11377 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11378 return JIM_ERR;
11379 }
11380 if (argc == 2) {
11381 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11382 return JIM_ERR;
11383 }
11384 interp->exitCode = exitCode;
11385 return JIM_EXIT;
11386 }
11387
11388 /* [catch] */
11389 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11390 Jim_Obj *const *argv)
11391 {
11392 int exitCode = 0;
11393
11394 if (argc != 2 && argc != 3) {
11395 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11396 return JIM_ERR;
11397 }
11398 exitCode = Jim_EvalObj(interp, argv[1]);
11399 if (argc == 3) {
11400 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11401 != JIM_OK)
11402 return JIM_ERR;
11403 }
11404 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11405 return JIM_OK;
11406 }
11407
11408 /* [ref] */
11409 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11410 Jim_Obj *const *argv)
11411 {
11412 if (argc != 3 && argc != 4) {
11413 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11414 return JIM_ERR;
11415 }
11416 if (argc == 3) {
11417 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11418 } else {
11419 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11420 argv[3]));
11421 }
11422 return JIM_OK;
11423 }
11424
11425 /* [getref] */
11426 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11427 Jim_Obj *const *argv)
11428 {
11429 Jim_Reference *refPtr;
11430
11431 if (argc != 2) {
11432 Jim_WrongNumArgs(interp, 1, argv, "reference");
11433 return JIM_ERR;
11434 }
11435 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11436 return JIM_ERR;
11437 Jim_SetResult(interp, refPtr->objPtr);
11438 return JIM_OK;
11439 }
11440
11441 /* [setref] */
11442 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11443 Jim_Obj *const *argv)
11444 {
11445 Jim_Reference *refPtr;
11446
11447 if (argc != 3) {
11448 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11449 return JIM_ERR;
11450 }
11451 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11452 return JIM_ERR;
11453 Jim_IncrRefCount(argv[2]);
11454 Jim_DecrRefCount(interp, refPtr->objPtr);
11455 refPtr->objPtr = argv[2];
11456 Jim_SetResult(interp, argv[2]);
11457 return JIM_OK;
11458 }
11459
11460 /* [collect] */
11461 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11462 Jim_Obj *const *argv)
11463 {
11464 if (argc != 1) {
11465 Jim_WrongNumArgs(interp, 1, argv, "");
11466 return JIM_ERR;
11467 }
11468 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11469 return JIM_OK;
11470 }
11471
11472 /* [finalize] reference ?newValue? */
11473 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11474 Jim_Obj *const *argv)
11475 {
11476 if (argc != 2 && argc != 3) {
11477 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11478 return JIM_ERR;
11479 }
11480 if (argc == 2) {
11481 Jim_Obj *cmdNamePtr;
11482
11483 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11484 return JIM_ERR;
11485 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11486 Jim_SetResult(interp, cmdNamePtr);
11487 } else {
11488 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11489 return JIM_ERR;
11490 Jim_SetResult(interp, argv[2]);
11491 }
11492 return JIM_OK;
11493 }
11494
11495 /* TODO */
11496 /* [info references] (list of all the references/finalizers) */
11497
11498 /* [rename] */
11499 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11500 Jim_Obj *const *argv)
11501 {
11502 const char *oldName, *newName;
11503
11504 if (argc != 3) {
11505 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11506 return JIM_ERR;
11507 }
11508 oldName = Jim_GetString(argv[1], NULL);
11509 newName = Jim_GetString(argv[2], NULL);
11510 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11511 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11512 Jim_AppendStrings(interp, Jim_GetResult(interp),
11513 "can't rename \"", oldName, "\": ",
11514 "command doesn't exist", NULL);
11515 return JIM_ERR;
11516 }
11517 return JIM_OK;
11518 }
11519
11520 /* [dict] */
11521 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11522 Jim_Obj *const *argv)
11523 {
11524 int option;
11525 const char *options[] = {
11526 "create", "get", "set", "unset", "exists", NULL
11527 };
11528 enum {
11529 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11530 };
11531
11532 if (argc < 2) {
11533 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11534 return JIM_ERR;
11535 }
11536
11537 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11538 JIM_ERRMSG) != JIM_OK)
11539 return JIM_ERR;
11540
11541 if (option == OPT_CREATE) {
11542 Jim_Obj *objPtr;
11543
11544 if (argc % 2) {
11545 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11546 return JIM_ERR;
11547 }
11548 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11549 Jim_SetResult(interp, objPtr);
11550 return JIM_OK;
11551 } else if (option == OPT_GET) {
11552 Jim_Obj *objPtr;
11553
11554 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11555 JIM_ERRMSG) != JIM_OK)
11556 return JIM_ERR;
11557 Jim_SetResult(interp, objPtr);
11558 return JIM_OK;
11559 } else if (option == OPT_SET) {
11560 if (argc < 5) {
11561 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11562 return JIM_ERR;
11563 }
11564 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11565 argv[argc-1]);
11566 } else if (option == OPT_UNSET) {
11567 if (argc < 4) {
11568 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11569 return JIM_ERR;
11570 }
11571 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11572 NULL);
11573 } else if (option == OPT_EXIST) {
11574 Jim_Obj *objPtr;
11575 int exists;
11576
11577 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11578 JIM_ERRMSG) == JIM_OK)
11579 exists = 1;
11580 else
11581 exists = 0;
11582 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11583 return JIM_OK;
11584 } else {
11585 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11586 Jim_AppendStrings(interp, Jim_GetResult(interp),
11587 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11588 " must be create, get, set", NULL);
11589 return JIM_ERR;
11590 }
11591 return JIM_OK;
11592 }
11593
11594 /* [load] */
11595 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11596 Jim_Obj *const *argv)
11597 {
11598 if (argc < 2) {
11599 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11600 return JIM_ERR;
11601 }
11602 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11603 }
11604
11605 /* [subst] */
11606 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11607 Jim_Obj *const *argv)
11608 {
11609 int i, flags = 0;
11610 Jim_Obj *objPtr;
11611
11612 if (argc < 2) {
11613 Jim_WrongNumArgs(interp, 1, argv,
11614 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11615 return JIM_ERR;
11616 }
11617 i = argc-2;
11618 while (i--) {
11619 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11620 "-nobackslashes"))
11621 flags |= JIM_SUBST_NOESC;
11622 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11623 "-novariables"))
11624 flags |= JIM_SUBST_NOVAR;
11625 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11626 "-nocommands"))
11627 flags |= JIM_SUBST_NOCMD;
11628 else {
11629 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11630 Jim_AppendStrings(interp, Jim_GetResult(interp),
11631 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11632 "\": must be -nobackslashes, -nocommands, or "
11633 "-novariables", NULL);
11634 return JIM_ERR;
11635 }
11636 }
11637 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11638 return JIM_ERR;
11639 Jim_SetResult(interp, objPtr);
11640 return JIM_OK;
11641 }
11642
11643 /* [info] */
11644 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11645 Jim_Obj *const *argv)
11646 {
11647 int cmd, result = JIM_OK;
11648 static const char *commands[] = {
11649 "body", "commands", "exists", "globals", "level", "locals",
11650 "vars", "version", "complete", "args", "hostname", NULL
11651 };
11652 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11653 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11654
11655 if (argc < 2) {
11656 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11657 return JIM_ERR;
11658 }
11659 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11660 != JIM_OK) {
11661 return JIM_ERR;
11662 }
11663
11664 if (cmd == INFO_COMMANDS) {
11665 if (argc != 2 && argc != 3) {
11666 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11667 return JIM_ERR;
11668 }
11669 if (argc == 3)
11670 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11671 else
11672 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11673 } else if (cmd == INFO_EXISTS) {
11674 Jim_Obj *exists;
11675 if (argc != 3) {
11676 Jim_WrongNumArgs(interp, 2, argv, "varName");
11677 return JIM_ERR;
11678 }
11679 exists = Jim_GetVariable(interp, argv[2], 0);
11680 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11681 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11682 int mode;
11683 switch (cmd) {
11684 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11685 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11686 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11687 default: mode = 0; /* avoid warning */; break;
11688 }
11689 if (argc != 2 && argc != 3) {
11690 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11691 return JIM_ERR;
11692 }
11693 if (argc == 3)
11694 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11695 else
11696 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11697 } else if (cmd == INFO_LEVEL) {
11698 Jim_Obj *objPtr;
11699 switch (argc) {
11700 case 2:
11701 Jim_SetResult(interp,
11702 Jim_NewIntObj(interp, interp->numLevels));
11703 break;
11704 case 3:
11705 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11706 return JIM_ERR;
11707 Jim_SetResult(interp, objPtr);
11708 break;
11709 default:
11710 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11711 return JIM_ERR;
11712 }
11713 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11714 Jim_Cmd *cmdPtr;
11715
11716 if (argc != 3) {
11717 Jim_WrongNumArgs(interp, 2, argv, "procname");
11718 return JIM_ERR;
11719 }
11720 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11721 return JIM_ERR;
11722 if (cmdPtr->cmdProc != NULL) {
11723 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11724 Jim_AppendStrings(interp, Jim_GetResult(interp),
11725 "command \"", Jim_GetString(argv[2], NULL),
11726 "\" is not a procedure", NULL);
11727 return JIM_ERR;
11728 }
11729 if (cmd == INFO_BODY)
11730 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11731 else
11732 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11733 } else if (cmd == INFO_VERSION) {
11734 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11735 sprintf(buf, "%d.%d",
11736 JIM_VERSION / 100, JIM_VERSION % 100);
11737 Jim_SetResultString(interp, buf, -1);
11738 } else if (cmd == INFO_COMPLETE) {
11739 const char *s;
11740 int len;
11741
11742 if (argc != 3) {
11743 Jim_WrongNumArgs(interp, 2, argv, "script");
11744 return JIM_ERR;
11745 }
11746 s = Jim_GetString(argv[2], &len);
11747 Jim_SetResult(interp,
11748 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11749 } else if (cmd == INFO_HOSTNAME) {
11750 /* Redirect to os.hostname if it exists */
11751 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11752 result = Jim_EvalObjVector(interp, 1, &command);
11753 }
11754 return result;
11755 }
11756
11757 /* [split] */
11758 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11759 Jim_Obj *const *argv)
11760 {
11761 const char *str, *splitChars, *noMatchStart;
11762 int splitLen, strLen, i;
11763 Jim_Obj *resObjPtr;
11764
11765 if (argc != 2 && argc != 3) {
11766 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11767 return JIM_ERR;
11768 }
11769 /* Init */
11770 if (argc == 2) {
11771 splitChars = " \n\t\r";
11772 splitLen = 4;
11773 } else {
11774 splitChars = Jim_GetString(argv[2], &splitLen);
11775 }
11776 str = Jim_GetString(argv[1], &strLen);
11777 if (!strLen) return JIM_OK;
11778 noMatchStart = str;
11779 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11780 /* Split */
11781 if (splitLen) {
11782 while (strLen) {
11783 for (i = 0; i < splitLen; i++) {
11784 if (*str == splitChars[i]) {
11785 Jim_Obj *objPtr;
11786
11787 objPtr = Jim_NewStringObj(interp, noMatchStart,
11788 (str-noMatchStart));
11789 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11790 noMatchStart = str + 1;
11791 break;
11792 }
11793 }
11794 str ++;
11795 strLen --;
11796 }
11797 Jim_ListAppendElement(interp, resObjPtr,
11798 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11799 } else {
11800 /* This handles the special case of splitchars eq {}. This
11801 * is trivial but we want to perform object sharing as Tcl does. */
11802 Jim_Obj *objCache[256];
11803 const unsigned char *u = (unsigned char*) str;
11804 memset(objCache, 0, sizeof(objCache));
11805 for (i = 0; i < strLen; i++) {
11806 int c = u[i];
11807
11808 if (objCache[c] == NULL)
11809 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11810 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11811 }
11812 }
11813 Jim_SetResult(interp, resObjPtr);
11814 return JIM_OK;
11815 }
11816
11817 /* [join] */
11818 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11819 Jim_Obj *const *argv)
11820 {
11821 const char *joinStr;
11822 int joinStrLen, i, listLen;
11823 Jim_Obj *resObjPtr;
11824
11825 if (argc != 2 && argc != 3) {
11826 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11827 return JIM_ERR;
11828 }
11829 /* Init */
11830 if (argc == 2) {
11831 joinStr = " ";
11832 joinStrLen = 1;
11833 } else {
11834 joinStr = Jim_GetString(argv[2], &joinStrLen);
11835 }
11836 Jim_ListLength(interp, argv[1], &listLen);
11837 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11838 /* Split */
11839 for (i = 0; i < listLen; i++) {
11840 Jim_Obj *objPtr=NULL;
11841
11842 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11843 Jim_AppendObj(interp, resObjPtr, objPtr);
11844 if (i + 1 != listLen) {
11845 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11846 }
11847 }
11848 Jim_SetResult(interp, resObjPtr);
11849 return JIM_OK;
11850 }
11851
11852 /* [format] */
11853 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11854 Jim_Obj *const *argv)
11855 {
11856 Jim_Obj *objPtr;
11857
11858 if (argc < 2) {
11859 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11860 return JIM_ERR;
11861 }
11862 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11863 if (objPtr == NULL)
11864 return JIM_ERR;
11865 Jim_SetResult(interp, objPtr);
11866 return JIM_OK;
11867 }
11868
11869 /* [scan] */
11870 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11871 Jim_Obj *const *argv)
11872 {
11873 Jim_Obj *listPtr, **outVec;
11874 int outc, i, count = 0;
11875
11876 if (argc < 3) {
11877 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11878 return JIM_ERR;
11879 }
11880 if (argv[2]->typePtr != &scanFmtStringObjType)
11881 SetScanFmtFromAny(interp, argv[2]);
11882 if (FormatGetError(argv[2]) != 0) {
11883 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11884 return JIM_ERR;
11885 }
11886 if (argc > 3) {
11887 int maxPos = FormatGetMaxPos(argv[2]);
11888 int arg_count = FormatGetCnvCount(argv[2]);
11889 if (maxPos > argc-3) {
11890 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11891 return JIM_ERR;
11892 } else if (arg_count != 0 && arg_count < argc-3) {
11893 Jim_SetResultString(interp, "variable is not assigned by any "
11894 "conversion specifiers", -1);
11895 return JIM_ERR;
11896 } else if (arg_count > argc-3) {
11897 Jim_SetResultString(interp, "different numbers of variable names and "
11898 "field specifiers", -1);
11899 return JIM_ERR;
11900 }
11901 }
11902 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11903 if (listPtr == 0)
11904 return JIM_ERR;
11905 if (argc > 3) {
11906 int len = 0;
11907 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11908 Jim_ListLength(interp, listPtr, &len);
11909 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11910 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11911 return JIM_OK;
11912 }
11913 JimListGetElements(interp, listPtr, &outc, &outVec);
11914 for (i = 0; i < outc; ++i) {
11915 if (Jim_Length(outVec[i]) > 0) {
11916 ++count;
11917 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11918 goto err;
11919 }
11920 }
11921 Jim_FreeNewObj(interp, listPtr);
11922 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11923 } else {
11924 if (listPtr == (Jim_Obj*)EOF) {
11925 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11926 return JIM_OK;
11927 }
11928 Jim_SetResult(interp, listPtr);
11929 }
11930 return JIM_OK;
11931 err:
11932 Jim_FreeNewObj(interp, listPtr);
11933 return JIM_ERR;
11934 }
11935
11936 /* [error] */
11937 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11938 Jim_Obj *const *argv)
11939 {
11940 if (argc != 2) {
11941 Jim_WrongNumArgs(interp, 1, argv, "message");
11942 return JIM_ERR;
11943 }
11944 Jim_SetResult(interp, argv[1]);
11945 return JIM_ERR;
11946 }
11947
11948 /* [lrange] */
11949 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11950 Jim_Obj *const *argv)
11951 {
11952 Jim_Obj *objPtr;
11953
11954 if (argc != 4) {
11955 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11956 return JIM_ERR;
11957 }
11958 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11959 return JIM_ERR;
11960 Jim_SetResult(interp, objPtr);
11961 return JIM_OK;
11962 }
11963
11964 /* [env] */
11965 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11966 Jim_Obj *const *argv)
11967 {
11968 const char *key;
11969 char *val;
11970
11971 if (argc == 1) {
11972
11973 #ifdef NEED_ENVIRON_EXTERN
11974 extern char **environ;
11975 #endif
11976
11977 int i;
11978 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11979
11980 for (i = 0; environ[i]; i++) {
11981 const char *equals = strchr(environ[i], '=');
11982 if (equals) {
11983 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11984 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11985 }
11986 }
11987
11988 Jim_SetResult(interp, listObjPtr);
11989 return JIM_OK;
11990 }
11991
11992 if (argc != 2) {
11993 Jim_WrongNumArgs(interp, 1, argv, "varName");
11994 return JIM_ERR;
11995 }
11996 key = Jim_GetString(argv[1], NULL);
11997 val = getenv(key);
11998 if (val == NULL) {
11999 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12000 Jim_AppendStrings(interp, Jim_GetResult(interp),
12001 "environment variable \"",
12002 key, "\" does not exist", NULL);
12003 return JIM_ERR;
12004 }
12005 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12006 return JIM_OK;
12007 }
12008
12009 /* [source] */
12010 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12011 Jim_Obj *const *argv)
12012 {
12013 int retval;
12014
12015 if (argc != 2) {
12016 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12017 return JIM_ERR;
12018 }
12019 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12020 if (retval == JIM_ERR) {
12021 return JIM_ERR_ADDSTACK;
12022 }
12023 if (retval == JIM_RETURN)
12024 return JIM_OK;
12025 return retval;
12026 }
12027
12028 /* [lreverse] */
12029 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12030 Jim_Obj *const *argv)
12031 {
12032 Jim_Obj *revObjPtr, **ele;
12033 int len;
12034
12035 if (argc != 2) {
12036 Jim_WrongNumArgs(interp, 1, argv, "list");
12037 return JIM_ERR;
12038 }
12039 JimListGetElements(interp, argv[1], &len, &ele);
12040 len--;
12041 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12042 while (len >= 0)
12043 ListAppendElement(revObjPtr, ele[len--]);
12044 Jim_SetResult(interp, revObjPtr);
12045 return JIM_OK;
12046 }
12047
12048 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12049 {
12050 jim_wide len;
12051
12052 if (step == 0) return -1;
12053 if (start == end) return 0;
12054 else if (step > 0 && start > end) return -1;
12055 else if (step < 0 && end > start) return -1;
12056 len = end-start;
12057 if (len < 0) len = -len; /* abs(len) */
12058 if (step < 0) step = -step; /* abs(step) */
12059 len = 1 + ((len-1)/step);
12060 /* We can truncate safely to INT_MAX, the range command
12061 * will always return an error for a such long range
12062 * because Tcl lists can't be so long. */
12063 if (len > INT_MAX) len = INT_MAX;
12064 return (int)((len < 0) ? -1 : len);
12065 }
12066
12067 /* [range] */
12068 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12069 Jim_Obj *const *argv)
12070 {
12071 jim_wide start = 0, end, step = 1;
12072 int len, i;
12073 Jim_Obj *objPtr;
12074
12075 if (argc < 2 || argc > 4) {
12076 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12077 return JIM_ERR;
12078 }
12079 if (argc == 2) {
12080 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12081 return JIM_ERR;
12082 } else {
12083 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12084 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12085 return JIM_ERR;
12086 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12087 return JIM_ERR;
12088 }
12089 if ((len = JimRangeLen(start, end, step)) == -1) {
12090 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12091 return JIM_ERR;
12092 }
12093 objPtr = Jim_NewListObj(interp, NULL, 0);
12094 for (i = 0; i < len; i++)
12095 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12096 Jim_SetResult(interp, objPtr);
12097 return JIM_OK;
12098 }
12099
12100 /* [rand] */
12101 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12102 Jim_Obj *const *argv)
12103 {
12104 jim_wide min = 0, max =0, len, maxMul;
12105
12106 if (argc < 1 || argc > 3) {
12107 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12108 return JIM_ERR;
12109 }
12110 if (argc == 1) {
12111 max = JIM_WIDE_MAX;
12112 } else if (argc == 2) {
12113 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12114 return JIM_ERR;
12115 } else if (argc == 3) {
12116 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12117 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12118 return JIM_ERR;
12119 }
12120 len = max-min;
12121 if (len < 0) {
12122 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12123 return JIM_ERR;
12124 }
12125 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12126 while (1) {
12127 jim_wide r;
12128
12129 JimRandomBytes(interp, &r, sizeof(jim_wide));
12130 if (r < 0 || r >= maxMul) continue;
12131 r = (len == 0) ? 0 : r%len;
12132 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12133 return JIM_OK;
12134 }
12135 }
12136
12137 /* [package] */
12138 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12139 Jim_Obj *const *argv)
12140 {
12141 int option;
12142 const char *options[] = {
12143 "require", "provide", NULL
12144 };
12145 enum {OPT_REQUIRE, OPT_PROVIDE};
12146
12147 if (argc < 2) {
12148 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12149 return JIM_ERR;
12150 }
12151 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12152 JIM_ERRMSG) != JIM_OK)
12153 return JIM_ERR;
12154
12155 if (option == OPT_REQUIRE) {
12156 int exact = 0;
12157 const char *ver;
12158
12159 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12160 exact = 1;
12161 argv++;
12162 argc--;
12163 }
12164 if (argc != 3 && argc != 4) {
12165 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12166 return JIM_ERR;
12167 }
12168 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12169 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12170 JIM_ERRMSG);
12171 if (ver == NULL)
12172 return JIM_ERR_ADDSTACK;
12173 Jim_SetResultString(interp, ver, -1);
12174 } else if (option == OPT_PROVIDE) {
12175 if (argc != 4) {
12176 Jim_WrongNumArgs(interp, 2, argv, "package version");
12177 return JIM_ERR;
12178 }
12179 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12180 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12181 }
12182 return JIM_OK;
12183 }
12184
12185 static struct {
12186 const char *name;
12187 Jim_CmdProc cmdProc;
12188 } Jim_CoreCommandsTable[] = {
12189 {"set", Jim_SetCoreCommand},
12190 {"unset", Jim_UnsetCoreCommand},
12191 {"puts", Jim_PutsCoreCommand},
12192 {"+", Jim_AddCoreCommand},
12193 {"*", Jim_MulCoreCommand},
12194 {"-", Jim_SubCoreCommand},
12195 {"/", Jim_DivCoreCommand},
12196 {"incr", Jim_IncrCoreCommand},
12197 {"while", Jim_WhileCoreCommand},
12198 {"for", Jim_ForCoreCommand},
12199 {"foreach", Jim_ForeachCoreCommand},
12200 {"lmap", Jim_LmapCoreCommand},
12201 {"if", Jim_IfCoreCommand},
12202 {"switch", Jim_SwitchCoreCommand},
12203 {"list", Jim_ListCoreCommand},
12204 {"lindex", Jim_LindexCoreCommand},
12205 {"lset", Jim_LsetCoreCommand},
12206 {"llength", Jim_LlengthCoreCommand},
12207 {"lappend", Jim_LappendCoreCommand},
12208 {"linsert", Jim_LinsertCoreCommand},
12209 {"lsort", Jim_LsortCoreCommand},
12210 {"append", Jim_AppendCoreCommand},
12211 {"debug", Jim_DebugCoreCommand},
12212 {"eval", Jim_EvalCoreCommand},
12213 {"uplevel", Jim_UplevelCoreCommand},
12214 {"expr", Jim_ExprCoreCommand},
12215 {"break", Jim_BreakCoreCommand},
12216 {"continue", Jim_ContinueCoreCommand},
12217 {"proc", Jim_ProcCoreCommand},
12218 {"concat", Jim_ConcatCoreCommand},
12219 {"return", Jim_ReturnCoreCommand},
12220 {"upvar", Jim_UpvarCoreCommand},
12221 {"global", Jim_GlobalCoreCommand},
12222 {"string", Jim_StringCoreCommand},
12223 {"time", Jim_TimeCoreCommand},
12224 {"exit", Jim_ExitCoreCommand},
12225 {"catch", Jim_CatchCoreCommand},
12226 {"ref", Jim_RefCoreCommand},
12227 {"getref", Jim_GetrefCoreCommand},
12228 {"setref", Jim_SetrefCoreCommand},
12229 {"finalize", Jim_FinalizeCoreCommand},
12230 {"collect", Jim_CollectCoreCommand},
12231 {"rename", Jim_RenameCoreCommand},
12232 {"dict", Jim_DictCoreCommand},
12233 {"load", Jim_LoadCoreCommand},
12234 {"subst", Jim_SubstCoreCommand},
12235 {"info", Jim_InfoCoreCommand},
12236 {"split", Jim_SplitCoreCommand},
12237 {"join", Jim_JoinCoreCommand},
12238 {"format", Jim_FormatCoreCommand},
12239 {"scan", Jim_ScanCoreCommand},
12240 {"error", Jim_ErrorCoreCommand},
12241 {"lrange", Jim_LrangeCoreCommand},
12242 {"env", Jim_EnvCoreCommand},
12243 {"source", Jim_SourceCoreCommand},
12244 {"lreverse", Jim_LreverseCoreCommand},
12245 {"range", Jim_RangeCoreCommand},
12246 {"rand", Jim_RandCoreCommand},
12247 {"package", Jim_PackageCoreCommand},
12248 {"tailcall", Jim_TailcallCoreCommand},
12249 {NULL, NULL},
12250 };
12251
12252 /* Some Jim core command is actually a procedure written in Jim itself. */
12253 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12254 {
12255 Jim_Eval(interp, (char*)
12256 "proc lambda {arglist args} {\n"
12257 " set name [ref {} function lambdaFinalizer]\n"
12258 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12259 " return $name\n"
12260 "}\n"
12261 "proc lambdaFinalizer {name val} {\n"
12262 " rename $name {}\n"
12263 "}\n"
12264 );
12265 }
12266
12267 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12268 {
12269 int i = 0;
12270
12271 while (Jim_CoreCommandsTable[i].name != NULL) {
12272 Jim_CreateCommand(interp,
12273 Jim_CoreCommandsTable[i].name,
12274 Jim_CoreCommandsTable[i].cmdProc,
12275 NULL, NULL);
12276 i++;
12277 }
12278 Jim_RegisterCoreProcedures(interp);
12279 }
12280
12281 /* -----------------------------------------------------------------------------
12282 * Interactive prompt
12283 * ---------------------------------------------------------------------------*/
12284 void Jim_PrintErrorMessage(Jim_Interp *interp)
12285 {
12286 int len, i;
12287
12288 if (*interp->errorFileName) {
12289 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12290 interp->errorFileName, interp->errorLine);
12291 }
12292 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12293 Jim_GetString(interp->result, NULL));
12294 Jim_ListLength(interp, interp->stackTrace, &len);
12295 for (i = 0; i < len; i += 3) {
12296 Jim_Obj *objPtr=NULL;
12297 const char *proc, *file, *line;
12298
12299 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12300 proc = Jim_GetString(objPtr, NULL);
12301 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12302 JIM_NONE);
12303 file = Jim_GetString(objPtr, NULL);
12304 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12305 JIM_NONE);
12306 line = Jim_GetString(objPtr, NULL);
12307 if (*proc) {
12308 Jim_fprintf(interp, interp->cookie_stderr,
12309 "in procedure '%s' ", proc);
12310 }
12311 if (*file) {
12312 Jim_fprintf(interp, interp->cookie_stderr,
12313 "called at file \"%s\", line %s",
12314 file, line);
12315 }
12316 if (*file || *proc) {
12317 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12318 }
12319 }
12320 }
12321
12322 int Jim_InteractivePrompt(Jim_Interp *interp)
12323 {
12324 int retcode = JIM_OK;
12325 Jim_Obj *scriptObjPtr;
12326
12327 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12328 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12329 JIM_VERSION / 100, JIM_VERSION % 100);
12330 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12331 while (1) {
12332 char buf[1024];
12333 const char *result;
12334 const char *retcodestr[] = {
12335 "ok", "error", "return", "break", "continue", "eval", "exit"
12336 };
12337 int reslen;
12338
12339 if (retcode != 0) {
12340 if (retcode >= 2 && retcode <= 6)
12341 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12342 else
12343 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12344 } else
12345 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12346 Jim_fflush(interp, interp->cookie_stdout);
12347 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12348 Jim_IncrRefCount(scriptObjPtr);
12349 while (1) {
12350 const char *str;
12351 char state;
12352 int len;
12353
12354 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12355 Jim_DecrRefCount(interp, scriptObjPtr);
12356 goto out;
12357 }
12358 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12359 str = Jim_GetString(scriptObjPtr, &len);
12360 if (Jim_ScriptIsComplete(str, len, &state))
12361 break;
12362 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12363 Jim_fflush(interp, interp->cookie_stdout);
12364 }
12365 retcode = Jim_EvalObj(interp, scriptObjPtr);
12366 Jim_DecrRefCount(interp, scriptObjPtr);
12367 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12368 if (retcode == JIM_ERR) {
12369 Jim_PrintErrorMessage(interp);
12370 } else if (retcode == JIM_EXIT) {
12371 exit(Jim_GetExitCode(interp));
12372 } else {
12373 if (reslen) {
12374 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12375 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12376 }
12377 }
12378 }
12379 out:
12380 return 0;
12381 }
12382
12383 /* -----------------------------------------------------------------------------
12384 * Jim's idea of STDIO..
12385 * ---------------------------------------------------------------------------*/
12386
12387 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12388 {
12389 int r;
12390
12391 va_list ap;
12392 va_start(ap,fmt);
12393 r = Jim_vfprintf(interp, cookie, fmt,ap);
12394 va_end(ap);
12395 return r;
12396 }
12397
12398 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12399 {
12400 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12401 errno = ENOTSUP;
12402 return -1;
12403 }
12404 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12405 }
12406
12407 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12408 {
12409 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12410 errno = ENOTSUP;
12411 return 0;
12412 }
12413 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12414 }
12415
12416 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12417 {
12418 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12419 errno = ENOTSUP;
12420 return 0;
12421 }
12422 return (*(interp->cb_fread))(ptr, size, n, cookie);
12423 }
12424
12425 int Jim_fflush(Jim_Interp *interp, void *cookie)
12426 {
12427 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12428 /* pretend all is well */
12429 return 0;
12430 }
12431 return (*(interp->cb_fflush))(cookie);
12432 }
12433
12434 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12435 {
12436 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12437 errno = ENOTSUP;
12438 return NULL;
12439 }
12440 return (*(interp->cb_fgets))(s, size, cookie);
12441 }
12442 Jim_Nvp *
12443 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12444 {
12445 while (p->name) {
12446 if (0 == strcmp(name, p->name)) {
12447 break;
12448 }
12449 p++;
12450 }
12451 return ((Jim_Nvp *)(p));
12452 }
12453
12454 Jim_Nvp *
12455 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12456 {
12457 while (p->name) {
12458 if (0 == strcasecmp(name, p->name)) {
12459 break;
12460 }
12461 p++;
12462 }
12463 return ((Jim_Nvp *)(p));
12464 }
12465
12466 int
12467 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12468 const Jim_Nvp *p,
12469 Jim_Obj *o,
12470 Jim_Nvp **result)
12471 {
12472 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12473 }
12474
12475
12476 int
12477 Jim_Nvp_name2value(Jim_Interp *interp,
12478 const Jim_Nvp *_p,
12479 const char *name,
12480 Jim_Nvp **result)
12481 {
12482 const Jim_Nvp *p;
12483
12484 p = Jim_Nvp_name2value_simple(_p, name);
12485
12486 /* result */
12487 if (result) {
12488 *result = (Jim_Nvp *)(p);
12489 }
12490
12491 /* found? */
12492 if (p->name) {
12493 return JIM_OK;
12494 } else {
12495 return JIM_ERR;
12496 }
12497 }
12498
12499 int
12500 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12501 {
12502 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12503 }
12504
12505 int
12506 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12507 {
12508 const Jim_Nvp *p;
12509
12510 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12511
12512 if (puthere) {
12513 *puthere = (Jim_Nvp *)(p);
12514 }
12515 /* found */
12516 if (p->name) {
12517 return JIM_OK;
12518 } else {
12519 return JIM_ERR;
12520 }
12521 }
12522
12523
12524 int
12525 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12526 {
12527 int e;;
12528 jim_wide w;
12529
12530 e = Jim_GetWide(interp, o, &w);
12531 if (e != JIM_OK) {
12532 return e;
12533 }
12534
12535 return Jim_Nvp_value2name(interp, p, w, result);
12536 }
12537
12538 Jim_Nvp *
12539 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12540 {
12541 while (p->name) {
12542 if (value == p->value) {
12543 break;
12544 }
12545 p++;
12546 }
12547 return ((Jim_Nvp *)(p));
12548 }
12549
12550
12551 int
12552 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12553 {
12554 const Jim_Nvp *p;
12555
12556 p = Jim_Nvp_value2name_simple(_p, value);
12557
12558 if (result) {
12559 *result = (Jim_Nvp *)(p);
12560 }
12561
12562 if (p->name) {
12563 return JIM_OK;
12564 } else {
12565 return JIM_ERR;
12566 }
12567 }
12568
12569
12570 int
12571 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12572 {
12573 memset(p, 0, sizeof(*p));
12574 p->interp = interp;
12575 p->argc = argc;
12576 p->argv = argv;
12577
12578 return JIM_OK;
12579 }
12580
12581 void
12582 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12583 {
12584 int x;
12585
12586 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12587 for (x = 0 ; x < p->argc ; x++) {
12588 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12589 "%2d) %s\n",
12590 x,
12591 Jim_GetString(p->argv[x], NULL));
12592 }
12593 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12594 }
12595
12596
12597 int
12598 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12599 {
12600 Jim_Obj *o;
12601
12602 o = NULL; // failure
12603 if (goi->argc) {
12604 // success
12605 o = goi->argv[0];
12606 goi->argc -= 1;
12607 goi->argv += 1;
12608 }
12609 if (puthere) {
12610 *puthere = o;
12611 }
12612 if (o != NULL) {
12613 return JIM_OK;
12614 } else {
12615 return JIM_ERR;
12616 }
12617 }
12618
12619 int
12620 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12621 {
12622 int r;
12623 Jim_Obj *o;
12624 const char *cp;
12625
12626
12627 r = Jim_GetOpt_Obj(goi, &o);
12628 if (r == JIM_OK) {
12629 cp = Jim_GetString(o, len);
12630 if (puthere) {
12631 /* remove const */
12632 *puthere = (char *)(cp);
12633 }
12634 }
12635 return r;
12636 }
12637
12638 int
12639 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12640 {
12641 int r;
12642 Jim_Obj *o;
12643 double _safe;
12644
12645 if (puthere == NULL) {
12646 puthere = &_safe;
12647 }
12648
12649 r = Jim_GetOpt_Obj(goi, &o);
12650 if (r == JIM_OK) {
12651 r = Jim_GetDouble(goi->interp, o, puthere);
12652 if (r != JIM_OK) {
12653 Jim_SetResult_sprintf(goi->interp,
12654 "not a number: %s",
12655 Jim_GetString(o, NULL));
12656 }
12657 }
12658 return r;
12659 }
12660
12661 int
12662 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12663 {
12664 int r;
12665 Jim_Obj *o;
12666 jim_wide _safe;
12667
12668 if (puthere == NULL) {
12669 puthere = &_safe;
12670 }
12671
12672 r = Jim_GetOpt_Obj(goi, &o);
12673 if (r == JIM_OK) {
12674 r = Jim_GetWide(goi->interp, o, puthere);
12675 }
12676 return r;
12677 }
12678
12679 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12680 const Jim_Nvp *nvp,
12681 Jim_Nvp **puthere)
12682 {
12683 Jim_Nvp *_safe;
12684 Jim_Obj *o;
12685 int e;
12686
12687 if (puthere == NULL) {
12688 puthere = &_safe;
12689 }
12690
12691 e = Jim_GetOpt_Obj(goi, &o);
12692 if (e == JIM_OK) {
12693 e = Jim_Nvp_name2value_obj(goi->interp,
12694 nvp,
12695 o,
12696 puthere);
12697 }
12698
12699 return e;
12700 }
12701
12702 void
12703 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12704 const Jim_Nvp *nvptable,
12705 int hadprefix)
12706 {
12707 if (hadprefix) {
12708 Jim_SetResult_NvpUnknown(goi->interp,
12709 goi->argv[-2],
12710 goi->argv[-1],
12711 nvptable);
12712 } else {
12713 Jim_SetResult_NvpUnknown(goi->interp,
12714 NULL,
12715 goi->argv[-1],
12716 nvptable);
12717 }
12718 }
12719
12720
12721 int
12722 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12723 const char * const * lookup,
12724 int *puthere)
12725 {
12726 int _safe;
12727 Jim_Obj *o;
12728 int e;
12729
12730 if (puthere == NULL) {
12731 puthere = &_safe;
12732 }
12733 e = Jim_GetOpt_Obj(goi, &o);
12734 if (e == JIM_OK) {
12735 e = Jim_GetEnum(goi->interp,
12736 o,
12737 lookup,
12738 puthere,
12739 "option",
12740 JIM_ERRMSG);
12741 }
12742 return e;
12743 }
12744
12745
12746
12747 int
12748 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12749 {
12750 va_list ap;
12751 char *buf;
12752
12753 va_start(ap,fmt);
12754 buf = jim_vasprintf(fmt, ap);
12755 va_end(ap);
12756 if (buf) {
12757 Jim_SetResultString(interp, buf, -1);
12758 jim_vasprintf_done(buf);
12759 }
12760 return JIM_OK;
12761 }
12762
12763
12764 void
12765 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12766 Jim_Obj *param_name,
12767 Jim_Obj *param_value,
12768 const Jim_Nvp *nvp)
12769 {
12770 if (param_name) {
12771 Jim_SetResult_sprintf(interp,
12772 "%s: Unknown: %s, try one of: ",
12773 Jim_GetString(param_name, NULL),
12774 Jim_GetString(param_value, NULL));
12775 } else {
12776 Jim_SetResult_sprintf(interp,
12777 "Unknown param: %s, try one of: ",
12778 Jim_GetString(param_value, NULL));
12779 }
12780 while (nvp->name) {
12781 const char *a;
12782 const char *b;
12783
12784 if ((nvp + 1)->name) {
12785 a = nvp->name;
12786 b = ", ";
12787 } else {
12788 a = "or ";
12789 b = nvp->name;
12790 }
12791 Jim_AppendStrings(interp,
12792 Jim_GetResult(interp),
12793 a, b, NULL);
12794 nvp++;
12795 }
12796 }
12797
12798
12799 static Jim_Obj *debug_string_obj;
12800
12801 const char *
12802 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12803 {
12804 int x;
12805
12806 if (debug_string_obj) {
12807 Jim_FreeObj(interp, debug_string_obj);
12808 }
12809
12810 debug_string_obj = Jim_NewEmptyStringObj(interp);
12811 for (x = 0 ; x < argc ; x++) {
12812 Jim_AppendStrings(interp,
12813 debug_string_obj,
12814 Jim_GetString(argv[x], NULL),
12815 " ",
12816 NULL);
12817 }
12818
12819 return Jim_GetString(debug_string_obj, NULL);
12820 }

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)