helper/jim: review scope of symbols
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
14 *
15 * The FreeBSD license
16 *
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
19 * are met:
20 *
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
27 *
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 *
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
44 **/
45 #ifdef HAVE_CONFIG_H
46 #include "config.h"
47 #endif
48
49 #define __JIM_CORE__
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
51
52 #ifdef __ECOS
53 #include <pkgconf/jimtcl.h>
54 #include <stdio.h>
55 #include <stdlib.h>
56
57 typedef CYG_ADDRWORD intptr_t;
58
59 #include <string.h>
60 #include <stdarg.h>
61 #include <ctype.h>
62 #include <limits.h>
63 #include <assert.h>
64 #include <errno.h>
65 #include <time.h>
66 #endif
67 #ifndef JIM_ANSIC
68 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
69 #endif /* JIM_ANSIC */
70
71 #include <stdarg.h>
72 #include <limits.h>
73
74 /* Include the platform dependent libraries for
75 * dynamic loading of libraries. */
76 #ifdef JIM_DYNLIB
77 #if defined(_WIN32) || defined(WIN32)
78 #ifndef WIN32
79 #define WIN32 1
80 #endif
81 #ifndef STRICT
82 #define STRICT
83 #endif
84 #define WIN32_LEAN_AND_MEAN
85 #include <windows.h>
86 #if _MSC_VER >= 1000
87 #pragma warning(disable:4146)
88 #endif /* _MSC_VER */
89 #else
90 #include <dlfcn.h>
91 #endif /* WIN32 */
92 #endif /* JIM_DYNLIB */
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType *getJimVariablesHashTableType(void);
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf(const char *fmt, va_list ap)
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf(buf, sizeof(buf), fmt, ap);
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 int result;
137 result = vasprintf(&buf, fmt, ap);
138 if (result < 0) exit(-1);
139 #endif
140 return buf;
141 }
142
143 static void
144 jim_vasprintf_done(void *buf)
145 {
146 #ifndef HAVE_VASPRINTF
147 (void)(buf);
148 #else
149 free(buf);
150 #endif
151 }
152
153
154 /*
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
157 *
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
160 */
161 #ifdef HAVE_LONG_LONG_INT
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
164 {
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
170
171 /*
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
175 */
176 s = nptr;
177 do {
178 c = *s++;
179 } while (isspace(c));
180 if (c == '-') {
181 neg = 1;
182 c = *s++;
183 } else {
184 neg = 0;
185 if (c == '+')
186 c = *s++;
187 }
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
190 c = s[1];
191 s += 2;
192 base = 16;
193 }
194 if (base == 0)
195 base = c == '0' ? 8 : 10;
196
197 /*
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
211 *
212 * Set any if any `digits' consumed; make it negative to indicate
213 * overflow.
214 */
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
217 : LLONG_MAX;
218 cutlim = (int)(cutoff % qbase);
219 cutoff /= qbase;
220 for (acc = 0, any = 0;; c = *s++) {
221 if (!JimIsAscii(c))
222 break;
223 if (isdigit(c))
224 c -= '0';
225 else if (isalpha(c))
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
227 else
228 break;
229 if (c >= base)
230 break;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
232 any = -1;
233 else {
234 any = 1;
235 acc *= qbase;
236 acc += c;
237 }
238 }
239 if (any < 0) {
240 acc = neg ? LLONG_MIN : LLONG_MAX;
241 errno = ERANGE;
242 } else if (neg)
243 acc = -acc;
244 if (endptr != 0)
245 *endptr = (char *)(any ? s - 1 : nptr);
246 return (acc);
247 }
248 #endif
249
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
253 {
254 while (patternLen) {
255 switch (pattern[0]) {
256 case '*':
257 while (pattern[1] == '*') {
258 pattern++;
259 patternLen--;
260 }
261 if (patternLen == 1)
262 return 1; /* match */
263 while (stringLen) {
264 if (JimStringMatch(pattern + 1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
267 string++;
268 stringLen--;
269 }
270 return 0; /* no match */
271 break;
272 case '?':
273 if (stringLen == 0)
274 return 0; /* no match */
275 string++;
276 stringLen--;
277 break;
278 case '[':
279 {
280 int not, match;
281
282 pattern++;
283 patternLen--;
284 not = pattern[0] == '^';
285 if (not) {
286 pattern++;
287 patternLen--;
288 }
289 match = 0;
290 while (1) {
291 if (pattern[0] == '\\') {
292 pattern++;
293 patternLen--;
294 if (pattern[0] == string[0])
295 match = 1;
296 } else if (pattern[0] == ']') {
297 break;
298 } else if (patternLen == 0) {
299 pattern--;
300 patternLen++;
301 break;
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
305 int c = string[0];
306 if (start > end) {
307 int t = start;
308 start = end;
309 end = t;
310 }
311 if (nocase) {
312 start = tolower(start);
313 end = tolower(end);
314 c = tolower(c);
315 }
316 pattern += 2;
317 patternLen -= 2;
318 if (c >= start && c <= end)
319 match = 1;
320 } else {
321 if (!nocase) {
322 if (pattern[0] == string[0])
323 match = 1;
324 } else {
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
326 match = 1;
327 }
328 }
329 pattern++;
330 patternLen--;
331 }
332 if (not)
333 match = !match;
334 if (!match)
335 return 0; /* no match */
336 string++;
337 stringLen--;
338 break;
339 }
340 case '\\':
341 if (patternLen >= 2) {
342 pattern++;
343 patternLen--;
344 }
345 /* fall through */
346 default:
347 if (!nocase) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
350 } else {
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
353 }
354 string++;
355 stringLen--;
356 break;
357 }
358 pattern++;
359 patternLen--;
360 if (stringLen == 0) {
361 while (*pattern == '*') {
362 pattern++;
363 patternLen--;
364 }
365 break;
366 }
367 }
368 if (patternLen == 0 && stringLen == 0)
369 return 1;
370 return 0;
371 }
372
373 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
374 int nocase)
375 {
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
377
378 if (nocase == 0) {
379 while (l1 && l2) {
380 if (*u1 != *u2)
381 return (int)*u1-*u2;
382 u1++; u2++; l1--; l2--;
383 }
384 if (!l1 && !l2) return 0;
385 return l1-l2;
386 } else {
387 while (l1 && l2) {
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
391 }
392 if (!l1 && !l2) return 0;
393 return l1-l2;
394 }
395 }
396
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index_t)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index_t < 0) index_t = 0;
406 s2 += index_t;
407 for (i = index_t; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 static int Jim_WideToString(char *buf, jim_wide wideValue)
416 {
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
419 }
420
421 static int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
422 {
423 char *endptr;
424
425 #ifdef HAVE_LONG_LONG_INT
426 *widePtr = JimStrtoll(str, &endptr, base);
427 #else
428 *widePtr = strtol(str, &endptr, base);
429 #endif
430 if ((str[0] == '\0') || (str == endptr))
431 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace((int)*endptr))
435 return JIM_ERR;
436 endptr++;
437 }
438 }
439 return JIM_OK;
440 }
441
442 static int Jim_StringToIndex(const char *str, int *intPtr)
443 {
444 char *endptr;
445
446 *intPtr = strtol(str, &endptr, 10);
447 if ((str[0] == '\0') || (str == endptr))
448 return JIM_ERR;
449 if (endptr[0] != '\0') {
450 while (*endptr) {
451 if (!isspace((int)*endptr))
452 return JIM_ERR;
453 endptr++;
454 }
455 }
456 return JIM_OK;
457 }
458
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
465
466 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
467
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
469 {
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
473 }
474
475 static int Jim_DoubleToString(char *buf, double doubleValue)
476 {
477 char *s;
478 int len;
479
480 len = sprintf(buf, "%.17g", doubleValue);
481 s = buf;
482 while (*s) {
483 if (*s == '.') return len;
484 s++;
485 }
486 /* Add a final ".0" if it's a number. But not
487 * for NaN or InF */
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
491 s[0] = '.';
492 s[1] = '0';
493 s[2] = '\0';
494 return len + 2;
495 }
496 return len;
497 }
498
499 static int Jim_StringToDouble(const char *str, double *doublePtr)
500 {
501 char *endptr;
502
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
505 return JIM_ERR;
506 return JIM_OK;
507 }
508
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
510 {
511 jim_wide i, res = 1;
512 if ((b == 0 && e != 0) || (e < 0)) return 0;
513 for (i = 0; i < e; i++) {res *= b;}
514 return res;
515 }
516
517 /* -----------------------------------------------------------------------------
518 * Special functions
519 * ---------------------------------------------------------------------------*/
520
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
525 {
526 va_list ap;
527
528 va_start(ap, fmt);
529 /*
530 * Send it here first.. Assuming STDIO still works
531 */
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
535 va_end(ap);
536
537 #ifdef HAVE_BACKTRACE
538 {
539 void *array[40];
540 int size, i;
541 char **strings;
542
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
549 }
550 #endif
551
552 /* This may actually crash... we do it last */
553 if (interp && interp->cookie_stderr) {
554 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
556 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
557 }
558 abort();
559 }
560
561 /* -----------------------------------------------------------------------------
562 * Memory allocation
563 * ---------------------------------------------------------------------------*/
564
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
568 #if 0
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
572 #endif
573
574 void *Jim_Alloc(int size)
575 {
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
577 if (size == 0)
578 size = 1;
579 void *p = malloc(size);
580 if (p == NULL)
581 Jim_Panic(NULL,"malloc: Out of memory");
582 return p;
583 }
584
585 void Jim_Free(void *ptr) {
586 free(ptr);
587 }
588
589 static void *Jim_Realloc(void *ptr, int size)
590 {
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
592 if (size == 0)
593 size = 1;
594 void *p = realloc(ptr, size);
595 if (p == NULL)
596 Jim_Panic(NULL,"realloc: Out of memory");
597 return p;
598 }
599
600 char *Jim_StrDup(const char *s)
601 {
602 int l = strlen(s);
603 char *copy = Jim_Alloc(l + 1);
604
605 memcpy(copy, s, l + 1);
606 return copy;
607 }
608
609 static char *Jim_StrDupLen(const char *s, int l)
610 {
611 char *copy = Jim_Alloc(l + 1);
612
613 memcpy(copy, s, l + 1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
615 return copy;
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
623 {
624 #if (defined WIN32) && !(defined JIM_ANSIC)
625 LARGE_INTEGER t, f;
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
629 #else /* !WIN32 */
630 clock_t clocks = clock();
631
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
633 #endif /* WIN32 */
634 }
635
636 /* -----------------------------------------------------------------------------
637 * Hash Tables
638 * ---------------------------------------------------------------------------*/
639
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
644
645 /* -------------------------- hash functions -------------------------------- */
646
647 /* Thomas Wang's 32 bit Mix Function */
648 static unsigned int Jim_IntHashFunction(unsigned int key)
649 {
650 key += ~(key << 15);
651 key ^= (key >> 10);
652 key += (key << 3);
653 key ^= (key >> 6);
654 key += ~(key << 11);
655 key ^= (key >> 16);
656 return key;
657 }
658
659 /* Identity hash function for integer keys */
660 unsigned int Jim_IdentityHashFunction(unsigned int key)
661 {
662 return key;
663 }
664
665 /* Generic hash function (we are using to multiply by 9 and add the byte
666 * as Tcl) */
667 static unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
668 {
669 unsigned int h = 0;
670 while (len--)
671 h += (h << 3)+*buf++;
672 return h;
673 }
674
675 /* ----------------------------- API implementation ------------------------- */
676 /* reset an hashtable already initialized with ht_init().
677 * NOTE: This function should only called by ht_destroy(). */
678 static void JimResetHashTable(Jim_HashTable *ht)
679 {
680 ht->table = NULL;
681 ht->size = 0;
682 ht->sizemask = 0;
683 ht->used = 0;
684 ht->collisions = 0;
685 }
686
687 /* Initialize the hash table */
688 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
689 void *privDataPtr)
690 {
691 JimResetHashTable(ht);
692 ht->type = type;
693 ht->privdata = privDataPtr;
694 return JIM_OK;
695 }
696
697 /* Resize the table to the minimal size that contains all the elements,
698 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
699 int Jim_ResizeHashTable(Jim_HashTable *ht)
700 {
701 int minimal = ht->used;
702
703 if (minimal < JIM_HT_INITIAL_SIZE)
704 minimal = JIM_HT_INITIAL_SIZE;
705 return Jim_ExpandHashTable(ht, minimal);
706 }
707
708 /* Expand or create the hashtable */
709 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
710 {
711 Jim_HashTable n; /* the new hashtable */
712 unsigned int realsize = JimHashTableNextPower(size), i;
713
714 /* the size is invalid if it is smaller than the number of
715 * elements already inside the hashtable */
716 if (ht->used >= size)
717 return JIM_ERR;
718
719 Jim_InitHashTable(&n, ht->type, ht->privdata);
720 n.size = realsize;
721 n.sizemask = realsize-1;
722 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
723
724 /* Initialize all the pointers to NULL */
725 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
726
727 /* Copy all the elements from the old to the new table:
728 * note that if the old hash table is empty ht->size is zero,
729 * so Jim_ExpandHashTable just creates an hash table. */
730 n.used = ht->used;
731 for (i = 0; i < ht->size && ht->used > 0; i++) {
732 Jim_HashEntry *he, *nextHe;
733
734 if (ht->table[i] == NULL) continue;
735
736 /* For each hash entry on this slot... */
737 he = ht->table[i];
738 while (he) {
739 unsigned int h;
740
741 nextHe = he->next;
742 /* Get the new element index */
743 h = Jim_HashKey(ht, he->key) & n.sizemask;
744 he->next = n.table[h];
745 n.table[h] = he;
746 ht->used--;
747 /* Pass to the next element */
748 he = nextHe;
749 }
750 }
751 assert(ht->used == 0);
752 Jim_Free(ht->table);
753
754 /* Remap the new hashtable in the old */
755 *ht = n;
756 return JIM_OK;
757 }
758
759 /* Add an element to the target hash table */
760 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
761 {
762 int index_t;
763 Jim_HashEntry *entry;
764
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index_t = JimInsertHashEntry(ht, key)) == -1)
768 return JIM_ERR;
769
770 /* Allocates the memory and stores key */
771 entry = Jim_Alloc(sizeof(*entry));
772 entry->next = ht->table[index_t];
773 ht->table[index_t] = entry;
774
775 /* Set the hash entry fields. */
776 Jim_SetHashKey(ht, entry, key);
777 Jim_SetHashVal(ht, entry, val);
778 ht->used++;
779 return JIM_OK;
780 }
781
782 /* Add an element, discarding the old if the key already exists */
783 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
784 {
785 Jim_HashEntry *entry;
786
787 /* Try to add the element. If the key
788 * does not exists Jim_AddHashEntry will suceed. */
789 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
790 return JIM_OK;
791 /* It already exists, get the entry */
792 entry = Jim_FindHashEntry(ht, key);
793 /* Free the old value and set the new one */
794 Jim_FreeEntryVal(ht, entry);
795 Jim_SetHashVal(ht, entry, val);
796 return JIM_OK;
797 }
798
799 /* Search and remove an element */
800 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
801 {
802 unsigned int h;
803 Jim_HashEntry *he, *prevHe;
804
805 if (ht->size == 0)
806 return JIM_ERR;
807 h = Jim_HashKey(ht, key) & ht->sizemask;
808 he = ht->table[h];
809
810 prevHe = NULL;
811 while (he) {
812 if (Jim_CompareHashKeys(ht, key, he->key)) {
813 /* Unlink the element from the list */
814 if (prevHe)
815 prevHe->next = he->next;
816 else
817 ht->table[h] = he->next;
818 Jim_FreeEntryKey(ht, he);
819 Jim_FreeEntryVal(ht, he);
820 Jim_Free(he);
821 ht->used--;
822 return JIM_OK;
823 }
824 prevHe = he;
825 he = he->next;
826 }
827 return JIM_ERR; /* not found */
828 }
829
830 /* Destroy an entire hash table */
831 int Jim_FreeHashTable(Jim_HashTable *ht)
832 {
833 unsigned int i;
834
835 /* Free all the elements */
836 for (i = 0; i < ht->size && ht->used > 0; i++) {
837 Jim_HashEntry *he, *nextHe;
838
839 if ((he = ht->table[i]) == NULL) continue;
840 while (he) {
841 nextHe = he->next;
842 Jim_FreeEntryKey(ht, he);
843 Jim_FreeEntryVal(ht, he);
844 Jim_Free(he);
845 ht->used--;
846 he = nextHe;
847 }
848 }
849 /* Free the table and the allocated cache structure */
850 Jim_Free(ht->table);
851 /* Re-initialize the table */
852 JimResetHashTable(ht);
853 return JIM_OK; /* never fails */
854 }
855
856 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
857 {
858 Jim_HashEntry *he;
859 unsigned int h;
860
861 if (ht->size == 0) return NULL;
862 h = Jim_HashKey(ht, key) & ht->sizemask;
863 he = ht->table[h];
864 while (he) {
865 if (Jim_CompareHashKeys(ht, key, he->key))
866 return he;
867 he = he->next;
868 }
869 return NULL;
870 }
871
872 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
873 {
874 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
875
876 iter->ht = ht;
877 iter->index = -1;
878 iter->entry = NULL;
879 iter->nextEntry = NULL;
880 return iter;
881 }
882
883 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
884 {
885 while (1) {
886 if (iter->entry == NULL) {
887 iter->index++;
888 if (iter->index >=
889 (signed)iter->ht->size) break;
890 iter->entry = iter->ht->table[iter->index];
891 } else {
892 iter->entry = iter->nextEntry;
893 }
894 if (iter->entry) {
895 /* We need to save the 'next' here, the iterator user
896 * may delete the entry we are returning. */
897 iter->nextEntry = iter->entry->next;
898 return iter->entry;
899 }
900 }
901 return NULL;
902 }
903
904 /* ------------------------- private functions ------------------------------ */
905
906 /* Expand the hash table if needed */
907 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
908 {
909 /* If the hash table is empty expand it to the intial size,
910 * if the table is "full" dobule its size. */
911 if (ht->size == 0)
912 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
913 if (ht->size == ht->used)
914 return Jim_ExpandHashTable(ht, ht->size*2);
915 return JIM_OK;
916 }
917
918 /* Our hash table capability is a power of two */
919 static unsigned int JimHashTableNextPower(unsigned int size)
920 {
921 unsigned int i = JIM_HT_INITIAL_SIZE;
922
923 if (size >= 2147483648U)
924 return 2147483648U;
925 while (1) {
926 if (i >= size)
927 return i;
928 i *= 2;
929 }
930 }
931
932 /* Returns the index of a free slot that can be populated with
933 * an hash entry for the given 'key'.
934 * If the key already exists, -1 is returned. */
935 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
936 {
937 unsigned int h;
938 Jim_HashEntry *he;
939
940 /* Expand the hashtable if needed */
941 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
942 return -1;
943 /* Compute the key hash value */
944 h = Jim_HashKey(ht, key) & ht->sizemask;
945 /* Search if this slot does not already contain the given key */
946 he = ht->table[h];
947 while (he) {
948 if (Jim_CompareHashKeys(ht, key, he->key))
949 return -1;
950 he = he->next;
951 }
952 return h;
953 }
954
955 /* ----------------------- StringCopy Hash Table Type ------------------------*/
956
957 static unsigned int JimStringCopyHTHashFunction(const void *key)
958 {
959 return Jim_GenHashFunction(key, strlen(key));
960 }
961
962 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
963 {
964 int len = strlen(key);
965 char *copy = Jim_Alloc(len + 1);
966 JIM_NOTUSED(privdata);
967
968 memcpy(copy, key, len);
969 copy[len] = '\0';
970 return copy;
971 }
972
973 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
974 {
975 int len = strlen(val);
976 char *copy = Jim_Alloc(len + 1);
977 JIM_NOTUSED(privdata);
978
979 memcpy(copy, val, len);
980 copy[len] = '\0';
981 return copy;
982 }
983
984 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
985 const void *key2)
986 {
987 JIM_NOTUSED(privdata);
988
989 return strcmp(key1, key2) == 0;
990 }
991
992 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
993 {
994 JIM_NOTUSED(privdata);
995
996 Jim_Free((void*)key); /* ATTENTION: const cast */
997 }
998
999 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
1000 {
1001 JIM_NOTUSED(privdata);
1002
1003 Jim_Free((void*)val); /* ATTENTION: const cast */
1004 }
1005
1006 static Jim_HashTableType JimStringCopyHashTableType = {
1007 JimStringCopyHTHashFunction, /* hash function */
1008 JimStringCopyHTKeyDup, /* key dup */
1009 NULL, /* val dup */
1010 JimStringCopyHTKeyCompare, /* key compare */
1011 JimStringCopyHTKeyDestructor, /* key destructor */
1012 NULL /* val destructor */
1013 };
1014
1015 /* This is like StringCopy but does not auto-duplicate the key.
1016 * It's used for intepreter's shared strings. */
1017 static Jim_HashTableType JimSharedStringsHashTableType = {
1018 JimStringCopyHTHashFunction, /* hash function */
1019 NULL, /* key dup */
1020 NULL, /* val dup */
1021 JimStringCopyHTKeyCompare, /* key compare */
1022 JimStringCopyHTKeyDestructor, /* key destructor */
1023 NULL /* val destructor */
1024 };
1025
1026 /* This is like StringCopy but also automatically handle dynamic
1027 * allocated C strings as values. */
1028 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1029 JimStringCopyHTHashFunction, /* hash function */
1030 JimStringCopyHTKeyDup, /* key dup */
1031 JimStringKeyValCopyHTValDup, /* val dup */
1032 JimStringCopyHTKeyCompare, /* key compare */
1033 JimStringCopyHTKeyDestructor, /* key destructor */
1034 JimStringKeyValCopyHTValDestructor, /* val destructor */
1035 };
1036
1037 typedef struct AssocDataValue {
1038 Jim_InterpDeleteProc *delProc;
1039 void *data;
1040 } AssocDataValue;
1041
1042 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1043 {
1044 AssocDataValue *assocPtr = (AssocDataValue *)data;
1045 if (assocPtr->delProc != NULL)
1046 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1047 Jim_Free(data);
1048 }
1049
1050 static Jim_HashTableType JimAssocDataHashTableType = {
1051 JimStringCopyHTHashFunction, /* hash function */
1052 JimStringCopyHTKeyDup, /* key dup */
1053 NULL, /* val dup */
1054 JimStringCopyHTKeyCompare, /* key compare */
1055 JimStringCopyHTKeyDestructor, /* key destructor */
1056 JimAssocDataHashTableValueDestructor /* val destructor */
1057 };
1058
1059 /* -----------------------------------------------------------------------------
1060 * Stack - This is a simple generic stack implementation. It is used for
1061 * example in the 'expr' expression compiler.
1062 * ---------------------------------------------------------------------------*/
1063 void Jim_InitStack(Jim_Stack *stack)
1064 {
1065 stack->len = 0;
1066 stack->maxlen = 0;
1067 stack->vector = NULL;
1068 }
1069
1070 void Jim_FreeStack(Jim_Stack *stack)
1071 {
1072 Jim_Free(stack->vector);
1073 }
1074
1075 int Jim_StackLen(Jim_Stack *stack)
1076 {
1077 return stack->len;
1078 }
1079
1080 void Jim_StackPush(Jim_Stack *stack, void *element) {
1081 int neededLen = stack->len + 1;
1082 if (neededLen > stack->maxlen) {
1083 stack->maxlen = neededLen*2;
1084 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1085 }
1086 stack->vector[stack->len] = element;
1087 stack->len++;
1088 }
1089
1090 void *Jim_StackPop(Jim_Stack *stack)
1091 {
1092 if (stack->len == 0) return NULL;
1093 stack->len--;
1094 return stack->vector[stack->len];
1095 }
1096
1097 void *Jim_StackPeek(Jim_Stack *stack)
1098 {
1099 if (stack->len == 0) return NULL;
1100 return stack->vector[stack->len-1];
1101 }
1102
1103 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1104 {
1105 int i;
1106
1107 for (i = 0; i < stack->len; i++)
1108 freeFunc(stack->vector[i]);
1109 }
1110
1111 /* -----------------------------------------------------------------------------
1112 * Parser
1113 * ---------------------------------------------------------------------------*/
1114
1115 /* Token types */
1116 #define JIM_TT_NONE -1 /* No token returned */
1117 #define JIM_TT_STR 0 /* simple string */
1118 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1119 #define JIM_TT_VAR 2 /* var substitution */
1120 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1121 #define JIM_TT_CMD 4 /* command substitution */
1122 #define JIM_TT_SEP 5 /* word separator */
1123 #define JIM_TT_EOL 6 /* line separator */
1124
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 7
1127 #define JIM_TT_SUBEXPR_END 8
1128 #define JIM_TT_EXPR_NUMBER 9
1129 #define JIM_TT_EXPR_OPERATOR 10
1130
1131 /* Parser states */
1132 #define JIM_PS_DEF 0 /* Default state */
1133 #define JIM_PS_QUOTE 1 /* Inside "" */
1134
1135 /* Parser context structure. The same context is used both to parse
1136 * Tcl scripts and lists. */
1137 struct JimParserCtx {
1138 const char *prg; /* Program text */
1139 const char *p; /* Pointer to the point of the program we are parsing */
1140 int len; /* Left length of 'prg' */
1141 int linenr; /* Current line number */
1142 const char *tstart;
1143 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1144 int tline; /* Line number of the returned token */
1145 int tt; /* Token type */
1146 int eof; /* Non zero if EOF condition is true. */
1147 int state; /* Parser state */
1148 int comment; /* Non zero if the next chars may be a comment. */
1149 };
1150
1151 #define JimParserEof(c) ((c)->eof)
1152 #define JimParserTstart(c) ((c)->tstart)
1153 #define JimParserTend(c) ((c)->tend)
1154 #define JimParserTtype(c) ((c)->tt)
1155 #define JimParserTline(c) ((c)->tline)
1156
1157 static int JimParseScript(struct JimParserCtx *pc);
1158 static int JimParseSep(struct JimParserCtx *pc);
1159 static int JimParseEol(struct JimParserCtx *pc);
1160 static int JimParseCmd(struct JimParserCtx *pc);
1161 static int JimParseVar(struct JimParserCtx *pc);
1162 static int JimParseBrace(struct JimParserCtx *pc);
1163 static int JimParseStr(struct JimParserCtx *pc);
1164 static int JimParseComment(struct JimParserCtx *pc);
1165 static char *JimParserGetToken(struct JimParserCtx *pc,
1166 int *lenPtr, int *typePtr, int *linePtr);
1167
1168 /* Initialize a parser context.
1169 * 'prg' is a pointer to the program text, linenr is the line
1170 * number of the first line contained in the program. */
1171 static void JimParserInit(struct JimParserCtx *pc, const char *prg,
1172 int len, int linenr)
1173 {
1174 pc->prg = prg;
1175 pc->p = prg;
1176 pc->len = len;
1177 pc->tstart = NULL;
1178 pc->tend = NULL;
1179 pc->tline = 0;
1180 pc->tt = JIM_TT_NONE;
1181 pc->eof = 0;
1182 pc->state = JIM_PS_DEF;
1183 pc->linenr = linenr;
1184 pc->comment = 1;
1185 }
1186
1187 int JimParseScript(struct JimParserCtx *pc)
1188 {
1189 while (1) { /* the while is used to reiterate with continue if needed */
1190 if (!pc->len) {
1191 pc->tstart = pc->p;
1192 pc->tend = pc->p-1;
1193 pc->tline = pc->linenr;
1194 pc->tt = JIM_TT_EOL;
1195 pc->eof = 1;
1196 return JIM_OK;
1197 }
1198 switch (*(pc->p)) {
1199 case '\\':
1200 if (*(pc->p + 1) == '\n')
1201 return JimParseSep(pc);
1202 else {
1203 pc->comment = 0;
1204 return JimParseStr(pc);
1205 }
1206 break;
1207 case ' ':
1208 case '\t':
1209 case '\r':
1210 if (pc->state == JIM_PS_DEF)
1211 return JimParseSep(pc);
1212 else {
1213 pc->comment = 0;
1214 return JimParseStr(pc);
1215 }
1216 break;
1217 case '\n':
1218 case ';':
1219 pc->comment = 1;
1220 if (pc->state == JIM_PS_DEF)
1221 return JimParseEol(pc);
1222 else
1223 return JimParseStr(pc);
1224 break;
1225 case '[':
1226 pc->comment = 0;
1227 return JimParseCmd(pc);
1228 break;
1229 case '$':
1230 pc->comment = 0;
1231 if (JimParseVar(pc) == JIM_ERR) {
1232 pc->tstart = pc->tend = pc->p++; pc->len--;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_STR;
1235 return JIM_OK;
1236 } else
1237 return JIM_OK;
1238 break;
1239 case '#':
1240 if (pc->comment) {
1241 JimParseComment(pc);
1242 continue;
1243 } else {
1244 return JimParseStr(pc);
1245 }
1246 default:
1247 pc->comment = 0;
1248 return JimParseStr(pc);
1249 break;
1250 }
1251 return JIM_OK;
1252 }
1253 }
1254
1255 int JimParseSep(struct JimParserCtx *pc)
1256 {
1257 pc->tstart = pc->p;
1258 pc->tline = pc->linenr;
1259 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1260 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1261 if (*pc->p == '\\') {
1262 pc->p++; pc->len--;
1263 pc->linenr++;
1264 }
1265 pc->p++; pc->len--;
1266 }
1267 pc->tend = pc->p-1;
1268 pc->tt = JIM_TT_SEP;
1269 return JIM_OK;
1270 }
1271
1272 int JimParseEol(struct JimParserCtx *pc)
1273 {
1274 pc->tstart = pc->p;
1275 pc->tline = pc->linenr;
1276 while (*pc->p == ' ' || *pc->p == '\n' ||
1277 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1278 if (*pc->p == '\n')
1279 pc->linenr++;
1280 pc->p++; pc->len--;
1281 }
1282 pc->tend = pc->p-1;
1283 pc->tt = JIM_TT_EOL;
1284 return JIM_OK;
1285 }
1286
1287 /* Todo. Don't stop if ']' appears inside {} or quoted.
1288 * Also should handle the case of puts [string length "]"] */
1289 int JimParseCmd(struct JimParserCtx *pc)
1290 {
1291 int level = 1;
1292 int blevel = 0;
1293
1294 pc->tstart = ++pc->p; pc->len--;
1295 pc->tline = pc->linenr;
1296 while (1) {
1297 if (pc->len == 0) {
1298 break;
1299 } else if (*pc->p == '[' && blevel == 0) {
1300 level++;
1301 } else if (*pc->p == ']' && blevel == 0) {
1302 level--;
1303 if (!level) break;
1304 } else if (*pc->p == '\\') {
1305 pc->p++; pc->len--;
1306 } else if (*pc->p == '{') {
1307 blevel++;
1308 } else if (*pc->p == '}') {
1309 if (blevel != 0)
1310 blevel--;
1311 } else if (*pc->p == '\n')
1312 pc->linenr++;
1313 pc->p++; pc->len--;
1314 }
1315 pc->tend = pc->p-1;
1316 pc->tt = JIM_TT_CMD;
1317 if (*pc->p == ']') {
1318 pc->p++; pc->len--;
1319 }
1320 return JIM_OK;
1321 }
1322
1323 int JimParseVar(struct JimParserCtx *pc)
1324 {
1325 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1326
1327 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1328 pc->tline = pc->linenr;
1329 if (*pc->p == '{') {
1330 pc->tstart = ++pc->p; pc->len--;
1331 brace = 1;
1332 }
1333 if (brace) {
1334 while (!stop) {
1335 if (*pc->p == '}' || pc->len == 0) {
1336 pc->tend = pc->p-1;
1337 stop = 1;
1338 if (pc->len == 0)
1339 break;
1340 }
1341 else if (*pc->p == '\n')
1342 pc->linenr++;
1343 pc->p++; pc->len--;
1344 }
1345 } else {
1346 /* Include leading colons */
1347 while (*pc->p == ':') {
1348 pc->p++;
1349 pc->len--;
1350 }
1351 while (!stop) {
1352 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1353 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1354 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1355 stop = 1;
1356 else {
1357 pc->p++; pc->len--;
1358 }
1359 }
1360 /* Parse [dict get] syntax sugar. */
1361 if (*pc->p == '(') {
1362 while (*pc->p != ')' && pc->len) {
1363 pc->p++; pc->len--;
1364 if (*pc->p == '\\' && pc->len >= 2) {
1365 pc->p += 2; pc->len -= 2;
1366 }
1367 }
1368 if (*pc->p != '\0') {
1369 pc->p++; pc->len--;
1370 }
1371 ttype = JIM_TT_DICTSUGAR;
1372 }
1373 pc->tend = pc->p-1;
1374 }
1375 /* Check if we parsed just the '$' character.
1376 * That's not a variable so an error is returned
1377 * to tell the state machine to consider this '$' just
1378 * a string. */
1379 if (pc->tstart == pc->p) {
1380 pc->p--; pc->len++;
1381 return JIM_ERR;
1382 }
1383 pc->tt = ttype;
1384 return JIM_OK;
1385 }
1386
1387 int JimParseBrace(struct JimParserCtx *pc)
1388 {
1389 int level = 1;
1390
1391 pc->tstart = ++pc->p; pc->len--;
1392 pc->tline = pc->linenr;
1393 while (1) {
1394 if (*pc->p == '\\' && pc->len >= 2) {
1395 pc->p++; pc->len--;
1396 if (*pc->p == '\n')
1397 pc->linenr++;
1398 } else if (*pc->p == '{') {
1399 level++;
1400 } else if (pc->len == 0 || *pc->p == '}') {
1401 level--;
1402 if (pc->len == 0 || level == 0) {
1403 pc->tend = pc->p-1;
1404 if (pc->len != 0) {
1405 pc->p++; pc->len--;
1406 }
1407 pc->tt = JIM_TT_STR;
1408 return JIM_OK;
1409 }
1410 } else if (*pc->p == '\n') {
1411 pc->linenr++;
1412 }
1413 pc->p++; pc->len--;
1414 }
1415 return JIM_OK; /* unreached */
1416 }
1417
1418 int JimParseStr(struct JimParserCtx *pc)
1419 {
1420 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1421 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1422 if (newword && *pc->p == '{') {
1423 return JimParseBrace(pc);
1424 } else if (newword && *pc->p == '"') {
1425 pc->state = JIM_PS_QUOTE;
1426 pc->p++; pc->len--;
1427 }
1428 pc->tstart = pc->p;
1429 pc->tline = pc->linenr;
1430 while (1) {
1431 if (pc->len == 0) {
1432 pc->tend = pc->p-1;
1433 pc->tt = JIM_TT_ESC;
1434 return JIM_OK;
1435 }
1436 switch (*pc->p) {
1437 case '\\':
1438 if (pc->state == JIM_PS_DEF &&
1439 *(pc->p + 1) == '\n') {
1440 pc->tend = pc->p-1;
1441 pc->tt = JIM_TT_ESC;
1442 return JIM_OK;
1443 }
1444 if (pc->len >= 2) {
1445 pc->p++; pc->len--;
1446 }
1447 break;
1448 case '$':
1449 case '[':
1450 pc->tend = pc->p-1;
1451 pc->tt = JIM_TT_ESC;
1452 return JIM_OK;
1453 case ' ':
1454 case '\t':
1455 case '\n':
1456 case '\r':
1457 case ';':
1458 if (pc->state == JIM_PS_DEF) {
1459 pc->tend = pc->p-1;
1460 pc->tt = JIM_TT_ESC;
1461 return JIM_OK;
1462 } else if (*pc->p == '\n') {
1463 pc->linenr++;
1464 }
1465 break;
1466 case '"':
1467 if (pc->state == JIM_PS_QUOTE) {
1468 pc->tend = pc->p-1;
1469 pc->tt = JIM_TT_ESC;
1470 pc->p++; pc->len--;
1471 pc->state = JIM_PS_DEF;
1472 return JIM_OK;
1473 }
1474 break;
1475 }
1476 pc->p++; pc->len--;
1477 }
1478 return JIM_OK; /* unreached */
1479 }
1480
1481 int JimParseComment(struct JimParserCtx *pc)
1482 {
1483 while (*pc->p) {
1484 if (*pc->p == '\n') {
1485 pc->linenr++;
1486 if (*(pc->p-1) != '\\') {
1487 pc->p++; pc->len--;
1488 return JIM_OK;
1489 }
1490 }
1491 pc->p++; pc->len--;
1492 }
1493 return JIM_OK;
1494 }
1495
1496 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1497 static int xdigitval(int c)
1498 {
1499 if (c >= '0' && c <= '9') return c-'0';
1500 if (c >= 'a' && c <= 'f') return c-'a'+10;
1501 if (c >= 'A' && c <= 'F') return c-'A'+10;
1502 return -1;
1503 }
1504
1505 static int odigitval(int c)
1506 {
1507 if (c >= '0' && c <= '7') return c-'0';
1508 return -1;
1509 }
1510
1511 /* Perform Tcl escape substitution of 's', storing the result
1512 * string into 'dest'. The escaped string is guaranteed to
1513 * be the same length or shorted than the source string.
1514 * Slen is the length of the string at 's', if it's -1 the string
1515 * length will be calculated by the function.
1516 *
1517 * The function returns the length of the resulting string. */
1518 static int JimEscape(char *dest, const char *s, int slen)
1519 {
1520 char *p = dest;
1521 int i, len;
1522
1523 if (slen == -1)
1524 slen = strlen(s);
1525
1526 for (i = 0; i < slen; i++) {
1527 switch (s[i]) {
1528 case '\\':
1529 switch (s[i + 1]) {
1530 case 'a': *p++ = 0x7; i++; break;
1531 case 'b': *p++ = 0x8; i++; break;
1532 case 'f': *p++ = 0xc; i++; break;
1533 case 'n': *p++ = 0xa; i++; break;
1534 case 'r': *p++ = 0xd; i++; break;
1535 case 't': *p++ = 0x9; i++; break;
1536 case 'v': *p++ = 0xb; i++; break;
1537 case '\0': *p++ = '\\'; i++; break;
1538 case '\n': *p++ = ' '; i++; break;
1539 default:
1540 if (s[i + 1] == 'x') {
1541 int val = 0;
1542 int c = xdigitval(s[i + 2]);
1543 if (c == -1) {
1544 *p++ = 'x';
1545 i++;
1546 break;
1547 }
1548 val = c;
1549 c = xdigitval(s[i + 3]);
1550 if (c == -1) {
1551 *p++ = val;
1552 i += 2;
1553 break;
1554 }
1555 val = (val*16) + c;
1556 *p++ = val;
1557 i += 3;
1558 break;
1559 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1560 {
1561 int val = 0;
1562 int c = odigitval(s[i + 1]);
1563 val = c;
1564 c = odigitval(s[i + 2]);
1565 if (c == -1) {
1566 *p++ = val;
1567 i ++;
1568 break;
1569 }
1570 val = (val*8) + c;
1571 c = odigitval(s[i + 3]);
1572 if (c == -1) {
1573 *p++ = val;
1574 i += 2;
1575 break;
1576 }
1577 val = (val*8) + c;
1578 *p++ = val;
1579 i += 3;
1580 } else {
1581 *p++ = s[i + 1];
1582 i++;
1583 }
1584 break;
1585 }
1586 break;
1587 default:
1588 *p++ = s[i];
1589 break;
1590 }
1591 }
1592 len = p-dest;
1593 *p++ = '\0';
1594 return len;
1595 }
1596
1597 /* Returns a dynamically allocated copy of the current token in the
1598 * parser context. The function perform conversion of escapes if
1599 * the token is of type JIM_TT_ESC.
1600 *
1601 * Note that after the conversion, tokens that are grouped with
1602 * braces in the source code, are always recognizable from the
1603 * identical string obtained in a different way from the type.
1604 *
1605 * For exmple the string:
1606 *
1607 * {expand}$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_STR
1610 *
1611 * While the string:
1612 *
1613 * expand$a
1614 *
1615 * will return as first token "expand", of type JIM_TT_ESC
1616 */
1617 char *JimParserGetToken(struct JimParserCtx *pc,
1618 int *lenPtr, int *typePtr, int *linePtr)
1619 {
1620 const char *start, *end;
1621 char *token;
1622 int len;
1623
1624 start = JimParserTstart(pc);
1625 end = JimParserTend(pc);
1626 if (start > end) {
1627 if (lenPtr) *lenPtr = 0;
1628 if (typePtr) *typePtr = JimParserTtype(pc);
1629 if (linePtr) *linePtr = JimParserTline(pc);
1630 token = Jim_Alloc(1);
1631 token[0] = '\0';
1632 return token;
1633 }
1634 len = (end-start) + 1;
1635 token = Jim_Alloc(len + 1);
1636 if (JimParserTtype(pc) != JIM_TT_ESC) {
1637 /* No escape conversion needed? Just copy it. */
1638 memcpy(token, start, len);
1639 token[len] = '\0';
1640 } else {
1641 /* Else convert the escape chars. */
1642 len = JimEscape(token, start, len);
1643 }
1644 if (lenPtr) *lenPtr = len;
1645 if (typePtr) *typePtr = JimParserTtype(pc);
1646 if (linePtr) *linePtr = JimParserTline(pc);
1647 return token;
1648 }
1649
1650 /* The following functin is not really part of the parsing engine of Jim,
1651 * but it somewhat related. Given an string and its length, it tries
1652 * to guess if the script is complete or there are instead " " or { }
1653 * open and not completed. This is useful for interactive shells
1654 * implementation and for [info complete].
1655 *
1656 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1657 * '{' on scripts incomplete missing one or more '}' to be balanced.
1658 * '"' on scripts incomplete missing a '"' char.
1659 *
1660 * If the script is complete, 1 is returned, otherwise 0. */
1661 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1662 {
1663 int level = 0;
1664 int state = ' ';
1665
1666 while (len) {
1667 switch (*s) {
1668 case '\\':
1669 if (len > 1)
1670 s++;
1671 break;
1672 case '"':
1673 if (state == ' ') {
1674 state = '"';
1675 } else if (state == '"') {
1676 state = ' ';
1677 }
1678 break;
1679 case '{':
1680 if (state == '{') {
1681 level++;
1682 } else if (state == ' ') {
1683 state = '{';
1684 level++;
1685 }
1686 break;
1687 case '}':
1688 if (state == '{') {
1689 level--;
1690 if (level == 0)
1691 state = ' ';
1692 }
1693 break;
1694 }
1695 s++;
1696 len--;
1697 }
1698 if (stateCharPtr)
1699 *stateCharPtr = state;
1700 return state == ' ';
1701 }
1702
1703 /* -----------------------------------------------------------------------------
1704 * Tcl Lists parsing
1705 * ---------------------------------------------------------------------------*/
1706 static int JimParseListSep(struct JimParserCtx *pc);
1707 static int JimParseListStr(struct JimParserCtx *pc);
1708
1709 static int JimParseList(struct JimParserCtx *pc)
1710 {
1711 if (pc->len == 0) {
1712 pc->tstart = pc->tend = pc->p;
1713 pc->tline = pc->linenr;
1714 pc->tt = JIM_TT_EOL;
1715 pc->eof = 1;
1716 return JIM_OK;
1717 }
1718 switch (*pc->p) {
1719 case ' ':
1720 case '\n':
1721 case '\t':
1722 case '\r':
1723 if (pc->state == JIM_PS_DEF)
1724 return JimParseListSep(pc);
1725 else
1726 return JimParseListStr(pc);
1727 break;
1728 default:
1729 return JimParseListStr(pc);
1730 break;
1731 }
1732 return JIM_OK;
1733 }
1734
1735 int JimParseListSep(struct JimParserCtx *pc)
1736 {
1737 pc->tstart = pc->p;
1738 pc->tline = pc->linenr;
1739 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1740 {
1741 pc->p++; pc->len--;
1742 }
1743 pc->tend = pc->p-1;
1744 pc->tt = JIM_TT_SEP;
1745 return JIM_OK;
1746 }
1747
1748 int JimParseListStr(struct JimParserCtx *pc)
1749 {
1750 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1751 pc->tt == JIM_TT_NONE);
1752 if (newword && *pc->p == '{') {
1753 return JimParseBrace(pc);
1754 } else if (newword && *pc->p == '"') {
1755 pc->state = JIM_PS_QUOTE;
1756 pc->p++; pc->len--;
1757 }
1758 pc->tstart = pc->p;
1759 pc->tline = pc->linenr;
1760 while (1) {
1761 if (pc->len == 0) {
1762 pc->tend = pc->p-1;
1763 pc->tt = JIM_TT_ESC;
1764 return JIM_OK;
1765 }
1766 switch (*pc->p) {
1767 case '\\':
1768 pc->p++; pc->len--;
1769 break;
1770 case ' ':
1771 case '\t':
1772 case '\n':
1773 case '\r':
1774 if (pc->state == JIM_PS_DEF) {
1775 pc->tend = pc->p-1;
1776 pc->tt = JIM_TT_ESC;
1777 return JIM_OK;
1778 } else if (*pc->p == '\n') {
1779 pc->linenr++;
1780 }
1781 break;
1782 case '"':
1783 if (pc->state == JIM_PS_QUOTE) {
1784 pc->tend = pc->p-1;
1785 pc->tt = JIM_TT_ESC;
1786 pc->p++; pc->len--;
1787 pc->state = JIM_PS_DEF;
1788 return JIM_OK;
1789 }
1790 break;
1791 }
1792 pc->p++; pc->len--;
1793 }
1794 return JIM_OK; /* unreached */
1795 }
1796
1797 /* -----------------------------------------------------------------------------
1798 * Jim_Obj related functions
1799 * ---------------------------------------------------------------------------*/
1800
1801 /* Return a new initialized object. */
1802 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1803 {
1804 Jim_Obj *objPtr;
1805
1806 /* -- Check if there are objects in the free list -- */
1807 if (interp->freeList != NULL) {
1808 /* -- Unlink the object from the free list -- */
1809 objPtr = interp->freeList;
1810 interp->freeList = objPtr->nextObjPtr;
1811 } else {
1812 /* -- No ready to use objects: allocate a new one -- */
1813 objPtr = Jim_Alloc(sizeof(*objPtr));
1814 }
1815
1816 /* Object is returned with refCount of 0. Every
1817 * kind of GC implemented should take care to don't try
1818 * to scan objects with refCount == 0. */
1819 objPtr->refCount = 0;
1820 /* All the other fields are left not initialized to save time.
1821 * The caller will probably want set they to the right
1822 * value anyway. */
1823
1824 /* -- Put the object into the live list -- */
1825 objPtr->prevObjPtr = NULL;
1826 objPtr->nextObjPtr = interp->liveList;
1827 if (interp->liveList)
1828 interp->liveList->prevObjPtr = objPtr;
1829 interp->liveList = objPtr;
1830
1831 return objPtr;
1832 }
1833
1834 /* Free an object. Actually objects are never freed, but
1835 * just moved to the free objects list, where they will be
1836 * reused by Jim_NewObj(). */
1837 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1838 {
1839 /* Check if the object was already freed, panic. */
1840 if (objPtr->refCount != 0) {
1841 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1842 objPtr->refCount);
1843 }
1844 /* Free the internal representation */
1845 Jim_FreeIntRep(interp, objPtr);
1846 /* Free the string representation */
1847 if (objPtr->bytes != NULL) {
1848 if (objPtr->bytes != JimEmptyStringRep)
1849 Jim_Free(objPtr->bytes);
1850 }
1851 /* Unlink the object from the live objects list */
1852 if (objPtr->prevObjPtr)
1853 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1854 if (objPtr->nextObjPtr)
1855 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1856 if (interp->liveList == objPtr)
1857 interp->liveList = objPtr->nextObjPtr;
1858 /* Link the object into the free objects list */
1859 objPtr->prevObjPtr = NULL;
1860 objPtr->nextObjPtr = interp->freeList;
1861 if (interp->freeList)
1862 interp->freeList->prevObjPtr = objPtr;
1863 interp->freeList = objPtr;
1864 objPtr->refCount = -1;
1865 }
1866
1867 /* Invalidate the string representation of an object. */
1868 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1869 {
1870 if (objPtr->bytes != NULL) {
1871 if (objPtr->bytes != JimEmptyStringRep)
1872 Jim_Free(objPtr->bytes);
1873 }
1874 objPtr->bytes = NULL;
1875 }
1876
1877 #define Jim_SetStringRep(o, b, l) \
1878 do { (o)->bytes = b; (o)->length = l; } while (0)
1879
1880 /* Set the initial string representation for an object.
1881 * Does not try to free an old one. */
1882 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1883 {
1884 if (length == 0) {
1885 objPtr->bytes = JimEmptyStringRep;
1886 objPtr->length = 0;
1887 } else {
1888 objPtr->bytes = Jim_Alloc(length + 1);
1889 objPtr->length = length;
1890 memcpy(objPtr->bytes, bytes, length);
1891 objPtr->bytes[length] = '\0';
1892 }
1893 }
1894
1895 /* Duplicate an object. The returned object has refcount = 0. */
1896 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1897 {
1898 Jim_Obj *dupPtr;
1899
1900 dupPtr = Jim_NewObj(interp);
1901 if (objPtr->bytes == NULL) {
1902 /* Object does not have a valid string representation. */
1903 dupPtr->bytes = NULL;
1904 } else {
1905 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1906 }
1907 if (objPtr->typePtr != NULL) {
1908 if (objPtr->typePtr->dupIntRepProc == NULL) {
1909 dupPtr->internalRep = objPtr->internalRep;
1910 } else {
1911 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1912 }
1913 dupPtr->typePtr = objPtr->typePtr;
1914 } else {
1915 dupPtr->typePtr = NULL;
1916 }
1917 return dupPtr;
1918 }
1919
1920 /* Return the string representation for objPtr. If the object
1921 * string representation is invalid, calls the method to create
1922 * a new one starting from the internal representation of the object. */
1923 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1924 {
1925 if (objPtr->bytes == NULL) {
1926 /* Invalid string repr. Generate it. */
1927 if (objPtr->typePtr->updateStringProc == NULL) {
1928 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1929 objPtr->typePtr->name);
1930 }
1931 objPtr->typePtr->updateStringProc(objPtr);
1932 }
1933 if (lenPtr)
1934 *lenPtr = objPtr->length;
1935 return objPtr->bytes;
1936 }
1937
1938 /* Just returns the length of the object's string rep */
1939 int Jim_Length(Jim_Obj *objPtr)
1940 {
1941 int len;
1942
1943 Jim_GetString(objPtr, &len);
1944 return len;
1945 }
1946
1947 /* -----------------------------------------------------------------------------
1948 * String Object
1949 * ---------------------------------------------------------------------------*/
1950 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1951 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1952
1953 static Jim_ObjType stringObjType = {
1954 "string",
1955 NULL,
1956 DupStringInternalRep,
1957 NULL,
1958 JIM_TYPE_REFERENCES,
1959 };
1960
1961 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1962 {
1963 JIM_NOTUSED(interp);
1964
1965 /* This is a bit subtle: the only caller of this function
1966 * should be Jim_DuplicateObj(), that will copy the
1967 * string representaion. After the copy, the duplicated
1968 * object will not have more room in teh buffer than
1969 * srcPtr->length bytes. So we just set it to length. */
1970 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1971 }
1972
1973 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1974 {
1975 /* Get a fresh string representation. */
1976 (void) Jim_GetString(objPtr, NULL);
1977 /* Free any other internal representation. */
1978 Jim_FreeIntRep(interp, objPtr);
1979 /* Set it as string, i.e. just set the maxLength field. */
1980 objPtr->typePtr = &stringObjType;
1981 objPtr->internalRep.strValue.maxLength = objPtr->length;
1982 return JIM_OK;
1983 }
1984
1985 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1986 {
1987 Jim_Obj *objPtr = Jim_NewObj(interp);
1988
1989 if (len == -1)
1990 len = strlen(s);
1991 /* Alloc/Set the string rep. */
1992 if (len == 0) {
1993 objPtr->bytes = JimEmptyStringRep;
1994 objPtr->length = 0;
1995 } else {
1996 objPtr->bytes = Jim_Alloc(len + 1);
1997 objPtr->length = len;
1998 memcpy(objPtr->bytes, s, len);
1999 objPtr->bytes[len] = '\0';
2000 }
2001
2002 /* No typePtr field for the vanilla string object. */
2003 objPtr->typePtr = NULL;
2004 return objPtr;
2005 }
2006
2007 /* This version does not try to duplicate the 's' pointer, but
2008 * use it directly. */
2009 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2010 {
2011 Jim_Obj *objPtr = Jim_NewObj(interp);
2012
2013 if (len == -1)
2014 len = strlen(s);
2015 Jim_SetStringRep(objPtr, s, len);
2016 objPtr->typePtr = NULL;
2017 return objPtr;
2018 }
2019
2020 /* Low-level string append. Use it only against objects
2021 * of type "string". */
2022 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2023 {
2024 int needlen;
2025
2026 if (len == -1)
2027 len = strlen(str);
2028 needlen = objPtr->length + len;
2029 if (objPtr->internalRep.strValue.maxLength < needlen ||
2030 objPtr->internalRep.strValue.maxLength == 0) {
2031 if (objPtr->bytes == JimEmptyStringRep) {
2032 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2033 } else {
2034 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2035 }
2036 objPtr->internalRep.strValue.maxLength = needlen*2;
2037 }
2038 memcpy(objPtr->bytes + objPtr->length, str, len);
2039 objPtr->bytes[objPtr->length + len] = '\0';
2040 objPtr->length += len;
2041 }
2042
2043 /* Low-level wrapper to append an object. */
2044 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2045 {
2046 int len;
2047 const char *str;
2048
2049 str = Jim_GetString(appendObjPtr, &len);
2050 StringAppendString(objPtr, str, len);
2051 }
2052
2053 /* Higher level API to append strings to objects. */
2054 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2055 int len)
2056 {
2057 if (Jim_IsShared(objPtr))
2058 Jim_Panic(interp,"Jim_AppendString called with shared object");
2059 if (objPtr->typePtr != &stringObjType)
2060 SetStringFromAny(interp, objPtr);
2061 StringAppendString(objPtr, str, len);
2062 }
2063
2064 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2065 {
2066 char *buf;
2067 va_list ap;
2068
2069 va_start(ap, fmt);
2070 buf = jim_vasprintf(fmt, ap);
2071 va_end(ap);
2072
2073 if (buf) {
2074 Jim_AppendString(interp, objPtr, buf, -1);
2075 jim_vasprintf_done(buf);
2076 }
2077 }
2078
2079
2080 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2081 Jim_Obj *appendObjPtr)
2082 {
2083 int len;
2084 const char *str;
2085
2086 str = Jim_GetString(appendObjPtr, &len);
2087 Jim_AppendString(interp, objPtr, str, len);
2088 }
2089
2090 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2091 {
2092 va_list ap;
2093
2094 if (objPtr->typePtr != &stringObjType)
2095 SetStringFromAny(interp, objPtr);
2096 va_start(ap, objPtr);
2097 while (1) {
2098 char *s = va_arg(ap, char*);
2099
2100 if (s == NULL) break;
2101 Jim_AppendString(interp, objPtr, s, -1);
2102 }
2103 va_end(ap);
2104 }
2105
2106 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2107 {
2108 const char *aStr, *bStr;
2109 int aLen, bLen, i;
2110
2111 if (aObjPtr == bObjPtr) return 1;
2112 aStr = Jim_GetString(aObjPtr, &aLen);
2113 bStr = Jim_GetString(bObjPtr, &bLen);
2114 if (aLen != bLen) return 0;
2115 if (nocase == 0)
2116 return memcmp(aStr, bStr, aLen) == 0;
2117 for (i = 0; i < aLen; i++) {
2118 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2119 return 0;
2120 }
2121 return 1;
2122 }
2123
2124 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2125 int nocase)
2126 {
2127 const char *pattern, *string;
2128 int patternLen, stringLen;
2129
2130 pattern = Jim_GetString(patternObjPtr, &patternLen);
2131 string = Jim_GetString(objPtr, &stringLen);
2132 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2133 }
2134
2135 static int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2136 Jim_Obj *secondObjPtr, int nocase)
2137 {
2138 const char *s1, *s2;
2139 int l1, l2;
2140
2141 s1 = Jim_GetString(firstObjPtr, &l1);
2142 s2 = Jim_GetString(secondObjPtr, &l2);
2143 return JimStringCompare(s1, l1, s2, l2, nocase);
2144 }
2145
2146 /* Convert a range, as returned by Jim_GetRange(), into
2147 * an absolute index into an object of the specified length.
2148 * This function may return negative values, or values
2149 * bigger or equal to the length of the list if the index
2150 * is out of range. */
2151 static int JimRelToAbsIndex(int len, int index_t)
2152 {
2153 if (index_t < 0)
2154 return len + index_t;
2155 return index_t;
2156 }
2157
2158 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2159 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2160 * for implementation of commands like [string range] and [lrange].
2161 *
2162 * The resulting range is guaranteed to address valid elements of
2163 * the structure. */
2164 static void JimRelToAbsRange(int len, int first, int last,
2165 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2166 {
2167 int rangeLen;
2168
2169 if (first > last) {
2170 rangeLen = 0;
2171 } else {
2172 rangeLen = last-first + 1;
2173 if (rangeLen) {
2174 if (first < 0) {
2175 rangeLen += first;
2176 first = 0;
2177 }
2178 if (last >= len) {
2179 rangeLen -= (last-(len-1));
2180 last = len-1;
2181 }
2182 }
2183 }
2184 if (rangeLen < 0) rangeLen = 0;
2185
2186 *firstPtr = first;
2187 *lastPtr = last;
2188 *rangeLenPtr = rangeLen;
2189 }
2190
2191 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2192 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2193 {
2194 int first, last;
2195 const char *str;
2196 int len, rangeLen;
2197
2198 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2199 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2200 return NULL;
2201 str = Jim_GetString(strObjPtr, &len);
2202 first = JimRelToAbsIndex(len, first);
2203 last = JimRelToAbsIndex(len, last);
2204 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2205 return Jim_NewStringObj(interp, str + first, rangeLen);
2206 }
2207
2208 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2209 {
2210 char *buf;
2211 int i;
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2214 }
2215
2216 buf = Jim_Alloc(strObjPtr->length + 1);
2217
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = tolower((unsigned)buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2222 }
2223
2224 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2225 {
2226 char *buf;
2227 int i;
2228 if (strObjPtr->typePtr != &stringObjType) {
2229 SetStringFromAny(interp, strObjPtr);
2230 }
2231
2232 buf = Jim_Alloc(strObjPtr->length + 1);
2233
2234 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2235 for (i = 0; i < strObjPtr->length; i++)
2236 buf[i] = toupper((unsigned)buf[i]);
2237 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2238 }
2239
2240 /* This is the core of the [format] command.
2241 * TODO: Lots of things work - via a hack
2242 * However, no format item can be >= JIM_MAX_FMT
2243 */
2244 #define JIM_MAX_FMT 2048
2245 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2246 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2247 {
2248 const char *fmt, *_fmt;
2249 int fmtLen;
2250 Jim_Obj *resObjPtr;
2251
2252
2253 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2254 _fmt = fmt;
2255 resObjPtr = Jim_NewStringObj(interp, "", 0);
2256 while (fmtLen) {
2257 const char *p = fmt;
2258 char spec[2], c;
2259 jim_wide wideValue;
2260 double doubleValue;
2261 /* we cheat and use Sprintf()! */
2262 char fmt_str[100];
2263 char *cp;
2264 int width;
2265 int ljust;
2266 int zpad;
2267 int spad;
2268 int altfm;
2269 int forceplus;
2270 int prec;
2271 int inprec;
2272 int haveprec;
2273 int accum;
2274
2275 while (*fmt != '%' && fmtLen) {
2276 fmt++; fmtLen--;
2277 }
2278 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2279 if (fmtLen == 0)
2280 break;
2281 fmt++; fmtLen--; /* skip '%' */
2282 zpad = 0;
2283 spad = 0;
2284 width = -1;
2285 ljust = 0;
2286 altfm = 0;
2287 forceplus = 0;
2288 inprec = 0;
2289 haveprec = 0;
2290 prec = -1; /* not found yet */
2291 next_fmt:
2292 if (fmtLen <= 0) {
2293 break;
2294 }
2295 switch (*fmt) {
2296 /* terminals */
2297 case 'b': /* binary - not all printfs() do this */
2298 case 's': /* string */
2299 case 'i': /* integer */
2300 case 'd': /* decimal */
2301 case 'x': /* hex */
2302 case 'X': /* CAP hex */
2303 case 'c': /* char */
2304 case 'o': /* octal */
2305 case 'u': /* unsigned */
2306 case 'f': /* float */
2307 break;
2308
2309 /* non-terminals */
2310 case '0': /* zero pad */
2311 zpad = 1;
2312 fmt++; fmtLen--;
2313 goto next_fmt;
2314 break;
2315 case '+':
2316 forceplus = 1;
2317 fmt++; fmtLen--;
2318 goto next_fmt;
2319 break;
2320 case ' ': /* sign space */
2321 spad = 1;
2322 fmt++; fmtLen--;
2323 goto next_fmt;
2324 break;
2325 case '-':
2326 ljust = 1;
2327 fmt++; fmtLen--;
2328 goto next_fmt;
2329 break;
2330 case '#':
2331 altfm = 1;
2332 fmt++; fmtLen--;
2333 goto next_fmt;
2334
2335 case '.':
2336 inprec = 1;
2337 fmt++; fmtLen--;
2338 goto next_fmt;
2339 break;
2340 case '1':
2341 case '2':
2342 case '3':
2343 case '4':
2344 case '5':
2345 case '6':
2346 case '7':
2347 case '8':
2348 case '9':
2349 accum = 0;
2350 while (isdigit((unsigned)*fmt) && (fmtLen > 0)) {
2351 accum = (accum * 10) + (*fmt - '0');
2352 fmt++; fmtLen--;
2353 }
2354 if (inprec) {
2355 haveprec = 1;
2356 prec = accum;
2357 } else {
2358 width = accum;
2359 }
2360 goto next_fmt;
2361 case '*':
2362 /* suck up the next item as an integer */
2363 fmt++; fmtLen--;
2364 objc--;
2365 if (objc <= 0) {
2366 goto not_enough_args;
2367 }
2368 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2369 Jim_FreeNewObj(interp, resObjPtr);
2370 return NULL;
2371 }
2372 if (inprec) {
2373 haveprec = 1;
2374 prec = wideValue;
2375 if (prec < 0) {
2376 /* man 3 printf says */
2377 /* if prec is negative, it is zero */
2378 prec = 0;
2379 }
2380 } else {
2381 width = wideValue;
2382 if (width < 0) {
2383 ljust = 1;
2384 width = -width;
2385 }
2386 }
2387 objv++;
2388 goto next_fmt;
2389 break;
2390 }
2391
2392
2393 if (*fmt != '%') {
2394 if (objc == 0) {
2395 not_enough_args:
2396 Jim_FreeNewObj(interp, resObjPtr);
2397 Jim_SetResultString(interp,
2398 "not enough arguments for all format specifiers", -1);
2399 return NULL;
2400 } else {
2401 objc--;
2402 }
2403 }
2404
2405 /*
2406 * Create the formatter
2407 * cause we cheat and use sprintf()
2408 */
2409 cp = fmt_str;
2410 *cp++ = '%';
2411 if (altfm) {
2412 *cp++ = '#';
2413 }
2414 if (forceplus) {
2415 *cp++ = '+';
2416 } else if (spad) {
2417 /* PLUS overrides */
2418 *cp++ = ' ';
2419 }
2420 if (ljust) {
2421 *cp++ = '-';
2422 }
2423 if (zpad) {
2424 *cp++ = '0';
2425 }
2426 if (width > 0) {
2427 sprintf(cp, "%d", width);
2428 /* skip ahead */
2429 cp = strchr(cp,0);
2430 }
2431 /* did we find a period? */
2432 if (inprec) {
2433 /* then add it */
2434 *cp++ = '.';
2435 /* did something occur after the period? */
2436 if (haveprec) {
2437 sprintf(cp, "%d", prec);
2438 }
2439 cp = strchr(cp,0);
2440 }
2441 *cp = 0;
2442
2443 /* here we do the work */
2444 /* actually - we make sprintf() do it for us */
2445 switch (*fmt) {
2446 case 's':
2447 *cp++ = 's';
2448 *cp = 0;
2449 /* BUG: we do not handled embeded NULLs */
2450 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2451 break;
2452 case 'c':
2453 *cp++ = 'c';
2454 *cp = 0;
2455 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2456 Jim_FreeNewObj(interp, resObjPtr);
2457 return NULL;
2458 }
2459 c = (char) wideValue;
2460 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2461 break;
2462 case 'f':
2463 case 'F':
2464 case 'g':
2465 case 'G':
2466 case 'e':
2467 case 'E':
2468 *cp++ = *fmt;
2469 *cp = 0;
2470 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2471 Jim_FreeNewObj(interp, resObjPtr);
2472 return NULL;
2473 }
2474 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2475 break;
2476 case 'b':
2477 case 'd':
2478 case 'o':
2479 case 'i':
2480 case 'u':
2481 case 'x':
2482 case 'X':
2483 /* jim widevaluse are 64bit */
2484 if (sizeof(jim_wide) == sizeof(long long)) {
2485 *cp++ = 'l';
2486 *cp++ = 'l';
2487 } else {
2488 *cp++ = 'l';
2489 }
2490 *cp++ = *fmt;
2491 *cp = 0;
2492 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2493 Jim_FreeNewObj(interp, resObjPtr);
2494 return NULL;
2495 }
2496 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2497 break;
2498 case '%':
2499 sprintf_buf[0] = '%';
2500 sprintf_buf[1] = 0;
2501 objv--; /* undo the objv++ below */
2502 break;
2503 default:
2504 spec[0] = *fmt; spec[1] = '\0';
2505 Jim_FreeNewObj(interp, resObjPtr);
2506 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2507 Jim_AppendStrings(interp, Jim_GetResult(interp),
2508 "bad field specifier \"", spec, "\"", NULL);
2509 return NULL;
2510 }
2511 /* force terminate */
2512 #if 0
2513 printf("FMT was: %s\n", fmt_str);
2514 printf("RES was: |%s|\n", sprintf_buf);
2515 #endif
2516
2517 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2518 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2519 /* next obj */
2520 objv++;
2521 fmt++;
2522 fmtLen--;
2523 }
2524 return resObjPtr;
2525 }
2526
2527 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2528 int objc, Jim_Obj *const *objv)
2529 {
2530 char *sprintf_buf = malloc(JIM_MAX_FMT);
2531 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2532 free(sprintf_buf);
2533 return t;
2534 }
2535
2536 /* -----------------------------------------------------------------------------
2537 * Compared String Object
2538 * ---------------------------------------------------------------------------*/
2539
2540 /* This is strange object that allows to compare a C literal string
2541 * with a Jim object in very short time if the same comparison is done
2542 * multiple times. For example every time the [if] command is executed,
2543 * Jim has to check if a given argument is "else". This comparions if
2544 * the code has no errors are true most of the times, so we can cache
2545 * inside the object the pointer of the string of the last matching
2546 * comparison. Because most C compilers perform literal sharing,
2547 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2548 * this works pretty well even if comparisons are at different places
2549 * inside the C code. */
2550
2551 static Jim_ObjType comparedStringObjType = {
2552 "compared-string",
2553 NULL,
2554 NULL,
2555 NULL,
2556 JIM_TYPE_REFERENCES,
2557 };
2558
2559 /* The only way this object is exposed to the API is via the following
2560 * function. Returns true if the string and the object string repr.
2561 * are the same, otherwise zero is returned.
2562 *
2563 * Note: this isn't binary safe, but it hardly needs to be.*/
2564 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2565 const char *str)
2566 {
2567 if (objPtr->typePtr == &comparedStringObjType &&
2568 objPtr->internalRep.ptr == str)
2569 return 1;
2570 else {
2571 const char *objStr = Jim_GetString(objPtr, NULL);
2572 if (strcmp(str, objStr) != 0) return 0;
2573 if (objPtr->typePtr != &comparedStringObjType) {
2574 Jim_FreeIntRep(interp, objPtr);
2575 objPtr->typePtr = &comparedStringObjType;
2576 }
2577 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2578 return 1;
2579 }
2580 }
2581
2582 static int qsortCompareStringPointers(const void *a, const void *b)
2583 {
2584 char * const *sa = (char * const *)a;
2585 char * const *sb = (char * const *)b;
2586 return strcmp(*sa, *sb);
2587 }
2588
2589 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2590 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2591 {
2592 const char * const *entryPtr = NULL;
2593 char **tablePtrSorted;
2594 int i, count = 0;
2595
2596 *indexPtr = -1;
2597 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2598 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2599 *indexPtr = i;
2600 return JIM_OK;
2601 }
2602 count++; /* If nothing matches, this will reach the len of tablePtr */
2603 }
2604 if (flags & JIM_ERRMSG) {
2605 if (name == NULL)
2606 name = "option";
2607 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2608 Jim_AppendStrings(interp, Jim_GetResult(interp),
2609 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2610 NULL);
2611 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2612 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2613 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2614 for (i = 0; i < count; i++) {
2615 if (i + 1 == count && count > 1)
2616 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2617 Jim_AppendString(interp, Jim_GetResult(interp),
2618 tablePtrSorted[i], -1);
2619 if (i + 1 != count)
2620 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2621 }
2622 Jim_Free(tablePtrSorted);
2623 }
2624 return JIM_ERR;
2625 }
2626
2627 int Jim_GetNvp(Jim_Interp *interp,
2628 Jim_Obj *objPtr,
2629 const Jim_Nvp *nvp_table,
2630 const Jim_Nvp ** result)
2631 {
2632 Jim_Nvp *n;
2633 int e;
2634
2635 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2636 if (e == JIM_ERR) {
2637 return e;
2638 }
2639
2640 /* Success? found? */
2641 if (n->name) {
2642 /* remove const */
2643 *result = (Jim_Nvp *)n;
2644 return JIM_OK;
2645 } else {
2646 return JIM_ERR;
2647 }
2648 }
2649
2650 /* -----------------------------------------------------------------------------
2651 * Source Object
2652 *
2653 * This object is just a string from the language point of view, but
2654 * in the internal representation it contains the filename and line number
2655 * where this given token was read. This information is used by
2656 * Jim_EvalObj() if the object passed happens to be of type "source".
2657 *
2658 * This allows to propagate the information about line numbers and file
2659 * names and give error messages with absolute line numbers.
2660 *
2661 * Note that this object uses shared strings for filenames, and the
2662 * pointer to the filename together with the line number is taken into
2663 * the space for the "inline" internal represenation of the Jim_Object,
2664 * so there is almost memory zero-overhead.
2665 *
2666 * Also the object will be converted to something else if the given
2667 * token it represents in the source file is not something to be
2668 * evaluated (not a script), and will be specialized in some other way,
2669 * so the time overhead is alzo null.
2670 * ---------------------------------------------------------------------------*/
2671
2672 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2673 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2674
2675 static Jim_ObjType sourceObjType = {
2676 "source",
2677 FreeSourceInternalRep,
2678 DupSourceInternalRep,
2679 NULL,
2680 JIM_TYPE_REFERENCES,
2681 };
2682
2683 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2684 {
2685 Jim_ReleaseSharedString(interp,
2686 objPtr->internalRep.sourceValue.fileName);
2687 }
2688
2689 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2690 {
2691 dupPtr->internalRep.sourceValue.fileName =
2692 Jim_GetSharedString(interp,
2693 srcPtr->internalRep.sourceValue.fileName);
2694 dupPtr->internalRep.sourceValue.lineNumber =
2695 dupPtr->internalRep.sourceValue.lineNumber;
2696 dupPtr->typePtr = &sourceObjType;
2697 }
2698
2699 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2700 const char *fileName, int lineNumber)
2701 {
2702 if (Jim_IsShared(objPtr))
2703 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2704 if (objPtr->typePtr != NULL)
2705 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2706 objPtr->internalRep.sourceValue.fileName =
2707 Jim_GetSharedString(interp, fileName);
2708 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2709 objPtr->typePtr = &sourceObjType;
2710 }
2711
2712 /* -----------------------------------------------------------------------------
2713 * Script Object
2714 * ---------------------------------------------------------------------------*/
2715
2716 #define JIM_CMDSTRUCT_EXPAND -1
2717
2718 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2719 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2720 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2721
2722 static Jim_ObjType scriptObjType = {
2723 "script",
2724 FreeScriptInternalRep,
2725 DupScriptInternalRep,
2726 NULL,
2727 JIM_TYPE_REFERENCES,
2728 };
2729
2730 /* The ScriptToken structure represents every token into a scriptObj.
2731 * Every token contains an associated Jim_Obj that can be specialized
2732 * by commands operating on it. */
2733 typedef struct ScriptToken {
2734 int type;
2735 Jim_Obj *objPtr;
2736 int linenr;
2737 } ScriptToken;
2738
2739 /* This is the script object internal representation. An array of
2740 * ScriptToken structures, with an associated command structure array.
2741 * The command structure is a pre-computed representation of the
2742 * command length and arguments structure as a simple liner array
2743 * of integers.
2744 *
2745 * For example the script:
2746 *
2747 * puts hello
2748 * set $i $x$y [foo]BAR
2749 *
2750 * will produce a ScriptObj with the following Tokens:
2751 *
2752 * ESC puts
2753 * SEP
2754 * ESC hello
2755 * EOL
2756 * ESC set
2757 * EOL
2758 * VAR i
2759 * SEP
2760 * VAR x
2761 * VAR y
2762 * SEP
2763 * CMD foo
2764 * ESC BAR
2765 * EOL
2766 *
2767 * This is a description of the tokens, separators, and of lines.
2768 * The command structure instead represents the number of arguments
2769 * of every command, followed by the tokens of which every argument
2770 * is composed. So for the example script, the cmdstruct array will
2771 * contain:
2772 *
2773 * 2 1 1 4 1 1 2 2
2774 *
2775 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2776 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2777 * composed of single tokens (1 1) and the last two of double tokens
2778 * (2 2).
2779 *
2780 * The precomputation of the command structure makes Jim_Eval() faster,
2781 * and simpler because there aren't dynamic lengths / allocations.
2782 *
2783 * -- {expand} handling --
2784 *
2785 * Expand is handled in a special way. When a command
2786 * contains at least an argument with the {expand} prefix,
2787 * the command structure presents a -1 before the integer
2788 * describing the number of arguments. This is used in order
2789 * to send the command exection to a different path in case
2790 * of {expand} and guarantee a fast path for the more common
2791 * case. Also, the integers describing the number of tokens
2792 * are expressed with negative sign, to allow for fast check
2793 * of what's an {expand}-prefixed argument and what not.
2794 *
2795 * For example the command:
2796 *
2797 * list {expand}{1 2}
2798 *
2799 * Will produce the following cmdstruct array:
2800 *
2801 * -1 2 1 -2
2802 *
2803 * -- the substFlags field of the structure --
2804 *
2805 * The scriptObj structure is used to represent both "script" objects
2806 * and "subst" objects. In the second case, the cmdStruct related
2807 * fields are not used at all, but there is an additional field used
2808 * that is 'substFlags': this represents the flags used to turn
2809 * the string into the intenral representation used to perform the
2810 * substitution. If this flags are not what the application requires
2811 * the scriptObj is created again. For example the script:
2812 *
2813 * subst -nocommands $string
2814 * subst -novariables $string
2815 *
2816 * Will recreate the internal representation of the $string object
2817 * two times.
2818 */
2819 typedef struct ScriptObj {
2820 int len; /* Length as number of tokens. */
2821 int commands; /* number of top-level commands in script. */
2822 ScriptToken *token; /* Tokens array. */
2823 int *cmdStruct; /* commands structure */
2824 int csLen; /* length of the cmdStruct array. */
2825 int substFlags; /* flags used for the compilation of "subst" objects */
2826 int inUse; /* Used to share a ScriptObj. Currently
2827 only used by Jim_EvalObj() as protection against
2828 shimmering of the currently evaluated object. */
2829 char *fileName;
2830 } ScriptObj;
2831
2832 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2833 {
2834 int i;
2835 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2836
2837 if (!script)
2838 return;
2839
2840 script->inUse--;
2841 if (script->inUse != 0) return;
2842 for (i = 0; i < script->len; i++) {
2843 if (script->token[i].objPtr != NULL)
2844 Jim_DecrRefCount(interp, script->token[i].objPtr);
2845 }
2846 Jim_Free(script->token);
2847 Jim_Free(script->cmdStruct);
2848 Jim_Free(script->fileName);
2849 Jim_Free(script);
2850 }
2851
2852 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2853 {
2854 JIM_NOTUSED(interp);
2855 JIM_NOTUSED(srcPtr);
2856
2857 /* Just returns an simple string. */
2858 dupPtr->typePtr = NULL;
2859 }
2860
2861 /* Add a new token to the internal repr of a script object */
2862 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2863 char *strtoken, int len, int type, char *filename, int linenr)
2864 {
2865 int prevtype;
2866 struct ScriptToken *token;
2867
2868 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2869 script->token[script->len-1].type;
2870 /* Skip tokens without meaning, like words separators
2871 * following a word separator or an end of command and
2872 * so on. */
2873 if (prevtype == JIM_TT_EOL) {
2874 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2875 Jim_Free(strtoken);
2876 return;
2877 }
2878 } else if (prevtype == JIM_TT_SEP) {
2879 if (type == JIM_TT_SEP) {
2880 Jim_Free(strtoken);
2881 return;
2882 } else if (type == JIM_TT_EOL) {
2883 /* If an EOL is following by a SEP, drop the previous
2884 * separator. */
2885 script->len--;
2886 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2887 }
2888 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2889 type == JIM_TT_ESC && len == 0)
2890 {
2891 /* Don't add empty tokens used in interpolation */
2892 Jim_Free(strtoken);
2893 return;
2894 }
2895 /* Make space for a new istruction */
2896 script->len++;
2897 script->token = Jim_Realloc(script->token,
2898 sizeof(ScriptToken)*script->len);
2899 /* Initialize the new token */
2900 token = script->token + (script->len-1);
2901 token->type = type;
2902 /* Every object is intially as a string, but the
2903 * internal type may be specialized during execution of the
2904 * script. */
2905 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2906 /* To add source info to SEP and EOL tokens is useless because
2907 * they will never by called as arguments of Jim_EvalObj(). */
2908 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2909 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2910 Jim_IncrRefCount(token->objPtr);
2911 token->linenr = linenr;
2912 }
2913
2914 /* Add an integer into the command structure field of the script object. */
2915 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2916 {
2917 script->csLen++;
2918 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2919 sizeof(int)*script->csLen);
2920 script->cmdStruct[script->csLen-1] = val;
2921 }
2922
2923 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2924 * of objPtr. Search nested script objects recursively. */
2925 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2926 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2927 {
2928 int i;
2929
2930 for (i = 0; i < script->len; i++) {
2931 if (script->token[i].objPtr != objPtr &&
2932 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2933 return script->token[i].objPtr;
2934 }
2935 /* Enter recursively on scripts only if the object
2936 * is not the same as the one we are searching for
2937 * shared occurrences. */
2938 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2939 script->token[i].objPtr != objPtr) {
2940 Jim_Obj *foundObjPtr;
2941
2942 ScriptObj *subScript =
2943 script->token[i].objPtr->internalRep.ptr;
2944 /* Don't recursively enter the script we are trying
2945 * to make shared to avoid circular references. */
2946 if (subScript == scriptBarrier) continue;
2947 if (subScript != script) {
2948 foundObjPtr =
2949 ScriptSearchLiteral(interp, subScript,
2950 scriptBarrier, objPtr);
2951 if (foundObjPtr != NULL)
2952 return foundObjPtr;
2953 }
2954 }
2955 }
2956 return NULL;
2957 }
2958
2959 /* Share literals of a script recursively sharing sub-scripts literals. */
2960 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2961 ScriptObj *topLevelScript)
2962 {
2963 int i, j;
2964
2965 return;
2966 /* Try to share with toplevel object. */
2967 if (topLevelScript != NULL) {
2968 for (i = 0; i < script->len; i++) {
2969 Jim_Obj *foundObjPtr;
2970 char *str = script->token[i].objPtr->bytes;
2971
2972 if (script->token[i].objPtr->refCount != 1) continue;
2973 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2974 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2975 foundObjPtr = ScriptSearchLiteral(interp,
2976 topLevelScript,
2977 script, /* barrier */
2978 script->token[i].objPtr);
2979 if (foundObjPtr != NULL) {
2980 Jim_IncrRefCount(foundObjPtr);
2981 Jim_DecrRefCount(interp,
2982 script->token[i].objPtr);
2983 script->token[i].objPtr = foundObjPtr;
2984 }
2985 }
2986 }
2987 /* Try to share locally */
2988 for (i = 0; i < script->len; i++) {
2989 char *str = script->token[i].objPtr->bytes;
2990
2991 if (script->token[i].objPtr->refCount != 1) continue;
2992 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2993 for (j = 0; j < script->len; j++) {
2994 if (script->token[i].objPtr !=
2995 script->token[j].objPtr &&
2996 Jim_StringEqObj(script->token[i].objPtr,
2997 script->token[j].objPtr, 0))
2998 {
2999 Jim_IncrRefCount(script->token[j].objPtr);
3000 Jim_DecrRefCount(interp,
3001 script->token[i].objPtr);
3002 script->token[i].objPtr =
3003 script->token[j].objPtr;
3004 }
3005 }
3006 }
3007 }
3008
3009 /* This method takes the string representation of an object
3010 * as a Tcl script, and generates the pre-parsed internal representation
3011 * of the script. */
3012 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3013 {
3014 int scriptTextLen;
3015 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3016 struct JimParserCtx parser;
3017 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3018 ScriptToken *token;
3019 int args, tokens, start, end, i;
3020 int initialLineNumber;
3021 int propagateSourceInfo = 0;
3022
3023 script->len = 0;
3024 script->csLen = 0;
3025 script->commands = 0;
3026 script->token = NULL;
3027 script->cmdStruct = NULL;
3028 script->inUse = 1;
3029 /* Try to get information about filename / line number */
3030 if (objPtr->typePtr == &sourceObjType) {
3031 script->fileName =
3032 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3033 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3034 propagateSourceInfo = 1;
3035 } else {
3036 script->fileName = Jim_StrDup("");
3037 initialLineNumber = 1;
3038 }
3039
3040 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3041 while (!JimParserEof(&parser)) {
3042 char *token_t;
3043 int len, type, linenr;
3044
3045 JimParseScript(&parser);
3046 token_t = JimParserGetToken(&parser, &len, &type, &linenr);
3047 ScriptObjAddToken(interp, script, token_t, len, type,
3048 propagateSourceInfo ? script->fileName : NULL,
3049 linenr);
3050 }
3051 token = script->token;
3052
3053 /* Compute the command structure array
3054 * (see the ScriptObj struct definition for more info) */
3055 start = 0; /* Current command start token index */
3056 end = -1; /* Current command end token index */
3057 while (1) {
3058 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3059 int interpolation = 0; /* set to 1 if there is at least one
3060 argument of the command obtained via
3061 interpolation of more tokens. */
3062 /* Search for the end of command, while
3063 * count the number of args. */
3064 start = ++end;
3065 if (start >= script->len) break;
3066 args = 1; /* Number of args in current command */
3067 while (token[end].type != JIM_TT_EOL) {
3068 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3069 token[end-1].type == JIM_TT_EOL)
3070 {
3071 if (token[end].type == JIM_TT_STR &&
3072 token[end + 1].type != JIM_TT_SEP &&
3073 token[end + 1].type != JIM_TT_EOL &&
3074 (!strcmp(token[end].objPtr->bytes, "expand") ||
3075 !strcmp(token[end].objPtr->bytes, "*")))
3076 expand++;
3077 }
3078 if (token[end].type == JIM_TT_SEP)
3079 args++;
3080 end++;
3081 }
3082 interpolation = !((end-start + 1) == args*2);
3083 /* Add the 'number of arguments' info into cmdstruct.
3084 * Negative value if there is list expansion involved. */
3085 if (expand)
3086 ScriptObjAddInt(script, -1);
3087 ScriptObjAddInt(script, args);
3088 /* Now add info about the number of tokens. */
3089 tokens = 0; /* Number of tokens in current argument. */
3090 expand = 0;
3091 for (i = start; i <= end; i++) {
3092 if (token[i].type == JIM_TT_SEP ||
3093 token[i].type == JIM_TT_EOL)
3094 {
3095 if (tokens == 1 && expand)
3096 expand = 0;
3097 ScriptObjAddInt(script,
3098 expand ? -tokens : tokens);
3099
3100 expand = 0;
3101 tokens = 0;
3102 continue;
3103 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3104 (!strcmp(token[i].objPtr->bytes, "expand") ||
3105 !strcmp(token[i].objPtr->bytes, "*")))
3106 {
3107 expand++;
3108 }
3109 tokens++;
3110 }
3111 }
3112 /* Perform literal sharing, but only for objects that appear
3113 * to be scripts written as literals inside the source code,
3114 * and not computed at runtime. Literal sharing is a costly
3115 * operation that should be done only against objects that
3116 * are likely to require compilation only the first time, and
3117 * then are executed multiple times. */
3118 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3119 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3120 if (bodyObjPtr->typePtr == &scriptObjType) {
3121 ScriptObj *bodyScript =
3122 bodyObjPtr->internalRep.ptr;
3123 ScriptShareLiterals(interp, script, bodyScript);
3124 }
3125 } else if (propagateSourceInfo) {
3126 ScriptShareLiterals(interp, script, NULL);
3127 }
3128 /* Free the old internal rep and set the new one. */
3129 Jim_FreeIntRep(interp, objPtr);
3130 Jim_SetIntRepPtr(objPtr, script);
3131 objPtr->typePtr = &scriptObjType;
3132 return JIM_OK;
3133 }
3134
3135 static ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3136 {
3137 if (objPtr->typePtr != &scriptObjType) {
3138 SetScriptFromAny(interp, objPtr);
3139 }
3140 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3141 }
3142
3143 /* -----------------------------------------------------------------------------
3144 * Commands
3145 * ---------------------------------------------------------------------------*/
3146
3147 /* Commands HashTable Type.
3148 *
3149 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3150 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3151 {
3152 Jim_Cmd *cmdPtr = (void*) val;
3153
3154 if (cmdPtr->cmdProc == NULL) {
3155 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3156 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3157 if (cmdPtr->staticVars) {
3158 Jim_FreeHashTable(cmdPtr->staticVars);
3159 Jim_Free(cmdPtr->staticVars);
3160 }
3161 } else if (cmdPtr->delProc != NULL) {
3162 /* If it was a C coded command, call the delProc if any */
3163 cmdPtr->delProc(interp, cmdPtr->privData);
3164 }
3165 Jim_Free(val);
3166 }
3167
3168 static Jim_HashTableType JimCommandsHashTableType = {
3169 JimStringCopyHTHashFunction, /* hash function */
3170 JimStringCopyHTKeyDup, /* key dup */
3171 NULL, /* val dup */
3172 JimStringCopyHTKeyCompare, /* key compare */
3173 JimStringCopyHTKeyDestructor, /* key destructor */
3174 Jim_CommandsHT_ValDestructor /* val destructor */
3175 };
3176
3177 /* ------------------------- Commands related functions --------------------- */
3178
3179 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3180 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3181 {
3182 Jim_HashEntry *he;
3183 Jim_Cmd *cmdPtr;
3184
3185 he = Jim_FindHashEntry(&interp->commands, cmdName);
3186 if (he == NULL) { /* New command to create */
3187 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3188 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3189 } else {
3190 Jim_InterpIncrProcEpoch(interp);
3191 /* Free the arglist/body objects if it was a Tcl procedure */
3192 cmdPtr = he->val;
3193 if (cmdPtr->cmdProc == NULL) {
3194 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3195 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3196 if (cmdPtr->staticVars) {
3197 Jim_FreeHashTable(cmdPtr->staticVars);
3198 Jim_Free(cmdPtr->staticVars);
3199 }
3200 cmdPtr->staticVars = NULL;
3201 } else if (cmdPtr->delProc != NULL) {
3202 /* If it was a C coded command, call the delProc if any */
3203 cmdPtr->delProc(interp, cmdPtr->privData);
3204 }
3205 }
3206
3207 /* Store the new details for this proc */
3208 cmdPtr->delProc = delProc;
3209 cmdPtr->cmdProc = cmdProc;
3210 cmdPtr->privData = privData;
3211
3212 /* There is no need to increment the 'proc epoch' because
3213 * creation of a new procedure can never affect existing
3214 * cached commands. We don't do negative caching. */
3215 return JIM_OK;
3216 }
3217
3218 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3219 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3220 int arityMin, int arityMax)
3221 {
3222 Jim_Cmd *cmdPtr;
3223
3224 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3225 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3226 cmdPtr->argListObjPtr = argListObjPtr;
3227 cmdPtr->bodyObjPtr = bodyObjPtr;
3228 Jim_IncrRefCount(argListObjPtr);
3229 Jim_IncrRefCount(bodyObjPtr);
3230 cmdPtr->arityMin = arityMin;
3231 cmdPtr->arityMax = arityMax;
3232 cmdPtr->staticVars = NULL;
3233
3234 /* Create the statics hash table. */
3235 if (staticsListObjPtr) {
3236 int len, i;
3237
3238 Jim_ListLength(interp, staticsListObjPtr, &len);
3239 if (len != 0) {
3240 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3241 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3242 interp);
3243 for (i = 0; i < len; i++) {
3244 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3245 Jim_Var *varPtr;
3246 int subLen;
3247
3248 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3249 /* Check if it's composed of two elements. */
3250 Jim_ListLength(interp, objPtr, &subLen);
3251 if (subLen == 1 || subLen == 2) {
3252 /* Try to get the variable value from the current
3253 * environment. */
3254 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3255 if (subLen == 1) {
3256 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3257 JIM_NONE);
3258 if (initObjPtr == NULL) {
3259 Jim_SetResult(interp,
3260 Jim_NewEmptyStringObj(interp));
3261 Jim_AppendStrings(interp, Jim_GetResult(interp),
3262 "variable for initialization of static \"",
3263 Jim_GetString(nameObjPtr, NULL),
3264 "\" not found in the local context",
3265 NULL);
3266 goto err;
3267 }
3268 } else {
3269 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3270 }
3271 varPtr = Jim_Alloc(sizeof(*varPtr));
3272 varPtr->objPtr = initObjPtr;
3273 Jim_IncrRefCount(initObjPtr);
3274 varPtr->linkFramePtr = NULL;
3275 if (Jim_AddHashEntry(cmdPtr->staticVars,
3276 Jim_GetString(nameObjPtr, NULL),
3277 varPtr) != JIM_OK)
3278 {
3279 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3280 Jim_AppendStrings(interp, Jim_GetResult(interp),
3281 "static variable name \"",
3282 Jim_GetString(objPtr, NULL), "\"",
3283 " duplicated in statics list", NULL);
3284 Jim_DecrRefCount(interp, initObjPtr);
3285 Jim_Free(varPtr);
3286 goto err;
3287 }
3288 } else {
3289 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3290 Jim_AppendStrings(interp, Jim_GetResult(interp),
3291 "too many fields in static specifier \"",
3292 objPtr, "\"", NULL);
3293 goto err;
3294 }
3295 }
3296 }
3297 }
3298
3299 /* Add the new command */
3300
3301 /* it may already exist, so we try to delete the old one */
3302 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3303 /* There was an old procedure with the same name, this requires
3304 * a 'proc epoch' update. */
3305 Jim_InterpIncrProcEpoch(interp);
3306 }
3307 /* If a procedure with the same name didn't existed there is no need
3308 * to increment the 'proc epoch' because creation of a new procedure
3309 * can never affect existing cached commands. We don't do
3310 * negative caching. */
3311 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3312 return JIM_OK;
3313
3314 err:
3315 Jim_FreeHashTable(cmdPtr->staticVars);
3316 Jim_Free(cmdPtr->staticVars);
3317 Jim_DecrRefCount(interp, argListObjPtr);
3318 Jim_DecrRefCount(interp, bodyObjPtr);
3319 Jim_Free(cmdPtr);
3320 return JIM_ERR;
3321 }
3322
3323 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3324 {
3325 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3326 return JIM_ERR;
3327 Jim_InterpIncrProcEpoch(interp);
3328 return JIM_OK;
3329 }
3330
3331 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3332 const char *newName)
3333 {
3334 Jim_Cmd *cmdPtr;
3335 Jim_HashEntry *he;
3336 Jim_Cmd *copyCmdPtr;
3337
3338 if (newName[0] == '\0') /* Delete! */
3339 return Jim_DeleteCommand(interp, oldName);
3340 /* Rename */
3341 he = Jim_FindHashEntry(&interp->commands, oldName);
3342 if (he == NULL)
3343 return JIM_ERR; /* Invalid command name */
3344 cmdPtr = he->val;
3345 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3346 *copyCmdPtr = *cmdPtr;
3347 /* In order to avoid that a procedure will get arglist/body/statics
3348 * freed by the hash table methods, fake a C-coded command
3349 * setting cmdPtr->cmdProc as not NULL */
3350 cmdPtr->cmdProc = (void*)1;
3351 /* Also make sure delProc is NULL. */
3352 cmdPtr->delProc = NULL;
3353 /* Destroy the old command, and make sure the new is freed
3354 * as well. */
3355 Jim_DeleteHashEntry(&interp->commands, oldName);
3356 Jim_DeleteHashEntry(&interp->commands, newName);
3357 /* Now the new command. We are sure it can't fail because
3358 * the target name was already freed. */
3359 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3360 /* Increment the epoch */
3361 Jim_InterpIncrProcEpoch(interp);
3362 return JIM_OK;
3363 }
3364
3365 /* -----------------------------------------------------------------------------
3366 * Command object
3367 * ---------------------------------------------------------------------------*/
3368
3369 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3370
3371 static Jim_ObjType commandObjType = {
3372 "command",
3373 NULL,
3374 NULL,
3375 NULL,
3376 JIM_TYPE_REFERENCES,
3377 };
3378
3379 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3380 {
3381 Jim_HashEntry *he;
3382 const char *cmdName;
3383
3384 /* Get the string representation */
3385 cmdName = Jim_GetString(objPtr, NULL);
3386 /* Lookup this name into the commands hash table */
3387 he = Jim_FindHashEntry(&interp->commands, cmdName);
3388 if (he == NULL)
3389 return JIM_ERR;
3390
3391 /* Free the old internal repr and set the new one. */
3392 Jim_FreeIntRep(interp, objPtr);
3393 objPtr->typePtr = &commandObjType;
3394 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3395 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3396 return JIM_OK;
3397 }
3398
3399 /* This function returns the command structure for the command name
3400 * stored in objPtr. It tries to specialize the objPtr to contain
3401 * a cached info instead to perform the lookup into the hash table
3402 * every time. The information cached may not be uptodate, in such
3403 * a case the lookup is performed and the cache updated. */
3404 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3405 {
3406 if ((objPtr->typePtr != &commandObjType ||
3407 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3408 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3409 if (flags & JIM_ERRMSG) {
3410 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3411 Jim_AppendStrings(interp, Jim_GetResult(interp),
3412 "invalid command name \"", objPtr->bytes, "\"",
3413 NULL);
3414 }
3415 return NULL;
3416 }
3417 return objPtr->internalRep.cmdValue.cmdPtr;
3418 }
3419
3420 /* -----------------------------------------------------------------------------
3421 * Variables
3422 * ---------------------------------------------------------------------------*/
3423
3424 /* Variables HashTable Type.
3425 *
3426 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3427 static void JimVariablesHTValDestructor(void *interp, void *val)
3428 {
3429 Jim_Var *varPtr = (void*) val;
3430
3431 Jim_DecrRefCount(interp, varPtr->objPtr);
3432 Jim_Free(val);
3433 }
3434
3435 static Jim_HashTableType JimVariablesHashTableType = {
3436 JimStringCopyHTHashFunction, /* hash function */
3437 JimStringCopyHTKeyDup, /* key dup */
3438 NULL, /* val dup */
3439 JimStringCopyHTKeyCompare, /* key compare */
3440 JimStringCopyHTKeyDestructor, /* key destructor */
3441 JimVariablesHTValDestructor /* val destructor */
3442 };
3443
3444 static Jim_HashTableType *getJimVariablesHashTableType(void)
3445 {
3446 return &JimVariablesHashTableType;
3447 }
3448
3449 /* -----------------------------------------------------------------------------
3450 * Variable object
3451 * ---------------------------------------------------------------------------*/
3452
3453 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3454
3455 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3456
3457 static Jim_ObjType variableObjType = {
3458 "variable",
3459 NULL,
3460 NULL,
3461 NULL,
3462 JIM_TYPE_REFERENCES,
3463 };
3464
3465 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3466 * is in the form "varname(key)". */
3467 static int Jim_NameIsDictSugar(const char *str, int len)
3468 {
3469 if (len == -1)
3470 len = strlen(str);
3471 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3472 return 1;
3473 return 0;
3474 }
3475
3476 /* This method should be called only by the variable API.
3477 * It returns JIM_OK on success (variable already exists),
3478 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3479 * a variable name, but syntax glue for [dict] i.e. the last
3480 * character is ')' */
3481 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3482 {
3483 Jim_HashEntry *he;
3484 const char *varName;
3485 int len;
3486
3487 /* Check if the object is already an uptodate variable */
3488 if (objPtr->typePtr == &variableObjType &&
3489 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3490 return JIM_OK; /* nothing to do */
3491 /* Get the string representation */
3492 varName = Jim_GetString(objPtr, &len);
3493 /* Make sure it's not syntax glue to get/set dict. */
3494 if (Jim_NameIsDictSugar(varName, len))
3495 return JIM_DICT_SUGAR;
3496 if (varName[0] == ':' && varName[1] == ':') {
3497 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3498 if (he == NULL) {
3499 return JIM_ERR;
3500 }
3501 }
3502 else {
3503 /* Lookup this name into the variables hash table */
3504 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3505 if (he == NULL) {
3506 /* Try with static vars. */
3507 if (interp->framePtr->staticVars == NULL)
3508 return JIM_ERR;
3509 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3510 return JIM_ERR;
3511 }
3512 }
3513 /* Free the old internal repr and set the new one. */
3514 Jim_FreeIntRep(interp, objPtr);
3515 objPtr->typePtr = &variableObjType;
3516 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3517 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3518 return JIM_OK;
3519 }
3520
3521 /* -------------------- Variables related functions ------------------------- */
3522 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3523 Jim_Obj *valObjPtr);
3524 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3525
3526 /* For now that's dummy. Variables lookup should be optimized
3527 * in many ways, with caching of lookups, and possibly with
3528 * a table of pre-allocated vars in every CallFrame for local vars.
3529 * All the caching should also have an 'epoch' mechanism similar
3530 * to the one used by Tcl for procedures lookup caching. */
3531
3532 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3533 {
3534 const char *name;
3535 Jim_Var *var;
3536 int err;
3537
3538 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3539 /* Check for [dict] syntax sugar. */
3540 if (err == JIM_DICT_SUGAR)
3541 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3542 /* New variable to create */
3543 name = Jim_GetString(nameObjPtr, NULL);
3544
3545 var = Jim_Alloc(sizeof(*var));
3546 var->objPtr = valObjPtr;
3547 Jim_IncrRefCount(valObjPtr);
3548 var->linkFramePtr = NULL;
3549 /* Insert the new variable */
3550 if (name[0] == ':' && name[1] == ':') {
3551 /* Into to the top evel frame */
3552 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3553 }
3554 else {
3555 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3556 }
3557 /* Make the object int rep a variable */
3558 Jim_FreeIntRep(interp, nameObjPtr);
3559 nameObjPtr->typePtr = &variableObjType;
3560 nameObjPtr->internalRep.varValue.callFrameId =
3561 interp->framePtr->id;
3562 nameObjPtr->internalRep.varValue.varPtr = var;
3563 } else {
3564 var = nameObjPtr->internalRep.varValue.varPtr;
3565 if (var->linkFramePtr == NULL) {
3566 Jim_IncrRefCount(valObjPtr);
3567 Jim_DecrRefCount(interp, var->objPtr);
3568 var->objPtr = valObjPtr;
3569 } else { /* Else handle the link */
3570 Jim_CallFrame *savedCallFrame;
3571
3572 savedCallFrame = interp->framePtr;
3573 interp->framePtr = var->linkFramePtr;
3574 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3575 interp->framePtr = savedCallFrame;
3576 if (err != JIM_OK)
3577 return err;
3578 }
3579 }
3580 return JIM_OK;
3581 }
3582
3583 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3584 {
3585 Jim_Obj *nameObjPtr;
3586 int result;
3587
3588 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3589 Jim_IncrRefCount(nameObjPtr);
3590 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3591 Jim_DecrRefCount(interp, nameObjPtr);
3592 return result;
3593 }
3594
3595 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3596 {
3597 Jim_CallFrame *savedFramePtr;
3598 int result;
3599
3600 savedFramePtr = interp->framePtr;
3601 interp->framePtr = interp->topFramePtr;
3602 result = Jim_SetVariableStr(interp, name, objPtr);
3603 interp->framePtr = savedFramePtr;
3604 return result;
3605 }
3606
3607 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3608 {
3609 Jim_Obj *nameObjPtr, *valObjPtr;
3610 int result;
3611
3612 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3613 valObjPtr = Jim_NewStringObj(interp, val, -1);
3614 Jim_IncrRefCount(nameObjPtr);
3615 Jim_IncrRefCount(valObjPtr);
3616 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3617 Jim_DecrRefCount(interp, nameObjPtr);
3618 Jim_DecrRefCount(interp, valObjPtr);
3619 return result;
3620 }
3621
3622 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3623 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3624 {
3625 const char *varName;
3626 int len;
3627
3628 /* Check for cycles. */
3629 if (interp->framePtr == targetCallFrame) {
3630 Jim_Obj *objPtr = targetNameObjPtr;
3631 Jim_Var *varPtr;
3632 /* Cycles are only possible with 'uplevel 0' */
3633 while (1) {
3634 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3635 Jim_SetResultString(interp,
3636 "can't upvar from variable to itself", -1);
3637 return JIM_ERR;
3638 }
3639 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3640 break;
3641 varPtr = objPtr->internalRep.varValue.varPtr;
3642 if (varPtr->linkFramePtr != targetCallFrame) break;
3643 objPtr = varPtr->objPtr;
3644 }
3645 }
3646 varName = Jim_GetString(nameObjPtr, &len);
3647 if (Jim_NameIsDictSugar(varName, len)) {
3648 Jim_SetResultString(interp,
3649 "Dict key syntax invalid as link source", -1);
3650 return JIM_ERR;
3651 }
3652 /* Perform the binding */
3653 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3654 /* We are now sure 'nameObjPtr' type is variableObjType */
3655 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3656 return JIM_OK;
3657 }
3658
3659 /* Return the Jim_Obj pointer associated with a variable name,
3660 * or NULL if the variable was not found in the current context.
3661 * The same optimization discussed in the comment to the
3662 * 'SetVariable' function should apply here. */
3663 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3664 {
3665 int err;
3666
3667 /* All the rest is handled here */
3668 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3669 /* Check for [dict] syntax sugar. */
3670 if (err == JIM_DICT_SUGAR)
3671 return JimDictSugarGet(interp, nameObjPtr);
3672 if (flags & JIM_ERRMSG) {
3673 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3674 Jim_AppendStrings(interp, Jim_GetResult(interp),
3675 "can't read \"", nameObjPtr->bytes,
3676 "\": no such variable", NULL);
3677 }
3678 return NULL;
3679 } else {
3680 Jim_Var *varPtr;
3681 Jim_Obj *objPtr;
3682 Jim_CallFrame *savedCallFrame;
3683
3684 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3685 if (varPtr->linkFramePtr == NULL)
3686 return varPtr->objPtr;
3687 /* The variable is a link? Resolve it. */
3688 savedCallFrame = interp->framePtr;
3689 interp->framePtr = varPtr->linkFramePtr;
3690 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3691 if (objPtr == NULL && flags & JIM_ERRMSG) {
3692 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3693 Jim_AppendStrings(interp, Jim_GetResult(interp),
3694 "can't read \"", nameObjPtr->bytes,
3695 "\": no such variable", NULL);
3696 }
3697 interp->framePtr = savedCallFrame;
3698 return objPtr;
3699 }
3700 }
3701
3702 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3703 int flags)
3704 {
3705 Jim_CallFrame *savedFramePtr;
3706 Jim_Obj *objPtr;
3707
3708 savedFramePtr = interp->framePtr;
3709 interp->framePtr = interp->topFramePtr;
3710 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3711 interp->framePtr = savedFramePtr;
3712
3713 return objPtr;
3714 }
3715
3716 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3717 {
3718 Jim_Obj *nameObjPtr, *varObjPtr;
3719
3720 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3721 Jim_IncrRefCount(nameObjPtr);
3722 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3723 Jim_DecrRefCount(interp, nameObjPtr);
3724 return varObjPtr;
3725 }
3726
3727 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3728 int flags)
3729 {
3730 Jim_CallFrame *savedFramePtr;
3731 Jim_Obj *objPtr;
3732
3733 savedFramePtr = interp->framePtr;
3734 interp->framePtr = interp->topFramePtr;
3735 objPtr = Jim_GetVariableStr(interp, name, flags);
3736 interp->framePtr = savedFramePtr;
3737
3738 return objPtr;
3739 }
3740
3741 /* Unset a variable.
3742 * Note: On success unset invalidates all the variable objects created
3743 * in the current call frame incrementing. */
3744 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3745 {
3746 const char *name;
3747 Jim_Var *varPtr;
3748 int err;
3749
3750 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3751 /* Check for [dict] syntax sugar. */
3752 if (err == JIM_DICT_SUGAR)
3753 return JimDictSugarSet(interp, nameObjPtr, NULL);
3754 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3755 Jim_AppendStrings(interp, Jim_GetResult(interp),
3756 "can't unset \"", nameObjPtr->bytes,
3757 "\": no such variable", NULL);
3758 return JIM_ERR; /* var not found */
3759 }
3760 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3761 /* If it's a link call UnsetVariable recursively */
3762 if (varPtr->linkFramePtr) {
3763 int retval;
3764
3765 Jim_CallFrame *savedCallFrame;
3766
3767 savedCallFrame = interp->framePtr;
3768 interp->framePtr = varPtr->linkFramePtr;
3769 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3770 interp->framePtr = savedCallFrame;
3771 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3772 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3773 Jim_AppendStrings(interp, Jim_GetResult(interp),
3774 "can't unset \"", nameObjPtr->bytes,
3775 "\": no such variable", NULL);
3776 }
3777 return retval;
3778 } else {
3779 name = Jim_GetString(nameObjPtr, NULL);
3780 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3781 != JIM_OK) return JIM_ERR;
3782 /* Change the callframe id, invalidating var lookup caching */
3783 JimChangeCallFrameId(interp, interp->framePtr);
3784 return JIM_OK;
3785 }
3786 }
3787
3788 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3789
3790 /* Given a variable name for [dict] operation syntax sugar,
3791 * this function returns two objects, the first with the name
3792 * of the variable to set, and the second with the rispective key.
3793 * For example "foo(bar)" will return objects with string repr. of
3794 * "foo" and "bar".
3795 *
3796 * The returned objects have refcount = 1. The function can't fail. */
3797 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3798 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3799 {
3800 const char *str, *p;
3801 char *t;
3802 int len, keyLen, nameLen;
3803 Jim_Obj *varObjPtr, *keyObjPtr;
3804
3805 str = Jim_GetString(objPtr, &len);
3806 p = strchr(str, '(');
3807 p++;
3808 keyLen = len-((p-str) + 1);
3809 nameLen = (p-str)-1;
3810 /* Create the objects with the variable name and key. */
3811 t = Jim_Alloc(nameLen + 1);
3812 memcpy(t, str, nameLen);
3813 t[nameLen] = '\0';
3814 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3815
3816 t = Jim_Alloc(keyLen + 1);
3817 memcpy(t, p, keyLen);
3818 t[keyLen] = '\0';
3819 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3820
3821 Jim_IncrRefCount(varObjPtr);
3822 Jim_IncrRefCount(keyObjPtr);
3823 *varPtrPtr = varObjPtr;
3824 *keyPtrPtr = keyObjPtr;
3825 }
3826
3827 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3828 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3829 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3830 Jim_Obj *valObjPtr)
3831 {
3832 Jim_Obj *varObjPtr, *keyObjPtr;
3833 int err = JIM_OK;
3834
3835 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3836 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3837 valObjPtr);
3838 Jim_DecrRefCount(interp, varObjPtr);
3839 Jim_DecrRefCount(interp, keyObjPtr);
3840 return err;
3841 }
3842
3843 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3844 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3845 {
3846 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3847
3848 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3849 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3850 if (!dictObjPtr) {
3851 resObjPtr = NULL;
3852 goto err;
3853 }
3854 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3855 != JIM_OK) {
3856 resObjPtr = NULL;
3857 }
3858 err:
3859 Jim_DecrRefCount(interp, varObjPtr);
3860 Jim_DecrRefCount(interp, keyObjPtr);
3861 return resObjPtr;
3862 }
3863
3864 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3865
3866 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3867 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3868 Jim_Obj *dupPtr);
3869
3870 static Jim_ObjType dictSubstObjType = {
3871 "dict-substitution",
3872 FreeDictSubstInternalRep,
3873 DupDictSubstInternalRep,
3874 NULL,
3875 JIM_TYPE_NONE,
3876 };
3877
3878 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3879 {
3880 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3881 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3882 }
3883
3884 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3885 Jim_Obj *dupPtr)
3886 {
3887 JIM_NOTUSED(interp);
3888
3889 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3890 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3891 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3892 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3893 dupPtr->typePtr = &dictSubstObjType;
3894 }
3895
3896 /* This function is used to expand [dict get] sugar in the form
3897 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3898 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3899 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3900 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3901 * the [dict]ionary contained in variable VARNAME. */
3902 static Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3903 {
3904 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3905 Jim_Obj *substKeyObjPtr = NULL;
3906
3907 if (objPtr->typePtr != &dictSubstObjType) {
3908 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3909 Jim_FreeIntRep(interp, objPtr);
3910 objPtr->typePtr = &dictSubstObjType;
3911 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3912 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3913 }
3914 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3915 &substKeyObjPtr, JIM_NONE)
3916 != JIM_OK) {
3917 substKeyObjPtr = NULL;
3918 goto err;
3919 }
3920 Jim_IncrRefCount(substKeyObjPtr);
3921 dictObjPtr = Jim_GetVariable(interp,
3922 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3923 if (!dictObjPtr) {
3924 resObjPtr = NULL;
3925 goto err;
3926 }
3927 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3928 != JIM_OK) {
3929 resObjPtr = NULL;
3930 goto err;
3931 }
3932 err:
3933 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3934 return resObjPtr;
3935 }
3936
3937 /* -----------------------------------------------------------------------------
3938 * CallFrame
3939 * ---------------------------------------------------------------------------*/
3940
3941 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3942 {
3943 Jim_CallFrame *cf;
3944 if (interp->freeFramesList) {
3945 cf = interp->freeFramesList;
3946 interp->freeFramesList = cf->nextFramePtr;
3947 } else {
3948 cf = Jim_Alloc(sizeof(*cf));
3949 cf->vars.table = NULL;
3950 }
3951
3952 cf->id = interp->callFrameEpoch++;
3953 cf->parentCallFrame = NULL;
3954 cf->argv = NULL;
3955 cf->argc = 0;
3956 cf->procArgsObjPtr = NULL;
3957 cf->procBodyObjPtr = NULL;
3958 cf->nextFramePtr = NULL;
3959 cf->staticVars = NULL;
3960 if (cf->vars.table == NULL)
3961 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3962 return cf;
3963 }
3964
3965 /* Used to invalidate every caching related to callframe stability. */
3966 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3967 {
3968 cf->id = interp->callFrameEpoch++;
3969 }
3970
3971 #define JIM_FCF_NONE 0 /* no flags */
3972 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3973 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3974 int flags)
3975 {
3976 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3977 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3978 if (!(flags & JIM_FCF_NOHT))
3979 Jim_FreeHashTable(&cf->vars);
3980 else {
3981 int i;
3982 Jim_HashEntry **table = cf->vars.table, *he;
3983
3984 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3985 he = table[i];
3986 while (he != NULL) {
3987 Jim_HashEntry *nextEntry = he->next;
3988 Jim_Var *varPtr = (void*) he->val;
3989
3990 Jim_DecrRefCount(interp, varPtr->objPtr);
3991 Jim_Free(he->val);
3992 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3993 Jim_Free(he);
3994 table[i] = NULL;
3995 he = nextEntry;
3996 }
3997 }
3998 cf->vars.used = 0;
3999 }
4000 cf->nextFramePtr = interp->freeFramesList;
4001 interp->freeFramesList = cf;
4002 }
4003
4004 /* -----------------------------------------------------------------------------
4005 * References
4006 * ---------------------------------------------------------------------------*/
4007
4008 /* References HashTable Type.
4009 *
4010 * Keys are jim_wide integers, dynamically allocated for now but in the
4011 * future it's worth to cache this 8 bytes objects. Values are poitners
4012 * to Jim_References. */
4013 static void JimReferencesHTValDestructor(void *interp, void *val)
4014 {
4015 Jim_Reference *refPtr = (void*) val;
4016
4017 Jim_DecrRefCount(interp, refPtr->objPtr);
4018 if (refPtr->finalizerCmdNamePtr != NULL) {
4019 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4020 }
4021 Jim_Free(val);
4022 }
4023
4024 static unsigned int JimReferencesHTHashFunction(const void *key)
4025 {
4026 /* Only the least significant bits are used. */
4027 const jim_wide *widePtr = key;
4028 unsigned int intValue = (unsigned int) *widePtr;
4029 return Jim_IntHashFunction(intValue);
4030 }
4031
4032 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4033 {
4034 /* Only the least significant bits are used. */
4035 const jim_wide *widePtr = key;
4036 unsigned int intValue = (unsigned int) *widePtr;
4037 return intValue; /* identity function. */
4038 }
4039
4040 static const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4041 {
4042 void *copy = Jim_Alloc(sizeof(jim_wide));
4043 JIM_NOTUSED(privdata);
4044
4045 memcpy(copy, key, sizeof(jim_wide));
4046 return copy;
4047 }
4048
4049 static int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4050 const void *key2)
4051 {
4052 JIM_NOTUSED(privdata);
4053
4054 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4055 }
4056
4057 static void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4058 {
4059 JIM_NOTUSED(privdata);
4060
4061 Jim_Free((void*)key);
4062 }
4063
4064 static Jim_HashTableType JimReferencesHashTableType = {
4065 JimReferencesHTHashFunction, /* hash function */
4066 JimReferencesHTKeyDup, /* key dup */
4067 NULL, /* val dup */
4068 JimReferencesHTKeyCompare, /* key compare */
4069 JimReferencesHTKeyDestructor, /* key destructor */
4070 JimReferencesHTValDestructor /* val destructor */
4071 };
4072
4073 /* -----------------------------------------------------------------------------
4074 * Reference object type and References API
4075 * ---------------------------------------------------------------------------*/
4076
4077 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4078
4079 static Jim_ObjType referenceObjType = {
4080 "reference",
4081 NULL,
4082 NULL,
4083 UpdateStringOfReference,
4084 JIM_TYPE_REFERENCES,
4085 };
4086
4087 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4088 {
4089 int len;
4090 char buf[JIM_REFERENCE_SPACE + 1];
4091 Jim_Reference *refPtr;
4092
4093 refPtr = objPtr->internalRep.refValue.refPtr;
4094 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4095 objPtr->bytes = Jim_Alloc(len + 1);
4096 memcpy(objPtr->bytes, buf, len + 1);
4097 objPtr->length = len;
4098 }
4099
4100 /* returns true if 'c' is a valid reference tag character.
4101 * i.e. inside the range [_a-zA-Z0-9] */
4102 static int isrefchar(int c)
4103 {
4104 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4105 (c >= '0' && c <= '9')) return 1;
4106 return 0;
4107 }
4108
4109 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4110 {
4111 jim_wide wideValue;
4112 int i, len;
4113 const char *str, *start, *end;
4114 char refId[21];
4115 Jim_Reference *refPtr;
4116 Jim_HashEntry *he;
4117
4118 /* Get the string representation */
4119 str = Jim_GetString(objPtr, &len);
4120 /* Check if it looks like a reference */
4121 if (len < JIM_REFERENCE_SPACE) goto badformat;
4122 /* Trim spaces */
4123 start = str;
4124 end = str + len-1;
4125 while (*start == ' ') start++;
4126 while (*end == ' ' && end > start) end--;
4127 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4128 /* <reference.<1234567>.%020> */
4129 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4130 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4131 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4132 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4133 if (!isrefchar(start[12 + i])) goto badformat;
4134 }
4135 /* Extract info from the refernece. */
4136 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4137 refId[20] = '\0';
4138 /* Try to convert the ID into a jim_wide */
4139 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4140 /* Check if the reference really exists! */
4141 he = Jim_FindHashEntry(&interp->references, &wideValue);
4142 if (he == NULL) {
4143 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4144 Jim_AppendStrings(interp, Jim_GetResult(interp),
4145 "Invalid reference ID \"", str, "\"", NULL);
4146 return JIM_ERR;
4147 }
4148 refPtr = he->val;
4149 /* Free the old internal repr and set the new one. */
4150 Jim_FreeIntRep(interp, objPtr);
4151 objPtr->typePtr = &referenceObjType;
4152 objPtr->internalRep.refValue.id = wideValue;
4153 objPtr->internalRep.refValue.refPtr = refPtr;
4154 return JIM_OK;
4155
4156 badformat:
4157 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4158 Jim_AppendStrings(interp, Jim_GetResult(interp),
4159 "expected reference but got \"", str, "\"", NULL);
4160 return JIM_ERR;
4161 }
4162
4163 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4164 * as finalizer command (or NULL if there is no finalizer).
4165 * The returned reference object has refcount = 0. */
4166 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4167 Jim_Obj *cmdNamePtr)
4168 {
4169 struct Jim_Reference *refPtr;
4170 jim_wide wideValue = interp->referenceNextId;
4171 Jim_Obj *refObjPtr;
4172 const char *tag;
4173 int tagLen, i;
4174
4175 /* Perform the Garbage Collection if needed. */
4176 Jim_CollectIfNeeded(interp);
4177
4178 refPtr = Jim_Alloc(sizeof(*refPtr));
4179 refPtr->objPtr = objPtr;
4180 Jim_IncrRefCount(objPtr);
4181 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4182 if (cmdNamePtr)
4183 Jim_IncrRefCount(cmdNamePtr);
4184 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4185 refObjPtr = Jim_NewObj(interp);
4186 refObjPtr->typePtr = &referenceObjType;
4187 refObjPtr->bytes = NULL;
4188 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4189 refObjPtr->internalRep.refValue.refPtr = refPtr;
4190 interp->referenceNextId++;
4191 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4192 * that does not pass the 'isrefchar' test is replaced with '_' */
4193 tag = Jim_GetString(tagPtr, &tagLen);
4194 if (tagLen > JIM_REFERENCE_TAGLEN)
4195 tagLen = JIM_REFERENCE_TAGLEN;
4196 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4197 if (i < tagLen)
4198 refPtr->tag[i] = tag[i];
4199 else
4200 refPtr->tag[i] = '_';
4201 }
4202 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4203 return refObjPtr;
4204 }
4205
4206 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4207 {
4208 if (objPtr->typePtr != &referenceObjType &&
4209 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4210 return NULL;
4211 return objPtr->internalRep.refValue.refPtr;
4212 }
4213
4214 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4215 {
4216 Jim_Reference *refPtr;
4217
4218 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4219 return JIM_ERR;
4220 Jim_IncrRefCount(cmdNamePtr);
4221 if (refPtr->finalizerCmdNamePtr)
4222 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4223 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4224 return JIM_OK;
4225 }
4226
4227 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4228 {
4229 Jim_Reference *refPtr;
4230
4231 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4232 return JIM_ERR;
4233 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4234 return JIM_OK;
4235 }
4236
4237 /* -----------------------------------------------------------------------------
4238 * References Garbage Collection
4239 * ---------------------------------------------------------------------------*/
4240
4241 /* This the hash table type for the "MARK" phase of the GC */
4242 static Jim_HashTableType JimRefMarkHashTableType = {
4243 JimReferencesHTHashFunction, /* hash function */
4244 JimReferencesHTKeyDup, /* key dup */
4245 NULL, /* val dup */
4246 JimReferencesHTKeyCompare, /* key compare */
4247 JimReferencesHTKeyDestructor, /* key destructor */
4248 NULL /* val destructor */
4249 };
4250
4251 /* #define JIM_DEBUG_GC 1 */
4252
4253 /* Performs the garbage collection. */
4254 int Jim_Collect(Jim_Interp *interp)
4255 {
4256 Jim_HashTable marks;
4257 Jim_HashTableIterator *htiter;
4258 Jim_HashEntry *he;
4259 Jim_Obj *objPtr;
4260 int collected = 0;
4261
4262 /* Avoid recursive calls */
4263 if (interp->lastCollectId == -1) {
4264 /* Jim_Collect() already running. Return just now. */
4265 return 0;
4266 }
4267 interp->lastCollectId = -1;
4268
4269 /* Mark all the references found into the 'mark' hash table.
4270 * The references are searched in every live object that
4271 * is of a type that can contain references. */
4272 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4273 objPtr = interp->liveList;
4274 while (objPtr) {
4275 if (objPtr->typePtr == NULL ||
4276 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4277 const char *str, *p;
4278 int len;
4279
4280 /* If the object is of type reference, to get the
4281 * Id is simple... */
4282 if (objPtr->typePtr == &referenceObjType) {
4283 Jim_AddHashEntry(&marks,
4284 &objPtr->internalRep.refValue.id, NULL);
4285 #ifdef JIM_DEBUG_GC
4286 Jim_fprintf(interp,interp->cookie_stdout,
4287 "MARK (reference): %d refcount: %d" JIM_NL,
4288 (int) objPtr->internalRep.refValue.id,
4289 objPtr->refCount);
4290 #endif
4291 objPtr = objPtr->nextObjPtr;
4292 continue;
4293 }
4294 /* Get the string repr of the object we want
4295 * to scan for references. */
4296 p = str = Jim_GetString(objPtr, &len);
4297 /* Skip objects too little to contain references. */
4298 if (len < JIM_REFERENCE_SPACE) {
4299 objPtr = objPtr->nextObjPtr;
4300 continue;
4301 }
4302 /* Extract references from the object string repr. */
4303 while (1) {
4304 int i;
4305 jim_wide id;
4306 char buf[21];
4307
4308 if ((p = strstr(p, "<reference.<")) == NULL)
4309 break;
4310 /* Check if it's a valid reference. */
4311 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4312 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4313 for (i = 21; i <= 40; i++)
4314 if (!isdigit((int)p[i]))
4315 break;
4316 /* Get the ID */
4317 memcpy(buf, p + 21, 20);
4318 buf[20] = '\0';
4319 Jim_StringToWide(buf, &id, 10);
4320
4321 /* Ok, a reference for the given ID
4322 * was found. Mark it. */
4323 Jim_AddHashEntry(&marks, &id, NULL);
4324 #ifdef JIM_DEBUG_GC
4325 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4326 #endif
4327 p += JIM_REFERENCE_SPACE;
4328 }
4329 }
4330 objPtr = objPtr->nextObjPtr;
4331 }
4332
4333 /* Run the references hash table to destroy every reference that
4334 * is not referenced outside (not present in the mark HT). */
4335 htiter = Jim_GetHashTableIterator(&interp->references);
4336 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4337 const jim_wide *refId;
4338 Jim_Reference *refPtr;
4339
4340 refId = he->key;
4341 /* Check if in the mark phase we encountered
4342 * this reference. */
4343 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4344 #ifdef JIM_DEBUG_GC
4345 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4346 #endif
4347 collected++;
4348 /* Drop the reference, but call the
4349 * finalizer first if registered. */
4350 refPtr = he->val;
4351 if (refPtr->finalizerCmdNamePtr) {
4352 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4353 Jim_Obj *objv[3], *oldResult;
4354
4355 JimFormatReference(refstr, refPtr, *refId);
4356
4357 objv[0] = refPtr->finalizerCmdNamePtr;
4358 objv[1] = Jim_NewStringObjNoAlloc(interp,
4359 refstr, 32);
4360 objv[2] = refPtr->objPtr;
4361 Jim_IncrRefCount(objv[0]);
4362 Jim_IncrRefCount(objv[1]);
4363 Jim_IncrRefCount(objv[2]);
4364
4365 /* Drop the reference itself */
4366 Jim_DeleteHashEntry(&interp->references, refId);
4367
4368 /* Call the finalizer. Errors ignored. */
4369 oldResult = interp->result;
4370 Jim_IncrRefCount(oldResult);
4371 Jim_EvalObjVector(interp, 3, objv);
4372 Jim_SetResult(interp, oldResult);
4373 Jim_DecrRefCount(interp, oldResult);
4374
4375 Jim_DecrRefCount(interp, objv[0]);
4376 Jim_DecrRefCount(interp, objv[1]);
4377 Jim_DecrRefCount(interp, objv[2]);
4378 } else {
4379 Jim_DeleteHashEntry(&interp->references, refId);
4380 }
4381 }
4382 }
4383 Jim_FreeHashTableIterator(htiter);
4384 Jim_FreeHashTable(&marks);
4385 interp->lastCollectId = interp->referenceNextId;
4386 interp->lastCollectTime = time(NULL);
4387 return collected;
4388 }
4389
4390 #define JIM_COLLECT_ID_PERIOD 5000
4391 #define JIM_COLLECT_TIME_PERIOD 300
4392
4393 void Jim_CollectIfNeeded(Jim_Interp *interp)
4394 {
4395 jim_wide elapsedId;
4396 int elapsedTime;
4397
4398 elapsedId = interp->referenceNextId - interp->lastCollectId;
4399 elapsedTime = time(NULL) - interp->lastCollectTime;
4400
4401
4402 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4403 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4404 Jim_Collect(interp);
4405 }
4406 }
4407
4408 /* -----------------------------------------------------------------------------
4409 * Interpreter related functions
4410 * ---------------------------------------------------------------------------*/
4411
4412 Jim_Interp *Jim_CreateInterp(void)
4413 {
4414 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4415 Jim_Obj *pathPtr;
4416
4417 i->errorLine = 0;
4418 i->errorFileName = Jim_StrDup("");
4419 i->numLevels = 0;
4420 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4421 i->returnCode = JIM_OK;
4422 i->exitCode = 0;
4423 i->procEpoch = 0;
4424 i->callFrameEpoch = 0;
4425 i->liveList = i->freeList = NULL;
4426 i->scriptFileName = Jim_StrDup("");
4427 i->referenceNextId = 0;
4428 i->lastCollectId = 0;
4429 i->lastCollectTime = time(NULL);
4430 i->freeFramesList = NULL;
4431 i->prngState = NULL;
4432 i->evalRetcodeLevel = -1;
4433 i->cookie_stdin = stdin;
4434 i->cookie_stdout = stdout;
4435 i->cookie_stderr = stderr;
4436 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4437 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4438 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4439 i->cb_fflush = ((int (*)(void *))(fflush));
4440 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4441
4442 /* Note that we can create objects only after the
4443 * interpreter liveList and freeList pointers are
4444 * initialized to NULL. */
4445 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4446 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4447 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4448 NULL);
4449 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4450 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4451 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4452 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4453 i->emptyObj = Jim_NewEmptyStringObj(i);
4454 i->result = i->emptyObj;
4455 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4456 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4457 i->unknown_called = 0;
4458 Jim_IncrRefCount(i->emptyObj);
4459 Jim_IncrRefCount(i->result);
4460 Jim_IncrRefCount(i->stackTrace);
4461 Jim_IncrRefCount(i->unknown);
4462
4463 /* Initialize key variables every interpreter should contain */
4464 pathPtr = Jim_NewStringObj(i, "./", -1);
4465 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4466 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4467
4468 /* Export the core API to extensions */
4469 JimRegisterCoreApi(i);
4470 return i;
4471 }
4472
4473 /* This is the only function Jim exports directly without
4474 * to use the STUB system. It is only used by embedders
4475 * in order to get an interpreter with the Jim API pointers
4476 * registered. */
4477 Jim_Interp *ExportedJimCreateInterp(void)
4478 {
4479 return Jim_CreateInterp();
4480 }
4481
4482 void Jim_FreeInterp(Jim_Interp *i)
4483 {
4484 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4485 Jim_Obj *objPtr, *nextObjPtr;
4486
4487 Jim_DecrRefCount(i, i->emptyObj);
4488 Jim_DecrRefCount(i, i->result);
4489 Jim_DecrRefCount(i, i->stackTrace);
4490 Jim_DecrRefCount(i, i->unknown);
4491 Jim_Free((void*)i->errorFileName);
4492 Jim_Free((void*)i->scriptFileName);
4493 Jim_FreeHashTable(&i->commands);
4494 Jim_FreeHashTable(&i->references);
4495 Jim_FreeHashTable(&i->stub);
4496 Jim_FreeHashTable(&i->assocData);
4497 Jim_FreeHashTable(&i->packages);
4498 Jim_Free(i->prngState);
4499 /* Free the call frames list */
4500 while (cf) {
4501 prevcf = cf->parentCallFrame;
4502 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4503 cf = prevcf;
4504 }
4505 /* Check that the live object list is empty, otherwise
4506 * there is a memory leak. */
4507 if (i->liveList != NULL) {
4508 objPtr = i->liveList;
4509
4510 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4511 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4512 while (objPtr) {
4513 const char *type = objPtr->typePtr ?
4514 objPtr->typePtr->name : "";
4515 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4516 objPtr, type,
4517 objPtr->bytes ? objPtr->bytes
4518 : "(null)", objPtr->refCount);
4519 if (objPtr->typePtr == &sourceObjType) {
4520 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4521 objPtr->internalRep.sourceValue.fileName,
4522 objPtr->internalRep.sourceValue.lineNumber);
4523 }
4524 objPtr = objPtr->nextObjPtr;
4525 }
4526 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4527 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4528 }
4529 /* Free all the freed objects. */
4530 objPtr = i->freeList;
4531 while (objPtr) {
4532 nextObjPtr = objPtr->nextObjPtr;
4533 Jim_Free(objPtr);
4534 objPtr = nextObjPtr;
4535 }
4536 /* Free cached CallFrame structures */
4537 cf = i->freeFramesList;
4538 while (cf) {
4539 nextcf = cf->nextFramePtr;
4540 if (cf->vars.table != NULL)
4541 Jim_Free(cf->vars.table);
4542 Jim_Free(cf);
4543 cf = nextcf;
4544 }
4545 /* Free the sharedString hash table. Make sure to free it
4546 * after every other Jim_Object was freed. */
4547 Jim_FreeHashTable(&i->sharedStrings);
4548 /* Free the interpreter structure. */
4549 Jim_Free(i);
4550 }
4551
4552 /* Store the call frame relative to the level represented by
4553 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4554 * level is assumed to be '1'.
4555 *
4556 * If a newLevelptr int pointer is specified, the function stores
4557 * the absolute level integer value of the new target callframe into
4558 * *newLevelPtr. (this is used to adjust interp->numLevels
4559 * in the implementation of [uplevel], so that [info level] will
4560 * return a correct information).
4561 *
4562 * This function accepts the 'level' argument in the form
4563 * of the commands [uplevel] and [upvar].
4564 *
4565 * For a function accepting a relative integer as level suitable
4566 * for implementation of [info level ?level?] check the
4567 * GetCallFrameByInteger() function. */
4568 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4569 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4570 {
4571 long level;
4572 const char *str;
4573 Jim_CallFrame *framePtr;
4574
4575 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4576 if (levelObjPtr) {
4577 str = Jim_GetString(levelObjPtr, NULL);
4578 if (str[0] == '#') {
4579 char *endptr;
4580 /* speedup for the toplevel (level #0) */
4581 if (str[1] == '0' && str[2] == '\0') {
4582 if (newLevelPtr) *newLevelPtr = 0;
4583 *framePtrPtr = interp->topFramePtr;
4584 return JIM_OK;
4585 }
4586
4587 level = strtol(str + 1, &endptr, 0);
4588 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4589 goto badlevel;
4590 /* An 'absolute' level is converted into the
4591 * 'number of levels to go back' format. */
4592 level = interp->numLevels - level;
4593 if (level < 0) goto badlevel;
4594 } else {
4595 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4596 goto badlevel;
4597 }
4598 } else {
4599 str = "1"; /* Needed to format the error message. */
4600 level = 1;
4601 }
4602 /* Lookup */
4603 framePtr = interp->framePtr;
4604 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4605 while (level--) {
4606 framePtr = framePtr->parentCallFrame;
4607 if (framePtr == NULL) goto badlevel;
4608 }
4609 *framePtrPtr = framePtr;
4610 return JIM_OK;
4611 badlevel:
4612 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4613 Jim_AppendStrings(interp, Jim_GetResult(interp),
4614 "bad level \"", str, "\"", NULL);
4615 return JIM_ERR;
4616 }
4617
4618 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4619 * as a relative integer like in the [info level ?level?] command. */
4620 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4621 Jim_CallFrame **framePtrPtr)
4622 {
4623 jim_wide level;
4624 jim_wide relLevel; /* level relative to the current one. */
4625 Jim_CallFrame *framePtr;
4626
4627 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4628 goto badlevel;
4629 if (level > 0) {
4630 /* An 'absolute' level is converted into the
4631 * 'number of levels to go back' format. */
4632 relLevel = interp->numLevels - level;
4633 } else {
4634 relLevel = -level;
4635 }
4636 /* Lookup */
4637 framePtr = interp->framePtr;
4638 while (relLevel--) {
4639 framePtr = framePtr->parentCallFrame;
4640 if (framePtr == NULL) goto badlevel;
4641 }
4642 *framePtrPtr = framePtr;
4643 return JIM_OK;
4644 badlevel:
4645 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4646 Jim_AppendStrings(interp, Jim_GetResult(interp),
4647 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4648 return JIM_ERR;
4649 }
4650
4651 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4652 {
4653 Jim_Free((void*)interp->errorFileName);
4654 interp->errorFileName = Jim_StrDup(filename);
4655 }
4656
4657 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4658 {
4659 interp->errorLine = linenr;
4660 }
4661
4662 static void JimResetStackTrace(Jim_Interp *interp)
4663 {
4664 Jim_DecrRefCount(interp, interp->stackTrace);
4665 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4666 Jim_IncrRefCount(interp->stackTrace);
4667 }
4668
4669 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4670 const char *filename, int linenr)
4671 {
4672 /* No need to add this dummy entry to the stack trace */
4673 if (strcmp(procname, "unknown") == 0) {
4674 return;
4675 }
4676
4677 if (Jim_IsShared(interp->stackTrace)) {
4678 interp->stackTrace =
4679 Jim_DuplicateObj(interp, interp->stackTrace);
4680 Jim_IncrRefCount(interp->stackTrace);
4681 }
4682 Jim_ListAppendElement(interp, interp->stackTrace,
4683 Jim_NewStringObj(interp, procname, -1));
4684 Jim_ListAppendElement(interp, interp->stackTrace,
4685 Jim_NewStringObj(interp, filename, -1));
4686 Jim_ListAppendElement(interp, interp->stackTrace,
4687 Jim_NewIntObj(interp, linenr));
4688 }
4689
4690 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4691 {
4692 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4693 assocEntryPtr->delProc = delProc;
4694 assocEntryPtr->data = data;
4695 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4696 }
4697
4698 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4699 {
4700 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4701 if (entryPtr != NULL) {
4702 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4703 return assocEntryPtr->data;
4704 }
4705 return NULL;
4706 }
4707
4708 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4709 {
4710 return Jim_DeleteHashEntry(&interp->assocData, key);
4711 }
4712
4713 int Jim_GetExitCode(Jim_Interp *interp) {
4714 return interp->exitCode;
4715 }
4716
4717 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4718 {
4719 if (fp != NULL) interp->cookie_stdin = fp;
4720 return interp->cookie_stdin;
4721 }
4722
4723 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4724 {
4725 if (fp != NULL) interp->cookie_stdout = fp;
4726 return interp->cookie_stdout;
4727 }
4728
4729 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4730 {
4731 if (fp != NULL) interp->cookie_stderr = fp;
4732 return interp->cookie_stderr;
4733 }
4734
4735 /* -----------------------------------------------------------------------------
4736 * Shared strings.
4737 * Every interpreter has an hash table where to put shared dynamically
4738 * allocate strings that are likely to be used a lot of times.
4739 * For example, in the 'source' object type, there is a pointer to
4740 * the filename associated with that object. Every script has a lot
4741 * of this objects with the identical file name, so it is wise to share
4742 * this info.
4743 *
4744 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4745 * returns the pointer to the shared string. Every time a reference
4746 * to the string is no longer used, the user should call
4747 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4748 * a given string, it is removed from the hash table.
4749 * ---------------------------------------------------------------------------*/
4750 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4751 {
4752 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4753
4754 if (he == NULL) {
4755 char *strCopy = Jim_StrDup(str);
4756
4757 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4758 return strCopy;
4759 } else {
4760 intptr_t refCount = (intptr_t) he->val;
4761
4762 refCount++;
4763 he->val = (void*) refCount;
4764 return he->key;
4765 }
4766 }
4767
4768 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4769 {
4770 intptr_t refCount;
4771 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4772
4773 if (he == NULL)
4774 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4775 "unknown shared string '%s'", str);
4776 refCount = (intptr_t) he->val;
4777 refCount--;
4778 if (refCount == 0) {
4779 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4780 } else {
4781 he->val = (void*) refCount;
4782 }
4783 }
4784
4785 /* -----------------------------------------------------------------------------
4786 * Integer object
4787 * ---------------------------------------------------------------------------*/
4788 #define JIM_INTEGER_SPACE 24
4789
4790 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4791 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4792
4793 static Jim_ObjType intObjType = {
4794 "int",
4795 NULL,
4796 NULL,
4797 UpdateStringOfInt,
4798 JIM_TYPE_NONE,
4799 };
4800
4801 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4802 {
4803 int len;
4804 char buf[JIM_INTEGER_SPACE + 1];
4805
4806 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4807 objPtr->bytes = Jim_Alloc(len + 1);
4808 memcpy(objPtr->bytes, buf, len + 1);
4809 objPtr->length = len;
4810 }
4811
4812 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4813 {
4814 jim_wide wideValue;
4815 const char *str;
4816
4817 /* Get the string representation */
4818 str = Jim_GetString(objPtr, NULL);
4819 /* Try to convert into a jim_wide */
4820 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4821 if (flags & JIM_ERRMSG) {
4822 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4823 Jim_AppendStrings(interp, Jim_GetResult(interp),
4824 "expected integer but got \"", str, "\"", NULL);
4825 }
4826 return JIM_ERR;
4827 }
4828 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4829 errno == ERANGE) {
4830 Jim_SetResultString(interp,
4831 "Integer value too big to be represented", -1);
4832 return JIM_ERR;
4833 }
4834 /* Free the old internal repr and set the new one. */
4835 Jim_FreeIntRep(interp, objPtr);
4836 objPtr->typePtr = &intObjType;
4837 objPtr->internalRep.wideValue = wideValue;
4838 return JIM_OK;
4839 }
4840
4841 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4842 {
4843 if (objPtr->typePtr != &intObjType &&
4844 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4845 return JIM_ERR;
4846 *widePtr = objPtr->internalRep.wideValue;
4847 return JIM_OK;
4848 }
4849
4850 /* Get a wide but does not set an error if the format is bad. */
4851 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4852 jim_wide *widePtr)
4853 {
4854 if (objPtr->typePtr != &intObjType &&
4855 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4856 return JIM_ERR;
4857 *widePtr = objPtr->internalRep.wideValue;
4858 return JIM_OK;
4859 }
4860
4861 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4862 {
4863 jim_wide wideValue;
4864 int retval;
4865
4866 retval = Jim_GetWide(interp, objPtr, &wideValue);
4867 if (retval == JIM_OK) {
4868 *longPtr = (long) wideValue;
4869 return JIM_OK;
4870 }
4871 return JIM_ERR;
4872 }
4873
4874 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4875 {
4876 if (Jim_IsShared(objPtr))
4877 Jim_Panic(interp,"Jim_SetWide called with shared object");
4878 if (objPtr->typePtr != &intObjType) {
4879 Jim_FreeIntRep(interp, objPtr);
4880 objPtr->typePtr = &intObjType;
4881 }
4882 Jim_InvalidateStringRep(objPtr);
4883 objPtr->internalRep.wideValue = wideValue;
4884 }
4885
4886 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4887 {
4888 Jim_Obj *objPtr;
4889
4890 objPtr = Jim_NewObj(interp);
4891 objPtr->typePtr = &intObjType;
4892 objPtr->bytes = NULL;
4893 objPtr->internalRep.wideValue = wideValue;
4894 return objPtr;
4895 }
4896
4897 /* -----------------------------------------------------------------------------
4898 * Double object
4899 * ---------------------------------------------------------------------------*/
4900 #define JIM_DOUBLE_SPACE 30
4901
4902 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4903 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4904
4905 static Jim_ObjType doubleObjType = {
4906 "double",
4907 NULL,
4908 NULL,
4909 UpdateStringOfDouble,
4910 JIM_TYPE_NONE,
4911 };
4912
4913 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4914 {
4915 int len;
4916 char buf[JIM_DOUBLE_SPACE + 1];
4917
4918 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4919 objPtr->bytes = Jim_Alloc(len + 1);
4920 memcpy(objPtr->bytes, buf, len + 1);
4921 objPtr->length = len;
4922 }
4923
4924 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4925 {
4926 double doubleValue;
4927 const char *str;
4928
4929 /* Get the string representation */
4930 str = Jim_GetString(objPtr, NULL);
4931 /* Try to convert into a double */
4932 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4933 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4934 Jim_AppendStrings(interp, Jim_GetResult(interp),
4935 "expected number but got '", str, "'", NULL);
4936 return JIM_ERR;
4937 }
4938 /* Free the old internal repr and set the new one. */
4939 Jim_FreeIntRep(interp, objPtr);
4940 objPtr->typePtr = &doubleObjType;
4941 objPtr->internalRep.doubleValue = doubleValue;
4942 return JIM_OK;
4943 }
4944
4945 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4946 {
4947 if (objPtr->typePtr != &doubleObjType &&
4948 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4949 return JIM_ERR;
4950 *doublePtr = objPtr->internalRep.doubleValue;
4951 return JIM_OK;
4952 }
4953
4954 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4955 {
4956 if (Jim_IsShared(objPtr))
4957 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4958 if (objPtr->typePtr != &doubleObjType) {
4959 Jim_FreeIntRep(interp, objPtr);
4960 objPtr->typePtr = &doubleObjType;
4961 }
4962 Jim_InvalidateStringRep(objPtr);
4963 objPtr->internalRep.doubleValue = doubleValue;
4964 }
4965
4966 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4967 {
4968 Jim_Obj *objPtr;
4969
4970 objPtr = Jim_NewObj(interp);
4971 objPtr->typePtr = &doubleObjType;
4972 objPtr->bytes = NULL;
4973 objPtr->internalRep.doubleValue = doubleValue;
4974 return objPtr;
4975 }
4976
4977 /* -----------------------------------------------------------------------------
4978 * List object
4979 * ---------------------------------------------------------------------------*/
4980 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4981 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4982 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4983 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4984 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4985
4986 /* Note that while the elements of the list may contain references,
4987 * the list object itself can't. This basically means that the
4988 * list object string representation as a whole can't contain references
4989 * that are not presents in the single elements. */
4990 static Jim_ObjType listObjType = {
4991 "list",
4992 FreeListInternalRep,
4993 DupListInternalRep,
4994 UpdateStringOfList,
4995 JIM_TYPE_NONE,
4996 };
4997
4998 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4999 {
5000 int i;
5001
5002 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5003 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5004 }
5005 Jim_Free(objPtr->internalRep.listValue.ele);
5006 }
5007
5008 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5009 {
5010 int i;
5011 JIM_NOTUSED(interp);
5012
5013 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5014 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5015 dupPtr->internalRep.listValue.ele =
5016 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5017 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5018 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5019 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5020 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5021 }
5022 dupPtr->typePtr = &listObjType;
5023 }
5024
5025 /* The following function checks if a given string can be encoded
5026 * into a list element without any kind of quoting, surrounded by braces,
5027 * or using escapes to quote. */
5028 #define JIM_ELESTR_SIMPLE 0
5029 #define JIM_ELESTR_BRACE 1
5030 #define JIM_ELESTR_QUOTE 2
5031 static int ListElementQuotingType(const char *s, int len)
5032 {
5033 int i, level, trySimple = 1;
5034
5035 /* Try with the SIMPLE case */
5036 if (len == 0) return JIM_ELESTR_BRACE;
5037 if (s[0] == '"' || s[0] == '{') {
5038 trySimple = 0;
5039 goto testbrace;
5040 }
5041 for (i = 0; i < len; i++) {
5042 switch (s[i]) {
5043 case ' ':
5044 case '$':
5045 case '"':
5046 case '[':
5047 case ']':
5048 case ';':
5049 case '\\':
5050 case '\r':
5051 case '\n':
5052 case '\t':
5053 case '\f':
5054 case '\v':
5055 trySimple = 0;
5056 case '{':
5057 case '}':
5058 goto testbrace;
5059 }
5060 }
5061 return JIM_ELESTR_SIMPLE;
5062
5063 testbrace:
5064 /* Test if it's possible to do with braces */
5065 if (s[len-1] == '\\' ||
5066 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5067 level = 0;
5068 for (i = 0; i < len; i++) {
5069 switch (s[i]) {
5070 case '{': level++; break;
5071 case '}': level--;
5072 if (level < 0) return JIM_ELESTR_QUOTE;
5073 break;
5074 case '\\':
5075 if (s[i + 1] == '\n')
5076 return JIM_ELESTR_QUOTE;
5077 else
5078 if (s[i + 1] != '\0') i++;
5079 break;
5080 }
5081 }
5082 if (level == 0) {
5083 if (!trySimple) return JIM_ELESTR_BRACE;
5084 for (i = 0; i < len; i++) {
5085 switch (s[i]) {
5086 case ' ':
5087 case '$':
5088 case '"':
5089 case '[':
5090 case ']':
5091 case ';':
5092 case '\\':
5093 case '\r':
5094 case '\n':
5095 case '\t':
5096 case '\f':
5097 case '\v':
5098 return JIM_ELESTR_BRACE;
5099 break;
5100 }
5101 }
5102 return JIM_ELESTR_SIMPLE;
5103 }
5104 return JIM_ELESTR_QUOTE;
5105 }
5106
5107 /* Returns the malloc-ed representation of a string
5108 * using backslash to quote special chars. */
5109 static char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5110 {
5111 char *q = Jim_Alloc(len*2 + 1), *p;
5112
5113 p = q;
5114 while (*s) {
5115 switch (*s) {
5116 case ' ':
5117 case '$':
5118 case '"':
5119 case '[':
5120 case ']':
5121 case '{':
5122 case '}':
5123 case ';':
5124 case '\\':
5125 *p++ = '\\';
5126 *p++ = *s++;
5127 break;
5128 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5129 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5130 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5131 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5132 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5133 default:
5134 *p++ = *s++;
5135 break;
5136 }
5137 }
5138 *p = '\0';
5139 *qlenPtr = p-q;
5140 return q;
5141 }
5142
5143 void UpdateStringOfList(struct Jim_Obj *objPtr)
5144 {
5145 int i, bufLen, realLength;
5146 const char *strRep;
5147 char *p;
5148 int *quotingType;
5149 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5150
5151 /* (Over) Estimate the space needed. */
5152 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5153 bufLen = 0;
5154 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5155 int len;
5156
5157 strRep = Jim_GetString(ele[i], &len);
5158 quotingType[i] = ListElementQuotingType(strRep, len);
5159 switch (quotingType[i]) {
5160 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5161 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5162 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5163 }
5164 bufLen++; /* elements separator. */
5165 }
5166 bufLen++;
5167
5168 /* Generate the string rep. */
5169 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5170 realLength = 0;
5171 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5172 int len, qlen;
5173 strRep = Jim_GetString(ele[i], &len);
5174 char *q;
5175
5176 switch (quotingType[i]) {
5177 case JIM_ELESTR_SIMPLE:
5178 memcpy(p, strRep, len);
5179 p += len;
5180 realLength += len;
5181 break;
5182 case JIM_ELESTR_BRACE:
5183 *p++ = '{';
5184 memcpy(p, strRep, len);
5185 p += len;
5186 *p++ = '}';
5187 realLength += len + 2;
5188 break;
5189 case JIM_ELESTR_QUOTE:
5190 q = BackslashQuoteString(strRep, len, &qlen);
5191 memcpy(p, q, qlen);
5192 Jim_Free(q);
5193 p += qlen;
5194 realLength += qlen;
5195 break;
5196 }
5197 /* Add a separating space */
5198 if (i + 1 != objPtr->internalRep.listValue.len) {
5199 *p++ = ' ';
5200 realLength ++;
5201 }
5202 }
5203 *p = '\0'; /* nul term. */
5204 objPtr->length = realLength;
5205 Jim_Free(quotingType);
5206 }
5207
5208 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5209 {
5210 struct JimParserCtx parser;
5211 const char *str;
5212 int strLen;
5213
5214 /* Get the string representation */
5215 str = Jim_GetString(objPtr, &strLen);
5216
5217 /* Free the old internal repr just now and initialize the
5218 * new one just now. The string->list conversion can't fail. */
5219 Jim_FreeIntRep(interp, objPtr);
5220 objPtr->typePtr = &listObjType;
5221 objPtr->internalRep.listValue.len = 0;
5222 objPtr->internalRep.listValue.maxLen = 0;
5223 objPtr->internalRep.listValue.ele = NULL;
5224
5225 /* Convert into a list */
5226 JimParserInit(&parser, str, strLen, 1);
5227 while (!JimParserEof(&parser)) {
5228 char *token;
5229 int tokenLen, type;
5230 Jim_Obj *elementPtr;
5231
5232 JimParseList(&parser);
5233 if (JimParserTtype(&parser) != JIM_TT_STR &&
5234 JimParserTtype(&parser) != JIM_TT_ESC)
5235 continue;
5236 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5237 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5238 ListAppendElement(objPtr, elementPtr);
5239 }
5240 return JIM_OK;
5241 }
5242
5243 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5244 int len)
5245 {
5246 Jim_Obj *objPtr;
5247 int i;
5248
5249 objPtr = Jim_NewObj(interp);
5250 objPtr->typePtr = &listObjType;
5251 objPtr->bytes = NULL;
5252 objPtr->internalRep.listValue.ele = NULL;
5253 objPtr->internalRep.listValue.len = 0;
5254 objPtr->internalRep.listValue.maxLen = 0;
5255 for (i = 0; i < len; i++) {
5256 ListAppendElement(objPtr, elements[i]);
5257 }
5258 return objPtr;
5259 }
5260
5261 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5262 * length of the vector. Note that the user of this function should make
5263 * sure that the list object can't shimmer while the vector returned
5264 * is in use, this vector is the one stored inside the internal representation
5265 * of the list object. This function is not exported, extensions should
5266 * always access to the List object elements using Jim_ListIndex(). */
5267 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5268 Jim_Obj ***listVec)
5269 {
5270 Jim_ListLength(interp, listObj, argc);
5271 assert(listObj->typePtr == &listObjType);
5272 *listVec = listObj->internalRep.listValue.ele;
5273 }
5274
5275 /* ListSortElements type values */
5276 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5277 JIM_LSORT_NOCASE_DECR};
5278
5279 /* Sort the internal rep of a list. */
5280 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5281 {
5282 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5283 }
5284
5285 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5286 {
5287 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5288 }
5289
5290 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5291 {
5292 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5293 }
5294
5295 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5296 {
5297 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5298 }
5299
5300 /* Sort a list *in place*. MUST be called with non-shared objects. */
5301 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5302 {
5303 typedef int (qsort_comparator)(const void *, const void *);
5304 int (*fn)(Jim_Obj**, Jim_Obj**);
5305 Jim_Obj **vector;
5306 int len;
5307
5308 if (Jim_IsShared(listObjPtr))
5309 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5310 if (listObjPtr->typePtr != &listObjType)
5311 SetListFromAny(interp, listObjPtr);
5312
5313 vector = listObjPtr->internalRep.listValue.ele;
5314 len = listObjPtr->internalRep.listValue.len;
5315 switch (type) {
5316 case JIM_LSORT_ASCII: fn = ListSortString; break;
5317 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5318 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5319 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5320 default:
5321 fn = NULL; /* avoid warning */
5322 Jim_Panic(interp,"ListSort called with invalid sort type");
5323 }
5324 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5325 Jim_InvalidateStringRep(listObjPtr);
5326 }
5327
5328 /* This is the low-level function to append an element to a list.
5329 * The higher-level Jim_ListAppendElement() performs shared object
5330 * check and invalidate the string repr. This version is used
5331 * in the internals of the List Object and is not exported.
5332 *
5333 * NOTE: this function can be called only against objects
5334 * with internal type of List. */
5335 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5336 {
5337 int requiredLen = listPtr->internalRep.listValue.len + 1;
5338
5339 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5340 int maxLen = requiredLen * 2;
5341
5342 listPtr->internalRep.listValue.ele =
5343 Jim_Realloc(listPtr->internalRep.listValue.ele,
5344 sizeof(Jim_Obj*)*maxLen);
5345 listPtr->internalRep.listValue.maxLen = maxLen;
5346 }
5347 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5348 objPtr;
5349 listPtr->internalRep.listValue.len ++;
5350 Jim_IncrRefCount(objPtr);
5351 }
5352
5353 /* This is the low-level function to insert elements into a list.
5354 * The higher-level Jim_ListInsertElements() performs shared object
5355 * check and invalidate the string repr. This version is used
5356 * in the internals of the List Object and is not exported.
5357 *
5358 * NOTE: this function can be called only against objects
5359 * with internal type of List. */
5360 static void ListInsertElements(Jim_Obj *listPtr, int index_t, int elemc,
5361 Jim_Obj *const *elemVec)
5362 {
5363 int currentLen = listPtr->internalRep.listValue.len;
5364 int requiredLen = currentLen + elemc;
5365 int i;
5366 Jim_Obj **point;
5367
5368 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5369 int maxLen = requiredLen * 2;
5370
5371 listPtr->internalRep.listValue.ele =
5372 Jim_Realloc(listPtr->internalRep.listValue.ele,
5373 sizeof(Jim_Obj*)*maxLen);
5374 listPtr->internalRep.listValue.maxLen = maxLen;
5375 }
5376 point = listPtr->internalRep.listValue.ele + index_t;
5377 memmove(point + elemc, point, (currentLen-index_t) * sizeof(Jim_Obj*));
5378 for (i = 0; i < elemc; ++i) {
5379 point[i] = elemVec[i];
5380 Jim_IncrRefCount(point[i]);
5381 }
5382 listPtr->internalRep.listValue.len += elemc;
5383 }
5384
5385 /* Appends every element of appendListPtr into listPtr.
5386 * Both have to be of the list type. */
5387 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5388 {
5389 int i, oldLen = listPtr->internalRep.listValue.len;
5390 int appendLen = appendListPtr->internalRep.listValue.len;
5391 int requiredLen = oldLen + appendLen;
5392
5393 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5394 int maxLen = requiredLen * 2;
5395
5396 listPtr->internalRep.listValue.ele =
5397 Jim_Realloc(listPtr->internalRep.listValue.ele,
5398 sizeof(Jim_Obj*)*maxLen);
5399 listPtr->internalRep.listValue.maxLen = maxLen;
5400 }
5401 for (i = 0; i < appendLen; i++) {
5402 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5403 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5404 Jim_IncrRefCount(objPtr);
5405 }
5406 listPtr->internalRep.listValue.len += appendLen;
5407 }
5408
5409 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5410 {
5411 if (Jim_IsShared(listPtr))
5412 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5413 if (listPtr->typePtr != &listObjType)
5414 SetListFromAny(interp, listPtr);
5415 Jim_InvalidateStringRep(listPtr);
5416 ListAppendElement(listPtr, objPtr);
5417 }
5418
5419 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5420 {
5421 if (Jim_IsShared(listPtr))
5422 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5423 if (listPtr->typePtr != &listObjType)
5424 SetListFromAny(interp, listPtr);
5425 Jim_InvalidateStringRep(listPtr);
5426 ListAppendList(listPtr, appendListPtr);
5427 }
5428
5429 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5430 {
5431 if (listPtr->typePtr != &listObjType)
5432 SetListFromAny(interp, listPtr);
5433 *intPtr = listPtr->internalRep.listValue.len;
5434 }
5435
5436 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5437 int objc, Jim_Obj *const *objVec)
5438 {
5439 if (Jim_IsShared(listPtr))
5440 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5441 if (listPtr->typePtr != &listObjType)
5442 SetListFromAny(interp, listPtr);
5443 if (index_t >= 0 && index_t > listPtr->internalRep.listValue.len)
5444 index_t = listPtr->internalRep.listValue.len;
5445 else if (index_t < 0)
5446 index_t = 0;
5447 Jim_InvalidateStringRep(listPtr);
5448 ListInsertElements(listPtr, index_t, objc, objVec);
5449 }
5450
5451 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5452 Jim_Obj **objPtrPtr, int flags)
5453 {
5454 if (listPtr->typePtr != &listObjType)
5455 SetListFromAny(interp, listPtr);
5456 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5457 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5458 if (flags & JIM_ERRMSG) {
5459 Jim_SetResultString(interp,
5460 "list index out of range", -1);
5461 }
5462 return JIM_ERR;
5463 }
5464 if (index_t < 0)
5465 index_t = listPtr->internalRep.listValue.len + index_t;
5466 *objPtrPtr = listPtr->internalRep.listValue.ele[index_t];
5467 return JIM_OK;
5468 }
5469
5470 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5471 Jim_Obj *newObjPtr, int flags)
5472 {
5473 if (listPtr->typePtr != &listObjType)
5474 SetListFromAny(interp, listPtr);
5475 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5476 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5477 if (flags & JIM_ERRMSG) {
5478 Jim_SetResultString(interp,
5479 "list index_t out of range", -1);
5480 }
5481 return JIM_ERR;
5482 }
5483 if (index_t < 0)
5484 index_t = listPtr->internalRep.listValue.len + index_t;
5485 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index_t]);
5486 listPtr->internalRep.listValue.ele[index_t] = newObjPtr;
5487 Jim_IncrRefCount(newObjPtr);
5488 return JIM_OK;
5489 }
5490
5491 /* Modify the list stored into the variable named 'varNamePtr'
5492 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5493 * with the new element 'newObjptr'. */
5494 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5495 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5496 {
5497 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5498 int shared, i, index_t;
5499
5500 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5501 if (objPtr == NULL)
5502 return JIM_ERR;
5503 if ((shared = Jim_IsShared(objPtr)))
5504 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5505 for (i = 0; i < indexc-1; i++) {
5506 listObjPtr = objPtr;
5507 if (Jim_GetIndex(interp, indexv[i], &index_t) != JIM_OK)
5508 goto err;
5509 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
5510 JIM_ERRMSG) != JIM_OK) {
5511 goto err;
5512 }
5513 if (Jim_IsShared(objPtr)) {
5514 objPtr = Jim_DuplicateObj(interp, objPtr);
5515 ListSetIndex(interp, listObjPtr, index_t, objPtr, JIM_NONE);
5516 }
5517 Jim_InvalidateStringRep(listObjPtr);
5518 }
5519 if (Jim_GetIndex(interp, indexv[indexc-1], &index_t) != JIM_OK)
5520 goto err;
5521 if (ListSetIndex(interp, objPtr, index_t, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5522 goto err;
5523 Jim_InvalidateStringRep(objPtr);
5524 Jim_InvalidateStringRep(varObjPtr);
5525 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5526 goto err;
5527 Jim_SetResult(interp, varObjPtr);
5528 return JIM_OK;
5529 err:
5530 if (shared) {
5531 Jim_FreeNewObj(interp, varObjPtr);
5532 }
5533 return JIM_ERR;
5534 }
5535
5536 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5537 {
5538 int i;
5539
5540 /* If all the objects in objv are lists without string rep.
5541 * it's possible to return a list as result, that's the
5542 * concatenation of all the lists. */
5543 for (i = 0; i < objc; i++) {
5544 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5545 break;
5546 }
5547 if (i == objc) {
5548 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5549 for (i = 0; i < objc; i++)
5550 Jim_ListAppendList(interp, objPtr, objv[i]);
5551 return objPtr;
5552 } else {
5553 /* Else... we have to glue strings together */
5554 int len = 0, objLen;
5555 char *bytes, *p;
5556
5557 /* Compute the length */
5558 for (i = 0; i < objc; i++) {
5559 Jim_GetString(objv[i], &objLen);
5560 len += objLen;
5561 }
5562 if (objc) len += objc-1;
5563 /* Create the string rep, and a stinrg object holding it. */
5564 p = bytes = Jim_Alloc(len + 1);
5565 for (i = 0; i < objc; i++) {
5566 const char *s = Jim_GetString(objv[i], &objLen);
5567 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5568 {
5569 s++; objLen--; len--;
5570 }
5571 while (objLen && (s[objLen-1] == ' ' ||
5572 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5573 objLen--; len--;
5574 }
5575 memcpy(p, s, objLen);
5576 p += objLen;
5577 if (objLen && i + 1 != objc) {
5578 *p++ = ' ';
5579 } else if (i + 1 != objc) {
5580 /* Drop the space calcuated for this
5581 * element that is instead null. */
5582 len--;
5583 }
5584 }
5585 *p = '\0';
5586 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5587 }
5588 }
5589
5590 /* Returns a list composed of the elements in the specified range.
5591 * first and start are directly accepted as Jim_Objects and
5592 * processed for the end?-index? case. */
5593 static Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr,
5594 Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5595 {
5596 int first, last;
5597 int len, rangeLen;
5598
5599 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5600 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5601 return NULL;
5602 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5603 first = JimRelToAbsIndex(len, first);
5604 last = JimRelToAbsIndex(len, last);
5605 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5606 return Jim_NewListObj(interp,
5607 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5608 }
5609
5610 /* -----------------------------------------------------------------------------
5611 * Dict object
5612 * ---------------------------------------------------------------------------*/
5613 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5614 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5615 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5616 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5617
5618 /* Dict HashTable Type.
5619 *
5620 * Keys and Values are Jim objects. */
5621
5622 static unsigned int JimObjectHTHashFunction(const void *key)
5623 {
5624 const char *str;
5625 Jim_Obj *objPtr = (Jim_Obj*) key;
5626 int len, h;
5627
5628 str = Jim_GetString(objPtr, &len);
5629 h = Jim_GenHashFunction((unsigned char*)str, len);
5630 return h;
5631 }
5632
5633 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5634 {
5635 JIM_NOTUSED(privdata);
5636
5637 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5638 }
5639
5640 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5641 {
5642 Jim_Obj *objPtr = val;
5643
5644 Jim_DecrRefCount(interp, objPtr);
5645 }
5646
5647 static Jim_HashTableType JimDictHashTableType = {
5648 JimObjectHTHashFunction, /* hash function */
5649 NULL, /* key dup */
5650 NULL, /* val dup */
5651 JimObjectHTKeyCompare, /* key compare */
5652 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5653 JimObjectHTKeyValDestructor, /* key destructor */
5654 JimObjectHTKeyValDestructor /* val destructor */
5655 };
5656
5657 /* Note that while the elements of the dict may contain references,
5658 * the list object itself can't. This basically means that the
5659 * dict object string representation as a whole can't contain references
5660 * that are not presents in the single elements. */
5661 static Jim_ObjType dictObjType = {
5662 "dict",
5663 FreeDictInternalRep,
5664 DupDictInternalRep,
5665 UpdateStringOfDict,
5666 JIM_TYPE_NONE,
5667 };
5668
5669 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5670 {
5671 JIM_NOTUSED(interp);
5672
5673 Jim_FreeHashTable(objPtr->internalRep.ptr);
5674 Jim_Free(objPtr->internalRep.ptr);
5675 }
5676
5677 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5678 {
5679 Jim_HashTable *ht, *dupHt;
5680 Jim_HashTableIterator *htiter;
5681 Jim_HashEntry *he;
5682
5683 /* Create a new hash table */
5684 ht = srcPtr->internalRep.ptr;
5685 dupHt = Jim_Alloc(sizeof(*dupHt));
5686 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5687 if (ht->size != 0)
5688 Jim_ExpandHashTable(dupHt, ht->size);
5689 /* Copy every element from the source to the dup hash table */
5690 htiter = Jim_GetHashTableIterator(ht);
5691 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5692 const Jim_Obj *keyObjPtr = he->key;
5693 Jim_Obj *valObjPtr = he->val;
5694
5695 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5696 Jim_IncrRefCount(valObjPtr);
5697 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5698 }
5699 Jim_FreeHashTableIterator(htiter);
5700
5701 dupPtr->internalRep.ptr = dupHt;
5702 dupPtr->typePtr = &dictObjType;
5703 }
5704
5705 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5706 {
5707 int i, bufLen, realLength;
5708 const char *strRep;
5709 char *p;
5710 int *quotingType, objc;
5711 Jim_HashTable *ht;
5712 Jim_HashTableIterator *htiter;
5713 Jim_HashEntry *he;
5714 Jim_Obj **objv;
5715
5716 /* Trun the hash table into a flat vector of Jim_Objects. */
5717 ht = objPtr->internalRep.ptr;
5718 objc = ht->used*2;
5719 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5720 htiter = Jim_GetHashTableIterator(ht);
5721 i = 0;
5722 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5723 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5724 objv[i++] = he->val;
5725 }
5726 Jim_FreeHashTableIterator(htiter);
5727 /* (Over) Estimate the space needed. */
5728 quotingType = Jim_Alloc(sizeof(int)*objc);
5729 bufLen = 0;
5730 for (i = 0; i < objc; i++) {
5731 int len;
5732
5733 strRep = Jim_GetString(objv[i], &len);
5734 quotingType[i] = ListElementQuotingType(strRep, len);
5735 switch (quotingType[i]) {
5736 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5737 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5738 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5739 }
5740 bufLen++; /* elements separator. */
5741 }
5742 bufLen++;
5743
5744 /* Generate the string rep. */
5745 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5746 realLength = 0;
5747 for (i = 0; i < objc; i++) {
5748 int len, qlen;
5749 strRep = Jim_GetString(objv[i], &len);
5750 char *q;
5751
5752 switch (quotingType[i]) {
5753 case JIM_ELESTR_SIMPLE:
5754 memcpy(p, strRep, len);
5755 p += len;
5756 realLength += len;
5757 break;
5758 case JIM_ELESTR_BRACE:
5759 *p++ = '{';
5760 memcpy(p, strRep, len);
5761 p += len;
5762 *p++ = '}';
5763 realLength += len + 2;
5764 break;
5765 case JIM_ELESTR_QUOTE:
5766 q = BackslashQuoteString(strRep, len, &qlen);
5767 memcpy(p, q, qlen);
5768 Jim_Free(q);
5769 p += qlen;
5770 realLength += qlen;
5771 break;
5772 }
5773 /* Add a separating space */
5774 if (i + 1 != objc) {
5775 *p++ = ' ';
5776 realLength ++;
5777 }
5778 }
5779 *p = '\0'; /* nul term. */
5780 objPtr->length = realLength;
5781 Jim_Free(quotingType);
5782 Jim_Free(objv);
5783 }
5784
5785 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5786 {
5787 struct JimParserCtx parser;
5788 Jim_HashTable *ht;
5789 Jim_Obj *objv[2];
5790 const char *str;
5791 int i, strLen;
5792
5793 /* Get the string representation */
5794 str = Jim_GetString(objPtr, &strLen);
5795
5796 /* Free the old internal repr just now and initialize the
5797 * new one just now. The string->list conversion can't fail. */
5798 Jim_FreeIntRep(interp, objPtr);
5799 ht = Jim_Alloc(sizeof(*ht));
5800 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5801 objPtr->typePtr = &dictObjType;
5802 objPtr->internalRep.ptr = ht;
5803
5804 /* Convert into a dict */
5805 JimParserInit(&parser, str, strLen, 1);
5806 i = 0;
5807 while (!JimParserEof(&parser)) {
5808 char *token;
5809 int tokenLen, type;
5810
5811 JimParseList(&parser);
5812 if (JimParserTtype(&parser) != JIM_TT_STR &&
5813 JimParserTtype(&parser) != JIM_TT_ESC)
5814 continue;
5815 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5816 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5817 if (i == 2) {
5818 i = 0;
5819 Jim_IncrRefCount(objv[0]);
5820 Jim_IncrRefCount(objv[1]);
5821 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5822 Jim_HashEntry *he;
5823 he = Jim_FindHashEntry(ht, objv[0]);
5824 Jim_DecrRefCount(interp, objv[0]);
5825 /* ATTENTION: const cast */
5826 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5827 he->val = objv[1];
5828 }
5829 }
5830 }
5831 if (i) {
5832 Jim_FreeNewObj(interp, objv[0]);
5833 objPtr->typePtr = NULL;
5834 Jim_FreeHashTable(ht);
5835 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5836 return JIM_ERR;
5837 }
5838 return JIM_OK;
5839 }
5840
5841 /* Dict object API */
5842
5843 /* Add an element to a dict. objPtr must be of the "dict" type.
5844 * The higer-level exported function is Jim_DictAddElement().
5845 * If an element with the specified key already exists, the value
5846 * associated is replaced with the new one.
5847 *
5848 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5849 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5850 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5851 {
5852 Jim_HashTable *ht = objPtr->internalRep.ptr;
5853
5854 if (valueObjPtr == NULL) { /* unset */
5855 Jim_DeleteHashEntry(ht, keyObjPtr);
5856 return;
5857 }
5858 Jim_IncrRefCount(keyObjPtr);
5859 Jim_IncrRefCount(valueObjPtr);
5860 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5861 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5862 Jim_DecrRefCount(interp, keyObjPtr);
5863 /* ATTENTION: const cast */
5864 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5865 he->val = valueObjPtr;
5866 }
5867 }
5868
5869 /* Add an element, higher-level interface for DictAddElement().
5870 * If valueObjPtr == NULL, the key is removed if it exists. */
5871 static int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5872 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5873 {
5874 if (Jim_IsShared(objPtr))
5875 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5876 if (objPtr->typePtr != &dictObjType) {
5877 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5878 return JIM_ERR;
5879 }
5880 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5881 Jim_InvalidateStringRep(objPtr);
5882 return JIM_OK;
5883 }
5884
5885 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5886 {
5887 Jim_Obj *objPtr;
5888 int i;
5889
5890 if (len % 2)
5891 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5892
5893 objPtr = Jim_NewObj(interp);
5894 objPtr->typePtr = &dictObjType;
5895 objPtr->bytes = NULL;
5896 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5897 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5898 for (i = 0; i < len; i += 2)
5899 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5900 return objPtr;
5901 }
5902
5903 /* Return the value associated to the specified dict key */
5904 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5905 Jim_Obj **objPtrPtr, int flags)
5906 {
5907 Jim_HashEntry *he;
5908 Jim_HashTable *ht;
5909
5910 if (dictPtr->typePtr != &dictObjType) {
5911 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5912 return JIM_ERR;
5913 }
5914 ht = dictPtr->internalRep.ptr;
5915 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5916 if (flags & JIM_ERRMSG) {
5917 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5918 Jim_AppendStrings(interp, Jim_GetResult(interp),
5919 "key \"", Jim_GetString(keyPtr, NULL),
5920 "\" not found in dictionary", NULL);
5921 }
5922 return JIM_ERR;
5923 }
5924 *objPtrPtr = he->val;
5925 return JIM_OK;
5926 }
5927
5928 /* Return the value associated to the specified dict keys */
5929 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5930 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5931 {
5932 Jim_Obj *objPtr = NULL;
5933 int i;
5934
5935 if (keyc == 0) {
5936 *objPtrPtr = dictPtr;
5937 return JIM_OK;
5938 }
5939
5940 for (i = 0; i < keyc; i++) {
5941 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5942 != JIM_OK)
5943 return JIM_ERR;
5944 dictPtr = objPtr;
5945 }
5946 *objPtrPtr = objPtr;
5947 return JIM_OK;
5948 }
5949
5950 /* Modify the dict stored into the variable named 'varNamePtr'
5951 * setting the element specified by the 'keyc' keys objects in 'keyv',
5952 * with the new value of the element 'newObjPtr'.
5953 *
5954 * If newObjPtr == NULL the operation is to remove the given key
5955 * from the dictionary. */
5956 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5957 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5958 {
5959 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5960 int shared, i;
5961
5962 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5963 if (objPtr == NULL) {
5964 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5965 return JIM_ERR;
5966 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5967 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5968 Jim_FreeNewObj(interp, varObjPtr);
5969 return JIM_ERR;
5970 }
5971 }
5972 if ((shared = Jim_IsShared(objPtr)))
5973 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5974 for (i = 0; i < keyc-1; i++) {
5975 dictObjPtr = objPtr;
5976
5977 /* Check if it's a valid dictionary */
5978 if (dictObjPtr->typePtr != &dictObjType) {
5979 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5980 goto err;
5981 }
5982 /* Check if the given key exists. */
5983 Jim_InvalidateStringRep(dictObjPtr);
5984 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5985 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5986 {
5987 /* This key exists at the current level.
5988 * Make sure it's not shared!. */
5989 if (Jim_IsShared(objPtr)) {
5990 objPtr = Jim_DuplicateObj(interp, objPtr);
5991 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5992 }
5993 } else {
5994 /* Key not found. If it's an [unset] operation
5995 * this is an error. Only the last key may not
5996 * exist. */
5997 if (newObjPtr == NULL)
5998 goto err;
5999 /* Otherwise set an empty dictionary
6000 * as key's value. */
6001 objPtr = Jim_NewDictObj(interp, NULL, 0);
6002 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6003 }
6004 }
6005 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6006 != JIM_OK)
6007 goto err;
6008 Jim_InvalidateStringRep(objPtr);
6009 Jim_InvalidateStringRep(varObjPtr);
6010 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6011 goto err;
6012 Jim_SetResult(interp, varObjPtr);
6013 return JIM_OK;
6014 err:
6015 if (shared) {
6016 Jim_FreeNewObj(interp, varObjPtr);
6017 }
6018 return JIM_ERR;
6019 }
6020
6021 /* -----------------------------------------------------------------------------
6022 * Index object
6023 * ---------------------------------------------------------------------------*/
6024 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6025 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6026
6027 static Jim_ObjType indexObjType = {
6028 "index",
6029 NULL,
6030 NULL,
6031 UpdateStringOfIndex,
6032 JIM_TYPE_NONE,
6033 };
6034
6035 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6036 {
6037 int len;
6038 char buf[JIM_INTEGER_SPACE + 1];
6039
6040 if (objPtr->internalRep.indexValue >= 0)
6041 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6042 else if (objPtr->internalRep.indexValue == -1)
6043 len = sprintf(buf, "end");
6044 else {
6045 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6046 }
6047 objPtr->bytes = Jim_Alloc(len + 1);
6048 memcpy(objPtr->bytes, buf, len + 1);
6049 objPtr->length = len;
6050 }
6051
6052 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6053 {
6054 int index_t, end = 0;
6055 const char *str;
6056
6057 /* Get the string representation */
6058 str = Jim_GetString(objPtr, NULL);
6059 /* Try to convert into an index */
6060 if (!strcmp(str, "end")) {
6061 index_t = 0;
6062 end = 1;
6063 } else {
6064 if (!strncmp(str, "end-", 4)) {
6065 str += 4;
6066 end = 1;
6067 }
6068 if (Jim_StringToIndex(str, &index_t) != JIM_OK) {
6069 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6070 Jim_AppendStrings(interp, Jim_GetResult(interp),
6071 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6072 "must be integer or end?-integer?", NULL);
6073 return JIM_ERR;
6074 }
6075 }
6076 if (end) {
6077 if (index_t < 0)
6078 index_t = INT_MAX;
6079 else
6080 index_t = -(index_t + 1);
6081 } else if (index_t < 0)
6082 index_t = -INT_MAX;
6083 /* Free the old internal repr and set the new one. */
6084 Jim_FreeIntRep(interp, objPtr);
6085 objPtr->typePtr = &indexObjType;
6086 objPtr->internalRep.indexValue = index_t;
6087 return JIM_OK;
6088 }
6089
6090 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6091 {
6092 /* Avoid shimmering if the object is an integer. */
6093 if (objPtr->typePtr == &intObjType) {
6094 jim_wide val = objPtr->internalRep.wideValue;
6095 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6096 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6097 return JIM_OK;
6098 }
6099 }
6100 if (objPtr->typePtr != &indexObjType &&
6101 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6102 return JIM_ERR;
6103 *indexPtr = objPtr->internalRep.indexValue;
6104 return JIM_OK;
6105 }
6106
6107 /* -----------------------------------------------------------------------------
6108 * Return Code Object.
6109 * ---------------------------------------------------------------------------*/
6110
6111 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6112
6113 static Jim_ObjType returnCodeObjType = {
6114 "return-code",
6115 NULL,
6116 NULL,
6117 NULL,
6118 JIM_TYPE_NONE,
6119 };
6120
6121 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6122 {
6123 const char *str;
6124 int strLen, returnCode;
6125 jim_wide wideValue;
6126
6127 /* Get the string representation */
6128 str = Jim_GetString(objPtr, &strLen);
6129 /* Try to convert into an integer */
6130 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6131 returnCode = (int) wideValue;
6132 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6133 returnCode = JIM_OK;
6134 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6135 returnCode = JIM_ERR;
6136 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6137 returnCode = JIM_RETURN;
6138 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6139 returnCode = JIM_BREAK;
6140 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6141 returnCode = JIM_CONTINUE;
6142 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6143 returnCode = JIM_EVAL;
6144 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6145 returnCode = JIM_EXIT;
6146 else {
6147 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6148 Jim_AppendStrings(interp, Jim_GetResult(interp),
6149 "expected return code but got '", str, "'",
6150 NULL);
6151 return JIM_ERR;
6152 }
6153 /* Free the old internal repr and set the new one. */
6154 Jim_FreeIntRep(interp, objPtr);
6155 objPtr->typePtr = &returnCodeObjType;
6156 objPtr->internalRep.returnCode = returnCode;
6157 return JIM_OK;
6158 }
6159
6160 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6161 {
6162 if (objPtr->typePtr != &returnCodeObjType &&
6163 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6164 return JIM_ERR;
6165 *intPtr = objPtr->internalRep.returnCode;
6166 return JIM_OK;
6167 }
6168
6169 /* -----------------------------------------------------------------------------
6170 * Expression Parsing
6171 * ---------------------------------------------------------------------------*/
6172 static int JimParseExprOperator(struct JimParserCtx *pc);
6173 static int JimParseExprNumber(struct JimParserCtx *pc);
6174 static int JimParseExprIrrational(struct JimParserCtx *pc);
6175
6176 /* Exrp's Stack machine operators opcodes. */
6177
6178 /* Binary operators (numbers) */
6179 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6180 #define JIM_EXPROP_MUL 0
6181 #define JIM_EXPROP_DIV 1
6182 #define JIM_EXPROP_MOD 2
6183 #define JIM_EXPROP_SUB 3
6184 #define JIM_EXPROP_ADD 4
6185 #define JIM_EXPROP_LSHIFT 5
6186 #define JIM_EXPROP_RSHIFT 6
6187 #define JIM_EXPROP_ROTL 7
6188 #define JIM_EXPROP_ROTR 8
6189 #define JIM_EXPROP_LT 9
6190 #define JIM_EXPROP_GT 10
6191 #define JIM_EXPROP_LTE 11
6192 #define JIM_EXPROP_GTE 12
6193 #define JIM_EXPROP_NUMEQ 13
6194 #define JIM_EXPROP_NUMNE 14
6195 #define JIM_EXPROP_BITAND 15
6196 #define JIM_EXPROP_BITXOR 16
6197 #define JIM_EXPROP_BITOR 17
6198 #define JIM_EXPROP_LOGICAND 18
6199 #define JIM_EXPROP_LOGICOR 19
6200 #define JIM_EXPROP_LOGICAND_LEFT 20
6201 #define JIM_EXPROP_LOGICOR_LEFT 21
6202 #define JIM_EXPROP_POW 22
6203 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6204
6205 /* Binary operators (strings) */
6206 #define JIM_EXPROP_STREQ 23
6207 #define JIM_EXPROP_STRNE 24
6208
6209 /* Unary operators (numbers) */
6210 #define JIM_EXPROP_NOT 25
6211 #define JIM_EXPROP_BITNOT 26
6212 #define JIM_EXPROP_UNARYMINUS 27
6213 #define JIM_EXPROP_UNARYPLUS 28
6214 #define JIM_EXPROP_LOGICAND_RIGHT 29
6215 #define JIM_EXPROP_LOGICOR_RIGHT 30
6216
6217 /* Ternary operators */
6218 #define JIM_EXPROP_TERNARY 31
6219
6220 /* Operands */
6221 #define JIM_EXPROP_NUMBER 32
6222 #define JIM_EXPROP_COMMAND 33
6223 #define JIM_EXPROP_VARIABLE 34
6224 #define JIM_EXPROP_DICTSUGAR 35
6225 #define JIM_EXPROP_SUBST 36
6226 #define JIM_EXPROP_STRING 37
6227
6228 /* Operators table */
6229 typedef struct Jim_ExprOperator {
6230 const char *name;
6231 int precedence;
6232 int arity;
6233 int opcode;
6234 } Jim_ExprOperator;
6235
6236 /* name - precedence - arity - opcode */
6237 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6238 {"!", 300, 1, JIM_EXPROP_NOT},
6239 {"~", 300, 1, JIM_EXPROP_BITNOT},
6240 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6241 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6242
6243 {"**", 250, 2, JIM_EXPROP_POW},
6244
6245 {"*", 200, 2, JIM_EXPROP_MUL},
6246 {"/", 200, 2, JIM_EXPROP_DIV},
6247 {"%", 200, 2, JIM_EXPROP_MOD},
6248
6249 {"-", 100, 2, JIM_EXPROP_SUB},
6250 {"+", 100, 2, JIM_EXPROP_ADD},
6251
6252 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6253 {">>>", 90, 3, JIM_EXPROP_ROTR},
6254 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6255 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6256
6257 {"<", 80, 2, JIM_EXPROP_LT},
6258 {">", 80, 2, JIM_EXPROP_GT},
6259 {"<=", 80, 2, JIM_EXPROP_LTE},
6260 {">=", 80, 2, JIM_EXPROP_GTE},
6261
6262 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6263 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6264
6265 {"eq", 60, 2, JIM_EXPROP_STREQ},
6266 {"ne", 60, 2, JIM_EXPROP_STRNE},
6267
6268 {"&", 50, 2, JIM_EXPROP_BITAND},
6269 {"^", 49, 2, JIM_EXPROP_BITXOR},
6270 {"|", 48, 2, JIM_EXPROP_BITOR},
6271
6272 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6273 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6274
6275 {"?", 5, 3, JIM_EXPROP_TERNARY},
6276 /* private operators */
6277 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6278 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6279 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6280 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6281 };
6282
6283 #define JIM_EXPR_OPERATORS_NUM \
6284 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6285
6286 static int JimParseExpression(struct JimParserCtx *pc)
6287 {
6288 /* Discard spaces and quoted newline */
6289 while (*(pc->p) == ' ' ||
6290 *(pc->p) == '\t' ||
6291 *(pc->p) == '\r' ||
6292 *(pc->p) == '\n' ||
6293 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6294 pc->p++; pc->len--;
6295 }
6296
6297 if (pc->len == 0) {
6298 pc->tstart = pc->tend = pc->p;
6299 pc->tline = pc->linenr;
6300 pc->tt = JIM_TT_EOL;
6301 pc->eof = 1;
6302 return JIM_OK;
6303 }
6304 switch (*(pc->p)) {
6305 case '(':
6306 pc->tstart = pc->tend = pc->p;
6307 pc->tline = pc->linenr;
6308 pc->tt = JIM_TT_SUBEXPR_START;
6309 pc->p++; pc->len--;
6310 break;
6311 case ')':
6312 pc->tstart = pc->tend = pc->p;
6313 pc->tline = pc->linenr;
6314 pc->tt = JIM_TT_SUBEXPR_END;
6315 pc->p++; pc->len--;
6316 break;
6317 case '[':
6318 return JimParseCmd(pc);
6319 break;
6320 case '$':
6321 if (JimParseVar(pc) == JIM_ERR)
6322 return JimParseExprOperator(pc);
6323 else
6324 return JIM_OK;
6325 break;
6326 case '-':
6327 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6328 isdigit((int)*(pc->p + 1)))
6329 return JimParseExprNumber(pc);
6330 else
6331 return JimParseExprOperator(pc);
6332 break;
6333 case '0': case '1': case '2': case '3': case '4':
6334 case '5': case '6': case '7': case '8': case '9': case '.':
6335 return JimParseExprNumber(pc);
6336 break;
6337 case '"':
6338 case '{':
6339 /* Here it's possible to reuse the List String parsing. */
6340 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6341 return JimParseListStr(pc);
6342 break;
6343 case 'N': case 'I':
6344 case 'n': case 'i':
6345 if (JimParseExprIrrational(pc) == JIM_ERR)
6346 return JimParseExprOperator(pc);
6347 break;
6348 default:
6349 return JimParseExprOperator(pc);
6350 break;
6351 }
6352 return JIM_OK;
6353 }
6354
6355 int JimParseExprNumber(struct JimParserCtx *pc)
6356 {
6357 int allowdot = 1;
6358 int allowhex = 0;
6359
6360 pc->tstart = pc->p;
6361 pc->tline = pc->linenr;
6362 if (*pc->p == '-') {
6363 pc->p++; pc->len--;
6364 }
6365 while (isdigit((int)*pc->p)
6366 || (allowhex && isxdigit((int)*pc->p))
6367 || (allowdot && *pc->p == '.')
6368 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6369 (*pc->p == 'x' || *pc->p == 'X'))
6370 )
6371 {
6372 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6373 allowhex = 1;
6374 allowdot = 0;
6375 }
6376 if (*pc->p == '.')
6377 allowdot = 0;
6378 pc->p++; pc->len--;
6379 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6380 pc->p += 2; pc->len -= 2;
6381 }
6382 }
6383 pc->tend = pc->p-1;
6384 pc->tt = JIM_TT_EXPR_NUMBER;
6385 return JIM_OK;
6386 }
6387
6388 int JimParseExprIrrational(struct JimParserCtx *pc)
6389 {
6390 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6391 const char **token;
6392 for (token = Tokens; *token != NULL; token++) {
6393 int len = strlen(*token);
6394 if (strncmp(*token, pc->p, len) == 0) {
6395 pc->tstart = pc->p;
6396 pc->tend = pc->p + len - 1;
6397 pc->p += len; pc->len -= len;
6398 pc->tline = pc->linenr;
6399 pc->tt = JIM_TT_EXPR_NUMBER;
6400 return JIM_OK;
6401 }
6402 }
6403 return JIM_ERR;
6404 }
6405
6406 int JimParseExprOperator(struct JimParserCtx *pc)
6407 {
6408 int i;
6409 int bestIdx = -1, bestLen = 0;
6410
6411 /* Try to get the longest match. */
6412 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6413 const char *opname;
6414 int oplen;
6415
6416 opname = Jim_ExprOperators[i].name;
6417 if (opname == NULL) continue;
6418 oplen = strlen(opname);
6419
6420 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6421 bestIdx = i;
6422 bestLen = oplen;
6423 }
6424 }
6425 if (bestIdx == -1) return JIM_ERR;
6426 pc->tstart = pc->p;
6427 pc->tend = pc->p + bestLen - 1;
6428 pc->p += bestLen; pc->len -= bestLen;
6429 pc->tline = pc->linenr;
6430 pc->tt = JIM_TT_EXPR_OPERATOR;
6431 return JIM_OK;
6432 }
6433
6434 static struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6435 {
6436 int i;
6437 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6438 if (Jim_ExprOperators[i].name &&
6439 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6440 return &Jim_ExprOperators[i];
6441 return NULL;
6442 }
6443
6444 static struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6445 {
6446 int i;
6447 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6448 if (Jim_ExprOperators[i].opcode == opcode)
6449 return &Jim_ExprOperators[i];
6450 return NULL;
6451 }
6452
6453 /* -----------------------------------------------------------------------------
6454 * Expression Object
6455 * ---------------------------------------------------------------------------*/
6456 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6457 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6458 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6459
6460 static Jim_ObjType exprObjType = {
6461 "expression",
6462 FreeExprInternalRep,
6463 DupExprInternalRep,
6464 NULL,
6465 JIM_TYPE_REFERENCES,
6466 };
6467
6468 /* Expr bytecode structure */
6469 typedef struct ExprByteCode {
6470 int *opcode; /* Integer array of opcodes. */
6471 Jim_Obj **obj; /* Array of associated Jim Objects. */
6472 int len; /* Bytecode length */
6473 int inUse; /* Used for sharing. */
6474 } ExprByteCode;
6475
6476 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6477 {
6478 int i;
6479 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6480
6481 expr->inUse--;
6482 if (expr->inUse != 0) return;
6483 for (i = 0; i < expr->len; i++)
6484 Jim_DecrRefCount(interp, expr->obj[i]);
6485 Jim_Free(expr->opcode);
6486 Jim_Free(expr->obj);
6487 Jim_Free(expr);
6488 }
6489
6490 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6491 {
6492 JIM_NOTUSED(interp);
6493 JIM_NOTUSED(srcPtr);
6494
6495 /* Just returns an simple string. */
6496 dupPtr->typePtr = NULL;
6497 }
6498
6499 /* Add a new instruction to an expression bytecode structure. */
6500 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6501 int opcode, char *str, int len)
6502 {
6503 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6504 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6505 expr->opcode[expr->len] = opcode;
6506 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6507 Jim_IncrRefCount(expr->obj[expr->len]);
6508 expr->len++;
6509 }
6510
6511 /* Check if an expr program looks correct. */
6512 static int ExprCheckCorrectness(ExprByteCode *expr)
6513 {
6514 int i;
6515 int stacklen = 0;
6516
6517 /* Try to check if there are stack underflows,
6518 * and make sure at the end of the program there is
6519 * a single result on the stack. */
6520 for (i = 0; i < expr->len; i++) {
6521 switch (expr->opcode[i]) {
6522 case JIM_EXPROP_NUMBER:
6523 case JIM_EXPROP_STRING:
6524 case JIM_EXPROP_SUBST:
6525 case JIM_EXPROP_VARIABLE:
6526 case JIM_EXPROP_DICTSUGAR:
6527 case JIM_EXPROP_COMMAND:
6528 stacklen++;
6529 break;
6530 case JIM_EXPROP_NOT:
6531 case JIM_EXPROP_BITNOT:
6532 case JIM_EXPROP_UNARYMINUS:
6533 case JIM_EXPROP_UNARYPLUS:
6534 /* Unary operations */
6535 if (stacklen < 1) return JIM_ERR;
6536 break;
6537 case JIM_EXPROP_ADD:
6538 case JIM_EXPROP_SUB:
6539 case JIM_EXPROP_MUL:
6540 case JIM_EXPROP_DIV:
6541 case JIM_EXPROP_MOD:
6542 case JIM_EXPROP_LT:
6543 case JIM_EXPROP_GT:
6544 case JIM_EXPROP_LTE:
6545 case JIM_EXPROP_GTE:
6546 case JIM_EXPROP_ROTL:
6547 case JIM_EXPROP_ROTR:
6548 case JIM_EXPROP_LSHIFT:
6549 case JIM_EXPROP_RSHIFT:
6550 case JIM_EXPROP_NUMEQ:
6551 case JIM_EXPROP_NUMNE:
6552 case JIM_EXPROP_STREQ:
6553 case JIM_EXPROP_STRNE:
6554 case JIM_EXPROP_BITAND:
6555 case JIM_EXPROP_BITXOR:
6556 case JIM_EXPROP_BITOR:
6557 case JIM_EXPROP_LOGICAND:
6558 case JIM_EXPROP_LOGICOR:
6559 case JIM_EXPROP_POW:
6560 /* binary operations */
6561 if (stacklen < 2) return JIM_ERR;
6562 stacklen--;
6563 break;
6564 default:
6565 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6566 break;
6567 }
6568 }
6569 if (stacklen != 1) return JIM_ERR;
6570 return JIM_OK;
6571 }
6572
6573 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6574 ScriptObj *topLevelScript)
6575 {
6576 int i;
6577
6578 return;
6579 for (i = 0; i < expr->len; i++) {
6580 Jim_Obj *foundObjPtr;
6581
6582 if (expr->obj[i] == NULL) continue;
6583 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6584 NULL, expr->obj[i]);
6585 if (foundObjPtr != NULL) {
6586 Jim_IncrRefCount(foundObjPtr);
6587 Jim_DecrRefCount(interp, expr->obj[i]);
6588 expr->obj[i] = foundObjPtr;
6589 }
6590 }
6591 }
6592
6593 /* This procedure converts every occurrence of || and && opereators
6594 * in lazy unary versions.
6595 *
6596 * a b || is converted into:
6597 *
6598 * a <offset> |L b |R
6599 *
6600 * a b && is converted into:
6601 *
6602 * a <offset> &L b &R
6603 *
6604 * "|L" checks if 'a' is true:
6605 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6606 * the opcode just after |R.
6607 * 2) if it is false does nothing.
6608 * "|R" checks if 'b' is true:
6609 * 1) if it is true pushes 1, otherwise pushes 0.
6610 *
6611 * "&L" checks if 'a' is true:
6612 * 1) if it is true does nothing.
6613 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6614 * the opcode just after &R
6615 * "&R" checks if 'a' is true:
6616 * if it is true pushes 1, otherwise pushes 0.
6617 */
6618 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6619 {
6620 while (1) {
6621 int index_t = -1, leftindex, arity, i, offset;
6622 Jim_ExprOperator *op;
6623
6624 /* Search for || or && */
6625 for (i = 0; i < expr->len; i++) {
6626 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6627 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6628 index_t = i;
6629 break;
6630 }
6631 }
6632 if (index_t == -1) return;
6633 /* Search for the end of the first operator */
6634 leftindex = index_t-1;
6635 arity = 1;
6636 while (arity) {
6637 switch (expr->opcode[leftindex]) {
6638 case JIM_EXPROP_NUMBER:
6639 case JIM_EXPROP_COMMAND:
6640 case JIM_EXPROP_VARIABLE:
6641 case JIM_EXPROP_DICTSUGAR:
6642 case JIM_EXPROP_SUBST:
6643 case JIM_EXPROP_STRING:
6644 break;
6645 default:
6646 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6647 if (op == NULL) {
6648 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6649 }
6650 arity += op->arity;
6651 break;
6652 }
6653 arity--;
6654 leftindex--;
6655 }
6656 leftindex++;
6657 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6658 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6659 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6660 sizeof(int)*(expr->len-leftindex));
6661 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6662 sizeof(Jim_Obj*)*(expr->len-leftindex));
6663 expr->len += 2;
6664 index_t += 2;
6665 offset = (index_t-leftindex)-1;
6666 Jim_DecrRefCount(interp, expr->obj[index_t]);
6667 if (expr->opcode[index_t] == JIM_EXPROP_LOGICAND) {
6668 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6669 expr->opcode[index_t] = JIM_EXPROP_LOGICAND_RIGHT;
6670 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6671 expr->obj[index_t] = Jim_NewStringObj(interp, "&R", -1);
6672 } else {
6673 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6674 expr->opcode[index_t] = JIM_EXPROP_LOGICOR_RIGHT;
6675 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6676 expr->obj[index_t] = Jim_NewStringObj(interp, "|R", -1);
6677 }
6678 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6679 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6680 Jim_IncrRefCount(expr->obj[index_t]);
6681 Jim_IncrRefCount(expr->obj[leftindex]);
6682 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6683 }
6684 }
6685
6686 /* This method takes the string representation of an expression
6687 * and generates a program for the Expr's stack-based VM. */
6688 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6689 {
6690 int exprTextLen;
6691 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6692 struct JimParserCtx parser;
6693 int i, shareLiterals;
6694 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6695 Jim_Stack stack;
6696 Jim_ExprOperator *op;
6697
6698 /* Perform literal sharing with the current procedure
6699 * running only if this expression appears to be not generated
6700 * at runtime. */
6701 shareLiterals = objPtr->typePtr == &sourceObjType;
6702
6703 expr->opcode = NULL;
6704 expr->obj = NULL;
6705 expr->len = 0;
6706 expr->inUse = 1;
6707
6708 Jim_InitStack(&stack);
6709 JimParserInit(&parser, exprText, exprTextLen, 1);
6710 while (!JimParserEof(&parser)) {
6711 char *token;
6712 int len, type;
6713
6714 if (JimParseExpression(&parser) != JIM_OK) {
6715 Jim_SetResultString(interp, "Syntax error in expression", -1);
6716 goto err;
6717 }
6718 token = JimParserGetToken(&parser, &len, &type, NULL);
6719 if (type == JIM_TT_EOL) {
6720 Jim_Free(token);
6721 break;
6722 }
6723 switch (type) {
6724 case JIM_TT_STR:
6725 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6726 break;
6727 case JIM_TT_ESC:
6728 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6729 break;
6730 case JIM_TT_VAR:
6731 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6732 break;
6733 case JIM_TT_DICTSUGAR:
6734 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6735 break;
6736 case JIM_TT_CMD:
6737 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6738 break;
6739 case JIM_TT_EXPR_NUMBER:
6740 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6741 break;
6742 case JIM_TT_EXPR_OPERATOR:
6743 op = JimExprOperatorInfo(token);
6744 while (1) {
6745 Jim_ExprOperator *stackTopOp;
6746
6747 if (Jim_StackPeek(&stack) != NULL) {
6748 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6749 } else {
6750 stackTopOp = NULL;
6751 }
6752 if (Jim_StackLen(&stack) && op->arity != 1 &&
6753 stackTopOp && stackTopOp->precedence >= op->precedence)
6754 {
6755 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6756 Jim_StackPeek(&stack), -1);
6757 Jim_StackPop(&stack);
6758 } else {
6759 break;
6760 }
6761 }
6762 Jim_StackPush(&stack, token);
6763 break;
6764 case JIM_TT_SUBEXPR_START:
6765 Jim_StackPush(&stack, Jim_StrDup("("));
6766 Jim_Free(token);
6767 break;
6768 case JIM_TT_SUBEXPR_END:
6769 {
6770 int found = 0;
6771 while (Jim_StackLen(&stack)) {
6772 char *opstr = Jim_StackPop(&stack);
6773 if (!strcmp(opstr, "(")) {
6774 Jim_Free(opstr);
6775 found = 1;
6776 break;
6777 }
6778 op = JimExprOperatorInfo(opstr);
6779 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6780 }
6781 if (!found) {
6782 Jim_SetResultString(interp,
6783 "Unexpected close parenthesis", -1);
6784 goto err;
6785 }
6786 }
6787 Jim_Free(token);
6788 break;
6789 default:
6790 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6791 break;
6792 }
6793 }
6794 while (Jim_StackLen(&stack)) {
6795 char *opstr = Jim_StackPop(&stack);
6796 op = JimExprOperatorInfo(opstr);
6797 if (op == NULL && !strcmp(opstr, "(")) {
6798 Jim_Free(opstr);
6799 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6800 goto err;
6801 }
6802 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6803 }
6804 /* Check program correctness. */
6805 if (ExprCheckCorrectness(expr) != JIM_OK) {
6806 Jim_SetResultString(interp, "Invalid expression", -1);
6807 goto err;
6808 }
6809
6810 /* Free the stack used for the compilation. */
6811 Jim_FreeStackElements(&stack, Jim_Free);
6812 Jim_FreeStack(&stack);
6813
6814 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6815 ExprMakeLazy(interp, expr);
6816
6817 /* Perform literal sharing */
6818 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6819 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6820 if (bodyObjPtr->typePtr == &scriptObjType) {
6821 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6822 ExprShareLiterals(interp, expr, bodyScript);
6823 }
6824 }
6825
6826 /* Free the old internal rep and set the new one. */
6827 Jim_FreeIntRep(interp, objPtr);
6828 Jim_SetIntRepPtr(objPtr, expr);
6829 objPtr->typePtr = &exprObjType;
6830 return JIM_OK;
6831
6832 err: /* we jump here on syntax/compile errors. */
6833 Jim_FreeStackElements(&stack, Jim_Free);
6834 Jim_FreeStack(&stack);
6835 Jim_Free(expr->opcode);
6836 for (i = 0; i < expr->len; i++) {
6837 Jim_DecrRefCount(interp,expr->obj[i]);
6838 }
6839 Jim_Free(expr->obj);
6840 Jim_Free(expr);
6841 return JIM_ERR;
6842 }
6843
6844 static ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6845 {
6846 if (objPtr->typePtr != &exprObjType) {
6847 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6848 return NULL;
6849 }
6850 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6851 }
6852
6853 /* -----------------------------------------------------------------------------
6854 * Expressions evaluation.
6855 * Jim uses a specialized stack-based virtual machine for expressions,
6856 * that takes advantage of the fact that expr's operators
6857 * can't be redefined.
6858 *
6859 * Jim_EvalExpression() uses the bytecode compiled by
6860 * SetExprFromAny() method of the "expression" object.
6861 *
6862 * On success a Tcl Object containing the result of the evaluation
6863 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6864 * returned.
6865 * On error the function returns a retcode != to JIM_OK and set a suitable
6866 * error on the interp.
6867 * ---------------------------------------------------------------------------*/
6868 #define JIM_EE_STATICSTACK_LEN 10
6869
6870 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6871 Jim_Obj **exprResultPtrPtr)
6872 {
6873 ExprByteCode *expr;
6874 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6875 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6876
6877 Jim_IncrRefCount(exprObjPtr);
6878 expr = Jim_GetExpression(interp, exprObjPtr);
6879 if (!expr) {
6880 Jim_DecrRefCount(interp, exprObjPtr);
6881 return JIM_ERR; /* error in expression. */
6882 }
6883 /* In order to avoid that the internal repr gets freed due to
6884 * shimmering of the exprObjPtr's object, we make the internal rep
6885 * shared. */
6886 expr->inUse++;
6887
6888 /* The stack-based expr VM itself */
6889
6890 /* Stack allocation. Expr programs have the feature that
6891 * a program of length N can't require a stack longer than
6892 * N. */
6893 if (expr->len > JIM_EE_STATICSTACK_LEN)
6894 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6895 else
6896 stack = staticStack;
6897
6898 /* Execute every istruction */
6899 for (i = 0; i < expr->len; i++) {
6900 Jim_Obj *A, *B, *objPtr;
6901 jim_wide wA, wB, wC;
6902 double dA, dB, dC;
6903 const char *sA, *sB;
6904 int Alen, Blen, retcode;
6905 int opcode = expr->opcode[i];
6906
6907 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6908 stack[stacklen++] = expr->obj[i];
6909 Jim_IncrRefCount(expr->obj[i]);
6910 } else if (opcode == JIM_EXPROP_VARIABLE) {
6911 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6912 if (objPtr == NULL) {
6913 error = 1;
6914 goto err;
6915 }
6916 stack[stacklen++] = objPtr;
6917 Jim_IncrRefCount(objPtr);
6918 } else if (opcode == JIM_EXPROP_SUBST) {
6919 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6920 &objPtr, JIM_NONE)) != JIM_OK)
6921 {
6922 error = 1;
6923 errRetCode = retcode;
6924 goto err;
6925 }
6926 stack[stacklen++] = objPtr;
6927 Jim_IncrRefCount(objPtr);
6928 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6929 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6930 if (objPtr == NULL) {
6931 error = 1;
6932 goto err;
6933 }
6934 stack[stacklen++] = objPtr;
6935 Jim_IncrRefCount(objPtr);
6936 } else if (opcode == JIM_EXPROP_COMMAND) {
6937 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6938 error = 1;
6939 errRetCode = retcode;
6940 goto err;
6941 }
6942 stack[stacklen++] = interp->result;
6943 Jim_IncrRefCount(interp->result);
6944 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6945 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6946 {
6947 /* Note that there isn't to increment the
6948 * refcount of objects. the references are moved
6949 * from stack to A and B. */
6950 B = stack[--stacklen];
6951 A = stack[--stacklen];
6952
6953 /* --- Integer --- */
6954 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6955 (B->typePtr == &doubleObjType && !B->bytes) ||
6956 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6957 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6958 goto trydouble;
6959 }
6960 Jim_DecrRefCount(interp, A);
6961 Jim_DecrRefCount(interp, B);
6962 switch (expr->opcode[i]) {
6963 case JIM_EXPROP_ADD: wC = wA + wB; break;
6964 case JIM_EXPROP_SUB: wC = wA-wB; break;
6965 case JIM_EXPROP_MUL: wC = wA*wB; break;
6966 case JIM_EXPROP_LT: wC = wA < wB; break;
6967 case JIM_EXPROP_GT: wC = wA > wB; break;
6968 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6969 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6970 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6971 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6972 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6973 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6974 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6975 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6976 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6977 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6978 case JIM_EXPROP_LOGICAND_LEFT:
6979 if (wA == 0) {
6980 i += (int)wB;
6981 wC = 0;
6982 } else {
6983 continue;
6984 }
6985 break;
6986 case JIM_EXPROP_LOGICOR_LEFT:
6987 if (wA != 0) {
6988 i += (int)wB;
6989 wC = 1;
6990 } else {
6991 continue;
6992 }
6993 break;
6994 case JIM_EXPROP_DIV:
6995 if (wB == 0) goto divbyzero;
6996 wC = wA/wB;
6997 break;
6998 case JIM_EXPROP_MOD:
6999 if (wB == 0) goto divbyzero;
7000 wC = wA%wB;
7001 break;
7002 case JIM_EXPROP_ROTL: {
7003 /* uint32_t would be better. But not everyone has inttypes.h?*/
7004 unsigned long uA = (unsigned long)wA;
7005 #ifdef _MSC_VER
7006 wC = _rotl(uA,(unsigned long)wB);
7007 #else
7008 const unsigned int S = sizeof(unsigned long) * 8;
7009 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7010 #endif
7011 break;
7012 }
7013 case JIM_EXPROP_ROTR: {
7014 unsigned long uA = (unsigned long)wA;
7015 #ifdef _MSC_VER
7016 wC = _rotr(uA,(unsigned long)wB);
7017 #else
7018 const unsigned int S = sizeof(unsigned long) * 8;
7019 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7020 #endif
7021 break;
7022 }
7023
7024 default:
7025 wC = 0; /* avoid gcc warning */
7026 break;
7027 }
7028 stack[stacklen] = Jim_NewIntObj(interp, wC);
7029 Jim_IncrRefCount(stack[stacklen]);
7030 stacklen++;
7031 continue;
7032 trydouble:
7033 /* --- Double --- */
7034 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7035 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7036
7037 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7038 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7039 opcode = JIM_EXPROP_STRNE;
7040 goto retry_as_string;
7041 }
7042 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7043 opcode = JIM_EXPROP_STREQ;
7044 goto retry_as_string;
7045 }
7046 Jim_DecrRefCount(interp, A);
7047 Jim_DecrRefCount(interp, B);
7048 error = 1;
7049 goto err;
7050 }
7051 Jim_DecrRefCount(interp, A);
7052 Jim_DecrRefCount(interp, B);
7053 switch (expr->opcode[i]) {
7054 case JIM_EXPROP_ROTL:
7055 case JIM_EXPROP_ROTR:
7056 case JIM_EXPROP_LSHIFT:
7057 case JIM_EXPROP_RSHIFT:
7058 case JIM_EXPROP_BITAND:
7059 case JIM_EXPROP_BITXOR:
7060 case JIM_EXPROP_BITOR:
7061 case JIM_EXPROP_MOD:
7062 case JIM_EXPROP_POW:
7063 Jim_SetResultString(interp,
7064 "Got floating-point value where integer was expected", -1);
7065 error = 1;
7066 goto err;
7067 case JIM_EXPROP_ADD: dC = dA + dB; break;
7068 case JIM_EXPROP_SUB: dC = dA-dB; break;
7069 case JIM_EXPROP_MUL: dC = dA*dB; break;
7070 case JIM_EXPROP_LT: dC = dA < dB; break;
7071 case JIM_EXPROP_GT: dC = dA > dB; break;
7072 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7073 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7074 /* FIXME comparing floats for equality/inequality is bad juju */
7075 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7076 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7077 case JIM_EXPROP_LOGICAND_LEFT:
7078 if (dA == 0) {
7079 i += (int)dB;
7080 dC = 0;
7081 } else {
7082 continue;
7083 }
7084 break;
7085 case JIM_EXPROP_LOGICOR_LEFT:
7086 if (dA != 0) {
7087 i += (int)dB;
7088 dC = 1;
7089 } else {
7090 continue;
7091 }
7092 break;
7093 case JIM_EXPROP_DIV:
7094 if (dB == 0) goto divbyzero;
7095 dC = dA/dB;
7096 break;
7097 default:
7098 dC = 0; /* avoid gcc warning */
7099 break;
7100 }
7101 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7102 Jim_IncrRefCount(stack[stacklen]);
7103 stacklen++;
7104 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7105 B = stack[--stacklen];
7106 A = stack[--stacklen];
7107 retry_as_string:
7108 sA = Jim_GetString(A, &Alen);
7109 sB = Jim_GetString(B, &Blen);
7110 switch (opcode) {
7111 case JIM_EXPROP_STREQ:
7112 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7113 wC = 1;
7114 else
7115 wC = 0;
7116 break;
7117 case JIM_EXPROP_STRNE:
7118 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7119 wC = 1;
7120 else
7121 wC = 0;
7122 break;
7123 default:
7124 wC = 0; /* avoid gcc warning */
7125 break;
7126 }
7127 Jim_DecrRefCount(interp, A);
7128 Jim_DecrRefCount(interp, B);
7129 stack[stacklen] = Jim_NewIntObj(interp, wC);
7130 Jim_IncrRefCount(stack[stacklen]);
7131 stacklen++;
7132 } else if (opcode == JIM_EXPROP_NOT ||
7133 opcode == JIM_EXPROP_BITNOT ||
7134 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7135 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7136 /* Note that there isn't to increment the
7137 * refcount of objects. the references are moved
7138 * from stack to A and B. */
7139 A = stack[--stacklen];
7140
7141 /* --- Integer --- */
7142 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7143 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7144 goto trydouble_unary;
7145 }
7146 Jim_DecrRefCount(interp, A);
7147 switch (expr->opcode[i]) {
7148 case JIM_EXPROP_NOT: wC = !wA; break;
7149 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7150 case JIM_EXPROP_LOGICAND_RIGHT:
7151 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7152 default:
7153 wC = 0; /* avoid gcc warning */
7154 break;
7155 }
7156 stack[stacklen] = Jim_NewIntObj(interp, wC);
7157 Jim_IncrRefCount(stack[stacklen]);
7158 stacklen++;
7159 continue;
7160 trydouble_unary:
7161 /* --- Double --- */
7162 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7163 Jim_DecrRefCount(interp, A);
7164 error = 1;
7165 goto err;
7166 }
7167 Jim_DecrRefCount(interp, A);
7168 switch (expr->opcode[i]) {
7169 case JIM_EXPROP_NOT: dC = !dA; break;
7170 case JIM_EXPROP_LOGICAND_RIGHT:
7171 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7172 case JIM_EXPROP_BITNOT:
7173 Jim_SetResultString(interp,
7174 "Got floating-point value where integer was expected", -1);
7175 error = 1;
7176 goto err;
7177 break;
7178 default:
7179 dC = 0; /* avoid gcc warning */
7180 break;
7181 }
7182 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7183 Jim_IncrRefCount(stack[stacklen]);
7184 stacklen++;
7185 } else {
7186 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7187 }
7188 }
7189 err:
7190 /* There is no need to decerement the inUse field because
7191 * this reference is transfered back into the exprObjPtr. */
7192 Jim_FreeIntRep(interp, exprObjPtr);
7193 exprObjPtr->typePtr = &exprObjType;
7194 Jim_SetIntRepPtr(exprObjPtr, expr);
7195 Jim_DecrRefCount(interp, exprObjPtr);
7196 if (!error) {
7197 *exprResultPtrPtr = stack[0];
7198 Jim_IncrRefCount(stack[0]);
7199 errRetCode = JIM_OK;
7200 }
7201 for (i = 0; i < stacklen; i++) {
7202 Jim_DecrRefCount(interp, stack[i]);
7203 }
7204 if (stack != staticStack)
7205 Jim_Free(stack);
7206 return errRetCode;
7207 divbyzero:
7208 error = 1;
7209 Jim_SetResultString(interp, "Division by zero", -1);
7210 goto err;
7211 }
7212
7213 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7214 {
7215 int retcode;
7216 jim_wide wideValue;
7217 double doubleValue;
7218 Jim_Obj *exprResultPtr;
7219
7220 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7221 if (retcode != JIM_OK)
7222 return retcode;
7223 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7224 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7225 {
7226 Jim_DecrRefCount(interp, exprResultPtr);
7227 return JIM_ERR;
7228 } else {
7229 Jim_DecrRefCount(interp, exprResultPtr);
7230 *boolPtr = doubleValue != 0;
7231 return JIM_OK;
7232 }
7233 }
7234 Jim_DecrRefCount(interp, exprResultPtr);
7235 *boolPtr = wideValue != 0;
7236 return JIM_OK;
7237 }
7238
7239 /* -----------------------------------------------------------------------------
7240 * ScanFormat String Object
7241 * ---------------------------------------------------------------------------*/
7242
7243 /* This Jim_Obj will held a parsed representation of a format string passed to
7244 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7245 * to be parsed in its entirely first and then, if correct, can be used for
7246 * scanning. To avoid endless re-parsing, the parsed representation will be
7247 * stored in an internal representation and re-used for performance reason. */
7248
7249 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7250 * scanformat string. This part will later be used to extract information
7251 * out from the string to be parsed by Jim_ScanString */
7252
7253 typedef struct ScanFmtPartDescr {
7254 char type; /* Type of conversion (e.g. c, d, f) */
7255 char modifier; /* Modify type (e.g. l - long, h - short */
7256 size_t width; /* Maximal width of input to be converted */
7257 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7258 char *arg; /* Specification of a CHARSET conversion */
7259 char *prefix; /* Prefix to be scanned literally before conversion */
7260 } ScanFmtPartDescr;
7261
7262 /* The ScanFmtStringObj will held the internal representation of a scanformat
7263 * string parsed and separated in part descriptions. Furthermore it contains
7264 * the original string representation of the scanformat string to allow for
7265 * fast update of the Jim_Obj's string representation part.
7266 *
7267 * As add-on the internal object representation add some scratch pad area
7268 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7269 * memory for purpose of string scanning.
7270 *
7271 * The error member points to a static allocated string in case of a mal-
7272 * formed scanformat string or it contains '0' (NULL) in case of a valid
7273 * parse representation.
7274 *
7275 * The whole memory of the internal representation is allocated as a single
7276 * area of memory that will be internally separated. So freeing and duplicating
7277 * of such an object is cheap */
7278
7279 typedef struct ScanFmtStringObj {
7280 jim_wide size; /* Size of internal repr in bytes */
7281 char *stringRep; /* Original string representation */
7282 size_t count; /* Number of ScanFmtPartDescr contained */
7283 size_t convCount; /* Number of conversions that will assign */
7284 size_t maxPos; /* Max position index if XPG3 is used */
7285 const char *error; /* Ptr to error text (NULL if no error */
7286 char *scratch; /* Some scratch pad used by Jim_ScanString */
7287 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7288 } ScanFmtStringObj;
7289
7290
7291 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7292 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7293 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7294
7295 static Jim_ObjType scanFmtStringObjType = {
7296 "scanformatstring",
7297 FreeScanFmtInternalRep,
7298 DupScanFmtInternalRep,
7299 UpdateStringOfScanFmt,
7300 JIM_TYPE_NONE,
7301 };
7302
7303 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7304 {
7305 JIM_NOTUSED(interp);
7306 Jim_Free((char*)objPtr->internalRep.ptr);
7307 objPtr->internalRep.ptr = 0;
7308 }
7309
7310 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7311 {
7312 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7313 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7314
7315 JIM_NOTUSED(interp);
7316 memcpy(newVec, srcPtr->internalRep.ptr, size);
7317 dupPtr->internalRep.ptr = newVec;
7318 dupPtr->typePtr = &scanFmtStringObjType;
7319 }
7320
7321 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7322 {
7323 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7324
7325 objPtr->bytes = Jim_StrDup(bytes);
7326 objPtr->length = strlen(bytes);
7327 }
7328
7329 /* SetScanFmtFromAny will parse a given string and create the internal
7330 * representation of the format specification. In case of an error
7331 * the error data member of the internal representation will be set
7332 * to an descriptive error text and the function will be left with
7333 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7334 * specification */
7335
7336 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7337 {
7338 ScanFmtStringObj *fmtObj;
7339 char *buffer;
7340 int maxCount, i, approxSize, lastPos = -1;
7341 const char *fmt = objPtr->bytes;
7342 int maxFmtLen = objPtr->length;
7343 const char *fmtEnd = fmt + maxFmtLen;
7344 int curr;
7345
7346 Jim_FreeIntRep(interp, objPtr);
7347 /* Count how many conversions could take place maximally */
7348 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7349 if (fmt[i] == '%')
7350 ++maxCount;
7351 /* Calculate an approximation of the memory necessary */
7352 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7353 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7354 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7355 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7356 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7357 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7358 + 1; /* safety byte */
7359 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7360 memset(fmtObj, 0, approxSize);
7361 fmtObj->size = approxSize;
7362 fmtObj->maxPos = 0;
7363 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7364 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7365 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7366 buffer = fmtObj->stringRep + maxFmtLen + 1;
7367 objPtr->internalRep.ptr = fmtObj;
7368 objPtr->typePtr = &scanFmtStringObjType;
7369 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7370 int width = 0, skip;
7371 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7372 fmtObj->count++;
7373 descr->width = 0; /* Assume width unspecified */
7374 /* Overread and store any "literal" prefix */
7375 if (*fmt != '%' || fmt[1] == '%') {
7376 descr->type = 0;
7377 descr->prefix = &buffer[i];
7378 for (; fmt < fmtEnd; ++fmt) {
7379 if (*fmt == '%') {
7380 if (fmt[1] != '%') break;
7381 ++fmt;
7382 }
7383 buffer[i++] = *fmt;
7384 }
7385 buffer[i++] = 0;
7386 }
7387 /* Skip the conversion introducing '%' sign */
7388 ++fmt;
7389 /* End reached due to non-conversion literal only? */
7390 if (fmt >= fmtEnd)
7391 goto done;
7392 descr->pos = 0; /* Assume "natural" positioning */
7393 if (*fmt == '*') {
7394 descr->pos = -1; /* Okay, conversion will not be assigned */
7395 ++fmt;
7396 } else
7397 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7398 /* Check if next token is a number (could be width or pos */
7399 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7400 fmt += skip;
7401 /* Was the number a XPG3 position specifier? */
7402 if (descr->pos != -1 && *fmt == '$') {
7403 int prev;
7404 ++fmt;
7405 descr->pos = width;
7406 width = 0;
7407 /* Look if "natural" postioning and XPG3 one was mixed */
7408 if ((lastPos == 0 && descr->pos > 0)
7409 || (lastPos > 0 && descr->pos == 0)) {
7410 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7411 return JIM_ERR;
7412 }
7413 /* Look if this position was already used */
7414 for (prev = 0; prev < curr; ++prev) {
7415 if (fmtObj->descr[prev].pos == -1) continue;
7416 if (fmtObj->descr[prev].pos == descr->pos) {
7417 fmtObj->error = "same \"%n$\" conversion specifier "
7418 "used more than once";
7419 return JIM_ERR;
7420 }
7421 }
7422 /* Try to find a width after the XPG3 specifier */
7423 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7424 descr->width = width;
7425 fmt += skip;
7426 }
7427 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7428 fmtObj->maxPos = descr->pos;
7429 } else {
7430 /* Number was not a XPG3, so it has to be a width */
7431 descr->width = width;
7432 }
7433 }
7434 /* If positioning mode was undetermined yet, fix this */
7435 if (lastPos == -1)
7436 lastPos = descr->pos;
7437 /* Handle CHARSET conversion type ... */
7438 if (*fmt == '[') {
7439 int swapped = 1, beg = i, end, j;
7440 descr->type = '[';
7441 descr->arg = &buffer[i];
7442 ++fmt;
7443 if (*fmt == '^') buffer[i++] = *fmt++;
7444 if (*fmt == ']') buffer[i++] = *fmt++;
7445 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7446 if (*fmt != ']') {
7447 fmtObj->error = "unmatched [ in format string";
7448 return JIM_ERR;
7449 }
7450 end = i;
7451 buffer[i++] = 0;
7452 /* In case a range fence was given "backwards", swap it */
7453 while (swapped) {
7454 swapped = 0;
7455 for (j = beg + 1; j < end-1; ++j) {
7456 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7457 char tmp = buffer[j-1];
7458 buffer[j-1] = buffer[j + 1];
7459 buffer[j + 1] = tmp;
7460 swapped = 1;
7461 }
7462 }
7463 }
7464 } else {
7465 /* Remember any valid modifier if given */
7466 if (strchr("hlL", *fmt) != 0)
7467 descr->modifier = tolower((int)*fmt++);
7468
7469 descr->type = *fmt;
7470 if (strchr("efgcsndoxui", *fmt) == 0) {
7471 fmtObj->error = "bad scan conversion character";
7472 return JIM_ERR;
7473 } else if (*fmt == 'c' && descr->width != 0) {
7474 fmtObj->error = "field width may not be specified in %c "
7475 "conversion";
7476 return JIM_ERR;
7477 } else if (*fmt == 'u' && descr->modifier == 'l') {
7478 fmtObj->error = "unsigned wide not supported";
7479 return JIM_ERR;
7480 }
7481 }
7482 curr++;
7483 }
7484 done:
7485 if (fmtObj->convCount == 0) {
7486 fmtObj->error = "no any conversion specifier given";
7487 return JIM_ERR;
7488 }
7489 return JIM_OK;
7490 }
7491
7492 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7493
7494 #define FormatGetCnvCount(_fo_) \
7495 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7496 #define FormatGetMaxPos(_fo_) \
7497 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7498 #define FormatGetError(_fo_) \
7499 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7500
7501 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7502 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7503 * bitvector implementation in Jim? */
7504
7505 static int JimTestBit(const char *bitvec, char ch)
7506 {
7507 div_t pos = div(ch-1, 8);
7508 return bitvec[pos.quot] & (1 << pos.rem);
7509 }
7510
7511 static void JimSetBit(char *bitvec, char ch)
7512 {
7513 div_t pos = div(ch-1, 8);
7514 bitvec[pos.quot] |= (1 << pos.rem);
7515 }
7516
7517 #if 0 /* currently not used */
7518 static void JimClearBit(char *bitvec, char ch)
7519 {
7520 div_t pos = div(ch-1, 8);
7521 bitvec[pos.quot] &= ~(1 << pos.rem);
7522 }
7523 #endif
7524
7525 /* JimScanAString is used to scan an unspecified string that ends with
7526 * next WS, or a string that is specified via a charset. The charset
7527 * is currently implemented in a way to only allow for usage with
7528 * ASCII. Whenever we will switch to UNICODE, another idea has to
7529 * be born :-/
7530 *
7531 * FIXME: Works only with ASCII */
7532
7533 static Jim_Obj *
7534 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7535 {
7536 size_t i;
7537 Jim_Obj *result;
7538 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7539 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7540
7541 /* First init charset to nothing or all, depending if a specified
7542 * or an unspecified string has to be parsed */
7543 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7544 if (sdescr) {
7545 /* There was a set description given, that means we are parsing
7546 * a specified string. So we have to build a corresponding
7547 * charset reflecting the description */
7548 int notFlag = 0;
7549 /* Should the set be negated at the end? */
7550 if (*sdescr == '^') {
7551 notFlag = 1;
7552 ++sdescr;
7553 }
7554 /* Here '-' is meant literally and not to define a range */
7555 if (*sdescr == '-') {
7556 JimSetBit(charset, '-');
7557 ++sdescr;
7558 }
7559 while (*sdescr) {
7560 if (sdescr[1] == '-' && sdescr[2] != 0) {
7561 /* Handle range definitions */
7562 int i_t;
7563 for (i_t = sdescr[0]; i_t <= sdescr[2]; ++i_t)
7564 JimSetBit(charset, (char)i_t);
7565 sdescr += 3;
7566 } else {
7567 /* Handle verbatim character definitions */
7568 JimSetBit(charset, *sdescr++);
7569 }
7570 }
7571 /* Negate the charset if there was a NOT given */
7572 for (i = 0; notFlag && i < sizeof(charset); ++i)
7573 charset[i] = ~charset[i];
7574 }
7575 /* And after all the mess above, the real work begin ... */
7576 while (str && *str) {
7577 if (!sdescr && isspace((int)*str))
7578 break; /* EOS via WS if unspecified */
7579 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7580 else break; /* EOS via mismatch if specified scanning */
7581 }
7582 *buffer = 0; /* Close the string properly ... */
7583 result = Jim_NewStringObj(interp, anchor, -1);
7584 Jim_Free(anchor); /* ... and free it afer usage */
7585 return result;
7586 }
7587
7588 /* ScanOneEntry will scan one entry out of the string passed as argument.
7589 * It use the sscanf() function for this task. After extracting and
7590 * converting of the value, the count of scanned characters will be
7591 * returned of -1 in case of no conversion tool place and string was
7592 * already scanned thru */
7593
7594 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7595 ScanFmtStringObj *fmtObj, long index_t, Jim_Obj **valObjPtr)
7596 {
7597 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7598 ? sizeof(jim_wide) \
7599 : sizeof(double))
7600 char buffer[MAX_SIZE];
7601 char *value = buffer;
7602 const char *tok;
7603 const ScanFmtPartDescr *descr = &fmtObj->descr[index_t];
7604 size_t sLen = strlen(&str[pos]), scanned = 0;
7605 size_t anchor = pos;
7606 int i;
7607
7608 /* First pessimiticly assume, we will not scan anything :-) */
7609 *valObjPtr = 0;
7610 if (descr->prefix) {
7611 /* There was a prefix given before the conversion, skip it and adjust
7612 * the string-to-be-parsed accordingly */
7613 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7614 /* If prefix require, skip WS */
7615 if (isspace((int)descr->prefix[i]))
7616 while (str[pos] && isspace((int)str[pos])) ++pos;
7617 else if (descr->prefix[i] != str[pos])
7618 break; /* Prefix do not match here, leave the loop */
7619 else
7620 ++pos; /* Prefix matched so far, next round */
7621 }
7622 if (str[pos] == 0)
7623 return -1; /* All of str consumed: EOF condition */
7624 else if (descr->prefix[i] != 0)
7625 return 0; /* Not whole prefix consumed, no conversion possible */
7626 }
7627 /* For all but following conversion, skip leading WS */
7628 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7629 while (isspace((int)str[pos])) ++pos;
7630 /* Determine how much skipped/scanned so far */
7631 scanned = pos - anchor;
7632 if (descr->type == 'n') {
7633 /* Return pseudo conversion means: how much scanned so far? */
7634 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7635 } else if (str[pos] == 0) {
7636 /* Cannot scan anything, as str is totally consumed */
7637 return -1;
7638 } else {
7639 /* Processing of conversions follows ... */
7640 if (descr->width > 0) {
7641 /* Do not try to scan as fas as possible but only the given width.
7642 * To ensure this, we copy the part that should be scanned. */
7643 size_t tLen = descr->width > sLen ? sLen : descr->width;
7644 tok = Jim_StrDupLen(&str[pos], tLen);
7645 } else {
7646 /* As no width was given, simply refer to the original string */
7647 tok = &str[pos];
7648 }
7649 switch (descr->type) {
7650 case 'c':
7651 *valObjPtr = Jim_NewIntObj(interp, *tok);
7652 scanned += 1;
7653 break;
7654 case 'd': case 'o': case 'x': case 'u': case 'i': {
7655 jim_wide jwvalue = 0;
7656 long lvalue = 0;
7657 char *endp; /* Position where the number finished */
7658 int base = descr->type == 'o' ? 8
7659 : descr->type == 'x' ? 16
7660 : descr->type == 'i' ? 0
7661 : 10;
7662
7663 do {
7664 /* Try to scan a number with the given base */
7665 if (descr->modifier == 'l')
7666 {
7667 #ifdef HAVE_LONG_LONG_INT
7668 jwvalue = JimStrtoll(tok, &endp, base),
7669 #else
7670 jwvalue = strtol(tok, &endp, base),
7671 #endif
7672 memcpy(value, &jwvalue, sizeof(jim_wide));
7673 }
7674 else
7675 {
7676 if (descr->type == 'u')
7677 lvalue = strtoul(tok, &endp, base);
7678 else
7679 lvalue = strtol(tok, &endp, base);
7680 memcpy(value, &lvalue, sizeof(lvalue));
7681 }
7682 /* If scanning failed, and base was undetermined, simply
7683 * put it to 10 and try once more. This should catch the
7684 * case where %i begin to parse a number prefix (e.g.
7685 * '0x' but no further digits follows. This will be
7686 * handled as a ZERO followed by a char 'x' by Tcl */
7687 if (endp == tok && base == 0) base = 10;
7688 else break;
7689 } while (1);
7690 if (endp != tok) {
7691 /* There was some number sucessfully scanned! */
7692 if (descr->modifier == 'l')
7693 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7694 else
7695 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7696 /* Adjust the number-of-chars scanned so far */
7697 scanned += endp - tok;
7698 } else {
7699 /* Nothing was scanned. We have to determine if this
7700 * happened due to e.g. prefix mismatch or input str
7701 * exhausted */
7702 scanned = *tok ? 0 : -1;
7703 }
7704 break;
7705 }
7706 case 's': case '[': {
7707 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7708 scanned += Jim_Length(*valObjPtr);
7709 break;
7710 }
7711 case 'e': case 'f': case 'g': {
7712 char *endp;
7713
7714 double dvalue = strtod(tok, &endp);
7715 memcpy(value, &dvalue, sizeof(double));
7716 if (endp != tok) {
7717 /* There was some number sucessfully scanned! */
7718 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7719 /* Adjust the number-of-chars scanned so far */
7720 scanned += endp - tok;
7721 } else {
7722 /* Nothing was scanned. We have to determine if this
7723 * happened due to e.g. prefix mismatch or input str
7724 * exhausted */
7725 scanned = *tok ? 0 : -1;
7726 }
7727 break;
7728 }
7729 }
7730 /* If a substring was allocated (due to pre-defined width) do not
7731 * forget to free it */
7732 if (tok != &str[pos])
7733 Jim_Free((char*)tok);
7734 }
7735 return scanned;
7736 }
7737
7738 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7739 * string and returns all converted (and not ignored) values in a list back
7740 * to the caller. If an error occured, a NULL pointer will be returned */
7741
7742 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7743 Jim_Obj *fmtObjPtr, int flags)
7744 {
7745 size_t i, pos;
7746 int scanned = 1;
7747 const char *str = Jim_GetString(strObjPtr, 0);
7748 Jim_Obj *resultList = 0;
7749 Jim_Obj **resultVec =NULL;
7750 int resultc;
7751 Jim_Obj *emptyStr = 0;
7752 ScanFmtStringObj *fmtObj;
7753
7754 /* If format specification is not an object, convert it! */
7755 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7756 SetScanFmtFromAny(interp, fmtObjPtr);
7757 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7758 /* Check if format specification was valid */
7759 if (fmtObj->error != 0) {
7760 if (flags & JIM_ERRMSG)
7761 Jim_SetResultString(interp, fmtObj->error, -1);
7762 return 0;
7763 }
7764 /* Allocate a new "shared" empty string for all unassigned conversions */
7765 emptyStr = Jim_NewEmptyStringObj(interp);
7766 Jim_IncrRefCount(emptyStr);
7767 /* Create a list and fill it with empty strings up to max specified XPG3 */
7768 resultList = Jim_NewListObj(interp, 0, 0);
7769 if (fmtObj->maxPos > 0) {
7770 for (i = 0; i < fmtObj->maxPos; ++i)
7771 Jim_ListAppendElement(interp, resultList, emptyStr);
7772 JimListGetElements(interp, resultList, &resultc, &resultVec);
7773 }
7774 /* Now handle every partial format description */
7775 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7776 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7777 Jim_Obj *value = 0;
7778 /* Only last type may be "literal" w/o conversion - skip it! */
7779 if (descr->type == 0) continue;
7780 /* As long as any conversion could be done, we will proceed */
7781 if (scanned > 0)
7782 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7783 /* In case our first try results in EOF, we will leave */
7784 if (scanned == -1 && i == 0)
7785 goto eof;
7786 /* Advance next pos-to-be-scanned for the amount scanned already */
7787 pos += scanned;
7788 /* value == 0 means no conversion took place so take empty string */
7789 if (value == 0)
7790 value = Jim_NewEmptyStringObj(interp);
7791 /* If value is a non-assignable one, skip it */
7792 if (descr->pos == -1) {
7793 Jim_FreeNewObj(interp, value);
7794 } else if (descr->pos == 0)
7795 /* Otherwise append it to the result list if no XPG3 was given */
7796 Jim_ListAppendElement(interp, resultList, value);
7797 else if (resultVec[descr->pos-1] == emptyStr) {
7798 /* But due to given XPG3, put the value into the corr. slot */
7799 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7800 Jim_IncrRefCount(value);
7801 resultVec[descr->pos-1] = value;
7802 } else {
7803 /* Otherwise, the slot was already used - free obj and ERROR */
7804 Jim_FreeNewObj(interp, value);
7805 goto err;
7806 }
7807 }
7808 Jim_DecrRefCount(interp, emptyStr);
7809 return resultList;
7810 eof:
7811 Jim_DecrRefCount(interp, emptyStr);
7812 Jim_FreeNewObj(interp, resultList);
7813 return (Jim_Obj*)EOF;
7814 err:
7815 Jim_DecrRefCount(interp, emptyStr);
7816 Jim_FreeNewObj(interp, resultList);
7817 return 0;
7818 }
7819
7820 /* -----------------------------------------------------------------------------
7821 * Pseudo Random Number Generation
7822 * ---------------------------------------------------------------------------*/
7823 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7824 int seedLen);
7825
7826 /* Initialize the sbox with the numbers from 0 to 255 */
7827 static void JimPrngInit(Jim_Interp *interp)
7828 {
7829 int i;
7830 unsigned int seed[256];
7831
7832 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7833 for (i = 0; i < 256; i++)
7834 seed[i] = (rand() ^ time(NULL) ^ clock());
7835 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7836 }
7837
7838 /* Generates N bytes of random data */
7839 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7840 {
7841 Jim_PrngState *prng;
7842 unsigned char *destByte = (unsigned char*) dest;
7843 unsigned int si, sj, x;
7844
7845 /* initialization, only needed the first time */
7846 if (interp->prngState == NULL)
7847 JimPrngInit(interp);
7848 prng = interp->prngState;
7849 /* generates 'len' bytes of pseudo-random numbers */
7850 for (x = 0; x < len; x++) {
7851 prng->i = (prng->i + 1) & 0xff;
7852 si = prng->sbox[prng->i];
7853 prng->j = (prng->j + si) & 0xff;
7854 sj = prng->sbox[prng->j];
7855 prng->sbox[prng->i] = sj;
7856 prng->sbox[prng->j] = si;
7857 *destByte++ = prng->sbox[(si + sj)&0xff];
7858 }
7859 }
7860
7861 /* Re-seed the generator with user-provided bytes */
7862 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7863 int seedLen)
7864 {
7865 int i;
7866 unsigned char buf[256];
7867 Jim_PrngState *prng;
7868
7869 /* initialization, only needed the first time */
7870 if (interp->prngState == NULL)
7871 JimPrngInit(interp);
7872 prng = interp->prngState;
7873
7874 /* Set the sbox[i] with i */
7875 for (i = 0; i < 256; i++)
7876 prng->sbox[i] = i;
7877 /* Now use the seed to perform a random permutation of the sbox */
7878 for (i = 0; i < seedLen; i++) {
7879 unsigned char t;
7880
7881 t = prng->sbox[i&0xFF];
7882 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7883 prng->sbox[seed[i]] = t;
7884 }
7885 prng->i = prng->j = 0;
7886 /* discard the first 256 bytes of stream. */
7887 JimRandomBytes(interp, buf, 256);
7888 }
7889
7890 /* -----------------------------------------------------------------------------
7891 * Dynamic libraries support (WIN32 not supported)
7892 * ---------------------------------------------------------------------------*/
7893
7894 #ifdef JIM_DYNLIB
7895 #ifdef WIN32
7896 #define RTLD_LAZY 0
7897 void * dlopen(const char *path, int mode)
7898 {
7899 JIM_NOTUSED(mode);
7900
7901 return (void *)LoadLibraryA(path);
7902 }
7903 int dlclose(void *handle)
7904 {
7905 FreeLibrary((HANDLE)handle);
7906 return 0;
7907 }
7908 void *dlsym(void *handle, const char *symbol)
7909 {
7910 return GetProcAddress((HMODULE)handle, symbol);
7911 }
7912 static char win32_dlerror_string[121];
7913 const char *dlerror(void)
7914 {
7915 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7916 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7917 return win32_dlerror_string;
7918 }
7919 #endif /* WIN32 */
7920
7921 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7922 {
7923 Jim_Obj *libPathObjPtr;
7924 int prefixc, i;
7925 void *handle;
7926 int (*onload)(Jim_Interp *interp);
7927
7928 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7929 if (libPathObjPtr == NULL) {
7930 prefixc = 0;
7931 libPathObjPtr = NULL;
7932 } else {
7933 Jim_IncrRefCount(libPathObjPtr);
7934 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7935 }
7936
7937 for (i = -1; i < prefixc; i++) {
7938 if (i < 0) {
7939 handle = dlopen(pathName, RTLD_LAZY);
7940 } else {
7941 FILE *fp;
7942 char buf[JIM_PATH_LEN];
7943 const char *prefix;
7944 int prefixlen;
7945 Jim_Obj *prefixObjPtr;
7946
7947 buf[0] = '\0';
7948 if (Jim_ListIndex(interp, libPathObjPtr, i,
7949 &prefixObjPtr, JIM_NONE) != JIM_OK)
7950 continue;
7951 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7952 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7953 continue;
7954 if (*pathName == '/') {
7955 strcpy(buf, pathName);
7956 }
7957 else if (prefixlen && prefix[prefixlen-1] == '/')
7958 sprintf(buf, "%s%s", prefix, pathName);
7959 else
7960 sprintf(buf, "%s/%s", prefix, pathName);
7961 fp = fopen(buf, "r");
7962 if (fp == NULL)
7963 continue;
7964 fclose(fp);
7965 handle = dlopen(buf, RTLD_LAZY);
7966 }
7967 if (handle == NULL) {
7968 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7969 Jim_AppendStrings(interp, Jim_GetResult(interp),
7970 "error loading extension \"", pathName,
7971 "\": ", dlerror(), NULL);
7972 if (i < 0)
7973 continue;
7974 goto err;
7975 }
7976 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7977 Jim_SetResultString(interp,
7978 "No Jim_OnLoad symbol found on extension", -1);
7979 goto err;
7980 }
7981 if (onload(interp) == JIM_ERR) {
7982 dlclose(handle);
7983 goto err;
7984 }
7985 Jim_SetEmptyResult(interp);
7986 if (libPathObjPtr != NULL)
7987 Jim_DecrRefCount(interp, libPathObjPtr);
7988 return JIM_OK;
7989 }
7990 err:
7991 if (libPathObjPtr != NULL)
7992 Jim_DecrRefCount(interp, libPathObjPtr);
7993 return JIM_ERR;
7994 }
7995 #else /* JIM_DYNLIB */
7996 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7997 {
7998 JIM_NOTUSED(interp);
7999 JIM_NOTUSED(pathName);
8000
8001 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
8002 return JIM_ERR;
8003 }
8004 #endif/* JIM_DYNLIB */
8005
8006 /* -----------------------------------------------------------------------------
8007 * Packages handling
8008 * ---------------------------------------------------------------------------*/
8009
8010 #define JIM_PKG_ANY_VERSION -1
8011
8012 /* Convert a string of the type "1.2" into an integer.
8013 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8014 * to the integer with value 102 */
8015 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8016 int *intPtr, int flags)
8017 {
8018 char *copy;
8019 jim_wide major, minor;
8020 char *majorStr, *minorStr, *p;
8021
8022 if (v[0] == '\0') {
8023 *intPtr = JIM_PKG_ANY_VERSION;
8024 return JIM_OK;
8025 }
8026
8027 copy = Jim_StrDup(v);
8028 p = strchr(copy, '.');
8029 if (p == NULL) goto badfmt;
8030 *p = '\0';
8031 majorStr = copy;
8032 minorStr = p + 1;
8033
8034 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8035 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8036 goto badfmt;
8037 *intPtr = (int)(major*100 + minor);
8038 Jim_Free(copy);
8039 return JIM_OK;
8040
8041 badfmt:
8042 Jim_Free(copy);
8043 if (flags & JIM_ERRMSG) {
8044 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8045 Jim_AppendStrings(interp, Jim_GetResult(interp),
8046 "invalid package version '", v, "'", NULL);
8047 }
8048 return JIM_ERR;
8049 }
8050
8051 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8052 static int JimPackageMatchVersion(int needed, int actual, int flags)
8053 {
8054 if (needed == JIM_PKG_ANY_VERSION) return 1;
8055 if (flags & JIM_MATCHVER_EXACT) {
8056 return needed == actual;
8057 } else {
8058 return needed/100 == actual/100 && (needed <= actual);
8059 }
8060 }
8061
8062 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8063 int flags)
8064 {
8065 int intVersion;
8066 /* Check if the version format is ok */
8067 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8068 return JIM_ERR;
8069 /* If the package was already provided returns an error. */
8070 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8071 if (flags & JIM_ERRMSG) {
8072 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8073 Jim_AppendStrings(interp, Jim_GetResult(interp),
8074 "package '", name, "' was already provided", NULL);
8075 }
8076 return JIM_ERR;
8077 }
8078 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8079 return JIM_OK;
8080 }
8081
8082 #ifndef JIM_ANSIC
8083
8084 #ifndef WIN32
8085 # include <sys/types.h>
8086 # include <dirent.h>
8087 #else
8088 # include <io.h>
8089 /* Posix dirent.h compatiblity layer for WIN32.
8090 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8091 * Copyright Salvatore Sanfilippo ,2005.
8092 *
8093 * Permission to use, copy, modify, and distribute this software and its
8094 * documentation for any purpose is hereby granted without fee, provided
8095 * that this copyright and permissions notice appear in all copies and
8096 * derivatives.
8097 *
8098 * This software is supplied "as is" without express or implied warranty.
8099 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8100 */
8101
8102 struct dirent {
8103 char *d_name;
8104 };
8105
8106 typedef struct DIR {
8107 long handle; /* -1 for failed rewind */
8108 struct _finddata_t info;
8109 struct dirent result; /* d_name null iff first time */
8110 char *name; /* null-terminated char string */
8111 } DIR;
8112
8113 DIR *opendir(const char *name)
8114 {
8115 DIR *dir = 0;
8116
8117 if (name && name[0]) {
8118 size_t base_length = strlen(name);
8119 const char *all = /* search pattern must end with suitable wildcard */
8120 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8121
8122 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8123 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8124 {
8125 strcat(strcpy(dir->name, name), all);
8126
8127 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8128 dir->result.d_name = 0;
8129 else { /* rollback */
8130 Jim_Free(dir->name);
8131 Jim_Free(dir);
8132 dir = 0;
8133 }
8134 } else { /* rollback */
8135 Jim_Free(dir);
8136 dir = 0;
8137 errno = ENOMEM;
8138 }
8139 } else {
8140 errno = EINVAL;
8141 }
8142 return dir;
8143 }
8144
8145 int closedir(DIR *dir)
8146 {
8147 int result = -1;
8148
8149 if (dir) {
8150 if (dir->handle != -1)
8151 result = _findclose(dir->handle);
8152 Jim_Free(dir->name);
8153 Jim_Free(dir);
8154 }
8155 if (result == -1) /* map all errors to EBADF */
8156 errno = EBADF;
8157 return result;
8158 }
8159
8160 struct dirent *readdir(DIR *dir)
8161 {
8162 struct dirent *result = 0;
8163
8164 if (dir && dir->handle != -1) {
8165 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8166 result = &dir->result;
8167 result->d_name = dir->info.name;
8168 }
8169 } else {
8170 errno = EBADF;
8171 }
8172 return result;
8173 }
8174
8175 #endif /* WIN32 */
8176
8177 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8178 int prefixc, const char *pkgName, int pkgVer, int flags)
8179 {
8180 int bestVer = -1, i;
8181 int pkgNameLen = strlen(pkgName);
8182 char *bestPackage = NULL;
8183 struct dirent *de;
8184
8185 for (i = 0; i < prefixc; i++) {
8186 DIR *dir;
8187 char buf[JIM_PATH_LEN];
8188 int prefixLen;
8189
8190 if (prefixes[i] == NULL) continue;
8191 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8192 buf[JIM_PATH_LEN-1] = '\0';
8193 prefixLen = strlen(buf);
8194 if (prefixLen && buf[prefixLen-1] == '/')
8195 buf[prefixLen-1] = '\0';
8196
8197 if ((dir = opendir(buf)) == NULL) continue;
8198 while ((de = readdir(dir)) != NULL) {
8199 char *fileName = de->d_name;
8200 int fileNameLen = strlen(fileName);
8201
8202 if (strncmp(fileName, "jim-", 4) == 0 &&
8203 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8204 *(fileName + 4+pkgNameLen) == '-' &&
8205 fileNameLen > 4 && /* note that this is not really useful */
8206 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8207 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8208 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8209 {
8210 char ver[6]; /* xx.yy < nulterm> */
8211 char *p = strrchr(fileName, '.');
8212 int verLen, fileVer;
8213
8214 verLen = p - (fileName + 4+pkgNameLen + 1);
8215 if (verLen < 3 || verLen > 5) continue;
8216 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8217 ver[verLen] = '\0';
8218 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8219 != JIM_OK) continue;
8220 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8221 (bestVer == -1 || bestVer < fileVer))
8222 {
8223 bestVer = fileVer;
8224 Jim_Free(bestPackage);
8225 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8226 sprintf(bestPackage, "%s/%s", buf, fileName);
8227 }
8228 }
8229 }
8230 closedir(dir);
8231 }
8232 return bestPackage;
8233 }
8234
8235 #else /* JIM_ANSIC */
8236
8237 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8238 int prefixc, const char *pkgName, int pkgVer, int flags)
8239 {
8240 JIM_NOTUSED(interp);
8241 JIM_NOTUSED(prefixes);
8242 JIM_NOTUSED(prefixc);
8243 JIM_NOTUSED(pkgName);
8244 JIM_NOTUSED(pkgVer);
8245 JIM_NOTUSED(flags);
8246 return NULL;
8247 }
8248
8249 #endif /* JIM_ANSIC */
8250
8251 /* Search for a suitable package under every dir specified by jim_libpath
8252 * and load it if possible. If a suitable package was loaded with success
8253 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8254 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8255 int flags)
8256 {
8257 Jim_Obj *libPathObjPtr;
8258 char **prefixes, *best;
8259 int prefixc, i, retCode = JIM_OK;
8260
8261 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8262 if (libPathObjPtr == NULL) {
8263 prefixc = 0;
8264 libPathObjPtr = NULL;
8265 } else {
8266 Jim_IncrRefCount(libPathObjPtr);
8267 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8268 }
8269
8270 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8271 for (i = 0; i < prefixc; i++) {
8272 Jim_Obj *prefixObjPtr;
8273 if (Jim_ListIndex(interp, libPathObjPtr, i,
8274 &prefixObjPtr, JIM_NONE) != JIM_OK)
8275 {
8276 prefixes[i] = NULL;
8277 continue;
8278 }
8279 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8280 }
8281 /* Scan every directory to find the "best" package. */
8282 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8283 if (best != NULL) {
8284 char *p = strrchr(best, '.');
8285 /* Try to load/source it */
8286 if (p && strcmp(p, ".tcl") == 0) {
8287 retCode = Jim_EvalFile(interp, best);
8288 } else {
8289 retCode = Jim_LoadLibrary(interp, best);
8290 }
8291 } else {
8292 retCode = JIM_ERR;
8293 }
8294 Jim_Free(best);
8295 for (i = 0; i < prefixc; i++)
8296 Jim_Free(prefixes[i]);
8297 Jim_Free(prefixes);
8298 if (libPathObjPtr)
8299 Jim_DecrRefCount(interp, libPathObjPtr);
8300 return retCode;
8301 }
8302
8303 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8304 const char *ver, int flags)
8305 {
8306 Jim_HashEntry *he;
8307 int requiredVer;
8308
8309 /* Start with an empty error string */
8310 Jim_SetResultString(interp, "", 0);
8311
8312 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8313 return NULL;
8314 he = Jim_FindHashEntry(&interp->packages, name);
8315 if (he == NULL) {
8316 /* Try to load the package. */
8317 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8318 he = Jim_FindHashEntry(&interp->packages, name);
8319 if (he == NULL) {
8320 return "?";
8321 }
8322 return he->val;
8323 }
8324 /* No way... return an error. */
8325 if (flags & JIM_ERRMSG) {
8326 int len;
8327 Jim_GetString(Jim_GetResult(interp), &len);
8328 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8329 "Can't find package '", name, "'", NULL);
8330 }
8331 return NULL;
8332 } else {
8333 int actualVer;
8334 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8335 != JIM_OK)
8336 {
8337 return NULL;
8338 }
8339 /* Check if version matches. */
8340 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8341 Jim_AppendStrings(interp, Jim_GetResult(interp),
8342 "Package '", name, "' already loaded, but with version ",
8343 he->val, NULL);
8344 return NULL;
8345 }
8346 return he->val;
8347 }
8348 }
8349
8350 /* -----------------------------------------------------------------------------
8351 * Eval
8352 * ---------------------------------------------------------------------------*/
8353 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8354 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8355
8356 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8357 Jim_Obj *const *argv);
8358
8359 /* Handle calls to the [unknown] command */
8360 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8361 {
8362 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8363 int retCode;
8364
8365 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8366 * done here
8367 */
8368 if (interp->unknown_called) {
8369 return JIM_ERR;
8370 }
8371
8372 /* If the [unknown] command does not exists returns
8373 * just now */
8374 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8375 return JIM_ERR;
8376
8377 /* The object interp->unknown just contains
8378 * the "unknown" string, it is used in order to
8379 * avoid to lookup the unknown command every time
8380 * but instread to cache the result. */
8381 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8382 v = sv;
8383 else
8384 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8385 /* Make a copy of the arguments vector, but shifted on
8386 * the right of one position. The command name of the
8387 * command will be instead the first argument of the
8388 * [unknonw] call. */
8389 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8390 v[0] = interp->unknown;
8391 /* Call it */
8392 interp->unknown_called++;
8393 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8394 interp->unknown_called--;
8395
8396 /* Clean up */
8397 if (v != sv)
8398 Jim_Free(v);
8399 return retCode;
8400 }
8401
8402 /* Eval the object vector 'objv' composed of 'objc' elements.
8403 * Every element is used as single argument.
8404 * Jim_EvalObj() will call this function every time its object
8405 * argument is of "list" type, with no string representation.
8406 *
8407 * This is possible because the string representation of a
8408 * list object generated by the UpdateStringOfList is made
8409 * in a way that ensures that every list element is a different
8410 * command argument. */
8411 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8412 {
8413 int i, retcode;
8414 Jim_Cmd *cmdPtr;
8415
8416 /* Incr refcount of arguments. */
8417 for (i = 0; i < objc; i++)
8418 Jim_IncrRefCount(objv[i]);
8419 /* Command lookup */
8420 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8421 if (cmdPtr == NULL) {
8422 retcode = JimUnknown(interp, objc, objv);
8423 } else {
8424 /* Call it -- Make sure result is an empty object. */
8425 Jim_SetEmptyResult(interp);
8426 if (cmdPtr->cmdProc) {
8427 interp->cmdPrivData = cmdPtr->privData;
8428 retcode = cmdPtr->cmdProc(interp, objc, objv);
8429 if (retcode == JIM_ERR_ADDSTACK) {
8430 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8431 retcode = JIM_ERR;
8432 }
8433 } else {
8434 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8435 if (retcode == JIM_ERR) {
8436 JimAppendStackTrace(interp,
8437 Jim_GetString(objv[0], NULL), "", 1);
8438 }
8439 }
8440 }
8441 /* Decr refcount of arguments and return the retcode */
8442 for (i = 0; i < objc; i++)
8443 Jim_DecrRefCount(interp, objv[i]);
8444 return retcode;
8445 }
8446
8447 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8448 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8449 * The returned object has refcount = 0. */
8450 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8451 int tokens, Jim_Obj **objPtrPtr)
8452 {
8453 int totlen = 0, i, retcode;
8454 Jim_Obj **intv;
8455 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8456 Jim_Obj *objPtr;
8457 char *s;
8458
8459 if (tokens <= JIM_EVAL_SINTV_LEN)
8460 intv = sintv;
8461 else
8462 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8463 tokens);
8464 /* Compute every token forming the argument
8465 * in the intv objects vector. */
8466 for (i = 0; i < tokens; i++) {
8467 switch (token[i].type) {
8468 case JIM_TT_ESC:
8469 case JIM_TT_STR:
8470 intv[i] = token[i].objPtr;
8471 break;
8472 case JIM_TT_VAR:
8473 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8474 if (!intv[i]) {
8475 retcode = JIM_ERR;
8476 goto err;
8477 }
8478 break;
8479 case JIM_TT_DICTSUGAR:
8480 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8481 if (!intv[i]) {
8482 retcode = JIM_ERR;
8483 goto err;
8484 }
8485 break;
8486 case JIM_TT_CMD:
8487 retcode = Jim_EvalObj(interp, token[i].objPtr);
8488 if (retcode != JIM_OK)
8489 goto err;
8490 intv[i] = Jim_GetResult(interp);
8491 break;
8492 default:
8493 Jim_Panic(interp,
8494 "default token type reached "
8495 "in Jim_InterpolateTokens().");
8496 break;
8497 }
8498 Jim_IncrRefCount(intv[i]);
8499 /* Make sure there is a valid
8500 * string rep, and add the string
8501 * length to the total legnth. */
8502 Jim_GetString(intv[i], NULL);
8503 totlen += intv[i]->length;
8504 }
8505 /* Concatenate every token in an unique
8506 * object. */
8507 objPtr = Jim_NewStringObjNoAlloc(interp,
8508 NULL, 0);
8509 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8510 objPtr->length = totlen;
8511 for (i = 0; i < tokens; i++) {
8512 memcpy(s, intv[i]->bytes, intv[i]->length);
8513 s += intv[i]->length;
8514 Jim_DecrRefCount(interp, intv[i]);
8515 }
8516 objPtr->bytes[totlen] = '\0';
8517 /* Free the intv vector if not static. */
8518 if (tokens > JIM_EVAL_SINTV_LEN)
8519 Jim_Free(intv);
8520 *objPtrPtr = objPtr;
8521 return JIM_OK;
8522 err:
8523 i--;
8524 for (; i >= 0; i--)
8525 Jim_DecrRefCount(interp, intv[i]);
8526 if (tokens > JIM_EVAL_SINTV_LEN)
8527 Jim_Free(intv);
8528 return retcode;
8529 }
8530
8531 /* Helper of Jim_EvalObj() to perform argument expansion.
8532 * Basically this function append an argument to 'argv'
8533 * (and increments argc by reference accordingly), performing
8534 * expansion of the list object if 'expand' is non-zero, or
8535 * just adding objPtr to argv if 'expand' is zero. */
8536 static void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8537 int *argcPtr, int expand, Jim_Obj *objPtr)
8538 {
8539 if (!expand) {
8540 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8541 /* refcount of objPtr not incremented because
8542 * we are actually transfering a reference from
8543 * the old 'argv' to the expanded one. */
8544 (*argv)[*argcPtr] = objPtr;
8545 (*argcPtr)++;
8546 } else {
8547 int len, i;
8548
8549 Jim_ListLength(interp, objPtr, &len);
8550 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8551 for (i = 0; i < len; i++) {
8552 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8553 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8554 (*argcPtr)++;
8555 }
8556 /* The original object reference is no longer needed,
8557 * after the expansion it is no longer present on
8558 * the argument vector, but the single elements are
8559 * in its place. */
8560 Jim_DecrRefCount(interp, objPtr);
8561 }
8562 }
8563
8564 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8565 {
8566 int i, j = 0, len;
8567 ScriptObj *script;
8568 ScriptToken *token;
8569 int *cs; /* command structure array */
8570 int retcode = JIM_OK;
8571 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8572
8573 interp->errorFlag = 0;
8574
8575 /* If the object is of type "list" and there is no
8576 * string representation for this object, we can call
8577 * a specialized version of Jim_EvalObj() */
8578 if (scriptObjPtr->typePtr == &listObjType &&
8579 scriptObjPtr->internalRep.listValue.len &&
8580 scriptObjPtr->bytes == NULL) {
8581 Jim_IncrRefCount(scriptObjPtr);
8582 retcode = Jim_EvalObjVector(interp,
8583 scriptObjPtr->internalRep.listValue.len,
8584 scriptObjPtr->internalRep.listValue.ele);
8585 Jim_DecrRefCount(interp, scriptObjPtr);
8586 return retcode;
8587 }
8588
8589 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8590 script = Jim_GetScript(interp, scriptObjPtr);
8591 /* Now we have to make sure the internal repr will not be
8592 * freed on shimmering.
8593 *
8594 * Think for example to this:
8595 *
8596 * set x {llength $x; ... some more code ...}; eval $x
8597 *
8598 * In order to preserve the internal rep, we increment the
8599 * inUse field of the script internal rep structure. */
8600 script->inUse++;
8601
8602 token = script->token;
8603 len = script->len;
8604 cs = script->cmdStruct;
8605 i = 0; /* 'i' is the current token index. */
8606
8607 /* Reset the interpreter result. This is useful to
8608 * return the emtpy result in the case of empty program. */
8609 Jim_SetEmptyResult(interp);
8610
8611 /* Execute every command sequentially, returns on
8612 * error (i.e. if a command does not return JIM_OK) */
8613 while (i < len) {
8614 int expand = 0;
8615 int argc = *cs++; /* Get the number of arguments */
8616 Jim_Cmd *cmd;
8617
8618 /* Set the expand flag if needed. */
8619 if (argc == -1) {
8620 expand++;
8621 argc = *cs++;
8622 }
8623 /* Allocate the arguments vector */
8624 if (argc <= JIM_EVAL_SARGV_LEN)
8625 argv = sargv;
8626 else
8627 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8628 /* Populate the arguments objects. */
8629 for (j = 0; j < argc; j++) {
8630 int tokens = *cs++;
8631
8632 /* tokens is negative if expansion is needed.
8633 * for this argument. */
8634 if (tokens < 0) {
8635 tokens = (-tokens)-1;
8636 i++;
8637 }
8638 if (tokens == 1) {
8639 /* Fast path if the token does not
8640 * need interpolation */
8641 switch (token[i].type) {
8642 case JIM_TT_ESC:
8643 case JIM_TT_STR:
8644 argv[j] = token[i].objPtr;
8645 break;
8646 case JIM_TT_VAR:
8647 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8648 JIM_ERRMSG);
8649 if (!tmpObjPtr) {
8650 retcode = JIM_ERR;
8651 goto err;
8652 }
8653 argv[j] = tmpObjPtr;
8654 break;
8655 case JIM_TT_DICTSUGAR:
8656 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8657 if (!tmpObjPtr) {
8658 retcode = JIM_ERR;
8659 goto err;
8660 }
8661 argv[j] = tmpObjPtr;
8662 break;
8663 case JIM_TT_CMD:
8664 retcode = Jim_EvalObj(interp, token[i].objPtr);
8665 if (retcode != JIM_OK)
8666 goto err;
8667 argv[j] = Jim_GetResult(interp);
8668 break;
8669 default:
8670 Jim_Panic(interp,
8671 "default token type reached "
8672 "in Jim_EvalObj().");
8673 break;
8674 }
8675 Jim_IncrRefCount(argv[j]);
8676 i += 2;
8677 } else {
8678 /* For interpolation we call an helper
8679 * function doing the work for us. */
8680 if ((retcode = Jim_InterpolateTokens(interp,
8681 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8682 {
8683 goto err;
8684 }
8685 argv[j] = tmpObjPtr;
8686 Jim_IncrRefCount(argv[j]);
8687 i += tokens + 1;
8688 }
8689 }
8690 /* Handle {expand} expansion */
8691 if (expand) {
8692 int *ecs = cs - argc;
8693 int eargc = 0;
8694 Jim_Obj **eargv = NULL;
8695
8696 for (j = 0; j < argc; j++) {
8697 Jim_ExpandArgument(interp, &eargv, &eargc,
8698 ecs[j] < 0, argv[j]);
8699 }
8700 if (argv != sargv)
8701 Jim_Free(argv);
8702 argc = eargc;
8703 argv = eargv;
8704 j = argc;
8705 if (argc == 0) {
8706 /* Nothing to do with zero args. */
8707 Jim_Free(eargv);
8708 continue;
8709 }
8710 }
8711 /* Lookup the command to call */
8712 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8713 if (cmd != NULL) {
8714 /* Call it -- Make sure result is an empty object. */
8715 Jim_SetEmptyResult(interp);
8716 if (cmd->cmdProc) {
8717 interp->cmdPrivData = cmd->privData;
8718 retcode = cmd->cmdProc(interp, argc, argv);
8719 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8720 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8721 retcode = JIM_ERR;
8722 }
8723 } else {
8724 retcode = JimCallProcedure(interp, cmd, argc, argv);
8725 if (retcode == JIM_ERR) {
8726 JimAppendStackTrace(interp,
8727 Jim_GetString(argv[0], NULL), script->fileName,
8728 token[i-argc*2].linenr);
8729 }
8730 }
8731 } else {
8732 /* Call [unknown] */
8733 retcode = JimUnknown(interp, argc, argv);
8734 if (retcode == JIM_ERR) {
8735 JimAppendStackTrace(interp,
8736 "", script->fileName,
8737 token[i-argc*2].linenr);
8738 }
8739 }
8740 if (retcode != JIM_OK) {
8741 i -= argc*2; /* point to the command name. */
8742 goto err;
8743 }
8744 /* Decrement the arguments count */
8745 for (j = 0; j < argc; j++) {
8746 Jim_DecrRefCount(interp, argv[j]);
8747 }
8748
8749 if (argv != sargv) {
8750 Jim_Free(argv);
8751 argv = NULL;
8752 }
8753 }
8754 /* Note that we don't have to decrement inUse, because the
8755 * following code transfers our use of the reference again to
8756 * the script object. */
8757 j = 0; /* on normal termination, the argv array is already
8758 Jim_DecrRefCount-ed. */
8759 err:
8760 /* Handle errors. */
8761 if (retcode == JIM_ERR && !interp->errorFlag) {
8762 interp->errorFlag = 1;
8763 JimSetErrorFileName(interp, script->fileName);
8764 JimSetErrorLineNumber(interp, token[i].linenr);
8765 JimResetStackTrace(interp);
8766 }
8767 Jim_FreeIntRep(interp, scriptObjPtr);
8768 scriptObjPtr->typePtr = &scriptObjType;
8769 Jim_SetIntRepPtr(scriptObjPtr, script);
8770 Jim_DecrRefCount(interp, scriptObjPtr);
8771 for (i = 0; i < j; i++) {
8772 Jim_DecrRefCount(interp, argv[i]);
8773 }
8774 if (argv != sargv)
8775 Jim_Free(argv);
8776 return retcode;
8777 }
8778
8779 /* Call a procedure implemented in Tcl.
8780 * It's possible to speed-up a lot this function, currently
8781 * the callframes are not cached, but allocated and
8782 * destroied every time. What is expecially costly is
8783 * to create/destroy the local vars hash table every time.
8784 *
8785 * This can be fixed just implementing callframes caching
8786 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8787 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8788 Jim_Obj *const *argv)
8789 {
8790 int i, retcode;
8791 Jim_CallFrame *callFramePtr;
8792 int num_args;
8793
8794 /* Check arity */
8795 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8796 argc > cmd->arityMax)) {
8797 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8798 Jim_AppendStrings(interp, objPtr,
8799 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8800 (cmd->arityMin > 1) ? " " : "",
8801 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8802 Jim_SetResult(interp, objPtr);
8803 return JIM_ERR;
8804 }
8805 /* Check if there are too nested calls */
8806 if (interp->numLevels == interp->maxNestingDepth) {
8807 Jim_SetResultString(interp,
8808 "Too many nested calls. Infinite recursion?", -1);
8809 return JIM_ERR;
8810 }
8811 /* Create a new callframe */
8812 callFramePtr = JimCreateCallFrame(interp);
8813 callFramePtr->parentCallFrame = interp->framePtr;
8814 callFramePtr->argv = argv;
8815 callFramePtr->argc = argc;
8816 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8817 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8818 callFramePtr->staticVars = cmd->staticVars;
8819 Jim_IncrRefCount(cmd->argListObjPtr);
8820 Jim_IncrRefCount(cmd->bodyObjPtr);
8821 interp->framePtr = callFramePtr;
8822 interp->numLevels ++;
8823
8824 /* Set arguments */
8825 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8826
8827 /* If last argument is 'args', don't set it here */
8828 if (cmd->arityMax == -1) {
8829 num_args--;
8830 }
8831
8832 for (i = 0; i < num_args; i++) {
8833 Jim_Obj *argObjPtr=NULL;
8834 Jim_Obj *nameObjPtr=NULL;
8835 Jim_Obj *valueObjPtr=NULL;
8836
8837 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8838 if (i + 1 >= cmd->arityMin) {
8839 /* The name is the first element of the list */
8840 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8841 }
8842 else {
8843 /* The element arg is the name */
8844 nameObjPtr = argObjPtr;
8845 }
8846
8847 if (i + 1 >= argc) {
8848 /* No more values, so use default */
8849 /* The value is the second element of the list */
8850 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8851 }
8852 else {
8853 valueObjPtr = argv[i + 1];
8854 }
8855 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8856 }
8857 /* Set optional arguments */
8858 if (cmd->arityMax == -1) {
8859 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8860
8861 i++;
8862 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8863 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8864 Jim_SetVariable(interp, objPtr, listObjPtr);
8865 }
8866 /* Eval the body */
8867 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8868
8869 /* Destroy the callframe */
8870 interp->numLevels --;
8871 interp->framePtr = interp->framePtr->parentCallFrame;
8872 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8873 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8874 } else {
8875 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8876 }
8877 /* Handle the JIM_EVAL return code */
8878 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8879 int savedLevel = interp->evalRetcodeLevel;
8880
8881 interp->evalRetcodeLevel = interp->numLevels;
8882 while (retcode == JIM_EVAL) {
8883 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8884 Jim_IncrRefCount(resultScriptObjPtr);
8885 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8886 Jim_DecrRefCount(interp, resultScriptObjPtr);
8887 }
8888 interp->evalRetcodeLevel = savedLevel;
8889 }
8890 /* Handle the JIM_RETURN return code */
8891 if (retcode == JIM_RETURN) {
8892 retcode = interp->returnCode;
8893 interp->returnCode = JIM_OK;
8894 }
8895 return retcode;
8896 }
8897
8898 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8899 {
8900 int retval;
8901 Jim_Obj *scriptObjPtr;
8902
8903 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8904 Jim_IncrRefCount(scriptObjPtr);
8905
8906
8907 if (filename) {
8908 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8909 }
8910
8911 retval = Jim_EvalObj(interp, scriptObjPtr);
8912 Jim_DecrRefCount(interp, scriptObjPtr);
8913 return retval;
8914 }
8915
8916 int Jim_Eval(Jim_Interp *interp, const char *script)
8917 {
8918 return Jim_Eval_Named(interp, script, NULL, 0);
8919 }
8920
8921
8922
8923 /* Execute script in the scope of the global level */
8924 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8925 {
8926 Jim_CallFrame *savedFramePtr;
8927 int retval;
8928
8929 savedFramePtr = interp->framePtr;
8930 interp->framePtr = interp->topFramePtr;
8931 retval = Jim_Eval(interp, script);
8932 interp->framePtr = savedFramePtr;
8933 return retval;
8934 }
8935
8936 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8937 {
8938 Jim_CallFrame *savedFramePtr;
8939 int retval;
8940
8941 savedFramePtr = interp->framePtr;
8942 interp->framePtr = interp->topFramePtr;
8943 retval = Jim_EvalObj(interp, scriptObjPtr);
8944 interp->framePtr = savedFramePtr;
8945 /* Try to report the error (if any) via the bgerror proc */
8946 if (retval != JIM_OK) {
8947 Jim_Obj *objv[2];
8948
8949 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8950 objv[1] = Jim_GetResult(interp);
8951 Jim_IncrRefCount(objv[0]);
8952 Jim_IncrRefCount(objv[1]);
8953 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8954 /* Report the error to stderr. */
8955 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8956 Jim_PrintErrorMessage(interp);
8957 }
8958 Jim_DecrRefCount(interp, objv[0]);
8959 Jim_DecrRefCount(interp, objv[1]);
8960 }
8961 return retval;
8962 }
8963
8964 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8965 {
8966 char *prg = NULL;
8967 FILE *fp;
8968 int nread, totread, maxlen, buflen;
8969 int retval;
8970 Jim_Obj *scriptObjPtr;
8971
8972 if ((fp = fopen(filename, "r")) == NULL) {
8973 const int cwd_len = 2048;
8974 char *cwd = malloc(cwd_len);
8975 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8976 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8977 Jim_AppendStrings(interp, Jim_GetResult(interp),
8978 "Error loading script \"", filename, "\"",
8979 " cwd: ", cwd,
8980 " err: ", strerror(errno), NULL);
8981 free(cwd);
8982 return JIM_ERR;
8983 }
8984 buflen = 1024;
8985 maxlen = totread = 0;
8986 while (1) {
8987 if (maxlen < totread + buflen + 1) {
8988 maxlen = totread + buflen + 1;
8989 prg = Jim_Realloc(prg, maxlen);
8990 }
8991 /* do not use Jim_fread() - this is really a file */
8992 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8993 totread += nread;
8994 }
8995 prg[totread] = '\0';
8996 /* do not use Jim_fclose() - this is really a file */
8997 fclose(fp);
8998
8999 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
9000 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
9001 Jim_IncrRefCount(scriptObjPtr);
9002 retval = Jim_EvalObj(interp, scriptObjPtr);
9003 Jim_DecrRefCount(interp, scriptObjPtr);
9004 return retval;
9005 }
9006
9007 /* -----------------------------------------------------------------------------
9008 * Subst
9009 * ---------------------------------------------------------------------------*/
9010 static int JimParseSubstStr(struct JimParserCtx *pc)
9011 {
9012 pc->tstart = pc->p;
9013 pc->tline = pc->linenr;
9014 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9015 pc->p++; pc->len--;
9016 }
9017 pc->tend = pc->p-1;
9018 pc->tt = JIM_TT_ESC;
9019 return JIM_OK;
9020 }
9021
9022 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9023 {
9024 int retval;
9025
9026 if (pc->len == 0) {
9027 pc->tstart = pc->tend = pc->p;
9028 pc->tline = pc->linenr;
9029 pc->tt = JIM_TT_EOL;
9030 pc->eof = 1;
9031 return JIM_OK;
9032 }
9033 switch (*pc->p) {
9034 case '[':
9035 retval = JimParseCmd(pc);
9036 if (flags & JIM_SUBST_NOCMD) {
9037 pc->tstart--;
9038 pc->tend++;
9039 pc->tt = (flags & JIM_SUBST_NOESC) ?
9040 JIM_TT_STR : JIM_TT_ESC;
9041 }
9042 return retval;
9043 break;
9044 case '$':
9045 if (JimParseVar(pc) == JIM_ERR) {
9046 pc->tstart = pc->tend = pc->p++; pc->len--;
9047 pc->tline = pc->linenr;
9048 pc->tt = JIM_TT_STR;
9049 } else {
9050 if (flags & JIM_SUBST_NOVAR) {
9051 pc->tstart--;
9052 if (flags & JIM_SUBST_NOESC)
9053 pc->tt = JIM_TT_STR;
9054 else
9055 pc->tt = JIM_TT_ESC;
9056 if (*pc->tstart == '{') {
9057 pc->tstart--;
9058 if (*(pc->tend + 1))
9059 pc->tend++;
9060 }
9061 }
9062 }
9063 break;
9064 default:
9065 retval = JimParseSubstStr(pc);
9066 if (flags & JIM_SUBST_NOESC)
9067 pc->tt = JIM_TT_STR;
9068 return retval;
9069 break;
9070 }
9071 return JIM_OK;
9072 }
9073
9074 /* The subst object type reuses most of the data structures and functions
9075 * of the script object. Script's data structures are a bit more complex
9076 * for what is needed for [subst]itution tasks, but the reuse helps to
9077 * deal with a single data structure at the cost of some more memory
9078 * usage for substitutions. */
9079 static Jim_ObjType substObjType = {
9080 "subst",
9081 FreeScriptInternalRep,
9082 DupScriptInternalRep,
9083 NULL,
9084 JIM_TYPE_REFERENCES,
9085 };
9086
9087 /* This method takes the string representation of an object
9088 * as a Tcl string where to perform [subst]itution, and generates
9089 * the pre-parsed internal representation. */
9090 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9091 {
9092 int scriptTextLen;
9093 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9094 struct JimParserCtx parser;
9095 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9096
9097 script->len = 0;
9098 script->csLen = 0;
9099 script->commands = 0;
9100 script->token = NULL;
9101 script->cmdStruct = NULL;
9102 script->inUse = 1;
9103 script->substFlags = flags;
9104 script->fileName = NULL;
9105
9106 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9107 while (1) {
9108 char *token;
9109 int len, type, linenr;
9110
9111 JimParseSubst(&parser, flags);
9112 if (JimParserEof(&parser)) break;
9113 token = JimParserGetToken(&parser, &len, &type, &linenr);
9114 ScriptObjAddToken(interp, script, token, len, type,
9115 NULL, linenr);
9116 }
9117 /* Free the old internal rep and set the new one. */
9118 Jim_FreeIntRep(interp, objPtr);
9119 Jim_SetIntRepPtr(objPtr, script);
9120 objPtr->typePtr = &scriptObjType;
9121 return JIM_OK;
9122 }
9123
9124 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9125 {
9126 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9127
9128 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9129 SetSubstFromAny(interp, objPtr, flags);
9130 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9131 }
9132
9133 /* Performs commands,variables,blackslashes substitution,
9134 * storing the result object (with refcount 0) into
9135 * resObjPtrPtr. */
9136 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9137 Jim_Obj **resObjPtrPtr, int flags)
9138 {
9139 ScriptObj *script;
9140 ScriptToken *token;
9141 int i, len, retcode = JIM_OK;
9142 Jim_Obj *resObjPtr, *savedResultObjPtr;
9143
9144 script = Jim_GetSubst(interp, substObjPtr, flags);
9145 #ifdef JIM_OPTIMIZATION
9146 /* Fast path for a very common case with array-alike syntax,
9147 * that's: $foo($bar) */
9148 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9149 Jim_Obj *varObjPtr = script->token[0].objPtr;
9150
9151 Jim_IncrRefCount(varObjPtr);
9152 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9153 if (resObjPtr == NULL) {
9154 Jim_DecrRefCount(interp, varObjPtr);
9155 return JIM_ERR;
9156 }
9157 Jim_DecrRefCount(interp, varObjPtr);
9158 *resObjPtrPtr = resObjPtr;
9159 return JIM_OK;
9160 }
9161 #endif
9162
9163 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9164 /* In order to preserve the internal rep, we increment the
9165 * inUse field of the script internal rep structure. */
9166 script->inUse++;
9167
9168 token = script->token;
9169 len = script->len;
9170
9171 /* Save the interp old result, to set it again before
9172 * to return. */
9173 savedResultObjPtr = interp->result;
9174 Jim_IncrRefCount(savedResultObjPtr);
9175
9176 /* Perform the substitution. Starts with an empty object
9177 * and adds every token (performing the appropriate
9178 * var/command/escape substitution). */
9179 resObjPtr = Jim_NewStringObj(interp, "", 0);
9180 for (i = 0; i < len; i++) {
9181 Jim_Obj *objPtr;
9182
9183 switch (token[i].type) {
9184 case JIM_TT_STR:
9185 case JIM_TT_ESC:
9186 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9187 break;
9188 case JIM_TT_VAR:
9189 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9190 if (objPtr == NULL) goto err;
9191 Jim_IncrRefCount(objPtr);
9192 Jim_AppendObj(interp, resObjPtr, objPtr);
9193 Jim_DecrRefCount(interp, objPtr);
9194 break;
9195 case JIM_TT_DICTSUGAR:
9196 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9197 if (!objPtr) {
9198 retcode = JIM_ERR;
9199 goto err;
9200 }
9201 break;
9202 case JIM_TT_CMD:
9203 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9204 goto err;
9205 Jim_AppendObj(interp, resObjPtr, interp->result);
9206 break;
9207 default:
9208 Jim_Panic(interp,
9209 "default token type (%d) reached "
9210 "in Jim_SubstObj().", token[i].type);
9211 break;
9212 }
9213 }
9214 ok:
9215 if (retcode == JIM_OK)
9216 Jim_SetResult(interp, savedResultObjPtr);
9217 Jim_DecrRefCount(interp, savedResultObjPtr);
9218 /* Note that we don't have to decrement inUse, because the
9219 * following code transfers our use of the reference again to
9220 * the script object. */
9221 Jim_FreeIntRep(interp, substObjPtr);
9222 substObjPtr->typePtr = &scriptObjType;
9223 Jim_SetIntRepPtr(substObjPtr, script);
9224 Jim_DecrRefCount(interp, substObjPtr);
9225 *resObjPtrPtr = resObjPtr;
9226 return retcode;
9227 err:
9228 Jim_FreeNewObj(interp, resObjPtr);
9229 retcode = JIM_ERR;
9230 goto ok;
9231 }
9232
9233 /* -----------------------------------------------------------------------------
9234 * API Input/Export functions
9235 * ---------------------------------------------------------------------------*/
9236
9237 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9238 {
9239 Jim_HashEntry *he;
9240
9241 he = Jim_FindHashEntry(&interp->stub, funcname);
9242 if (!he)
9243 return JIM_ERR;
9244 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9245 return JIM_OK;
9246 }
9247
9248 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9249 {
9250 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9251 }
9252
9253 #define JIM_REGISTER_API(name) \
9254 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9255
9256 void JimRegisterCoreApi(Jim_Interp *interp)
9257 {
9258 interp->getApiFuncPtr = Jim_GetApi;
9259 JIM_REGISTER_API(Alloc);
9260 JIM_REGISTER_API(Free);
9261 JIM_REGISTER_API(Eval);
9262 JIM_REGISTER_API(Eval_Named);
9263 JIM_REGISTER_API(EvalGlobal);
9264 JIM_REGISTER_API(EvalFile);
9265 JIM_REGISTER_API(EvalObj);
9266 JIM_REGISTER_API(EvalObjBackground);
9267 JIM_REGISTER_API(EvalObjVector);
9268 JIM_REGISTER_API(InitHashTable);
9269 JIM_REGISTER_API(ExpandHashTable);
9270 JIM_REGISTER_API(AddHashEntry);
9271 JIM_REGISTER_API(ReplaceHashEntry);
9272 JIM_REGISTER_API(DeleteHashEntry);
9273 JIM_REGISTER_API(FreeHashTable);
9274 JIM_REGISTER_API(FindHashEntry);
9275 JIM_REGISTER_API(ResizeHashTable);
9276 JIM_REGISTER_API(GetHashTableIterator);
9277 JIM_REGISTER_API(NextHashEntry);
9278 JIM_REGISTER_API(NewObj);
9279 JIM_REGISTER_API(FreeObj);
9280 JIM_REGISTER_API(InvalidateStringRep);
9281 JIM_REGISTER_API(InitStringRep);
9282 JIM_REGISTER_API(DuplicateObj);
9283 JIM_REGISTER_API(GetString);
9284 JIM_REGISTER_API(Length);
9285 JIM_REGISTER_API(InvalidateStringRep);
9286 JIM_REGISTER_API(NewStringObj);
9287 JIM_REGISTER_API(NewStringObjNoAlloc);
9288 JIM_REGISTER_API(AppendString);
9289 JIM_REGISTER_API(AppendString_sprintf);
9290 JIM_REGISTER_API(AppendObj);
9291 JIM_REGISTER_API(AppendStrings);
9292 JIM_REGISTER_API(StringEqObj);
9293 JIM_REGISTER_API(StringMatchObj);
9294 JIM_REGISTER_API(StringRangeObj);
9295 JIM_REGISTER_API(FormatString);
9296 JIM_REGISTER_API(CompareStringImmediate);
9297 JIM_REGISTER_API(NewReference);
9298 JIM_REGISTER_API(GetReference);
9299 JIM_REGISTER_API(SetFinalizer);
9300 JIM_REGISTER_API(GetFinalizer);
9301 JIM_REGISTER_API(CreateInterp);
9302 JIM_REGISTER_API(FreeInterp);
9303 JIM_REGISTER_API(GetExitCode);
9304 JIM_REGISTER_API(SetStdin);
9305 JIM_REGISTER_API(SetStdout);
9306 JIM_REGISTER_API(SetStderr);
9307 JIM_REGISTER_API(CreateCommand);
9308 JIM_REGISTER_API(CreateProcedure);
9309 JIM_REGISTER_API(DeleteCommand);
9310 JIM_REGISTER_API(RenameCommand);
9311 JIM_REGISTER_API(GetCommand);
9312 JIM_REGISTER_API(SetVariable);
9313 JIM_REGISTER_API(SetVariableStr);
9314 JIM_REGISTER_API(SetGlobalVariableStr);
9315 JIM_REGISTER_API(SetVariableStrWithStr);
9316 JIM_REGISTER_API(SetVariableLink);
9317 JIM_REGISTER_API(GetVariable);
9318 JIM_REGISTER_API(GetCallFrameByLevel);
9319 JIM_REGISTER_API(Collect);
9320 JIM_REGISTER_API(CollectIfNeeded);
9321 JIM_REGISTER_API(GetIndex);
9322 JIM_REGISTER_API(NewListObj);
9323 JIM_REGISTER_API(ListAppendElement);
9324 JIM_REGISTER_API(ListAppendList);
9325 JIM_REGISTER_API(ListLength);
9326 JIM_REGISTER_API(ListIndex);
9327 JIM_REGISTER_API(SetListIndex);
9328 JIM_REGISTER_API(ConcatObj);
9329 JIM_REGISTER_API(NewDictObj);
9330 JIM_REGISTER_API(DictKey);
9331 JIM_REGISTER_API(DictKeysVector);
9332 JIM_REGISTER_API(GetIndex);
9333 JIM_REGISTER_API(GetReturnCode);
9334 JIM_REGISTER_API(EvalExpression);
9335 JIM_REGISTER_API(GetBoolFromExpr);
9336 JIM_REGISTER_API(GetWide);
9337 JIM_REGISTER_API(GetLong);
9338 JIM_REGISTER_API(SetWide);
9339 JIM_REGISTER_API(NewIntObj);
9340 JIM_REGISTER_API(GetDouble);
9341 JIM_REGISTER_API(SetDouble);
9342 JIM_REGISTER_API(NewDoubleObj);
9343 JIM_REGISTER_API(WrongNumArgs);
9344 JIM_REGISTER_API(SetDictKeysVector);
9345 JIM_REGISTER_API(SubstObj);
9346 JIM_REGISTER_API(RegisterApi);
9347 JIM_REGISTER_API(PrintErrorMessage);
9348 JIM_REGISTER_API(InteractivePrompt);
9349 JIM_REGISTER_API(RegisterCoreCommands);
9350 JIM_REGISTER_API(GetSharedString);
9351 JIM_REGISTER_API(ReleaseSharedString);
9352 JIM_REGISTER_API(Panic);
9353 JIM_REGISTER_API(StrDup);
9354 JIM_REGISTER_API(UnsetVariable);
9355 JIM_REGISTER_API(GetVariableStr);
9356 JIM_REGISTER_API(GetGlobalVariable);
9357 JIM_REGISTER_API(GetGlobalVariableStr);
9358 JIM_REGISTER_API(GetAssocData);
9359 JIM_REGISTER_API(SetAssocData);
9360 JIM_REGISTER_API(DeleteAssocData);
9361 JIM_REGISTER_API(GetEnum);
9362 JIM_REGISTER_API(ScriptIsComplete);
9363 JIM_REGISTER_API(PackageRequire);
9364 JIM_REGISTER_API(PackageProvide);
9365 JIM_REGISTER_API(InitStack);
9366 JIM_REGISTER_API(FreeStack);
9367 JIM_REGISTER_API(StackLen);
9368 JIM_REGISTER_API(StackPush);
9369 JIM_REGISTER_API(StackPop);
9370 JIM_REGISTER_API(StackPeek);
9371 JIM_REGISTER_API(FreeStackElements);
9372 JIM_REGISTER_API(fprintf);
9373 JIM_REGISTER_API(vfprintf);
9374 JIM_REGISTER_API(fwrite);
9375 JIM_REGISTER_API(fread);
9376 JIM_REGISTER_API(fflush);
9377 JIM_REGISTER_API(fgets);
9378 JIM_REGISTER_API(GetNvp);
9379 JIM_REGISTER_API(Nvp_name2value);
9380 JIM_REGISTER_API(Nvp_name2value_simple);
9381 JIM_REGISTER_API(Nvp_name2value_obj);
9382 JIM_REGISTER_API(Nvp_name2value_nocase);
9383 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9384
9385 JIM_REGISTER_API(Nvp_value2name);
9386 JIM_REGISTER_API(Nvp_value2name_simple);
9387 JIM_REGISTER_API(Nvp_value2name_obj);
9388
9389 JIM_REGISTER_API(GetOpt_Setup);
9390 JIM_REGISTER_API(GetOpt_Debug);
9391 JIM_REGISTER_API(GetOpt_Obj);
9392 JIM_REGISTER_API(GetOpt_String);
9393 JIM_REGISTER_API(GetOpt_Double);
9394 JIM_REGISTER_API(GetOpt_Wide);
9395 JIM_REGISTER_API(GetOpt_Nvp);
9396 JIM_REGISTER_API(GetOpt_NvpUnknown);
9397 JIM_REGISTER_API(GetOpt_Enum);
9398
9399 JIM_REGISTER_API(Debug_ArgvString);
9400 JIM_REGISTER_API(SetResult_sprintf);
9401 JIM_REGISTER_API(SetResult_NvpUnknown);
9402
9403 }
9404
9405 /* -----------------------------------------------------------------------------
9406 * Core commands utility functions
9407 * ---------------------------------------------------------------------------*/
9408 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9409 const char *msg)
9410 {
9411 int i;
9412 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9413
9414 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9415 for (i = 0; i < argc; i++) {
9416 Jim_AppendObj(interp, objPtr, argv[i]);
9417 if (!(i + 1 == argc && msg[0] == '\0'))
9418 Jim_AppendString(interp, objPtr, " ", 1);
9419 }
9420 Jim_AppendString(interp, objPtr, msg, -1);
9421 Jim_AppendString(interp, objPtr, "\"", 1);
9422 Jim_SetResult(interp, objPtr);
9423 }
9424
9425 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9426 {
9427 Jim_HashTableIterator *htiter;
9428 Jim_HashEntry *he;
9429 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9430 const char *pattern;
9431 int patternLen=0;
9432
9433 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9434 htiter = Jim_GetHashTableIterator(&interp->commands);
9435 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9436 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9437 strlen((const char*)he->key), 0))
9438 continue;
9439 Jim_ListAppendElement(interp, listObjPtr,
9440 Jim_NewStringObj(interp, he->key, -1));
9441 }
9442 Jim_FreeHashTableIterator(htiter);
9443 return listObjPtr;
9444 }
9445
9446 #define JIM_VARLIST_GLOBALS 0
9447 #define JIM_VARLIST_LOCALS 1
9448 #define JIM_VARLIST_VARS 2
9449
9450 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9451 int mode)
9452 {
9453 Jim_HashTableIterator *htiter;
9454 Jim_HashEntry *he;
9455 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9456 const char *pattern;
9457 int patternLen=0;
9458
9459 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9460 if (mode == JIM_VARLIST_GLOBALS) {
9461 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9462 } else {
9463 /* For [info locals], if we are at top level an emtpy list
9464 * is returned. I don't agree, but we aim at compatibility (SS) */
9465 if (mode == JIM_VARLIST_LOCALS &&
9466 interp->framePtr == interp->topFramePtr)
9467 return listObjPtr;
9468 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9469 }
9470 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9471 Jim_Var *varPtr = (Jim_Var*) he->val;
9472 if (mode == JIM_VARLIST_LOCALS) {
9473 if (varPtr->linkFramePtr != NULL)
9474 continue;
9475 }
9476 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9477 strlen((const char*)he->key), 0))
9478 continue;
9479 Jim_ListAppendElement(interp, listObjPtr,
9480 Jim_NewStringObj(interp, he->key, -1));
9481 }
9482 Jim_FreeHashTableIterator(htiter);
9483 return listObjPtr;
9484 }
9485
9486 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9487 Jim_Obj **objPtrPtr)
9488 {
9489 Jim_CallFrame *targetCallFrame;
9490
9491 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9492 != JIM_OK)
9493 return JIM_ERR;
9494 /* No proc call at toplevel callframe */
9495 if (targetCallFrame == interp->topFramePtr) {
9496 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9497 Jim_AppendStrings(interp, Jim_GetResult(interp),
9498 "bad level \"",
9499 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9500 return JIM_ERR;
9501 }
9502 *objPtrPtr = Jim_NewListObj(interp,
9503 targetCallFrame->argv,
9504 targetCallFrame->argc);
9505 return JIM_OK;
9506 }
9507
9508 /* -----------------------------------------------------------------------------
9509 * Core commands
9510 * ---------------------------------------------------------------------------*/
9511
9512 /* fake [puts] -- not the real puts, just for debugging. */
9513 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9514 Jim_Obj *const *argv)
9515 {
9516 const char *str;
9517 int len, nonewline = 0;
9518
9519 if (argc != 2 && argc != 3) {
9520 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9521 return JIM_ERR;
9522 }
9523 if (argc == 3) {
9524 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9525 {
9526 Jim_SetResultString(interp, "The second argument must "
9527 "be -nonewline", -1);
9528 return JIM_OK;
9529 } else {
9530 nonewline = 1;
9531 argv++;
9532 }
9533 }
9534 str = Jim_GetString(argv[1], &len);
9535 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9536 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9537 return JIM_OK;
9538 }
9539
9540 /* Helper for [+] and [*] */
9541 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9542 Jim_Obj *const *argv, int op)
9543 {
9544 jim_wide wideValue, res;
9545 double doubleValue, doubleRes;
9546 int i;
9547
9548 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9549
9550 for (i = 1; i < argc; i++) {
9551 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9552 goto trydouble;
9553 if (op == JIM_EXPROP_ADD)
9554 res += wideValue;
9555 else
9556 res *= wideValue;
9557 }
9558 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9559 return JIM_OK;
9560 trydouble:
9561 doubleRes = (double) res;
9562 for (;i < argc; i++) {
9563 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9564 return JIM_ERR;
9565 if (op == JIM_EXPROP_ADD)
9566 doubleRes += doubleValue;
9567 else
9568 doubleRes *= doubleValue;
9569 }
9570 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9571 return JIM_OK;
9572 }
9573
9574 /* Helper for [-] and [/] */
9575 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9576 Jim_Obj *const *argv, int op)
9577 {
9578 jim_wide wideValue, res = 0;
9579 double doubleValue, doubleRes = 0;
9580 int i = 2;
9581
9582 if (argc < 2) {
9583 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9584 return JIM_ERR;
9585 } else if (argc == 2) {
9586 /* The arity = 2 case is different. For [- x] returns -x,
9587 * while [/ x] returns 1/x. */
9588 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9589 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9590 JIM_OK)
9591 {
9592 return JIM_ERR;
9593 } else {
9594 if (op == JIM_EXPROP_SUB)
9595 doubleRes = -doubleValue;
9596 else
9597 doubleRes = 1.0/doubleValue;
9598 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9599 doubleRes));
9600 return JIM_OK;
9601 }
9602 }
9603 if (op == JIM_EXPROP_SUB) {
9604 res = -wideValue;
9605 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9606 } else {
9607 doubleRes = 1.0/wideValue;
9608 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9609 doubleRes));
9610 }
9611 return JIM_OK;
9612 } else {
9613 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9614 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9615 != JIM_OK) {
9616 return JIM_ERR;
9617 } else {
9618 goto trydouble;
9619 }
9620 }
9621 }
9622 for (i = 2; i < argc; i++) {
9623 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9624 doubleRes = (double) res;
9625 goto trydouble;
9626 }
9627 if (op == JIM_EXPROP_SUB)
9628 res -= wideValue;
9629 else
9630 res /= wideValue;
9631 }
9632 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9633 return JIM_OK;
9634 trydouble:
9635 for (;i < argc; i++) {
9636 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9637 return JIM_ERR;
9638 if (op == JIM_EXPROP_SUB)
9639 doubleRes -= doubleValue;
9640 else
9641 doubleRes /= doubleValue;
9642 }
9643 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9644 return JIM_OK;
9645 }
9646
9647
9648 /* [+] */
9649 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9650 Jim_Obj *const *argv)
9651 {
9652 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9653 }
9654
9655 /* [*] */
9656 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9657 Jim_Obj *const *argv)
9658 {
9659 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9660 }
9661
9662 /* [-] */
9663 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9664 Jim_Obj *const *argv)
9665 {
9666 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9667 }
9668
9669 /* [/] */
9670 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9671 Jim_Obj *const *argv)
9672 {
9673 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9674 }
9675
9676 /* [set] */
9677 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9678 Jim_Obj *const *argv)
9679 {
9680 if (argc != 2 && argc != 3) {
9681 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9682 return JIM_ERR;
9683 }
9684 if (argc == 2) {
9685 Jim_Obj *objPtr;
9686 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9687 if (!objPtr)
9688 return JIM_ERR;
9689 Jim_SetResult(interp, objPtr);
9690 return JIM_OK;
9691 }
9692 /* argc == 3 case. */
9693 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9694 return JIM_ERR;
9695 Jim_SetResult(interp, argv[2]);
9696 return JIM_OK;
9697 }
9698
9699 /* [unset] */
9700 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9701 Jim_Obj *const *argv)
9702 {
9703 int i;
9704
9705 if (argc < 2) {
9706 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9707 return JIM_ERR;
9708 }
9709 for (i = 1; i < argc; i++) {
9710 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9711 return JIM_ERR;
9712 }
9713 return JIM_OK;
9714 }
9715
9716 /* [incr] */
9717 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9718 Jim_Obj *const *argv)
9719 {
9720 jim_wide wideValue, increment = 1;
9721 Jim_Obj *intObjPtr;
9722
9723 if (argc != 2 && argc != 3) {
9724 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9725 return JIM_ERR;
9726 }
9727 if (argc == 3) {
9728 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9729 return JIM_ERR;
9730 }
9731 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9732 if (!intObjPtr) return JIM_ERR;
9733 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9734 return JIM_ERR;
9735 if (Jim_IsShared(intObjPtr)) {
9736 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9737 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9738 Jim_FreeNewObj(interp, intObjPtr);
9739 return JIM_ERR;
9740 }
9741 } else {
9742 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9743 /* The following step is required in order to invalidate the
9744 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9745 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9746 return JIM_ERR;
9747 }
9748 }
9749 Jim_SetResult(interp, intObjPtr);
9750 return JIM_OK;
9751 }
9752
9753 /* [while] */
9754 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9755 Jim_Obj *const *argv)
9756 {
9757 if (argc != 3) {
9758 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9759 return JIM_ERR;
9760 }
9761 /* Try to run a specialized version of while if the expression
9762 * is in one of the following forms:
9763 *
9764 * $a < CONST, $a < $b
9765 * $a <= CONST, $a <= $b
9766 * $a > CONST, $a > $b
9767 * $a >= CONST, $a >= $b
9768 * $a != CONST, $a != $b
9769 * $a == CONST, $a == $b
9770 * $a
9771 * !$a
9772 * CONST
9773 */
9774
9775 #ifdef JIM_OPTIMIZATION
9776 {
9777 ExprByteCode *expr;
9778 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9779 int exprLen, retval;
9780
9781 /* STEP 1 -- Check if there are the conditions to run the specialized
9782 * version of while */
9783
9784 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9785 if (expr->len <= 0 || expr->len > 3) goto noopt;
9786 switch (expr->len) {
9787 case 1:
9788 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9789 expr->opcode[0] != JIM_EXPROP_NUMBER)
9790 goto noopt;
9791 break;
9792 case 2:
9793 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9794 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9795 goto noopt;
9796 break;
9797 case 3:
9798 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9799 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9800 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9801 goto noopt;
9802 switch (expr->opcode[2]) {
9803 case JIM_EXPROP_LT:
9804 case JIM_EXPROP_LTE:
9805 case JIM_EXPROP_GT:
9806 case JIM_EXPROP_GTE:
9807 case JIM_EXPROP_NUMEQ:
9808 case JIM_EXPROP_NUMNE:
9809 /* nothing to do */
9810 break;
9811 default:
9812 goto noopt;
9813 }
9814 break;
9815 default:
9816 Jim_Panic(interp,
9817 "Unexpected default reached in Jim_WhileCoreCommand()");
9818 break;
9819 }
9820
9821 /* STEP 2 -- conditions meet. Initialization. Take different
9822 * branches for different expression lengths. */
9823 exprLen = expr->len;
9824
9825 if (exprLen == 1) {
9826 jim_wide wideValue=0;
9827
9828 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9829 varAObjPtr = expr->obj[0];
9830 Jim_IncrRefCount(varAObjPtr);
9831 } else {
9832 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9833 goto noopt;
9834 }
9835 while (1) {
9836 if (varAObjPtr) {
9837 if (!(objPtr =
9838 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9839 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9840 {
9841 Jim_DecrRefCount(interp, varAObjPtr);
9842 goto noopt;
9843 }
9844 }
9845 if (!wideValue) break;
9846 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9847 switch (retval) {
9848 case JIM_BREAK:
9849 if (varAObjPtr)
9850 Jim_DecrRefCount(interp, varAObjPtr);
9851 goto out;
9852 break;
9853 case JIM_CONTINUE:
9854 continue;
9855 break;
9856 default:
9857 if (varAObjPtr)
9858 Jim_DecrRefCount(interp, varAObjPtr);
9859 return retval;
9860 }
9861 }
9862 }
9863 if (varAObjPtr)
9864 Jim_DecrRefCount(interp, varAObjPtr);
9865 } else if (exprLen == 3) {
9866 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9867 int cmpType = expr->opcode[2];
9868
9869 varAObjPtr = expr->obj[0];
9870 Jim_IncrRefCount(varAObjPtr);
9871 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9872 varBObjPtr = expr->obj[1];
9873 Jim_IncrRefCount(varBObjPtr);
9874 } else {
9875 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9876 goto noopt;
9877 }
9878 while (1) {
9879 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9880 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9881 {
9882 Jim_DecrRefCount(interp, varAObjPtr);
9883 if (varBObjPtr)
9884 Jim_DecrRefCount(interp, varBObjPtr);
9885 goto noopt;
9886 }
9887 if (varBObjPtr) {
9888 if (!(objPtr =
9889 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9890 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9891 {
9892 Jim_DecrRefCount(interp, varAObjPtr);
9893 Jim_DecrRefCount(interp, varBObjPtr);
9894 goto noopt;
9895 }
9896 }
9897 switch (cmpType) {
9898 case JIM_EXPROP_LT:
9899 cmpRes = wideValueA < wideValueB; break;
9900 case JIM_EXPROP_LTE:
9901 cmpRes = wideValueA <= wideValueB; break;
9902 case JIM_EXPROP_GT:
9903 cmpRes = wideValueA > wideValueB; break;
9904 case JIM_EXPROP_GTE:
9905 cmpRes = wideValueA >= wideValueB; break;
9906 case JIM_EXPROP_NUMEQ:
9907 cmpRes = wideValueA == wideValueB; break;
9908 case JIM_EXPROP_NUMNE:
9909 cmpRes = wideValueA != wideValueB; break;
9910 }
9911 if (!cmpRes) break;
9912 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9913 switch (retval) {
9914 case JIM_BREAK:
9915 Jim_DecrRefCount(interp, varAObjPtr);
9916 if (varBObjPtr)
9917 Jim_DecrRefCount(interp, varBObjPtr);
9918 goto out;
9919 break;
9920 case JIM_CONTINUE:
9921 continue;
9922 break;
9923 default:
9924 Jim_DecrRefCount(interp, varAObjPtr);
9925 if (varBObjPtr)
9926 Jim_DecrRefCount(interp, varBObjPtr);
9927 return retval;
9928 }
9929 }
9930 }
9931 Jim_DecrRefCount(interp, varAObjPtr);
9932 if (varBObjPtr)
9933 Jim_DecrRefCount(interp, varBObjPtr);
9934 } else {
9935 /* TODO: case for len == 2 */
9936 goto noopt;
9937 }
9938 Jim_SetEmptyResult(interp);
9939 return JIM_OK;
9940 }
9941 noopt:
9942 #endif
9943
9944 /* The general purpose implementation of while starts here */
9945 while (1) {
9946 int local_boolean, retval;
9947
9948 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9949 &local_boolean)) != JIM_OK)
9950 return retval;
9951 if (!local_boolean) break;
9952 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9953 switch (retval) {
9954 case JIM_BREAK:
9955 goto out;
9956 break;
9957 case JIM_CONTINUE:
9958 continue;
9959 break;
9960 default:
9961 return retval;
9962 }
9963 }
9964 }
9965 out:
9966 Jim_SetEmptyResult(interp);
9967 return JIM_OK;
9968 }
9969
9970 /* [for] */
9971 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9972 Jim_Obj *const *argv)
9973 {
9974 int retval;
9975
9976 if (argc != 5) {
9977 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9978 return JIM_ERR;
9979 }
9980 /* Check if the for is on the form:
9981 * for {set i CONST} {$i < CONST} {incr i}
9982 * for {set i CONST} {$i < $j} {incr i}
9983 * for {set i CONST} {$i <= CONST} {incr i}
9984 * for {set i CONST} {$i <= $j} {incr i}
9985 * XXX: NOTE: if variable traces are implemented, this optimization
9986 * need to be modified to check for the proc epoch at every variable
9987 * update. */
9988 #ifdef JIM_OPTIMIZATION
9989 {
9990 ScriptObj *initScript, *incrScript;
9991 ExprByteCode *expr;
9992 jim_wide start, stop=0, currentVal;
9993 unsigned jim_wide procEpoch = interp->procEpoch;
9994 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9995 int cmpType;
9996 struct Jim_Cmd *cmdPtr;
9997
9998 /* Do it only if there aren't shared arguments */
9999 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
10000 goto evalstart;
10001 initScript = Jim_GetScript(interp, argv[1]);
10002 expr = Jim_GetExpression(interp, argv[2]);
10003 incrScript = Jim_GetScript(interp, argv[3]);
10004
10005 /* Ensure proper lengths to start */
10006 if (initScript->len != 6) goto evalstart;
10007 if (incrScript->len != 4) goto evalstart;
10008 if (expr->len != 3) goto evalstart;
10009 /* Ensure proper token types. */
10010 if (initScript->token[2].type != JIM_TT_ESC ||
10011 initScript->token[4].type != JIM_TT_ESC ||
10012 incrScript->token[2].type != JIM_TT_ESC ||
10013 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10014 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10015 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10016 (expr->opcode[2] != JIM_EXPROP_LT &&
10017 expr->opcode[2] != JIM_EXPROP_LTE))
10018 goto evalstart;
10019 cmpType = expr->opcode[2];
10020 /* Initialization command must be [set] */
10021 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10022 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10023 goto evalstart;
10024 /* Update command must be incr */
10025 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10026 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10027 goto evalstart;
10028 /* set, incr, expression must be about the same variable */
10029 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10030 incrScript->token[2].objPtr, 0))
10031 goto evalstart;
10032 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10033 expr->obj[0], 0))
10034 goto evalstart;
10035 /* Check that the initialization and comparison are valid integers */
10036 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10037 goto evalstart;
10038 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10039 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10040 {
10041 goto evalstart;
10042 }
10043
10044 /* Initialization */
10045 varNamePtr = expr->obj[0];
10046 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10047 stopVarNamePtr = expr->obj[1];
10048 Jim_IncrRefCount(stopVarNamePtr);
10049 }
10050 Jim_IncrRefCount(varNamePtr);
10051
10052 /* --- OPTIMIZED FOR --- */
10053 /* Start to loop */
10054 objPtr = Jim_NewIntObj(interp, start);
10055 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10056 Jim_DecrRefCount(interp, varNamePtr);
10057 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10058 Jim_FreeNewObj(interp, objPtr);
10059 goto evalstart;
10060 }
10061 while (1) {
10062 /* === Check condition === */
10063 /* Common code: */
10064 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10065 if (objPtr == NULL ||
10066 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10067 {
10068 Jim_DecrRefCount(interp, varNamePtr);
10069 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10070 goto testcond;
10071 }
10072 /* Immediate or Variable? get the 'stop' value if the latter. */
10073 if (stopVarNamePtr) {
10074 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10075 if (objPtr == NULL ||
10076 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10077 {
10078 Jim_DecrRefCount(interp, varNamePtr);
10079 Jim_DecrRefCount(interp, stopVarNamePtr);
10080 goto testcond;
10081 }
10082 }
10083 if (cmpType == JIM_EXPROP_LT) {
10084 if (currentVal >= stop) break;
10085 } else {
10086 if (currentVal > stop) break;
10087 }
10088 /* Eval body */
10089 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10090 switch (retval) {
10091 case JIM_BREAK:
10092 if (stopVarNamePtr)
10093 Jim_DecrRefCount(interp, stopVarNamePtr);
10094 Jim_DecrRefCount(interp, varNamePtr);
10095 goto out;
10096 case JIM_CONTINUE:
10097 /* nothing to do */
10098 break;
10099 default:
10100 if (stopVarNamePtr)
10101 Jim_DecrRefCount(interp, stopVarNamePtr);
10102 Jim_DecrRefCount(interp, varNamePtr);
10103 return retval;
10104 }
10105 }
10106 /* If there was a change in procedures/command continue
10107 * with the usual [for] command implementation */
10108 if (procEpoch != interp->procEpoch) {
10109 if (stopVarNamePtr)
10110 Jim_DecrRefCount(interp, stopVarNamePtr);
10111 Jim_DecrRefCount(interp, varNamePtr);
10112 goto evalnext;
10113 }
10114 /* Increment */
10115 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10116 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10117 objPtr->internalRep.wideValue ++;
10118 Jim_InvalidateStringRep(objPtr);
10119 } else {
10120 Jim_Obj *auxObjPtr;
10121
10122 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10123 if (stopVarNamePtr)
10124 Jim_DecrRefCount(interp, stopVarNamePtr);
10125 Jim_DecrRefCount(interp, varNamePtr);
10126 goto evalnext;
10127 }
10128 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10129 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10130 if (stopVarNamePtr)
10131 Jim_DecrRefCount(interp, stopVarNamePtr);
10132 Jim_DecrRefCount(interp, varNamePtr);
10133 Jim_FreeNewObj(interp, auxObjPtr);
10134 goto evalnext;
10135 }
10136 }
10137 }
10138 if (stopVarNamePtr)
10139 Jim_DecrRefCount(interp, stopVarNamePtr);
10140 Jim_DecrRefCount(interp, varNamePtr);
10141 Jim_SetEmptyResult(interp);
10142 return JIM_OK;
10143 }
10144 #endif
10145 evalstart:
10146 /* Eval start */
10147 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10148 return retval;
10149 while (1) {
10150 int local_boolean;
10151 testcond:
10152 /* Test the condition */
10153 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &local_boolean))
10154 != JIM_OK)
10155 return retval;
10156 if (!local_boolean) break;
10157 /* Eval body */
10158 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10159 switch (retval) {
10160 case JIM_BREAK:
10161 goto out;
10162 break;
10163 case JIM_CONTINUE:
10164 /* Nothing to do */
10165 break;
10166 default:
10167 return retval;
10168 }
10169 }
10170 evalnext:
10171 /* Eval next */
10172 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10173 switch (retval) {
10174 case JIM_BREAK:
10175 goto out;
10176 break;
10177 case JIM_CONTINUE:
10178 continue;
10179 break;
10180 default:
10181 return retval;
10182 }
10183 }
10184 }
10185 out:
10186 Jim_SetEmptyResult(interp);
10187 return JIM_OK;
10188 }
10189
10190 /* foreach + lmap implementation. */
10191 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10192 Jim_Obj *const *argv, int doMap)
10193 {
10194 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10195 int nbrOfLoops = 0;
10196 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10197
10198 if (argc < 4 || argc % 2 != 0) {
10199 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10200 return JIM_ERR;
10201 }
10202 if (doMap) {
10203 mapRes = Jim_NewListObj(interp, NULL, 0);
10204 Jim_IncrRefCount(mapRes);
10205 }
10206 emptyStr = Jim_NewEmptyStringObj(interp);
10207 Jim_IncrRefCount(emptyStr);
10208 script = argv[argc-1]; /* Last argument is a script */
10209 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10210 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10211 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10212 /* Initialize iterators and remember max nbr elements each list */
10213 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10214 /* Remember lengths of all lists and calculate how much rounds to loop */
10215 for (i = 0; i < nbrOfLists*2; i += 2) {
10216 div_t cnt;
10217 int count;
10218 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10219 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10220 if (listsEnd[i] == 0) {
10221 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10222 goto err;
10223 }
10224 cnt = div(listsEnd[i + 1], listsEnd[i]);
10225 count = cnt.quot + (cnt.rem ? 1 : 0);
10226 if (count > nbrOfLoops)
10227 nbrOfLoops = count;
10228 }
10229 for (; nbrOfLoops-- > 0;) {
10230 for (i = 0; i < nbrOfLists; ++i) {
10231 int varIdx = 0, var = i * 2;
10232 while (varIdx < listsEnd[var]) {
10233 Jim_Obj *varName, *ele;
10234 int lst = i * 2 + 1;
10235 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10236 != JIM_OK)
10237 goto err;
10238 if (listsIdx[i] < listsEnd[lst]) {
10239 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10240 != JIM_OK)
10241 goto err;
10242 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10243 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10244 goto err;
10245 }
10246 ++listsIdx[i]; /* Remember next iterator of current list */
10247 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10248 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10249 goto err;
10250 }
10251 ++varIdx; /* Next variable */
10252 }
10253 }
10254 switch (result = Jim_EvalObj(interp, script)) {
10255 case JIM_OK:
10256 if (doMap)
10257 Jim_ListAppendElement(interp, mapRes, interp->result);
10258 break;
10259 case JIM_CONTINUE:
10260 break;
10261 case JIM_BREAK:
10262 goto out;
10263 break;
10264 default:
10265 goto err;
10266 }
10267 }
10268 out:
10269 result = JIM_OK;
10270 if (doMap)
10271 Jim_SetResult(interp, mapRes);
10272 else
10273 Jim_SetEmptyResult(interp);
10274 err:
10275 if (doMap)
10276 Jim_DecrRefCount(interp, mapRes);
10277 Jim_DecrRefCount(interp, emptyStr);
10278 Jim_Free(listsIdx);
10279 Jim_Free(listsEnd);
10280 return result;
10281 }
10282
10283 /* [foreach] */
10284 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10285 Jim_Obj *const *argv)
10286 {
10287 return JimForeachMapHelper(interp, argc, argv, 0);
10288 }
10289
10290 /* [lmap] */
10291 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10292 Jim_Obj *const *argv)
10293 {
10294 return JimForeachMapHelper(interp, argc, argv, 1);
10295 }
10296
10297 /* [if] */
10298 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10299 Jim_Obj *const *argv)
10300 {
10301 int local_boolean, retval, current = 1, falsebody = 0;
10302 if (argc >= 3) {
10303 while (1) {
10304 /* Far not enough arguments given! */
10305 if (current >= argc) goto err;
10306 if ((retval = Jim_GetBoolFromExpr(interp,
10307 argv[current++], &local_boolean))
10308 != JIM_OK)
10309 return retval;
10310 /* There lacks something, isn't it? */
10311 if (current >= argc) goto err;
10312 if (Jim_CompareStringImmediate(interp, argv[current],
10313 "then")) current++;
10314 /* Tsk tsk, no then-clause? */
10315 if (current >= argc) goto err;
10316 if (local_boolean)
10317 return Jim_EvalObj(interp, argv[current]);
10318 /* Ok: no else-clause follows */
10319 if (++current >= argc) {
10320 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10321 return JIM_OK;
10322 }
10323 falsebody = current++;
10324 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10325 "else")) {
10326 /* IIICKS - else-clause isn't last cmd? */
10327 if (current != argc-1) goto err;
10328 return Jim_EvalObj(interp, argv[current]);
10329 } else if (Jim_CompareStringImmediate(interp,
10330 argv[falsebody], "elseif"))
10331 /* Ok: elseif follows meaning all the stuff
10332 * again (how boring...) */
10333 continue;
10334 /* OOPS - else-clause is not last cmd?*/
10335 else if (falsebody != argc-1)
10336 goto err;
10337 return Jim_EvalObj(interp, argv[falsebody]);
10338 }
10339 return JIM_OK;
10340 }
10341 err:
10342 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10343 return JIM_ERR;
10344 }
10345
10346 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10347
10348 /* [switch] */
10349 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10350 Jim_Obj *const *argv)
10351 {
10352 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10353 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10354 Jim_Obj *script = 0;
10355 if (argc < 3) goto wrongnumargs;
10356 for (opt = 1; opt < argc; ++opt) {
10357 const char *option = Jim_GetString(argv[opt], 0);
10358 if (*option != '-') break;
10359 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10360 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10361 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10362 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10363 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10364 if ((argc - opt) < 2) goto wrongnumargs;
10365 command = argv[++opt];
10366 } else {
10367 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10368 Jim_AppendStrings(interp, Jim_GetResult(interp),
10369 "bad option \"", option, "\": must be -exact, -glob, "
10370 "-regexp, -command procname or --", 0);
10371 goto err;
10372 }
10373 if ((argc - opt) < 2) goto wrongnumargs;
10374 }
10375 strObj = argv[opt++];
10376 patCount = argc - opt;
10377 if (patCount == 1) {
10378 Jim_Obj **vector;
10379 JimListGetElements(interp, argv[opt], &patCount, &vector);
10380 caseList = vector;
10381 } else
10382 caseList = &argv[opt];
10383 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10384 for (i = 0; script == 0 && i < patCount; i += 2) {
10385 Jim_Obj *patObj = caseList[i];
10386 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10387 || i < (patCount-2)) {
10388 switch (matchOpt) {
10389 case SWITCH_EXACT:
10390 if (Jim_StringEqObj(strObj, patObj, 0))
10391 script = caseList[i + 1];
10392 break;
10393 case SWITCH_GLOB:
10394 if (Jim_StringMatchObj(patObj, strObj, 0))
10395 script = caseList[i + 1];
10396 break;
10397 case SWITCH_RE:
10398 command = Jim_NewStringObj(interp, "regexp", -1);
10399 /* Fall thru intentionally */
10400 case SWITCH_CMD: {
10401 Jim_Obj *parms[] = {command, patObj, strObj};
10402 int rc = Jim_EvalObjVector(interp, 3, parms);
10403 long matching;
10404 /* After the execution of a command we need to
10405 * make sure to reconvert the object into a list
10406 * again. Only for the single-list style [switch]. */
10407 if (argc-opt == 1) {
10408 Jim_Obj **vector;
10409 JimListGetElements(interp, argv[opt], &patCount,
10410 &vector);
10411 caseList = vector;
10412 }
10413 /* command is here already decref'd */
10414 if (rc != JIM_OK) {
10415 retcode = rc;
10416 goto err;
10417 }
10418 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10419 if (rc != JIM_OK) {
10420 retcode = rc;
10421 goto err;
10422 }
10423 if (matching)
10424 script = caseList[i + 1];
10425 break;
10426 }
10427 default:
10428 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10429 Jim_AppendStrings(interp, Jim_GetResult(interp),
10430 "internal error: no such option implemented", 0);
10431 goto err;
10432 }
10433 } else {
10434 script = caseList[i + 1];
10435 }
10436 }
10437 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10438 i += 2)
10439 script = caseList[i + 1];
10440 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10441 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10442 Jim_AppendStrings(interp, Jim_GetResult(interp),
10443 "no body specified for pattern \"",
10444 Jim_GetString(caseList[i-2], 0), "\"", 0);
10445 goto err;
10446 }
10447 retcode = JIM_OK;
10448 Jim_SetEmptyResult(interp);
10449 if (script != 0)
10450 retcode = Jim_EvalObj(interp, script);
10451 return retcode;
10452 wrongnumargs:
10453 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10454 "pattern body ... ?default body? or "
10455 "{pattern body ?pattern body ...?}");
10456 err:
10457 return retcode;
10458 }
10459
10460 /* [list] */
10461 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10462 Jim_Obj *const *argv)
10463 {
10464 Jim_Obj *listObjPtr;
10465
10466 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10467 Jim_SetResult(interp, listObjPtr);
10468 return JIM_OK;
10469 }
10470
10471 /* [lindex] */
10472 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10473 Jim_Obj *const *argv)
10474 {
10475 Jim_Obj *objPtr, *listObjPtr;
10476 int i;
10477 int index_t;
10478
10479 if (argc < 3) {
10480 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10481 return JIM_ERR;
10482 }
10483 objPtr = argv[1];
10484 Jim_IncrRefCount(objPtr);
10485 for (i = 2; i < argc; i++) {
10486 listObjPtr = objPtr;
10487 if (Jim_GetIndex(interp, argv[i], &index_t) != JIM_OK) {
10488 Jim_DecrRefCount(interp, listObjPtr);
10489 return JIM_ERR;
10490 }
10491 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
10492 JIM_NONE) != JIM_OK) {
10493 /* Returns an empty object if the index
10494 * is out of range. */
10495 Jim_DecrRefCount(interp, listObjPtr);
10496 Jim_SetEmptyResult(interp);
10497 return JIM_OK;
10498 }
10499 Jim_IncrRefCount(objPtr);
10500 Jim_DecrRefCount(interp, listObjPtr);
10501 }
10502 Jim_SetResult(interp, objPtr);
10503 Jim_DecrRefCount(interp, objPtr);
10504 return JIM_OK;
10505 }
10506
10507 /* [llength] */
10508 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10509 Jim_Obj *const *argv)
10510 {
10511 int len;
10512
10513 if (argc != 2) {
10514 Jim_WrongNumArgs(interp, 1, argv, "list");
10515 return JIM_ERR;
10516 }
10517 Jim_ListLength(interp, argv[1], &len);
10518 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10519 return JIM_OK;
10520 }
10521
10522 /* [lappend] */
10523 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10524 Jim_Obj *const *argv)
10525 {
10526 Jim_Obj *listObjPtr;
10527 int shared, i;
10528
10529 if (argc < 2) {
10530 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10531 return JIM_ERR;
10532 }
10533 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10534 if (!listObjPtr) {
10535 /* Create the list if it does not exists */
10536 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10537 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10538 Jim_FreeNewObj(interp, listObjPtr);
10539 return JIM_ERR;
10540 }
10541 }
10542 shared = Jim_IsShared(listObjPtr);
10543 if (shared)
10544 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10545 for (i = 2; i < argc; i++)
10546 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10547 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10548 if (shared)
10549 Jim_FreeNewObj(interp, listObjPtr);
10550 return JIM_ERR;
10551 }
10552 Jim_SetResult(interp, listObjPtr);
10553 return JIM_OK;
10554 }
10555
10556 /* [linsert] */
10557 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10558 Jim_Obj *const *argv)
10559 {
10560 int index_t, len;
10561 Jim_Obj *listPtr;
10562
10563 if (argc < 4) {
10564 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10565 "?element ...?");
10566 return JIM_ERR;
10567 }
10568 listPtr = argv[1];
10569 if (Jim_IsShared(listPtr))
10570 listPtr = Jim_DuplicateObj(interp, listPtr);
10571 if (Jim_GetIndex(interp, argv[2], &index_t) != JIM_OK)
10572 goto err;
10573 Jim_ListLength(interp, listPtr, &len);
10574 if (index_t >= len)
10575 index_t = len;
10576 else if (index_t < 0)
10577 index_t = len + index_t + 1;
10578 Jim_ListInsertElements(interp, listPtr, index_t, argc-3, &argv[3]);
10579 Jim_SetResult(interp, listPtr);
10580 return JIM_OK;
10581 err:
10582 if (listPtr != argv[1]) {
10583 Jim_FreeNewObj(interp, listPtr);
10584 }
10585 return JIM_ERR;
10586 }
10587
10588 /* [lset] */
10589 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10590 Jim_Obj *const *argv)
10591 {
10592 if (argc < 3) {
10593 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10594 return JIM_ERR;
10595 } else if (argc == 3) {
10596 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10597 return JIM_ERR;
10598 Jim_SetResult(interp, argv[2]);
10599 return JIM_OK;
10600 }
10601 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10602 == JIM_ERR) return JIM_ERR;
10603 return JIM_OK;
10604 }
10605
10606 /* [lsort] */
10607 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10608 {
10609 const char *options[] = {
10610 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10611 };
10612 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10613 Jim_Obj *resObj;
10614 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10615 int decreasing = 0;
10616
10617 if (argc < 2) {
10618 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10619 return JIM_ERR;
10620 }
10621 for (i = 1; i < (argc-1); i++) {
10622 int option;
10623
10624 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10625 != JIM_OK)
10626 return JIM_ERR;
10627 switch (option) {
10628 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10629 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10630 case OPT_INCREASING: decreasing = 0; break;
10631 case OPT_DECREASING: decreasing = 1; break;
10632 }
10633 }
10634 if (decreasing) {
10635 switch (lsortType) {
10636 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10637 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10638 }
10639 }
10640 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10641 ListSortElements(interp, resObj, lsortType);
10642 Jim_SetResult(interp, resObj);
10643 return JIM_OK;
10644 }
10645
10646 /* [append] */
10647 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10648 Jim_Obj *const *argv)
10649 {
10650 Jim_Obj *stringObjPtr;
10651 int shared, i;
10652
10653 if (argc < 2) {
10654 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10655 return JIM_ERR;
10656 }
10657 if (argc == 2) {
10658 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10659 if (!stringObjPtr) return JIM_ERR;
10660 } else {
10661 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10662 if (!stringObjPtr) {
10663 /* Create the string if it does not exists */
10664 stringObjPtr = Jim_NewEmptyStringObj(interp);
10665 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10666 != JIM_OK) {
10667 Jim_FreeNewObj(interp, stringObjPtr);
10668 return JIM_ERR;
10669 }
10670 }
10671 }
10672 shared = Jim_IsShared(stringObjPtr);
10673 if (shared)
10674 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10675 for (i = 2; i < argc; i++)
10676 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10677 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10678 if (shared)
10679 Jim_FreeNewObj(interp, stringObjPtr);
10680 return JIM_ERR;
10681 }
10682 Jim_SetResult(interp, stringObjPtr);
10683 return JIM_OK;
10684 }
10685
10686 /* [debug] */
10687 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10688 Jim_Obj *const *argv)
10689 {
10690 const char *options[] = {
10691 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10692 "exprbc",
10693 NULL
10694 };
10695 enum {
10696 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10697 OPT_EXPRLEN, OPT_EXPRBC
10698 };
10699 int option;
10700
10701 if (argc < 2) {
10702 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10703 return JIM_ERR;
10704 }
10705 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10706 JIM_ERRMSG) != JIM_OK)
10707 return JIM_ERR;
10708 if (option == OPT_REFCOUNT) {
10709 if (argc != 3) {
10710 Jim_WrongNumArgs(interp, 2, argv, "object");
10711 return JIM_ERR;
10712 }
10713 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10714 return JIM_OK;
10715 } else if (option == OPT_OBJCOUNT) {
10716 int freeobj = 0, liveobj = 0;
10717 char buf[256];
10718 Jim_Obj *objPtr;
10719
10720 if (argc != 2) {
10721 Jim_WrongNumArgs(interp, 2, argv, "");
10722 return JIM_ERR;
10723 }
10724 /* Count the number of free objects. */
10725 objPtr = interp->freeList;
10726 while (objPtr) {
10727 freeobj++;
10728 objPtr = objPtr->nextObjPtr;
10729 }
10730 /* Count the number of live objects. */
10731 objPtr = interp->liveList;
10732 while (objPtr) {
10733 liveobj++;
10734 objPtr = objPtr->nextObjPtr;
10735 }
10736 /* Set the result string and return. */
10737 sprintf(buf, "free %d used %d", freeobj, liveobj);
10738 Jim_SetResultString(interp, buf, -1);
10739 return JIM_OK;
10740 } else if (option == OPT_OBJECTS) {
10741 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10742 /* Count the number of live objects. */
10743 objPtr = interp->liveList;
10744 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10745 while (objPtr) {
10746 char buf[128];
10747 const char *type = objPtr->typePtr ?
10748 objPtr->typePtr->name : "";
10749 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10750 sprintf(buf, "%p", objPtr);
10751 Jim_ListAppendElement(interp, subListObjPtr,
10752 Jim_NewStringObj(interp, buf, -1));
10753 Jim_ListAppendElement(interp, subListObjPtr,
10754 Jim_NewStringObj(interp, type, -1));
10755 Jim_ListAppendElement(interp, subListObjPtr,
10756 Jim_NewIntObj(interp, objPtr->refCount));
10757 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10758 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10759 objPtr = objPtr->nextObjPtr;
10760 }
10761 Jim_SetResult(interp, listObjPtr);
10762 return JIM_OK;
10763 } else if (option == OPT_INVSTR) {
10764 Jim_Obj *objPtr;
10765
10766 if (argc != 3) {
10767 Jim_WrongNumArgs(interp, 2, argv, "object");
10768 return JIM_ERR;
10769 }
10770 objPtr = argv[2];
10771 if (objPtr->typePtr != NULL)
10772 Jim_InvalidateStringRep(objPtr);
10773 Jim_SetEmptyResult(interp);
10774 return JIM_OK;
10775 } else if (option == OPT_SCRIPTLEN) {
10776 ScriptObj *script;
10777 if (argc != 3) {
10778 Jim_WrongNumArgs(interp, 2, argv, "script");
10779 return JIM_ERR;
10780 }
10781 script = Jim_GetScript(interp, argv[2]);
10782 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10783 return JIM_OK;
10784 } else if (option == OPT_EXPRLEN) {
10785 ExprByteCode *expr;
10786 if (argc != 3) {
10787 Jim_WrongNumArgs(interp, 2, argv, "expression");
10788 return JIM_ERR;
10789 }
10790 expr = Jim_GetExpression(interp, argv[2]);
10791 if (expr == NULL)
10792 return JIM_ERR;
10793 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10794 return JIM_OK;
10795 } else if (option == OPT_EXPRBC) {
10796 Jim_Obj *objPtr;
10797 ExprByteCode *expr;
10798 int i;
10799
10800 if (argc != 3) {
10801 Jim_WrongNumArgs(interp, 2, argv, "expression");
10802 return JIM_ERR;
10803 }
10804 expr = Jim_GetExpression(interp, argv[2]);
10805 if (expr == NULL)
10806 return JIM_ERR;
10807 objPtr = Jim_NewListObj(interp, NULL, 0);
10808 for (i = 0; i < expr->len; i++) {
10809 const char *type;
10810 Jim_ExprOperator *op;
10811
10812 switch (expr->opcode[i]) {
10813 case JIM_EXPROP_NUMBER: type = "number"; break;
10814 case JIM_EXPROP_COMMAND: type = "command"; break;
10815 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10816 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10817 case JIM_EXPROP_SUBST: type = "subst"; break;
10818 case JIM_EXPROP_STRING: type = "string"; break;
10819 default:
10820 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10821 if (op == NULL) {
10822 type = "private";
10823 } else {
10824 type = "operator";
10825 }
10826 break;
10827 }
10828 Jim_ListAppendElement(interp, objPtr,
10829 Jim_NewStringObj(interp, type, -1));
10830 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10831 }
10832 Jim_SetResult(interp, objPtr);
10833 return JIM_OK;
10834 } else {
10835 Jim_SetResultString(interp,
10836 "bad option. Valid options are refcount, "
10837 "objcount, objects, invstr", -1);
10838 return JIM_ERR;
10839 }
10840 return JIM_OK; /* unreached */
10841 }
10842
10843 /* [eval] */
10844 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10845 Jim_Obj *const *argv)
10846 {
10847 if (argc == 2) {
10848 return Jim_EvalObj(interp, argv[1]);
10849 } else if (argc > 2) {
10850 Jim_Obj *objPtr;
10851 int retcode;
10852
10853 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10854 Jim_IncrRefCount(objPtr);
10855 retcode = Jim_EvalObj(interp, objPtr);
10856 Jim_DecrRefCount(interp, objPtr);
10857 return retcode;
10858 } else {
10859 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10860 return JIM_ERR;
10861 }
10862 }
10863
10864 /* [uplevel] */
10865 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10866 Jim_Obj *const *argv)
10867 {
10868 if (argc >= 2) {
10869 int retcode, newLevel, oldLevel;
10870 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10871 Jim_Obj *objPtr;
10872 const char *str;
10873
10874 /* Save the old callframe pointer */
10875 savedCallFrame = interp->framePtr;
10876
10877 /* Lookup the target frame pointer */
10878 str = Jim_GetString(argv[1], NULL);
10879 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10880 {
10881 if (Jim_GetCallFrameByLevel(interp, argv[1],
10882 &targetCallFrame,
10883 &newLevel) != JIM_OK)
10884 return JIM_ERR;
10885 argc--;
10886 argv++;
10887 } else {
10888 if (Jim_GetCallFrameByLevel(interp, NULL,
10889 &targetCallFrame,
10890 &newLevel) != JIM_OK)
10891 return JIM_ERR;
10892 }
10893 if (argc < 2) {
10894 argc++;
10895 argv--;
10896 Jim_WrongNumArgs(interp, 1, argv,
10897 "?level? command ?arg ...?");
10898 return JIM_ERR;
10899 }
10900 /* Eval the code in the target callframe. */
10901 interp->framePtr = targetCallFrame;
10902 oldLevel = interp->numLevels;
10903 interp->numLevels = newLevel;
10904 if (argc == 2) {
10905 retcode = Jim_EvalObj(interp, argv[1]);
10906 } else {
10907 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10908 Jim_IncrRefCount(objPtr);
10909 retcode = Jim_EvalObj(interp, objPtr);
10910 Jim_DecrRefCount(interp, objPtr);
10911 }
10912 interp->numLevels = oldLevel;
10913 interp->framePtr = savedCallFrame;
10914 return retcode;
10915 } else {
10916 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10917 return JIM_ERR;
10918 }
10919 }
10920
10921 /* [expr] */
10922 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10923 Jim_Obj *const *argv)
10924 {
10925 Jim_Obj *exprResultPtr;
10926 int retcode;
10927
10928 if (argc == 2) {
10929 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10930 } else if (argc > 2) {
10931 Jim_Obj *objPtr;
10932
10933 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10934 Jim_IncrRefCount(objPtr);
10935 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10936 Jim_DecrRefCount(interp, objPtr);
10937 } else {
10938 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10939 return JIM_ERR;
10940 }
10941 if (retcode != JIM_OK) return retcode;
10942 Jim_SetResult(interp, exprResultPtr);
10943 Jim_DecrRefCount(interp, exprResultPtr);
10944 return JIM_OK;
10945 }
10946
10947 /* [break] */
10948 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10949 Jim_Obj *const *argv)
10950 {
10951 if (argc != 1) {
10952 Jim_WrongNumArgs(interp, 1, argv, "");
10953 return JIM_ERR;
10954 }
10955 return JIM_BREAK;
10956 }
10957
10958 /* [continue] */
10959 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10960 Jim_Obj *const *argv)
10961 {
10962 if (argc != 1) {
10963 Jim_WrongNumArgs(interp, 1, argv, "");
10964 return JIM_ERR;
10965 }
10966 return JIM_CONTINUE;
10967 }
10968
10969 /* [return] */
10970 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10971 Jim_Obj *const *argv)
10972 {
10973 if (argc == 1) {
10974 return JIM_RETURN;
10975 } else if (argc == 2) {
10976 Jim_SetResult(interp, argv[1]);
10977 interp->returnCode = JIM_OK;
10978 return JIM_RETURN;
10979 } else if (argc == 3 || argc == 4) {
10980 int returnCode;
10981 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10982 return JIM_ERR;
10983 interp->returnCode = returnCode;
10984 if (argc == 4)
10985 Jim_SetResult(interp, argv[3]);
10986 return JIM_RETURN;
10987 } else {
10988 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10989 return JIM_ERR;
10990 }
10991 return JIM_RETURN; /* unreached */
10992 }
10993
10994 /* [tailcall] */
10995 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10996 Jim_Obj *const *argv)
10997 {
10998 Jim_Obj *objPtr;
10999
11000 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
11001 Jim_SetResult(interp, objPtr);
11002 return JIM_EVAL;
11003 }
11004
11005 /* [proc] */
11006 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11007 Jim_Obj *const *argv)
11008 {
11009 int argListLen;
11010 int arityMin, arityMax;
11011
11012 if (argc != 4 && argc != 5) {
11013 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11014 return JIM_ERR;
11015 }
11016 Jim_ListLength(interp, argv[2], &argListLen);
11017 arityMin = arityMax = argListLen + 1;
11018
11019 if (argListLen) {
11020 const char *str;
11021 int len;
11022 Jim_Obj *argPtr=NULL;
11023
11024 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11025 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11026 str = Jim_GetString(argPtr, &len);
11027 if (len == 4 && memcmp(str, "args", 4) == 0) {
11028 arityMin--;
11029 arityMax = -1;
11030 }
11031
11032 /* Check for default arguments and reduce arityMin if necessary */
11033 while (arityMin > 1) {
11034 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11035 Jim_ListLength(interp, argPtr, &len);
11036 if (len != 2) {
11037 /* No default argument */
11038 break;
11039 }
11040 arityMin--;
11041 }
11042 }
11043 if (argc == 4) {
11044 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11045 argv[2], NULL, argv[3], arityMin, arityMax);
11046 } else {
11047 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11048 argv[2], argv[3], argv[4], arityMin, arityMax);
11049 }
11050 }
11051
11052 /* [concat] */
11053 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11054 Jim_Obj *const *argv)
11055 {
11056 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11057 return JIM_OK;
11058 }
11059
11060 /* [upvar] */
11061 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11062 Jim_Obj *const *argv)
11063 {
11064 const char *str;
11065 int i;
11066 Jim_CallFrame *targetCallFrame;
11067
11068 /* Lookup the target frame pointer */
11069 str = Jim_GetString(argv[1], NULL);
11070 if (argc > 3 &&
11071 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11072 {
11073 if (Jim_GetCallFrameByLevel(interp, argv[1],
11074 &targetCallFrame, NULL) != JIM_OK)
11075 return JIM_ERR;
11076 argc--;
11077 argv++;
11078 } else {
11079 if (Jim_GetCallFrameByLevel(interp, NULL,
11080 &targetCallFrame, NULL) != JIM_OK)
11081 return JIM_ERR;
11082 }
11083 /* Check for arity */
11084 if (argc < 3 || ((argc-1)%2) != 0) {
11085 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11086 return JIM_ERR;
11087 }
11088 /* Now... for every other/local couple: */
11089 for (i = 1; i < argc; i += 2) {
11090 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11091 targetCallFrame) != JIM_OK) return JIM_ERR;
11092 }
11093 return JIM_OK;
11094 }
11095
11096 /* [global] */
11097 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11098 Jim_Obj *const *argv)
11099 {
11100 int i;
11101
11102 if (argc < 2) {
11103 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11104 return JIM_ERR;
11105 }
11106 /* Link every var to the toplevel having the same name */
11107 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11108 for (i = 1; i < argc; i++) {
11109 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11110 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11111 }
11112 return JIM_OK;
11113 }
11114
11115 /* does the [string map] operation. On error NULL is returned,
11116 * otherwise a new string object with the result, having refcount = 0,
11117 * is returned. */
11118 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11119 Jim_Obj *objPtr, int nocase)
11120 {
11121 int numMaps;
11122 const char **key, *str, *noMatchStart = NULL;
11123 Jim_Obj **value;
11124 int *keyLen, strLen, i;
11125 Jim_Obj *resultObjPtr;
11126
11127 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11128 if (numMaps % 2) {
11129 Jim_SetResultString(interp,
11130 "list must contain an even number of elements", -1);
11131 return NULL;
11132 }
11133 /* Initialization */
11134 numMaps /= 2;
11135 key = Jim_Alloc(sizeof(char*)*numMaps);
11136 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11137 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11138 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11139 for (i = 0; i < numMaps; i++) {
11140 Jim_Obj *eleObjPtr=NULL;
11141
11142 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11143 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11144 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11145 value[i] = eleObjPtr;
11146 }
11147 str = Jim_GetString(objPtr, &strLen);
11148 /* Map it */
11149 while (strLen) {
11150 for (i = 0; i < numMaps; i++) {
11151 if (strLen >= keyLen[i] && keyLen[i]) {
11152 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11153 nocase))
11154 {
11155 if (noMatchStart) {
11156 Jim_AppendString(interp, resultObjPtr,
11157 noMatchStart, str-noMatchStart);
11158 noMatchStart = NULL;
11159 }
11160 Jim_AppendObj(interp, resultObjPtr, value[i]);
11161 str += keyLen[i];
11162 strLen -= keyLen[i];
11163 break;
11164 }
11165 }
11166 }
11167 if (i == numMaps) { /* no match */
11168 if (noMatchStart == NULL)
11169 noMatchStart = str;
11170 str ++;
11171 strLen --;
11172 }
11173 }
11174 if (noMatchStart) {
11175 Jim_AppendString(interp, resultObjPtr,
11176 noMatchStart, str-noMatchStart);
11177 }
11178 Jim_Free((void*)key);
11179 Jim_Free(keyLen);
11180 Jim_Free(value);
11181 return resultObjPtr;
11182 }
11183
11184 /* [string] */
11185 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11186 Jim_Obj *const *argv)
11187 {
11188 int option;
11189 const char *options[] = {
11190 "length", "compare", "match", "equal", "range", "map", "repeat",
11191 "index", "first", "tolower", "toupper", NULL
11192 };
11193 enum {
11194 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11195 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11196 };
11197
11198 if (argc < 2) {
11199 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11200 return JIM_ERR;
11201 }
11202 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11203 JIM_ERRMSG) != JIM_OK)
11204 return JIM_ERR;
11205
11206 if (option == OPT_LENGTH) {
11207 int len;
11208
11209 if (argc != 3) {
11210 Jim_WrongNumArgs(interp, 2, argv, "string");
11211 return JIM_ERR;
11212 }
11213 Jim_GetString(argv[2], &len);
11214 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11215 return JIM_OK;
11216 } else if (option == OPT_COMPARE) {
11217 int nocase = 0;
11218 if ((argc != 4 && argc != 5) ||
11219 (argc == 5 && Jim_CompareStringImmediate(interp,
11220 argv[2], "-nocase") == 0)) {
11221 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11222 return JIM_ERR;
11223 }
11224 if (argc == 5) {
11225 nocase = 1;
11226 argv++;
11227 }
11228 Jim_SetResult(interp, Jim_NewIntObj(interp,
11229 Jim_StringCompareObj(argv[2],
11230 argv[3], nocase)));
11231 return JIM_OK;
11232 } else if (option == OPT_MATCH) {
11233 int nocase = 0;
11234 if ((argc != 4 && argc != 5) ||
11235 (argc == 5 && Jim_CompareStringImmediate(interp,
11236 argv[2], "-nocase") == 0)) {
11237 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11238 "string");
11239 return JIM_ERR;
11240 }
11241 if (argc == 5) {
11242 nocase = 1;
11243 argv++;
11244 }
11245 Jim_SetResult(interp,
11246 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11247 argv[3], nocase)));
11248 return JIM_OK;
11249 } else if (option == OPT_EQUAL) {
11250 if (argc != 4) {
11251 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11252 return JIM_ERR;
11253 }
11254 Jim_SetResult(interp,
11255 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11256 argv[3], 0)));
11257 return JIM_OK;
11258 } else if (option == OPT_RANGE) {
11259 Jim_Obj *objPtr;
11260
11261 if (argc != 5) {
11262 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11263 return JIM_ERR;
11264 }
11265 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11266 if (objPtr == NULL)
11267 return JIM_ERR;
11268 Jim_SetResult(interp, objPtr);
11269 return JIM_OK;
11270 } else if (option == OPT_MAP) {
11271 int nocase = 0;
11272 Jim_Obj *objPtr;
11273
11274 if ((argc != 4 && argc != 5) ||
11275 (argc == 5 && Jim_CompareStringImmediate(interp,
11276 argv[2], "-nocase") == 0)) {
11277 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11278 "string");
11279 return JIM_ERR;
11280 }
11281 if (argc == 5) {
11282 nocase = 1;
11283 argv++;
11284 }
11285 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11286 if (objPtr == NULL)
11287 return JIM_ERR;
11288 Jim_SetResult(interp, objPtr);
11289 return JIM_OK;
11290 } else if (option == OPT_REPEAT) {
11291 Jim_Obj *objPtr;
11292 jim_wide count;
11293
11294 if (argc != 4) {
11295 Jim_WrongNumArgs(interp, 2, argv, "string count");
11296 return JIM_ERR;
11297 }
11298 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11299 return JIM_ERR;
11300 objPtr = Jim_NewStringObj(interp, "", 0);
11301 while (count--) {
11302 Jim_AppendObj(interp, objPtr, argv[2]);
11303 }
11304 Jim_SetResult(interp, objPtr);
11305 return JIM_OK;
11306 } else if (option == OPT_INDEX) {
11307 int index_t, len;
11308 const char *str;
11309
11310 if (argc != 4) {
11311 Jim_WrongNumArgs(interp, 2, argv, "string index");
11312 return JIM_ERR;
11313 }
11314 if (Jim_GetIndex(interp, argv[3], &index_t) != JIM_OK)
11315 return JIM_ERR;
11316 str = Jim_GetString(argv[2], &len);
11317 if (index_t != INT_MIN && index_t != INT_MAX)
11318 index_t = JimRelToAbsIndex(len, index_t);
11319 if (index_t < 0 || index_t >= len) {
11320 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11321 return JIM_OK;
11322 } else {
11323 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index_t, 1));
11324 return JIM_OK;
11325 }
11326 } else if (option == OPT_FIRST) {
11327 int index_t = 0, l1, l2;
11328 const char *s1, *s2;
11329
11330 if (argc != 4 && argc != 5) {
11331 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11332 return JIM_ERR;
11333 }
11334 s1 = Jim_GetString(argv[2], &l1);
11335 s2 = Jim_GetString(argv[3], &l2);
11336 if (argc == 5) {
11337 if (Jim_GetIndex(interp, argv[4], &index_t) != JIM_OK)
11338 return JIM_ERR;
11339 index_t = JimRelToAbsIndex(l2, index_t);
11340 }
11341 Jim_SetResult(interp, Jim_NewIntObj(interp,
11342 JimStringFirst(s1, l1, s2, l2, index_t)));
11343 return JIM_OK;
11344 } else if (option == OPT_TOLOWER) {
11345 if (argc != 3) {
11346 Jim_WrongNumArgs(interp, 2, argv, "string");
11347 return JIM_ERR;
11348 }
11349 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11350 } else if (option == OPT_TOUPPER) {
11351 if (argc != 3) {
11352 Jim_WrongNumArgs(interp, 2, argv, "string");
11353 return JIM_ERR;
11354 }
11355 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11356 }
11357 return JIM_OK;
11358 }
11359
11360 /* [time] */
11361 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11362 Jim_Obj *const *argv)
11363 {
11364 long i, count = 1;
11365 jim_wide start, elapsed;
11366 char buf [256];
11367 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11368
11369 if (argc < 2) {
11370 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11371 return JIM_ERR;
11372 }
11373 if (argc == 3) {
11374 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11375 return JIM_ERR;
11376 }
11377 if (count < 0)
11378 return JIM_OK;
11379 i = count;
11380 start = JimClock();
11381 while (i-- > 0) {
11382 int retval;
11383
11384 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11385 return retval;
11386 }
11387 elapsed = JimClock() - start;
11388 sprintf(buf, fmt, elapsed/count);
11389 Jim_SetResultString(interp, buf, -1);
11390 return JIM_OK;
11391 }
11392
11393 /* [exit] */
11394 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11395 Jim_Obj *const *argv)
11396 {
11397 long exitCode = 0;
11398
11399 if (argc > 2) {
11400 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11401 return JIM_ERR;
11402 }
11403 if (argc == 2) {
11404 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11405 return JIM_ERR;
11406 }
11407 interp->exitCode = exitCode;
11408 return JIM_EXIT;
11409 }
11410
11411 /* [catch] */
11412 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11413 Jim_Obj *const *argv)
11414 {
11415 int exitCode = 0;
11416
11417 if (argc != 2 && argc != 3) {
11418 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11419 return JIM_ERR;
11420 }
11421 exitCode = Jim_EvalObj(interp, argv[1]);
11422 if (argc == 3) {
11423 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11424 != JIM_OK)
11425 return JIM_ERR;
11426 }
11427 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11428 return JIM_OK;
11429 }
11430
11431 /* [ref] */
11432 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11433 Jim_Obj *const *argv)
11434 {
11435 if (argc != 3 && argc != 4) {
11436 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11437 return JIM_ERR;
11438 }
11439 if (argc == 3) {
11440 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11441 } else {
11442 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11443 argv[3]));
11444 }
11445 return JIM_OK;
11446 }
11447
11448 /* [getref] */
11449 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11450 Jim_Obj *const *argv)
11451 {
11452 Jim_Reference *refPtr;
11453
11454 if (argc != 2) {
11455 Jim_WrongNumArgs(interp, 1, argv, "reference");
11456 return JIM_ERR;
11457 }
11458 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11459 return JIM_ERR;
11460 Jim_SetResult(interp, refPtr->objPtr);
11461 return JIM_OK;
11462 }
11463
11464 /* [setref] */
11465 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11466 Jim_Obj *const *argv)
11467 {
11468 Jim_Reference *refPtr;
11469
11470 if (argc != 3) {
11471 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11472 return JIM_ERR;
11473 }
11474 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11475 return JIM_ERR;
11476 Jim_IncrRefCount(argv[2]);
11477 Jim_DecrRefCount(interp, refPtr->objPtr);
11478 refPtr->objPtr = argv[2];
11479 Jim_SetResult(interp, argv[2]);
11480 return JIM_OK;
11481 }
11482
11483 /* [collect] */
11484 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11485 Jim_Obj *const *argv)
11486 {
11487 if (argc != 1) {
11488 Jim_WrongNumArgs(interp, 1, argv, "");
11489 return JIM_ERR;
11490 }
11491 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11492 return JIM_OK;
11493 }
11494
11495 /* [finalize] reference ?newValue? */
11496 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11497 Jim_Obj *const *argv)
11498 {
11499 if (argc != 2 && argc != 3) {
11500 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11501 return JIM_ERR;
11502 }
11503 if (argc == 2) {
11504 Jim_Obj *cmdNamePtr;
11505
11506 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11507 return JIM_ERR;
11508 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11509 Jim_SetResult(interp, cmdNamePtr);
11510 } else {
11511 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11512 return JIM_ERR;
11513 Jim_SetResult(interp, argv[2]);
11514 }
11515 return JIM_OK;
11516 }
11517
11518 /* TODO */
11519 /* [info references] (list of all the references/finalizers) */
11520
11521 /* [rename] */
11522 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11523 Jim_Obj *const *argv)
11524 {
11525 const char *oldName, *newName;
11526
11527 if (argc != 3) {
11528 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11529 return JIM_ERR;
11530 }
11531 oldName = Jim_GetString(argv[1], NULL);
11532 newName = Jim_GetString(argv[2], NULL);
11533 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11534 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11535 Jim_AppendStrings(interp, Jim_GetResult(interp),
11536 "can't rename \"", oldName, "\": ",
11537 "command doesn't exist", NULL);
11538 return JIM_ERR;
11539 }
11540 return JIM_OK;
11541 }
11542
11543 /* [dict] */
11544 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11545 Jim_Obj *const *argv)
11546 {
11547 int option;
11548 const char *options[] = {
11549 "create", "get", "set", "unset", "exists", NULL
11550 };
11551 enum {
11552 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11553 };
11554
11555 if (argc < 2) {
11556 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11557 return JIM_ERR;
11558 }
11559
11560 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11561 JIM_ERRMSG) != JIM_OK)
11562 return JIM_ERR;
11563
11564 if (option == OPT_CREATE) {
11565 Jim_Obj *objPtr;
11566
11567 if (argc % 2) {
11568 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11569 return JIM_ERR;
11570 }
11571 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11572 Jim_SetResult(interp, objPtr);
11573 return JIM_OK;
11574 } else if (option == OPT_GET) {
11575 Jim_Obj *objPtr;
11576
11577 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11578 JIM_ERRMSG) != JIM_OK)
11579 return JIM_ERR;
11580 Jim_SetResult(interp, objPtr);
11581 return JIM_OK;
11582 } else if (option == OPT_SET) {
11583 if (argc < 5) {
11584 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11585 return JIM_ERR;
11586 }
11587 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11588 argv[argc-1]);
11589 } else if (option == OPT_UNSET) {
11590 if (argc < 4) {
11591 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11592 return JIM_ERR;
11593 }
11594 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11595 NULL);
11596 } else if (option == OPT_EXIST) {
11597 Jim_Obj *objPtr;
11598 int exists;
11599
11600 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11601 JIM_ERRMSG) == JIM_OK)
11602 exists = 1;
11603 else
11604 exists = 0;
11605 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11606 return JIM_OK;
11607 } else {
11608 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11609 Jim_AppendStrings(interp, Jim_GetResult(interp),
11610 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11611 " must be create, get, set", NULL);
11612 return JIM_ERR;
11613 }
11614 return JIM_OK;
11615 }
11616
11617 /* [load] */
11618 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11619 Jim_Obj *const *argv)
11620 {
11621 if (argc < 2) {
11622 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11623 return JIM_ERR;
11624 }
11625 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11626 }
11627
11628 /* [subst] */
11629 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11630 Jim_Obj *const *argv)
11631 {
11632 int i, flags = 0;
11633 Jim_Obj *objPtr;
11634
11635 if (argc < 2) {
11636 Jim_WrongNumArgs(interp, 1, argv,
11637 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11638 return JIM_ERR;
11639 }
11640 i = argc-2;
11641 while (i--) {
11642 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11643 "-nobackslashes"))
11644 flags |= JIM_SUBST_NOESC;
11645 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11646 "-novariables"))
11647 flags |= JIM_SUBST_NOVAR;
11648 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11649 "-nocommands"))
11650 flags |= JIM_SUBST_NOCMD;
11651 else {
11652 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11653 Jim_AppendStrings(interp, Jim_GetResult(interp),
11654 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11655 "\": must be -nobackslashes, -nocommands, or "
11656 "-novariables", NULL);
11657 return JIM_ERR;
11658 }
11659 }
11660 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11661 return JIM_ERR;
11662 Jim_SetResult(interp, objPtr);
11663 return JIM_OK;
11664 }
11665
11666 /* [info] */
11667 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11668 Jim_Obj *const *argv)
11669 {
11670 int cmd, result = JIM_OK;
11671 static const char *commands[] = {
11672 "body", "commands", "exists", "globals", "level", "locals",
11673 "vars", "version", "complete", "args", "hostname", NULL
11674 };
11675 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11676 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11677
11678 if (argc < 2) {
11679 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11680 return JIM_ERR;
11681 }
11682 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11683 != JIM_OK) {
11684 return JIM_ERR;
11685 }
11686
11687 if (cmd == INFO_COMMANDS) {
11688 if (argc != 2 && argc != 3) {
11689 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11690 return JIM_ERR;
11691 }
11692 if (argc == 3)
11693 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11694 else
11695 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11696 } else if (cmd == INFO_EXISTS) {
11697 Jim_Obj *exists;
11698 if (argc != 3) {
11699 Jim_WrongNumArgs(interp, 2, argv, "varName");
11700 return JIM_ERR;
11701 }
11702 exists = Jim_GetVariable(interp, argv[2], 0);
11703 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11704 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11705 int mode;
11706 switch (cmd) {
11707 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11708 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11709 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11710 default: mode = 0; /* avoid warning */; break;
11711 }
11712 if (argc != 2 && argc != 3) {
11713 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11714 return JIM_ERR;
11715 }
11716 if (argc == 3)
11717 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11718 else
11719 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11720 } else if (cmd == INFO_LEVEL) {
11721 Jim_Obj *objPtr;
11722 switch (argc) {
11723 case 2:
11724 Jim_SetResult(interp,
11725 Jim_NewIntObj(interp, interp->numLevels));
11726 break;
11727 case 3:
11728 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11729 return JIM_ERR;
11730 Jim_SetResult(interp, objPtr);
11731 break;
11732 default:
11733 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11734 return JIM_ERR;
11735 }
11736 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11737 Jim_Cmd *cmdPtr;
11738
11739 if (argc != 3) {
11740 Jim_WrongNumArgs(interp, 2, argv, "procname");
11741 return JIM_ERR;
11742 }
11743 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11744 return JIM_ERR;
11745 if (cmdPtr->cmdProc != NULL) {
11746 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11747 Jim_AppendStrings(interp, Jim_GetResult(interp),
11748 "command \"", Jim_GetString(argv[2], NULL),
11749 "\" is not a procedure", NULL);
11750 return JIM_ERR;
11751 }
11752 if (cmd == INFO_BODY)
11753 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11754 else
11755 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11756 } else if (cmd == INFO_VERSION) {
11757 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11758 sprintf(buf, "%d.%d",
11759 JIM_VERSION / 100, JIM_VERSION % 100);
11760 Jim_SetResultString(interp, buf, -1);
11761 } else if (cmd == INFO_COMPLETE) {
11762 const char *s;
11763 int len;
11764
11765 if (argc != 3) {
11766 Jim_WrongNumArgs(interp, 2, argv, "script");
11767 return JIM_ERR;
11768 }
11769 s = Jim_GetString(argv[2], &len);
11770 Jim_SetResult(interp,
11771 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11772 } else if (cmd == INFO_HOSTNAME) {
11773 /* Redirect to os.hostname if it exists */
11774 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11775 result = Jim_EvalObjVector(interp, 1, &command);
11776 }
11777 return result;
11778 }
11779
11780 /* [split] */
11781 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11782 Jim_Obj *const *argv)
11783 {
11784 const char *str, *splitChars, *noMatchStart;
11785 int splitLen, strLen, i;
11786 Jim_Obj *resObjPtr;
11787
11788 if (argc != 2 && argc != 3) {
11789 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11790 return JIM_ERR;
11791 }
11792 /* Init */
11793 if (argc == 2) {
11794 splitChars = " \n\t\r";
11795 splitLen = 4;
11796 } else {
11797 splitChars = Jim_GetString(argv[2], &splitLen);
11798 }
11799 str = Jim_GetString(argv[1], &strLen);
11800 if (!strLen) return JIM_OK;
11801 noMatchStart = str;
11802 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11803 /* Split */
11804 if (splitLen) {
11805 while (strLen) {
11806 for (i = 0; i < splitLen; i++) {
11807 if (*str == splitChars[i]) {
11808 Jim_Obj *objPtr;
11809
11810 objPtr = Jim_NewStringObj(interp, noMatchStart,
11811 (str-noMatchStart));
11812 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11813 noMatchStart = str + 1;
11814 break;
11815 }
11816 }
11817 str ++;
11818 strLen --;
11819 }
11820 Jim_ListAppendElement(interp, resObjPtr,
11821 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11822 } else {
11823 /* This handles the special case of splitchars eq {}. This
11824 * is trivial but we want to perform object sharing as Tcl does. */
11825 Jim_Obj *objCache[256];
11826 const unsigned char *u = (unsigned char*) str;
11827 memset(objCache, 0, sizeof(objCache));
11828 for (i = 0; i < strLen; i++) {
11829 int c = u[i];
11830
11831 if (objCache[c] == NULL)
11832 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11833 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11834 }
11835 }
11836 Jim_SetResult(interp, resObjPtr);
11837 return JIM_OK;
11838 }
11839
11840 /* [join] */
11841 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11842 Jim_Obj *const *argv)
11843 {
11844 const char *joinStr;
11845 int joinStrLen, i, listLen;
11846 Jim_Obj *resObjPtr;
11847
11848 if (argc != 2 && argc != 3) {
11849 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11850 return JIM_ERR;
11851 }
11852 /* Init */
11853 if (argc == 2) {
11854 joinStr = " ";
11855 joinStrLen = 1;
11856 } else {
11857 joinStr = Jim_GetString(argv[2], &joinStrLen);
11858 }
11859 Jim_ListLength(interp, argv[1], &listLen);
11860 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11861 /* Split */
11862 for (i = 0; i < listLen; i++) {
11863 Jim_Obj *objPtr=NULL;
11864
11865 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11866 Jim_AppendObj(interp, resObjPtr, objPtr);
11867 if (i + 1 != listLen) {
11868 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11869 }
11870 }
11871 Jim_SetResult(interp, resObjPtr);
11872 return JIM_OK;
11873 }
11874
11875 /* [format] */
11876 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11877 Jim_Obj *const *argv)
11878 {
11879 Jim_Obj *objPtr;
11880
11881 if (argc < 2) {
11882 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11883 return JIM_ERR;
11884 }
11885 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11886 if (objPtr == NULL)
11887 return JIM_ERR;
11888 Jim_SetResult(interp, objPtr);
11889 return JIM_OK;
11890 }
11891
11892 /* [scan] */
11893 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11894 Jim_Obj *const *argv)
11895 {
11896 Jim_Obj *listPtr, **outVec;
11897 int outc, i, count = 0;
11898
11899 if (argc < 3) {
11900 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11901 return JIM_ERR;
11902 }
11903 if (argv[2]->typePtr != &scanFmtStringObjType)
11904 SetScanFmtFromAny(interp, argv[2]);
11905 if (FormatGetError(argv[2]) != 0) {
11906 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11907 return JIM_ERR;
11908 }
11909 if (argc > 3) {
11910 int maxPos = FormatGetMaxPos(argv[2]);
11911 int arg_count = FormatGetCnvCount(argv[2]);
11912 if (maxPos > argc-3) {
11913 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11914 return JIM_ERR;
11915 } else if (arg_count != 0 && arg_count < argc-3) {
11916 Jim_SetResultString(interp, "variable is not assigned by any "
11917 "conversion specifiers", -1);
11918 return JIM_ERR;
11919 } else if (arg_count > argc-3) {
11920 Jim_SetResultString(interp, "different numbers of variable names and "
11921 "field specifiers", -1);
11922 return JIM_ERR;
11923 }
11924 }
11925 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11926 if (listPtr == 0)
11927 return JIM_ERR;
11928 if (argc > 3) {
11929 int len = 0;
11930 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11931 Jim_ListLength(interp, listPtr, &len);
11932 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11933 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11934 return JIM_OK;
11935 }
11936 JimListGetElements(interp, listPtr, &outc, &outVec);
11937 for (i = 0; i < outc; ++i) {
11938 if (Jim_Length(outVec[i]) > 0) {
11939 ++count;
11940 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11941 goto err;
11942 }
11943 }
11944 Jim_FreeNewObj(interp, listPtr);
11945 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11946 } else {
11947 if (listPtr == (Jim_Obj*)EOF) {
11948 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11949 return JIM_OK;
11950 }
11951 Jim_SetResult(interp, listPtr);
11952 }
11953 return JIM_OK;
11954 err:
11955 Jim_FreeNewObj(interp, listPtr);
11956 return JIM_ERR;
11957 }
11958
11959 /* [error] */
11960 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11961 Jim_Obj *const *argv)
11962 {
11963 if (argc != 2) {
11964 Jim_WrongNumArgs(interp, 1, argv, "message");
11965 return JIM_ERR;
11966 }
11967 Jim_SetResult(interp, argv[1]);
11968 return JIM_ERR;
11969 }
11970
11971 /* [lrange] */
11972 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11973 Jim_Obj *const *argv)
11974 {
11975 Jim_Obj *objPtr;
11976
11977 if (argc != 4) {
11978 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11979 return JIM_ERR;
11980 }
11981 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11982 return JIM_ERR;
11983 Jim_SetResult(interp, objPtr);
11984 return JIM_OK;
11985 }
11986
11987 /* [env] */
11988 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11989 Jim_Obj *const *argv)
11990 {
11991 const char *key;
11992 char *val;
11993
11994 if (argc == 1) {
11995
11996 #ifdef NEED_ENVIRON_EXTERN
11997 extern char **environ;
11998 #endif
11999
12000 int i;
12001 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12002
12003 for (i = 0; environ[i]; i++) {
12004 const char *equals = strchr(environ[i], '=');
12005 if (equals) {
12006 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
12007 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12008 }
12009 }
12010
12011 Jim_SetResult(interp, listObjPtr);
12012 return JIM_OK;
12013 }
12014
12015 if (argc != 2) {
12016 Jim_WrongNumArgs(interp, 1, argv, "varName");
12017 return JIM_ERR;
12018 }
12019 key = Jim_GetString(argv[1], NULL);
12020 val = getenv(key);
12021 if (val == NULL) {
12022 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12023 Jim_AppendStrings(interp, Jim_GetResult(interp),
12024 "environment variable \"",
12025 key, "\" does not exist", NULL);
12026 return JIM_ERR;
12027 }
12028 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12029 return JIM_OK;
12030 }
12031
12032 /* [source] */
12033 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12034 Jim_Obj *const *argv)
12035 {
12036 int retval;
12037
12038 if (argc != 2) {
12039 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12040 return JIM_ERR;
12041 }
12042 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12043 if (retval == JIM_ERR) {
12044 return JIM_ERR_ADDSTACK;
12045 }
12046 if (retval == JIM_RETURN)
12047 return JIM_OK;
12048 return retval;
12049 }
12050
12051 /* [lreverse] */
12052 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12053 Jim_Obj *const *argv)
12054 {
12055 Jim_Obj *revObjPtr, **ele;
12056 int len;
12057
12058 if (argc != 2) {
12059 Jim_WrongNumArgs(interp, 1, argv, "list");
12060 return JIM_ERR;
12061 }
12062 JimListGetElements(interp, argv[1], &len, &ele);
12063 len--;
12064 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12065 while (len >= 0)
12066 ListAppendElement(revObjPtr, ele[len--]);
12067 Jim_SetResult(interp, revObjPtr);
12068 return JIM_OK;
12069 }
12070
12071 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12072 {
12073 jim_wide len;
12074
12075 if (step == 0) return -1;
12076 if (start == end) return 0;
12077 else if (step > 0 && start > end) return -1;
12078 else if (step < 0 && end > start) return -1;
12079 len = end-start;
12080 if (len < 0) len = -len; /* abs(len) */
12081 if (step < 0) step = -step; /* abs(step) */
12082 len = 1 + ((len-1)/step);
12083 /* We can truncate safely to INT_MAX, the range command
12084 * will always return an error for a such long range
12085 * because Tcl lists can't be so long. */
12086 if (len > INT_MAX) len = INT_MAX;
12087 return (int)((len < 0) ? -1 : len);
12088 }
12089
12090 /* [range] */
12091 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12092 Jim_Obj *const *argv)
12093 {
12094 jim_wide start = 0, end, step = 1;
12095 int len, i;
12096 Jim_Obj *objPtr;
12097
12098 if (argc < 2 || argc > 4) {
12099 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12100 return JIM_ERR;
12101 }
12102 if (argc == 2) {
12103 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12104 return JIM_ERR;
12105 } else {
12106 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12107 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12108 return JIM_ERR;
12109 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12110 return JIM_ERR;
12111 }
12112 if ((len = JimRangeLen(start, end, step)) == -1) {
12113 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12114 return JIM_ERR;
12115 }
12116 objPtr = Jim_NewListObj(interp, NULL, 0);
12117 for (i = 0; i < len; i++)
12118 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12119 Jim_SetResult(interp, objPtr);
12120 return JIM_OK;
12121 }
12122
12123 /* [rand] */
12124 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12125 Jim_Obj *const *argv)
12126 {
12127 jim_wide min = 0, max =0, len, maxMul;
12128
12129 if (argc < 1 || argc > 3) {
12130 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12131 return JIM_ERR;
12132 }
12133 if (argc == 1) {
12134 max = JIM_WIDE_MAX;
12135 } else if (argc == 2) {
12136 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12137 return JIM_ERR;
12138 } else if (argc == 3) {
12139 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12140 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12141 return JIM_ERR;
12142 }
12143 len = max-min;
12144 if (len < 0) {
12145 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12146 return JIM_ERR;
12147 }
12148 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12149 while (1) {
12150 jim_wide r;
12151
12152 JimRandomBytes(interp, &r, sizeof(jim_wide));
12153 if (r < 0 || r >= maxMul) continue;
12154 r = (len == 0) ? 0 : r%len;
12155 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12156 return JIM_OK;
12157 }
12158 }
12159
12160 /* [package] */
12161 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12162 Jim_Obj *const *argv)
12163 {
12164 int option;
12165 const char *options[] = {
12166 "require", "provide", NULL
12167 };
12168 enum {OPT_REQUIRE, OPT_PROVIDE};
12169
12170 if (argc < 2) {
12171 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12172 return JIM_ERR;
12173 }
12174 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12175 JIM_ERRMSG) != JIM_OK)
12176 return JIM_ERR;
12177
12178 if (option == OPT_REQUIRE) {
12179 int exact = 0;
12180 const char *ver;
12181
12182 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12183 exact = 1;
12184 argv++;
12185 argc--;
12186 }
12187 if (argc != 3 && argc != 4) {
12188 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12189 return JIM_ERR;
12190 }
12191 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12192 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12193 JIM_ERRMSG);
12194 if (ver == NULL)
12195 return JIM_ERR_ADDSTACK;
12196 Jim_SetResultString(interp, ver, -1);
12197 } else if (option == OPT_PROVIDE) {
12198 if (argc != 4) {
12199 Jim_WrongNumArgs(interp, 2, argv, "package version");
12200 return JIM_ERR;
12201 }
12202 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12203 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12204 }
12205 return JIM_OK;
12206 }
12207
12208 static struct {
12209 const char *name;
12210 Jim_CmdProc cmdProc;
12211 } Jim_CoreCommandsTable[] = {
12212 {"set", Jim_SetCoreCommand},
12213 {"unset", Jim_UnsetCoreCommand},
12214 {"puts", Jim_PutsCoreCommand},
12215 {"+", Jim_AddCoreCommand},
12216 {"*", Jim_MulCoreCommand},
12217 {"-", Jim_SubCoreCommand},
12218 {"/", Jim_DivCoreCommand},
12219 {"incr", Jim_IncrCoreCommand},
12220 {"while", Jim_WhileCoreCommand},
12221 {"for", Jim_ForCoreCommand},
12222 {"foreach", Jim_ForeachCoreCommand},
12223 {"lmap", Jim_LmapCoreCommand},
12224 {"if", Jim_IfCoreCommand},
12225 {"switch", Jim_SwitchCoreCommand},
12226 {"list", Jim_ListCoreCommand},
12227 {"lindex", Jim_LindexCoreCommand},
12228 {"lset", Jim_LsetCoreCommand},
12229 {"llength", Jim_LlengthCoreCommand},
12230 {"lappend", Jim_LappendCoreCommand},
12231 {"linsert", Jim_LinsertCoreCommand},
12232 {"lsort", Jim_LsortCoreCommand},
12233 {"append", Jim_AppendCoreCommand},
12234 {"debug", Jim_DebugCoreCommand},
12235 {"eval", Jim_EvalCoreCommand},
12236 {"uplevel", Jim_UplevelCoreCommand},
12237 {"expr", Jim_ExprCoreCommand},
12238 {"break", Jim_BreakCoreCommand},
12239 {"continue", Jim_ContinueCoreCommand},
12240 {"proc", Jim_ProcCoreCommand},
12241 {"concat", Jim_ConcatCoreCommand},
12242 {"return", Jim_ReturnCoreCommand},
12243 {"upvar", Jim_UpvarCoreCommand},
12244 {"global", Jim_GlobalCoreCommand},
12245 {"string", Jim_StringCoreCommand},
12246 {"time", Jim_TimeCoreCommand},
12247 {"exit", Jim_ExitCoreCommand},
12248 {"catch", Jim_CatchCoreCommand},
12249 {"ref", Jim_RefCoreCommand},
12250 {"getref", Jim_GetrefCoreCommand},
12251 {"setref", Jim_SetrefCoreCommand},
12252 {"finalize", Jim_FinalizeCoreCommand},
12253 {"collect", Jim_CollectCoreCommand},
12254 {"rename", Jim_RenameCoreCommand},
12255 {"dict", Jim_DictCoreCommand},
12256 {"load", Jim_LoadCoreCommand},
12257 {"subst", Jim_SubstCoreCommand},
12258 {"info", Jim_InfoCoreCommand},
12259 {"split", Jim_SplitCoreCommand},
12260 {"join", Jim_JoinCoreCommand},
12261 {"format", Jim_FormatCoreCommand},
12262 {"scan", Jim_ScanCoreCommand},
12263 {"error", Jim_ErrorCoreCommand},
12264 {"lrange", Jim_LrangeCoreCommand},
12265 {"env", Jim_EnvCoreCommand},
12266 {"source", Jim_SourceCoreCommand},
12267 {"lreverse", Jim_LreverseCoreCommand},
12268 {"range", Jim_RangeCoreCommand},
12269 {"rand", Jim_RandCoreCommand},
12270 {"package", Jim_PackageCoreCommand},
12271 {"tailcall", Jim_TailcallCoreCommand},
12272 {NULL, NULL},
12273 };
12274
12275 /* Some Jim core command is actually a procedure written in Jim itself. */
12276 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12277 {
12278 Jim_Eval(interp, (char*)
12279 "proc lambda {arglist args} {\n"
12280 " set name [ref {} function lambdaFinalizer]\n"
12281 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12282 " return $name\n"
12283 "}\n"
12284 "proc lambdaFinalizer {name val} {\n"
12285 " rename $name {}\n"
12286 "}\n"
12287 );
12288 }
12289
12290 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12291 {
12292 int i = 0;
12293
12294 while (Jim_CoreCommandsTable[i].name != NULL) {
12295 Jim_CreateCommand(interp,
12296 Jim_CoreCommandsTable[i].name,
12297 Jim_CoreCommandsTable[i].cmdProc,
12298 NULL, NULL);
12299 i++;
12300 }
12301 Jim_RegisterCoreProcedures(interp);
12302 }
12303
12304 /* -----------------------------------------------------------------------------
12305 * Interactive prompt
12306 * ---------------------------------------------------------------------------*/
12307 void Jim_PrintErrorMessage(Jim_Interp *interp)
12308 {
12309 int len, i;
12310
12311 if (*interp->errorFileName) {
12312 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12313 interp->errorFileName, interp->errorLine);
12314 }
12315 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12316 Jim_GetString(interp->result, NULL));
12317 Jim_ListLength(interp, interp->stackTrace, &len);
12318 for (i = len-3; i >= 0; i-= 3) {
12319 Jim_Obj *objPtr=NULL;
12320 const char *proc, *file, *line;
12321
12322 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12323 proc = Jim_GetString(objPtr, NULL);
12324 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12325 JIM_NONE);
12326 file = Jim_GetString(objPtr, NULL);
12327 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12328 JIM_NONE);
12329 line = Jim_GetString(objPtr, NULL);
12330 if (*proc) {
12331 Jim_fprintf(interp, interp->cookie_stderr,
12332 "in procedure '%s' ", proc);
12333 }
12334 if (*file) {
12335 Jim_fprintf(interp, interp->cookie_stderr,
12336 "called at file \"%s\", line %s",
12337 file, line);
12338 }
12339 if (*file || *proc) {
12340 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12341 }
12342 }
12343 }
12344
12345 int Jim_InteractivePrompt(Jim_Interp *interp)
12346 {
12347 int retcode = JIM_OK;
12348 Jim_Obj *scriptObjPtr;
12349
12350 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12351 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12352 JIM_VERSION / 100, JIM_VERSION % 100);
12353 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12354 while (1) {
12355 char buf[1024];
12356 const char *result;
12357 const char *retcodestr[] = {
12358 "ok", "error", "return", "break", "continue", "eval", "exit"
12359 };
12360 int reslen;
12361
12362 if (retcode != 0) {
12363 if (retcode >= 2 && retcode <= 6)
12364 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12365 else
12366 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12367 } else
12368 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12369 Jim_fflush(interp, interp->cookie_stdout);
12370 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12371 Jim_IncrRefCount(scriptObjPtr);
12372 while (1) {
12373 const char *str;
12374 char state;
12375 int len;
12376
12377 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12378 Jim_DecrRefCount(interp, scriptObjPtr);
12379 goto out;
12380 }
12381 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12382 str = Jim_GetString(scriptObjPtr, &len);
12383 if (Jim_ScriptIsComplete(str, len, &state))
12384 break;
12385 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12386 Jim_fflush(interp, interp->cookie_stdout);
12387 }
12388 retcode = Jim_EvalObj(interp, scriptObjPtr);
12389 Jim_DecrRefCount(interp, scriptObjPtr);
12390 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12391 if (retcode == JIM_ERR) {
12392 Jim_PrintErrorMessage(interp);
12393 } else if (retcode == JIM_EXIT) {
12394 exit(Jim_GetExitCode(interp));
12395 } else {
12396 if (reslen) {
12397 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12398 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12399 }
12400 }
12401 }
12402 out:
12403 return 0;
12404 }
12405
12406 /* -----------------------------------------------------------------------------
12407 * Jim's idea of STDIO..
12408 * ---------------------------------------------------------------------------*/
12409
12410 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12411 {
12412 int r;
12413
12414 va_list ap;
12415 va_start(ap,fmt);
12416 r = Jim_vfprintf(interp, cookie, fmt,ap);
12417 va_end(ap);
12418 return r;
12419 }
12420
12421 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12422 {
12423 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12424 errno = ENOTSUP;
12425 return -1;
12426 }
12427 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12428 }
12429
12430 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12431 {
12432 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12433 errno = ENOTSUP;
12434 return 0;
12435 }
12436 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12437 }
12438
12439 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12440 {
12441 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12442 errno = ENOTSUP;
12443 return 0;
12444 }
12445 return (*(interp->cb_fread))(ptr, size, n, cookie);
12446 }
12447
12448 int Jim_fflush(Jim_Interp *interp, void *cookie)
12449 {
12450 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12451 /* pretend all is well */
12452 return 0;
12453 }
12454 return (*(interp->cb_fflush))(cookie);
12455 }
12456
12457 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12458 {
12459 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12460 errno = ENOTSUP;
12461 return NULL;
12462 }
12463 return (*(interp->cb_fgets))(s, size, cookie);
12464 }
12465 Jim_Nvp *
12466 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12467 {
12468 while (p->name) {
12469 if (0 == strcmp(name, p->name)) {
12470 break;
12471 }
12472 p++;
12473 }
12474 return ((Jim_Nvp *)(p));
12475 }
12476
12477 Jim_Nvp *
12478 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12479 {
12480 while (p->name) {
12481 if (0 == strcasecmp(name, p->name)) {
12482 break;
12483 }
12484 p++;
12485 }
12486 return ((Jim_Nvp *)(p));
12487 }
12488
12489 int
12490 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12491 const Jim_Nvp *p,
12492 Jim_Obj *o,
12493 Jim_Nvp **result)
12494 {
12495 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12496 }
12497
12498
12499 int
12500 Jim_Nvp_name2value(Jim_Interp *interp,
12501 const Jim_Nvp *_p,
12502 const char *name,
12503 Jim_Nvp **result)
12504 {
12505 const Jim_Nvp *p;
12506
12507 p = Jim_Nvp_name2value_simple(_p, name);
12508
12509 /* result */
12510 if (result) {
12511 *result = (Jim_Nvp *)(p);
12512 }
12513
12514 /* found? */
12515 if (p->name) {
12516 return JIM_OK;
12517 } else {
12518 return JIM_ERR;
12519 }
12520 }
12521
12522 int
12523 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12524 {
12525 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12526 }
12527
12528 int
12529 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12530 {
12531 const Jim_Nvp *p;
12532
12533 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12534
12535 if (puthere) {
12536 *puthere = (Jim_Nvp *)(p);
12537 }
12538 /* found */
12539 if (p->name) {
12540 return JIM_OK;
12541 } else {
12542 return JIM_ERR;
12543 }
12544 }
12545
12546
12547 int
12548 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12549 {
12550 int e;;
12551 jim_wide w;
12552
12553 e = Jim_GetWide(interp, o, &w);
12554 if (e != JIM_OK) {
12555 return e;
12556 }
12557
12558 return Jim_Nvp_value2name(interp, p, w, result);
12559 }
12560
12561 Jim_Nvp *
12562 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12563 {
12564 while (p->name) {
12565 if (value == p->value) {
12566 break;
12567 }
12568 p++;
12569 }
12570 return ((Jim_Nvp *)(p));
12571 }
12572
12573
12574 int
12575 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12576 {
12577 const Jim_Nvp *p;
12578
12579 p = Jim_Nvp_value2name_simple(_p, value);
12580
12581 if (result) {
12582 *result = (Jim_Nvp *)(p);
12583 }
12584
12585 if (p->name) {
12586 return JIM_OK;
12587 } else {
12588 return JIM_ERR;
12589 }
12590 }
12591
12592
12593 int
12594 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12595 {
12596 memset(p, 0, sizeof(*p));
12597 p->interp = interp;
12598 p->argc = argc;
12599 p->argv = argv;
12600
12601 return JIM_OK;
12602 }
12603
12604 void
12605 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12606 {
12607 int x;
12608
12609 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12610 for (x = 0 ; x < p->argc ; x++) {
12611 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12612 "%2d) %s\n",
12613 x,
12614 Jim_GetString(p->argv[x], NULL));
12615 }
12616 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12617 }
12618
12619
12620 int
12621 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12622 {
12623 Jim_Obj *o;
12624
12625 o = NULL; // failure
12626 if (goi->argc) {
12627 // success
12628 o = goi->argv[0];
12629 goi->argc -= 1;
12630 goi->argv += 1;
12631 }
12632 if (puthere) {
12633 *puthere = o;
12634 }
12635 if (o != NULL) {
12636 return JIM_OK;
12637 } else {
12638 return JIM_ERR;
12639 }
12640 }
12641
12642 int
12643 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12644 {
12645 int r;
12646 Jim_Obj *o;
12647 const char *cp;
12648
12649
12650 r = Jim_GetOpt_Obj(goi, &o);
12651 if (r == JIM_OK) {
12652 cp = Jim_GetString(o, len);
12653 if (puthere) {
12654 /* remove const */
12655 *puthere = (char *)(cp);
12656 }
12657 }
12658 return r;
12659 }
12660
12661 int
12662 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12663 {
12664 int r;
12665 Jim_Obj *o;
12666 double _safe;
12667
12668 if (puthere == NULL) {
12669 puthere = &_safe;
12670 }
12671
12672 r = Jim_GetOpt_Obj(goi, &o);
12673 if (r == JIM_OK) {
12674 r = Jim_GetDouble(goi->interp, o, puthere);
12675 if (r != JIM_OK) {
12676 Jim_SetResult_sprintf(goi->interp,
12677 "not a number: %s",
12678 Jim_GetString(o, NULL));
12679 }
12680 }
12681 return r;
12682 }
12683
12684 int
12685 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12686 {
12687 int r;
12688 Jim_Obj *o;
12689 jim_wide _safe;
12690
12691 if (puthere == NULL) {
12692 puthere = &_safe;
12693 }
12694
12695 r = Jim_GetOpt_Obj(goi, &o);
12696 if (r == JIM_OK) {
12697 r = Jim_GetWide(goi->interp, o, puthere);
12698 }
12699 return r;
12700 }
12701
12702 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12703 const Jim_Nvp *nvp,
12704 Jim_Nvp **puthere)
12705 {
12706 Jim_Nvp *_safe;
12707 Jim_Obj *o;
12708 int e;
12709
12710 if (puthere == NULL) {
12711 puthere = &_safe;
12712 }
12713
12714 e = Jim_GetOpt_Obj(goi, &o);
12715 if (e == JIM_OK) {
12716 e = Jim_Nvp_name2value_obj(goi->interp,
12717 nvp,
12718 o,
12719 puthere);
12720 }
12721
12722 return e;
12723 }
12724
12725 void
12726 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12727 const Jim_Nvp *nvptable,
12728 int hadprefix)
12729 {
12730 if (hadprefix) {
12731 Jim_SetResult_NvpUnknown(goi->interp,
12732 goi->argv[-2],
12733 goi->argv[-1],
12734 nvptable);
12735 } else {
12736 Jim_SetResult_NvpUnknown(goi->interp,
12737 NULL,
12738 goi->argv[-1],
12739 nvptable);
12740 }
12741 }
12742
12743
12744 int
12745 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12746 const char * const * lookup,
12747 int *puthere)
12748 {
12749 int _safe;
12750 Jim_Obj *o;
12751 int e;
12752
12753 if (puthere == NULL) {
12754 puthere = &_safe;
12755 }
12756 e = Jim_GetOpt_Obj(goi, &o);
12757 if (e == JIM_OK) {
12758 e = Jim_GetEnum(goi->interp,
12759 o,
12760 lookup,
12761 puthere,
12762 "option",
12763 JIM_ERRMSG);
12764 }
12765 return e;
12766 }
12767
12768
12769
12770 int
12771 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12772 {
12773 va_list ap;
12774 char *buf;
12775
12776 va_start(ap,fmt);
12777 buf = jim_vasprintf(fmt, ap);
12778 va_end(ap);
12779 if (buf) {
12780 Jim_SetResultString(interp, buf, -1);
12781 jim_vasprintf_done(buf);
12782 }
12783 return JIM_OK;
12784 }
12785
12786
12787 void
12788 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12789 Jim_Obj *param_name,
12790 Jim_Obj *param_value,
12791 const Jim_Nvp *nvp)
12792 {
12793 if (param_name) {
12794 Jim_SetResult_sprintf(interp,
12795 "%s: Unknown: %s, try one of: ",
12796 Jim_GetString(param_name, NULL),
12797 Jim_GetString(param_value, NULL));
12798 } else {
12799 Jim_SetResult_sprintf(interp,
12800 "Unknown param: %s, try one of: ",
12801 Jim_GetString(param_value, NULL));
12802 }
12803 while (nvp->name) {
12804 const char *a;
12805 const char *b;
12806
12807 if ((nvp + 1)->name) {
12808 a = nvp->name;
12809 b = ", ";
12810 } else {
12811 a = "or ";
12812 b = nvp->name;
12813 }
12814 Jim_AppendStrings(interp,
12815 Jim_GetResult(interp),
12816 a, b, NULL);
12817 nvp++;
12818 }
12819 }
12820
12821
12822 static Jim_Obj *debug_string_obj;
12823
12824 const char *
12825 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12826 {
12827 int x;
12828
12829 if (debug_string_obj) {
12830 Jim_FreeObj(interp, debug_string_obj);
12831 }
12832
12833 debug_string_obj = Jim_NewEmptyStringObj(interp);
12834 for (x = 0 ; x < argc ; x++) {
12835 Jim_AppendStrings(interp,
12836 debug_string_obj,
12837 Jim_GetString(argv[x], NULL),
12838 " ",
12839 NULL);
12840 }
12841
12842 return Jim_GetString(debug_string_obj, NULL);
12843 }

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)