c1ba0d9da97a7ea09c22c7614c4e2b547b56e75e
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 *
12 * The FreeBSD license
13 *
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
16 * are met:
17 *
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 *
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
41 **/
42 #ifdef HAVE_CONFIG_H
43 #include "config.h"
44 #endif
45
46 #define __JIM_CORE__
47 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
48
49 #ifdef __ECOS
50 #include <pkgconf/jimtcl.h>
51 #include <stdio.h>
52 #include <stdlib.h>
53 #include <string.h>
54 #include <stdarg.h>
55 #include <ctype.h>
56 #include <limits.h>
57 #include <assert.h>
58 #include <errno.h>
59 #include <time.h>
60 #endif
61 #ifndef JIM_ANSIC
62 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
63 #endif /* JIM_ANSIC */
64
65 #include <stdarg.h>
66 #include <limits.h>
67
68 /* Include the platform dependent libraries for
69 * dynamic loading of libraries. */
70 #ifdef JIM_DYNLIB
71 #if defined(_WIN32) || defined(WIN32)
72 #ifndef WIN32
73 #define WIN32 1
74 #endif
75 #ifndef STRICT
76 #define STRICT
77 #endif
78 #define WIN32_LEAN_AND_MEAN
79 #include <windows.h>
80 #if _MSC_VER >= 1000
81 #pragma warning(disable:4146)
82 #endif /* _MSC_VER */
83 #else
84 #include <dlfcn.h>
85 #endif /* WIN32 */
86 #endif /* JIM_DYNLIB */
87
88 #ifdef __ECOS
89 #include <cyg/jimtcl/jim.h>
90 #else
91 #include "jim.h"
92 #endif
93
94 #ifdef HAVE_BACKTRACE
95 #include <execinfo.h>
96 #endif
97
98 /* -----------------------------------------------------------------------------
99 * Global variables
100 * ---------------------------------------------------------------------------*/
101
102 /* A shared empty string for the objects string representation.
103 * Jim_InvalidateStringRep knows about it and don't try to free. */
104 static char *JimEmptyStringRep = (char*) "";
105
106 /* -----------------------------------------------------------------------------
107 * Required prototypes of not exported functions
108 * ---------------------------------------------------------------------------*/
109 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
110 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
111 static void JimRegisterCoreApi(Jim_Interp *interp);
112
113 static Jim_HashTableType *getJimVariablesHashTableType(void);
114
115 /* -----------------------------------------------------------------------------
116 * Utility functions
117 * ---------------------------------------------------------------------------*/
118
119 static char *
120 jim_vasprintf(const char *fmt, va_list ap)
121 {
122 #ifndef HAVE_VASPRINTF
123 /* yucky way */
124 static char buf[2048];
125 vsnprintf(buf, sizeof(buf), fmt, ap);
126 /* garentee termination */
127 buf[sizeof(buf)-1] = 0;
128 #else
129 char *buf;
130 int result;
131 result = vasprintf(&buf, fmt, ap);
132 if (result < 0) exit(-1);
133 #endif
134 return buf;
135 }
136
137 static void
138 jim_vasprintf_done(void *buf)
139 {
140 #ifndef HAVE_VASPRINTF
141 (void)(buf);
142 #else
143 free(buf);
144 #endif
145 }
146
147
148 /*
149 * Convert a string to a jim_wide INTEGER.
150 * This function originates from BSD.
151 *
152 * Ignores `locale' stuff. Assumes that the upper and lower case
153 * alphabets and digits are each contiguous.
154 */
155 #ifdef HAVE_LONG_LONG_INT
156 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
157 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
158 {
159 register const char *s;
160 register unsigned jim_wide acc;
161 register unsigned char c;
162 register unsigned jim_wide qbase, cutoff;
163 register int neg, any, cutlim;
164
165 /*
166 * Skip white space and pick up leading +/- sign if any.
167 * If base is 0, allow 0x for hex and 0 for octal, else
168 * assume decimal; if base is already 16, allow 0x.
169 */
170 s = nptr;
171 do {
172 c = *s++;
173 } while (isspace(c));
174 if (c == '-') {
175 neg = 1;
176 c = *s++;
177 } else {
178 neg = 0;
179 if (c == '+')
180 c = *s++;
181 }
182 if ((base == 0 || base == 16) &&
183 c == '0' && (*s == 'x' || *s == 'X')) {
184 c = s[1];
185 s += 2;
186 base = 16;
187 }
188 if (base == 0)
189 base = c == '0' ? 8 : 10;
190
191 /*
192 * Compute the cutoff value between legal numbers and illegal
193 * numbers. That is the largest legal value, divided by the
194 * base. An input number that is greater than this value, if
195 * followed by a legal input character, is too big. One that
196 * is equal to this value may be valid or not; the limit
197 * between valid and invalid numbers is then based on the last
198 * digit. For instance, if the range for quads is
199 * [-9223372036854775808..9223372036854775807] and the input base
200 * is 10, cutoff will be set to 922337203685477580 and cutlim to
201 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
202 * accumulated a value > 922337203685477580, or equal but the
203 * next digit is > 7 (or 8), the number is too big, and we will
204 * return a range error.
205 *
206 * Set any if any `digits' consumed; make it negative to indicate
207 * overflow.
208 */
209 qbase = (unsigned)base;
210 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
211 : LLONG_MAX;
212 cutlim = (int)(cutoff % qbase);
213 cutoff /= qbase;
214 for (acc = 0, any = 0;; c = *s++) {
215 if (!JimIsAscii(c))
216 break;
217 if (isdigit(c))
218 c -= '0';
219 else if (isalpha(c))
220 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
221 else
222 break;
223 if (c >= base)
224 break;
225 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
226 any = -1;
227 else {
228 any = 1;
229 acc *= qbase;
230 acc += c;
231 }
232 }
233 if (any < 0) {
234 acc = neg ? LLONG_MIN : LLONG_MAX;
235 errno = ERANGE;
236 } else if (neg)
237 acc = -acc;
238 if (endptr != 0)
239 *endptr = (char *)(any ? s - 1 : nptr);
240 return (acc);
241 }
242 #endif
243
244 /* Glob-style pattern matching. */
245 static int JimStringMatch(const char *pattern, int patternLen,
246 const char *string, int stringLen, int nocase)
247 {
248 while (patternLen) {
249 switch (pattern[0]) {
250 case '*':
251 while (pattern[1] == '*') {
252 pattern++;
253 patternLen--;
254 }
255 if (patternLen == 1)
256 return 1; /* match */
257 while (stringLen) {
258 if (JimStringMatch(pattern + 1, patternLen-1,
259 string, stringLen, nocase))
260 return 1; /* match */
261 string++;
262 stringLen--;
263 }
264 return 0; /* no match */
265 break;
266 case '?':
267 if (stringLen == 0)
268 return 0; /* no match */
269 string++;
270 stringLen--;
271 break;
272 case '[':
273 {
274 int not, match;
275
276 pattern++;
277 patternLen--;
278 not = pattern[0] == '^';
279 if (not) {
280 pattern++;
281 patternLen--;
282 }
283 match = 0;
284 while (1) {
285 if (pattern[0] == '\\') {
286 pattern++;
287 patternLen--;
288 if (pattern[0] == string[0])
289 match = 1;
290 } else if (pattern[0] == ']') {
291 break;
292 } else if (patternLen == 0) {
293 pattern--;
294 patternLen++;
295 break;
296 } else if (pattern[1] == '-' && patternLen >= 3) {
297 int start = pattern[0];
298 int end = pattern[2];
299 int c = string[0];
300 if (start > end) {
301 int t = start;
302 start = end;
303 end = t;
304 }
305 if (nocase) {
306 start = tolower(start);
307 end = tolower(end);
308 c = tolower(c);
309 }
310 pattern += 2;
311 patternLen -= 2;
312 if (c >= start && c <= end)
313 match = 1;
314 } else {
315 if (!nocase) {
316 if (pattern[0] == string[0])
317 match = 1;
318 } else {
319 if (tolower((int)pattern[0]) == tolower((int)string[0]))
320 match = 1;
321 }
322 }
323 pattern++;
324 patternLen--;
325 }
326 if (not)
327 match = !match;
328 if (!match)
329 return 0; /* no match */
330 string++;
331 stringLen--;
332 break;
333 }
334 case '\\':
335 if (patternLen >= 2) {
336 pattern++;
337 patternLen--;
338 }
339 /* fall through */
340 default:
341 if (!nocase) {
342 if (pattern[0] != string[0])
343 return 0; /* no match */
344 } else {
345 if (tolower((int)pattern[0]) != tolower((int)string[0]))
346 return 0; /* no match */
347 }
348 string++;
349 stringLen--;
350 break;
351 }
352 pattern++;
353 patternLen--;
354 if (stringLen == 0) {
355 while (*pattern == '*') {
356 pattern++;
357 patternLen--;
358 }
359 break;
360 }
361 }
362 if (patternLen == 0 && stringLen == 0)
363 return 1;
364 return 0;
365 }
366
367 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
368 int nocase)
369 {
370 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
371
372 if (nocase == 0) {
373 while (l1 && l2) {
374 if (*u1 != *u2)
375 return (int)*u1-*u2;
376 u1++; u2++; l1--; l2--;
377 }
378 if (!l1 && !l2) return 0;
379 return l1-l2;
380 } else {
381 while (l1 && l2) {
382 if (tolower((int)*u1) != tolower((int)*u2))
383 return tolower((int)*u1)-tolower((int)*u2);
384 u1++; u2++; l1--; l2--;
385 }
386 if (!l1 && !l2) return 0;
387 return l1-l2;
388 }
389 }
390
391 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
392 * The index of the first occurrence of s1 in s2 is returned.
393 * If s1 is not found inside s2, -1 is returned. */
394 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
395 {
396 int i;
397
398 if (!l1 || !l2 || l1 > l2) return -1;
399 if (index < 0) index = 0;
400 s2 += index;
401 for (i = index; i <= l2-l1; i++) {
402 if (memcmp(s2, s1, l1) == 0)
403 return i;
404 s2++;
405 }
406 return -1;
407 }
408
409 int Jim_WideToString(char *buf, jim_wide wideValue)
410 {
411 const char *fmt = "%" JIM_WIDE_MODIFIER;
412 return sprintf(buf, fmt, wideValue);
413 }
414
415 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
416 {
417 char *endptr;
418
419 #ifdef HAVE_LONG_LONG_INT
420 *widePtr = JimStrtoll(str, &endptr, base);
421 #else
422 *widePtr = strtol(str, &endptr, base);
423 #endif
424 if ((str[0] == '\0') || (str == endptr))
425 return JIM_ERR;
426 if (endptr[0] != '\0') {
427 while (*endptr) {
428 if (!isspace((int)*endptr))
429 return JIM_ERR;
430 endptr++;
431 }
432 }
433 return JIM_OK;
434 }
435
436 int Jim_StringToIndex(const char *str, int *intPtr)
437 {
438 char *endptr;
439
440 *intPtr = strtol(str, &endptr, 10);
441 if ((str[0] == '\0') || (str == endptr))
442 return JIM_ERR;
443 if (endptr[0] != '\0') {
444 while (*endptr) {
445 if (!isspace((int)*endptr))
446 return JIM_ERR;
447 endptr++;
448 }
449 }
450 return JIM_OK;
451 }
452
453 /* The string representation of references has two features in order
454 * to make the GC faster. The first is that every reference starts
455 * with a non common character '~', in order to make the string matching
456 * fater. The second is that the reference string rep his 32 characters
457 * in length, this allows to avoid to check every object with a string
458 * repr < 32, and usually there are many of this objects. */
459
460 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
461
462 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
463 {
464 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
465 sprintf(buf, fmt, refPtr->tag, id);
466 return JIM_REFERENCE_SPACE;
467 }
468
469 int Jim_DoubleToString(char *buf, double doubleValue)
470 {
471 char *s;
472 int len;
473
474 len = sprintf(buf, "%.17g", doubleValue);
475 s = buf;
476 while (*s) {
477 if (*s == '.') return len;
478 s++;
479 }
480 /* Add a final ".0" if it's a number. But not
481 * for NaN or InF */
482 if (isdigit((int)buf[0])
483 || ((buf[0] == '-' || buf[0] == '+')
484 && isdigit((int)buf[1]))) {
485 s[0] = '.';
486 s[1] = '0';
487 s[2] = '\0';
488 return len + 2;
489 }
490 return len;
491 }
492
493 int Jim_StringToDouble(const char *str, double *doublePtr)
494 {
495 char *endptr;
496
497 *doublePtr = strtod(str, &endptr);
498 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
499 return JIM_ERR;
500 return JIM_OK;
501 }
502
503 static jim_wide JimPowWide(jim_wide b, jim_wide e)
504 {
505 jim_wide i, res = 1;
506 if ((b == 0 && e != 0) || (e < 0)) return 0;
507 for (i = 0; i < e; i++) {res *= b;}
508 return res;
509 }
510
511 /* -----------------------------------------------------------------------------
512 * Special functions
513 * ---------------------------------------------------------------------------*/
514
515 /* Note that 'interp' may be NULL if not available in the
516 * context of the panic. It's only useful to get the error
517 * file descriptor, it will default to stderr otherwise. */
518 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
519 {
520 va_list ap;
521
522 va_start(ap, fmt);
523 /*
524 * Send it here first.. Assuming STDIO still works
525 */
526 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
527 vfprintf(stderr, fmt, ap);
528 fprintf(stderr, JIM_NL JIM_NL);
529 va_end(ap);
530
531 #ifdef HAVE_BACKTRACE
532 {
533 void *array[40];
534 int size, i;
535 char **strings;
536
537 size = backtrace(array, 40);
538 strings = backtrace_symbols(array, size);
539 for (i = 0; i < size; i++)
540 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
541 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
542 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
543 }
544 #endif
545
546 /* This may actually crash... we do it last */
547 if (interp && interp->cookie_stderr) {
548 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
549 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
550 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
551 }
552 abort();
553 }
554
555 /* -----------------------------------------------------------------------------
556 * Memory allocation
557 * ---------------------------------------------------------------------------*/
558
559 /* Macro used for memory debugging.
560 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
561 * and similary for Jim_Realloc and Jim_Free */
562 #if 0
563 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
564 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
565 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
566 #endif
567
568 void *Jim_Alloc(int size)
569 {
570 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
571 if (size == 0)
572 size = 1;
573 void *p = malloc(size);
574 if (p == NULL)
575 Jim_Panic(NULL,"malloc: Out of memory");
576 return p;
577 }
578
579 void Jim_Free(void *ptr) {
580 free(ptr);
581 }
582
583 void *Jim_Realloc(void *ptr, int size)
584 {
585 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
586 if (size == 0)
587 size = 1;
588 void *p = realloc(ptr, size);
589 if (p == NULL)
590 Jim_Panic(NULL,"realloc: Out of memory");
591 return p;
592 }
593
594 char *Jim_StrDup(const char *s)
595 {
596 int l = strlen(s);
597 char *copy = Jim_Alloc(l + 1);
598
599 memcpy(copy, s, l + 1);
600 return copy;
601 }
602
603 char *Jim_StrDupLen(const char *s, int l)
604 {
605 char *copy = Jim_Alloc(l + 1);
606
607 memcpy(copy, s, l + 1);
608 copy[l] = 0; /* Just to be sure, original could be substring */
609 return copy;
610 }
611
612 /* -----------------------------------------------------------------------------
613 * Time related functions
614 * ---------------------------------------------------------------------------*/
615 /* Returns microseconds of CPU used since start. */
616 static jim_wide JimClock(void)
617 {
618 #if (defined WIN32) && !(defined JIM_ANSIC)
619 LARGE_INTEGER t, f;
620 QueryPerformanceFrequency(&f);
621 QueryPerformanceCounter(&t);
622 return (long)((t.QuadPart * 1000000) / f.QuadPart);
623 #else /* !WIN32 */
624 clock_t clocks = clock();
625
626 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
627 #endif /* WIN32 */
628 }
629
630 /* -----------------------------------------------------------------------------
631 * Hash Tables
632 * ---------------------------------------------------------------------------*/
633
634 /* -------------------------- private prototypes ---------------------------- */
635 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
636 static unsigned int JimHashTableNextPower(unsigned int size);
637 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
638
639 /* -------------------------- hash functions -------------------------------- */
640
641 /* Thomas Wang's 32 bit Mix Function */
642 unsigned int Jim_IntHashFunction(unsigned int key)
643 {
644 key += ~(key << 15);
645 key ^= (key >> 10);
646 key += (key << 3);
647 key ^= (key >> 6);
648 key += ~(key << 11);
649 key ^= (key >> 16);
650 return key;
651 }
652
653 /* Identity hash function for integer keys */
654 unsigned int Jim_IdentityHashFunction(unsigned int key)
655 {
656 return key;
657 }
658
659 /* Generic hash function (we are using to multiply by 9 and add the byte
660 * as Tcl) */
661 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;
757 Jim_HashEntry *entry;
758
759 /* Get the index of the new element, or -1 if
760 * the element already exists. */
761 if ((index = 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];
767 ht->table[index] = 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 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 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 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 /* Low-level wrapper to append an object. */
2038 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2039 {
2040 int len;
2041 const char *str;
2042
2043 str = Jim_GetString(appendObjPtr, &len);
2044 StringAppendString(objPtr, str, len);
2045 }
2046
2047 /* Higher level API to append strings to objects. */
2048 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2049 int len)
2050 {
2051 if (Jim_IsShared(objPtr))
2052 Jim_Panic(interp,"Jim_AppendString called with shared object");
2053 if (objPtr->typePtr != &stringObjType)
2054 SetStringFromAny(interp, objPtr);
2055 StringAppendString(objPtr, str, len);
2056 }
2057
2058 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2059 {
2060 char *buf;
2061 va_list ap;
2062
2063 va_start(ap, fmt);
2064 buf = jim_vasprintf(fmt, ap);
2065 va_end(ap);
2066
2067 if (buf) {
2068 Jim_AppendString(interp, objPtr, buf, -1);
2069 jim_vasprintf_done(buf);
2070 }
2071 }
2072
2073
2074 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2075 Jim_Obj *appendObjPtr)
2076 {
2077 int len;
2078 const char *str;
2079
2080 str = Jim_GetString(appendObjPtr, &len);
2081 Jim_AppendString(interp, objPtr, str, len);
2082 }
2083
2084 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2085 {
2086 va_list ap;
2087
2088 if (objPtr->typePtr != &stringObjType)
2089 SetStringFromAny(interp, objPtr);
2090 va_start(ap, objPtr);
2091 while (1) {
2092 char *s = va_arg(ap, char*);
2093
2094 if (s == NULL) break;
2095 Jim_AppendString(interp, objPtr, s, -1);
2096 }
2097 va_end(ap);
2098 }
2099
2100 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2101 {
2102 const char *aStr, *bStr;
2103 int aLen, bLen, i;
2104
2105 if (aObjPtr == bObjPtr) return 1;
2106 aStr = Jim_GetString(aObjPtr, &aLen);
2107 bStr = Jim_GetString(bObjPtr, &bLen);
2108 if (aLen != bLen) return 0;
2109 if (nocase == 0)
2110 return memcmp(aStr, bStr, aLen) == 0;
2111 for (i = 0; i < aLen; i++) {
2112 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2113 return 0;
2114 }
2115 return 1;
2116 }
2117
2118 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2119 int nocase)
2120 {
2121 const char *pattern, *string;
2122 int patternLen, stringLen;
2123
2124 pattern = Jim_GetString(patternObjPtr, &patternLen);
2125 string = Jim_GetString(objPtr, &stringLen);
2126 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2127 }
2128
2129 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2130 Jim_Obj *secondObjPtr, int nocase)
2131 {
2132 const char *s1, *s2;
2133 int l1, l2;
2134
2135 s1 = Jim_GetString(firstObjPtr, &l1);
2136 s2 = Jim_GetString(secondObjPtr, &l2);
2137 return JimStringCompare(s1, l1, s2, l2, nocase);
2138 }
2139
2140 /* Convert a range, as returned by Jim_GetRange(), into
2141 * an absolute index into an object of the specified length.
2142 * This function may return negative values, or values
2143 * bigger or equal to the length of the list if the index
2144 * is out of range. */
2145 static int JimRelToAbsIndex(int len, int index)
2146 {
2147 if (index < 0)
2148 return len + index;
2149 return index;
2150 }
2151
2152 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2153 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2154 * for implementation of commands like [string range] and [lrange].
2155 *
2156 * The resulting range is guaranteed to address valid elements of
2157 * the structure. */
2158 static void JimRelToAbsRange(int len, int first, int last,
2159 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2160 {
2161 int rangeLen;
2162
2163 if (first > last) {
2164 rangeLen = 0;
2165 } else {
2166 rangeLen = last-first + 1;
2167 if (rangeLen) {
2168 if (first < 0) {
2169 rangeLen += first;
2170 first = 0;
2171 }
2172 if (last >= len) {
2173 rangeLen -= (last-(len-1));
2174 last = len-1;
2175 }
2176 }
2177 }
2178 if (rangeLen < 0) rangeLen = 0;
2179
2180 *firstPtr = first;
2181 *lastPtr = last;
2182 *rangeLenPtr = rangeLen;
2183 }
2184
2185 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2186 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2187 {
2188 int first, last;
2189 const char *str;
2190 int len, rangeLen;
2191
2192 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2193 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2194 return NULL;
2195 str = Jim_GetString(strObjPtr, &len);
2196 first = JimRelToAbsIndex(len, first);
2197 last = JimRelToAbsIndex(len, last);
2198 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2199 return Jim_NewStringObj(interp, str + first, rangeLen);
2200 }
2201
2202 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2203 {
2204 char *buf;
2205 int i;
2206 if (strObjPtr->typePtr != &stringObjType) {
2207 SetStringFromAny(interp, strObjPtr);
2208 }
2209
2210 buf = Jim_Alloc(strObjPtr->length + 1);
2211
2212 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2213 for (i = 0; i < strObjPtr->length; i++)
2214 buf[i] = tolower(buf[i]);
2215 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2216 }
2217
2218 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2219 {
2220 char *buf;
2221 int i;
2222 if (strObjPtr->typePtr != &stringObjType) {
2223 SetStringFromAny(interp, strObjPtr);
2224 }
2225
2226 buf = Jim_Alloc(strObjPtr->length + 1);
2227
2228 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2229 for (i = 0; i < strObjPtr->length; i++)
2230 buf[i] = toupper(buf[i]);
2231 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2232 }
2233
2234 /* This is the core of the [format] command.
2235 * TODO: Lots of things work - via a hack
2236 * However, no format item can be >= JIM_MAX_FMT
2237 */
2238 #define JIM_MAX_FMT 2048
2239 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2240 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2241 {
2242 const char *fmt, *_fmt;
2243 int fmtLen;
2244 Jim_Obj *resObjPtr;
2245
2246
2247 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2248 _fmt = fmt;
2249 resObjPtr = Jim_NewStringObj(interp, "", 0);
2250 while (fmtLen) {
2251 const char *p = fmt;
2252 char spec[2], c;
2253 jim_wide wideValue;
2254 double doubleValue;
2255 /* we cheat and use Sprintf()! */
2256 char fmt_str[100];
2257 char *cp;
2258 int width;
2259 int ljust;
2260 int zpad;
2261 int spad;
2262 int altfm;
2263 int forceplus;
2264 int prec;
2265 int inprec;
2266 int haveprec;
2267 int accum;
2268
2269 while (*fmt != '%' && fmtLen) {
2270 fmt++; fmtLen--;
2271 }
2272 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2273 if (fmtLen == 0)
2274 break;
2275 fmt++; fmtLen--; /* skip '%' */
2276 zpad = 0;
2277 spad = 0;
2278 width = -1;
2279 ljust = 0;
2280 altfm = 0;
2281 forceplus = 0;
2282 inprec = 0;
2283 haveprec = 0;
2284 prec = -1; /* not found yet */
2285 next_fmt:
2286 if (fmtLen <= 0) {
2287 break;
2288 }
2289 switch (*fmt) {
2290 /* terminals */
2291 case 'b': /* binary - not all printfs() do this */
2292 case 's': /* string */
2293 case 'i': /* integer */
2294 case 'd': /* decimal */
2295 case 'x': /* hex */
2296 case 'X': /* CAP hex */
2297 case 'c': /* char */
2298 case 'o': /* octal */
2299 case 'u': /* unsigned */
2300 case 'f': /* float */
2301 break;
2302
2303 /* non-terminals */
2304 case '0': /* zero pad */
2305 zpad = 1;
2306 fmt++; fmtLen--;
2307 goto next_fmt;
2308 break;
2309 case '+':
2310 forceplus = 1;
2311 fmt++; fmtLen--;
2312 goto next_fmt;
2313 break;
2314 case ' ': /* sign space */
2315 spad = 1;
2316 fmt++; fmtLen--;
2317 goto next_fmt;
2318 break;
2319 case '-':
2320 ljust = 1;
2321 fmt++; fmtLen--;
2322 goto next_fmt;
2323 break;
2324 case '#':
2325 altfm = 1;
2326 fmt++; fmtLen--;
2327 goto next_fmt;
2328
2329 case '.':
2330 inprec = 1;
2331 fmt++; fmtLen--;
2332 goto next_fmt;
2333 break;
2334 case '1':
2335 case '2':
2336 case '3':
2337 case '4':
2338 case '5':
2339 case '6':
2340 case '7':
2341 case '8':
2342 case '9':
2343 accum = 0;
2344 while (isdigit(*fmt) && (fmtLen > 0)) {
2345 accum = (accum * 10) + (*fmt - '0');
2346 fmt++; fmtLen--;
2347 }
2348 if (inprec) {
2349 haveprec = 1;
2350 prec = accum;
2351 } else {
2352 width = accum;
2353 }
2354 goto next_fmt;
2355 case '*':
2356 /* suck up the next item as an integer */
2357 fmt++; fmtLen--;
2358 objc--;
2359 if (objc <= 0) {
2360 goto not_enough_args;
2361 }
2362 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2363 Jim_FreeNewObj(interp, resObjPtr);
2364 return NULL;
2365 }
2366 if (inprec) {
2367 haveprec = 1;
2368 prec = wideValue;
2369 if (prec < 0) {
2370 /* man 3 printf says */
2371 /* if prec is negative, it is zero */
2372 prec = 0;
2373 }
2374 } else {
2375 width = wideValue;
2376 if (width < 0) {
2377 ljust = 1;
2378 width = -width;
2379 }
2380 }
2381 objv++;
2382 goto next_fmt;
2383 break;
2384 }
2385
2386
2387 if (*fmt != '%') {
2388 if (objc == 0) {
2389 not_enough_args:
2390 Jim_FreeNewObj(interp, resObjPtr);
2391 Jim_SetResultString(interp,
2392 "not enough arguments for all format specifiers", -1);
2393 return NULL;
2394 } else {
2395 objc--;
2396 }
2397 }
2398
2399 /*
2400 * Create the formatter
2401 * cause we cheat and use sprintf()
2402 */
2403 cp = fmt_str;
2404 *cp++ = '%';
2405 if (altfm) {
2406 *cp++ = '#';
2407 }
2408 if (forceplus) {
2409 *cp++ = '+';
2410 } else if (spad) {
2411 /* PLUS overrides */
2412 *cp++ = ' ';
2413 }
2414 if (ljust) {
2415 *cp++ = '-';
2416 }
2417 if (zpad) {
2418 *cp++ = '0';
2419 }
2420 if (width > 0) {
2421 sprintf(cp, "%d", width);
2422 /* skip ahead */
2423 cp = strchr(cp,0);
2424 }
2425 /* did we find a period? */
2426 if (inprec) {
2427 /* then add it */
2428 *cp++ = '.';
2429 /* did something occur after the period? */
2430 if (haveprec) {
2431 sprintf(cp, "%d", prec);
2432 }
2433 cp = strchr(cp,0);
2434 }
2435 *cp = 0;
2436
2437 /* here we do the work */
2438 /* actually - we make sprintf() do it for us */
2439 switch (*fmt) {
2440 case 's':
2441 *cp++ = 's';
2442 *cp = 0;
2443 /* BUG: we do not handled embeded NULLs */
2444 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2445 break;
2446 case 'c':
2447 *cp++ = 'c';
2448 *cp = 0;
2449 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2450 Jim_FreeNewObj(interp, resObjPtr);
2451 return NULL;
2452 }
2453 c = (char) wideValue;
2454 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2455 break;
2456 case 'f':
2457 case 'F':
2458 case 'g':
2459 case 'G':
2460 case 'e':
2461 case 'E':
2462 *cp++ = *fmt;
2463 *cp = 0;
2464 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2465 Jim_FreeNewObj(interp, resObjPtr);
2466 return NULL;
2467 }
2468 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2469 break;
2470 case 'b':
2471 case 'd':
2472 case 'o':
2473 case 'i':
2474 case 'u':
2475 case 'x':
2476 case 'X':
2477 /* jim widevaluse are 64bit */
2478 if (sizeof(jim_wide) == sizeof(long long)) {
2479 *cp++ = 'l';
2480 *cp++ = 'l';
2481 } else {
2482 *cp++ = 'l';
2483 }
2484 *cp++ = *fmt;
2485 *cp = 0;
2486 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2487 Jim_FreeNewObj(interp, resObjPtr);
2488 return NULL;
2489 }
2490 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2491 break;
2492 case '%':
2493 sprintf_buf[0] = '%';
2494 sprintf_buf[1] = 0;
2495 objv--; /* undo the objv++ below */
2496 break;
2497 default:
2498 spec[0] = *fmt; spec[1] = '\0';
2499 Jim_FreeNewObj(interp, resObjPtr);
2500 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2501 Jim_AppendStrings(interp, Jim_GetResult(interp),
2502 "bad field specifier \"", spec, "\"", NULL);
2503 return NULL;
2504 }
2505 /* force terminate */
2506 #if 0
2507 printf("FMT was: %s\n", fmt_str);
2508 printf("RES was: |%s|\n", sprintf_buf);
2509 #endif
2510
2511 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2512 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2513 /* next obj */
2514 objv++;
2515 fmt++;
2516 fmtLen--;
2517 }
2518 return resObjPtr;
2519 }
2520
2521 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2522 int objc, Jim_Obj *const *objv)
2523 {
2524 char *sprintf_buf = malloc(JIM_MAX_FMT);
2525 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2526 free(sprintf_buf);
2527 return t;
2528 }
2529
2530 /* -----------------------------------------------------------------------------
2531 * Compared String Object
2532 * ---------------------------------------------------------------------------*/
2533
2534 /* This is strange object that allows to compare a C literal string
2535 * with a Jim object in very short time if the same comparison is done
2536 * multiple times. For example every time the [if] command is executed,
2537 * Jim has to check if a given argument is "else". This comparions if
2538 * the code has no errors are true most of the times, so we can cache
2539 * inside the object the pointer of the string of the last matching
2540 * comparison. Because most C compilers perform literal sharing,
2541 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2542 * this works pretty well even if comparisons are at different places
2543 * inside the C code. */
2544
2545 static Jim_ObjType comparedStringObjType = {
2546 "compared-string",
2547 NULL,
2548 NULL,
2549 NULL,
2550 JIM_TYPE_REFERENCES,
2551 };
2552
2553 /* The only way this object is exposed to the API is via the following
2554 * function. Returns true if the string and the object string repr.
2555 * are the same, otherwise zero is returned.
2556 *
2557 * Note: this isn't binary safe, but it hardly needs to be.*/
2558 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2559 const char *str)
2560 {
2561 if (objPtr->typePtr == &comparedStringObjType &&
2562 objPtr->internalRep.ptr == str)
2563 return 1;
2564 else {
2565 const char *objStr = Jim_GetString(objPtr, NULL);
2566 if (strcmp(str, objStr) != 0) return 0;
2567 if (objPtr->typePtr != &comparedStringObjType) {
2568 Jim_FreeIntRep(interp, objPtr);
2569 objPtr->typePtr = &comparedStringObjType;
2570 }
2571 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2572 return 1;
2573 }
2574 }
2575
2576 int qsortCompareStringPointers(const void *a, const void *b)
2577 {
2578 char * const *sa = (char * const *)a;
2579 char * const *sb = (char * const *)b;
2580 return strcmp(*sa, *sb);
2581 }
2582
2583 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2584 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2585 {
2586 const char * const *entryPtr = NULL;
2587 char **tablePtrSorted;
2588 int i, count = 0;
2589
2590 *indexPtr = -1;
2591 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2592 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2593 *indexPtr = i;
2594 return JIM_OK;
2595 }
2596 count++; /* If nothing matches, this will reach the len of tablePtr */
2597 }
2598 if (flags & JIM_ERRMSG) {
2599 if (name == NULL)
2600 name = "option";
2601 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2602 Jim_AppendStrings(interp, Jim_GetResult(interp),
2603 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2604 NULL);
2605 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2606 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2607 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2608 for (i = 0; i < count; i++) {
2609 if (i + 1 == count && count > 1)
2610 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2611 Jim_AppendString(interp, Jim_GetResult(interp),
2612 tablePtrSorted[i], -1);
2613 if (i + 1 != count)
2614 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2615 }
2616 Jim_Free(tablePtrSorted);
2617 }
2618 return JIM_ERR;
2619 }
2620
2621 int Jim_GetNvp(Jim_Interp *interp,
2622 Jim_Obj *objPtr,
2623 const Jim_Nvp *nvp_table,
2624 const Jim_Nvp ** result)
2625 {
2626 Jim_Nvp *n;
2627 int e;
2628
2629 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2630 if (e == JIM_ERR) {
2631 return e;
2632 }
2633
2634 /* Success? found? */
2635 if (n->name) {
2636 /* remove const */
2637 *result = (Jim_Nvp *)n;
2638 return JIM_OK;
2639 } else {
2640 return JIM_ERR;
2641 }
2642 }
2643
2644 /* -----------------------------------------------------------------------------
2645 * Source Object
2646 *
2647 * This object is just a string from the language point of view, but
2648 * in the internal representation it contains the filename and line number
2649 * where this given token was read. This information is used by
2650 * Jim_EvalObj() if the object passed happens to be of type "source".
2651 *
2652 * This allows to propagate the information about line numbers and file
2653 * names and give error messages with absolute line numbers.
2654 *
2655 * Note that this object uses shared strings for filenames, and the
2656 * pointer to the filename together with the line number is taken into
2657 * the space for the "inline" internal represenation of the Jim_Object,
2658 * so there is almost memory zero-overhead.
2659 *
2660 * Also the object will be converted to something else if the given
2661 * token it represents in the source file is not something to be
2662 * evaluated (not a script), and will be specialized in some other way,
2663 * so the time overhead is alzo null.
2664 * ---------------------------------------------------------------------------*/
2665
2666 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2667 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2668
2669 static Jim_ObjType sourceObjType = {
2670 "source",
2671 FreeSourceInternalRep,
2672 DupSourceInternalRep,
2673 NULL,
2674 JIM_TYPE_REFERENCES,
2675 };
2676
2677 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2678 {
2679 Jim_ReleaseSharedString(interp,
2680 objPtr->internalRep.sourceValue.fileName);
2681 }
2682
2683 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2684 {
2685 dupPtr->internalRep.sourceValue.fileName =
2686 Jim_GetSharedString(interp,
2687 srcPtr->internalRep.sourceValue.fileName);
2688 dupPtr->internalRep.sourceValue.lineNumber =
2689 dupPtr->internalRep.sourceValue.lineNumber;
2690 dupPtr->typePtr = &sourceObjType;
2691 }
2692
2693 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2694 const char *fileName, int lineNumber)
2695 {
2696 if (Jim_IsShared(objPtr))
2697 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2698 if (objPtr->typePtr != NULL)
2699 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2700 objPtr->internalRep.sourceValue.fileName =
2701 Jim_GetSharedString(interp, fileName);
2702 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2703 objPtr->typePtr = &sourceObjType;
2704 }
2705
2706 /* -----------------------------------------------------------------------------
2707 * Script Object
2708 * ---------------------------------------------------------------------------*/
2709
2710 #define JIM_CMDSTRUCT_EXPAND -1
2711
2712 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2713 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2714 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2715
2716 static Jim_ObjType scriptObjType = {
2717 "script",
2718 FreeScriptInternalRep,
2719 DupScriptInternalRep,
2720 NULL,
2721 JIM_TYPE_REFERENCES,
2722 };
2723
2724 /* The ScriptToken structure represents every token into a scriptObj.
2725 * Every token contains an associated Jim_Obj that can be specialized
2726 * by commands operating on it. */
2727 typedef struct ScriptToken {
2728 int type;
2729 Jim_Obj *objPtr;
2730 int linenr;
2731 } ScriptToken;
2732
2733 /* This is the script object internal representation. An array of
2734 * ScriptToken structures, with an associated command structure array.
2735 * The command structure is a pre-computed representation of the
2736 * command length and arguments structure as a simple liner array
2737 * of integers.
2738 *
2739 * For example the script:
2740 *
2741 * puts hello
2742 * set $i $x$y [foo]BAR
2743 *
2744 * will produce a ScriptObj with the following Tokens:
2745 *
2746 * ESC puts
2747 * SEP
2748 * ESC hello
2749 * EOL
2750 * ESC set
2751 * EOL
2752 * VAR i
2753 * SEP
2754 * VAR x
2755 * VAR y
2756 * SEP
2757 * CMD foo
2758 * ESC BAR
2759 * EOL
2760 *
2761 * This is a description of the tokens, separators, and of lines.
2762 * The command structure instead represents the number of arguments
2763 * of every command, followed by the tokens of which every argument
2764 * is composed. So for the example script, the cmdstruct array will
2765 * contain:
2766 *
2767 * 2 1 1 4 1 1 2 2
2768 *
2769 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2770 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2771 * composed of single tokens (1 1) and the last two of double tokens
2772 * (2 2).
2773 *
2774 * The precomputation of the command structure makes Jim_Eval() faster,
2775 * and simpler because there aren't dynamic lengths / allocations.
2776 *
2777 * -- {expand} handling --
2778 *
2779 * Expand is handled in a special way. When a command
2780 * contains at least an argument with the {expand} prefix,
2781 * the command structure presents a -1 before the integer
2782 * describing the number of arguments. This is used in order
2783 * to send the command exection to a different path in case
2784 * of {expand} and guarantee a fast path for the more common
2785 * case. Also, the integers describing the number of tokens
2786 * are expressed with negative sign, to allow for fast check
2787 * of what's an {expand}-prefixed argument and what not.
2788 *
2789 * For example the command:
2790 *
2791 * list {expand}{1 2}
2792 *
2793 * Will produce the following cmdstruct array:
2794 *
2795 * -1 2 1 -2
2796 *
2797 * -- the substFlags field of the structure --
2798 *
2799 * The scriptObj structure is used to represent both "script" objects
2800 * and "subst" objects. In the second case, the cmdStruct related
2801 * fields are not used at all, but there is an additional field used
2802 * that is 'substFlags': this represents the flags used to turn
2803 * the string into the intenral representation used to perform the
2804 * substitution. If this flags are not what the application requires
2805 * the scriptObj is created again. For example the script:
2806 *
2807 * subst -nocommands $string
2808 * subst -novariables $string
2809 *
2810 * Will recreate the internal representation of the $string object
2811 * two times.
2812 */
2813 typedef struct ScriptObj {
2814 int len; /* Length as number of tokens. */
2815 int commands; /* number of top-level commands in script. */
2816 ScriptToken *token; /* Tokens array. */
2817 int *cmdStruct; /* commands structure */
2818 int csLen; /* length of the cmdStruct array. */
2819 int substFlags; /* flags used for the compilation of "subst" objects */
2820 int inUse; /* Used to share a ScriptObj. Currently
2821 only used by Jim_EvalObj() as protection against
2822 shimmering of the currently evaluated object. */
2823 char *fileName;
2824 } ScriptObj;
2825
2826 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2827 {
2828 int i;
2829 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2830
2831 if (!script)
2832 return;
2833
2834 script->inUse--;
2835 if (script->inUse != 0) return;
2836 for (i = 0; i < script->len; i++) {
2837 if (script->token[i].objPtr != NULL)
2838 Jim_DecrRefCount(interp, script->token[i].objPtr);
2839 }
2840 Jim_Free(script->token);
2841 Jim_Free(script->cmdStruct);
2842 Jim_Free(script->fileName);
2843 Jim_Free(script);
2844 }
2845
2846 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2847 {
2848 JIM_NOTUSED(interp);
2849 JIM_NOTUSED(srcPtr);
2850
2851 /* Just returns an simple string. */
2852 dupPtr->typePtr = NULL;
2853 }
2854
2855 /* Add a new token to the internal repr of a script object */
2856 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2857 char *strtoken, int len, int type, char *filename, int linenr)
2858 {
2859 int prevtype;
2860 struct ScriptToken *token;
2861
2862 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2863 script->token[script->len-1].type;
2864 /* Skip tokens without meaning, like words separators
2865 * following a word separator or an end of command and
2866 * so on. */
2867 if (prevtype == JIM_TT_EOL) {
2868 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2869 Jim_Free(strtoken);
2870 return;
2871 }
2872 } else if (prevtype == JIM_TT_SEP) {
2873 if (type == JIM_TT_SEP) {
2874 Jim_Free(strtoken);
2875 return;
2876 } else if (type == JIM_TT_EOL) {
2877 /* If an EOL is following by a SEP, drop the previous
2878 * separator. */
2879 script->len--;
2880 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2881 }
2882 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2883 type == JIM_TT_ESC && len == 0)
2884 {
2885 /* Don't add empty tokens used in interpolation */
2886 Jim_Free(strtoken);
2887 return;
2888 }
2889 /* Make space for a new istruction */
2890 script->len++;
2891 script->token = Jim_Realloc(script->token,
2892 sizeof(ScriptToken)*script->len);
2893 /* Initialize the new token */
2894 token = script->token + (script->len-1);
2895 token->type = type;
2896 /* Every object is intially as a string, but the
2897 * internal type may be specialized during execution of the
2898 * script. */
2899 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2900 /* To add source info to SEP and EOL tokens is useless because
2901 * they will never by called as arguments of Jim_EvalObj(). */
2902 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2903 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2904 Jim_IncrRefCount(token->objPtr);
2905 token->linenr = linenr;
2906 }
2907
2908 /* Add an integer into the command structure field of the script object. */
2909 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2910 {
2911 script->csLen++;
2912 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2913 sizeof(int)*script->csLen);
2914 script->cmdStruct[script->csLen-1] = val;
2915 }
2916
2917 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2918 * of objPtr. Search nested script objects recursively. */
2919 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2920 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2921 {
2922 int i;
2923
2924 for (i = 0; i < script->len; i++) {
2925 if (script->token[i].objPtr != objPtr &&
2926 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2927 return script->token[i].objPtr;
2928 }
2929 /* Enter recursively on scripts only if the object
2930 * is not the same as the one we are searching for
2931 * shared occurrences. */
2932 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2933 script->token[i].objPtr != objPtr) {
2934 Jim_Obj *foundObjPtr;
2935
2936 ScriptObj *subScript =
2937 script->token[i].objPtr->internalRep.ptr;
2938 /* Don't recursively enter the script we are trying
2939 * to make shared to avoid circular references. */
2940 if (subScript == scriptBarrier) continue;
2941 if (subScript != script) {
2942 foundObjPtr =
2943 ScriptSearchLiteral(interp, subScript,
2944 scriptBarrier, objPtr);
2945 if (foundObjPtr != NULL)
2946 return foundObjPtr;
2947 }
2948 }
2949 }
2950 return NULL;
2951 }
2952
2953 /* Share literals of a script recursively sharing sub-scripts literals. */
2954 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2955 ScriptObj *topLevelScript)
2956 {
2957 int i, j;
2958
2959 return;
2960 /* Try to share with toplevel object. */
2961 if (topLevelScript != NULL) {
2962 for (i = 0; i < script->len; i++) {
2963 Jim_Obj *foundObjPtr;
2964 char *str = script->token[i].objPtr->bytes;
2965
2966 if (script->token[i].objPtr->refCount != 1) continue;
2967 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2968 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2969 foundObjPtr = ScriptSearchLiteral(interp,
2970 topLevelScript,
2971 script, /* barrier */
2972 script->token[i].objPtr);
2973 if (foundObjPtr != NULL) {
2974 Jim_IncrRefCount(foundObjPtr);
2975 Jim_DecrRefCount(interp,
2976 script->token[i].objPtr);
2977 script->token[i].objPtr = foundObjPtr;
2978 }
2979 }
2980 }
2981 /* Try to share locally */
2982 for (i = 0; i < script->len; i++) {
2983 char *str = script->token[i].objPtr->bytes;
2984
2985 if (script->token[i].objPtr->refCount != 1) continue;
2986 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2987 for (j = 0; j < script->len; j++) {
2988 if (script->token[i].objPtr !=
2989 script->token[j].objPtr &&
2990 Jim_StringEqObj(script->token[i].objPtr,
2991 script->token[j].objPtr, 0))
2992 {
2993 Jim_IncrRefCount(script->token[j].objPtr);
2994 Jim_DecrRefCount(interp,
2995 script->token[i].objPtr);
2996 script->token[i].objPtr =
2997 script->token[j].objPtr;
2998 }
2999 }
3000 }
3001 }
3002
3003 /* This method takes the string representation of an object
3004 * as a Tcl script, and generates the pre-parsed internal representation
3005 * of the script. */
3006 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3007 {
3008 int scriptTextLen;
3009 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3010 struct JimParserCtx parser;
3011 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3012 ScriptToken *token;
3013 int args, tokens, start, end, i;
3014 int initialLineNumber;
3015 int propagateSourceInfo = 0;
3016
3017 script->len = 0;
3018 script->csLen = 0;
3019 script->commands = 0;
3020 script->token = NULL;
3021 script->cmdStruct = NULL;
3022 script->inUse = 1;
3023 /* Try to get information about filename / line number */
3024 if (objPtr->typePtr == &sourceObjType) {
3025 script->fileName =
3026 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3027 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3028 propagateSourceInfo = 1;
3029 } else {
3030 script->fileName = Jim_StrDup("");
3031 initialLineNumber = 1;
3032 }
3033
3034 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3035 while (!JimParserEof(&parser)) {
3036 char *token;
3037 int len, type, linenr;
3038
3039 JimParseScript(&parser);
3040 token = JimParserGetToken(&parser, &len, &type, &linenr);
3041 ScriptObjAddToken(interp, script, token, len, type,
3042 propagateSourceInfo ? script->fileName : NULL,
3043 linenr);
3044 }
3045 token = script->token;
3046
3047 /* Compute the command structure array
3048 * (see the ScriptObj struct definition for more info) */
3049 start = 0; /* Current command start token index */
3050 end = -1; /* Current command end token index */
3051 while (1) {
3052 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3053 int interpolation = 0; /* set to 1 if there is at least one
3054 argument of the command obtained via
3055 interpolation of more tokens. */
3056 /* Search for the end of command, while
3057 * count the number of args. */
3058 start = ++end;
3059 if (start >= script->len) break;
3060 args = 1; /* Number of args in current command */
3061 while (token[end].type != JIM_TT_EOL) {
3062 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3063 token[end-1].type == JIM_TT_EOL)
3064 {
3065 if (token[end].type == JIM_TT_STR &&
3066 token[end + 1].type != JIM_TT_SEP &&
3067 token[end + 1].type != JIM_TT_EOL &&
3068 (!strcmp(token[end].objPtr->bytes, "expand") ||
3069 !strcmp(token[end].objPtr->bytes, "*")))
3070 expand++;
3071 }
3072 if (token[end].type == JIM_TT_SEP)
3073 args++;
3074 end++;
3075 }
3076 interpolation = !((end-start + 1) == args*2);
3077 /* Add the 'number of arguments' info into cmdstruct.
3078 * Negative value if there is list expansion involved. */
3079 if (expand)
3080 ScriptObjAddInt(script, -1);
3081 ScriptObjAddInt(script, args);
3082 /* Now add info about the number of tokens. */
3083 tokens = 0; /* Number of tokens in current argument. */
3084 expand = 0;
3085 for (i = start; i <= end; i++) {
3086 if (token[i].type == JIM_TT_SEP ||
3087 token[i].type == JIM_TT_EOL)
3088 {
3089 if (tokens == 1 && expand)
3090 expand = 0;
3091 ScriptObjAddInt(script,
3092 expand ? -tokens : tokens);
3093
3094 expand = 0;
3095 tokens = 0;
3096 continue;
3097 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3098 (!strcmp(token[i].objPtr->bytes, "expand") ||
3099 !strcmp(token[i].objPtr->bytes, "*")))
3100 {
3101 expand++;
3102 }
3103 tokens++;
3104 }
3105 }
3106 /* Perform literal sharing, but only for objects that appear
3107 * to be scripts written as literals inside the source code,
3108 * and not computed at runtime. Literal sharing is a costly
3109 * operation that should be done only against objects that
3110 * are likely to require compilation only the first time, and
3111 * then are executed multiple times. */
3112 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3113 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3114 if (bodyObjPtr->typePtr == &scriptObjType) {
3115 ScriptObj *bodyScript =
3116 bodyObjPtr->internalRep.ptr;
3117 ScriptShareLiterals(interp, script, bodyScript);
3118 }
3119 } else if (propagateSourceInfo) {
3120 ScriptShareLiterals(interp, script, NULL);
3121 }
3122 /* Free the old internal rep and set the new one. */
3123 Jim_FreeIntRep(interp, objPtr);
3124 Jim_SetIntRepPtr(objPtr, script);
3125 objPtr->typePtr = &scriptObjType;
3126 return JIM_OK;
3127 }
3128
3129 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3130 {
3131 if (objPtr->typePtr != &scriptObjType) {
3132 SetScriptFromAny(interp, objPtr);
3133 }
3134 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3135 }
3136
3137 /* -----------------------------------------------------------------------------
3138 * Commands
3139 * ---------------------------------------------------------------------------*/
3140
3141 /* Commands HashTable Type.
3142 *
3143 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3144 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3145 {
3146 Jim_Cmd *cmdPtr = (void*) val;
3147
3148 if (cmdPtr->cmdProc == NULL) {
3149 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3150 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3151 if (cmdPtr->staticVars) {
3152 Jim_FreeHashTable(cmdPtr->staticVars);
3153 Jim_Free(cmdPtr->staticVars);
3154 }
3155 } else if (cmdPtr->delProc != NULL) {
3156 /* If it was a C coded command, call the delProc if any */
3157 cmdPtr->delProc(interp, cmdPtr->privData);
3158 }
3159 Jim_Free(val);
3160 }
3161
3162 static Jim_HashTableType JimCommandsHashTableType = {
3163 JimStringCopyHTHashFunction, /* hash function */
3164 JimStringCopyHTKeyDup, /* key dup */
3165 NULL, /* val dup */
3166 JimStringCopyHTKeyCompare, /* key compare */
3167 JimStringCopyHTKeyDestructor, /* key destructor */
3168 Jim_CommandsHT_ValDestructor /* val destructor */
3169 };
3170
3171 /* ------------------------- Commands related functions --------------------- */
3172
3173 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3174 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3175 {
3176 Jim_HashEntry *he;
3177 Jim_Cmd *cmdPtr;
3178
3179 he = Jim_FindHashEntry(&interp->commands, cmdName);
3180 if (he == NULL) { /* New command to create */
3181 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3182 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3183 } else {
3184 Jim_InterpIncrProcEpoch(interp);
3185 /* Free the arglist/body objects if it was a Tcl procedure */
3186 cmdPtr = he->val;
3187 if (cmdPtr->cmdProc == NULL) {
3188 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3189 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3190 if (cmdPtr->staticVars) {
3191 Jim_FreeHashTable(cmdPtr->staticVars);
3192 Jim_Free(cmdPtr->staticVars);
3193 }
3194 cmdPtr->staticVars = NULL;
3195 } else if (cmdPtr->delProc != NULL) {
3196 /* If it was a C coded command, call the delProc if any */
3197 cmdPtr->delProc(interp, cmdPtr->privData);
3198 }
3199 }
3200
3201 /* Store the new details for this proc */
3202 cmdPtr->delProc = delProc;
3203 cmdPtr->cmdProc = cmdProc;
3204 cmdPtr->privData = privData;
3205
3206 /* There is no need to increment the 'proc epoch' because
3207 * creation of a new procedure can never affect existing
3208 * cached commands. We don't do negative caching. */
3209 return JIM_OK;
3210 }
3211
3212 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3213 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3214 int arityMin, int arityMax)
3215 {
3216 Jim_Cmd *cmdPtr;
3217
3218 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3219 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3220 cmdPtr->argListObjPtr = argListObjPtr;
3221 cmdPtr->bodyObjPtr = bodyObjPtr;
3222 Jim_IncrRefCount(argListObjPtr);
3223 Jim_IncrRefCount(bodyObjPtr);
3224 cmdPtr->arityMin = arityMin;
3225 cmdPtr->arityMax = arityMax;
3226 cmdPtr->staticVars = NULL;
3227
3228 /* Create the statics hash table. */
3229 if (staticsListObjPtr) {
3230 int len, i;
3231
3232 Jim_ListLength(interp, staticsListObjPtr, &len);
3233 if (len != 0) {
3234 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3235 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3236 interp);
3237 for (i = 0; i < len; i++) {
3238 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3239 Jim_Var *varPtr;
3240 int subLen;
3241
3242 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3243 /* Check if it's composed of two elements. */
3244 Jim_ListLength(interp, objPtr, &subLen);
3245 if (subLen == 1 || subLen == 2) {
3246 /* Try to get the variable value from the current
3247 * environment. */
3248 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3249 if (subLen == 1) {
3250 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3251 JIM_NONE);
3252 if (initObjPtr == NULL) {
3253 Jim_SetResult(interp,
3254 Jim_NewEmptyStringObj(interp));
3255 Jim_AppendStrings(interp, Jim_GetResult(interp),
3256 "variable for initialization of static \"",
3257 Jim_GetString(nameObjPtr, NULL),
3258 "\" not found in the local context",
3259 NULL);
3260 goto err;
3261 }
3262 } else {
3263 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3264 }
3265 varPtr = Jim_Alloc(sizeof(*varPtr));
3266 varPtr->objPtr = initObjPtr;
3267 Jim_IncrRefCount(initObjPtr);
3268 varPtr->linkFramePtr = NULL;
3269 if (Jim_AddHashEntry(cmdPtr->staticVars,
3270 Jim_GetString(nameObjPtr, NULL),
3271 varPtr) != JIM_OK)
3272 {
3273 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274 Jim_AppendStrings(interp, Jim_GetResult(interp),
3275 "static variable name \"",
3276 Jim_GetString(objPtr, NULL), "\"",
3277 " duplicated in statics list", NULL);
3278 Jim_DecrRefCount(interp, initObjPtr);
3279 Jim_Free(varPtr);
3280 goto err;
3281 }
3282 } else {
3283 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3284 Jim_AppendStrings(interp, Jim_GetResult(interp),
3285 "too many fields in static specifier \"",
3286 objPtr, "\"", NULL);
3287 goto err;
3288 }
3289 }
3290 }
3291 }
3292
3293 /* Add the new command */
3294
3295 /* it may already exist, so we try to delete the old one */
3296 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3297 /* There was an old procedure with the same name, this requires
3298 * a 'proc epoch' update. */
3299 Jim_InterpIncrProcEpoch(interp);
3300 }
3301 /* If a procedure with the same name didn't existed there is no need
3302 * to increment the 'proc epoch' because creation of a new procedure
3303 * can never affect existing cached commands. We don't do
3304 * negative caching. */
3305 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3306 return JIM_OK;
3307
3308 err:
3309 Jim_FreeHashTable(cmdPtr->staticVars);
3310 Jim_Free(cmdPtr->staticVars);
3311 Jim_DecrRefCount(interp, argListObjPtr);
3312 Jim_DecrRefCount(interp, bodyObjPtr);
3313 Jim_Free(cmdPtr);
3314 return JIM_ERR;
3315 }
3316
3317 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3318 {
3319 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3320 return JIM_ERR;
3321 Jim_InterpIncrProcEpoch(interp);
3322 return JIM_OK;
3323 }
3324
3325 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3326 const char *newName)
3327 {
3328 Jim_Cmd *cmdPtr;
3329 Jim_HashEntry *he;
3330 Jim_Cmd *copyCmdPtr;
3331
3332 if (newName[0] == '\0') /* Delete! */
3333 return Jim_DeleteCommand(interp, oldName);
3334 /* Rename */
3335 he = Jim_FindHashEntry(&interp->commands, oldName);
3336 if (he == NULL)
3337 return JIM_ERR; /* Invalid command name */
3338 cmdPtr = he->val;
3339 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3340 *copyCmdPtr = *cmdPtr;
3341 /* In order to avoid that a procedure will get arglist/body/statics
3342 * freed by the hash table methods, fake a C-coded command
3343 * setting cmdPtr->cmdProc as not NULL */
3344 cmdPtr->cmdProc = (void*)1;
3345 /* Also make sure delProc is NULL. */
3346 cmdPtr->delProc = NULL;
3347 /* Destroy the old command, and make sure the new is freed
3348 * as well. */
3349 Jim_DeleteHashEntry(&interp->commands, oldName);
3350 Jim_DeleteHashEntry(&interp->commands, newName);
3351 /* Now the new command. We are sure it can't fail because
3352 * the target name was already freed. */
3353 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3354 /* Increment the epoch */
3355 Jim_InterpIncrProcEpoch(interp);
3356 return JIM_OK;
3357 }
3358
3359 /* -----------------------------------------------------------------------------
3360 * Command object
3361 * ---------------------------------------------------------------------------*/
3362
3363 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3364
3365 static Jim_ObjType commandObjType = {
3366 "command",
3367 NULL,
3368 NULL,
3369 NULL,
3370 JIM_TYPE_REFERENCES,
3371 };
3372
3373 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3374 {
3375 Jim_HashEntry *he;
3376 const char *cmdName;
3377
3378 /* Get the string representation */
3379 cmdName = Jim_GetString(objPtr, NULL);
3380 /* Lookup this name into the commands hash table */
3381 he = Jim_FindHashEntry(&interp->commands, cmdName);
3382 if (he == NULL)
3383 return JIM_ERR;
3384
3385 /* Free the old internal repr and set the new one. */
3386 Jim_FreeIntRep(interp, objPtr);
3387 objPtr->typePtr = &commandObjType;
3388 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3389 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3390 return JIM_OK;
3391 }
3392
3393 /* This function returns the command structure for the command name
3394 * stored in objPtr. It tries to specialize the objPtr to contain
3395 * a cached info instead to perform the lookup into the hash table
3396 * every time. The information cached may not be uptodate, in such
3397 * a case the lookup is performed and the cache updated. */
3398 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3399 {
3400 if ((objPtr->typePtr != &commandObjType ||
3401 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3402 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3403 if (flags & JIM_ERRMSG) {
3404 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3405 Jim_AppendStrings(interp, Jim_GetResult(interp),
3406 "invalid command name \"", objPtr->bytes, "\"",
3407 NULL);
3408 }
3409 return NULL;
3410 }
3411 return objPtr->internalRep.cmdValue.cmdPtr;
3412 }
3413
3414 /* -----------------------------------------------------------------------------
3415 * Variables
3416 * ---------------------------------------------------------------------------*/
3417
3418 /* Variables HashTable Type.
3419 *
3420 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3421 static void JimVariablesHTValDestructor(void *interp, void *val)
3422 {
3423 Jim_Var *varPtr = (void*) val;
3424
3425 Jim_DecrRefCount(interp, varPtr->objPtr);
3426 Jim_Free(val);
3427 }
3428
3429 static Jim_HashTableType JimVariablesHashTableType = {
3430 JimStringCopyHTHashFunction, /* hash function */
3431 JimStringCopyHTKeyDup, /* key dup */
3432 NULL, /* val dup */
3433 JimStringCopyHTKeyCompare, /* key compare */
3434 JimStringCopyHTKeyDestructor, /* key destructor */
3435 JimVariablesHTValDestructor /* val destructor */
3436 };
3437
3438 static Jim_HashTableType *getJimVariablesHashTableType(void)
3439 {
3440 return &JimVariablesHashTableType;
3441 }
3442
3443 /* -----------------------------------------------------------------------------
3444 * Variable object
3445 * ---------------------------------------------------------------------------*/
3446
3447 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3448
3449 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3450
3451 static Jim_ObjType variableObjType = {
3452 "variable",
3453 NULL,
3454 NULL,
3455 NULL,
3456 JIM_TYPE_REFERENCES,
3457 };
3458
3459 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3460 * is in the form "varname(key)". */
3461 static int Jim_NameIsDictSugar(const char *str, int len)
3462 {
3463 if (len == -1)
3464 len = strlen(str);
3465 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3466 return 1;
3467 return 0;
3468 }
3469
3470 /* This method should be called only by the variable API.
3471 * It returns JIM_OK on success (variable already exists),
3472 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3473 * a variable name, but syntax glue for [dict] i.e. the last
3474 * character is ')' */
3475 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3476 {
3477 Jim_HashEntry *he;
3478 const char *varName;
3479 int len;
3480
3481 /* Check if the object is already an uptodate variable */
3482 if (objPtr->typePtr == &variableObjType &&
3483 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3484 return JIM_OK; /* nothing to do */
3485 /* Get the string representation */
3486 varName = Jim_GetString(objPtr, &len);
3487 /* Make sure it's not syntax glue to get/set dict. */
3488 if (Jim_NameIsDictSugar(varName, len))
3489 return JIM_DICT_SUGAR;
3490 if (varName[0] == ':' && varName[1] == ':') {
3491 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3492 if (he == NULL) {
3493 return JIM_ERR;
3494 }
3495 }
3496 else {
3497 /* Lookup this name into the variables hash table */
3498 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3499 if (he == NULL) {
3500 /* Try with static vars. */
3501 if (interp->framePtr->staticVars == NULL)
3502 return JIM_ERR;
3503 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3504 return JIM_ERR;
3505 }
3506 }
3507 /* Free the old internal repr and set the new one. */
3508 Jim_FreeIntRep(interp, objPtr);
3509 objPtr->typePtr = &variableObjType;
3510 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3511 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3512 return JIM_OK;
3513 }
3514
3515 /* -------------------- Variables related functions ------------------------- */
3516 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3517 Jim_Obj *valObjPtr);
3518 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3519
3520 /* For now that's dummy. Variables lookup should be optimized
3521 * in many ways, with caching of lookups, and possibly with
3522 * a table of pre-allocated vars in every CallFrame for local vars.
3523 * All the caching should also have an 'epoch' mechanism similar
3524 * to the one used by Tcl for procedures lookup caching. */
3525
3526 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3527 {
3528 const char *name;
3529 Jim_Var *var;
3530 int err;
3531
3532 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3533 /* Check for [dict] syntax sugar. */
3534 if (err == JIM_DICT_SUGAR)
3535 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3536 /* New variable to create */
3537 name = Jim_GetString(nameObjPtr, NULL);
3538
3539 var = Jim_Alloc(sizeof(*var));
3540 var->objPtr = valObjPtr;
3541 Jim_IncrRefCount(valObjPtr);
3542 var->linkFramePtr = NULL;
3543 /* Insert the new variable */
3544 if (name[0] == ':' && name[1] == ':') {
3545 /* Into to the top evel frame */
3546 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3547 }
3548 else {
3549 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3550 }
3551 /* Make the object int rep a variable */
3552 Jim_FreeIntRep(interp, nameObjPtr);
3553 nameObjPtr->typePtr = &variableObjType;
3554 nameObjPtr->internalRep.varValue.callFrameId =
3555 interp->framePtr->id;
3556 nameObjPtr->internalRep.varValue.varPtr = var;
3557 } else {
3558 var = nameObjPtr->internalRep.varValue.varPtr;
3559 if (var->linkFramePtr == NULL) {
3560 Jim_IncrRefCount(valObjPtr);
3561 Jim_DecrRefCount(interp, var->objPtr);
3562 var->objPtr = valObjPtr;
3563 } else { /* Else handle the link */
3564 Jim_CallFrame *savedCallFrame;
3565
3566 savedCallFrame = interp->framePtr;
3567 interp->framePtr = var->linkFramePtr;
3568 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3569 interp->framePtr = savedCallFrame;
3570 if (err != JIM_OK)
3571 return err;
3572 }
3573 }
3574 return JIM_OK;
3575 }
3576
3577 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3578 {
3579 Jim_Obj *nameObjPtr;
3580 int result;
3581
3582 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3583 Jim_IncrRefCount(nameObjPtr);
3584 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3585 Jim_DecrRefCount(interp, nameObjPtr);
3586 return result;
3587 }
3588
3589 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3590 {
3591 Jim_CallFrame *savedFramePtr;
3592 int result;
3593
3594 savedFramePtr = interp->framePtr;
3595 interp->framePtr = interp->topFramePtr;
3596 result = Jim_SetVariableStr(interp, name, objPtr);
3597 interp->framePtr = savedFramePtr;
3598 return result;
3599 }
3600
3601 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3602 {
3603 Jim_Obj *nameObjPtr, *valObjPtr;
3604 int result;
3605
3606 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3607 valObjPtr = Jim_NewStringObj(interp, val, -1);
3608 Jim_IncrRefCount(nameObjPtr);
3609 Jim_IncrRefCount(valObjPtr);
3610 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3611 Jim_DecrRefCount(interp, nameObjPtr);
3612 Jim_DecrRefCount(interp, valObjPtr);
3613 return result;
3614 }
3615
3616 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3617 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3618 {
3619 const char *varName;
3620 int len;
3621
3622 /* Check for cycles. */
3623 if (interp->framePtr == targetCallFrame) {
3624 Jim_Obj *objPtr = targetNameObjPtr;
3625 Jim_Var *varPtr;
3626 /* Cycles are only possible with 'uplevel 0' */
3627 while (1) {
3628 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3629 Jim_SetResultString(interp,
3630 "can't upvar from variable to itself", -1);
3631 return JIM_ERR;
3632 }
3633 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3634 break;
3635 varPtr = objPtr->internalRep.varValue.varPtr;
3636 if (varPtr->linkFramePtr != targetCallFrame) break;
3637 objPtr = varPtr->objPtr;
3638 }
3639 }
3640 varName = Jim_GetString(nameObjPtr, &len);
3641 if (Jim_NameIsDictSugar(varName, len)) {
3642 Jim_SetResultString(interp,
3643 "Dict key syntax invalid as link source", -1);
3644 return JIM_ERR;
3645 }
3646 /* Perform the binding */
3647 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3648 /* We are now sure 'nameObjPtr' type is variableObjType */
3649 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3650 return JIM_OK;
3651 }
3652
3653 /* Return the Jim_Obj pointer associated with a variable name,
3654 * or NULL if the variable was not found in the current context.
3655 * The same optimization discussed in the comment to the
3656 * 'SetVariable' function should apply here. */
3657 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3658 {
3659 int err;
3660
3661 /* All the rest is handled here */
3662 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3663 /* Check for [dict] syntax sugar. */
3664 if (err == JIM_DICT_SUGAR)
3665 return JimDictSugarGet(interp, nameObjPtr);
3666 if (flags & JIM_ERRMSG) {
3667 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3668 Jim_AppendStrings(interp, Jim_GetResult(interp),
3669 "can't read \"", nameObjPtr->bytes,
3670 "\": no such variable", NULL);
3671 }
3672 return NULL;
3673 } else {
3674 Jim_Var *varPtr;
3675 Jim_Obj *objPtr;
3676 Jim_CallFrame *savedCallFrame;
3677
3678 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3679 if (varPtr->linkFramePtr == NULL)
3680 return varPtr->objPtr;
3681 /* The variable is a link? Resolve it. */
3682 savedCallFrame = interp->framePtr;
3683 interp->framePtr = varPtr->linkFramePtr;
3684 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3685 if (objPtr == NULL && flags & JIM_ERRMSG) {
3686 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3687 Jim_AppendStrings(interp, Jim_GetResult(interp),
3688 "can't read \"", nameObjPtr->bytes,
3689 "\": no such variable", NULL);
3690 }
3691 interp->framePtr = savedCallFrame;
3692 return objPtr;
3693 }
3694 }
3695
3696 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3697 int flags)
3698 {
3699 Jim_CallFrame *savedFramePtr;
3700 Jim_Obj *objPtr;
3701
3702 savedFramePtr = interp->framePtr;
3703 interp->framePtr = interp->topFramePtr;
3704 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3705 interp->framePtr = savedFramePtr;
3706
3707 return objPtr;
3708 }
3709
3710 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3711 {
3712 Jim_Obj *nameObjPtr, *varObjPtr;
3713
3714 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3715 Jim_IncrRefCount(nameObjPtr);
3716 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3717 Jim_DecrRefCount(interp, nameObjPtr);
3718 return varObjPtr;
3719 }
3720
3721 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3722 int flags)
3723 {
3724 Jim_CallFrame *savedFramePtr;
3725 Jim_Obj *objPtr;
3726
3727 savedFramePtr = interp->framePtr;
3728 interp->framePtr = interp->topFramePtr;
3729 objPtr = Jim_GetVariableStr(interp, name, flags);
3730 interp->framePtr = savedFramePtr;
3731
3732 return objPtr;
3733 }
3734
3735 /* Unset a variable.
3736 * Note: On success unset invalidates all the variable objects created
3737 * in the current call frame incrementing. */
3738 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3739 {
3740 const char *name;
3741 Jim_Var *varPtr;
3742 int err;
3743
3744 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3745 /* Check for [dict] syntax sugar. */
3746 if (err == JIM_DICT_SUGAR)
3747 return JimDictSugarSet(interp, nameObjPtr, NULL);
3748 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3749 Jim_AppendStrings(interp, Jim_GetResult(interp),
3750 "can't unset \"", nameObjPtr->bytes,
3751 "\": no such variable", NULL);
3752 return JIM_ERR; /* var not found */
3753 }
3754 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3755 /* If it's a link call UnsetVariable recursively */
3756 if (varPtr->linkFramePtr) {
3757 int retval;
3758
3759 Jim_CallFrame *savedCallFrame;
3760
3761 savedCallFrame = interp->framePtr;
3762 interp->framePtr = varPtr->linkFramePtr;
3763 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3764 interp->framePtr = savedCallFrame;
3765 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3766 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3767 Jim_AppendStrings(interp, Jim_GetResult(interp),
3768 "can't unset \"", nameObjPtr->bytes,
3769 "\": no such variable", NULL);
3770 }
3771 return retval;
3772 } else {
3773 name = Jim_GetString(nameObjPtr, NULL);
3774 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3775 != JIM_OK) return JIM_ERR;
3776 /* Change the callframe id, invalidating var lookup caching */
3777 JimChangeCallFrameId(interp, interp->framePtr);
3778 return JIM_OK;
3779 }
3780 }
3781
3782 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3783
3784 /* Given a variable name for [dict] operation syntax sugar,
3785 * this function returns two objects, the first with the name
3786 * of the variable to set, and the second with the rispective key.
3787 * For example "foo(bar)" will return objects with string repr. of
3788 * "foo" and "bar".
3789 *
3790 * The returned objects have refcount = 1. The function can't fail. */
3791 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3792 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3793 {
3794 const char *str, *p;
3795 char *t;
3796 int len, keyLen, nameLen;
3797 Jim_Obj *varObjPtr, *keyObjPtr;
3798
3799 str = Jim_GetString(objPtr, &len);
3800 p = strchr(str, '(');
3801 p++;
3802 keyLen = len-((p-str) + 1);
3803 nameLen = (p-str)-1;
3804 /* Create the objects with the variable name and key. */
3805 t = Jim_Alloc(nameLen + 1);
3806 memcpy(t, str, nameLen);
3807 t[nameLen] = '\0';
3808 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3809
3810 t = Jim_Alloc(keyLen + 1);
3811 memcpy(t, p, keyLen);
3812 t[keyLen] = '\0';
3813 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3814
3815 Jim_IncrRefCount(varObjPtr);
3816 Jim_IncrRefCount(keyObjPtr);
3817 *varPtrPtr = varObjPtr;
3818 *keyPtrPtr = keyObjPtr;
3819 }
3820
3821 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3822 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3823 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3824 Jim_Obj *valObjPtr)
3825 {
3826 Jim_Obj *varObjPtr, *keyObjPtr;
3827 int err = JIM_OK;
3828
3829 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3830 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3831 valObjPtr);
3832 Jim_DecrRefCount(interp, varObjPtr);
3833 Jim_DecrRefCount(interp, keyObjPtr);
3834 return err;
3835 }
3836
3837 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3838 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3839 {
3840 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3841
3842 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3843 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3844 if (!dictObjPtr) {
3845 resObjPtr = NULL;
3846 goto err;
3847 }
3848 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3849 != JIM_OK) {
3850 resObjPtr = NULL;
3851 }
3852 err:
3853 Jim_DecrRefCount(interp, varObjPtr);
3854 Jim_DecrRefCount(interp, keyObjPtr);
3855 return resObjPtr;
3856 }
3857
3858 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3859
3860 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3861 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3862 Jim_Obj *dupPtr);
3863
3864 static Jim_ObjType dictSubstObjType = {
3865 "dict-substitution",
3866 FreeDictSubstInternalRep,
3867 DupDictSubstInternalRep,
3868 NULL,
3869 JIM_TYPE_NONE,
3870 };
3871
3872 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3873 {
3874 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3875 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3876 }
3877
3878 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3879 Jim_Obj *dupPtr)
3880 {
3881 JIM_NOTUSED(interp);
3882
3883 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3884 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3885 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3886 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3887 dupPtr->typePtr = &dictSubstObjType;
3888 }
3889
3890 /* This function is used to expand [dict get] sugar in the form
3891 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3892 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3893 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3894 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3895 * the [dict]ionary contained in variable VARNAME. */
3896 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3897 {
3898 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3899 Jim_Obj *substKeyObjPtr = NULL;
3900
3901 if (objPtr->typePtr != &dictSubstObjType) {
3902 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3903 Jim_FreeIntRep(interp, objPtr);
3904 objPtr->typePtr = &dictSubstObjType;
3905 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3906 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3907 }
3908 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3909 &substKeyObjPtr, JIM_NONE)
3910 != JIM_OK) {
3911 substKeyObjPtr = NULL;
3912 goto err;
3913 }
3914 Jim_IncrRefCount(substKeyObjPtr);
3915 dictObjPtr = Jim_GetVariable(interp,
3916 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3917 if (!dictObjPtr) {
3918 resObjPtr = NULL;
3919 goto err;
3920 }
3921 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3922 != JIM_OK) {
3923 resObjPtr = NULL;
3924 goto err;
3925 }
3926 err:
3927 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3928 return resObjPtr;
3929 }
3930
3931 /* -----------------------------------------------------------------------------
3932 * CallFrame
3933 * ---------------------------------------------------------------------------*/
3934
3935 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3936 {
3937 Jim_CallFrame *cf;
3938 if (interp->freeFramesList) {
3939 cf = interp->freeFramesList;
3940 interp->freeFramesList = cf->nextFramePtr;
3941 } else {
3942 cf = Jim_Alloc(sizeof(*cf));
3943 cf->vars.table = NULL;
3944 }
3945
3946 cf->id = interp->callFrameEpoch++;
3947 cf->parentCallFrame = NULL;
3948 cf->argv = NULL;
3949 cf->argc = 0;
3950 cf->procArgsObjPtr = NULL;
3951 cf->procBodyObjPtr = NULL;
3952 cf->nextFramePtr = NULL;
3953 cf->staticVars = NULL;
3954 if (cf->vars.table == NULL)
3955 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3956 return cf;
3957 }
3958
3959 /* Used to invalidate every caching related to callframe stability. */
3960 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3961 {
3962 cf->id = interp->callFrameEpoch++;
3963 }
3964
3965 #define JIM_FCF_NONE 0 /* no flags */
3966 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3967 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3968 int flags)
3969 {
3970 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3971 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3972 if (!(flags & JIM_FCF_NOHT))
3973 Jim_FreeHashTable(&cf->vars);
3974 else {
3975 int i;
3976 Jim_HashEntry **table = cf->vars.table, *he;
3977
3978 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3979 he = table[i];
3980 while (he != NULL) {
3981 Jim_HashEntry *nextEntry = he->next;
3982 Jim_Var *varPtr = (void*) he->val;
3983
3984 Jim_DecrRefCount(interp, varPtr->objPtr);
3985 Jim_Free(he->val);
3986 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3987 Jim_Free(he);
3988 table[i] = NULL;
3989 he = nextEntry;
3990 }
3991 }
3992 cf->vars.used = 0;
3993 }
3994 cf->nextFramePtr = interp->freeFramesList;
3995 interp->freeFramesList = cf;
3996 }
3997
3998 /* -----------------------------------------------------------------------------
3999 * References
4000 * ---------------------------------------------------------------------------*/
4001
4002 /* References HashTable Type.
4003 *
4004 * Keys are jim_wide integers, dynamically allocated for now but in the
4005 * future it's worth to cache this 8 bytes objects. Values are poitners
4006 * to Jim_References. */
4007 static void JimReferencesHTValDestructor(void *interp, void *val)
4008 {
4009 Jim_Reference *refPtr = (void*) val;
4010
4011 Jim_DecrRefCount(interp, refPtr->objPtr);
4012 if (refPtr->finalizerCmdNamePtr != NULL) {
4013 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4014 }
4015 Jim_Free(val);
4016 }
4017
4018 unsigned int JimReferencesHTHashFunction(const void *key)
4019 {
4020 /* Only the least significant bits are used. */
4021 const jim_wide *widePtr = key;
4022 unsigned int intValue = (unsigned int) *widePtr;
4023 return Jim_IntHashFunction(intValue);
4024 }
4025
4026 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4027 {
4028 /* Only the least significant bits are used. */
4029 const jim_wide *widePtr = key;
4030 unsigned int intValue = (unsigned int) *widePtr;
4031 return intValue; /* identity function. */
4032 }
4033
4034 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4035 {
4036 void *copy = Jim_Alloc(sizeof(jim_wide));
4037 JIM_NOTUSED(privdata);
4038
4039 memcpy(copy, key, sizeof(jim_wide));
4040 return copy;
4041 }
4042
4043 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4044 const void *key2)
4045 {
4046 JIM_NOTUSED(privdata);
4047
4048 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4049 }
4050
4051 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4052 {
4053 JIM_NOTUSED(privdata);
4054
4055 Jim_Free((void*)key);
4056 }
4057
4058 static Jim_HashTableType JimReferencesHashTableType = {
4059 JimReferencesHTHashFunction, /* hash function */
4060 JimReferencesHTKeyDup, /* key dup */
4061 NULL, /* val dup */
4062 JimReferencesHTKeyCompare, /* key compare */
4063 JimReferencesHTKeyDestructor, /* key destructor */
4064 JimReferencesHTValDestructor /* val destructor */
4065 };
4066
4067 /* -----------------------------------------------------------------------------
4068 * Reference object type and References API
4069 * ---------------------------------------------------------------------------*/
4070
4071 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4072
4073 static Jim_ObjType referenceObjType = {
4074 "reference",
4075 NULL,
4076 NULL,
4077 UpdateStringOfReference,
4078 JIM_TYPE_REFERENCES,
4079 };
4080
4081 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4082 {
4083 int len;
4084 char buf[JIM_REFERENCE_SPACE + 1];
4085 Jim_Reference *refPtr;
4086
4087 refPtr = objPtr->internalRep.refValue.refPtr;
4088 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4089 objPtr->bytes = Jim_Alloc(len + 1);
4090 memcpy(objPtr->bytes, buf, len + 1);
4091 objPtr->length = len;
4092 }
4093
4094 /* returns true if 'c' is a valid reference tag character.
4095 * i.e. inside the range [_a-zA-Z0-9] */
4096 static int isrefchar(int c)
4097 {
4098 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4099 (c >= '0' && c <= '9')) return 1;
4100 return 0;
4101 }
4102
4103 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4104 {
4105 jim_wide wideValue;
4106 int i, len;
4107 const char *str, *start, *end;
4108 char refId[21];
4109 Jim_Reference *refPtr;
4110 Jim_HashEntry *he;
4111
4112 /* Get the string representation */
4113 str = Jim_GetString(objPtr, &len);
4114 /* Check if it looks like a reference */
4115 if (len < JIM_REFERENCE_SPACE) goto badformat;
4116 /* Trim spaces */
4117 start = str;
4118 end = str + len-1;
4119 while (*start == ' ') start++;
4120 while (*end == ' ' && end > start) end--;
4121 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4122 /* <reference.<1234567>.%020> */
4123 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4124 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4125 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4126 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4127 if (!isrefchar(start[12 + i])) goto badformat;
4128 }
4129 /* Extract info from the refernece. */
4130 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4131 refId[20] = '\0';
4132 /* Try to convert the ID into a jim_wide */
4133 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4134 /* Check if the reference really exists! */
4135 he = Jim_FindHashEntry(&interp->references, &wideValue);
4136 if (he == NULL) {
4137 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4138 Jim_AppendStrings(interp, Jim_GetResult(interp),
4139 "Invalid reference ID \"", str, "\"", NULL);
4140 return JIM_ERR;
4141 }
4142 refPtr = he->val;
4143 /* Free the old internal repr and set the new one. */
4144 Jim_FreeIntRep(interp, objPtr);
4145 objPtr->typePtr = &referenceObjType;
4146 objPtr->internalRep.refValue.id = wideValue;
4147 objPtr->internalRep.refValue.refPtr = refPtr;
4148 return JIM_OK;
4149
4150 badformat:
4151 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4152 Jim_AppendStrings(interp, Jim_GetResult(interp),
4153 "expected reference but got \"", str, "\"", NULL);
4154 return JIM_ERR;
4155 }
4156
4157 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4158 * as finalizer command (or NULL if there is no finalizer).
4159 * The returned reference object has refcount = 0. */
4160 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4161 Jim_Obj *cmdNamePtr)
4162 {
4163 struct Jim_Reference *refPtr;
4164 jim_wide wideValue = interp->referenceNextId;
4165 Jim_Obj *refObjPtr;
4166 const char *tag;
4167 int tagLen, i;
4168
4169 /* Perform the Garbage Collection if needed. */
4170 Jim_CollectIfNeeded(interp);
4171
4172 refPtr = Jim_Alloc(sizeof(*refPtr));
4173 refPtr->objPtr = objPtr;
4174 Jim_IncrRefCount(objPtr);
4175 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4176 if (cmdNamePtr)
4177 Jim_IncrRefCount(cmdNamePtr);
4178 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4179 refObjPtr = Jim_NewObj(interp);
4180 refObjPtr->typePtr = &referenceObjType;
4181 refObjPtr->bytes = NULL;
4182 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4183 refObjPtr->internalRep.refValue.refPtr = refPtr;
4184 interp->referenceNextId++;
4185 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4186 * that does not pass the 'isrefchar' test is replaced with '_' */
4187 tag = Jim_GetString(tagPtr, &tagLen);
4188 if (tagLen > JIM_REFERENCE_TAGLEN)
4189 tagLen = JIM_REFERENCE_TAGLEN;
4190 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4191 if (i < tagLen)
4192 refPtr->tag[i] = tag[i];
4193 else
4194 refPtr->tag[i] = '_';
4195 }
4196 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4197 return refObjPtr;
4198 }
4199
4200 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4201 {
4202 if (objPtr->typePtr != &referenceObjType &&
4203 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4204 return NULL;
4205 return objPtr->internalRep.refValue.refPtr;
4206 }
4207
4208 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4209 {
4210 Jim_Reference *refPtr;
4211
4212 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4213 return JIM_ERR;
4214 Jim_IncrRefCount(cmdNamePtr);
4215 if (refPtr->finalizerCmdNamePtr)
4216 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4217 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4218 return JIM_OK;
4219 }
4220
4221 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4222 {
4223 Jim_Reference *refPtr;
4224
4225 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4226 return JIM_ERR;
4227 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4228 return JIM_OK;
4229 }
4230
4231 /* -----------------------------------------------------------------------------
4232 * References Garbage Collection
4233 * ---------------------------------------------------------------------------*/
4234
4235 /* This the hash table type for the "MARK" phase of the GC */
4236 static Jim_HashTableType JimRefMarkHashTableType = {
4237 JimReferencesHTHashFunction, /* hash function */
4238 JimReferencesHTKeyDup, /* key dup */
4239 NULL, /* val dup */
4240 JimReferencesHTKeyCompare, /* key compare */
4241 JimReferencesHTKeyDestructor, /* key destructor */
4242 NULL /* val destructor */
4243 };
4244
4245 /* #define JIM_DEBUG_GC 1 */
4246
4247 /* Performs the garbage collection. */
4248 int Jim_Collect(Jim_Interp *interp)
4249 {
4250 Jim_HashTable marks;
4251 Jim_HashTableIterator *htiter;
4252 Jim_HashEntry *he;
4253 Jim_Obj *objPtr;
4254 int collected = 0;
4255
4256 /* Avoid recursive calls */
4257 if (interp->lastCollectId == -1) {
4258 /* Jim_Collect() already running. Return just now. */
4259 return 0;
4260 }
4261 interp->lastCollectId = -1;
4262
4263 /* Mark all the references found into the 'mark' hash table.
4264 * The references are searched in every live object that
4265 * is of a type that can contain references. */
4266 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4267 objPtr = interp->liveList;
4268 while (objPtr) {
4269 if (objPtr->typePtr == NULL ||
4270 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4271 const char *str, *p;
4272 int len;
4273
4274 /* If the object is of type reference, to get the
4275 * Id is simple... */
4276 if (objPtr->typePtr == &referenceObjType) {
4277 Jim_AddHashEntry(&marks,
4278 &objPtr->internalRep.refValue.id, NULL);
4279 #ifdef JIM_DEBUG_GC
4280 Jim_fprintf(interp,interp->cookie_stdout,
4281 "MARK (reference): %d refcount: %d" JIM_NL,
4282 (int) objPtr->internalRep.refValue.id,
4283 objPtr->refCount);
4284 #endif
4285 objPtr = objPtr->nextObjPtr;
4286 continue;
4287 }
4288 /* Get the string repr of the object we want
4289 * to scan for references. */
4290 p = str = Jim_GetString(objPtr, &len);
4291 /* Skip objects too little to contain references. */
4292 if (len < JIM_REFERENCE_SPACE) {
4293 objPtr = objPtr->nextObjPtr;
4294 continue;
4295 }
4296 /* Extract references from the object string repr. */
4297 while (1) {
4298 int i;
4299 jim_wide id;
4300 char buf[21];
4301
4302 if ((p = strstr(p, "<reference.<")) == NULL)
4303 break;
4304 /* Check if it's a valid reference. */
4305 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4306 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4307 for (i = 21; i <= 40; i++)
4308 if (!isdigit((int)p[i]))
4309 break;
4310 /* Get the ID */
4311 memcpy(buf, p + 21, 20);
4312 buf[20] = '\0';
4313 Jim_StringToWide(buf, &id, 10);
4314
4315 /* Ok, a reference for the given ID
4316 * was found. Mark it. */
4317 Jim_AddHashEntry(&marks, &id, NULL);
4318 #ifdef JIM_DEBUG_GC
4319 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4320 #endif
4321 p += JIM_REFERENCE_SPACE;
4322 }
4323 }
4324 objPtr = objPtr->nextObjPtr;
4325 }
4326
4327 /* Run the references hash table to destroy every reference that
4328 * is not referenced outside (not present in the mark HT). */
4329 htiter = Jim_GetHashTableIterator(&interp->references);
4330 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4331 const jim_wide *refId;
4332 Jim_Reference *refPtr;
4333
4334 refId = he->key;
4335 /* Check if in the mark phase we encountered
4336 * this reference. */
4337 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4338 #ifdef JIM_DEBUG_GC
4339 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4340 #endif
4341 collected++;
4342 /* Drop the reference, but call the
4343 * finalizer first if registered. */
4344 refPtr = he->val;
4345 if (refPtr->finalizerCmdNamePtr) {
4346 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4347 Jim_Obj *objv[3], *oldResult;
4348
4349 JimFormatReference(refstr, refPtr, *refId);
4350
4351 objv[0] = refPtr->finalizerCmdNamePtr;
4352 objv[1] = Jim_NewStringObjNoAlloc(interp,
4353 refstr, 32);
4354 objv[2] = refPtr->objPtr;
4355 Jim_IncrRefCount(objv[0]);
4356 Jim_IncrRefCount(objv[1]);
4357 Jim_IncrRefCount(objv[2]);
4358
4359 /* Drop the reference itself */
4360 Jim_DeleteHashEntry(&interp->references, refId);
4361
4362 /* Call the finalizer. Errors ignored. */
4363 oldResult = interp->result;
4364 Jim_IncrRefCount(oldResult);
4365 Jim_EvalObjVector(interp, 3, objv);
4366 Jim_SetResult(interp, oldResult);
4367 Jim_DecrRefCount(interp, oldResult);
4368
4369 Jim_DecrRefCount(interp, objv[0]);
4370 Jim_DecrRefCount(interp, objv[1]);
4371 Jim_DecrRefCount(interp, objv[2]);
4372 } else {
4373 Jim_DeleteHashEntry(&interp->references, refId);
4374 }
4375 }
4376 }
4377 Jim_FreeHashTableIterator(htiter);
4378 Jim_FreeHashTable(&marks);
4379 interp->lastCollectId = interp->referenceNextId;
4380 interp->lastCollectTime = time(NULL);
4381 return collected;
4382 }
4383
4384 #define JIM_COLLECT_ID_PERIOD 5000
4385 #define JIM_COLLECT_TIME_PERIOD 300
4386
4387 void Jim_CollectIfNeeded(Jim_Interp *interp)
4388 {
4389 jim_wide elapsedId;
4390 int elapsedTime;
4391
4392 elapsedId = interp->referenceNextId - interp->lastCollectId;
4393 elapsedTime = time(NULL) - interp->lastCollectTime;
4394
4395
4396 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4397 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4398 Jim_Collect(interp);
4399 }
4400 }
4401
4402 /* -----------------------------------------------------------------------------
4403 * Interpreter related functions
4404 * ---------------------------------------------------------------------------*/
4405
4406 Jim_Interp *Jim_CreateInterp(void)
4407 {
4408 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4409 Jim_Obj *pathPtr;
4410
4411 i->errorLine = 0;
4412 i->errorFileName = Jim_StrDup("");
4413 i->numLevels = 0;
4414 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4415 i->returnCode = JIM_OK;
4416 i->exitCode = 0;
4417 i->procEpoch = 0;
4418 i->callFrameEpoch = 0;
4419 i->liveList = i->freeList = NULL;
4420 i->scriptFileName = Jim_StrDup("");
4421 i->referenceNextId = 0;
4422 i->lastCollectId = 0;
4423 i->lastCollectTime = time(NULL);
4424 i->freeFramesList = NULL;
4425 i->prngState = NULL;
4426 i->evalRetcodeLevel = -1;
4427 i->cookie_stdin = stdin;
4428 i->cookie_stdout = stdout;
4429 i->cookie_stderr = stderr;
4430 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4431 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4432 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4433 i->cb_fflush = ((int (*)(void *))(fflush));
4434 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4435
4436 /* Note that we can create objects only after the
4437 * interpreter liveList and freeList pointers are
4438 * initialized to NULL. */
4439 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4440 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4441 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4442 NULL);
4443 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4444 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4445 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4446 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4447 i->emptyObj = Jim_NewEmptyStringObj(i);
4448 i->result = i->emptyObj;
4449 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4450 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4451 i->unknown_called = 0;
4452 Jim_IncrRefCount(i->emptyObj);
4453 Jim_IncrRefCount(i->result);
4454 Jim_IncrRefCount(i->stackTrace);
4455 Jim_IncrRefCount(i->unknown);
4456
4457 /* Initialize key variables every interpreter should contain */
4458 pathPtr = Jim_NewStringObj(i, "./", -1);
4459 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4460 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4461
4462 /* Export the core API to extensions */
4463 JimRegisterCoreApi(i);
4464 return i;
4465 }
4466
4467 /* This is the only function Jim exports directly without
4468 * to use the STUB system. It is only used by embedders
4469 * in order to get an interpreter with the Jim API pointers
4470 * registered. */
4471 Jim_Interp *ExportedJimCreateInterp(void)
4472 {
4473 return Jim_CreateInterp();
4474 }
4475
4476 void Jim_FreeInterp(Jim_Interp *i)
4477 {
4478 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4479 Jim_Obj *objPtr, *nextObjPtr;
4480
4481 Jim_DecrRefCount(i, i->emptyObj);
4482 Jim_DecrRefCount(i, i->result);
4483 Jim_DecrRefCount(i, i->stackTrace);
4484 Jim_DecrRefCount(i, i->unknown);
4485 Jim_Free((void*)i->errorFileName);
4486 Jim_Free((void*)i->scriptFileName);
4487 Jim_FreeHashTable(&i->commands);
4488 Jim_FreeHashTable(&i->references);
4489 Jim_FreeHashTable(&i->stub);
4490 Jim_FreeHashTable(&i->assocData);
4491 Jim_FreeHashTable(&i->packages);
4492 Jim_Free(i->prngState);
4493 /* Free the call frames list */
4494 while (cf) {
4495 prevcf = cf->parentCallFrame;
4496 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4497 cf = prevcf;
4498 }
4499 /* Check that the live object list is empty, otherwise
4500 * there is a memory leak. */
4501 if (i->liveList != NULL) {
4502 Jim_Obj *objPtr = i->liveList;
4503
4504 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4505 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4506 while (objPtr) {
4507 const char *type = objPtr->typePtr ?
4508 objPtr->typePtr->name : "";
4509 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4510 objPtr, type,
4511 objPtr->bytes ? objPtr->bytes
4512 : "(null)", objPtr->refCount);
4513 if (objPtr->typePtr == &sourceObjType) {
4514 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4515 objPtr->internalRep.sourceValue.fileName,
4516 objPtr->internalRep.sourceValue.lineNumber);
4517 }
4518 objPtr = objPtr->nextObjPtr;
4519 }
4520 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4521 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4522 }
4523 /* Free all the freed objects. */
4524 objPtr = i->freeList;
4525 while (objPtr) {
4526 nextObjPtr = objPtr->nextObjPtr;
4527 Jim_Free(objPtr);
4528 objPtr = nextObjPtr;
4529 }
4530 /* Free cached CallFrame structures */
4531 cf = i->freeFramesList;
4532 while (cf) {
4533 nextcf = cf->nextFramePtr;
4534 if (cf->vars.table != NULL)
4535 Jim_Free(cf->vars.table);
4536 Jim_Free(cf);
4537 cf = nextcf;
4538 }
4539 /* Free the sharedString hash table. Make sure to free it
4540 * after every other Jim_Object was freed. */
4541 Jim_FreeHashTable(&i->sharedStrings);
4542 /* Free the interpreter structure. */
4543 Jim_Free(i);
4544 }
4545
4546 /* Store the call frame relative to the level represented by
4547 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4548 * level is assumed to be '1'.
4549 *
4550 * If a newLevelptr int pointer is specified, the function stores
4551 * the absolute level integer value of the new target callframe into
4552 * *newLevelPtr. (this is used to adjust interp->numLevels
4553 * in the implementation of [uplevel], so that [info level] will
4554 * return a correct information).
4555 *
4556 * This function accepts the 'level' argument in the form
4557 * of the commands [uplevel] and [upvar].
4558 *
4559 * For a function accepting a relative integer as level suitable
4560 * for implementation of [info level ?level?] check the
4561 * GetCallFrameByInteger() function. */
4562 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4563 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4564 {
4565 long level;
4566 const char *str;
4567 Jim_CallFrame *framePtr;
4568
4569 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4570 if (levelObjPtr) {
4571 str = Jim_GetString(levelObjPtr, NULL);
4572 if (str[0] == '#') {
4573 char *endptr;
4574 /* speedup for the toplevel (level #0) */
4575 if (str[1] == '0' && str[2] == '\0') {
4576 if (newLevelPtr) *newLevelPtr = 0;
4577 *framePtrPtr = interp->topFramePtr;
4578 return JIM_OK;
4579 }
4580
4581 level = strtol(str + 1, &endptr, 0);
4582 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4583 goto badlevel;
4584 /* An 'absolute' level is converted into the
4585 * 'number of levels to go back' format. */
4586 level = interp->numLevels - level;
4587 if (level < 0) goto badlevel;
4588 } else {
4589 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4590 goto badlevel;
4591 }
4592 } else {
4593 str = "1"; /* Needed to format the error message. */
4594 level = 1;
4595 }
4596 /* Lookup */
4597 framePtr = interp->framePtr;
4598 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4599 while (level--) {
4600 framePtr = framePtr->parentCallFrame;
4601 if (framePtr == NULL) goto badlevel;
4602 }
4603 *framePtrPtr = framePtr;
4604 return JIM_OK;
4605 badlevel:
4606 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4607 Jim_AppendStrings(interp, Jim_GetResult(interp),
4608 "bad level \"", str, "\"", NULL);
4609 return JIM_ERR;
4610 }
4611
4612 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4613 * as a relative integer like in the [info level ?level?] command. */
4614 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4615 Jim_CallFrame **framePtrPtr)
4616 {
4617 jim_wide level;
4618 jim_wide relLevel; /* level relative to the current one. */
4619 Jim_CallFrame *framePtr;
4620
4621 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4622 goto badlevel;
4623 if (level > 0) {
4624 /* An 'absolute' level is converted into the
4625 * 'number of levels to go back' format. */
4626 relLevel = interp->numLevels - level;
4627 } else {
4628 relLevel = -level;
4629 }
4630 /* Lookup */
4631 framePtr = interp->framePtr;
4632 while (relLevel--) {
4633 framePtr = framePtr->parentCallFrame;
4634 if (framePtr == NULL) goto badlevel;
4635 }
4636 *framePtrPtr = framePtr;
4637 return JIM_OK;
4638 badlevel:
4639 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4640 Jim_AppendStrings(interp, Jim_GetResult(interp),
4641 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4642 return JIM_ERR;
4643 }
4644
4645 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4646 {
4647 Jim_Free((void*)interp->errorFileName);
4648 interp->errorFileName = Jim_StrDup(filename);
4649 }
4650
4651 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4652 {
4653 interp->errorLine = linenr;
4654 }
4655
4656 static void JimResetStackTrace(Jim_Interp *interp)
4657 {
4658 Jim_DecrRefCount(interp, interp->stackTrace);
4659 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4660 Jim_IncrRefCount(interp->stackTrace);
4661 }
4662
4663 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4664 const char *filename, int linenr)
4665 {
4666 /* No need to add this dummy entry to the stack trace */
4667 if (strcmp(procname, "unknown") == 0) {
4668 return;
4669 }
4670
4671 if (Jim_IsShared(interp->stackTrace)) {
4672 interp->stackTrace =
4673 Jim_DuplicateObj(interp, interp->stackTrace);
4674 Jim_IncrRefCount(interp->stackTrace);
4675 }
4676 Jim_ListAppendElement(interp, interp->stackTrace,
4677 Jim_NewStringObj(interp, procname, -1));
4678 Jim_ListAppendElement(interp, interp->stackTrace,
4679 Jim_NewStringObj(interp, filename, -1));
4680 Jim_ListAppendElement(interp, interp->stackTrace,
4681 Jim_NewIntObj(interp, linenr));
4682 }
4683
4684 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4685 {
4686 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4687 assocEntryPtr->delProc = delProc;
4688 assocEntryPtr->data = data;
4689 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4690 }
4691
4692 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4693 {
4694 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4695 if (entryPtr != NULL) {
4696 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4697 return assocEntryPtr->data;
4698 }
4699 return NULL;
4700 }
4701
4702 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4703 {
4704 return Jim_DeleteHashEntry(&interp->assocData, key);
4705 }
4706
4707 int Jim_GetExitCode(Jim_Interp *interp) {
4708 return interp->exitCode;
4709 }
4710
4711 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4712 {
4713 if (fp != NULL) interp->cookie_stdin = fp;
4714 return interp->cookie_stdin;
4715 }
4716
4717 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4718 {
4719 if (fp != NULL) interp->cookie_stdout = fp;
4720 return interp->cookie_stdout;
4721 }
4722
4723 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4724 {
4725 if (fp != NULL) interp->cookie_stderr = fp;
4726 return interp->cookie_stderr;
4727 }
4728
4729 /* -----------------------------------------------------------------------------
4730 * Shared strings.
4731 * Every interpreter has an hash table where to put shared dynamically
4732 * allocate strings that are likely to be used a lot of times.
4733 * For example, in the 'source' object type, there is a pointer to
4734 * the filename associated with that object. Every script has a lot
4735 * of this objects with the identical file name, so it is wise to share
4736 * this info.
4737 *
4738 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4739 * returns the pointer to the shared string. Every time a reference
4740 * to the string is no longer used, the user should call
4741 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4742 * a given string, it is removed from the hash table.
4743 * ---------------------------------------------------------------------------*/
4744 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4745 {
4746 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4747
4748 if (he == NULL) {
4749 char *strCopy = Jim_StrDup(str);
4750
4751 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4752 return strCopy;
4753 } else {
4754 long refCount = (long) he->val;
4755
4756 refCount++;
4757 he->val = (void*) refCount;
4758 return he->key;
4759 }
4760 }
4761
4762 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4763 {
4764 long refCount;
4765 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4766
4767 if (he == NULL)
4768 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4769 "unknown shared string '%s'", str);
4770 refCount = (long) he->val;
4771 refCount--;
4772 if (refCount == 0) {
4773 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4774 } else {
4775 he->val = (void*) refCount;
4776 }
4777 }
4778
4779 /* -----------------------------------------------------------------------------
4780 * Integer object
4781 * ---------------------------------------------------------------------------*/
4782 #define JIM_INTEGER_SPACE 24
4783
4784 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4785 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4786
4787 static Jim_ObjType intObjType = {
4788 "int",
4789 NULL,
4790 NULL,
4791 UpdateStringOfInt,
4792 JIM_TYPE_NONE,
4793 };
4794
4795 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4796 {
4797 int len;
4798 char buf[JIM_INTEGER_SPACE + 1];
4799
4800 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4801 objPtr->bytes = Jim_Alloc(len + 1);
4802 memcpy(objPtr->bytes, buf, len + 1);
4803 objPtr->length = len;
4804 }
4805
4806 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4807 {
4808 jim_wide wideValue;
4809 const char *str;
4810
4811 /* Get the string representation */
4812 str = Jim_GetString(objPtr, NULL);
4813 /* Try to convert into a jim_wide */
4814 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4815 if (flags & JIM_ERRMSG) {
4816 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4817 Jim_AppendStrings(interp, Jim_GetResult(interp),
4818 "expected integer but got \"", str, "\"", NULL);
4819 }
4820 return JIM_ERR;
4821 }
4822 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4823 errno == ERANGE) {
4824 Jim_SetResultString(interp,
4825 "Integer value too big to be represented", -1);
4826 return JIM_ERR;
4827 }
4828 /* Free the old internal repr and set the new one. */
4829 Jim_FreeIntRep(interp, objPtr);
4830 objPtr->typePtr = &intObjType;
4831 objPtr->internalRep.wideValue = wideValue;
4832 return JIM_OK;
4833 }
4834
4835 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4836 {
4837 if (objPtr->typePtr != &intObjType &&
4838 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4839 return JIM_ERR;
4840 *widePtr = objPtr->internalRep.wideValue;
4841 return JIM_OK;
4842 }
4843
4844 /* Get a wide but does not set an error if the format is bad. */
4845 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4846 jim_wide *widePtr)
4847 {
4848 if (objPtr->typePtr != &intObjType &&
4849 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4850 return JIM_ERR;
4851 *widePtr = objPtr->internalRep.wideValue;
4852 return JIM_OK;
4853 }
4854
4855 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4856 {
4857 jim_wide wideValue;
4858 int retval;
4859
4860 retval = Jim_GetWide(interp, objPtr, &wideValue);
4861 if (retval == JIM_OK) {
4862 *longPtr = (long) wideValue;
4863 return JIM_OK;
4864 }
4865 return JIM_ERR;
4866 }
4867
4868 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4869 {
4870 if (Jim_IsShared(objPtr))
4871 Jim_Panic(interp,"Jim_SetWide called with shared object");
4872 if (objPtr->typePtr != &intObjType) {
4873 Jim_FreeIntRep(interp, objPtr);
4874 objPtr->typePtr = &intObjType;
4875 }
4876 Jim_InvalidateStringRep(objPtr);
4877 objPtr->internalRep.wideValue = wideValue;
4878 }
4879
4880 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4881 {
4882 Jim_Obj *objPtr;
4883
4884 objPtr = Jim_NewObj(interp);
4885 objPtr->typePtr = &intObjType;
4886 objPtr->bytes = NULL;
4887 objPtr->internalRep.wideValue = wideValue;
4888 return objPtr;
4889 }
4890
4891 /* -----------------------------------------------------------------------------
4892 * Double object
4893 * ---------------------------------------------------------------------------*/
4894 #define JIM_DOUBLE_SPACE 30
4895
4896 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4897 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4898
4899 static Jim_ObjType doubleObjType = {
4900 "double",
4901 NULL,
4902 NULL,
4903 UpdateStringOfDouble,
4904 JIM_TYPE_NONE,
4905 };
4906
4907 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4908 {
4909 int len;
4910 char buf[JIM_DOUBLE_SPACE + 1];
4911
4912 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4913 objPtr->bytes = Jim_Alloc(len + 1);
4914 memcpy(objPtr->bytes, buf, len + 1);
4915 objPtr->length = len;
4916 }
4917
4918 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4919 {
4920 double doubleValue;
4921 const char *str;
4922
4923 /* Get the string representation */
4924 str = Jim_GetString(objPtr, NULL);
4925 /* Try to convert into a double */
4926 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4927 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4928 Jim_AppendStrings(interp, Jim_GetResult(interp),
4929 "expected number but got '", str, "'", NULL);
4930 return JIM_ERR;
4931 }
4932 /* Free the old internal repr and set the new one. */
4933 Jim_FreeIntRep(interp, objPtr);
4934 objPtr->typePtr = &doubleObjType;
4935 objPtr->internalRep.doubleValue = doubleValue;
4936 return JIM_OK;
4937 }
4938
4939 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4940 {
4941 if (objPtr->typePtr != &doubleObjType &&
4942 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4943 return JIM_ERR;
4944 *doublePtr = objPtr->internalRep.doubleValue;
4945 return JIM_OK;
4946 }
4947
4948 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4949 {
4950 if (Jim_IsShared(objPtr))
4951 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4952 if (objPtr->typePtr != &doubleObjType) {
4953 Jim_FreeIntRep(interp, objPtr);
4954 objPtr->typePtr = &doubleObjType;
4955 }
4956 Jim_InvalidateStringRep(objPtr);
4957 objPtr->internalRep.doubleValue = doubleValue;
4958 }
4959
4960 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4961 {
4962 Jim_Obj *objPtr;
4963
4964 objPtr = Jim_NewObj(interp);
4965 objPtr->typePtr = &doubleObjType;
4966 objPtr->bytes = NULL;
4967 objPtr->internalRep.doubleValue = doubleValue;
4968 return objPtr;
4969 }
4970
4971 /* -----------------------------------------------------------------------------
4972 * List object
4973 * ---------------------------------------------------------------------------*/
4974 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4975 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4976 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4977 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4978 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4979
4980 /* Note that while the elements of the list may contain references,
4981 * the list object itself can't. This basically means that the
4982 * list object string representation as a whole can't contain references
4983 * that are not presents in the single elements. */
4984 static Jim_ObjType listObjType = {
4985 "list",
4986 FreeListInternalRep,
4987 DupListInternalRep,
4988 UpdateStringOfList,
4989 JIM_TYPE_NONE,
4990 };
4991
4992 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4993 {
4994 int i;
4995
4996 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4997 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4998 }
4999 Jim_Free(objPtr->internalRep.listValue.ele);
5000 }
5001
5002 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5003 {
5004 int i;
5005 JIM_NOTUSED(interp);
5006
5007 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5008 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5009 dupPtr->internalRep.listValue.ele =
5010 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5011 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5012 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5013 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5014 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5015 }
5016 dupPtr->typePtr = &listObjType;
5017 }
5018
5019 /* The following function checks if a given string can be encoded
5020 * into a list element without any kind of quoting, surrounded by braces,
5021 * or using escapes to quote. */
5022 #define JIM_ELESTR_SIMPLE 0
5023 #define JIM_ELESTR_BRACE 1
5024 #define JIM_ELESTR_QUOTE 2
5025 static int ListElementQuotingType(const char *s, int len)
5026 {
5027 int i, level, trySimple = 1;
5028
5029 /* Try with the SIMPLE case */
5030 if (len == 0) return JIM_ELESTR_BRACE;
5031 if (s[0] == '"' || s[0] == '{') {
5032 trySimple = 0;
5033 goto testbrace;
5034 }
5035 for (i = 0; i < len; i++) {
5036 switch (s[i]) {
5037 case ' ':
5038 case '$':
5039 case '"':
5040 case '[':
5041 case ']':
5042 case ';':
5043 case '\\':
5044 case '\r':
5045 case '\n':
5046 case '\t':
5047 case '\f':
5048 case '\v':
5049 trySimple = 0;
5050 case '{':
5051 case '}':
5052 goto testbrace;
5053 }
5054 }
5055 return JIM_ELESTR_SIMPLE;
5056
5057 testbrace:
5058 /* Test if it's possible to do with braces */
5059 if (s[len-1] == '\\' ||
5060 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5061 level = 0;
5062 for (i = 0; i < len; i++) {
5063 switch (s[i]) {
5064 case '{': level++; break;
5065 case '}': level--;
5066 if (level < 0) return JIM_ELESTR_QUOTE;
5067 break;
5068 case '\\':
5069 if (s[i + 1] == '\n')
5070 return JIM_ELESTR_QUOTE;
5071 else
5072 if (s[i + 1] != '\0') i++;
5073 break;
5074 }
5075 }
5076 if (level == 0) {
5077 if (!trySimple) return JIM_ELESTR_BRACE;
5078 for (i = 0; i < len; i++) {
5079 switch (s[i]) {
5080 case ' ':
5081 case '$':
5082 case '"':
5083 case '[':
5084 case ']':
5085 case ';':
5086 case '\\':
5087 case '\r':
5088 case '\n':
5089 case '\t':
5090 case '\f':
5091 case '\v':
5092 return JIM_ELESTR_BRACE;
5093 break;
5094 }
5095 }
5096 return JIM_ELESTR_SIMPLE;
5097 }
5098 return JIM_ELESTR_QUOTE;
5099 }
5100
5101 /* Returns the malloc-ed representation of a string
5102 * using backslash to quote special chars. */
5103 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5104 {
5105 char *q = Jim_Alloc(len*2 + 1), *p;
5106
5107 p = q;
5108 while (*s) {
5109 switch (*s) {
5110 case ' ':
5111 case '$':
5112 case '"':
5113 case '[':
5114 case ']':
5115 case '{':
5116 case '}':
5117 case ';':
5118 case '\\':
5119 *p++ = '\\';
5120 *p++ = *s++;
5121 break;
5122 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5123 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5124 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5125 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5126 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5127 default:
5128 *p++ = *s++;
5129 break;
5130 }
5131 }
5132 *p = '\0';
5133 *qlenPtr = p-q;
5134 return q;
5135 }
5136
5137 void UpdateStringOfList(struct Jim_Obj *objPtr)
5138 {
5139 int i, bufLen, realLength;
5140 const char *strRep;
5141 char *p;
5142 int *quotingType;
5143 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5144
5145 /* (Over) Estimate the space needed. */
5146 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5147 bufLen = 0;
5148 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5149 int len;
5150
5151 strRep = Jim_GetString(ele[i], &len);
5152 quotingType[i] = ListElementQuotingType(strRep, len);
5153 switch (quotingType[i]) {
5154 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5155 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5156 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5157 }
5158 bufLen++; /* elements separator. */
5159 }
5160 bufLen++;
5161
5162 /* Generate the string rep. */
5163 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5164 realLength = 0;
5165 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5166 int len, qlen;
5167 const char *strRep = Jim_GetString(ele[i], &len);
5168 char *q;
5169
5170 switch (quotingType[i]) {
5171 case JIM_ELESTR_SIMPLE:
5172 memcpy(p, strRep, len);
5173 p += len;
5174 realLength += len;
5175 break;
5176 case JIM_ELESTR_BRACE:
5177 *p++ = '{';
5178 memcpy(p, strRep, len);
5179 p += len;
5180 *p++ = '}';
5181 realLength += len + 2;
5182 break;
5183 case JIM_ELESTR_QUOTE:
5184 q = BackslashQuoteString(strRep, len, &qlen);
5185 memcpy(p, q, qlen);
5186 Jim_Free(q);
5187 p += qlen;
5188 realLength += qlen;
5189 break;
5190 }
5191 /* Add a separating space */
5192 if (i + 1 != objPtr->internalRep.listValue.len) {
5193 *p++ = ' ';
5194 realLength ++;
5195 }
5196 }
5197 *p = '\0'; /* nul term. */
5198 objPtr->length = realLength;
5199 Jim_Free(quotingType);
5200 }
5201
5202 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5203 {
5204 struct JimParserCtx parser;
5205 const char *str;
5206 int strLen;
5207
5208 /* Get the string representation */
5209 str = Jim_GetString(objPtr, &strLen);
5210
5211 /* Free the old internal repr just now and initialize the
5212 * new one just now. The string->list conversion can't fail. */
5213 Jim_FreeIntRep(interp, objPtr);
5214 objPtr->typePtr = &listObjType;
5215 objPtr->internalRep.listValue.len = 0;
5216 objPtr->internalRep.listValue.maxLen = 0;
5217 objPtr->internalRep.listValue.ele = NULL;
5218
5219 /* Convert into a list */
5220 JimParserInit(&parser, str, strLen, 1);
5221 while (!JimParserEof(&parser)) {
5222 char *token;
5223 int tokenLen, type;
5224 Jim_Obj *elementPtr;
5225
5226 JimParseList(&parser);
5227 if (JimParserTtype(&parser) != JIM_TT_STR &&
5228 JimParserTtype(&parser) != JIM_TT_ESC)
5229 continue;
5230 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5231 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5232 ListAppendElement(objPtr, elementPtr);
5233 }
5234 return JIM_OK;
5235 }
5236
5237 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5238 int len)
5239 {
5240 Jim_Obj *objPtr;
5241 int i;
5242
5243 objPtr = Jim_NewObj(interp);
5244 objPtr->typePtr = &listObjType;
5245 objPtr->bytes = NULL;
5246 objPtr->internalRep.listValue.ele = NULL;
5247 objPtr->internalRep.listValue.len = 0;
5248 objPtr->internalRep.listValue.maxLen = 0;
5249 for (i = 0; i < len; i++) {
5250 ListAppendElement(objPtr, elements[i]);
5251 }
5252 return objPtr;
5253 }
5254
5255 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5256 * length of the vector. Note that the user of this function should make
5257 * sure that the list object can't shimmer while the vector returned
5258 * is in use, this vector is the one stored inside the internal representation
5259 * of the list object. This function is not exported, extensions should
5260 * always access to the List object elements using Jim_ListIndex(). */
5261 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5262 Jim_Obj ***listVec)
5263 {
5264 Jim_ListLength(interp, listObj, argc);
5265 assert(listObj->typePtr == &listObjType);
5266 *listVec = listObj->internalRep.listValue.ele;
5267 }
5268
5269 /* ListSortElements type values */
5270 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5271 JIM_LSORT_NOCASE_DECR};
5272
5273 /* Sort the internal rep of a list. */
5274 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5275 {
5276 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5277 }
5278
5279 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5280 {
5281 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5282 }
5283
5284 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5285 {
5286 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5287 }
5288
5289 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5290 {
5291 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5292 }
5293
5294 /* Sort a list *in place*. MUST be called with non-shared objects. */
5295 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5296 {
5297 typedef int (qsort_comparator)(const void *, const void *);
5298 int (*fn)(Jim_Obj**, Jim_Obj**);
5299 Jim_Obj **vector;
5300 int len;
5301
5302 if (Jim_IsShared(listObjPtr))
5303 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5304 if (listObjPtr->typePtr != &listObjType)
5305 SetListFromAny(interp, listObjPtr);
5306
5307 vector = listObjPtr->internalRep.listValue.ele;
5308 len = listObjPtr->internalRep.listValue.len;
5309 switch (type) {
5310 case JIM_LSORT_ASCII: fn = ListSortString; break;
5311 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5312 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5313 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5314 default:
5315 fn = NULL; /* avoid warning */
5316 Jim_Panic(interp,"ListSort called with invalid sort type");
5317 }
5318 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5319 Jim_InvalidateStringRep(listObjPtr);
5320 }
5321
5322 /* This is the low-level function to append an element to a list.
5323 * The higher-level Jim_ListAppendElement() performs shared object
5324 * check and invalidate the string repr. This version is used
5325 * in the internals of the List Object and is not exported.
5326 *
5327 * NOTE: this function can be called only against objects
5328 * with internal type of List. */
5329 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5330 {
5331 int requiredLen = listPtr->internalRep.listValue.len + 1;
5332
5333 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5334 int maxLen = requiredLen * 2;
5335
5336 listPtr->internalRep.listValue.ele =
5337 Jim_Realloc(listPtr->internalRep.listValue.ele,
5338 sizeof(Jim_Obj*)*maxLen);
5339 listPtr->internalRep.listValue.maxLen = maxLen;
5340 }
5341 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5342 objPtr;
5343 listPtr->internalRep.listValue.len ++;
5344 Jim_IncrRefCount(objPtr);
5345 }
5346
5347 /* This is the low-level function to insert elements into a list.
5348 * The higher-level Jim_ListInsertElements() performs shared object
5349 * check and invalidate the string repr. This version is used
5350 * in the internals of the List Object and is not exported.
5351 *
5352 * NOTE: this function can be called only against objects
5353 * with internal type of List. */
5354 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5355 Jim_Obj *const *elemVec)
5356 {
5357 int currentLen = listPtr->internalRep.listValue.len;
5358 int requiredLen = currentLen + elemc;
5359 int i;
5360 Jim_Obj **point;
5361
5362 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5363 int maxLen = requiredLen * 2;
5364
5365 listPtr->internalRep.listValue.ele =
5366 Jim_Realloc(listPtr->internalRep.listValue.ele,
5367 sizeof(Jim_Obj*)*maxLen);
5368 listPtr->internalRep.listValue.maxLen = maxLen;
5369 }
5370 point = listPtr->internalRep.listValue.ele + index;
5371 memmove(point + elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5372 for (i = 0; i < elemc; ++i) {
5373 point[i] = elemVec[i];
5374 Jim_IncrRefCount(point[i]);
5375 }
5376 listPtr->internalRep.listValue.len += elemc;
5377 }
5378
5379 /* Appends every element of appendListPtr into listPtr.
5380 * Both have to be of the list type. */
5381 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5382 {
5383 int i, oldLen = listPtr->internalRep.listValue.len;
5384 int appendLen = appendListPtr->internalRep.listValue.len;
5385 int requiredLen = oldLen + appendLen;
5386
5387 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5388 int maxLen = requiredLen * 2;
5389
5390 listPtr->internalRep.listValue.ele =
5391 Jim_Realloc(listPtr->internalRep.listValue.ele,
5392 sizeof(Jim_Obj*)*maxLen);
5393 listPtr->internalRep.listValue.maxLen = maxLen;
5394 }
5395 for (i = 0; i < appendLen; i++) {
5396 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5397 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5398 Jim_IncrRefCount(objPtr);
5399 }
5400 listPtr->internalRep.listValue.len += appendLen;
5401 }
5402
5403 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5404 {
5405 if (Jim_IsShared(listPtr))
5406 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5407 if (listPtr->typePtr != &listObjType)
5408 SetListFromAny(interp, listPtr);
5409 Jim_InvalidateStringRep(listPtr);
5410 ListAppendElement(listPtr, objPtr);
5411 }
5412
5413 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5414 {
5415 if (Jim_IsShared(listPtr))
5416 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5417 if (listPtr->typePtr != &listObjType)
5418 SetListFromAny(interp, listPtr);
5419 Jim_InvalidateStringRep(listPtr);
5420 ListAppendList(listPtr, appendListPtr);
5421 }
5422
5423 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5424 {
5425 if (listPtr->typePtr != &listObjType)
5426 SetListFromAny(interp, listPtr);
5427 *intPtr = listPtr->internalRep.listValue.len;
5428 }
5429
5430 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5431 int objc, Jim_Obj *const *objVec)
5432 {
5433 if (Jim_IsShared(listPtr))
5434 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5435 if (listPtr->typePtr != &listObjType)
5436 SetListFromAny(interp, listPtr);
5437 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5438 index = listPtr->internalRep.listValue.len;
5439 else if (index < 0)
5440 index = 0;
5441 Jim_InvalidateStringRep(listPtr);
5442 ListInsertElements(listPtr, index, objc, objVec);
5443 }
5444
5445 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5446 Jim_Obj **objPtrPtr, int flags)
5447 {
5448 if (listPtr->typePtr != &listObjType)
5449 SetListFromAny(interp, listPtr);
5450 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5451 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5452 if (flags & JIM_ERRMSG) {
5453 Jim_SetResultString(interp,
5454 "list index out of range", -1);
5455 }
5456 return JIM_ERR;
5457 }
5458 if (index < 0)
5459 index = listPtr->internalRep.listValue.len + index;
5460 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5461 return JIM_OK;
5462 }
5463
5464 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5465 Jim_Obj *newObjPtr, int flags)
5466 {
5467 if (listPtr->typePtr != &listObjType)
5468 SetListFromAny(interp, listPtr);
5469 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5470 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5471 if (flags & JIM_ERRMSG) {
5472 Jim_SetResultString(interp,
5473 "list index out of range", -1);
5474 }
5475 return JIM_ERR;
5476 }
5477 if (index < 0)
5478 index = listPtr->internalRep.listValue.len + index;
5479 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5480 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5481 Jim_IncrRefCount(newObjPtr);
5482 return JIM_OK;
5483 }
5484
5485 /* Modify the list stored into the variable named 'varNamePtr'
5486 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5487 * with the new element 'newObjptr'. */
5488 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5489 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5490 {
5491 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5492 int shared, i, index;
5493
5494 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5495 if (objPtr == NULL)
5496 return JIM_ERR;
5497 if ((shared = Jim_IsShared(objPtr)))
5498 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5499 for (i = 0; i < indexc-1; i++) {
5500 listObjPtr = objPtr;
5501 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5502 goto err;
5503 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5504 JIM_ERRMSG) != JIM_OK) {
5505 goto err;
5506 }
5507 if (Jim_IsShared(objPtr)) {
5508 objPtr = Jim_DuplicateObj(interp, objPtr);
5509 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5510 }
5511 Jim_InvalidateStringRep(listObjPtr);
5512 }
5513 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5514 goto err;
5515 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5516 goto err;
5517 Jim_InvalidateStringRep(objPtr);
5518 Jim_InvalidateStringRep(varObjPtr);
5519 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5520 goto err;
5521 Jim_SetResult(interp, varObjPtr);
5522 return JIM_OK;
5523 err:
5524 if (shared) {
5525 Jim_FreeNewObj(interp, varObjPtr);
5526 }
5527 return JIM_ERR;
5528 }
5529
5530 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5531 {
5532 int i;
5533
5534 /* If all the objects in objv are lists without string rep.
5535 * it's possible to return a list as result, that's the
5536 * concatenation of all the lists. */
5537 for (i = 0; i < objc; i++) {
5538 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5539 break;
5540 }
5541 if (i == objc) {
5542 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5543 for (i = 0; i < objc; i++)
5544 Jim_ListAppendList(interp, objPtr, objv[i]);
5545 return objPtr;
5546 } else {
5547 /* Else... we have to glue strings together */
5548 int len = 0, objLen;
5549 char *bytes, *p;
5550
5551 /* Compute the length */
5552 for (i = 0; i < objc; i++) {
5553 Jim_GetString(objv[i], &objLen);
5554 len += objLen;
5555 }
5556 if (objc) len += objc-1;
5557 /* Create the string rep, and a stinrg object holding it. */
5558 p = bytes = Jim_Alloc(len + 1);
5559 for (i = 0; i < objc; i++) {
5560 const char *s = Jim_GetString(objv[i], &objLen);
5561 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5562 {
5563 s++; objLen--; len--;
5564 }
5565 while (objLen && (s[objLen-1] == ' ' ||
5566 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5567 objLen--; len--;
5568 }
5569 memcpy(p, s, objLen);
5570 p += objLen;
5571 if (objLen && i + 1 != objc) {
5572 *p++ = ' ';
5573 } else if (i + 1 != objc) {
5574 /* Drop the space calcuated for this
5575 * element that is instead null. */
5576 len--;
5577 }
5578 }
5579 *p = '\0';
5580 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5581 }
5582 }
5583
5584 /* Returns a list composed of the elements in the specified range.
5585 * first and start are directly accepted as Jim_Objects and
5586 * processed for the end?-index? case. */
5587 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5588 {
5589 int first, last;
5590 int len, rangeLen;
5591
5592 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5593 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5594 return NULL;
5595 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5596 first = JimRelToAbsIndex(len, first);
5597 last = JimRelToAbsIndex(len, last);
5598 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5599 return Jim_NewListObj(interp,
5600 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5601 }
5602
5603 /* -----------------------------------------------------------------------------
5604 * Dict object
5605 * ---------------------------------------------------------------------------*/
5606 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5607 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5608 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5609 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5610
5611 /* Dict HashTable Type.
5612 *
5613 * Keys and Values are Jim objects. */
5614
5615 unsigned int JimObjectHTHashFunction(const void *key)
5616 {
5617 const char *str;
5618 Jim_Obj *objPtr = (Jim_Obj*) key;
5619 int len, h;
5620
5621 str = Jim_GetString(objPtr, &len);
5622 h = Jim_GenHashFunction((unsigned char*)str, len);
5623 return h;
5624 }
5625
5626 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5627 {
5628 JIM_NOTUSED(privdata);
5629
5630 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5631 }
5632
5633 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5634 {
5635 Jim_Obj *objPtr = val;
5636
5637 Jim_DecrRefCount(interp, objPtr);
5638 }
5639
5640 static Jim_HashTableType JimDictHashTableType = {
5641 JimObjectHTHashFunction, /* hash function */
5642 NULL, /* key dup */
5643 NULL, /* val dup */
5644 JimObjectHTKeyCompare, /* key compare */
5645 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5646 JimObjectHTKeyValDestructor, /* key destructor */
5647 JimObjectHTKeyValDestructor /* val destructor */
5648 };
5649
5650 /* Note that while the elements of the dict may contain references,
5651 * the list object itself can't. This basically means that the
5652 * dict object string representation as a whole can't contain references
5653 * that are not presents in the single elements. */
5654 static Jim_ObjType dictObjType = {
5655 "dict",
5656 FreeDictInternalRep,
5657 DupDictInternalRep,
5658 UpdateStringOfDict,
5659 JIM_TYPE_NONE,
5660 };
5661
5662 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5663 {
5664 JIM_NOTUSED(interp);
5665
5666 Jim_FreeHashTable(objPtr->internalRep.ptr);
5667 Jim_Free(objPtr->internalRep.ptr);
5668 }
5669
5670 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5671 {
5672 Jim_HashTable *ht, *dupHt;
5673 Jim_HashTableIterator *htiter;
5674 Jim_HashEntry *he;
5675
5676 /* Create a new hash table */
5677 ht = srcPtr->internalRep.ptr;
5678 dupHt = Jim_Alloc(sizeof(*dupHt));
5679 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5680 if (ht->size != 0)
5681 Jim_ExpandHashTable(dupHt, ht->size);
5682 /* Copy every element from the source to the dup hash table */
5683 htiter = Jim_GetHashTableIterator(ht);
5684 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5685 const Jim_Obj *keyObjPtr = he->key;
5686 Jim_Obj *valObjPtr = he->val;
5687
5688 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5689 Jim_IncrRefCount(valObjPtr);
5690 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5691 }
5692 Jim_FreeHashTableIterator(htiter);
5693
5694 dupPtr->internalRep.ptr = dupHt;
5695 dupPtr->typePtr = &dictObjType;
5696 }
5697
5698 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5699 {
5700 int i, bufLen, realLength;
5701 const char *strRep;
5702 char *p;
5703 int *quotingType, objc;
5704 Jim_HashTable *ht;
5705 Jim_HashTableIterator *htiter;
5706 Jim_HashEntry *he;
5707 Jim_Obj **objv;
5708
5709 /* Trun the hash table into a flat vector of Jim_Objects. */
5710 ht = objPtr->internalRep.ptr;
5711 objc = ht->used*2;
5712 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5713 htiter = Jim_GetHashTableIterator(ht);
5714 i = 0;
5715 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5716 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5717 objv[i++] = he->val;
5718 }
5719 Jim_FreeHashTableIterator(htiter);
5720 /* (Over) Estimate the space needed. */
5721 quotingType = Jim_Alloc(sizeof(int)*objc);
5722 bufLen = 0;
5723 for (i = 0; i < objc; i++) {
5724 int len;
5725
5726 strRep = Jim_GetString(objv[i], &len);
5727 quotingType[i] = ListElementQuotingType(strRep, len);
5728 switch (quotingType[i]) {
5729 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5730 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5731 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5732 }
5733 bufLen++; /* elements separator. */
5734 }
5735 bufLen++;
5736
5737 /* Generate the string rep. */
5738 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5739 realLength = 0;
5740 for (i = 0; i < objc; i++) {
5741 int len, qlen;
5742 const char *strRep = Jim_GetString(objv[i], &len);
5743 char *q;
5744
5745 switch (quotingType[i]) {
5746 case JIM_ELESTR_SIMPLE:
5747 memcpy(p, strRep, len);
5748 p += len;
5749 realLength += len;
5750 break;
5751 case JIM_ELESTR_BRACE:
5752 *p++ = '{';
5753 memcpy(p, strRep, len);
5754 p += len;
5755 *p++ = '}';
5756 realLength += len + 2;
5757 break;
5758 case JIM_ELESTR_QUOTE:
5759 q = BackslashQuoteString(strRep, len, &qlen);
5760 memcpy(p, q, qlen);
5761 Jim_Free(q);
5762 p += qlen;
5763 realLength += qlen;
5764 break;
5765 }
5766 /* Add a separating space */
5767 if (i + 1 != objc) {
5768 *p++ = ' ';
5769 realLength ++;
5770 }
5771 }
5772 *p = '\0'; /* nul term. */
5773 objPtr->length = realLength;
5774 Jim_Free(quotingType);
5775 Jim_Free(objv);
5776 }
5777
5778 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5779 {
5780 struct JimParserCtx parser;
5781 Jim_HashTable *ht;
5782 Jim_Obj *objv[2];
5783 const char *str;
5784 int i, strLen;
5785
5786 /* Get the string representation */
5787 str = Jim_GetString(objPtr, &strLen);
5788
5789 /* Free the old internal repr just now and initialize the
5790 * new one just now. The string->list conversion can't fail. */
5791 Jim_FreeIntRep(interp, objPtr);
5792 ht = Jim_Alloc(sizeof(*ht));
5793 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5794 objPtr->typePtr = &dictObjType;
5795 objPtr->internalRep.ptr = ht;
5796
5797 /* Convert into a dict */
5798 JimParserInit(&parser, str, strLen, 1);
5799 i = 0;
5800 while (!JimParserEof(&parser)) {
5801 char *token;
5802 int tokenLen, type;
5803
5804 JimParseList(&parser);
5805 if (JimParserTtype(&parser) != JIM_TT_STR &&
5806 JimParserTtype(&parser) != JIM_TT_ESC)
5807 continue;
5808 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5809 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5810 if (i == 2) {
5811 i = 0;
5812 Jim_IncrRefCount(objv[0]);
5813 Jim_IncrRefCount(objv[1]);
5814 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5815 Jim_HashEntry *he;
5816 he = Jim_FindHashEntry(ht, objv[0]);
5817 Jim_DecrRefCount(interp, objv[0]);
5818 /* ATTENTION: const cast */
5819 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5820 he->val = objv[1];
5821 }
5822 }
5823 }
5824 if (i) {
5825 Jim_FreeNewObj(interp, objv[0]);
5826 objPtr->typePtr = NULL;
5827 Jim_FreeHashTable(ht);
5828 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5829 return JIM_ERR;
5830 }
5831 return JIM_OK;
5832 }
5833
5834 /* Dict object API */
5835
5836 /* Add an element to a dict. objPtr must be of the "dict" type.
5837 * The higer-level exported function is Jim_DictAddElement().
5838 * If an element with the specified key already exists, the value
5839 * associated is replaced with the new one.
5840 *
5841 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5842 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5843 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5844 {
5845 Jim_HashTable *ht = objPtr->internalRep.ptr;
5846
5847 if (valueObjPtr == NULL) { /* unset */
5848 Jim_DeleteHashEntry(ht, keyObjPtr);
5849 return;
5850 }
5851 Jim_IncrRefCount(keyObjPtr);
5852 Jim_IncrRefCount(valueObjPtr);
5853 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5854 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5855 Jim_DecrRefCount(interp, keyObjPtr);
5856 /* ATTENTION: const cast */
5857 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5858 he->val = valueObjPtr;
5859 }
5860 }
5861
5862 /* Add an element, higher-level interface for DictAddElement().
5863 * If valueObjPtr == NULL, the key is removed if it exists. */
5864 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5865 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5866 {
5867 if (Jim_IsShared(objPtr))
5868 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5869 if (objPtr->typePtr != &dictObjType) {
5870 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5871 return JIM_ERR;
5872 }
5873 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5874 Jim_InvalidateStringRep(objPtr);
5875 return JIM_OK;
5876 }
5877
5878 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5879 {
5880 Jim_Obj *objPtr;
5881 int i;
5882
5883 if (len % 2)
5884 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5885
5886 objPtr = Jim_NewObj(interp);
5887 objPtr->typePtr = &dictObjType;
5888 objPtr->bytes = NULL;
5889 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5890 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5891 for (i = 0; i < len; i += 2)
5892 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5893 return objPtr;
5894 }
5895
5896 /* Return the value associated to the specified dict key */
5897 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5898 Jim_Obj **objPtrPtr, int flags)
5899 {
5900 Jim_HashEntry *he;
5901 Jim_HashTable *ht;
5902
5903 if (dictPtr->typePtr != &dictObjType) {
5904 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5905 return JIM_ERR;
5906 }
5907 ht = dictPtr->internalRep.ptr;
5908 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5909 if (flags & JIM_ERRMSG) {
5910 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5911 Jim_AppendStrings(interp, Jim_GetResult(interp),
5912 "key \"", Jim_GetString(keyPtr, NULL),
5913 "\" not found in dictionary", NULL);
5914 }
5915 return JIM_ERR;
5916 }
5917 *objPtrPtr = he->val;
5918 return JIM_OK;
5919 }
5920
5921 /* Return the value associated to the specified dict keys */
5922 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5923 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5924 {
5925 Jim_Obj *objPtr = NULL;
5926 int i;
5927
5928 if (keyc == 0) {
5929 *objPtrPtr = dictPtr;
5930 return JIM_OK;
5931 }
5932
5933 for (i = 0; i < keyc; i++) {
5934 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5935 != JIM_OK)
5936 return JIM_ERR;
5937 dictPtr = objPtr;
5938 }
5939 *objPtrPtr = objPtr;
5940 return JIM_OK;
5941 }
5942
5943 /* Modify the dict stored into the variable named 'varNamePtr'
5944 * setting the element specified by the 'keyc' keys objects in 'keyv',
5945 * with the new value of the element 'newObjPtr'.
5946 *
5947 * If newObjPtr == NULL the operation is to remove the given key
5948 * from the dictionary. */
5949 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5950 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5951 {
5952 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5953 int shared, i;
5954
5955 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5956 if (objPtr == NULL) {
5957 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5958 return JIM_ERR;
5959 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5960 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5961 Jim_FreeNewObj(interp, varObjPtr);
5962 return JIM_ERR;
5963 }
5964 }
5965 if ((shared = Jim_IsShared(objPtr)))
5966 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5967 for (i = 0; i < keyc-1; i++) {
5968 dictObjPtr = objPtr;
5969
5970 /* Check if it's a valid dictionary */
5971 if (dictObjPtr->typePtr != &dictObjType) {
5972 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5973 goto err;
5974 }
5975 /* Check if the given key exists. */
5976 Jim_InvalidateStringRep(dictObjPtr);
5977 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5978 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5979 {
5980 /* This key exists at the current level.
5981 * Make sure it's not shared!. */
5982 if (Jim_IsShared(objPtr)) {
5983 objPtr = Jim_DuplicateObj(interp, objPtr);
5984 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5985 }
5986 } else {
5987 /* Key not found. If it's an [unset] operation
5988 * this is an error. Only the last key may not
5989 * exist. */
5990 if (newObjPtr == NULL)
5991 goto err;
5992 /* Otherwise set an empty dictionary
5993 * as key's value. */
5994 objPtr = Jim_NewDictObj(interp, NULL, 0);
5995 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5996 }
5997 }
5998 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5999 != JIM_OK)
6000 goto err;
6001 Jim_InvalidateStringRep(objPtr);
6002 Jim_InvalidateStringRep(varObjPtr);
6003 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6004 goto err;
6005 Jim_SetResult(interp, varObjPtr);
6006 return JIM_OK;
6007 err:
6008 if (shared) {
6009 Jim_FreeNewObj(interp, varObjPtr);
6010 }
6011 return JIM_ERR;
6012 }
6013
6014 /* -----------------------------------------------------------------------------
6015 * Index object
6016 * ---------------------------------------------------------------------------*/
6017 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6018 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6019
6020 static Jim_ObjType indexObjType = {
6021 "index",
6022 NULL,
6023 NULL,
6024 UpdateStringOfIndex,
6025 JIM_TYPE_NONE,
6026 };
6027
6028 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6029 {
6030 int len;
6031 char buf[JIM_INTEGER_SPACE + 1];
6032
6033 if (objPtr->internalRep.indexValue >= 0)
6034 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6035 else if (objPtr->internalRep.indexValue == -1)
6036 len = sprintf(buf, "end");
6037 else {
6038 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6039 }
6040 objPtr->bytes = Jim_Alloc(len + 1);
6041 memcpy(objPtr->bytes, buf, len + 1);
6042 objPtr->length = len;
6043 }
6044
6045 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6046 {
6047 int index, end = 0;
6048 const char *str;
6049
6050 /* Get the string representation */
6051 str = Jim_GetString(objPtr, NULL);
6052 /* Try to convert into an index */
6053 if (!strcmp(str, "end")) {
6054 index = 0;
6055 end = 1;
6056 } else {
6057 if (!strncmp(str, "end-", 4)) {
6058 str += 4;
6059 end = 1;
6060 }
6061 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6062 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6063 Jim_AppendStrings(interp, Jim_GetResult(interp),
6064 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6065 "must be integer or end?-integer?", NULL);
6066 return JIM_ERR;
6067 }
6068 }
6069 if (end) {
6070 if (index < 0)
6071 index = INT_MAX;
6072 else
6073 index = -(index + 1);
6074 } else if (!end && index < 0)
6075 index = -INT_MAX;
6076 /* Free the old internal repr and set the new one. */
6077 Jim_FreeIntRep(interp, objPtr);
6078 objPtr->typePtr = &indexObjType;
6079 objPtr->internalRep.indexValue = index;
6080 return JIM_OK;
6081 }
6082
6083 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6084 {
6085 /* Avoid shimmering if the object is an integer. */
6086 if (objPtr->typePtr == &intObjType) {
6087 jim_wide val = objPtr->internalRep.wideValue;
6088 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6089 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6090 return JIM_OK;
6091 }
6092 }
6093 if (objPtr->typePtr != &indexObjType &&
6094 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6095 return JIM_ERR;
6096 *indexPtr = objPtr->internalRep.indexValue;
6097 return JIM_OK;
6098 }
6099
6100 /* -----------------------------------------------------------------------------
6101 * Return Code Object.
6102 * ---------------------------------------------------------------------------*/
6103
6104 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6105
6106 static Jim_ObjType returnCodeObjType = {
6107 "return-code",
6108 NULL,
6109 NULL,
6110 NULL,
6111 JIM_TYPE_NONE,
6112 };
6113
6114 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6115 {
6116 const char *str;
6117 int strLen, returnCode;
6118 jim_wide wideValue;
6119
6120 /* Get the string representation */
6121 str = Jim_GetString(objPtr, &strLen);
6122 /* Try to convert into an integer */
6123 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6124 returnCode = (int) wideValue;
6125 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6126 returnCode = JIM_OK;
6127 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6128 returnCode = JIM_ERR;
6129 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6130 returnCode = JIM_RETURN;
6131 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6132 returnCode = JIM_BREAK;
6133 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6134 returnCode = JIM_CONTINUE;
6135 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6136 returnCode = JIM_EVAL;
6137 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6138 returnCode = JIM_EXIT;
6139 else {
6140 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6141 Jim_AppendStrings(interp, Jim_GetResult(interp),
6142 "expected return code but got '", str, "'",
6143 NULL);
6144 return JIM_ERR;
6145 }
6146 /* Free the old internal repr and set the new one. */
6147 Jim_FreeIntRep(interp, objPtr);
6148 objPtr->typePtr = &returnCodeObjType;
6149 objPtr->internalRep.returnCode = returnCode;
6150 return JIM_OK;
6151 }
6152
6153 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6154 {
6155 if (objPtr->typePtr != &returnCodeObjType &&
6156 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6157 return JIM_ERR;
6158 *intPtr = objPtr->internalRep.returnCode;
6159 return JIM_OK;
6160 }
6161
6162 /* -----------------------------------------------------------------------------
6163 * Expression Parsing
6164 * ---------------------------------------------------------------------------*/
6165 static int JimParseExprOperator(struct JimParserCtx *pc);
6166 static int JimParseExprNumber(struct JimParserCtx *pc);
6167 static int JimParseExprIrrational(struct JimParserCtx *pc);
6168
6169 /* Exrp's Stack machine operators opcodes. */
6170
6171 /* Binary operators (numbers) */
6172 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6173 #define JIM_EXPROP_MUL 0
6174 #define JIM_EXPROP_DIV 1
6175 #define JIM_EXPROP_MOD 2
6176 #define JIM_EXPROP_SUB 3
6177 #define JIM_EXPROP_ADD 4
6178 #define JIM_EXPROP_LSHIFT 5
6179 #define JIM_EXPROP_RSHIFT 6
6180 #define JIM_EXPROP_ROTL 7
6181 #define JIM_EXPROP_ROTR 8
6182 #define JIM_EXPROP_LT 9
6183 #define JIM_EXPROP_GT 10
6184 #define JIM_EXPROP_LTE 11
6185 #define JIM_EXPROP_GTE 12
6186 #define JIM_EXPROP_NUMEQ 13
6187 #define JIM_EXPROP_NUMNE 14
6188 #define JIM_EXPROP_BITAND 15
6189 #define JIM_EXPROP_BITXOR 16
6190 #define JIM_EXPROP_BITOR 17
6191 #define JIM_EXPROP_LOGICAND 18
6192 #define JIM_EXPROP_LOGICOR 19
6193 #define JIM_EXPROP_LOGICAND_LEFT 20
6194 #define JIM_EXPROP_LOGICOR_LEFT 21
6195 #define JIM_EXPROP_POW 22
6196 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6197
6198 /* Binary operators (strings) */
6199 #define JIM_EXPROP_STREQ 23
6200 #define JIM_EXPROP_STRNE 24
6201
6202 /* Unary operators (numbers) */
6203 #define JIM_EXPROP_NOT 25
6204 #define JIM_EXPROP_BITNOT 26
6205 #define JIM_EXPROP_UNARYMINUS 27
6206 #define JIM_EXPROP_UNARYPLUS 28
6207 #define JIM_EXPROP_LOGICAND_RIGHT 29
6208 #define JIM_EXPROP_LOGICOR_RIGHT 30
6209
6210 /* Ternary operators */
6211 #define JIM_EXPROP_TERNARY 31
6212
6213 /* Operands */
6214 #define JIM_EXPROP_NUMBER 32
6215 #define JIM_EXPROP_COMMAND 33
6216 #define JIM_EXPROP_VARIABLE 34
6217 #define JIM_EXPROP_DICTSUGAR 35
6218 #define JIM_EXPROP_SUBST 36
6219 #define JIM_EXPROP_STRING 37
6220
6221 /* Operators table */
6222 typedef struct Jim_ExprOperator {
6223 const char *name;
6224 int precedence;
6225 int arity;
6226 int opcode;
6227 } Jim_ExprOperator;
6228
6229 /* name - precedence - arity - opcode */
6230 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6231 {"!", 300, 1, JIM_EXPROP_NOT},
6232 {"~", 300, 1, JIM_EXPROP_BITNOT},
6233 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6234 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6235
6236 {"**", 250, 2, JIM_EXPROP_POW},
6237
6238 {"*", 200, 2, JIM_EXPROP_MUL},
6239 {"/", 200, 2, JIM_EXPROP_DIV},
6240 {"%", 200, 2, JIM_EXPROP_MOD},
6241
6242 {"-", 100, 2, JIM_EXPROP_SUB},
6243 {"+", 100, 2, JIM_EXPROP_ADD},
6244
6245 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6246 {">>>", 90, 3, JIM_EXPROP_ROTR},
6247 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6248 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6249
6250 {"<", 80, 2, JIM_EXPROP_LT},
6251 {">", 80, 2, JIM_EXPROP_GT},
6252 {"<=", 80, 2, JIM_EXPROP_LTE},
6253 {">=", 80, 2, JIM_EXPROP_GTE},
6254
6255 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6256 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6257
6258 {"eq", 60, 2, JIM_EXPROP_STREQ},
6259 {"ne", 60, 2, JIM_EXPROP_STRNE},
6260
6261 {"&", 50, 2, JIM_EXPROP_BITAND},
6262 {"^", 49, 2, JIM_EXPROP_BITXOR},
6263 {"|", 48, 2, JIM_EXPROP_BITOR},
6264
6265 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6266 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6267
6268 {"?", 5, 3, JIM_EXPROP_TERNARY},
6269 /* private operators */
6270 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6271 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6272 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6273 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6274 };
6275
6276 #define JIM_EXPR_OPERATORS_NUM \
6277 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6278
6279 int JimParseExpression(struct JimParserCtx *pc)
6280 {
6281 /* Discard spaces and quoted newline */
6282 while (*(pc->p) == ' ' ||
6283 *(pc->p) == '\t' ||
6284 *(pc->p) == '\r' ||
6285 *(pc->p) == '\n' ||
6286 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6287 pc->p++; pc->len--;
6288 }
6289
6290 if (pc->len == 0) {
6291 pc->tstart = pc->tend = pc->p;
6292 pc->tline = pc->linenr;
6293 pc->tt = JIM_TT_EOL;
6294 pc->eof = 1;
6295 return JIM_OK;
6296 }
6297 switch (*(pc->p)) {
6298 case '(':
6299 pc->tstart = pc->tend = pc->p;
6300 pc->tline = pc->linenr;
6301 pc->tt = JIM_TT_SUBEXPR_START;
6302 pc->p++; pc->len--;
6303 break;
6304 case ')':
6305 pc->tstart = pc->tend = pc->p;
6306 pc->tline = pc->linenr;
6307 pc->tt = JIM_TT_SUBEXPR_END;
6308 pc->p++; pc->len--;
6309 break;
6310 case '[':
6311 return JimParseCmd(pc);
6312 break;
6313 case '$':
6314 if (JimParseVar(pc) == JIM_ERR)
6315 return JimParseExprOperator(pc);
6316 else
6317 return JIM_OK;
6318 break;
6319 case '-':
6320 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6321 isdigit((int)*(pc->p + 1)))
6322 return JimParseExprNumber(pc);
6323 else
6324 return JimParseExprOperator(pc);
6325 break;
6326 case '0': case '1': case '2': case '3': case '4':
6327 case '5': case '6': case '7': case '8': case '9': case '.':
6328 return JimParseExprNumber(pc);
6329 break;
6330 case '"':
6331 case '{':
6332 /* Here it's possible to reuse the List String parsing. */
6333 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6334 return JimParseListStr(pc);
6335 break;
6336 case 'N': case 'I':
6337 case 'n': case 'i':
6338 if (JimParseExprIrrational(pc) == JIM_ERR)
6339 return JimParseExprOperator(pc);
6340 break;
6341 default:
6342 return JimParseExprOperator(pc);
6343 break;
6344 }
6345 return JIM_OK;
6346 }
6347
6348 int JimParseExprNumber(struct JimParserCtx *pc)
6349 {
6350 int allowdot = 1;
6351 int allowhex = 0;
6352
6353 pc->tstart = pc->p;
6354 pc->tline = pc->linenr;
6355 if (*pc->p == '-') {
6356 pc->p++; pc->len--;
6357 }
6358 while (isdigit((int)*pc->p)
6359 || (allowhex && isxdigit((int)*pc->p))
6360 || (allowdot && *pc->p == '.')
6361 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6362 (*pc->p == 'x' || *pc->p == 'X'))
6363 )
6364 {
6365 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6366 allowhex = 1;
6367 allowdot = 0;
6368 }
6369 if (*pc->p == '.')
6370 allowdot = 0;
6371 pc->p++; pc->len--;
6372 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6373 pc->p += 2; pc->len -= 2;
6374 }
6375 }
6376 pc->tend = pc->p-1;
6377 pc->tt = JIM_TT_EXPR_NUMBER;
6378 return JIM_OK;
6379 }
6380
6381 int JimParseExprIrrational(struct JimParserCtx *pc)
6382 {
6383 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6384 const char **token;
6385 for (token = Tokens; *token != NULL; token++) {
6386 int len = strlen(*token);
6387 if (strncmp(*token, pc->p, len) == 0) {
6388 pc->tstart = pc->p;
6389 pc->tend = pc->p + len - 1;
6390 pc->p += len; pc->len -= len;
6391 pc->tline = pc->linenr;
6392 pc->tt = JIM_TT_EXPR_NUMBER;
6393 return JIM_OK;
6394 }
6395 }
6396 return JIM_ERR;
6397 }
6398
6399 int JimParseExprOperator(struct JimParserCtx *pc)
6400 {
6401 int i;
6402 int bestIdx = -1, bestLen = 0;
6403
6404 /* Try to get the longest match. */
6405 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6406 const char *opname;
6407 int oplen;
6408
6409 opname = Jim_ExprOperators[i].name;
6410 if (opname == NULL) continue;
6411 oplen = strlen(opname);
6412
6413 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6414 bestIdx = i;
6415 bestLen = oplen;
6416 }
6417 }
6418 if (bestIdx == -1) return JIM_ERR;
6419 pc->tstart = pc->p;
6420 pc->tend = pc->p + bestLen - 1;
6421 pc->p += bestLen; pc->len -= bestLen;
6422 pc->tline = pc->linenr;
6423 pc->tt = JIM_TT_EXPR_OPERATOR;
6424 return JIM_OK;
6425 }
6426
6427 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6428 {
6429 int i;
6430 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6431 if (Jim_ExprOperators[i].name &&
6432 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6433 return &Jim_ExprOperators[i];
6434 return NULL;
6435 }
6436
6437 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6438 {
6439 int i;
6440 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6441 if (Jim_ExprOperators[i].opcode == opcode)
6442 return &Jim_ExprOperators[i];
6443 return NULL;
6444 }
6445
6446 /* -----------------------------------------------------------------------------
6447 * Expression Object
6448 * ---------------------------------------------------------------------------*/
6449 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6450 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6451 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6452
6453 static Jim_ObjType exprObjType = {
6454 "expression",
6455 FreeExprInternalRep,
6456 DupExprInternalRep,
6457 NULL,
6458 JIM_TYPE_REFERENCES,
6459 };
6460
6461 /* Expr bytecode structure */
6462 typedef struct ExprByteCode {
6463 int *opcode; /* Integer array of opcodes. */
6464 Jim_Obj **obj; /* Array of associated Jim Objects. */
6465 int len; /* Bytecode length */
6466 int inUse; /* Used for sharing. */
6467 } ExprByteCode;
6468
6469 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6470 {
6471 int i;
6472 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6473
6474 expr->inUse--;
6475 if (expr->inUse != 0) return;
6476 for (i = 0; i < expr->len; i++)
6477 Jim_DecrRefCount(interp, expr->obj[i]);
6478 Jim_Free(expr->opcode);
6479 Jim_Free(expr->obj);
6480 Jim_Free(expr);
6481 }
6482
6483 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6484 {
6485 JIM_NOTUSED(interp);
6486 JIM_NOTUSED(srcPtr);
6487
6488 /* Just returns an simple string. */
6489 dupPtr->typePtr = NULL;
6490 }
6491
6492 /* Add a new instruction to an expression bytecode structure. */
6493 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6494 int opcode, char *str, int len)
6495 {
6496 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6497 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6498 expr->opcode[expr->len] = opcode;
6499 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6500 Jim_IncrRefCount(expr->obj[expr->len]);
6501 expr->len++;
6502 }
6503
6504 /* Check if an expr program looks correct. */
6505 static int ExprCheckCorrectness(ExprByteCode *expr)
6506 {
6507 int i;
6508 int stacklen = 0;
6509
6510 /* Try to check if there are stack underflows,
6511 * and make sure at the end of the program there is
6512 * a single result on the stack. */
6513 for (i = 0; i < expr->len; i++) {
6514 switch (expr->opcode[i]) {
6515 case JIM_EXPROP_NUMBER:
6516 case JIM_EXPROP_STRING:
6517 case JIM_EXPROP_SUBST:
6518 case JIM_EXPROP_VARIABLE:
6519 case JIM_EXPROP_DICTSUGAR:
6520 case JIM_EXPROP_COMMAND:
6521 stacklen++;
6522 break;
6523 case JIM_EXPROP_NOT:
6524 case JIM_EXPROP_BITNOT:
6525 case JIM_EXPROP_UNARYMINUS:
6526 case JIM_EXPROP_UNARYPLUS:
6527 /* Unary operations */
6528 if (stacklen < 1) return JIM_ERR;
6529 break;
6530 case JIM_EXPROP_ADD:
6531 case JIM_EXPROP_SUB:
6532 case JIM_EXPROP_MUL:
6533 case JIM_EXPROP_DIV:
6534 case JIM_EXPROP_MOD:
6535 case JIM_EXPROP_LT:
6536 case JIM_EXPROP_GT:
6537 case JIM_EXPROP_LTE:
6538 case JIM_EXPROP_GTE:
6539 case JIM_EXPROP_ROTL:
6540 case JIM_EXPROP_ROTR:
6541 case JIM_EXPROP_LSHIFT:
6542 case JIM_EXPROP_RSHIFT:
6543 case JIM_EXPROP_NUMEQ:
6544 case JIM_EXPROP_NUMNE:
6545 case JIM_EXPROP_STREQ:
6546 case JIM_EXPROP_STRNE:
6547 case JIM_EXPROP_BITAND:
6548 case JIM_EXPROP_BITXOR:
6549 case JIM_EXPROP_BITOR:
6550 case JIM_EXPROP_LOGICAND:
6551 case JIM_EXPROP_LOGICOR:
6552 case JIM_EXPROP_POW:
6553 /* binary operations */
6554 if (stacklen < 2) return JIM_ERR;
6555 stacklen--;
6556 break;
6557 default:
6558 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6559 break;
6560 }
6561 }
6562 if (stacklen != 1) return JIM_ERR;
6563 return JIM_OK;
6564 }
6565
6566 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6567 ScriptObj *topLevelScript)
6568 {
6569 int i;
6570
6571 return;
6572 for (i = 0; i < expr->len; i++) {
6573 Jim_Obj *foundObjPtr;
6574
6575 if (expr->obj[i] == NULL) continue;
6576 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6577 NULL, expr->obj[i]);
6578 if (foundObjPtr != NULL) {
6579 Jim_IncrRefCount(foundObjPtr);
6580 Jim_DecrRefCount(interp, expr->obj[i]);
6581 expr->obj[i] = foundObjPtr;
6582 }
6583 }
6584 }
6585
6586 /* This procedure converts every occurrence of || and && opereators
6587 * in lazy unary versions.
6588 *
6589 * a b || is converted into:
6590 *
6591 * a <offset> |L b |R
6592 *
6593 * a b && is converted into:
6594 *
6595 * a <offset> &L b &R
6596 *
6597 * "|L" checks if 'a' is true:
6598 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6599 * the opcode just after |R.
6600 * 2) if it is false does nothing.
6601 * "|R" checks if 'b' is true:
6602 * 1) if it is true pushes 1, otherwise pushes 0.
6603 *
6604 * "&L" checks if 'a' is true:
6605 * 1) if it is true does nothing.
6606 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6607 * the opcode just after &R
6608 * "&R" checks if 'a' is true:
6609 * if it is true pushes 1, otherwise pushes 0.
6610 */
6611 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6612 {
6613 while (1) {
6614 int index = -1, leftindex, arity, i, offset;
6615 Jim_ExprOperator *op;
6616
6617 /* Search for || or && */
6618 for (i = 0; i < expr->len; i++) {
6619 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6620 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6621 index = i;
6622 break;
6623 }
6624 }
6625 if (index == -1) return;
6626 /* Search for the end of the first operator */
6627 leftindex = index-1;
6628 arity = 1;
6629 while (arity) {
6630 switch (expr->opcode[leftindex]) {
6631 case JIM_EXPROP_NUMBER:
6632 case JIM_EXPROP_COMMAND:
6633 case JIM_EXPROP_VARIABLE:
6634 case JIM_EXPROP_DICTSUGAR:
6635 case JIM_EXPROP_SUBST:
6636 case JIM_EXPROP_STRING:
6637 break;
6638 default:
6639 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6640 if (op == NULL) {
6641 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6642 }
6643 arity += op->arity;
6644 break;
6645 }
6646 arity--;
6647 leftindex--;
6648 }
6649 leftindex++;
6650 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6651 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6652 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6653 sizeof(int)*(expr->len-leftindex));
6654 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6655 sizeof(Jim_Obj*)*(expr->len-leftindex));
6656 expr->len += 2;
6657 index += 2;
6658 offset = (index-leftindex)-1;
6659 Jim_DecrRefCount(interp, expr->obj[index]);
6660 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6661 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6662 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6663 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6664 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6665 } else {
6666 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6667 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6668 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6669 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6670 }
6671 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6672 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6673 Jim_IncrRefCount(expr->obj[index]);
6674 Jim_IncrRefCount(expr->obj[leftindex]);
6675 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6676 }
6677 }
6678
6679 /* This method takes the string representation of an expression
6680 * and generates a program for the Expr's stack-based VM. */
6681 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6682 {
6683 int exprTextLen;
6684 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6685 struct JimParserCtx parser;
6686 int i, shareLiterals;
6687 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6688 Jim_Stack stack;
6689 Jim_ExprOperator *op;
6690
6691 /* Perform literal sharing with the current procedure
6692 * running only if this expression appears to be not generated
6693 * at runtime. */
6694 shareLiterals = objPtr->typePtr == &sourceObjType;
6695
6696 expr->opcode = NULL;
6697 expr->obj = NULL;
6698 expr->len = 0;
6699 expr->inUse = 1;
6700
6701 Jim_InitStack(&stack);
6702 JimParserInit(&parser, exprText, exprTextLen, 1);
6703 while (!JimParserEof(&parser)) {
6704 char *token;
6705 int len, type;
6706
6707 if (JimParseExpression(&parser) != JIM_OK) {
6708 Jim_SetResultString(interp, "Syntax error in expression", -1);
6709 goto err;
6710 }
6711 token = JimParserGetToken(&parser, &len, &type, NULL);
6712 if (type == JIM_TT_EOL) {
6713 Jim_Free(token);
6714 break;
6715 }
6716 switch (type) {
6717 case JIM_TT_STR:
6718 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6719 break;
6720 case JIM_TT_ESC:
6721 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6722 break;
6723 case JIM_TT_VAR:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6725 break;
6726 case JIM_TT_DICTSUGAR:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6728 break;
6729 case JIM_TT_CMD:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6731 break;
6732 case JIM_TT_EXPR_NUMBER:
6733 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6734 break;
6735 case JIM_TT_EXPR_OPERATOR:
6736 op = JimExprOperatorInfo(token);
6737 while (1) {
6738 Jim_ExprOperator *stackTopOp;
6739
6740 if (Jim_StackPeek(&stack) != NULL) {
6741 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6742 } else {
6743 stackTopOp = NULL;
6744 }
6745 if (Jim_StackLen(&stack) && op->arity != 1 &&
6746 stackTopOp && stackTopOp->precedence >= op->precedence)
6747 {
6748 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6749 Jim_StackPeek(&stack), -1);
6750 Jim_StackPop(&stack);
6751 } else {
6752 break;
6753 }
6754 }
6755 Jim_StackPush(&stack, token);
6756 break;
6757 case JIM_TT_SUBEXPR_START:
6758 Jim_StackPush(&stack, Jim_StrDup("("));
6759 Jim_Free(token);
6760 break;
6761 case JIM_TT_SUBEXPR_END:
6762 {
6763 int found = 0;
6764 while (Jim_StackLen(&stack)) {
6765 char *opstr = Jim_StackPop(&stack);
6766 if (!strcmp(opstr, "(")) {
6767 Jim_Free(opstr);
6768 found = 1;
6769 break;
6770 }
6771 op = JimExprOperatorInfo(opstr);
6772 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6773 }
6774 if (!found) {
6775 Jim_SetResultString(interp,
6776 "Unexpected close parenthesis", -1);
6777 goto err;
6778 }
6779 }
6780 Jim_Free(token);
6781 break;
6782 default:
6783 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6784 break;
6785 }
6786 }
6787 while (Jim_StackLen(&stack)) {
6788 char *opstr = Jim_StackPop(&stack);
6789 op = JimExprOperatorInfo(opstr);
6790 if (op == NULL && !strcmp(opstr, "(")) {
6791 Jim_Free(opstr);
6792 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6793 goto err;
6794 }
6795 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6796 }
6797 /* Check program correctness. */
6798 if (ExprCheckCorrectness(expr) != JIM_OK) {
6799 Jim_SetResultString(interp, "Invalid expression", -1);
6800 goto err;
6801 }
6802
6803 /* Free the stack used for the compilation. */
6804 Jim_FreeStackElements(&stack, Jim_Free);
6805 Jim_FreeStack(&stack);
6806
6807 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6808 ExprMakeLazy(interp, expr);
6809
6810 /* Perform literal sharing */
6811 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6812 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6813 if (bodyObjPtr->typePtr == &scriptObjType) {
6814 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6815 ExprShareLiterals(interp, expr, bodyScript);
6816 }
6817 }
6818
6819 /* Free the old internal rep and set the new one. */
6820 Jim_FreeIntRep(interp, objPtr);
6821 Jim_SetIntRepPtr(objPtr, expr);
6822 objPtr->typePtr = &exprObjType;
6823 return JIM_OK;
6824
6825 err: /* we jump here on syntax/compile errors. */
6826 Jim_FreeStackElements(&stack, Jim_Free);
6827 Jim_FreeStack(&stack);
6828 Jim_Free(expr->opcode);
6829 for (i = 0; i < expr->len; i++) {
6830 Jim_DecrRefCount(interp,expr->obj[i]);
6831 }
6832 Jim_Free(expr->obj);
6833 Jim_Free(expr);
6834 return JIM_ERR;
6835 }
6836
6837 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6838 {
6839 if (objPtr->typePtr != &exprObjType) {
6840 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6841 return NULL;
6842 }
6843 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6844 }
6845
6846 /* -----------------------------------------------------------------------------
6847 * Expressions evaluation.
6848 * Jim uses a specialized stack-based virtual machine for expressions,
6849 * that takes advantage of the fact that expr's operators
6850 * can't be redefined.
6851 *
6852 * Jim_EvalExpression() uses the bytecode compiled by
6853 * SetExprFromAny() method of the "expression" object.
6854 *
6855 * On success a Tcl Object containing the result of the evaluation
6856 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6857 * returned.
6858 * On error the function returns a retcode != to JIM_OK and set a suitable
6859 * error on the interp.
6860 * ---------------------------------------------------------------------------*/
6861 #define JIM_EE_STATICSTACK_LEN 10
6862
6863 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6864 Jim_Obj **exprResultPtrPtr)
6865 {
6866 ExprByteCode *expr;
6867 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6868 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6869
6870 Jim_IncrRefCount(exprObjPtr);
6871 expr = Jim_GetExpression(interp, exprObjPtr);
6872 if (!expr) {
6873 Jim_DecrRefCount(interp, exprObjPtr);
6874 return JIM_ERR; /* error in expression. */
6875 }
6876 /* In order to avoid that the internal repr gets freed due to
6877 * shimmering of the exprObjPtr's object, we make the internal rep
6878 * shared. */
6879 expr->inUse++;
6880
6881 /* The stack-based expr VM itself */
6882
6883 /* Stack allocation. Expr programs have the feature that
6884 * a program of length N can't require a stack longer than
6885 * N. */
6886 if (expr->len > JIM_EE_STATICSTACK_LEN)
6887 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6888 else
6889 stack = staticStack;
6890
6891 /* Execute every istruction */
6892 for (i = 0; i < expr->len; i++) {
6893 Jim_Obj *A, *B, *objPtr;
6894 jim_wide wA, wB, wC;
6895 double dA, dB, dC;
6896 const char *sA, *sB;
6897 int Alen, Blen, retcode;
6898 int opcode = expr->opcode[i];
6899
6900 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6901 stack[stacklen++] = expr->obj[i];
6902 Jim_IncrRefCount(expr->obj[i]);
6903 } else if (opcode == JIM_EXPROP_VARIABLE) {
6904 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6905 if (objPtr == NULL) {
6906 error = 1;
6907 goto err;
6908 }
6909 stack[stacklen++] = objPtr;
6910 Jim_IncrRefCount(objPtr);
6911 } else if (opcode == JIM_EXPROP_SUBST) {
6912 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6913 &objPtr, JIM_NONE)) != JIM_OK)
6914 {
6915 error = 1;
6916 errRetCode = retcode;
6917 goto err;
6918 }
6919 stack[stacklen++] = objPtr;
6920 Jim_IncrRefCount(objPtr);
6921 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6922 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6923 if (objPtr == NULL) {
6924 error = 1;
6925 goto err;
6926 }
6927 stack[stacklen++] = objPtr;
6928 Jim_IncrRefCount(objPtr);
6929 } else if (opcode == JIM_EXPROP_COMMAND) {
6930 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6931 error = 1;
6932 errRetCode = retcode;
6933 goto err;
6934 }
6935 stack[stacklen++] = interp->result;
6936 Jim_IncrRefCount(interp->result);
6937 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6938 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6939 {
6940 /* Note that there isn't to increment the
6941 * refcount of objects. the references are moved
6942 * from stack to A and B. */
6943 B = stack[--stacklen];
6944 A = stack[--stacklen];
6945
6946 /* --- Integer --- */
6947 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6948 (B->typePtr == &doubleObjType && !B->bytes) ||
6949 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6950 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6951 goto trydouble;
6952 }
6953 Jim_DecrRefCount(interp, A);
6954 Jim_DecrRefCount(interp, B);
6955 switch (expr->opcode[i]) {
6956 case JIM_EXPROP_ADD: wC = wA + wB; break;
6957 case JIM_EXPROP_SUB: wC = wA-wB; break;
6958 case JIM_EXPROP_MUL: wC = wA*wB; break;
6959 case JIM_EXPROP_LT: wC = wA < wB; break;
6960 case JIM_EXPROP_GT: wC = wA > wB; break;
6961 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6962 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6963 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6964 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6965 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6966 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6967 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6968 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6969 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6970 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6971 case JIM_EXPROP_LOGICAND_LEFT:
6972 if (wA == 0) {
6973 i += (int)wB;
6974 wC = 0;
6975 } else {
6976 continue;
6977 }
6978 break;
6979 case JIM_EXPROP_LOGICOR_LEFT:
6980 if (wA != 0) {
6981 i += (int)wB;
6982 wC = 1;
6983 } else {
6984 continue;
6985 }
6986 break;
6987 case JIM_EXPROP_DIV:
6988 if (wB == 0) goto divbyzero;
6989 wC = wA/wB;
6990 break;
6991 case JIM_EXPROP_MOD:
6992 if (wB == 0) goto divbyzero;
6993 wC = wA%wB;
6994 break;
6995 case JIM_EXPROP_ROTL: {
6996 /* uint32_t would be better. But not everyone has inttypes.h?*/
6997 unsigned long uA = (unsigned long)wA;
6998 #ifdef _MSC_VER
6999 wC = _rotl(uA,(unsigned long)wB);
7000 #else
7001 const unsigned int S = sizeof(unsigned long) * 8;
7002 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7003 #endif
7004 break;
7005 }
7006 case JIM_EXPROP_ROTR: {
7007 unsigned long uA = (unsigned long)wA;
7008 #ifdef _MSC_VER
7009 wC = _rotr(uA,(unsigned long)wB);
7010 #else
7011 const unsigned int S = sizeof(unsigned long) * 8;
7012 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7013 #endif
7014 break;
7015 }
7016
7017 default:
7018 wC = 0; /* avoid gcc warning */
7019 break;
7020 }
7021 stack[stacklen] = Jim_NewIntObj(interp, wC);
7022 Jim_IncrRefCount(stack[stacklen]);
7023 stacklen++;
7024 continue;
7025 trydouble:
7026 /* --- Double --- */
7027 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7028 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7029
7030 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7031 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7032 opcode = JIM_EXPROP_STRNE;
7033 goto retry_as_string;
7034 }
7035 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7036 opcode = JIM_EXPROP_STREQ;
7037 goto retry_as_string;
7038 }
7039 Jim_DecrRefCount(interp, A);
7040 Jim_DecrRefCount(interp, B);
7041 error = 1;
7042 goto err;
7043 }
7044 Jim_DecrRefCount(interp, A);
7045 Jim_DecrRefCount(interp, B);
7046 switch (expr->opcode[i]) {
7047 case JIM_EXPROP_ROTL:
7048 case JIM_EXPROP_ROTR:
7049 case JIM_EXPROP_LSHIFT:
7050 case JIM_EXPROP_RSHIFT:
7051 case JIM_EXPROP_BITAND:
7052 case JIM_EXPROP_BITXOR:
7053 case JIM_EXPROP_BITOR:
7054 case JIM_EXPROP_MOD:
7055 case JIM_EXPROP_POW:
7056 Jim_SetResultString(interp,
7057 "Got floating-point value where integer was expected", -1);
7058 error = 1;
7059 goto err;
7060 break;
7061 case JIM_EXPROP_ADD: dC = dA + dB; break;
7062 case JIM_EXPROP_SUB: dC = dA-dB; break;
7063 case JIM_EXPROP_MUL: dC = dA*dB; break;
7064 case JIM_EXPROP_LT: dC = dA < dB; break;
7065 case JIM_EXPROP_GT: dC = dA > dB; break;
7066 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7067 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7068 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7069 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7070 case JIM_EXPROP_LOGICAND_LEFT:
7071 if (dA == 0) {
7072 i += (int)dB;
7073 dC = 0;
7074 } else {
7075 continue;
7076 }
7077 break;
7078 case JIM_EXPROP_LOGICOR_LEFT:
7079 if (dA != 0) {
7080 i += (int)dB;
7081 dC = 1;
7082 } else {
7083 continue;
7084 }
7085 break;
7086 case JIM_EXPROP_DIV:
7087 if (dB == 0) goto divbyzero;
7088 dC = dA/dB;
7089 break;
7090 default:
7091 dC = 0; /* avoid gcc warning */
7092 break;
7093 }
7094 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7095 Jim_IncrRefCount(stack[stacklen]);
7096 stacklen++;
7097 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7098 B = stack[--stacklen];
7099 A = stack[--stacklen];
7100 retry_as_string:
7101 sA = Jim_GetString(A, &Alen);
7102 sB = Jim_GetString(B, &Blen);
7103 switch (opcode) {
7104 case JIM_EXPROP_STREQ:
7105 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7106 wC = 1;
7107 else
7108 wC = 0;
7109 break;
7110 case JIM_EXPROP_STRNE:
7111 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7112 wC = 1;
7113 else
7114 wC = 0;
7115 break;
7116 default:
7117 wC = 0; /* avoid gcc warning */
7118 break;
7119 }
7120 Jim_DecrRefCount(interp, A);
7121 Jim_DecrRefCount(interp, B);
7122 stack[stacklen] = Jim_NewIntObj(interp, wC);
7123 Jim_IncrRefCount(stack[stacklen]);
7124 stacklen++;
7125 } else if (opcode == JIM_EXPROP_NOT ||
7126 opcode == JIM_EXPROP_BITNOT ||
7127 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7128 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7129 /* Note that there isn't to increment the
7130 * refcount of objects. the references are moved
7131 * from stack to A and B. */
7132 A = stack[--stacklen];
7133
7134 /* --- Integer --- */
7135 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7136 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7137 goto trydouble_unary;
7138 }
7139 Jim_DecrRefCount(interp, A);
7140 switch (expr->opcode[i]) {
7141 case JIM_EXPROP_NOT: wC = !wA; break;
7142 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7143 case JIM_EXPROP_LOGICAND_RIGHT:
7144 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7145 default:
7146 wC = 0; /* avoid gcc warning */
7147 break;
7148 }
7149 stack[stacklen] = Jim_NewIntObj(interp, wC);
7150 Jim_IncrRefCount(stack[stacklen]);
7151 stacklen++;
7152 continue;
7153 trydouble_unary:
7154 /* --- Double --- */
7155 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7156 Jim_DecrRefCount(interp, A);
7157 error = 1;
7158 goto err;
7159 }
7160 Jim_DecrRefCount(interp, A);
7161 switch (expr->opcode[i]) {
7162 case JIM_EXPROP_NOT: dC = !dA; break;
7163 case JIM_EXPROP_LOGICAND_RIGHT:
7164 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7165 case JIM_EXPROP_BITNOT:
7166 Jim_SetResultString(interp,
7167 "Got floating-point value where integer was expected", -1);
7168 error = 1;
7169 goto err;
7170 break;
7171 default:
7172 dC = 0; /* avoid gcc warning */
7173 break;
7174 }
7175 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7176 Jim_IncrRefCount(stack[stacklen]);
7177 stacklen++;
7178 } else {
7179 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7180 }
7181 }
7182 err:
7183 /* There is no need to decerement the inUse field because
7184 * this reference is transfered back into the exprObjPtr. */
7185 Jim_FreeIntRep(interp, exprObjPtr);
7186 exprObjPtr->typePtr = &exprObjType;
7187 Jim_SetIntRepPtr(exprObjPtr, expr);
7188 Jim_DecrRefCount(interp, exprObjPtr);
7189 if (!error) {
7190 *exprResultPtrPtr = stack[0];
7191 Jim_IncrRefCount(stack[0]);
7192 errRetCode = JIM_OK;
7193 }
7194 for (i = 0; i < stacklen; i++) {
7195 Jim_DecrRefCount(interp, stack[i]);
7196 }
7197 if (stack != staticStack)
7198 Jim_Free(stack);
7199 return errRetCode;
7200 divbyzero:
7201 error = 1;
7202 Jim_SetResultString(interp, "Division by zero", -1);
7203 goto err;
7204 }
7205
7206 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7207 {
7208 int retcode;
7209 jim_wide wideValue;
7210 double doubleValue;
7211 Jim_Obj *exprResultPtr;
7212
7213 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7214 if (retcode != JIM_OK)
7215 return retcode;
7216 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7217 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7218 {
7219 Jim_DecrRefCount(interp, exprResultPtr);
7220 return JIM_ERR;
7221 } else {
7222 Jim_DecrRefCount(interp, exprResultPtr);
7223 *boolPtr = doubleValue != 0;
7224 return JIM_OK;
7225 }
7226 }
7227 Jim_DecrRefCount(interp, exprResultPtr);
7228 *boolPtr = wideValue != 0;
7229 return JIM_OK;
7230 }
7231
7232 /* -----------------------------------------------------------------------------
7233 * ScanFormat String Object
7234 * ---------------------------------------------------------------------------*/
7235
7236 /* This Jim_Obj will held a parsed representation of a format string passed to
7237 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7238 * to be parsed in its entirely first and then, if correct, can be used for
7239 * scanning. To avoid endless re-parsing, the parsed representation will be
7240 * stored in an internal representation and re-used for performance reason. */
7241
7242 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7243 * scanformat string. This part will later be used to extract information
7244 * out from the string to be parsed by Jim_ScanString */
7245
7246 typedef struct ScanFmtPartDescr {
7247 char type; /* Type of conversion (e.g. c, d, f) */
7248 char modifier; /* Modify type (e.g. l - long, h - short */
7249 size_t width; /* Maximal width of input to be converted */
7250 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7251 char *arg; /* Specification of a CHARSET conversion */
7252 char *prefix; /* Prefix to be scanned literally before conversion */
7253 } ScanFmtPartDescr;
7254
7255 /* The ScanFmtStringObj will held the internal representation of a scanformat
7256 * string parsed and separated in part descriptions. Furthermore it contains
7257 * the original string representation of the scanformat string to allow for
7258 * fast update of the Jim_Obj's string representation part.
7259 *
7260 * As add-on the internal object representation add some scratch pad area
7261 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7262 * memory for purpose of string scanning.
7263 *
7264 * The error member points to a static allocated string in case of a mal-
7265 * formed scanformat string or it contains '0' (NULL) in case of a valid
7266 * parse representation.
7267 *
7268 * The whole memory of the internal representation is allocated as a single
7269 * area of memory that will be internally separated. So freeing and duplicating
7270 * of such an object is cheap */
7271
7272 typedef struct ScanFmtStringObj {
7273 jim_wide size; /* Size of internal repr in bytes */
7274 char *stringRep; /* Original string representation */
7275 size_t count; /* Number of ScanFmtPartDescr contained */
7276 size_t convCount; /* Number of conversions that will assign */
7277 size_t maxPos; /* Max position index if XPG3 is used */
7278 const char *error; /* Ptr to error text (NULL if no error */
7279 char *scratch; /* Some scratch pad used by Jim_ScanString */
7280 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7281 } ScanFmtStringObj;
7282
7283
7284 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7285 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7286 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7287
7288 static Jim_ObjType scanFmtStringObjType = {
7289 "scanformatstring",
7290 FreeScanFmtInternalRep,
7291 DupScanFmtInternalRep,
7292 UpdateStringOfScanFmt,
7293 JIM_TYPE_NONE,
7294 };
7295
7296 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7297 {
7298 JIM_NOTUSED(interp);
7299 Jim_Free((char*)objPtr->internalRep.ptr);
7300 objPtr->internalRep.ptr = 0;
7301 }
7302
7303 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7304 {
7305 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7306 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7307
7308 JIM_NOTUSED(interp);
7309 memcpy(newVec, srcPtr->internalRep.ptr, size);
7310 dupPtr->internalRep.ptr = newVec;
7311 dupPtr->typePtr = &scanFmtStringObjType;
7312 }
7313
7314 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7315 {
7316 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7317
7318 objPtr->bytes = Jim_StrDup(bytes);
7319 objPtr->length = strlen(bytes);
7320 }
7321
7322 /* SetScanFmtFromAny will parse a given string and create the internal
7323 * representation of the format specification. In case of an error
7324 * the error data member of the internal representation will be set
7325 * to an descriptive error text and the function will be left with
7326 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7327 * specification */
7328
7329 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7330 {
7331 ScanFmtStringObj *fmtObj;
7332 char *buffer;
7333 int maxCount, i, approxSize, lastPos = -1;
7334 const char *fmt = objPtr->bytes;
7335 int maxFmtLen = objPtr->length;
7336 const char *fmtEnd = fmt + maxFmtLen;
7337 int curr;
7338
7339 Jim_FreeIntRep(interp, objPtr);
7340 /* Count how many conversions could take place maximally */
7341 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7342 if (fmt[i] == '%')
7343 ++maxCount;
7344 /* Calculate an approximation of the memory necessary */
7345 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7346 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7347 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7348 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7349 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7350 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7351 + 1; /* safety byte */
7352 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7353 memset(fmtObj, 0, approxSize);
7354 fmtObj->size = approxSize;
7355 fmtObj->maxPos = 0;
7356 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7357 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7358 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7359 buffer = fmtObj->stringRep + maxFmtLen + 1;
7360 objPtr->internalRep.ptr = fmtObj;
7361 objPtr->typePtr = &scanFmtStringObjType;
7362 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7363 int width = 0, skip;
7364 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7365 fmtObj->count++;
7366 descr->width = 0; /* Assume width unspecified */
7367 /* Overread and store any "literal" prefix */
7368 if (*fmt != '%' || fmt[1] == '%') {
7369 descr->type = 0;
7370 descr->prefix = &buffer[i];
7371 for (; fmt < fmtEnd; ++fmt) {
7372 if (*fmt == '%') {
7373 if (fmt[1] != '%') break;
7374 ++fmt;
7375 }
7376 buffer[i++] = *fmt;
7377 }
7378 buffer[i++] = 0;
7379 }
7380 /* Skip the conversion introducing '%' sign */
7381 ++fmt;
7382 /* End reached due to non-conversion literal only? */
7383 if (fmt >= fmtEnd)
7384 goto done;
7385 descr->pos = 0; /* Assume "natural" positioning */
7386 if (*fmt == '*') {
7387 descr->pos = -1; /* Okay, conversion will not be assigned */
7388 ++fmt;
7389 } else
7390 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7391 /* Check if next token is a number (could be width or pos */
7392 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7393 fmt += skip;
7394 /* Was the number a XPG3 position specifier? */
7395 if (descr->pos != -1 && *fmt == '$') {
7396 int prev;
7397 ++fmt;
7398 descr->pos = width;
7399 width = 0;
7400 /* Look if "natural" postioning and XPG3 one was mixed */
7401 if ((lastPos == 0 && descr->pos > 0)
7402 || (lastPos > 0 && descr->pos == 0)) {
7403 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7404 return JIM_ERR;
7405 }
7406 /* Look if this position was already used */
7407 for (prev = 0; prev < curr; ++prev) {
7408 if (fmtObj->descr[prev].pos == -1) continue;
7409 if (fmtObj->descr[prev].pos == descr->pos) {
7410 fmtObj->error = "same \"%n$\" conversion specifier "
7411 "used more than once";
7412 return JIM_ERR;
7413 }
7414 }
7415 /* Try to find a width after the XPG3 specifier */
7416 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7417 descr->width = width;
7418 fmt += skip;
7419 }
7420 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7421 fmtObj->maxPos = descr->pos;
7422 } else {
7423 /* Number was not a XPG3, so it has to be a width */
7424 descr->width = width;
7425 }
7426 }
7427 /* If positioning mode was undetermined yet, fix this */
7428 if (lastPos == -1)
7429 lastPos = descr->pos;
7430 /* Handle CHARSET conversion type ... */
7431 if (*fmt == '[') {
7432 int swapped = 1, beg = i, end, j;
7433 descr->type = '[';
7434 descr->arg = &buffer[i];
7435 ++fmt;
7436 if (*fmt == '^') buffer[i++] = *fmt++;
7437 if (*fmt == ']') buffer[i++] = *fmt++;
7438 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7439 if (*fmt != ']') {
7440 fmtObj->error = "unmatched [ in format string";
7441 return JIM_ERR;
7442 }
7443 end = i;
7444 buffer[i++] = 0;
7445 /* In case a range fence was given "backwards", swap it */
7446 while (swapped) {
7447 swapped = 0;
7448 for (j = beg + 1; j < end-1; ++j) {
7449 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7450 char tmp = buffer[j-1];
7451 buffer[j-1] = buffer[j + 1];
7452 buffer[j + 1] = tmp;
7453 swapped = 1;
7454 }
7455 }
7456 }
7457 } else {
7458 /* Remember any valid modifier if given */
7459 if (strchr("hlL", *fmt) != 0)
7460 descr->modifier = tolower((int)*fmt++);
7461
7462 descr->type = *fmt;
7463 if (strchr("efgcsndoxui", *fmt) == 0) {
7464 fmtObj->error = "bad scan conversion character";
7465 return JIM_ERR;
7466 } else if (*fmt == 'c' && descr->width != 0) {
7467 fmtObj->error = "field width may not be specified in %c "
7468 "conversion";
7469 return JIM_ERR;
7470 } else if (*fmt == 'u' && descr->modifier == 'l') {
7471 fmtObj->error = "unsigned wide not supported";
7472 return JIM_ERR;
7473 }
7474 }
7475 curr++;
7476 }
7477 done:
7478 if (fmtObj->convCount == 0) {
7479 fmtObj->error = "no any conversion specifier given";
7480 return JIM_ERR;
7481 }
7482 return JIM_OK;
7483 }
7484
7485 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7486
7487 #define FormatGetCnvCount(_fo_) \
7488 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7489 #define FormatGetMaxPos(_fo_) \
7490 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7491 #define FormatGetError(_fo_) \
7492 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7493
7494 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7495 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7496 * bitvector implementation in Jim? */
7497
7498 static int JimTestBit(const char *bitvec, char ch)
7499 {
7500 div_t pos = div(ch-1, 8);
7501 return bitvec[pos.quot] & (1 << pos.rem);
7502 }
7503
7504 static void JimSetBit(char *bitvec, char ch)
7505 {
7506 div_t pos = div(ch-1, 8);
7507 bitvec[pos.quot] |= (1 << pos.rem);
7508 }
7509
7510 #if 0 /* currently not used */
7511 static void JimClearBit(char *bitvec, char ch)
7512 {
7513 div_t pos = div(ch-1, 8);
7514 bitvec[pos.quot] &= ~(1 << pos.rem);
7515 }
7516 #endif
7517
7518 /* JimScanAString is used to scan an unspecified string that ends with
7519 * next WS, or a string that is specified via a charset. The charset
7520 * is currently implemented in a way to only allow for usage with
7521 * ASCII. Whenever we will switch to UNICODE, another idea has to
7522 * be born :-/
7523 *
7524 * FIXME: Works only with ASCII */
7525
7526 static Jim_Obj *
7527 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7528 {
7529 size_t i;
7530 Jim_Obj *result;
7531 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7532 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7533
7534 /* First init charset to nothing or all, depending if a specified
7535 * or an unspecified string has to be parsed */
7536 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7537 if (sdescr) {
7538 /* There was a set description given, that means we are parsing
7539 * a specified string. So we have to build a corresponding
7540 * charset reflecting the description */
7541 int notFlag = 0;
7542 /* Should the set be negated at the end? */
7543 if (*sdescr == '^') {
7544 notFlag = 1;
7545 ++sdescr;
7546 }
7547 /* Here '-' is meant literally and not to define a range */
7548 if (*sdescr == '-') {
7549 JimSetBit(charset, '-');
7550 ++sdescr;
7551 }
7552 while (*sdescr) {
7553 if (sdescr[1] == '-' && sdescr[2] != 0) {
7554 /* Handle range definitions */
7555 int i;
7556 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7557 JimSetBit(charset, (char)i);
7558 sdescr += 3;
7559 } else {
7560 /* Handle verbatim character definitions */
7561 JimSetBit(charset, *sdescr++);
7562 }
7563 }
7564 /* Negate the charset if there was a NOT given */
7565 for (i = 0; notFlag && i < sizeof(charset); ++i)
7566 charset[i] = ~charset[i];
7567 }
7568 /* And after all the mess above, the real work begin ... */
7569 while (str && *str) {
7570 if (!sdescr && isspace((int)*str))
7571 break; /* EOS via WS if unspecified */
7572 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7573 else break; /* EOS via mismatch if specified scanning */
7574 }
7575 *buffer = 0; /* Close the string properly ... */
7576 result = Jim_NewStringObj(interp, anchor, -1);
7577 Jim_Free(anchor); /* ... and free it afer usage */
7578 return result;
7579 }
7580
7581 /* ScanOneEntry will scan one entry out of the string passed as argument.
7582 * It use the sscanf() function for this task. After extracting and
7583 * converting of the value, the count of scanned characters will be
7584 * returned of -1 in case of no conversion tool place and string was
7585 * already scanned thru */
7586
7587 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7588 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7589 {
7590 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7591 ? sizeof(jim_wide) \
7592 : sizeof(double))
7593 char buffer[MAX_SIZE];
7594 char *value = buffer;
7595 const char *tok;
7596 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7597 size_t sLen = strlen(&str[pos]), scanned = 0;
7598 size_t anchor = pos;
7599 int i;
7600
7601 /* First pessimiticly assume, we will not scan anything :-) */
7602 *valObjPtr = 0;
7603 if (descr->prefix) {
7604 /* There was a prefix given before the conversion, skip it and adjust
7605 * the string-to-be-parsed accordingly */
7606 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7607 /* If prefix require, skip WS */
7608 if (isspace((int)descr->prefix[i]))
7609 while (str[pos] && isspace((int)str[pos])) ++pos;
7610 else if (descr->prefix[i] != str[pos])
7611 break; /* Prefix do not match here, leave the loop */
7612 else
7613 ++pos; /* Prefix matched so far, next round */
7614 }
7615 if (str[pos] == 0)
7616 return -1; /* All of str consumed: EOF condition */
7617 else if (descr->prefix[i] != 0)
7618 return 0; /* Not whole prefix consumed, no conversion possible */
7619 }
7620 /* For all but following conversion, skip leading WS */
7621 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7622 while (isspace((int)str[pos])) ++pos;
7623 /* Determine how much skipped/scanned so far */
7624 scanned = pos - anchor;
7625 if (descr->type == 'n') {
7626 /* Return pseudo conversion means: how much scanned so far? */
7627 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7628 } else if (str[pos] == 0) {
7629 /* Cannot scan anything, as str is totally consumed */
7630 return -1;
7631 } else {
7632 /* Processing of conversions follows ... */
7633 if (descr->width > 0) {
7634 /* Do not try to scan as fas as possible but only the given width.
7635 * To ensure this, we copy the part that should be scanned. */
7636 size_t tLen = descr->width > sLen ? sLen : descr->width;
7637 tok = Jim_StrDupLen(&str[pos], tLen);
7638 } else {
7639 /* As no width was given, simply refer to the original string */
7640 tok = &str[pos];
7641 }
7642 switch (descr->type) {
7643 case 'c':
7644 *valObjPtr = Jim_NewIntObj(interp, *tok);
7645 scanned += 1;
7646 break;
7647 case 'd': case 'o': case 'x': case 'u': case 'i': {
7648 jim_wide jwvalue = 0;
7649 long lvalue = 0;
7650 char *endp; /* Position where the number finished */
7651 int base = descr->type == 'o' ? 8
7652 : descr->type == 'x' ? 16
7653 : descr->type == 'i' ? 0
7654 : 10;
7655
7656 do {
7657 /* Try to scan a number with the given base */
7658 if (descr->modifier == 'l')
7659 {
7660 #ifdef HAVE_LONG_LONG_INT
7661 jwvalue = JimStrtoll(tok, &endp, base),
7662 #else
7663 jwvalue = strtol(tok, &endp, base),
7664 #endif
7665 memcpy(value, &jwvalue, sizeof(jim_wide));
7666 }
7667 else
7668 {
7669 if (descr->type == 'u')
7670 lvalue = strtoul(tok, &endp, base);
7671 else
7672 lvalue = strtol(tok, &endp, base);
7673 memcpy(value, &lvalue, sizeof(lvalue));
7674 }
7675 /* If scanning failed, and base was undetermined, simply
7676 * put it to 10 and try once more. This should catch the
7677 * case where %i begin to parse a number prefix (e.g.
7678 * '0x' but no further digits follows. This will be
7679 * handled as a ZERO followed by a char 'x' by Tcl */
7680 if (endp == tok && base == 0) base = 10;
7681 else break;
7682 } while (1);
7683 if (endp != tok) {
7684 /* There was some number sucessfully scanned! */
7685 if (descr->modifier == 'l')
7686 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7687 else
7688 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7689 /* Adjust the number-of-chars scanned so far */
7690 scanned += endp - tok;
7691 } else {
7692 /* Nothing was scanned. We have to determine if this
7693 * happened due to e.g. prefix mismatch or input str
7694 * exhausted */
7695 scanned = *tok ? 0 : -1;
7696 }
7697 break;
7698 }
7699 case 's': case '[': {
7700 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7701 scanned += Jim_Length(*valObjPtr);
7702 break;
7703 }
7704 case 'e': case 'f': case 'g': {
7705 char *endp;
7706
7707 double dvalue = strtod(tok, &endp);
7708 memcpy(value, &dvalue, sizeof(double));
7709 if (endp != tok) {
7710 /* There was some number sucessfully scanned! */
7711 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7712 /* Adjust the number-of-chars scanned so far */
7713 scanned += endp - tok;
7714 } else {
7715 /* Nothing was scanned. We have to determine if this
7716 * happened due to e.g. prefix mismatch or input str
7717 * exhausted */
7718 scanned = *tok ? 0 : -1;
7719 }
7720 break;
7721 }
7722 }
7723 /* If a substring was allocated (due to pre-defined width) do not
7724 * forget to free it */
7725 if (tok != &str[pos])
7726 Jim_Free((char*)tok);
7727 }
7728 return scanned;
7729 }
7730
7731 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7732 * string and returns all converted (and not ignored) values in a list back
7733 * to the caller. If an error occured, a NULL pointer will be returned */
7734
7735 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7736 Jim_Obj *fmtObjPtr, int flags)
7737 {
7738 size_t i, pos;
7739 int scanned = 1;
7740 const char *str = Jim_GetString(strObjPtr, 0);
7741 Jim_Obj *resultList = 0;
7742 Jim_Obj **resultVec =NULL;
7743 int resultc;
7744 Jim_Obj *emptyStr = 0;
7745 ScanFmtStringObj *fmtObj;
7746
7747 /* If format specification is not an object, convert it! */
7748 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7749 SetScanFmtFromAny(interp, fmtObjPtr);
7750 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7751 /* Check if format specification was valid */
7752 if (fmtObj->error != 0) {
7753 if (flags & JIM_ERRMSG)
7754 Jim_SetResultString(interp, fmtObj->error, -1);
7755 return 0;
7756 }
7757 /* Allocate a new "shared" empty string for all unassigned conversions */
7758 emptyStr = Jim_NewEmptyStringObj(interp);
7759 Jim_IncrRefCount(emptyStr);
7760 /* Create a list and fill it with empty strings up to max specified XPG3 */
7761 resultList = Jim_NewListObj(interp, 0, 0);
7762 if (fmtObj->maxPos > 0) {
7763 for (i = 0; i < fmtObj->maxPos; ++i)
7764 Jim_ListAppendElement(interp, resultList, emptyStr);
7765 JimListGetElements(interp, resultList, &resultc, &resultVec);
7766 }
7767 /* Now handle every partial format description */
7768 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7769 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7770 Jim_Obj *value = 0;
7771 /* Only last type may be "literal" w/o conversion - skip it! */
7772 if (descr->type == 0) continue;
7773 /* As long as any conversion could be done, we will proceed */
7774 if (scanned > 0)
7775 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7776 /* In case our first try results in EOF, we will leave */
7777 if (scanned == -1 && i == 0)
7778 goto eof;
7779 /* Advance next pos-to-be-scanned for the amount scanned already */
7780 pos += scanned;
7781 /* value == 0 means no conversion took place so take empty string */
7782 if (value == 0)
7783 value = Jim_NewEmptyStringObj(interp);
7784 /* If value is a non-assignable one, skip it */
7785 if (descr->pos == -1) {
7786 Jim_FreeNewObj(interp, value);
7787 } else if (descr->pos == 0)
7788 /* Otherwise append it to the result list if no XPG3 was given */
7789 Jim_ListAppendElement(interp, resultList, value);
7790 else if (resultVec[descr->pos-1] == emptyStr) {
7791 /* But due to given XPG3, put the value into the corr. slot */
7792 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7793 Jim_IncrRefCount(value);
7794 resultVec[descr->pos-1] = value;
7795 } else {
7796 /* Otherwise, the slot was already used - free obj and ERROR */
7797 Jim_FreeNewObj(interp, value);
7798 goto err;
7799 }
7800 }
7801 Jim_DecrRefCount(interp, emptyStr);
7802 return resultList;
7803 eof:
7804 Jim_DecrRefCount(interp, emptyStr);
7805 Jim_FreeNewObj(interp, resultList);
7806 return (Jim_Obj*)EOF;
7807 err:
7808 Jim_DecrRefCount(interp, emptyStr);
7809 Jim_FreeNewObj(interp, resultList);
7810 return 0;
7811 }
7812
7813 /* -----------------------------------------------------------------------------
7814 * Pseudo Random Number Generation
7815 * ---------------------------------------------------------------------------*/
7816 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7817 int seedLen);
7818
7819 /* Initialize the sbox with the numbers from 0 to 255 */
7820 static void JimPrngInit(Jim_Interp *interp)
7821 {
7822 int i;
7823 unsigned int seed[256];
7824
7825 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7826 for (i = 0; i < 256; i++)
7827 seed[i] = (rand() ^ time(NULL) ^ clock());
7828 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7829 }
7830
7831 /* Generates N bytes of random data */
7832 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7833 {
7834 Jim_PrngState *prng;
7835 unsigned char *destByte = (unsigned char*) dest;
7836 unsigned int si, sj, x;
7837
7838 /* initialization, only needed the first time */
7839 if (interp->prngState == NULL)
7840 JimPrngInit(interp);
7841 prng = interp->prngState;
7842 /* generates 'len' bytes of pseudo-random numbers */
7843 for (x = 0; x < len; x++) {
7844 prng->i = (prng->i + 1) & 0xff;
7845 si = prng->sbox[prng->i];
7846 prng->j = (prng->j + si) & 0xff;
7847 sj = prng->sbox[prng->j];
7848 prng->sbox[prng->i] = sj;
7849 prng->sbox[prng->j] = si;
7850 *destByte++ = prng->sbox[(si + sj)&0xff];
7851 }
7852 }
7853
7854 /* Re-seed the generator with user-provided bytes */
7855 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7856 int seedLen)
7857 {
7858 int i;
7859 unsigned char buf[256];
7860 Jim_PrngState *prng;
7861
7862 /* initialization, only needed the first time */
7863 if (interp->prngState == NULL)
7864 JimPrngInit(interp);
7865 prng = interp->prngState;
7866
7867 /* Set the sbox[i] with i */
7868 for (i = 0; i < 256; i++)
7869 prng->sbox[i] = i;
7870 /* Now use the seed to perform a random permutation of the sbox */
7871 for (i = 0; i < seedLen; i++) {
7872 unsigned char t;
7873
7874 t = prng->sbox[i&0xFF];
7875 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7876 prng->sbox[seed[i]] = t;
7877 }
7878 prng->i = prng->j = 0;
7879 /* discard the first 256 bytes of stream. */
7880 JimRandomBytes(interp, buf, 256);
7881 }
7882
7883 /* -----------------------------------------------------------------------------
7884 * Dynamic libraries support (WIN32 not supported)
7885 * ---------------------------------------------------------------------------*/
7886
7887 #ifdef JIM_DYNLIB
7888 #ifdef WIN32
7889 #define RTLD_LAZY 0
7890 void * dlopen(const char *path, int mode)
7891 {
7892 JIM_NOTUSED(mode);
7893
7894 return (void *)LoadLibraryA(path);
7895 }
7896 int dlclose(void *handle)
7897 {
7898 FreeLibrary((HANDLE)handle);
7899 return 0;
7900 }
7901 void *dlsym(void *handle, const char *symbol)
7902 {
7903 return GetProcAddress((HMODULE)handle, symbol);
7904 }
7905 static char win32_dlerror_string[121];
7906 const char *dlerror(void)
7907 {
7908 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7909 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7910 return win32_dlerror_string;
7911 }
7912 #endif /* WIN32 */
7913
7914 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7915 {
7916 Jim_Obj *libPathObjPtr;
7917 int prefixc, i;
7918 void *handle;
7919 int (*onload)(Jim_Interp *interp);
7920
7921 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7922 if (libPathObjPtr == NULL) {
7923 prefixc = 0;
7924 libPathObjPtr = NULL;
7925 } else {
7926 Jim_IncrRefCount(libPathObjPtr);
7927 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7928 }
7929
7930 for (i = -1; i < prefixc; i++) {
7931 if (i < 0) {
7932 handle = dlopen(pathName, RTLD_LAZY);
7933 } else {
7934 FILE *fp;
7935 char buf[JIM_PATH_LEN];
7936 const char *prefix;
7937 int prefixlen;
7938 Jim_Obj *prefixObjPtr;
7939
7940 buf[0] = '\0';
7941 if (Jim_ListIndex(interp, libPathObjPtr, i,
7942 &prefixObjPtr, JIM_NONE) != JIM_OK)
7943 continue;
7944 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7945 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7946 continue;
7947 if (*pathName == '/') {
7948 strcpy(buf, pathName);
7949 }
7950 else if (prefixlen && prefix[prefixlen-1] == '/')
7951 sprintf(buf, "%s%s", prefix, pathName);
7952 else
7953 sprintf(buf, "%s/%s", prefix, pathName);
7954 fp = fopen(buf, "r");
7955 if (fp == NULL)
7956 continue;
7957 fclose(fp);
7958 handle = dlopen(buf, RTLD_LAZY);
7959 }
7960 if (handle == NULL) {
7961 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7962 Jim_AppendStrings(interp, Jim_GetResult(interp),
7963 "error loading extension \"", pathName,
7964 "\": ", dlerror(), NULL);
7965 if (i < 0)
7966 continue;
7967 goto err;
7968 }
7969 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7970 Jim_SetResultString(interp,
7971 "No Jim_OnLoad symbol found on extension", -1);
7972 goto err;
7973 }
7974 if (onload(interp) == JIM_ERR) {
7975 dlclose(handle);
7976 goto err;
7977 }
7978 Jim_SetEmptyResult(interp);
7979 if (libPathObjPtr != NULL)
7980 Jim_DecrRefCount(interp, libPathObjPtr);
7981 return JIM_OK;
7982 }
7983 err:
7984 if (libPathObjPtr != NULL)
7985 Jim_DecrRefCount(interp, libPathObjPtr);
7986 return JIM_ERR;
7987 }
7988 #else /* JIM_DYNLIB */
7989 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7990 {
7991 JIM_NOTUSED(interp);
7992 JIM_NOTUSED(pathName);
7993
7994 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7995 return JIM_ERR;
7996 }
7997 #endif/* JIM_DYNLIB */
7998
7999 /* -----------------------------------------------------------------------------
8000 * Packages handling
8001 * ---------------------------------------------------------------------------*/
8002
8003 #define JIM_PKG_ANY_VERSION -1
8004
8005 /* Convert a string of the type "1.2" into an integer.
8006 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8007 * to the integer with value 102 */
8008 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8009 int *intPtr, int flags)
8010 {
8011 char *copy;
8012 jim_wide major, minor;
8013 char *majorStr, *minorStr, *p;
8014
8015 if (v[0] == '\0') {
8016 *intPtr = JIM_PKG_ANY_VERSION;
8017 return JIM_OK;
8018 }
8019
8020 copy = Jim_StrDup(v);
8021 p = strchr(copy, '.');
8022 if (p == NULL) goto badfmt;
8023 *p = '\0';
8024 majorStr = copy;
8025 minorStr = p + 1;
8026
8027 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8028 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8029 goto badfmt;
8030 *intPtr = (int)(major*100 + minor);
8031 Jim_Free(copy);
8032 return JIM_OK;
8033
8034 badfmt:
8035 Jim_Free(copy);
8036 if (flags & JIM_ERRMSG) {
8037 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8038 Jim_AppendStrings(interp, Jim_GetResult(interp),
8039 "invalid package version '", v, "'", NULL);
8040 }
8041 return JIM_ERR;
8042 }
8043
8044 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8045 static int JimPackageMatchVersion(int needed, int actual, int flags)
8046 {
8047 if (needed == JIM_PKG_ANY_VERSION) return 1;
8048 if (flags & JIM_MATCHVER_EXACT) {
8049 return needed == actual;
8050 } else {
8051 return needed/100 == actual/100 && (needed <= actual);
8052 }
8053 }
8054
8055 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8056 int flags)
8057 {
8058 int intVersion;
8059 /* Check if the version format is ok */
8060 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8061 return JIM_ERR;
8062 /* If the package was already provided returns an error. */
8063 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8064 if (flags & JIM_ERRMSG) {
8065 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8066 Jim_AppendStrings(interp, Jim_GetResult(interp),
8067 "package '", name, "' was already provided", NULL);
8068 }
8069 return JIM_ERR;
8070 }
8071 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8072 return JIM_OK;
8073 }
8074
8075 #ifndef JIM_ANSIC
8076
8077 #ifndef WIN32
8078 # include <sys/types.h>
8079 # include <dirent.h>
8080 #else
8081 # include <io.h>
8082 /* Posix dirent.h compatiblity layer for WIN32.
8083 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8084 * Copyright Salvatore Sanfilippo ,2005.
8085 *
8086 * Permission to use, copy, modify, and distribute this software and its
8087 * documentation for any purpose is hereby granted without fee, provided
8088 * that this copyright and permissions notice appear in all copies and
8089 * derivatives.
8090 *
8091 * This software is supplied "as is" without express or implied warranty.
8092 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8093 */
8094
8095 struct dirent {
8096 char *d_name;
8097 };
8098
8099 typedef struct DIR {
8100 long handle; /* -1 for failed rewind */
8101 struct _finddata_t info;
8102 struct dirent result; /* d_name null iff first time */
8103 char *name; /* null-terminated char string */
8104 } DIR;
8105
8106 DIR *opendir(const char *name)
8107 {
8108 DIR *dir = 0;
8109
8110 if (name && name[0]) {
8111 size_t base_length = strlen(name);
8112 const char *all = /* search pattern must end with suitable wildcard */
8113 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8114
8115 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8116 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8117 {
8118 strcat(strcpy(dir->name, name), all);
8119
8120 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8121 dir->result.d_name = 0;
8122 else { /* rollback */
8123 Jim_Free(dir->name);
8124 Jim_Free(dir);
8125 dir = 0;
8126 }
8127 } else { /* rollback */
8128 Jim_Free(dir);
8129 dir = 0;
8130 errno = ENOMEM;
8131 }
8132 } else {
8133 errno = EINVAL;
8134 }
8135 return dir;
8136 }
8137
8138 int closedir(DIR *dir)
8139 {
8140 int result = -1;
8141
8142 if (dir) {
8143 if (dir->handle != -1)
8144 result = _findclose(dir->handle);
8145 Jim_Free(dir->name);
8146 Jim_Free(dir);
8147 }
8148 if (result == -1) /* map all errors to EBADF */
8149 errno = EBADF;
8150 return result;
8151 }
8152
8153 struct dirent *readdir(DIR *dir)
8154 {
8155 struct dirent *result = 0;
8156
8157 if (dir && dir->handle != -1) {
8158 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8159 result = &dir->result;
8160 result->d_name = dir->info.name;
8161 }
8162 } else {
8163 errno = EBADF;
8164 }
8165 return result;
8166 }
8167
8168 #endif /* WIN32 */
8169
8170 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8171 int prefixc, const char *pkgName, int pkgVer, int flags)
8172 {
8173 int bestVer = -1, i;
8174 int pkgNameLen = strlen(pkgName);
8175 char *bestPackage = NULL;
8176 struct dirent *de;
8177
8178 for (i = 0; i < prefixc; i++) {
8179 DIR *dir;
8180 char buf[JIM_PATH_LEN];
8181 int prefixLen;
8182
8183 if (prefixes[i] == NULL) continue;
8184 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8185 buf[JIM_PATH_LEN-1] = '\0';
8186 prefixLen = strlen(buf);
8187 if (prefixLen && buf[prefixLen-1] == '/')
8188 buf[prefixLen-1] = '\0';
8189
8190 if ((dir = opendir(buf)) == NULL) continue;
8191 while ((de = readdir(dir)) != NULL) {
8192 char *fileName = de->d_name;
8193 int fileNameLen = strlen(fileName);
8194
8195 if (strncmp(fileName, "jim-", 4) == 0 &&
8196 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8197 *(fileName + 4+pkgNameLen) == '-' &&
8198 fileNameLen > 4 && /* note that this is not really useful */
8199 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8200 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8201 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8202 {
8203 char ver[6]; /* xx.yy < nulterm> */
8204 char *p = strrchr(fileName, '.');
8205 int verLen, fileVer;
8206
8207 verLen = p - (fileName + 4+pkgNameLen + 1);
8208 if (verLen < 3 || verLen > 5) continue;
8209 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8210 ver[verLen] = '\0';
8211 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8212 != JIM_OK) continue;
8213 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8214 (bestVer == -1 || bestVer < fileVer))
8215 {
8216 bestVer = fileVer;
8217 Jim_Free(bestPackage);
8218 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8219 sprintf(bestPackage, "%s/%s", buf, fileName);
8220 }
8221 }
8222 }
8223 closedir(dir);
8224 }
8225 return bestPackage;
8226 }
8227
8228 #else /* JIM_ANSIC */
8229
8230 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8231 int prefixc, const char *pkgName, int pkgVer, int flags)
8232 {
8233 JIM_NOTUSED(interp);
8234 JIM_NOTUSED(prefixes);
8235 JIM_NOTUSED(prefixc);
8236 JIM_NOTUSED(pkgName);
8237 JIM_NOTUSED(pkgVer);
8238 JIM_NOTUSED(flags);
8239 return NULL;
8240 }
8241
8242 #endif /* JIM_ANSIC */
8243
8244 /* Search for a suitable package under every dir specified by jim_libpath
8245 * and load it if possible. If a suitable package was loaded with success
8246 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8247 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8248 int flags)
8249 {
8250 Jim_Obj *libPathObjPtr;
8251 char **prefixes, *best;
8252 int prefixc, i, retCode = JIM_OK;
8253
8254 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8255 if (libPathObjPtr == NULL) {
8256 prefixc = 0;
8257 libPathObjPtr = NULL;
8258 } else {
8259 Jim_IncrRefCount(libPathObjPtr);
8260 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8261 }
8262
8263 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8264 for (i = 0; i < prefixc; i++) {
8265 Jim_Obj *prefixObjPtr;
8266 if (Jim_ListIndex(interp, libPathObjPtr, i,
8267 &prefixObjPtr, JIM_NONE) != JIM_OK)
8268 {
8269 prefixes[i] = NULL;
8270 continue;
8271 }
8272 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8273 }
8274 /* Scan every directory to find the "best" package. */
8275 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8276 if (best != NULL) {
8277 char *p = strrchr(best, '.');
8278 /* Try to load/source it */
8279 if (p && strcmp(p, ".tcl") == 0) {
8280 retCode = Jim_EvalFile(interp, best);
8281 } else {
8282 retCode = Jim_LoadLibrary(interp, best);
8283 }
8284 } else {
8285 retCode = JIM_ERR;
8286 }
8287 Jim_Free(best);
8288 for (i = 0; i < prefixc; i++)
8289 Jim_Free(prefixes[i]);
8290 Jim_Free(prefixes);
8291 if (libPathObjPtr)
8292 Jim_DecrRefCount(interp, libPathObjPtr);
8293 return retCode;
8294 }
8295
8296 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8297 const char *ver, int flags)
8298 {
8299 Jim_HashEntry *he;
8300 int requiredVer;
8301
8302 /* Start with an empty error string */
8303 Jim_SetResultString(interp, "", 0);
8304
8305 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8306 return NULL;
8307 he = Jim_FindHashEntry(&interp->packages, name);
8308 if (he == NULL) {
8309 /* Try to load the package. */
8310 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8311 he = Jim_FindHashEntry(&interp->packages, name);
8312 if (he == NULL) {
8313 return "?";
8314 }
8315 return he->val;
8316 }
8317 /* No way... return an error. */
8318 if (flags & JIM_ERRMSG) {
8319 int len;
8320 Jim_GetString(Jim_GetResult(interp), &len);
8321 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8322 "Can't find package '", name, "'", NULL);
8323 }
8324 return NULL;
8325 } else {
8326 int actualVer;
8327 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8328 != JIM_OK)
8329 {
8330 return NULL;
8331 }
8332 /* Check if version matches. */
8333 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8334 Jim_AppendStrings(interp, Jim_GetResult(interp),
8335 "Package '", name, "' already loaded, but with version ",
8336 he->val, NULL);
8337 return NULL;
8338 }
8339 return he->val;
8340 }
8341 }
8342
8343 /* -----------------------------------------------------------------------------
8344 * Eval
8345 * ---------------------------------------------------------------------------*/
8346 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8347 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8348
8349 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8350 Jim_Obj *const *argv);
8351
8352 /* Handle calls to the [unknown] command */
8353 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8354 {
8355 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8356 int retCode;
8357
8358 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8359 * done here
8360 */
8361 if (interp->unknown_called) {
8362 return JIM_ERR;
8363 }
8364
8365 /* If the [unknown] command does not exists returns
8366 * just now */
8367 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8368 return JIM_ERR;
8369
8370 /* The object interp->unknown just contains
8371 * the "unknown" string, it is used in order to
8372 * avoid to lookup the unknown command every time
8373 * but instread to cache the result. */
8374 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8375 v = sv;
8376 else
8377 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8378 /* Make a copy of the arguments vector, but shifted on
8379 * the right of one position. The command name of the
8380 * command will be instead the first argument of the
8381 * [unknonw] call. */
8382 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8383 v[0] = interp->unknown;
8384 /* Call it */
8385 interp->unknown_called++;
8386 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8387 interp->unknown_called--;
8388
8389 /* Clean up */
8390 if (v != sv)
8391 Jim_Free(v);
8392 return retCode;
8393 }
8394
8395 /* Eval the object vector 'objv' composed of 'objc' elements.
8396 * Every element is used as single argument.
8397 * Jim_EvalObj() will call this function every time its object
8398 * argument is of "list" type, with no string representation.
8399 *
8400 * This is possible because the string representation of a
8401 * list object generated by the UpdateStringOfList is made
8402 * in a way that ensures that every list element is a different
8403 * command argument. */
8404 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8405 {
8406 int i, retcode;
8407 Jim_Cmd *cmdPtr;
8408
8409 /* Incr refcount of arguments. */
8410 for (i = 0; i < objc; i++)
8411 Jim_IncrRefCount(objv[i]);
8412 /* Command lookup */
8413 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8414 if (cmdPtr == NULL) {
8415 retcode = JimUnknown(interp, objc, objv);
8416 } else {
8417 /* Call it -- Make sure result is an empty object. */
8418 Jim_SetEmptyResult(interp);
8419 if (cmdPtr->cmdProc) {
8420 interp->cmdPrivData = cmdPtr->privData;
8421 retcode = cmdPtr->cmdProc(interp, objc, objv);
8422 if (retcode == JIM_ERR_ADDSTACK) {
8423 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8424 retcode = JIM_ERR;
8425 }
8426 } else {
8427 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8428 if (retcode == JIM_ERR) {
8429 JimAppendStackTrace(interp,
8430 Jim_GetString(objv[0], NULL), "", 1);
8431 }
8432 }
8433 }
8434 /* Decr refcount of arguments and return the retcode */
8435 for (i = 0; i < objc; i++)
8436 Jim_DecrRefCount(interp, objv[i]);
8437 return retcode;
8438 }
8439
8440 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8441 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8442 * The returned object has refcount = 0. */
8443 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8444 int tokens, Jim_Obj **objPtrPtr)
8445 {
8446 int totlen = 0, i, retcode;
8447 Jim_Obj **intv;
8448 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8449 Jim_Obj *objPtr;
8450 char *s;
8451
8452 if (tokens <= JIM_EVAL_SINTV_LEN)
8453 intv = sintv;
8454 else
8455 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8456 tokens);
8457 /* Compute every token forming the argument
8458 * in the intv objects vector. */
8459 for (i = 0; i < tokens; i++) {
8460 switch (token[i].type) {
8461 case JIM_TT_ESC:
8462 case JIM_TT_STR:
8463 intv[i] = token[i].objPtr;
8464 break;
8465 case JIM_TT_VAR:
8466 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8467 if (!intv[i]) {
8468 retcode = JIM_ERR;
8469 goto err;
8470 }
8471 break;
8472 case JIM_TT_DICTSUGAR:
8473 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8474 if (!intv[i]) {
8475 retcode = JIM_ERR;
8476 goto err;
8477 }
8478 break;
8479 case JIM_TT_CMD:
8480 retcode = Jim_EvalObj(interp, token[i].objPtr);
8481 if (retcode != JIM_OK)
8482 goto err;
8483 intv[i] = Jim_GetResult(interp);
8484 break;
8485 default:
8486 Jim_Panic(interp,
8487 "default token type reached "
8488 "in Jim_InterpolateTokens().");
8489 break;
8490 }
8491 Jim_IncrRefCount(intv[i]);
8492 /* Make sure there is a valid
8493 * string rep, and add the string
8494 * length to the total legnth. */
8495 Jim_GetString(intv[i], NULL);
8496 totlen += intv[i]->length;
8497 }
8498 /* Concatenate every token in an unique
8499 * object. */
8500 objPtr = Jim_NewStringObjNoAlloc(interp,
8501 NULL, 0);
8502 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8503 objPtr->length = totlen;
8504 for (i = 0; i < tokens; i++) {
8505 memcpy(s, intv[i]->bytes, intv[i]->length);
8506 s += intv[i]->length;
8507 Jim_DecrRefCount(interp, intv[i]);
8508 }
8509 objPtr->bytes[totlen] = '\0';
8510 /* Free the intv vector if not static. */
8511 if (tokens > JIM_EVAL_SINTV_LEN)
8512 Jim_Free(intv);
8513 *objPtrPtr = objPtr;
8514 return JIM_OK;
8515 err:
8516 i--;
8517 for (; i >= 0; i--)
8518 Jim_DecrRefCount(interp, intv[i]);
8519 if (tokens > JIM_EVAL_SINTV_LEN)
8520 Jim_Free(intv);
8521 return retcode;
8522 }
8523
8524 /* Helper of Jim_EvalObj() to perform argument expansion.
8525 * Basically this function append an argument to 'argv'
8526 * (and increments argc by reference accordingly), performing
8527 * expansion of the list object if 'expand' is non-zero, or
8528 * just adding objPtr to argv if 'expand' is zero. */
8529 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8530 int *argcPtr, int expand, Jim_Obj *objPtr)
8531 {
8532 if (!expand) {
8533 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8534 /* refcount of objPtr not incremented because
8535 * we are actually transfering a reference from
8536 * the old 'argv' to the expanded one. */
8537 (*argv)[*argcPtr] = objPtr;
8538 (*argcPtr)++;
8539 } else {
8540 int len, i;
8541
8542 Jim_ListLength(interp, objPtr, &len);
8543 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8544 for (i = 0; i < len; i++) {
8545 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8546 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8547 (*argcPtr)++;
8548 }
8549 /* The original object reference is no longer needed,
8550 * after the expansion it is no longer present on
8551 * the argument vector, but the single elements are
8552 * in its place. */
8553 Jim_DecrRefCount(interp, objPtr);
8554 }
8555 }
8556
8557 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8558 {
8559 int i, j = 0, len;
8560 ScriptObj *script;
8561 ScriptToken *token;
8562 int *cs; /* command structure array */
8563 int retcode = JIM_OK;
8564 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8565
8566 interp->errorFlag = 0;
8567
8568 /* If the object is of type "list" and there is no
8569 * string representation for this object, we can call
8570 * a specialized version of Jim_EvalObj() */
8571 if (scriptObjPtr->typePtr == &listObjType &&
8572 scriptObjPtr->internalRep.listValue.len &&
8573 scriptObjPtr->bytes == NULL) {
8574 Jim_IncrRefCount(scriptObjPtr);
8575 retcode = Jim_EvalObjVector(interp,
8576 scriptObjPtr->internalRep.listValue.len,
8577 scriptObjPtr->internalRep.listValue.ele);
8578 Jim_DecrRefCount(interp, scriptObjPtr);
8579 return retcode;
8580 }
8581
8582 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8583 script = Jim_GetScript(interp, scriptObjPtr);
8584 /* Now we have to make sure the internal repr will not be
8585 * freed on shimmering.
8586 *
8587 * Think for example to this:
8588 *
8589 * set x {llength $x; ... some more code ...}; eval $x
8590 *
8591 * In order to preserve the internal rep, we increment the
8592 * inUse field of the script internal rep structure. */
8593 script->inUse++;
8594
8595 token = script->token;
8596 len = script->len;
8597 cs = script->cmdStruct;
8598 i = 0; /* 'i' is the current token index. */
8599
8600 /* Reset the interpreter result. This is useful to
8601 * return the emtpy result in the case of empty program. */
8602 Jim_SetEmptyResult(interp);
8603
8604 /* Execute every command sequentially, returns on
8605 * error (i.e. if a command does not return JIM_OK) */
8606 while (i < len) {
8607 int expand = 0;
8608 int argc = *cs++; /* Get the number of arguments */
8609 Jim_Cmd *cmd;
8610
8611 /* Set the expand flag if needed. */
8612 if (argc == -1) {
8613 expand++;
8614 argc = *cs++;
8615 }
8616 /* Allocate the arguments vector */
8617 if (argc <= JIM_EVAL_SARGV_LEN)
8618 argv = sargv;
8619 else
8620 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8621 /* Populate the arguments objects. */
8622 for (j = 0; j < argc; j++) {
8623 int tokens = *cs++;
8624
8625 /* tokens is negative if expansion is needed.
8626 * for this argument. */
8627 if (tokens < 0) {
8628 tokens = (-tokens)-1;
8629 i++;
8630 }
8631 if (tokens == 1) {
8632 /* Fast path if the token does not
8633 * need interpolation */
8634 switch (token[i].type) {
8635 case JIM_TT_ESC:
8636 case JIM_TT_STR:
8637 argv[j] = token[i].objPtr;
8638 break;
8639 case JIM_TT_VAR:
8640 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8641 JIM_ERRMSG);
8642 if (!tmpObjPtr) {
8643 retcode = JIM_ERR;
8644 goto err;
8645 }
8646 argv[j] = tmpObjPtr;
8647 break;
8648 case JIM_TT_DICTSUGAR:
8649 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8650 if (!tmpObjPtr) {
8651 retcode = JIM_ERR;
8652 goto err;
8653 }
8654 argv[j] = tmpObjPtr;
8655 break;
8656 case JIM_TT_CMD:
8657 retcode = Jim_EvalObj(interp, token[i].objPtr);
8658 if (retcode != JIM_OK)
8659 goto err;
8660 argv[j] = Jim_GetResult(interp);
8661 break;
8662 default:
8663 Jim_Panic(interp,
8664 "default token type reached "
8665 "in Jim_EvalObj().");
8666 break;
8667 }
8668 Jim_IncrRefCount(argv[j]);
8669 i += 2;
8670 } else {
8671 /* For interpolation we call an helper
8672 * function doing the work for us. */
8673 if ((retcode = Jim_InterpolateTokens(interp,
8674 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8675 {
8676 goto err;
8677 }
8678 argv[j] = tmpObjPtr;
8679 Jim_IncrRefCount(argv[j]);
8680 i += tokens + 1;
8681 }
8682 }
8683 /* Handle {expand} expansion */
8684 if (expand) {
8685 int *ecs = cs - argc;
8686 int eargc = 0;
8687 Jim_Obj **eargv = NULL;
8688
8689 for (j = 0; j < argc; j++) {
8690 Jim_ExpandArgument(interp, &eargv, &eargc,
8691 ecs[j] < 0, argv[j]);
8692 }
8693 if (argv != sargv)
8694 Jim_Free(argv);
8695 argc = eargc;
8696 argv = eargv;
8697 j = argc;
8698 if (argc == 0) {
8699 /* Nothing to do with zero args. */
8700 Jim_Free(eargv);
8701 continue;
8702 }
8703 }
8704 /* Lookup the command to call */
8705 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8706 if (cmd != NULL) {
8707 /* Call it -- Make sure result is an empty object. */
8708 Jim_SetEmptyResult(interp);
8709 if (cmd->cmdProc) {
8710 interp->cmdPrivData = cmd->privData;
8711 retcode = cmd->cmdProc(interp, argc, argv);
8712 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8713 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8714 retcode = JIM_ERR;
8715 }
8716 } else {
8717 retcode = JimCallProcedure(interp, cmd, argc, argv);
8718 if (retcode == JIM_ERR) {
8719 JimAppendStackTrace(interp,
8720 Jim_GetString(argv[0], NULL), script->fileName,
8721 token[i-argc*2].linenr);
8722 }
8723 }
8724 } else {
8725 /* Call [unknown] */
8726 retcode = JimUnknown(interp, argc, argv);
8727 if (retcode == JIM_ERR) {
8728 JimAppendStackTrace(interp,
8729 "", script->fileName,
8730 token[i-argc*2].linenr);
8731 }
8732 }
8733 if (retcode != JIM_OK) {
8734 i -= argc*2; /* point to the command name. */
8735 goto err;
8736 }
8737 /* Decrement the arguments count */
8738 for (j = 0; j < argc; j++) {
8739 Jim_DecrRefCount(interp, argv[j]);
8740 }
8741
8742 if (argv != sargv) {
8743 Jim_Free(argv);
8744 argv = NULL;
8745 }
8746 }
8747 /* Note that we don't have to decrement inUse, because the
8748 * following code transfers our use of the reference again to
8749 * the script object. */
8750 j = 0; /* on normal termination, the argv array is already
8751 Jim_DecrRefCount-ed. */
8752 err:
8753 /* Handle errors. */
8754 if (retcode == JIM_ERR && !interp->errorFlag) {
8755 interp->errorFlag = 1;
8756 JimSetErrorFileName(interp, script->fileName);
8757 JimSetErrorLineNumber(interp, token[i].linenr);
8758 JimResetStackTrace(interp);
8759 }
8760 Jim_FreeIntRep(interp, scriptObjPtr);
8761 scriptObjPtr->typePtr = &scriptObjType;
8762 Jim_SetIntRepPtr(scriptObjPtr, script);
8763 Jim_DecrRefCount(interp, scriptObjPtr);
8764 for (i = 0; i < j; i++) {
8765 Jim_DecrRefCount(interp, argv[i]);
8766 }
8767 if (argv != sargv)
8768 Jim_Free(argv);
8769 return retcode;
8770 }
8771
8772 /* Call a procedure implemented in Tcl.
8773 * It's possible to speed-up a lot this function, currently
8774 * the callframes are not cached, but allocated and
8775 * destroied every time. What is expecially costly is
8776 * to create/destroy the local vars hash table every time.
8777 *
8778 * This can be fixed just implementing callframes caching
8779 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8780 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8781 Jim_Obj *const *argv)
8782 {
8783 int i, retcode;
8784 Jim_CallFrame *callFramePtr;
8785 int num_args;
8786
8787 /* Check arity */
8788 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8789 argc > cmd->arityMax)) {
8790 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8791 Jim_AppendStrings(interp, objPtr,
8792 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8793 (cmd->arityMin > 1) ? " " : "",
8794 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8795 Jim_SetResult(interp, objPtr);
8796 return JIM_ERR;
8797 }
8798 /* Check if there are too nested calls */
8799 if (interp->numLevels == interp->maxNestingDepth) {
8800 Jim_SetResultString(interp,
8801 "Too many nested calls. Infinite recursion?", -1);
8802 return JIM_ERR;
8803 }
8804 /* Create a new callframe */
8805 callFramePtr = JimCreateCallFrame(interp);
8806 callFramePtr->parentCallFrame = interp->framePtr;
8807 callFramePtr->argv = argv;
8808 callFramePtr->argc = argc;
8809 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8810 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8811 callFramePtr->staticVars = cmd->staticVars;
8812 Jim_IncrRefCount(cmd->argListObjPtr);
8813 Jim_IncrRefCount(cmd->bodyObjPtr);
8814 interp->framePtr = callFramePtr;
8815 interp->numLevels ++;
8816
8817 /* Set arguments */
8818 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8819
8820 /* If last argument is 'args', don't set it here */
8821 if (cmd->arityMax == -1) {
8822 num_args--;
8823 }
8824
8825 for (i = 0; i < num_args; i++) {
8826 Jim_Obj *argObjPtr=NULL;
8827 Jim_Obj *nameObjPtr=NULL;
8828 Jim_Obj *valueObjPtr=NULL;
8829
8830 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8831 if (i + 1 >= cmd->arityMin) {
8832 /* The name is the first element of the list */
8833 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8834 }
8835 else {
8836 /* The element arg is the name */
8837 nameObjPtr = argObjPtr;
8838 }
8839
8840 if (i + 1 >= argc) {
8841 /* No more values, so use default */
8842 /* The value is the second element of the list */
8843 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8844 }
8845 else {
8846 valueObjPtr = argv[i + 1];
8847 }
8848 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8849 }
8850 /* Set optional arguments */
8851 if (cmd->arityMax == -1) {
8852 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8853
8854 i++;
8855 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8856 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8857 Jim_SetVariable(interp, objPtr, listObjPtr);
8858 }
8859 /* Eval the body */
8860 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8861
8862 /* Destroy the callframe */
8863 interp->numLevels --;
8864 interp->framePtr = interp->framePtr->parentCallFrame;
8865 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8866 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8867 } else {
8868 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8869 }
8870 /* Handle the JIM_EVAL return code */
8871 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8872 int savedLevel = interp->evalRetcodeLevel;
8873
8874 interp->evalRetcodeLevel = interp->numLevels;
8875 while (retcode == JIM_EVAL) {
8876 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8877 Jim_IncrRefCount(resultScriptObjPtr);
8878 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8879 Jim_DecrRefCount(interp, resultScriptObjPtr);
8880 }
8881 interp->evalRetcodeLevel = savedLevel;
8882 }
8883 /* Handle the JIM_RETURN return code */
8884 if (retcode == JIM_RETURN) {
8885 retcode = interp->returnCode;
8886 interp->returnCode = JIM_OK;
8887 }
8888 return retcode;
8889 }
8890
8891 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8892 {
8893 int retval;
8894 Jim_Obj *scriptObjPtr;
8895
8896 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8897 Jim_IncrRefCount(scriptObjPtr);
8898
8899
8900 if (filename) {
8901 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8902 }
8903
8904 retval = Jim_EvalObj(interp, scriptObjPtr);
8905 Jim_DecrRefCount(interp, scriptObjPtr);
8906 return retval;
8907 }
8908
8909 int Jim_Eval(Jim_Interp *interp, const char *script)
8910 {
8911 return Jim_Eval_Named(interp, script, NULL, 0);
8912 }
8913
8914
8915
8916 /* Execute script in the scope of the global level */
8917 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8918 {
8919 Jim_CallFrame *savedFramePtr;
8920 int retval;
8921
8922 savedFramePtr = interp->framePtr;
8923 interp->framePtr = interp->topFramePtr;
8924 retval = Jim_Eval(interp, script);
8925 interp->framePtr = savedFramePtr;
8926 return retval;
8927 }
8928
8929 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8930 {
8931 Jim_CallFrame *savedFramePtr;
8932 int retval;
8933
8934 savedFramePtr = interp->framePtr;
8935 interp->framePtr = interp->topFramePtr;
8936 retval = Jim_EvalObj(interp, scriptObjPtr);
8937 interp->framePtr = savedFramePtr;
8938 /* Try to report the error (if any) via the bgerror proc */
8939 if (retval != JIM_OK) {
8940 Jim_Obj *objv[2];
8941
8942 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8943 objv[1] = Jim_GetResult(interp);
8944 Jim_IncrRefCount(objv[0]);
8945 Jim_IncrRefCount(objv[1]);
8946 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8947 /* Report the error to stderr. */
8948 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8949 Jim_PrintErrorMessage(interp);
8950 }
8951 Jim_DecrRefCount(interp, objv[0]);
8952 Jim_DecrRefCount(interp, objv[1]);
8953 }
8954 return retval;
8955 }
8956
8957 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8958 {
8959 char *prg = NULL;
8960 FILE *fp;
8961 int nread, totread, maxlen, buflen;
8962 int retval;
8963 Jim_Obj *scriptObjPtr;
8964
8965 if ((fp = fopen(filename, "r")) == NULL) {
8966 const int cwd_len = 2048;
8967 char *cwd = malloc(cwd_len);
8968 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8969 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8970 Jim_AppendStrings(interp, Jim_GetResult(interp),
8971 "Error loading script \"", filename, "\"",
8972 " cwd: ", cwd,
8973 " err: ", strerror(errno), NULL);
8974 free(cwd);
8975 return JIM_ERR;
8976 }
8977 buflen = 1024;
8978 maxlen = totread = 0;
8979 while (1) {
8980 if (maxlen < totread + buflen + 1) {
8981 maxlen = totread + buflen + 1;
8982 prg = Jim_Realloc(prg, maxlen);
8983 }
8984 /* do not use Jim_fread() - this is really a file */
8985 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8986 totread += nread;
8987 }
8988 prg[totread] = '\0';
8989 /* do not use Jim_fclose() - this is really a file */
8990 fclose(fp);
8991
8992 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8993 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8994 Jim_IncrRefCount(scriptObjPtr);
8995 retval = Jim_EvalObj(interp, scriptObjPtr);
8996 Jim_DecrRefCount(interp, scriptObjPtr);
8997 return retval;
8998 }
8999
9000 /* -----------------------------------------------------------------------------
9001 * Subst
9002 * ---------------------------------------------------------------------------*/
9003 static int JimParseSubstStr(struct JimParserCtx *pc)
9004 {
9005 pc->tstart = pc->p;
9006 pc->tline = pc->linenr;
9007 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9008 pc->p++; pc->len--;
9009 }
9010 pc->tend = pc->p-1;
9011 pc->tt = JIM_TT_ESC;
9012 return JIM_OK;
9013 }
9014
9015 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9016 {
9017 int retval;
9018
9019 if (pc->len == 0) {
9020 pc->tstart = pc->tend = pc->p;
9021 pc->tline = pc->linenr;
9022 pc->tt = JIM_TT_EOL;
9023 pc->eof = 1;
9024 return JIM_OK;
9025 }
9026 switch (*pc->p) {
9027 case '[':
9028 retval = JimParseCmd(pc);
9029 if (flags & JIM_SUBST_NOCMD) {
9030 pc->tstart--;
9031 pc->tend++;
9032 pc->tt = (flags & JIM_SUBST_NOESC) ?
9033 JIM_TT_STR : JIM_TT_ESC;
9034 }
9035 return retval;
9036 break;
9037 case '$':
9038 if (JimParseVar(pc) == JIM_ERR) {
9039 pc->tstart = pc->tend = pc->p++; pc->len--;
9040 pc->tline = pc->linenr;
9041 pc->tt = JIM_TT_STR;
9042 } else {
9043 if (flags & JIM_SUBST_NOVAR) {
9044 pc->tstart--;
9045 if (flags & JIM_SUBST_NOESC)
9046 pc->tt = JIM_TT_STR;
9047 else
9048 pc->tt = JIM_TT_ESC;
9049 if (*pc->tstart == '{') {
9050 pc->tstart--;
9051 if (*(pc->tend + 1))
9052 pc->tend++;
9053 }
9054 }
9055 }
9056 break;
9057 default:
9058 retval = JimParseSubstStr(pc);
9059 if (flags & JIM_SUBST_NOESC)
9060 pc->tt = JIM_TT_STR;
9061 return retval;
9062 break;
9063 }
9064 return JIM_OK;
9065 }
9066
9067 /* The subst object type reuses most of the data structures and functions
9068 * of the script object. Script's data structures are a bit more complex
9069 * for what is needed for [subst]itution tasks, but the reuse helps to
9070 * deal with a single data structure at the cost of some more memory
9071 * usage for substitutions. */
9072 static Jim_ObjType substObjType = {
9073 "subst",
9074 FreeScriptInternalRep,
9075 DupScriptInternalRep,
9076 NULL,
9077 JIM_TYPE_REFERENCES,
9078 };
9079
9080 /* This method takes the string representation of an object
9081 * as a Tcl string where to perform [subst]itution, and generates
9082 * the pre-parsed internal representation. */
9083 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9084 {
9085 int scriptTextLen;
9086 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9087 struct JimParserCtx parser;
9088 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9089
9090 script->len = 0;
9091 script->csLen = 0;
9092 script->commands = 0;
9093 script->token = NULL;
9094 script->cmdStruct = NULL;
9095 script->inUse = 1;
9096 script->substFlags = flags;
9097 script->fileName = NULL;
9098
9099 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9100 while (1) {
9101 char *token;
9102 int len, type, linenr;
9103
9104 JimParseSubst(&parser, flags);
9105 if (JimParserEof(&parser)) break;
9106 token = JimParserGetToken(&parser, &len, &type, &linenr);
9107 ScriptObjAddToken(interp, script, token, len, type,
9108 NULL, linenr);
9109 }
9110 /* Free the old internal rep and set the new one. */
9111 Jim_FreeIntRep(interp, objPtr);
9112 Jim_SetIntRepPtr(objPtr, script);
9113 objPtr->typePtr = &scriptObjType;
9114 return JIM_OK;
9115 }
9116
9117 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9118 {
9119 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9120
9121 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9122 SetSubstFromAny(interp, objPtr, flags);
9123 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9124 }
9125
9126 /* Performs commands,variables,blackslashes substitution,
9127 * storing the result object (with refcount 0) into
9128 * resObjPtrPtr. */
9129 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9130 Jim_Obj **resObjPtrPtr, int flags)
9131 {
9132 ScriptObj *script;
9133 ScriptToken *token;
9134 int i, len, retcode = JIM_OK;
9135 Jim_Obj *resObjPtr, *savedResultObjPtr;
9136
9137 script = Jim_GetSubst(interp, substObjPtr, flags);
9138 #ifdef JIM_OPTIMIZATION
9139 /* Fast path for a very common case with array-alike syntax,
9140 * that's: $foo($bar) */
9141 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9142 Jim_Obj *varObjPtr = script->token[0].objPtr;
9143
9144 Jim_IncrRefCount(varObjPtr);
9145 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9146 if (resObjPtr == NULL) {
9147 Jim_DecrRefCount(interp, varObjPtr);
9148 return JIM_ERR;
9149 }
9150 Jim_DecrRefCount(interp, varObjPtr);
9151 *resObjPtrPtr = resObjPtr;
9152 return JIM_OK;
9153 }
9154 #endif
9155
9156 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9157 /* In order to preserve the internal rep, we increment the
9158 * inUse field of the script internal rep structure. */
9159 script->inUse++;
9160
9161 token = script->token;
9162 len = script->len;
9163
9164 /* Save the interp old result, to set it again before
9165 * to return. */
9166 savedResultObjPtr = interp->result;
9167 Jim_IncrRefCount(savedResultObjPtr);
9168
9169 /* Perform the substitution. Starts with an empty object
9170 * and adds every token (performing the appropriate
9171 * var/command/escape substitution). */
9172 resObjPtr = Jim_NewStringObj(interp, "", 0);
9173 for (i = 0; i < len; i++) {
9174 Jim_Obj *objPtr;
9175
9176 switch (token[i].type) {
9177 case JIM_TT_STR:
9178 case JIM_TT_ESC:
9179 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9180 break;
9181 case JIM_TT_VAR:
9182 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9183 if (objPtr == NULL) goto err;
9184 Jim_IncrRefCount(objPtr);
9185 Jim_AppendObj(interp, resObjPtr, objPtr);
9186 Jim_DecrRefCount(interp, objPtr);
9187 break;
9188 case JIM_TT_DICTSUGAR:
9189 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9190 if (!objPtr) {
9191 retcode = JIM_ERR;
9192 goto err;
9193 }
9194 break;
9195 case JIM_TT_CMD:
9196 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9197 goto err;
9198 Jim_AppendObj(interp, resObjPtr, interp->result);
9199 break;
9200 default:
9201 Jim_Panic(interp,
9202 "default token type (%d) reached "
9203 "in Jim_SubstObj().", token[i].type);
9204 break;
9205 }
9206 }
9207 ok:
9208 if (retcode == JIM_OK)
9209 Jim_SetResult(interp, savedResultObjPtr);
9210 Jim_DecrRefCount(interp, savedResultObjPtr);
9211 /* Note that we don't have to decrement inUse, because the
9212 * following code transfers our use of the reference again to
9213 * the script object. */
9214 Jim_FreeIntRep(interp, substObjPtr);
9215 substObjPtr->typePtr = &scriptObjType;
9216 Jim_SetIntRepPtr(substObjPtr, script);
9217 Jim_DecrRefCount(interp, substObjPtr);
9218 *resObjPtrPtr = resObjPtr;
9219 return retcode;
9220 err:
9221 Jim_FreeNewObj(interp, resObjPtr);
9222 retcode = JIM_ERR;
9223 goto ok;
9224 }
9225
9226 /* -----------------------------------------------------------------------------
9227 * API Input/Export functions
9228 * ---------------------------------------------------------------------------*/
9229
9230 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9231 {
9232 Jim_HashEntry *he;
9233
9234 he = Jim_FindHashEntry(&interp->stub, funcname);
9235 if (!he)
9236 return JIM_ERR;
9237 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9238 return JIM_OK;
9239 }
9240
9241 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9242 {
9243 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9244 }
9245
9246 #define JIM_REGISTER_API(name) \
9247 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9248
9249 void JimRegisterCoreApi(Jim_Interp *interp)
9250 {
9251 interp->getApiFuncPtr = Jim_GetApi;
9252 JIM_REGISTER_API(Alloc);
9253 JIM_REGISTER_API(Free);
9254 JIM_REGISTER_API(Eval);
9255 JIM_REGISTER_API(Eval_Named);
9256 JIM_REGISTER_API(EvalGlobal);
9257 JIM_REGISTER_API(EvalFile);
9258 JIM_REGISTER_API(EvalObj);
9259 JIM_REGISTER_API(EvalObjBackground);
9260 JIM_REGISTER_API(EvalObjVector);
9261 JIM_REGISTER_API(InitHashTable);
9262 JIM_REGISTER_API(ExpandHashTable);
9263 JIM_REGISTER_API(AddHashEntry);
9264 JIM_REGISTER_API(ReplaceHashEntry);
9265 JIM_REGISTER_API(DeleteHashEntry);
9266 JIM_REGISTER_API(FreeHashTable);
9267 JIM_REGISTER_API(FindHashEntry);
9268 JIM_REGISTER_API(ResizeHashTable);
9269 JIM_REGISTER_API(GetHashTableIterator);
9270 JIM_REGISTER_API(NextHashEntry);
9271 JIM_REGISTER_API(NewObj);
9272 JIM_REGISTER_API(FreeObj);
9273 JIM_REGISTER_API(InvalidateStringRep);
9274 JIM_REGISTER_API(InitStringRep);
9275 JIM_REGISTER_API(DuplicateObj);
9276 JIM_REGISTER_API(GetString);
9277 JIM_REGISTER_API(Length);
9278 JIM_REGISTER_API(InvalidateStringRep);
9279 JIM_REGISTER_API(NewStringObj);
9280 JIM_REGISTER_API(NewStringObjNoAlloc);
9281 JIM_REGISTER_API(AppendString);
9282 JIM_REGISTER_API(AppendString_sprintf);
9283 JIM_REGISTER_API(AppendObj);
9284 JIM_REGISTER_API(AppendStrings);
9285 JIM_REGISTER_API(StringEqObj);
9286 JIM_REGISTER_API(StringMatchObj);
9287 JIM_REGISTER_API(StringRangeObj);
9288 JIM_REGISTER_API(FormatString);
9289 JIM_REGISTER_API(CompareStringImmediate);
9290 JIM_REGISTER_API(NewReference);
9291 JIM_REGISTER_API(GetReference);
9292 JIM_REGISTER_API(SetFinalizer);
9293 JIM_REGISTER_API(GetFinalizer);
9294 JIM_REGISTER_API(CreateInterp);
9295 JIM_REGISTER_API(FreeInterp);
9296 JIM_REGISTER_API(GetExitCode);
9297 JIM_REGISTER_API(SetStdin);
9298 JIM_REGISTER_API(SetStdout);
9299 JIM_REGISTER_API(SetStderr);
9300 JIM_REGISTER_API(CreateCommand);
9301 JIM_REGISTER_API(CreateProcedure);
9302 JIM_REGISTER_API(DeleteCommand);
9303 JIM_REGISTER_API(RenameCommand);
9304 JIM_REGISTER_API(GetCommand);
9305 JIM_REGISTER_API(SetVariable);
9306 JIM_REGISTER_API(SetVariableStr);
9307 JIM_REGISTER_API(SetGlobalVariableStr);
9308 JIM_REGISTER_API(SetVariableStrWithStr);
9309 JIM_REGISTER_API(SetVariableLink);
9310 JIM_REGISTER_API(GetVariable);
9311 JIM_REGISTER_API(GetCallFrameByLevel);
9312 JIM_REGISTER_API(Collect);
9313 JIM_REGISTER_API(CollectIfNeeded);
9314 JIM_REGISTER_API(GetIndex);
9315 JIM_REGISTER_API(NewListObj);
9316 JIM_REGISTER_API(ListAppendElement);
9317 JIM_REGISTER_API(ListAppendList);
9318 JIM_REGISTER_API(ListLength);
9319 JIM_REGISTER_API(ListIndex);
9320 JIM_REGISTER_API(SetListIndex);
9321 JIM_REGISTER_API(ConcatObj);
9322 JIM_REGISTER_API(NewDictObj);
9323 JIM_REGISTER_API(DictKey);
9324 JIM_REGISTER_API(DictKeysVector);
9325 JIM_REGISTER_API(GetIndex);
9326 JIM_REGISTER_API(GetReturnCode);
9327 JIM_REGISTER_API(EvalExpression);
9328 JIM_REGISTER_API(GetBoolFromExpr);
9329 JIM_REGISTER_API(GetWide);
9330 JIM_REGISTER_API(GetLong);
9331 JIM_REGISTER_API(SetWide);
9332 JIM_REGISTER_API(NewIntObj);
9333 JIM_REGISTER_API(GetDouble);
9334 JIM_REGISTER_API(SetDouble);
9335 JIM_REGISTER_API(NewDoubleObj);
9336 JIM_REGISTER_API(WrongNumArgs);
9337 JIM_REGISTER_API(SetDictKeysVector);
9338 JIM_REGISTER_API(SubstObj);
9339 JIM_REGISTER_API(RegisterApi);
9340 JIM_REGISTER_API(PrintErrorMessage);
9341 JIM_REGISTER_API(InteractivePrompt);
9342 JIM_REGISTER_API(RegisterCoreCommands);
9343 JIM_REGISTER_API(GetSharedString);
9344 JIM_REGISTER_API(ReleaseSharedString);
9345 JIM_REGISTER_API(Panic);
9346 JIM_REGISTER_API(StrDup);
9347 JIM_REGISTER_API(UnsetVariable);
9348 JIM_REGISTER_API(GetVariableStr);
9349 JIM_REGISTER_API(GetGlobalVariable);
9350 JIM_REGISTER_API(GetGlobalVariableStr);
9351 JIM_REGISTER_API(GetAssocData);
9352 JIM_REGISTER_API(SetAssocData);
9353 JIM_REGISTER_API(DeleteAssocData);
9354 JIM_REGISTER_API(GetEnum);
9355 JIM_REGISTER_API(ScriptIsComplete);
9356 JIM_REGISTER_API(PackageRequire);
9357 JIM_REGISTER_API(PackageProvide);
9358 JIM_REGISTER_API(InitStack);
9359 JIM_REGISTER_API(FreeStack);
9360 JIM_REGISTER_API(StackLen);
9361 JIM_REGISTER_API(StackPush);
9362 JIM_REGISTER_API(StackPop);
9363 JIM_REGISTER_API(StackPeek);
9364 JIM_REGISTER_API(FreeStackElements);
9365 JIM_REGISTER_API(fprintf);
9366 JIM_REGISTER_API(vfprintf);
9367 JIM_REGISTER_API(fwrite);
9368 JIM_REGISTER_API(fread);
9369 JIM_REGISTER_API(fflush);
9370 JIM_REGISTER_API(fgets);
9371 JIM_REGISTER_API(GetNvp);
9372 JIM_REGISTER_API(Nvp_name2value);
9373 JIM_REGISTER_API(Nvp_name2value_simple);
9374 JIM_REGISTER_API(Nvp_name2value_obj);
9375 JIM_REGISTER_API(Nvp_name2value_nocase);
9376 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9377
9378 JIM_REGISTER_API(Nvp_value2name);
9379 JIM_REGISTER_API(Nvp_value2name_simple);
9380 JIM_REGISTER_API(Nvp_value2name_obj);
9381
9382 JIM_REGISTER_API(GetOpt_Setup);
9383 JIM_REGISTER_API(GetOpt_Debug);
9384 JIM_REGISTER_API(GetOpt_Obj);
9385 JIM_REGISTER_API(GetOpt_String);
9386 JIM_REGISTER_API(GetOpt_Double);
9387 JIM_REGISTER_API(GetOpt_Wide);
9388 JIM_REGISTER_API(GetOpt_Nvp);
9389 JIM_REGISTER_API(GetOpt_NvpUnknown);
9390 JIM_REGISTER_API(GetOpt_Enum);
9391
9392 JIM_REGISTER_API(Debug_ArgvString);
9393 JIM_REGISTER_API(SetResult_sprintf);
9394 JIM_REGISTER_API(SetResult_NvpUnknown);
9395
9396 }
9397
9398 /* -----------------------------------------------------------------------------
9399 * Core commands utility functions
9400 * ---------------------------------------------------------------------------*/
9401 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9402 const char *msg)
9403 {
9404 int i;
9405 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9406
9407 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9408 for (i = 0; i < argc; i++) {
9409 Jim_AppendObj(interp, objPtr, argv[i]);
9410 if (!(i + 1 == argc && msg[0] == '\0'))
9411 Jim_AppendString(interp, objPtr, " ", 1);
9412 }
9413 Jim_AppendString(interp, objPtr, msg, -1);
9414 Jim_AppendString(interp, objPtr, "\"", 1);
9415 Jim_SetResult(interp, objPtr);
9416 }
9417
9418 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9419 {
9420 Jim_HashTableIterator *htiter;
9421 Jim_HashEntry *he;
9422 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9423 const char *pattern;
9424 int patternLen=0;
9425
9426 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9427 htiter = Jim_GetHashTableIterator(&interp->commands);
9428 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9429 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9430 strlen((const char*)he->key), 0))
9431 continue;
9432 Jim_ListAppendElement(interp, listObjPtr,
9433 Jim_NewStringObj(interp, he->key, -1));
9434 }
9435 Jim_FreeHashTableIterator(htiter);
9436 return listObjPtr;
9437 }
9438
9439 #define JIM_VARLIST_GLOBALS 0
9440 #define JIM_VARLIST_LOCALS 1
9441 #define JIM_VARLIST_VARS 2
9442
9443 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9444 int mode)
9445 {
9446 Jim_HashTableIterator *htiter;
9447 Jim_HashEntry *he;
9448 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9449 const char *pattern;
9450 int patternLen=0;
9451
9452 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9453 if (mode == JIM_VARLIST_GLOBALS) {
9454 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9455 } else {
9456 /* For [info locals], if we are at top level an emtpy list
9457 * is returned. I don't agree, but we aim at compatibility (SS) */
9458 if (mode == JIM_VARLIST_LOCALS &&
9459 interp->framePtr == interp->topFramePtr)
9460 return listObjPtr;
9461 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9462 }
9463 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9464 Jim_Var *varPtr = (Jim_Var*) he->val;
9465 if (mode == JIM_VARLIST_LOCALS) {
9466 if (varPtr->linkFramePtr != NULL)
9467 continue;
9468 }
9469 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9470 strlen((const char*)he->key), 0))
9471 continue;
9472 Jim_ListAppendElement(interp, listObjPtr,
9473 Jim_NewStringObj(interp, he->key, -1));
9474 }
9475 Jim_FreeHashTableIterator(htiter);
9476 return listObjPtr;
9477 }
9478
9479 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9480 Jim_Obj **objPtrPtr)
9481 {
9482 Jim_CallFrame *targetCallFrame;
9483
9484 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9485 != JIM_OK)
9486 return JIM_ERR;
9487 /* No proc call at toplevel callframe */
9488 if (targetCallFrame == interp->topFramePtr) {
9489 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9490 Jim_AppendStrings(interp, Jim_GetResult(interp),
9491 "bad level \"",
9492 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9493 return JIM_ERR;
9494 }
9495 *objPtrPtr = Jim_NewListObj(interp,
9496 targetCallFrame->argv,
9497 targetCallFrame->argc);
9498 return JIM_OK;
9499 }
9500
9501 /* -----------------------------------------------------------------------------
9502 * Core commands
9503 * ---------------------------------------------------------------------------*/
9504
9505 /* fake [puts] -- not the real puts, just for debugging. */
9506 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9507 Jim_Obj *const *argv)
9508 {
9509 const char *str;
9510 int len, nonewline = 0;
9511
9512 if (argc != 2 && argc != 3) {
9513 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9514 return JIM_ERR;
9515 }
9516 if (argc == 3) {
9517 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9518 {
9519 Jim_SetResultString(interp, "The second argument must "
9520 "be -nonewline", -1);
9521 return JIM_OK;
9522 } else {
9523 nonewline = 1;
9524 argv++;
9525 }
9526 }
9527 str = Jim_GetString(argv[1], &len);
9528 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9529 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9530 return JIM_OK;
9531 }
9532
9533 /* Helper for [+] and [*] */
9534 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9535 Jim_Obj *const *argv, int op)
9536 {
9537 jim_wide wideValue, res;
9538 double doubleValue, doubleRes;
9539 int i;
9540
9541 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9542
9543 for (i = 1; i < argc; i++) {
9544 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9545 goto trydouble;
9546 if (op == JIM_EXPROP_ADD)
9547 res += wideValue;
9548 else
9549 res *= wideValue;
9550 }
9551 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9552 return JIM_OK;
9553 trydouble:
9554 doubleRes = (double) res;
9555 for (;i < argc; i++) {
9556 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9557 return JIM_ERR;
9558 if (op == JIM_EXPROP_ADD)
9559 doubleRes += doubleValue;
9560 else
9561 doubleRes *= doubleValue;
9562 }
9563 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9564 return JIM_OK;
9565 }
9566
9567 /* Helper for [-] and [/] */
9568 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9569 Jim_Obj *const *argv, int op)
9570 {
9571 jim_wide wideValue, res = 0;
9572 double doubleValue, doubleRes = 0;
9573 int i = 2;
9574
9575 if (argc < 2) {
9576 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9577 return JIM_ERR;
9578 } else if (argc == 2) {
9579 /* The arity = 2 case is different. For [- x] returns -x,
9580 * while [/ x] returns 1/x. */
9581 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9582 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9583 JIM_OK)
9584 {
9585 return JIM_ERR;
9586 } else {
9587 if (op == JIM_EXPROP_SUB)
9588 doubleRes = -doubleValue;
9589 else
9590 doubleRes = 1.0/doubleValue;
9591 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9592 doubleRes));
9593 return JIM_OK;
9594 }
9595 }
9596 if (op == JIM_EXPROP_SUB) {
9597 res = -wideValue;
9598 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9599 } else {
9600 doubleRes = 1.0/wideValue;
9601 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9602 doubleRes));
9603 }
9604 return JIM_OK;
9605 } else {
9606 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9607 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9608 != JIM_OK) {
9609 return JIM_ERR;
9610 } else {
9611 goto trydouble;
9612 }
9613 }
9614 }
9615 for (i = 2; i < argc; i++) {
9616 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9617 doubleRes = (double) res;
9618 goto trydouble;
9619 }
9620 if (op == JIM_EXPROP_SUB)
9621 res -= wideValue;
9622 else
9623 res /= wideValue;
9624 }
9625 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9626 return JIM_OK;
9627 trydouble:
9628 for (;i < argc; i++) {
9629 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9630 return JIM_ERR;
9631 if (op == JIM_EXPROP_SUB)
9632 doubleRes -= doubleValue;
9633 else
9634 doubleRes /= doubleValue;
9635 }
9636 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9637 return JIM_OK;
9638 }
9639
9640
9641 /* [+] */
9642 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9643 Jim_Obj *const *argv)
9644 {
9645 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9646 }
9647
9648 /* [*] */
9649 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9650 Jim_Obj *const *argv)
9651 {
9652 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9653 }
9654
9655 /* [-] */
9656 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9657 Jim_Obj *const *argv)
9658 {
9659 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9660 }
9661
9662 /* [/] */
9663 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9664 Jim_Obj *const *argv)
9665 {
9666 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9667 }
9668
9669 /* [set] */
9670 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9671 Jim_Obj *const *argv)
9672 {
9673 if (argc != 2 && argc != 3) {
9674 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9675 return JIM_ERR;
9676 }
9677 if (argc == 2) {
9678 Jim_Obj *objPtr;
9679 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9680 if (!objPtr)
9681 return JIM_ERR;
9682 Jim_SetResult(interp, objPtr);
9683 return JIM_OK;
9684 }
9685 /* argc == 3 case. */
9686 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9687 return JIM_ERR;
9688 Jim_SetResult(interp, argv[2]);
9689 return JIM_OK;
9690 }
9691
9692 /* [unset] */
9693 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9694 Jim_Obj *const *argv)
9695 {
9696 int i;
9697
9698 if (argc < 2) {
9699 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9700 return JIM_ERR;
9701 }
9702 for (i = 1; i < argc; i++) {
9703 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9704 return JIM_ERR;
9705 }
9706 return JIM_OK;
9707 }
9708
9709 /* [incr] */
9710 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9711 Jim_Obj *const *argv)
9712 {
9713 jim_wide wideValue, increment = 1;
9714 Jim_Obj *intObjPtr;
9715
9716 if (argc != 2 && argc != 3) {
9717 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9718 return JIM_ERR;
9719 }
9720 if (argc == 3) {
9721 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9722 return JIM_ERR;
9723 }
9724 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9725 if (!intObjPtr) return JIM_ERR;
9726 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9727 return JIM_ERR;
9728 if (Jim_IsShared(intObjPtr)) {
9729 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9730 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9731 Jim_FreeNewObj(interp, intObjPtr);
9732 return JIM_ERR;
9733 }
9734 } else {
9735 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9736 /* The following step is required in order to invalidate the
9737 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9738 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9739 return JIM_ERR;
9740 }
9741 }
9742 Jim_SetResult(interp, intObjPtr);
9743 return JIM_OK;
9744 }
9745
9746 /* [while] */
9747 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9748 Jim_Obj *const *argv)
9749 {
9750 if (argc != 3) {
9751 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9752 return JIM_ERR;
9753 }
9754 /* Try to run a specialized version of while if the expression
9755 * is in one of the following forms:
9756 *
9757 * $a < CONST, $a < $b
9758 * $a <= CONST, $a <= $b
9759 * $a > CONST, $a > $b
9760 * $a >= CONST, $a >= $b
9761 * $a != CONST, $a != $b
9762 * $a == CONST, $a == $b
9763 * $a
9764 * !$a
9765 * CONST
9766 */
9767
9768 #ifdef JIM_OPTIMIZATION
9769 {
9770 ExprByteCode *expr;
9771 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9772 int exprLen, retval;
9773
9774 /* STEP 1 -- Check if there are the conditions to run the specialized
9775 * version of while */
9776
9777 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9778 if (expr->len <= 0 || expr->len > 3) goto noopt;
9779 switch (expr->len) {
9780 case 1:
9781 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9782 expr->opcode[0] != JIM_EXPROP_NUMBER)
9783 goto noopt;
9784 break;
9785 case 2:
9786 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9787 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9788 goto noopt;
9789 break;
9790 case 3:
9791 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9792 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9793 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9794 goto noopt;
9795 switch (expr->opcode[2]) {
9796 case JIM_EXPROP_LT:
9797 case JIM_EXPROP_LTE:
9798 case JIM_EXPROP_GT:
9799 case JIM_EXPROP_GTE:
9800 case JIM_EXPROP_NUMEQ:
9801 case JIM_EXPROP_NUMNE:
9802 /* nothing to do */
9803 break;
9804 default:
9805 goto noopt;
9806 }
9807 break;
9808 default:
9809 Jim_Panic(interp,
9810 "Unexpected default reached in Jim_WhileCoreCommand()");
9811 break;
9812 }
9813
9814 /* STEP 2 -- conditions meet. Initialization. Take different
9815 * branches for different expression lengths. */
9816 exprLen = expr->len;
9817
9818 if (exprLen == 1) {
9819 jim_wide wideValue=0;
9820
9821 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9822 varAObjPtr = expr->obj[0];
9823 Jim_IncrRefCount(varAObjPtr);
9824 } else {
9825 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9826 goto noopt;
9827 }
9828 while (1) {
9829 if (varAObjPtr) {
9830 if (!(objPtr =
9831 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9832 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9833 {
9834 Jim_DecrRefCount(interp, varAObjPtr);
9835 goto noopt;
9836 }
9837 }
9838 if (!wideValue) break;
9839 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9840 switch (retval) {
9841 case JIM_BREAK:
9842 if (varAObjPtr)
9843 Jim_DecrRefCount(interp, varAObjPtr);
9844 goto out;
9845 break;
9846 case JIM_CONTINUE:
9847 continue;
9848 break;
9849 default:
9850 if (varAObjPtr)
9851 Jim_DecrRefCount(interp, varAObjPtr);
9852 return retval;
9853 }
9854 }
9855 }
9856 if (varAObjPtr)
9857 Jim_DecrRefCount(interp, varAObjPtr);
9858 } else if (exprLen == 3) {
9859 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9860 int cmpType = expr->opcode[2];
9861
9862 varAObjPtr = expr->obj[0];
9863 Jim_IncrRefCount(varAObjPtr);
9864 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9865 varBObjPtr = expr->obj[1];
9866 Jim_IncrRefCount(varBObjPtr);
9867 } else {
9868 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9869 goto noopt;
9870 }
9871 while (1) {
9872 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9873 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9874 {
9875 Jim_DecrRefCount(interp, varAObjPtr);
9876 if (varBObjPtr)
9877 Jim_DecrRefCount(interp, varBObjPtr);
9878 goto noopt;
9879 }
9880 if (varBObjPtr) {
9881 if (!(objPtr =
9882 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9883 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9884 {
9885 Jim_DecrRefCount(interp, varAObjPtr);
9886 if (varBObjPtr)
9887 Jim_DecrRefCount(interp, varBObjPtr);
9888 goto noopt;
9889 }
9890 }
9891 switch (cmpType) {
9892 case JIM_EXPROP_LT:
9893 cmpRes = wideValueA < wideValueB; break;
9894 case JIM_EXPROP_LTE:
9895 cmpRes = wideValueA <= wideValueB; break;
9896 case JIM_EXPROP_GT:
9897 cmpRes = wideValueA > wideValueB; break;
9898 case JIM_EXPROP_GTE:
9899 cmpRes = wideValueA >= wideValueB; break;
9900 case JIM_EXPROP_NUMEQ:
9901 cmpRes = wideValueA == wideValueB; break;
9902 case JIM_EXPROP_NUMNE:
9903 cmpRes = wideValueA != wideValueB; break;
9904 }
9905 if (!cmpRes) break;
9906 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9907 switch (retval) {
9908 case JIM_BREAK:
9909 Jim_DecrRefCount(interp, varAObjPtr);
9910 if (varBObjPtr)
9911 Jim_DecrRefCount(interp, varBObjPtr);
9912 goto out;
9913 break;
9914 case JIM_CONTINUE:
9915 continue;
9916 break;
9917 default:
9918 Jim_DecrRefCount(interp, varAObjPtr);
9919 if (varBObjPtr)
9920 Jim_DecrRefCount(interp, varBObjPtr);
9921 return retval;
9922 }
9923 }
9924 }
9925 Jim_DecrRefCount(interp, varAObjPtr);
9926 if (varBObjPtr)
9927 Jim_DecrRefCount(interp, varBObjPtr);
9928 } else {
9929 /* TODO: case for len == 2 */
9930 goto noopt;
9931 }
9932 Jim_SetEmptyResult(interp);
9933 return JIM_OK;
9934 }
9935 noopt:
9936 #endif
9937
9938 /* The general purpose implementation of while starts here */
9939 while (1) {
9940 int boolean, retval;
9941
9942 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9943 &boolean)) != JIM_OK)
9944 return retval;
9945 if (!boolean) break;
9946 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9947 switch (retval) {
9948 case JIM_BREAK:
9949 goto out;
9950 break;
9951 case JIM_CONTINUE:
9952 continue;
9953 break;
9954 default:
9955 return retval;
9956 }
9957 }
9958 }
9959 out:
9960 Jim_SetEmptyResult(interp);
9961 return JIM_OK;
9962 }
9963
9964 /* [for] */
9965 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9966 Jim_Obj *const *argv)
9967 {
9968 int retval;
9969
9970 if (argc != 5) {
9971 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9972 return JIM_ERR;
9973 }
9974 /* Check if the for is on the form:
9975 * for {set i CONST} {$i < CONST} {incr i}
9976 * for {set i CONST} {$i < $j} {incr i}
9977 * for {set i CONST} {$i <= CONST} {incr i}
9978 * for {set i CONST} {$i <= $j} {incr i}
9979 * XXX: NOTE: if variable traces are implemented, this optimization
9980 * need to be modified to check for the proc epoch at every variable
9981 * update. */
9982 #ifdef JIM_OPTIMIZATION
9983 {
9984 ScriptObj *initScript, *incrScript;
9985 ExprByteCode *expr;
9986 jim_wide start, stop=0, currentVal;
9987 unsigned jim_wide procEpoch = interp->procEpoch;
9988 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9989 int cmpType;
9990 struct Jim_Cmd *cmdPtr;
9991
9992 /* Do it only if there aren't shared arguments */
9993 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9994 goto evalstart;
9995 initScript = Jim_GetScript(interp, argv[1]);
9996 expr = Jim_GetExpression(interp, argv[2]);
9997 incrScript = Jim_GetScript(interp, argv[3]);
9998
9999 /* Ensure proper lengths to start */
10000 if (initScript->len != 6) goto evalstart;
10001 if (incrScript->len != 4) goto evalstart;
10002 if (expr->len != 3) goto evalstart;
10003 /* Ensure proper token types. */
10004 if (initScript->token[2].type != JIM_TT_ESC ||
10005 initScript->token[4].type != JIM_TT_ESC ||
10006 incrScript->token[2].type != JIM_TT_ESC ||
10007 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10008 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10009 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10010 (expr->opcode[2] != JIM_EXPROP_LT &&
10011 expr->opcode[2] != JIM_EXPROP_LTE))
10012 goto evalstart;
10013 cmpType = expr->opcode[2];
10014 /* Initialization command must be [set] */
10015 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10016 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10017 goto evalstart;
10018 /* Update command must be incr */
10019 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10020 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10021 goto evalstart;
10022 /* set, incr, expression must be about the same variable */
10023 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10024 incrScript->token[2].objPtr, 0))
10025 goto evalstart;
10026 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10027 expr->obj[0], 0))
10028 goto evalstart;
10029 /* Check that the initialization and comparison are valid integers */
10030 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10031 goto evalstart;
10032 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10033 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10034 {
10035 goto evalstart;
10036 }
10037
10038 /* Initialization */
10039 varNamePtr = expr->obj[0];
10040 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10041 stopVarNamePtr = expr->obj[1];
10042 Jim_IncrRefCount(stopVarNamePtr);
10043 }
10044 Jim_IncrRefCount(varNamePtr);
10045
10046 /* --- OPTIMIZED FOR --- */
10047 /* Start to loop */
10048 objPtr = Jim_NewIntObj(interp, start);
10049 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10050 Jim_DecrRefCount(interp, varNamePtr);
10051 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10052 Jim_FreeNewObj(interp, objPtr);
10053 goto evalstart;
10054 }
10055 while (1) {
10056 /* === Check condition === */
10057 /* Common code: */
10058 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10059 if (objPtr == NULL ||
10060 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10061 {
10062 Jim_DecrRefCount(interp, varNamePtr);
10063 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10064 goto testcond;
10065 }
10066 /* Immediate or Variable? get the 'stop' value if the latter. */
10067 if (stopVarNamePtr) {
10068 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10069 if (objPtr == NULL ||
10070 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10071 {
10072 Jim_DecrRefCount(interp, varNamePtr);
10073 Jim_DecrRefCount(interp, stopVarNamePtr);
10074 goto testcond;
10075 }
10076 }
10077 if (cmpType == JIM_EXPROP_LT) {
10078 if (currentVal >= stop) break;
10079 } else {
10080 if (currentVal > stop) break;
10081 }
10082 /* Eval body */
10083 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10084 switch (retval) {
10085 case JIM_BREAK:
10086 if (stopVarNamePtr)
10087 Jim_DecrRefCount(interp, stopVarNamePtr);
10088 Jim_DecrRefCount(interp, varNamePtr);
10089 goto out;
10090 case JIM_CONTINUE:
10091 /* nothing to do */
10092 break;
10093 default:
10094 if (stopVarNamePtr)
10095 Jim_DecrRefCount(interp, stopVarNamePtr);
10096 Jim_DecrRefCount(interp, varNamePtr);
10097 return retval;
10098 }
10099 }
10100 /* If there was a change in procedures/command continue
10101 * with the usual [for] command implementation */
10102 if (procEpoch != interp->procEpoch) {
10103 if (stopVarNamePtr)
10104 Jim_DecrRefCount(interp, stopVarNamePtr);
10105 Jim_DecrRefCount(interp, varNamePtr);
10106 goto evalnext;
10107 }
10108 /* Increment */
10109 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10110 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10111 objPtr->internalRep.wideValue ++;
10112 Jim_InvalidateStringRep(objPtr);
10113 } else {
10114 Jim_Obj *auxObjPtr;
10115
10116 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10117 if (stopVarNamePtr)
10118 Jim_DecrRefCount(interp, stopVarNamePtr);
10119 Jim_DecrRefCount(interp, varNamePtr);
10120 goto evalnext;
10121 }
10122 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10123 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10124 if (stopVarNamePtr)
10125 Jim_DecrRefCount(interp, stopVarNamePtr);
10126 Jim_DecrRefCount(interp, varNamePtr);
10127 Jim_FreeNewObj(interp, auxObjPtr);
10128 goto evalnext;
10129 }
10130 }
10131 }
10132 if (stopVarNamePtr)
10133 Jim_DecrRefCount(interp, stopVarNamePtr);
10134 Jim_DecrRefCount(interp, varNamePtr);
10135 Jim_SetEmptyResult(interp);
10136 return JIM_OK;
10137 }
10138 #endif
10139 evalstart:
10140 /* Eval start */
10141 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10142 return retval;
10143 while (1) {
10144 int boolean;
10145 testcond:
10146 /* Test the condition */
10147 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10148 != JIM_OK)
10149 return retval;
10150 if (!boolean) break;
10151 /* Eval body */
10152 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10153 switch (retval) {
10154 case JIM_BREAK:
10155 goto out;
10156 break;
10157 case JIM_CONTINUE:
10158 /* Nothing to do */
10159 break;
10160 default:
10161 return retval;
10162 }
10163 }
10164 evalnext:
10165 /* Eval next */
10166 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10167 switch (retval) {
10168 case JIM_BREAK:
10169 goto out;
10170 break;
10171 case JIM_CONTINUE:
10172 continue;
10173 break;
10174 default:
10175 return retval;
10176 }
10177 }
10178 }
10179 out:
10180 Jim_SetEmptyResult(interp);
10181 return JIM_OK;
10182 }
10183
10184 /* foreach + lmap implementation. */
10185 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10186 Jim_Obj *const *argv, int doMap)
10187 {
10188 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10189 int nbrOfLoops = 0;
10190 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10191
10192 if (argc < 4 || argc % 2 != 0) {
10193 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10194 return JIM_ERR;
10195 }
10196 if (doMap) {
10197 mapRes = Jim_NewListObj(interp, NULL, 0);
10198 Jim_IncrRefCount(mapRes);
10199 }
10200 emptyStr = Jim_NewEmptyStringObj(interp);
10201 Jim_IncrRefCount(emptyStr);
10202 script = argv[argc-1]; /* Last argument is a script */
10203 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10204 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10205 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10206 /* Initialize iterators and remember max nbr elements each list */
10207 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10208 /* Remember lengths of all lists and calculate how much rounds to loop */
10209 for (i = 0; i < nbrOfLists*2; i += 2) {
10210 div_t cnt;
10211 int count;
10212 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10213 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10214 if (listsEnd[i] == 0) {
10215 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10216 goto err;
10217 }
10218 cnt = div(listsEnd[i + 1], listsEnd[i]);
10219 count = cnt.quot + (cnt.rem ? 1 : 0);
10220 if (count > nbrOfLoops)
10221 nbrOfLoops = count;
10222 }
10223 for (; nbrOfLoops-- > 0;) {
10224 for (i = 0; i < nbrOfLists; ++i) {
10225 int varIdx = 0, var = i * 2;
10226 while (varIdx < listsEnd[var]) {
10227 Jim_Obj *varName, *ele;
10228 int lst = i * 2 + 1;
10229 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10230 != JIM_OK)
10231 goto err;
10232 if (listsIdx[i] < listsEnd[lst]) {
10233 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10234 != JIM_OK)
10235 goto err;
10236 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10237 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10238 goto err;
10239 }
10240 ++listsIdx[i]; /* Remember next iterator of current list */
10241 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10242 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10243 goto err;
10244 }
10245 ++varIdx; /* Next variable */
10246 }
10247 }
10248 switch (result = Jim_EvalObj(interp, script)) {
10249 case JIM_OK:
10250 if (doMap)
10251 Jim_ListAppendElement(interp, mapRes, interp->result);
10252 break;
10253 case JIM_CONTINUE:
10254 break;
10255 case JIM_BREAK:
10256 goto out;
10257 break;
10258 default:
10259 goto err;
10260 }
10261 }
10262 out:
10263 result = JIM_OK;
10264 if (doMap)
10265 Jim_SetResult(interp, mapRes);
10266 else
10267 Jim_SetEmptyResult(interp);
10268 err:
10269 if (doMap)
10270 Jim_DecrRefCount(interp, mapRes);
10271 Jim_DecrRefCount(interp, emptyStr);
10272 Jim_Free(listsIdx);
10273 Jim_Free(listsEnd);
10274 return result;
10275 }
10276
10277 /* [foreach] */
10278 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10279 Jim_Obj *const *argv)
10280 {
10281 return JimForeachMapHelper(interp, argc, argv, 0);
10282 }
10283
10284 /* [lmap] */
10285 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10286 Jim_Obj *const *argv)
10287 {
10288 return JimForeachMapHelper(interp, argc, argv, 1);
10289 }
10290
10291 /* [if] */
10292 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10293 Jim_Obj *const *argv)
10294 {
10295 int boolean, retval, current = 1, falsebody = 0;
10296 if (argc >= 3) {
10297 while (1) {
10298 /* Far not enough arguments given! */
10299 if (current >= argc) goto err;
10300 if ((retval = Jim_GetBoolFromExpr(interp,
10301 argv[current++], &boolean))
10302 != JIM_OK)
10303 return retval;
10304 /* There lacks something, isn't it? */
10305 if (current >= argc) goto err;
10306 if (Jim_CompareStringImmediate(interp, argv[current],
10307 "then")) current++;
10308 /* Tsk tsk, no then-clause? */
10309 if (current >= argc) goto err;
10310 if (boolean)
10311 return Jim_EvalObj(interp, argv[current]);
10312 /* Ok: no else-clause follows */
10313 if (++current >= argc) {
10314 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10315 return JIM_OK;
10316 }
10317 falsebody = current++;
10318 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10319 "else")) {
10320 /* IIICKS - else-clause isn't last cmd? */
10321 if (current != argc-1) goto err;
10322 return Jim_EvalObj(interp, argv[current]);
10323 } else if (Jim_CompareStringImmediate(interp,
10324 argv[falsebody], "elseif"))
10325 /* Ok: elseif follows meaning all the stuff
10326 * again (how boring...) */
10327 continue;
10328 /* OOPS - else-clause is not last cmd?*/
10329 else if (falsebody != argc-1)
10330 goto err;
10331 return Jim_EvalObj(interp, argv[falsebody]);
10332 }
10333 return JIM_OK;
10334 }
10335 err:
10336 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10337 return JIM_ERR;
10338 }
10339
10340 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10341
10342 /* [switch] */
10343 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10344 Jim_Obj *const *argv)
10345 {
10346 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10347 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10348 Jim_Obj *script = 0;
10349 if (argc < 3) goto wrongnumargs;
10350 for (opt = 1; opt < argc; ++opt) {
10351 const char *option = Jim_GetString(argv[opt], 0);
10352 if (*option != '-') break;
10353 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10354 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10355 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10356 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10357 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10358 if ((argc - opt) < 2) goto wrongnumargs;
10359 command = argv[++opt];
10360 } else {
10361 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10362 Jim_AppendStrings(interp, Jim_GetResult(interp),
10363 "bad option \"", option, "\": must be -exact, -glob, "
10364 "-regexp, -command procname or --", 0);
10365 goto err;
10366 }
10367 if ((argc - opt) < 2) goto wrongnumargs;
10368 }
10369 strObj = argv[opt++];
10370 patCount = argc - opt;
10371 if (patCount == 1) {
10372 Jim_Obj **vector;
10373 JimListGetElements(interp, argv[opt], &patCount, &vector);
10374 caseList = vector;
10375 } else
10376 caseList = &argv[opt];
10377 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10378 for (i = 0; script == 0 && i < patCount; i += 2) {
10379 Jim_Obj *patObj = caseList[i];
10380 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10381 || i < (patCount-2)) {
10382 switch (matchOpt) {
10383 case SWITCH_EXACT:
10384 if (Jim_StringEqObj(strObj, patObj, 0))
10385 script = caseList[i + 1];
10386 break;
10387 case SWITCH_GLOB:
10388 if (Jim_StringMatchObj(patObj, strObj, 0))
10389 script = caseList[i + 1];
10390 break;
10391 case SWITCH_RE:
10392 command = Jim_NewStringObj(interp, "regexp", -1);
10393 /* Fall thru intentionally */
10394 case SWITCH_CMD: {
10395 Jim_Obj *parms[] = {command, patObj, strObj};
10396 int rc = Jim_EvalObjVector(interp, 3, parms);
10397 long matching;
10398 /* After the execution of a command we need to
10399 * make sure to reconvert the object into a list
10400 * again. Only for the single-list style [switch]. */
10401 if (argc-opt == 1) {
10402 Jim_Obj **vector;
10403 JimListGetElements(interp, argv[opt], &patCount,
10404 &vector);
10405 caseList = vector;
10406 }
10407 /* command is here already decref'd */
10408 if (rc != JIM_OK) {
10409 retcode = rc;
10410 goto err;
10411 }
10412 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10413 if (rc != JIM_OK) {
10414 retcode = rc;
10415 goto err;
10416 }
10417 if (matching)
10418 script = caseList[i + 1];
10419 break;
10420 }
10421 default:
10422 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10423 Jim_AppendStrings(interp, Jim_GetResult(interp),
10424 "internal error: no such option implemented", 0);
10425 goto err;
10426 }
10427 } else {
10428 script = caseList[i + 1];
10429 }
10430 }
10431 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10432 i += 2)
10433 script = caseList[i + 1];
10434 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10435 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10436 Jim_AppendStrings(interp, Jim_GetResult(interp),
10437 "no body specified for pattern \"",
10438 Jim_GetString(caseList[i-2], 0), "\"", 0);
10439 goto err;
10440 }
10441 retcode = JIM_OK;
10442 Jim_SetEmptyResult(interp);
10443 if (script != 0)
10444 retcode = Jim_EvalObj(interp, script);
10445 return retcode;
10446 wrongnumargs:
10447 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10448 "pattern body ... ?default body? or "
10449 "{pattern body ?pattern body ...?}");
10450 err:
10451 return retcode;
10452 }
10453
10454 /* [list] */
10455 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10456 Jim_Obj *const *argv)
10457 {
10458 Jim_Obj *listObjPtr;
10459
10460 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10461 Jim_SetResult(interp, listObjPtr);
10462 return JIM_OK;
10463 }
10464
10465 /* [lindex] */
10466 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10467 Jim_Obj *const *argv)
10468 {
10469 Jim_Obj *objPtr, *listObjPtr;
10470 int i;
10471 int index;
10472
10473 if (argc < 3) {
10474 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10475 return JIM_ERR;
10476 }
10477 objPtr = argv[1];
10478 Jim_IncrRefCount(objPtr);
10479 for (i = 2; i < argc; i++) {
10480 listObjPtr = objPtr;
10481 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10482 Jim_DecrRefCount(interp, listObjPtr);
10483 return JIM_ERR;
10484 }
10485 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10486 JIM_NONE) != JIM_OK) {
10487 /* Returns an empty object if the index
10488 * is out of range. */
10489 Jim_DecrRefCount(interp, listObjPtr);
10490 Jim_SetEmptyResult(interp);
10491 return JIM_OK;
10492 }
10493 Jim_IncrRefCount(objPtr);
10494 Jim_DecrRefCount(interp, listObjPtr);
10495 }
10496 Jim_SetResult(interp, objPtr);
10497 Jim_DecrRefCount(interp, objPtr);
10498 return JIM_OK;
10499 }
10500
10501 /* [llength] */
10502 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10503 Jim_Obj *const *argv)
10504 {
10505 int len;
10506
10507 if (argc != 2) {
10508 Jim_WrongNumArgs(interp, 1, argv, "list");
10509 return JIM_ERR;
10510 }
10511 Jim_ListLength(interp, argv[1], &len);
10512 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10513 return JIM_OK;
10514 }
10515
10516 /* [lappend] */
10517 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10518 Jim_Obj *const *argv)
10519 {
10520 Jim_Obj *listObjPtr;
10521 int shared, i;
10522
10523 if (argc < 2) {
10524 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10525 return JIM_ERR;
10526 }
10527 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10528 if (!listObjPtr) {
10529 /* Create the list if it does not exists */
10530 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10531 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10532 Jim_FreeNewObj(interp, listObjPtr);
10533 return JIM_ERR;
10534 }
10535 }
10536 shared = Jim_IsShared(listObjPtr);
10537 if (shared)
10538 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10539 for (i = 2; i < argc; i++)
10540 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10541 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10542 if (shared)
10543 Jim_FreeNewObj(interp, listObjPtr);
10544 return JIM_ERR;
10545 }
10546 Jim_SetResult(interp, listObjPtr);
10547 return JIM_OK;
10548 }
10549
10550 /* [linsert] */
10551 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10552 Jim_Obj *const *argv)
10553 {
10554 int index, len;
10555 Jim_Obj *listPtr;
10556
10557 if (argc < 4) {
10558 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10559 "?element ...?");
10560 return JIM_ERR;
10561 }
10562 listPtr = argv[1];
10563 if (Jim_IsShared(listPtr))
10564 listPtr = Jim_DuplicateObj(interp, listPtr);
10565 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10566 goto err;
10567 Jim_ListLength(interp, listPtr, &len);
10568 if (index >= len)
10569 index = len;
10570 else if (index < 0)
10571 index = len + index + 1;
10572 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10573 Jim_SetResult(interp, listPtr);
10574 return JIM_OK;
10575 err:
10576 if (listPtr != argv[1]) {
10577 Jim_FreeNewObj(interp, listPtr);
10578 }
10579 return JIM_ERR;
10580 }
10581
10582 /* [lset] */
10583 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10584 Jim_Obj *const *argv)
10585 {
10586 if (argc < 3) {
10587 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10588 return JIM_ERR;
10589 } else if (argc == 3) {
10590 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10591 return JIM_ERR;
10592 Jim_SetResult(interp, argv[2]);
10593 return JIM_OK;
10594 }
10595 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10596 == JIM_ERR) return JIM_ERR;
10597 return JIM_OK;
10598 }
10599
10600 /* [lsort] */
10601 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10602 {
10603 const char *options[] = {
10604 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10605 };
10606 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10607 Jim_Obj *resObj;
10608 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10609 int decreasing = 0;
10610
10611 if (argc < 2) {
10612 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10613 return JIM_ERR;
10614 }
10615 for (i = 1; i < (argc-1); i++) {
10616 int option;
10617
10618 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10619 != JIM_OK)
10620 return JIM_ERR;
10621 switch (option) {
10622 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10623 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10624 case OPT_INCREASING: decreasing = 0; break;
10625 case OPT_DECREASING: decreasing = 1; break;
10626 }
10627 }
10628 if (decreasing) {
10629 switch (lsortType) {
10630 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10631 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10632 }
10633 }
10634 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10635 ListSortElements(interp, resObj, lsortType);
10636 Jim_SetResult(interp, resObj);
10637 return JIM_OK;
10638 }
10639
10640 /* [append] */
10641 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10642 Jim_Obj *const *argv)
10643 {
10644 Jim_Obj *stringObjPtr;
10645 int shared, i;
10646
10647 if (argc < 2) {
10648 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10649 return JIM_ERR;
10650 }
10651 if (argc == 2) {
10652 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10653 if (!stringObjPtr) return JIM_ERR;
10654 } else {
10655 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10656 if (!stringObjPtr) {
10657 /* Create the string if it does not exists */
10658 stringObjPtr = Jim_NewEmptyStringObj(interp);
10659 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10660 != JIM_OK) {
10661 Jim_FreeNewObj(interp, stringObjPtr);
10662 return JIM_ERR;
10663 }
10664 }
10665 }
10666 shared = Jim_IsShared(stringObjPtr);
10667 if (shared)
10668 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10669 for (i = 2; i < argc; i++)
10670 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10671 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10672 if (shared)
10673 Jim_FreeNewObj(interp, stringObjPtr);
10674 return JIM_ERR;
10675 }
10676 Jim_SetResult(interp, stringObjPtr);
10677 return JIM_OK;
10678 }
10679
10680 /* [debug] */
10681 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10682 Jim_Obj *const *argv)
10683 {
10684 const char *options[] = {
10685 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10686 "exprbc",
10687 NULL
10688 };
10689 enum {
10690 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10691 OPT_EXPRLEN, OPT_EXPRBC
10692 };
10693 int option;
10694
10695 if (argc < 2) {
10696 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10697 return JIM_ERR;
10698 }
10699 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10700 JIM_ERRMSG) != JIM_OK)
10701 return JIM_ERR;
10702 if (option == OPT_REFCOUNT) {
10703 if (argc != 3) {
10704 Jim_WrongNumArgs(interp, 2, argv, "object");
10705 return JIM_ERR;
10706 }
10707 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10708 return JIM_OK;
10709 } else if (option == OPT_OBJCOUNT) {
10710 int freeobj = 0, liveobj = 0;
10711 char buf[256];
10712 Jim_Obj *objPtr;
10713
10714 if (argc != 2) {
10715 Jim_WrongNumArgs(interp, 2, argv, "");
10716 return JIM_ERR;
10717 }
10718 /* Count the number of free objects. */
10719 objPtr = interp->freeList;
10720 while (objPtr) {
10721 freeobj++;
10722 objPtr = objPtr->nextObjPtr;
10723 }
10724 /* Count the number of live objects. */
10725 objPtr = interp->liveList;
10726 while (objPtr) {
10727 liveobj++;
10728 objPtr = objPtr->nextObjPtr;
10729 }
10730 /* Set the result string and return. */
10731 sprintf(buf, "free %d used %d", freeobj, liveobj);
10732 Jim_SetResultString(interp, buf, -1);
10733 return JIM_OK;
10734 } else if (option == OPT_OBJECTS) {
10735 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10736 /* Count the number of live objects. */
10737 objPtr = interp->liveList;
10738 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10739 while (objPtr) {
10740 char buf[128];
10741 const char *type = objPtr->typePtr ?
10742 objPtr->typePtr->name : "";
10743 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10744 sprintf(buf, "%p", objPtr);
10745 Jim_ListAppendElement(interp, subListObjPtr,
10746 Jim_NewStringObj(interp, buf, -1));
10747 Jim_ListAppendElement(interp, subListObjPtr,
10748 Jim_NewStringObj(interp, type, -1));
10749 Jim_ListAppendElement(interp, subListObjPtr,
10750 Jim_NewIntObj(interp, objPtr->refCount));
10751 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10752 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10753 objPtr = objPtr->nextObjPtr;
10754 }
10755 Jim_SetResult(interp, listObjPtr);
10756 return JIM_OK;
10757 } else if (option == OPT_INVSTR) {
10758 Jim_Obj *objPtr;
10759
10760 if (argc != 3) {
10761 Jim_WrongNumArgs(interp, 2, argv, "object");
10762 return JIM_ERR;
10763 }
10764 objPtr = argv[2];
10765 if (objPtr->typePtr != NULL)
10766 Jim_InvalidateStringRep(objPtr);
10767 Jim_SetEmptyResult(interp);
10768 return JIM_OK;
10769 } else if (option == OPT_SCRIPTLEN) {
10770 ScriptObj *script;
10771 if (argc != 3) {
10772 Jim_WrongNumArgs(interp, 2, argv, "script");
10773 return JIM_ERR;
10774 }
10775 script = Jim_GetScript(interp, argv[2]);
10776 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10777 return JIM_OK;
10778 } else if (option == OPT_EXPRLEN) {
10779 ExprByteCode *expr;
10780 if (argc != 3) {
10781 Jim_WrongNumArgs(interp, 2, argv, "expression");
10782 return JIM_ERR;
10783 }
10784 expr = Jim_GetExpression(interp, argv[2]);
10785 if (expr == NULL)
10786 return JIM_ERR;
10787 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10788 return JIM_OK;
10789 } else if (option == OPT_EXPRBC) {
10790 Jim_Obj *objPtr;
10791 ExprByteCode *expr;
10792 int i;
10793
10794 if (argc != 3) {
10795 Jim_WrongNumArgs(interp, 2, argv, "expression");
10796 return JIM_ERR;
10797 }
10798 expr = Jim_GetExpression(interp, argv[2]);
10799 if (expr == NULL)
10800 return JIM_ERR;
10801 objPtr = Jim_NewListObj(interp, NULL, 0);
10802 for (i = 0; i < expr->len; i++) {
10803 const char *type;
10804 Jim_ExprOperator *op;
10805
10806 switch (expr->opcode[i]) {
10807 case JIM_EXPROP_NUMBER: type = "number"; break;
10808 case JIM_EXPROP_COMMAND: type = "command"; break;
10809 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10810 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10811 case JIM_EXPROP_SUBST: type = "subst"; break;
10812 case JIM_EXPROP_STRING: type = "string"; break;
10813 default:
10814 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10815 if (op == NULL) {
10816 type = "private";
10817 } else {
10818 type = "operator";
10819 }
10820 break;
10821 }
10822 Jim_ListAppendElement(interp, objPtr,
10823 Jim_NewStringObj(interp, type, -1));
10824 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10825 }
10826 Jim_SetResult(interp, objPtr);
10827 return JIM_OK;
10828 } else {
10829 Jim_SetResultString(interp,
10830 "bad option. Valid options are refcount, "
10831 "objcount, objects, invstr", -1);
10832 return JIM_ERR;
10833 }
10834 return JIM_OK; /* unreached */
10835 }
10836
10837 /* [eval] */
10838 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10839 Jim_Obj *const *argv)
10840 {
10841 if (argc == 2) {
10842 return Jim_EvalObj(interp, argv[1]);
10843 } else if (argc > 2) {
10844 Jim_Obj *objPtr;
10845 int retcode;
10846
10847 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10848 Jim_IncrRefCount(objPtr);
10849 retcode = Jim_EvalObj(interp, objPtr);
10850 Jim_DecrRefCount(interp, objPtr);
10851 return retcode;
10852 } else {
10853 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10854 return JIM_ERR;
10855 }
10856 }
10857
10858 /* [uplevel] */
10859 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10860 Jim_Obj *const *argv)
10861 {
10862 if (argc >= 2) {
10863 int retcode, newLevel, oldLevel;
10864 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10865 Jim_Obj *objPtr;
10866 const char *str;
10867
10868 /* Save the old callframe pointer */
10869 savedCallFrame = interp->framePtr;
10870
10871 /* Lookup the target frame pointer */
10872 str = Jim_GetString(argv[1], NULL);
10873 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10874 {
10875 if (Jim_GetCallFrameByLevel(interp, argv[1],
10876 &targetCallFrame,
10877 &newLevel) != JIM_OK)
10878 return JIM_ERR;
10879 argc--;
10880 argv++;
10881 } else {
10882 if (Jim_GetCallFrameByLevel(interp, NULL,
10883 &targetCallFrame,
10884 &newLevel) != JIM_OK)
10885 return JIM_ERR;
10886 }
10887 if (argc < 2) {
10888 argc++;
10889 argv--;
10890 Jim_WrongNumArgs(interp, 1, argv,
10891 "?level? command ?arg ...?");
10892 return JIM_ERR;
10893 }
10894 /* Eval the code in the target callframe. */
10895 interp->framePtr = targetCallFrame;
10896 oldLevel = interp->numLevels;
10897 interp->numLevels = newLevel;
10898 if (argc == 2) {
10899 retcode = Jim_EvalObj(interp, argv[1]);
10900 } else {
10901 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10902 Jim_IncrRefCount(objPtr);
10903 retcode = Jim_EvalObj(interp, objPtr);
10904 Jim_DecrRefCount(interp, objPtr);
10905 }
10906 interp->numLevels = oldLevel;
10907 interp->framePtr = savedCallFrame;
10908 return retcode;
10909 } else {
10910 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10911 return JIM_ERR;
10912 }
10913 }
10914
10915 /* [expr] */
10916 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10917 Jim_Obj *const *argv)
10918 {
10919 Jim_Obj *exprResultPtr;
10920 int retcode;
10921
10922 if (argc == 2) {
10923 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10924 } else if (argc > 2) {
10925 Jim_Obj *objPtr;
10926
10927 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10928 Jim_IncrRefCount(objPtr);
10929 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10930 Jim_DecrRefCount(interp, objPtr);
10931 } else {
10932 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10933 return JIM_ERR;
10934 }
10935 if (retcode != JIM_OK) return retcode;
10936 Jim_SetResult(interp, exprResultPtr);
10937 Jim_DecrRefCount(interp, exprResultPtr);
10938 return JIM_OK;
10939 }
10940
10941 /* [break] */
10942 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10943 Jim_Obj *const *argv)
10944 {
10945 if (argc != 1) {
10946 Jim_WrongNumArgs(interp, 1, argv, "");
10947 return JIM_ERR;
10948 }
10949 return JIM_BREAK;
10950 }
10951
10952 /* [continue] */
10953 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10954 Jim_Obj *const *argv)
10955 {
10956 if (argc != 1) {
10957 Jim_WrongNumArgs(interp, 1, argv, "");
10958 return JIM_ERR;
10959 }
10960 return JIM_CONTINUE;
10961 }
10962
10963 /* [return] */
10964 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10965 Jim_Obj *const *argv)
10966 {
10967 if (argc == 1) {
10968 return JIM_RETURN;
10969 } else if (argc == 2) {
10970 Jim_SetResult(interp, argv[1]);
10971 interp->returnCode = JIM_OK;
10972 return JIM_RETURN;
10973 } else if (argc == 3 || argc == 4) {
10974 int returnCode;
10975 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10976 return JIM_ERR;
10977 interp->returnCode = returnCode;
10978 if (argc == 4)
10979 Jim_SetResult(interp, argv[3]);
10980 return JIM_RETURN;
10981 } else {
10982 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10983 return JIM_ERR;
10984 }
10985 return JIM_RETURN; /* unreached */
10986 }
10987
10988 /* [tailcall] */
10989 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10990 Jim_Obj *const *argv)
10991 {
10992 Jim_Obj *objPtr;
10993
10994 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10995 Jim_SetResult(interp, objPtr);
10996 return JIM_EVAL;
10997 }
10998
10999 /* [proc] */
11000 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11001 Jim_Obj *const *argv)
11002 {
11003 int argListLen;
11004 int arityMin, arityMax;
11005
11006 if (argc != 4 && argc != 5) {
11007 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11008 return JIM_ERR;
11009 }
11010 Jim_ListLength(interp, argv[2], &argListLen);
11011 arityMin = arityMax = argListLen + 1;
11012
11013 if (argListLen) {
11014 const char *str;
11015 int len;
11016 Jim_Obj *argPtr=NULL;
11017
11018 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11019 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11020 str = Jim_GetString(argPtr, &len);
11021 if (len == 4 && memcmp(str, "args", 4) == 0) {
11022 arityMin--;
11023 arityMax = -1;
11024 }
11025
11026 /* Check for default arguments and reduce arityMin if necessary */
11027 while (arityMin > 1) {
11028 int len;
11029 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11030 Jim_ListLength(interp, argPtr, &len);
11031 if (len != 2) {
11032 /* No default argument */
11033 break;
11034 }
11035 arityMin--;
11036 }
11037 }
11038 if (argc == 4) {
11039 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11040 argv[2], NULL, argv[3], arityMin, arityMax);
11041 } else {
11042 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11043 argv[2], argv[3], argv[4], arityMin, arityMax);
11044 }
11045 }
11046
11047 /* [concat] */
11048 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11049 Jim_Obj *const *argv)
11050 {
11051 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11052 return JIM_OK;
11053 }
11054
11055 /* [upvar] */
11056 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11057 Jim_Obj *const *argv)
11058 {
11059 const char *str;
11060 int i;
11061 Jim_CallFrame *targetCallFrame;
11062
11063 /* Lookup the target frame pointer */
11064 str = Jim_GetString(argv[1], NULL);
11065 if (argc > 3 &&
11066 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11067 {
11068 if (Jim_GetCallFrameByLevel(interp, argv[1],
11069 &targetCallFrame, NULL) != JIM_OK)
11070 return JIM_ERR;
11071 argc--;
11072 argv++;
11073 } else {
11074 if (Jim_GetCallFrameByLevel(interp, NULL,
11075 &targetCallFrame, NULL) != JIM_OK)
11076 return JIM_ERR;
11077 }
11078 /* Check for arity */
11079 if (argc < 3 || ((argc-1)%2) != 0) {
11080 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11081 return JIM_ERR;
11082 }
11083 /* Now... for every other/local couple: */
11084 for (i = 1; i < argc; i += 2) {
11085 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11086 targetCallFrame) != JIM_OK) return JIM_ERR;
11087 }
11088 return JIM_OK;
11089 }
11090
11091 /* [global] */
11092 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11093 Jim_Obj *const *argv)
11094 {
11095 int i;
11096
11097 if (argc < 2) {
11098 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11099 return JIM_ERR;
11100 }
11101 /* Link every var to the toplevel having the same name */
11102 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11103 for (i = 1; i < argc; i++) {
11104 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11105 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11106 }
11107 return JIM_OK;
11108 }
11109
11110 /* does the [string map] operation. On error NULL is returned,
11111 * otherwise a new string object with the result, having refcount = 0,
11112 * is returned. */
11113 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11114 Jim_Obj *objPtr, int nocase)
11115 {
11116 int numMaps;
11117 const char **key, *str, *noMatchStart = NULL;
11118 Jim_Obj **value;
11119 int *keyLen, strLen, i;
11120 Jim_Obj *resultObjPtr;
11121
11122 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11123 if (numMaps % 2) {
11124 Jim_SetResultString(interp,
11125 "list must contain an even number of elements", -1);
11126 return NULL;
11127 }
11128 /* Initialization */
11129 numMaps /= 2;
11130 key = Jim_Alloc(sizeof(char*)*numMaps);
11131 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11132 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11133 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11134 for (i = 0; i < numMaps; i++) {
11135 Jim_Obj *eleObjPtr=NULL;
11136
11137 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11138 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11139 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11140 value[i] = eleObjPtr;
11141 }
11142 str = Jim_GetString(objPtr, &strLen);
11143 /* Map it */
11144 while (strLen) {
11145 for (i = 0; i < numMaps; i++) {
11146 if (strLen >= keyLen[i] && keyLen[i]) {
11147 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11148 nocase))
11149 {
11150 if (noMatchStart) {
11151 Jim_AppendString(interp, resultObjPtr,
11152 noMatchStart, str-noMatchStart);
11153 noMatchStart = NULL;
11154 }
11155 Jim_AppendObj(interp, resultObjPtr, value[i]);
11156 str += keyLen[i];
11157 strLen -= keyLen[i];
11158 break;
11159 }
11160 }
11161 }
11162 if (i == numMaps) { /* no match */
11163 if (noMatchStart == NULL)
11164 noMatchStart = str;
11165 str ++;
11166 strLen --;
11167 }
11168 }
11169 if (noMatchStart) {
11170 Jim_AppendString(interp, resultObjPtr,
11171 noMatchStart, str-noMatchStart);
11172 }
11173 Jim_Free((void*)key);
11174 Jim_Free(keyLen);
11175 Jim_Free(value);
11176 return resultObjPtr;
11177 }
11178
11179 /* [string] */
11180 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11181 Jim_Obj *const *argv)
11182 {
11183 int option;
11184 const char *options[] = {
11185 "length", "compare", "match", "equal", "range", "map", "repeat",
11186 "index", "first", "tolower", "toupper", NULL
11187 };
11188 enum {
11189 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11190 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11191 };
11192
11193 if (argc < 2) {
11194 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11195 return JIM_ERR;
11196 }
11197 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11198 JIM_ERRMSG) != JIM_OK)
11199 return JIM_ERR;
11200
11201 if (option == OPT_LENGTH) {
11202 int len;
11203
11204 if (argc != 3) {
11205 Jim_WrongNumArgs(interp, 2, argv, "string");
11206 return JIM_ERR;
11207 }
11208 Jim_GetString(argv[2], &len);
11209 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11210 return JIM_OK;
11211 } else if (option == OPT_COMPARE) {
11212 int nocase = 0;
11213 if ((argc != 4 && argc != 5) ||
11214 (argc == 5 && Jim_CompareStringImmediate(interp,
11215 argv[2], "-nocase") == 0)) {
11216 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11217 return JIM_ERR;
11218 }
11219 if (argc == 5) {
11220 nocase = 1;
11221 argv++;
11222 }
11223 Jim_SetResult(interp, Jim_NewIntObj(interp,
11224 Jim_StringCompareObj(argv[2],
11225 argv[3], nocase)));
11226 return JIM_OK;
11227 } else if (option == OPT_MATCH) {
11228 int nocase = 0;
11229 if ((argc != 4 && argc != 5) ||
11230 (argc == 5 && Jim_CompareStringImmediate(interp,
11231 argv[2], "-nocase") == 0)) {
11232 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11233 "string");
11234 return JIM_ERR;
11235 }
11236 if (argc == 5) {
11237 nocase = 1;
11238 argv++;
11239 }
11240 Jim_SetResult(interp,
11241 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11242 argv[3], nocase)));
11243 return JIM_OK;
11244 } else if (option == OPT_EQUAL) {
11245 if (argc != 4) {
11246 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11247 return JIM_ERR;
11248 }
11249 Jim_SetResult(interp,
11250 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11251 argv[3], 0)));
11252 return JIM_OK;
11253 } else if (option == OPT_RANGE) {
11254 Jim_Obj *objPtr;
11255
11256 if (argc != 5) {
11257 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11258 return JIM_ERR;
11259 }
11260 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11261 if (objPtr == NULL)
11262 return JIM_ERR;
11263 Jim_SetResult(interp, objPtr);
11264 return JIM_OK;
11265 } else if (option == OPT_MAP) {
11266 int nocase = 0;
11267 Jim_Obj *objPtr;
11268
11269 if ((argc != 4 && argc != 5) ||
11270 (argc == 5 && Jim_CompareStringImmediate(interp,
11271 argv[2], "-nocase") == 0)) {
11272 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11273 "string");
11274 return JIM_ERR;
11275 }
11276 if (argc == 5) {
11277 nocase = 1;
11278 argv++;
11279 }
11280 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11281 if (objPtr == NULL)
11282 return JIM_ERR;
11283 Jim_SetResult(interp, objPtr);
11284 return JIM_OK;
11285 } else if (option == OPT_REPEAT) {
11286 Jim_Obj *objPtr;
11287 jim_wide count;
11288
11289 if (argc != 4) {
11290 Jim_WrongNumArgs(interp, 2, argv, "string count");
11291 return JIM_ERR;
11292 }
11293 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11294 return JIM_ERR;
11295 objPtr = Jim_NewStringObj(interp, "", 0);
11296 while (count--) {
11297 Jim_AppendObj(interp, objPtr, argv[2]);
11298 }
11299 Jim_SetResult(interp, objPtr);
11300 return JIM_OK;
11301 } else if (option == OPT_INDEX) {
11302 int index, len;
11303 const char *str;
11304
11305 if (argc != 4) {
11306 Jim_WrongNumArgs(interp, 2, argv, "string index");
11307 return JIM_ERR;
11308 }
11309 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11310 return JIM_ERR;
11311 str = Jim_GetString(argv[2], &len);
11312 if (index != INT_MIN && index != INT_MAX)
11313 index = JimRelToAbsIndex(len, index);
11314 if (index < 0 || index >= len) {
11315 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11316 return JIM_OK;
11317 } else {
11318 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11319 return JIM_OK;
11320 }
11321 } else if (option == OPT_FIRST) {
11322 int index = 0, l1, l2;
11323 const char *s1, *s2;
11324
11325 if (argc != 4 && argc != 5) {
11326 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11327 return JIM_ERR;
11328 }
11329 s1 = Jim_GetString(argv[2], &l1);
11330 s2 = Jim_GetString(argv[3], &l2);
11331 if (argc == 5) {
11332 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11333 return JIM_ERR;
11334 index = JimRelToAbsIndex(l2, index);
11335 }
11336 Jim_SetResult(interp, Jim_NewIntObj(interp,
11337 JimStringFirst(s1, l1, s2, l2, index)));
11338 return JIM_OK;
11339 } else if (option == OPT_TOLOWER) {
11340 if (argc != 3) {
11341 Jim_WrongNumArgs(interp, 2, argv, "string");
11342 return JIM_ERR;
11343 }
11344 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11345 } else if (option == OPT_TOUPPER) {
11346 if (argc != 3) {
11347 Jim_WrongNumArgs(interp, 2, argv, "string");
11348 return JIM_ERR;
11349 }
11350 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11351 }
11352 return JIM_OK;
11353 }
11354
11355 /* [time] */
11356 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11357 Jim_Obj *const *argv)
11358 {
11359 long i, count = 1;
11360 jim_wide start, elapsed;
11361 char buf [256];
11362 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11363
11364 if (argc < 2) {
11365 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11366 return JIM_ERR;
11367 }
11368 if (argc == 3) {
11369 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11370 return JIM_ERR;
11371 }
11372 if (count < 0)
11373 return JIM_OK;
11374 i = count;
11375 start = JimClock();
11376 while (i-- > 0) {
11377 int retval;
11378
11379 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11380 return retval;
11381 }
11382 elapsed = JimClock() - start;
11383 sprintf(buf, fmt, elapsed/count);
11384 Jim_SetResultString(interp, buf, -1);
11385 return JIM_OK;
11386 }
11387
11388 /* [exit] */
11389 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11390 Jim_Obj *const *argv)
11391 {
11392 long exitCode = 0;
11393
11394 if (argc > 2) {
11395 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11396 return JIM_ERR;
11397 }
11398 if (argc == 2) {
11399 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11400 return JIM_ERR;
11401 }
11402 interp->exitCode = exitCode;
11403 return JIM_EXIT;
11404 }
11405
11406 /* [catch] */
11407 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11408 Jim_Obj *const *argv)
11409 {
11410 int exitCode = 0;
11411
11412 if (argc != 2 && argc != 3) {
11413 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11414 return JIM_ERR;
11415 }
11416 exitCode = Jim_EvalObj(interp, argv[1]);
11417 if (argc == 3) {
11418 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11419 != JIM_OK)
11420 return JIM_ERR;
11421 }
11422 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11423 return JIM_OK;
11424 }
11425
11426 /* [ref] */
11427 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11428 Jim_Obj *const *argv)
11429 {
11430 if (argc != 3 && argc != 4) {
11431 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11432 return JIM_ERR;
11433 }
11434 if (argc == 3) {
11435 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11436 } else {
11437 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11438 argv[3]));
11439 }
11440 return JIM_OK;
11441 }
11442
11443 /* [getref] */
11444 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11445 Jim_Obj *const *argv)
11446 {
11447 Jim_Reference *refPtr;
11448
11449 if (argc != 2) {
11450 Jim_WrongNumArgs(interp, 1, argv, "reference");
11451 return JIM_ERR;
11452 }
11453 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11454 return JIM_ERR;
11455 Jim_SetResult(interp, refPtr->objPtr);
11456 return JIM_OK;
11457 }
11458
11459 /* [setref] */
11460 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11461 Jim_Obj *const *argv)
11462 {
11463 Jim_Reference *refPtr;
11464
11465 if (argc != 3) {
11466 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11467 return JIM_ERR;
11468 }
11469 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11470 return JIM_ERR;
11471 Jim_IncrRefCount(argv[2]);
11472 Jim_DecrRefCount(interp, refPtr->objPtr);
11473 refPtr->objPtr = argv[2];
11474 Jim_SetResult(interp, argv[2]);
11475 return JIM_OK;
11476 }
11477
11478 /* [collect] */
11479 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11480 Jim_Obj *const *argv)
11481 {
11482 if (argc != 1) {
11483 Jim_WrongNumArgs(interp, 1, argv, "");
11484 return JIM_ERR;
11485 }
11486 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11487 return JIM_OK;
11488 }
11489
11490 /* [finalize] reference ?newValue? */
11491 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11492 Jim_Obj *const *argv)
11493 {
11494 if (argc != 2 && argc != 3) {
11495 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11496 return JIM_ERR;
11497 }
11498 if (argc == 2) {
11499 Jim_Obj *cmdNamePtr;
11500
11501 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11502 return JIM_ERR;
11503 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11504 Jim_SetResult(interp, cmdNamePtr);
11505 } else {
11506 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11507 return JIM_ERR;
11508 Jim_SetResult(interp, argv[2]);
11509 }
11510 return JIM_OK;
11511 }
11512
11513 /* TODO */
11514 /* [info references] (list of all the references/finalizers) */
11515
11516 /* [rename] */
11517 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11518 Jim_Obj *const *argv)
11519 {
11520 const char *oldName, *newName;
11521
11522 if (argc != 3) {
11523 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11524 return JIM_ERR;
11525 }
11526 oldName = Jim_GetString(argv[1], NULL);
11527 newName = Jim_GetString(argv[2], NULL);
11528 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11529 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11530 Jim_AppendStrings(interp, Jim_GetResult(interp),
11531 "can't rename \"", oldName, "\": ",
11532 "command doesn't exist", NULL);
11533 return JIM_ERR;
11534 }
11535 return JIM_OK;
11536 }
11537
11538 /* [dict] */
11539 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11540 Jim_Obj *const *argv)
11541 {
11542 int option;
11543 const char *options[] = {
11544 "create", "get", "set", "unset", "exists", NULL
11545 };
11546 enum {
11547 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11548 };
11549
11550 if (argc < 2) {
11551 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11552 return JIM_ERR;
11553 }
11554
11555 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11556 JIM_ERRMSG) != JIM_OK)
11557 return JIM_ERR;
11558
11559 if (option == OPT_CREATE) {
11560 Jim_Obj *objPtr;
11561
11562 if (argc % 2) {
11563 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11564 return JIM_ERR;
11565 }
11566 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11567 Jim_SetResult(interp, objPtr);
11568 return JIM_OK;
11569 } else if (option == OPT_GET) {
11570 Jim_Obj *objPtr;
11571
11572 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11573 JIM_ERRMSG) != JIM_OK)
11574 return JIM_ERR;
11575 Jim_SetResult(interp, objPtr);
11576 return JIM_OK;
11577 } else if (option == OPT_SET) {
11578 if (argc < 5) {
11579 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11580 return JIM_ERR;
11581 }
11582 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11583 argv[argc-1]);
11584 } else if (option == OPT_UNSET) {
11585 if (argc < 4) {
11586 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11587 return JIM_ERR;
11588 }
11589 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11590 NULL);
11591 } else if (option == OPT_EXIST) {
11592 Jim_Obj *objPtr;
11593 int exists;
11594
11595 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11596 JIM_ERRMSG) == JIM_OK)
11597 exists = 1;
11598 else
11599 exists = 0;
11600 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11601 return JIM_OK;
11602 } else {
11603 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11604 Jim_AppendStrings(interp, Jim_GetResult(interp),
11605 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11606 " must be create, get, set", NULL);
11607 return JIM_ERR;
11608 }
11609 return JIM_OK;
11610 }
11611
11612 /* [load] */
11613 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11614 Jim_Obj *const *argv)
11615 {
11616 if (argc < 2) {
11617 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11618 return JIM_ERR;
11619 }
11620 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11621 }
11622
11623 /* [subst] */
11624 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11625 Jim_Obj *const *argv)
11626 {
11627 int i, flags = 0;
11628 Jim_Obj *objPtr;
11629
11630 if (argc < 2) {
11631 Jim_WrongNumArgs(interp, 1, argv,
11632 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11633 return JIM_ERR;
11634 }
11635 i = argc-2;
11636 while (i--) {
11637 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11638 "-nobackslashes"))
11639 flags |= JIM_SUBST_NOESC;
11640 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11641 "-novariables"))
11642 flags |= JIM_SUBST_NOVAR;
11643 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11644 "-nocommands"))
11645 flags |= JIM_SUBST_NOCMD;
11646 else {
11647 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11648 Jim_AppendStrings(interp, Jim_GetResult(interp),
11649 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11650 "\": must be -nobackslashes, -nocommands, or "
11651 "-novariables", NULL);
11652 return JIM_ERR;
11653 }
11654 }
11655 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11656 return JIM_ERR;
11657 Jim_SetResult(interp, objPtr);
11658 return JIM_OK;
11659 }
11660
11661 /* [info] */
11662 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11663 Jim_Obj *const *argv)
11664 {
11665 int cmd, result = JIM_OK;
11666 static const char *commands[] = {
11667 "body", "commands", "exists", "globals", "level", "locals",
11668 "vars", "version", "complete", "args", "hostname", NULL
11669 };
11670 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11671 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11672
11673 if (argc < 2) {
11674 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11675 return JIM_ERR;
11676 }
11677 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11678 != JIM_OK) {
11679 return JIM_ERR;
11680 }
11681
11682 if (cmd == INFO_COMMANDS) {
11683 if (argc != 2 && argc != 3) {
11684 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11685 return JIM_ERR;
11686 }
11687 if (argc == 3)
11688 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11689 else
11690 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11691 } else if (cmd == INFO_EXISTS) {
11692 Jim_Obj *exists;
11693 if (argc != 3) {
11694 Jim_WrongNumArgs(interp, 2, argv, "varName");
11695 return JIM_ERR;
11696 }
11697 exists = Jim_GetVariable(interp, argv[2], 0);
11698 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11699 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11700 int mode;
11701 switch (cmd) {
11702 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11703 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11704 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11705 default: mode = 0; /* avoid warning */; break;
11706 }
11707 if (argc != 2 && argc != 3) {
11708 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11709 return JIM_ERR;
11710 }
11711 if (argc == 3)
11712 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11713 else
11714 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11715 } else if (cmd == INFO_LEVEL) {
11716 Jim_Obj *objPtr;
11717 switch (argc) {
11718 case 2:
11719 Jim_SetResult(interp,
11720 Jim_NewIntObj(interp, interp->numLevels));
11721 break;
11722 case 3:
11723 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11724 return JIM_ERR;
11725 Jim_SetResult(interp, objPtr);
11726 break;
11727 default:
11728 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11729 return JIM_ERR;
11730 }
11731 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11732 Jim_Cmd *cmdPtr;
11733
11734 if (argc != 3) {
11735 Jim_WrongNumArgs(interp, 2, argv, "procname");
11736 return JIM_ERR;
11737 }
11738 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11739 return JIM_ERR;
11740 if (cmdPtr->cmdProc != NULL) {
11741 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11742 Jim_AppendStrings(interp, Jim_GetResult(interp),
11743 "command \"", Jim_GetString(argv[2], NULL),
11744 "\" is not a procedure", NULL);
11745 return JIM_ERR;
11746 }
11747 if (cmd == INFO_BODY)
11748 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11749 else
11750 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11751 } else if (cmd == INFO_VERSION) {
11752 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11753 sprintf(buf, "%d.%d",
11754 JIM_VERSION / 100, JIM_VERSION % 100);
11755 Jim_SetResultString(interp, buf, -1);
11756 } else if (cmd == INFO_COMPLETE) {
11757 const char *s;
11758 int len;
11759
11760 if (argc != 3) {
11761 Jim_WrongNumArgs(interp, 2, argv, "script");
11762 return JIM_ERR;
11763 }
11764 s = Jim_GetString(argv[2], &len);
11765 Jim_SetResult(interp,
11766 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11767 } else if (cmd == INFO_HOSTNAME) {
11768 /* Redirect to os.hostname if it exists */
11769 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11770 result = Jim_EvalObjVector(interp, 1, &command);
11771 }
11772 return result;
11773 }
11774
11775 /* [split] */
11776 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11777 Jim_Obj *const *argv)
11778 {
11779 const char *str, *splitChars, *noMatchStart;
11780 int splitLen, strLen, i;
11781 Jim_Obj *resObjPtr;
11782
11783 if (argc != 2 && argc != 3) {
11784 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11785 return JIM_ERR;
11786 }
11787 /* Init */
11788 if (argc == 2) {
11789 splitChars = " \n\t\r";
11790 splitLen = 4;
11791 } else {
11792 splitChars = Jim_GetString(argv[2], &splitLen);
11793 }
11794 str = Jim_GetString(argv[1], &strLen);
11795 if (!strLen) return JIM_OK;
11796 noMatchStart = str;
11797 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11798 /* Split */
11799 if (splitLen) {
11800 while (strLen) {
11801 for (i = 0; i < splitLen; i++) {
11802 if (*str == splitChars[i]) {
11803 Jim_Obj *objPtr;
11804
11805 objPtr = Jim_NewStringObj(interp, noMatchStart,
11806 (str-noMatchStart));
11807 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11808 noMatchStart = str + 1;
11809 break;
11810 }
11811 }
11812 str ++;
11813 strLen --;
11814 }
11815 Jim_ListAppendElement(interp, resObjPtr,
11816 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11817 } else {
11818 /* This handles the special case of splitchars eq {}. This
11819 * is trivial but we want to perform object sharing as Tcl does. */
11820 Jim_Obj *objCache[256];
11821 const unsigned char *u = (unsigned char*) str;
11822 memset(objCache, 0, sizeof(objCache));
11823 for (i = 0; i < strLen; i++) {
11824 int c = u[i];
11825
11826 if (objCache[c] == NULL)
11827 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11828 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11829 }
11830 }
11831 Jim_SetResult(interp, resObjPtr);
11832 return JIM_OK;
11833 }
11834
11835 /* [join] */
11836 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11837 Jim_Obj *const *argv)
11838 {
11839 const char *joinStr;
11840 int joinStrLen, i, listLen;
11841 Jim_Obj *resObjPtr;
11842
11843 if (argc != 2 && argc != 3) {
11844 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11845 return JIM_ERR;
11846 }
11847 /* Init */
11848 if (argc == 2) {
11849 joinStr = " ";
11850 joinStrLen = 1;
11851 } else {
11852 joinStr = Jim_GetString(argv[2], &joinStrLen);
11853 }
11854 Jim_ListLength(interp, argv[1], &listLen);
11855 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11856 /* Split */
11857 for (i = 0; i < listLen; i++) {
11858 Jim_Obj *objPtr=NULL;
11859
11860 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11861 Jim_AppendObj(interp, resObjPtr, objPtr);
11862 if (i + 1 != listLen) {
11863 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11864 }
11865 }
11866 Jim_SetResult(interp, resObjPtr);
11867 return JIM_OK;
11868 }
11869
11870 /* [format] */
11871 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11872 Jim_Obj *const *argv)
11873 {
11874 Jim_Obj *objPtr;
11875
11876 if (argc < 2) {
11877 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11878 return JIM_ERR;
11879 }
11880 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11881 if (objPtr == NULL)
11882 return JIM_ERR;
11883 Jim_SetResult(interp, objPtr);
11884 return JIM_OK;
11885 }
11886
11887 /* [scan] */
11888 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11889 Jim_Obj *const *argv)
11890 {
11891 Jim_Obj *listPtr, **outVec;
11892 int outc, i, count = 0;
11893
11894 if (argc < 3) {
11895 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11896 return JIM_ERR;
11897 }
11898 if (argv[2]->typePtr != &scanFmtStringObjType)
11899 SetScanFmtFromAny(interp, argv[2]);
11900 if (FormatGetError(argv[2]) != 0) {
11901 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11902 return JIM_ERR;
11903 }
11904 if (argc > 3) {
11905 int maxPos = FormatGetMaxPos(argv[2]);
11906 int count = FormatGetCnvCount(argv[2]);
11907 if (maxPos > argc-3) {
11908 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11909 return JIM_ERR;
11910 } else if (count != 0 && count < argc-3) {
11911 Jim_SetResultString(interp, "variable is not assigned by any "
11912 "conversion specifiers", -1);
11913 return JIM_ERR;
11914 } else if (count > argc-3) {
11915 Jim_SetResultString(interp, "different numbers of variable names and "
11916 "field specifiers", -1);
11917 return JIM_ERR;
11918 }
11919 }
11920 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11921 if (listPtr == 0)
11922 return JIM_ERR;
11923 if (argc > 3) {
11924 int len = 0;
11925 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11926 Jim_ListLength(interp, listPtr, &len);
11927 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11928 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11929 return JIM_OK;
11930 }
11931 JimListGetElements(interp, listPtr, &outc, &outVec);
11932 for (i = 0; i < outc; ++i) {
11933 if (Jim_Length(outVec[i]) > 0) {
11934 ++count;
11935 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11936 goto err;
11937 }
11938 }
11939 Jim_FreeNewObj(interp, listPtr);
11940 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11941 } else {
11942 if (listPtr == (Jim_Obj*)EOF) {
11943 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11944 return JIM_OK;
11945 }
11946 Jim_SetResult(interp, listPtr);
11947 }
11948 return JIM_OK;
11949 err:
11950 Jim_FreeNewObj(interp, listPtr);
11951 return JIM_ERR;
11952 }
11953
11954 /* [error] */
11955 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11956 Jim_Obj *const *argv)
11957 {
11958 if (argc != 2) {
11959 Jim_WrongNumArgs(interp, 1, argv, "message");
11960 return JIM_ERR;
11961 }
11962 Jim_SetResult(interp, argv[1]);
11963 return JIM_ERR;
11964 }
11965
11966 /* [lrange] */
11967 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11968 Jim_Obj *const *argv)
11969 {
11970 Jim_Obj *objPtr;
11971
11972 if (argc != 4) {
11973 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11974 return JIM_ERR;
11975 }
11976 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11977 return JIM_ERR;
11978 Jim_SetResult(interp, objPtr);
11979 return JIM_OK;
11980 }
11981
11982 /* [env] */
11983 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11984 Jim_Obj *const *argv)
11985 {
11986 const char *key;
11987 char *val;
11988
11989 if (argc == 1) {
11990
11991 #ifdef NEED_ENVIRON_EXTERN
11992 extern char **environ;
11993 #endif
11994
11995 int i;
11996 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11997
11998 for (i = 0; environ[i]; i++) {
11999 const char *equals = strchr(environ[i], '=');
12000 if (equals) {
12001 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
12002 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12003 }
12004 }
12005
12006 Jim_SetResult(interp, listObjPtr);
12007 return JIM_OK;
12008 }
12009
12010 if (argc != 2) {
12011 Jim_WrongNumArgs(interp, 1, argv, "varName");
12012 return JIM_ERR;
12013 }
12014 key = Jim_GetString(argv[1], NULL);
12015 val = getenv(key);
12016 if (val == NULL) {
12017 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12018 Jim_AppendStrings(interp, Jim_GetResult(interp),
12019 "environment variable \"",
12020 key, "\" does not exist", NULL);
12021 return JIM_ERR;
12022 }
12023 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12024 return JIM_OK;
12025 }
12026
12027 /* [source] */
12028 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12029 Jim_Obj *const *argv)
12030 {
12031 int retval;
12032
12033 if (argc != 2) {
12034 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12035 return JIM_ERR;
12036 }
12037 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12038 if (retval == JIM_ERR) {
12039 return JIM_ERR_ADDSTACK;
12040 }
12041 if (retval == JIM_RETURN)
12042 return JIM_OK;
12043 return retval;
12044 }
12045
12046 /* [lreverse] */
12047 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12048 Jim_Obj *const *argv)
12049 {
12050 Jim_Obj *revObjPtr, **ele;
12051 int len;
12052
12053 if (argc != 2) {
12054 Jim_WrongNumArgs(interp, 1, argv, "list");
12055 return JIM_ERR;
12056 }
12057 JimListGetElements(interp, argv[1], &len, &ele);
12058 len--;
12059 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12060 while (len >= 0)
12061 ListAppendElement(revObjPtr, ele[len--]);
12062 Jim_SetResult(interp, revObjPtr);
12063 return JIM_OK;
12064 }
12065
12066 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12067 {
12068 jim_wide len;
12069
12070 if (step == 0) return -1;
12071 if (start == end) return 0;
12072 else if (step > 0 && start > end) return -1;
12073 else if (step < 0 && end > start) return -1;
12074 len = end-start;
12075 if (len < 0) len = -len; /* abs(len) */
12076 if (step < 0) step = -step; /* abs(step) */
12077 len = 1 + ((len-1)/step);
12078 /* We can truncate safely to INT_MAX, the range command
12079 * will always return an error for a such long range
12080 * because Tcl lists can't be so long. */
12081 if (len > INT_MAX) len = INT_MAX;
12082 return (int)((len < 0) ? -1 : len);
12083 }
12084
12085 /* [range] */
12086 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12087 Jim_Obj *const *argv)
12088 {
12089 jim_wide start = 0, end, step = 1;
12090 int len, i;
12091 Jim_Obj *objPtr;
12092
12093 if (argc < 2 || argc > 4) {
12094 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12095 return JIM_ERR;
12096 }
12097 if (argc == 2) {
12098 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12099 return JIM_ERR;
12100 } else {
12101 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12102 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12103 return JIM_ERR;
12104 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12105 return JIM_ERR;
12106 }
12107 if ((len = JimRangeLen(start, end, step)) == -1) {
12108 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12109 return JIM_ERR;
12110 }
12111 objPtr = Jim_NewListObj(interp, NULL, 0);
12112 for (i = 0; i < len; i++)
12113 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12114 Jim_SetResult(interp, objPtr);
12115 return JIM_OK;
12116 }
12117
12118 /* [rand] */
12119 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12120 Jim_Obj *const *argv)
12121 {
12122 jim_wide min = 0, max =0, len, maxMul;
12123
12124 if (argc < 1 || argc > 3) {
12125 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12126 return JIM_ERR;
12127 }
12128 if (argc == 1) {
12129 max = JIM_WIDE_MAX;
12130 } else if (argc == 2) {
12131 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12132 return JIM_ERR;
12133 } else if (argc == 3) {
12134 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12135 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12136 return JIM_ERR;
12137 }
12138 len = max-min;
12139 if (len < 0) {
12140 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12141 return JIM_ERR;
12142 }
12143 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12144 while (1) {
12145 jim_wide r;
12146
12147 JimRandomBytes(interp, &r, sizeof(jim_wide));
12148 if (r < 0 || r >= maxMul) continue;
12149 r = (len == 0) ? 0 : r%len;
12150 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12151 return JIM_OK;
12152 }
12153 }
12154
12155 /* [package] */
12156 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12157 Jim_Obj *const *argv)
12158 {
12159 int option;
12160 const char *options[] = {
12161 "require", "provide", NULL
12162 };
12163 enum {OPT_REQUIRE, OPT_PROVIDE};
12164
12165 if (argc < 2) {
12166 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12167 return JIM_ERR;
12168 }
12169 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12170 JIM_ERRMSG) != JIM_OK)
12171 return JIM_ERR;
12172
12173 if (option == OPT_REQUIRE) {
12174 int exact = 0;
12175 const char *ver;
12176
12177 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12178 exact = 1;
12179 argv++;
12180 argc--;
12181 }
12182 if (argc != 3 && argc != 4) {
12183 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12184 return JIM_ERR;
12185 }
12186 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12187 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12188 JIM_ERRMSG);
12189 if (ver == NULL)
12190 return JIM_ERR_ADDSTACK;
12191 Jim_SetResultString(interp, ver, -1);
12192 } else if (option == OPT_PROVIDE) {
12193 if (argc != 4) {
12194 Jim_WrongNumArgs(interp, 2, argv, "package version");
12195 return JIM_ERR;
12196 }
12197 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12198 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12199 }
12200 return JIM_OK;
12201 }
12202
12203 static struct {
12204 const char *name;
12205 Jim_CmdProc cmdProc;
12206 } Jim_CoreCommandsTable[] = {
12207 {"set", Jim_SetCoreCommand},
12208 {"unset", Jim_UnsetCoreCommand},
12209 {"puts", Jim_PutsCoreCommand},
12210 {"+", Jim_AddCoreCommand},
12211 {"*", Jim_MulCoreCommand},
12212 {"-", Jim_SubCoreCommand},
12213 {"/", Jim_DivCoreCommand},
12214 {"incr", Jim_IncrCoreCommand},
12215 {"while", Jim_WhileCoreCommand},
12216 {"for", Jim_ForCoreCommand},
12217 {"foreach", Jim_ForeachCoreCommand},
12218 {"lmap", Jim_LmapCoreCommand},
12219 {"if", Jim_IfCoreCommand},
12220 {"switch", Jim_SwitchCoreCommand},
12221 {"list", Jim_ListCoreCommand},
12222 {"lindex", Jim_LindexCoreCommand},
12223 {"lset", Jim_LsetCoreCommand},
12224 {"llength", Jim_LlengthCoreCommand},
12225 {"lappend", Jim_LappendCoreCommand},
12226 {"linsert", Jim_LinsertCoreCommand},
12227 {"lsort", Jim_LsortCoreCommand},
12228 {"append", Jim_AppendCoreCommand},
12229 {"debug", Jim_DebugCoreCommand},
12230 {"eval", Jim_EvalCoreCommand},
12231 {"uplevel", Jim_UplevelCoreCommand},
12232 {"expr", Jim_ExprCoreCommand},
12233 {"break", Jim_BreakCoreCommand},
12234 {"continue", Jim_ContinueCoreCommand},
12235 {"proc", Jim_ProcCoreCommand},
12236 {"concat", Jim_ConcatCoreCommand},
12237 {"return", Jim_ReturnCoreCommand},
12238 {"upvar", Jim_UpvarCoreCommand},
12239 {"global", Jim_GlobalCoreCommand},
12240 {"string", Jim_StringCoreCommand},
12241 {"time", Jim_TimeCoreCommand},
12242 {"exit", Jim_ExitCoreCommand},
12243 {"catch", Jim_CatchCoreCommand},
12244 {"ref", Jim_RefCoreCommand},
12245 {"getref", Jim_GetrefCoreCommand},
12246 {"setref", Jim_SetrefCoreCommand},
12247 {"finalize", Jim_FinalizeCoreCommand},
12248 {"collect", Jim_CollectCoreCommand},
12249 {"rename", Jim_RenameCoreCommand},
12250 {"dict", Jim_DictCoreCommand},
12251 {"load", Jim_LoadCoreCommand},
12252 {"subst", Jim_SubstCoreCommand},
12253 {"info", Jim_InfoCoreCommand},
12254 {"split", Jim_SplitCoreCommand},
12255 {"join", Jim_JoinCoreCommand},
12256 {"format", Jim_FormatCoreCommand},
12257 {"scan", Jim_ScanCoreCommand},
12258 {"error", Jim_ErrorCoreCommand},
12259 {"lrange", Jim_LrangeCoreCommand},
12260 {"env", Jim_EnvCoreCommand},
12261 {"source", Jim_SourceCoreCommand},
12262 {"lreverse", Jim_LreverseCoreCommand},
12263 {"range", Jim_RangeCoreCommand},
12264 {"rand", Jim_RandCoreCommand},
12265 {"package", Jim_PackageCoreCommand},
12266 {"tailcall", Jim_TailcallCoreCommand},
12267 {NULL, NULL},
12268 };
12269
12270 /* Some Jim core command is actually a procedure written in Jim itself. */
12271 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12272 {
12273 Jim_Eval(interp, (char*)
12274 "proc lambda {arglist args} {\n"
12275 " set name [ref {} function lambdaFinalizer]\n"
12276 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12277 " return $name\n"
12278 "}\n"
12279 "proc lambdaFinalizer {name val} {\n"
12280 " rename $name {}\n"
12281 "}\n"
12282 );
12283 }
12284
12285 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12286 {
12287 int i = 0;
12288
12289 while (Jim_CoreCommandsTable[i].name != NULL) {
12290 Jim_CreateCommand(interp,
12291 Jim_CoreCommandsTable[i].name,
12292 Jim_CoreCommandsTable[i].cmdProc,
12293 NULL, NULL);
12294 i++;
12295 }
12296 Jim_RegisterCoreProcedures(interp);
12297 }
12298
12299 /* -----------------------------------------------------------------------------
12300 * Interactive prompt
12301 * ---------------------------------------------------------------------------*/
12302 void Jim_PrintErrorMessage(Jim_Interp *interp)
12303 {
12304 int len, i;
12305
12306 if (*interp->errorFileName) {
12307 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12308 interp->errorFileName, interp->errorLine);
12309 }
12310 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12311 Jim_GetString(interp->result, NULL));
12312 Jim_ListLength(interp, interp->stackTrace, &len);
12313 for (i = len-3; i >= 0; i-= 3) {
12314 Jim_Obj *objPtr=NULL;
12315 const char *proc, *file, *line;
12316
12317 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12318 proc = Jim_GetString(objPtr, NULL);
12319 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12320 JIM_NONE);
12321 file = Jim_GetString(objPtr, NULL);
12322 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12323 JIM_NONE);
12324 line = Jim_GetString(objPtr, NULL);
12325 if (*proc) {
12326 Jim_fprintf(interp, interp->cookie_stderr,
12327 "in procedure '%s' ", proc);
12328 }
12329 if (*file) {
12330 Jim_fprintf(interp, interp->cookie_stderr,
12331 "called at file \"%s\", line %s",
12332 file, line);
12333 }
12334 if (*file || *proc) {
12335 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12336 }
12337 }
12338 }
12339
12340 int Jim_InteractivePrompt(Jim_Interp *interp)
12341 {
12342 int retcode = JIM_OK;
12343 Jim_Obj *scriptObjPtr;
12344
12345 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12346 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12347 JIM_VERSION / 100, JIM_VERSION % 100);
12348 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12349 while (1) {
12350 char buf[1024];
12351 const char *result;
12352 const char *retcodestr[] = {
12353 "ok", "error", "return", "break", "continue", "eval", "exit"
12354 };
12355 int reslen;
12356
12357 if (retcode != 0) {
12358 if (retcode >= 2 && retcode <= 6)
12359 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12360 else
12361 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12362 } else
12363 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12364 Jim_fflush(interp, interp->cookie_stdout);
12365 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12366 Jim_IncrRefCount(scriptObjPtr);
12367 while (1) {
12368 const char *str;
12369 char state;
12370 int len;
12371
12372 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12373 Jim_DecrRefCount(interp, scriptObjPtr);
12374 goto out;
12375 }
12376 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12377 str = Jim_GetString(scriptObjPtr, &len);
12378 if (Jim_ScriptIsComplete(str, len, &state))
12379 break;
12380 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12381 Jim_fflush(interp, interp->cookie_stdout);
12382 }
12383 retcode = Jim_EvalObj(interp, scriptObjPtr);
12384 Jim_DecrRefCount(interp, scriptObjPtr);
12385 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12386 if (retcode == JIM_ERR) {
12387 Jim_PrintErrorMessage(interp);
12388 } else if (retcode == JIM_EXIT) {
12389 exit(Jim_GetExitCode(interp));
12390 } else {
12391 if (reslen) {
12392 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12393 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12394 }
12395 }
12396 }
12397 out:
12398 return 0;
12399 }
12400
12401 /* -----------------------------------------------------------------------------
12402 * Jim's idea of STDIO..
12403 * ---------------------------------------------------------------------------*/
12404
12405 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12406 {
12407 int r;
12408
12409 va_list ap;
12410 va_start(ap,fmt);
12411 r = Jim_vfprintf(interp, cookie, fmt,ap);
12412 va_end(ap);
12413 return r;
12414 }
12415
12416 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12417 {
12418 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12419 errno = ENOTSUP;
12420 return -1;
12421 }
12422 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12423 }
12424
12425 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12426 {
12427 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12428 errno = ENOTSUP;
12429 return 0;
12430 }
12431 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12432 }
12433
12434 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12435 {
12436 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12437 errno = ENOTSUP;
12438 return 0;
12439 }
12440 return (*(interp->cb_fread))(ptr, size, n, cookie);
12441 }
12442
12443 int Jim_fflush(Jim_Interp *interp, void *cookie)
12444 {
12445 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12446 /* pretend all is well */
12447 return 0;
12448 }
12449 return (*(interp->cb_fflush))(cookie);
12450 }
12451
12452 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12453 {
12454 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12455 errno = ENOTSUP;
12456 return NULL;
12457 }
12458 return (*(interp->cb_fgets))(s, size, cookie);
12459 }
12460 Jim_Nvp *
12461 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12462 {
12463 while (p->name) {
12464 if (0 == strcmp(name, p->name)) {
12465 break;
12466 }
12467 p++;
12468 }
12469 return ((Jim_Nvp *)(p));
12470 }
12471
12472 Jim_Nvp *
12473 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12474 {
12475 while (p->name) {
12476 if (0 == strcasecmp(name, p->name)) {
12477 break;
12478 }
12479 p++;
12480 }
12481 return ((Jim_Nvp *)(p));
12482 }
12483
12484 int
12485 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12486 const Jim_Nvp *p,
12487 Jim_Obj *o,
12488 Jim_Nvp **result)
12489 {
12490 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12491 }
12492
12493
12494 int
12495 Jim_Nvp_name2value(Jim_Interp *interp,
12496 const Jim_Nvp *_p,
12497 const char *name,
12498 Jim_Nvp **result)
12499 {
12500 const Jim_Nvp *p;
12501
12502 p = Jim_Nvp_name2value_simple(_p, name);
12503
12504 /* result */
12505 if (result) {
12506 *result = (Jim_Nvp *)(p);
12507 }
12508
12509 /* found? */
12510 if (p->name) {
12511 return JIM_OK;
12512 } else {
12513 return JIM_ERR;
12514 }
12515 }
12516
12517 int
12518 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12519 {
12520 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12521 }
12522
12523 int
12524 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12525 {
12526 const Jim_Nvp *p;
12527
12528 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12529
12530 if (puthere) {
12531 *puthere = (Jim_Nvp *)(p);
12532 }
12533 /* found */
12534 if (p->name) {
12535 return JIM_OK;
12536 } else {
12537 return JIM_ERR;
12538 }
12539 }
12540
12541
12542 int
12543 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12544 {
12545 int e;;
12546 jim_wide w;
12547
12548 e = Jim_GetWide(interp, o, &w);
12549 if (e != JIM_OK) {
12550 return e;
12551 }
12552
12553 return Jim_Nvp_value2name(interp, p, w, result);
12554 }
12555
12556 Jim_Nvp *
12557 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12558 {
12559 while (p->name) {
12560 if (value == p->value) {
12561 break;
12562 }
12563 p++;
12564 }
12565 return ((Jim_Nvp *)(p));
12566 }
12567
12568
12569 int
12570 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12571 {
12572 const Jim_Nvp *p;
12573
12574 p = Jim_Nvp_value2name_simple(_p, value);
12575
12576 if (result) {
12577 *result = (Jim_Nvp *)(p);
12578 }
12579
12580 if (p->name) {
12581 return JIM_OK;
12582 } else {
12583 return JIM_ERR;
12584 }
12585 }
12586
12587
12588 int
12589 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12590 {
12591 memset(p, 0, sizeof(*p));
12592 p->interp = interp;
12593 p->argc = argc;
12594 p->argv = argv;
12595
12596 return JIM_OK;
12597 }
12598
12599 void
12600 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12601 {
12602 int x;
12603
12604 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12605 for (x = 0 ; x < p->argc ; x++) {
12606 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12607 "%2d) %s\n",
12608 x,
12609 Jim_GetString(p->argv[x], NULL));
12610 }
12611 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12612 }
12613
12614
12615 int
12616 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12617 {
12618 Jim_Obj *o;
12619
12620 o = NULL; // failure
12621 if (goi->argc) {
12622 // success
12623 o = goi->argv[0];
12624 goi->argc -= 1;
12625 goi->argv += 1;
12626 }
12627 if (puthere) {
12628 *puthere = o;
12629 }
12630 if (o != NULL) {
12631 return JIM_OK;
12632 } else {
12633 return JIM_ERR;
12634 }
12635 }
12636
12637 int
12638 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12639 {
12640 int r;
12641 Jim_Obj *o;
12642 const char *cp;
12643
12644
12645 r = Jim_GetOpt_Obj(goi, &o);
12646 if (r == JIM_OK) {
12647 cp = Jim_GetString(o, len);
12648 if (puthere) {
12649 /* remove const */
12650 *puthere = (char *)(cp);
12651 }
12652 }
12653 return r;
12654 }
12655
12656 int
12657 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12658 {
12659 int r;
12660 Jim_Obj *o;
12661 double _safe;
12662
12663 if (puthere == NULL) {
12664 puthere = &_safe;
12665 }
12666
12667 r = Jim_GetOpt_Obj(goi, &o);
12668 if (r == JIM_OK) {
12669 r = Jim_GetDouble(goi->interp, o, puthere);
12670 if (r != JIM_OK) {
12671 Jim_SetResult_sprintf(goi->interp,
12672 "not a number: %s",
12673 Jim_GetString(o, NULL));
12674 }
12675 }
12676 return r;
12677 }
12678
12679 int
12680 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12681 {
12682 int r;
12683 Jim_Obj *o;
12684 jim_wide _safe;
12685
12686 if (puthere == NULL) {
12687 puthere = &_safe;
12688 }
12689
12690 r = Jim_GetOpt_Obj(goi, &o);
12691 if (r == JIM_OK) {
12692 r = Jim_GetWide(goi->interp, o, puthere);
12693 }
12694 return r;
12695 }
12696
12697 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12698 const Jim_Nvp *nvp,
12699 Jim_Nvp **puthere)
12700 {
12701 Jim_Nvp *_safe;
12702 Jim_Obj *o;
12703 int e;
12704
12705 if (puthere == NULL) {
12706 puthere = &_safe;
12707 }
12708
12709 e = Jim_GetOpt_Obj(goi, &o);
12710 if (e == JIM_OK) {
12711 e = Jim_Nvp_name2value_obj(goi->interp,
12712 nvp,
12713 o,
12714 puthere);
12715 }
12716
12717 return e;
12718 }
12719
12720 void
12721 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12722 const Jim_Nvp *nvptable,
12723 int hadprefix)
12724 {
12725 if (hadprefix) {
12726 Jim_SetResult_NvpUnknown(goi->interp,
12727 goi->argv[-2],
12728 goi->argv[-1],
12729 nvptable);
12730 } else {
12731 Jim_SetResult_NvpUnknown(goi->interp,
12732 NULL,
12733 goi->argv[-1],
12734 nvptable);
12735 }
12736 }
12737
12738
12739 int
12740 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12741 const char * const * lookup,
12742 int *puthere)
12743 {
12744 int _safe;
12745 Jim_Obj *o;
12746 int e;
12747
12748 if (puthere == NULL) {
12749 puthere = &_safe;
12750 }
12751 e = Jim_GetOpt_Obj(goi, &o);
12752 if (e == JIM_OK) {
12753 e = Jim_GetEnum(goi->interp,
12754 o,
12755 lookup,
12756 puthere,
12757 "option",
12758 JIM_ERRMSG);
12759 }
12760 return e;
12761 }
12762
12763
12764
12765 int
12766 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12767 {
12768 va_list ap;
12769 char *buf;
12770
12771 va_start(ap,fmt);
12772 buf = jim_vasprintf(fmt, ap);
12773 va_end(ap);
12774 if (buf) {
12775 Jim_SetResultString(interp, buf, -1);
12776 jim_vasprintf_done(buf);
12777 }
12778 return JIM_OK;
12779 }
12780
12781
12782 void
12783 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12784 Jim_Obj *param_name,
12785 Jim_Obj *param_value,
12786 const Jim_Nvp *nvp)
12787 {
12788 if (param_name) {
12789 Jim_SetResult_sprintf(interp,
12790 "%s: Unknown: %s, try one of: ",
12791 Jim_GetString(param_name, NULL),
12792 Jim_GetString(param_value, NULL));
12793 } else {
12794 Jim_SetResult_sprintf(interp,
12795 "Unknown param: %s, try one of: ",
12796 Jim_GetString(param_value, NULL));
12797 }
12798 while (nvp->name) {
12799 const char *a;
12800 const char *b;
12801
12802 if ((nvp + 1)->name) {
12803 a = nvp->name;
12804 b = ", ";
12805 } else {
12806 a = "or ";
12807 b = nvp->name;
12808 }
12809 Jim_AppendStrings(interp,
12810 Jim_GetResult(interp),
12811 a, b, NULL);
12812 nvp++;
12813 }
12814 }
12815
12816
12817 static Jim_Obj *debug_string_obj;
12818
12819 const char *
12820 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12821 {
12822 int x;
12823
12824 if (debug_string_obj) {
12825 Jim_FreeObj(interp, debug_string_obj);
12826 }
12827
12828 debug_string_obj = Jim_NewEmptyStringObj(interp);
12829 for (x = 0 ; x < argc ; x++) {
12830 Jim_AppendStrings(interp,
12831 debug_string_obj,
12832 Jim_GetString(argv[x], NULL),
12833 " ",
12834 NULL);
12835 }
12836
12837 return Jim_GetString(debug_string_obj, NULL);
12838 }

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)