cygwin 1.7 build fixes
[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 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 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index < 0) index = 0;
406 s2 += index;
407 for (i = index; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 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 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 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 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 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 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 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 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 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;
763 Jim_HashEntry *entry;
764
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index = 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];
773 ht->table[index] = 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 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 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 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 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)
2152 {
2153 if (index < 0)
2154 return len + index;
2155 return index;
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 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;
3043 int len, type, linenr;
3044
3045 JimParseScript(&parser);
3046 token = JimParserGetToken(&parser, &len, &type, &linenr);
3047 ScriptObjAddToken(interp, script, token, 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 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 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 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 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 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 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 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 Jim_Obj *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 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 const char *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 void ListInsertElements(Jim_Obj *listPtr, int index, 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;
5377 memmove(point + elemc, point, (currentLen-index) * 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 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,
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 >= 0 && index > listPtr->internalRep.listValue.len)
5444 index = listPtr->internalRep.listValue.len;
5445 else if (index < 0)
5446 index = 0;
5447 Jim_InvalidateStringRep(listPtr);
5448 ListInsertElements(listPtr, index, objc, objVec);
5449 }
5450
5451 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5452 Jim_Obj **objPtrPtr, int flags)
5453 {
5454 if (listPtr->typePtr != &listObjType)
5455 SetListFromAny(interp, listPtr);
5456 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5457 (index < 0 && (-index-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 < 0)
5465 index = listPtr->internalRep.listValue.len + index;
5466 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5467 return JIM_OK;
5468 }
5469
5470 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5471 Jim_Obj *newObjPtr, int flags)
5472 {
5473 if (listPtr->typePtr != &listObjType)
5474 SetListFromAny(interp, listPtr);
5475 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5476 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5477 if (flags & JIM_ERRMSG) {
5478 Jim_SetResultString(interp,
5479 "list index out of range", -1);
5480 }
5481 return JIM_ERR;
5482 }
5483 if (index < 0)
5484 index = listPtr->internalRep.listValue.len + index;
5485 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5486 listPtr->internalRep.listValue.ele[index] = 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;
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) != JIM_OK)
5508 goto err;
5509 if (Jim_ListIndex(interp, listObjPtr, index, &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, objPtr, JIM_NONE);
5516 }
5517 Jim_InvalidateStringRep(listObjPtr);
5518 }
5519 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5520 goto err;
5521 if (ListSetIndex(interp, objPtr, index, 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 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5594 {
5595 int first, last;
5596 int len, rangeLen;
5597
5598 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5599 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5600 return NULL;
5601 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5602 first = JimRelToAbsIndex(len, first);
5603 last = JimRelToAbsIndex(len, last);
5604 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5605 return Jim_NewListObj(interp,
5606 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5607 }
5608
5609 /* -----------------------------------------------------------------------------
5610 * Dict object
5611 * ---------------------------------------------------------------------------*/
5612 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5613 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5614 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5615 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5616
5617 /* Dict HashTable Type.
5618 *
5619 * Keys and Values are Jim objects. */
5620
5621 unsigned int JimObjectHTHashFunction(const void *key)
5622 {
5623 const char *str;
5624 Jim_Obj *objPtr = (Jim_Obj*) key;
5625 int len, h;
5626
5627 str = Jim_GetString(objPtr, &len);
5628 h = Jim_GenHashFunction((unsigned char*)str, len);
5629 return h;
5630 }
5631
5632 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5633 {
5634 JIM_NOTUSED(privdata);
5635
5636 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5637 }
5638
5639 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5640 {
5641 Jim_Obj *objPtr = val;
5642
5643 Jim_DecrRefCount(interp, objPtr);
5644 }
5645
5646 static Jim_HashTableType JimDictHashTableType = {
5647 JimObjectHTHashFunction, /* hash function */
5648 NULL, /* key dup */
5649 NULL, /* val dup */
5650 JimObjectHTKeyCompare, /* key compare */
5651 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5652 JimObjectHTKeyValDestructor, /* key destructor */
5653 JimObjectHTKeyValDestructor /* val destructor */
5654 };
5655
5656 /* Note that while the elements of the dict may contain references,
5657 * the list object itself can't. This basically means that the
5658 * dict object string representation as a whole can't contain references
5659 * that are not presents in the single elements. */
5660 static Jim_ObjType dictObjType = {
5661 "dict",
5662 FreeDictInternalRep,
5663 DupDictInternalRep,
5664 UpdateStringOfDict,
5665 JIM_TYPE_NONE,
5666 };
5667
5668 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5669 {
5670 JIM_NOTUSED(interp);
5671
5672 Jim_FreeHashTable(objPtr->internalRep.ptr);
5673 Jim_Free(objPtr->internalRep.ptr);
5674 }
5675
5676 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5677 {
5678 Jim_HashTable *ht, *dupHt;
5679 Jim_HashTableIterator *htiter;
5680 Jim_HashEntry *he;
5681
5682 /* Create a new hash table */
5683 ht = srcPtr->internalRep.ptr;
5684 dupHt = Jim_Alloc(sizeof(*dupHt));
5685 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5686 if (ht->size != 0)
5687 Jim_ExpandHashTable(dupHt, ht->size);
5688 /* Copy every element from the source to the dup hash table */
5689 htiter = Jim_GetHashTableIterator(ht);
5690 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5691 const Jim_Obj *keyObjPtr = he->key;
5692 Jim_Obj *valObjPtr = he->val;
5693
5694 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5695 Jim_IncrRefCount(valObjPtr);
5696 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5697 }
5698 Jim_FreeHashTableIterator(htiter);
5699
5700 dupPtr->internalRep.ptr = dupHt;
5701 dupPtr->typePtr = &dictObjType;
5702 }
5703
5704 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5705 {
5706 int i, bufLen, realLength;
5707 const char *strRep;
5708 char *p;
5709 int *quotingType, objc;
5710 Jim_HashTable *ht;
5711 Jim_HashTableIterator *htiter;
5712 Jim_HashEntry *he;
5713 Jim_Obj **objv;
5714
5715 /* Trun the hash table into a flat vector of Jim_Objects. */
5716 ht = objPtr->internalRep.ptr;
5717 objc = ht->used*2;
5718 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5719 htiter = Jim_GetHashTableIterator(ht);
5720 i = 0;
5721 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5722 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5723 objv[i++] = he->val;
5724 }
5725 Jim_FreeHashTableIterator(htiter);
5726 /* (Over) Estimate the space needed. */
5727 quotingType = Jim_Alloc(sizeof(int)*objc);
5728 bufLen = 0;
5729 for (i = 0; i < objc; i++) {
5730 int len;
5731
5732 strRep = Jim_GetString(objv[i], &len);
5733 quotingType[i] = ListElementQuotingType(strRep, len);
5734 switch (quotingType[i]) {
5735 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5736 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5737 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5738 }
5739 bufLen++; /* elements separator. */
5740 }
5741 bufLen++;
5742
5743 /* Generate the string rep. */
5744 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5745 realLength = 0;
5746 for (i = 0; i < objc; i++) {
5747 int len, qlen;
5748 const char *strRep = Jim_GetString(objv[i], &len);
5749 char *q;
5750
5751 switch (quotingType[i]) {
5752 case JIM_ELESTR_SIMPLE:
5753 memcpy(p, strRep, len);
5754 p += len;
5755 realLength += len;
5756 break;
5757 case JIM_ELESTR_BRACE:
5758 *p++ = '{';
5759 memcpy(p, strRep, len);
5760 p += len;
5761 *p++ = '}';
5762 realLength += len + 2;
5763 break;
5764 case JIM_ELESTR_QUOTE:
5765 q = BackslashQuoteString(strRep, len, &qlen);
5766 memcpy(p, q, qlen);
5767 Jim_Free(q);
5768 p += qlen;
5769 realLength += qlen;
5770 break;
5771 }
5772 /* Add a separating space */
5773 if (i + 1 != objc) {
5774 *p++ = ' ';
5775 realLength ++;
5776 }
5777 }
5778 *p = '\0'; /* nul term. */
5779 objPtr->length = realLength;
5780 Jim_Free(quotingType);
5781 Jim_Free(objv);
5782 }
5783
5784 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5785 {
5786 struct JimParserCtx parser;
5787 Jim_HashTable *ht;
5788 Jim_Obj *objv[2];
5789 const char *str;
5790 int i, strLen;
5791
5792 /* Get the string representation */
5793 str = Jim_GetString(objPtr, &strLen);
5794
5795 /* Free the old internal repr just now and initialize the
5796 * new one just now. The string->list conversion can't fail. */
5797 Jim_FreeIntRep(interp, objPtr);
5798 ht = Jim_Alloc(sizeof(*ht));
5799 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5800 objPtr->typePtr = &dictObjType;
5801 objPtr->internalRep.ptr = ht;
5802
5803 /* Convert into a dict */
5804 JimParserInit(&parser, str, strLen, 1);
5805 i = 0;
5806 while (!JimParserEof(&parser)) {
5807 char *token;
5808 int tokenLen, type;
5809
5810 JimParseList(&parser);
5811 if (JimParserTtype(&parser) != JIM_TT_STR &&
5812 JimParserTtype(&parser) != JIM_TT_ESC)
5813 continue;
5814 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5815 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5816 if (i == 2) {
5817 i = 0;
5818 Jim_IncrRefCount(objv[0]);
5819 Jim_IncrRefCount(objv[1]);
5820 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5821 Jim_HashEntry *he;
5822 he = Jim_FindHashEntry(ht, objv[0]);
5823 Jim_DecrRefCount(interp, objv[0]);
5824 /* ATTENTION: const cast */
5825 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5826 he->val = objv[1];
5827 }
5828 }
5829 }
5830 if (i) {
5831 Jim_FreeNewObj(interp, objv[0]);
5832 objPtr->typePtr = NULL;
5833 Jim_FreeHashTable(ht);
5834 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5835 return JIM_ERR;
5836 }
5837 return JIM_OK;
5838 }
5839
5840 /* Dict object API */
5841
5842 /* Add an element to a dict. objPtr must be of the "dict" type.
5843 * The higer-level exported function is Jim_DictAddElement().
5844 * If an element with the specified key already exists, the value
5845 * associated is replaced with the new one.
5846 *
5847 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5848 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5849 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5850 {
5851 Jim_HashTable *ht = objPtr->internalRep.ptr;
5852
5853 if (valueObjPtr == NULL) { /* unset */
5854 Jim_DeleteHashEntry(ht, keyObjPtr);
5855 return;
5856 }
5857 Jim_IncrRefCount(keyObjPtr);
5858 Jim_IncrRefCount(valueObjPtr);
5859 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5860 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5861 Jim_DecrRefCount(interp, keyObjPtr);
5862 /* ATTENTION: const cast */
5863 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5864 he->val = valueObjPtr;
5865 }
5866 }
5867
5868 /* Add an element, higher-level interface for DictAddElement().
5869 * If valueObjPtr == NULL, the key is removed if it exists. */
5870 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5871 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5872 {
5873 if (Jim_IsShared(objPtr))
5874 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5875 if (objPtr->typePtr != &dictObjType) {
5876 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5877 return JIM_ERR;
5878 }
5879 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5880 Jim_InvalidateStringRep(objPtr);
5881 return JIM_OK;
5882 }
5883
5884 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5885 {
5886 Jim_Obj *objPtr;
5887 int i;
5888
5889 if (len % 2)
5890 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5891
5892 objPtr = Jim_NewObj(interp);
5893 objPtr->typePtr = &dictObjType;
5894 objPtr->bytes = NULL;
5895 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5896 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5897 for (i = 0; i < len; i += 2)
5898 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5899 return objPtr;
5900 }
5901
5902 /* Return the value associated to the specified dict key */
5903 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5904 Jim_Obj **objPtrPtr, int flags)
5905 {
5906 Jim_HashEntry *he;
5907 Jim_HashTable *ht;
5908
5909 if (dictPtr->typePtr != &dictObjType) {
5910 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5911 return JIM_ERR;
5912 }
5913 ht = dictPtr->internalRep.ptr;
5914 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5915 if (flags & JIM_ERRMSG) {
5916 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5917 Jim_AppendStrings(interp, Jim_GetResult(interp),
5918 "key \"", Jim_GetString(keyPtr, NULL),
5919 "\" not found in dictionary", NULL);
5920 }
5921 return JIM_ERR;
5922 }
5923 *objPtrPtr = he->val;
5924 return JIM_OK;
5925 }
5926
5927 /* Return the value associated to the specified dict keys */
5928 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5929 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5930 {
5931 Jim_Obj *objPtr = NULL;
5932 int i;
5933
5934 if (keyc == 0) {
5935 *objPtrPtr = dictPtr;
5936 return JIM_OK;
5937 }
5938
5939 for (i = 0; i < keyc; i++) {
5940 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5941 != JIM_OK)
5942 return JIM_ERR;
5943 dictPtr = objPtr;
5944 }
5945 *objPtrPtr = objPtr;
5946 return JIM_OK;
5947 }
5948
5949 /* Modify the dict stored into the variable named 'varNamePtr'
5950 * setting the element specified by the 'keyc' keys objects in 'keyv',
5951 * with the new value of the element 'newObjPtr'.
5952 *
5953 * If newObjPtr == NULL the operation is to remove the given key
5954 * from the dictionary. */
5955 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5956 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5957 {
5958 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5959 int shared, i;
5960
5961 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5962 if (objPtr == NULL) {
5963 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5964 return JIM_ERR;
5965 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5966 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5967 Jim_FreeNewObj(interp, varObjPtr);
5968 return JIM_ERR;
5969 }
5970 }
5971 if ((shared = Jim_IsShared(objPtr)))
5972 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5973 for (i = 0; i < keyc-1; i++) {
5974 dictObjPtr = objPtr;
5975
5976 /* Check if it's a valid dictionary */
5977 if (dictObjPtr->typePtr != &dictObjType) {
5978 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5979 goto err;
5980 }
5981 /* Check if the given key exists. */
5982 Jim_InvalidateStringRep(dictObjPtr);
5983 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5984 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5985 {
5986 /* This key exists at the current level.
5987 * Make sure it's not shared!. */
5988 if (Jim_IsShared(objPtr)) {
5989 objPtr = Jim_DuplicateObj(interp, objPtr);
5990 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5991 }
5992 } else {
5993 /* Key not found. If it's an [unset] operation
5994 * this is an error. Only the last key may not
5995 * exist. */
5996 if (newObjPtr == NULL)
5997 goto err;
5998 /* Otherwise set an empty dictionary
5999 * as key's value. */
6000 objPtr = Jim_NewDictObj(interp, NULL, 0);
6001 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6002 }
6003 }
6004 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6005 != JIM_OK)
6006 goto err;
6007 Jim_InvalidateStringRep(objPtr);
6008 Jim_InvalidateStringRep(varObjPtr);
6009 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6010 goto err;
6011 Jim_SetResult(interp, varObjPtr);
6012 return JIM_OK;
6013 err:
6014 if (shared) {
6015 Jim_FreeNewObj(interp, varObjPtr);
6016 }
6017 return JIM_ERR;
6018 }
6019
6020 /* -----------------------------------------------------------------------------
6021 * Index object
6022 * ---------------------------------------------------------------------------*/
6023 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6024 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6025
6026 static Jim_ObjType indexObjType = {
6027 "index",
6028 NULL,
6029 NULL,
6030 UpdateStringOfIndex,
6031 JIM_TYPE_NONE,
6032 };
6033
6034 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6035 {
6036 int len;
6037 char buf[JIM_INTEGER_SPACE + 1];
6038
6039 if (objPtr->internalRep.indexValue >= 0)
6040 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6041 else if (objPtr->internalRep.indexValue == -1)
6042 len = sprintf(buf, "end");
6043 else {
6044 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6045 }
6046 objPtr->bytes = Jim_Alloc(len + 1);
6047 memcpy(objPtr->bytes, buf, len + 1);
6048 objPtr->length = len;
6049 }
6050
6051 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6052 {
6053 int index, end = 0;
6054 const char *str;
6055
6056 /* Get the string representation */
6057 str = Jim_GetString(objPtr, NULL);
6058 /* Try to convert into an index */
6059 if (!strcmp(str, "end")) {
6060 index = 0;
6061 end = 1;
6062 } else {
6063 if (!strncmp(str, "end-", 4)) {
6064 str += 4;
6065 end = 1;
6066 }
6067 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6068 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6069 Jim_AppendStrings(interp, Jim_GetResult(interp),
6070 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6071 "must be integer or end?-integer?", NULL);
6072 return JIM_ERR;
6073 }
6074 }
6075 if (end) {
6076 if (index < 0)
6077 index = INT_MAX;
6078 else
6079 index = -(index + 1);
6080 } else if (index < 0)
6081 index = -INT_MAX;
6082 /* Free the old internal repr and set the new one. */
6083 Jim_FreeIntRep(interp, objPtr);
6084 objPtr->typePtr = &indexObjType;
6085 objPtr->internalRep.indexValue = index;
6086 return JIM_OK;
6087 }
6088
6089 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6090 {
6091 /* Avoid shimmering if the object is an integer. */
6092 if (objPtr->typePtr == &intObjType) {
6093 jim_wide val = objPtr->internalRep.wideValue;
6094 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6095 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6096 return JIM_OK;
6097 }
6098 }
6099 if (objPtr->typePtr != &indexObjType &&
6100 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6101 return JIM_ERR;
6102 *indexPtr = objPtr->internalRep.indexValue;
6103 return JIM_OK;
6104 }
6105
6106 /* -----------------------------------------------------------------------------
6107 * Return Code Object.
6108 * ---------------------------------------------------------------------------*/
6109
6110 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6111
6112 static Jim_ObjType returnCodeObjType = {
6113 "return-code",
6114 NULL,
6115 NULL,
6116 NULL,
6117 JIM_TYPE_NONE,
6118 };
6119
6120 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6121 {
6122 const char *str;
6123 int strLen, returnCode;
6124 jim_wide wideValue;
6125
6126 /* Get the string representation */
6127 str = Jim_GetString(objPtr, &strLen);
6128 /* Try to convert into an integer */
6129 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6130 returnCode = (int) wideValue;
6131 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6132 returnCode = JIM_OK;
6133 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6134 returnCode = JIM_ERR;
6135 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6136 returnCode = JIM_RETURN;
6137 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6138 returnCode = JIM_BREAK;
6139 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6140 returnCode = JIM_CONTINUE;
6141 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6142 returnCode = JIM_EVAL;
6143 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6144 returnCode = JIM_EXIT;
6145 else {
6146 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6147 Jim_AppendStrings(interp, Jim_GetResult(interp),
6148 "expected return code but got '", str, "'",
6149 NULL);
6150 return JIM_ERR;
6151 }
6152 /* Free the old internal repr and set the new one. */
6153 Jim_FreeIntRep(interp, objPtr);
6154 objPtr->typePtr = &returnCodeObjType;
6155 objPtr->internalRep.returnCode = returnCode;
6156 return JIM_OK;
6157 }
6158
6159 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6160 {
6161 if (objPtr->typePtr != &returnCodeObjType &&
6162 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6163 return JIM_ERR;
6164 *intPtr = objPtr->internalRep.returnCode;
6165 return JIM_OK;
6166 }
6167
6168 /* -----------------------------------------------------------------------------
6169 * Expression Parsing
6170 * ---------------------------------------------------------------------------*/
6171 static int JimParseExprOperator(struct JimParserCtx *pc);
6172 static int JimParseExprNumber(struct JimParserCtx *pc);
6173 static int JimParseExprIrrational(struct JimParserCtx *pc);
6174
6175 /* Exrp's Stack machine operators opcodes. */
6176
6177 /* Binary operators (numbers) */
6178 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6179 #define JIM_EXPROP_MUL 0
6180 #define JIM_EXPROP_DIV 1
6181 #define JIM_EXPROP_MOD 2
6182 #define JIM_EXPROP_SUB 3
6183 #define JIM_EXPROP_ADD 4
6184 #define JIM_EXPROP_LSHIFT 5
6185 #define JIM_EXPROP_RSHIFT 6
6186 #define JIM_EXPROP_ROTL 7
6187 #define JIM_EXPROP_ROTR 8
6188 #define JIM_EXPROP_LT 9
6189 #define JIM_EXPROP_GT 10
6190 #define JIM_EXPROP_LTE 11
6191 #define JIM_EXPROP_GTE 12
6192 #define JIM_EXPROP_NUMEQ 13
6193 #define JIM_EXPROP_NUMNE 14
6194 #define JIM_EXPROP_BITAND 15
6195 #define JIM_EXPROP_BITXOR 16
6196 #define JIM_EXPROP_BITOR 17
6197 #define JIM_EXPROP_LOGICAND 18
6198 #define JIM_EXPROP_LOGICOR 19
6199 #define JIM_EXPROP_LOGICAND_LEFT 20
6200 #define JIM_EXPROP_LOGICOR_LEFT 21
6201 #define JIM_EXPROP_POW 22
6202 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6203
6204 /* Binary operators (strings) */
6205 #define JIM_EXPROP_STREQ 23
6206 #define JIM_EXPROP_STRNE 24
6207
6208 /* Unary operators (numbers) */
6209 #define JIM_EXPROP_NOT 25
6210 #define JIM_EXPROP_BITNOT 26
6211 #define JIM_EXPROP_UNARYMINUS 27
6212 #define JIM_EXPROP_UNARYPLUS 28
6213 #define JIM_EXPROP_LOGICAND_RIGHT 29
6214 #define JIM_EXPROP_LOGICOR_RIGHT 30
6215
6216 /* Ternary operators */
6217 #define JIM_EXPROP_TERNARY 31
6218
6219 /* Operands */
6220 #define JIM_EXPROP_NUMBER 32
6221 #define JIM_EXPROP_COMMAND 33
6222 #define JIM_EXPROP_VARIABLE 34
6223 #define JIM_EXPROP_DICTSUGAR 35
6224 #define JIM_EXPROP_SUBST 36
6225 #define JIM_EXPROP_STRING 37
6226
6227 /* Operators table */
6228 typedef struct Jim_ExprOperator {
6229 const char *name;
6230 int precedence;
6231 int arity;
6232 int opcode;
6233 } Jim_ExprOperator;
6234
6235 /* name - precedence - arity - opcode */
6236 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6237 {"!", 300, 1, JIM_EXPROP_NOT},
6238 {"~", 300, 1, JIM_EXPROP_BITNOT},
6239 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6240 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6241
6242 {"**", 250, 2, JIM_EXPROP_POW},
6243
6244 {"*", 200, 2, JIM_EXPROP_MUL},
6245 {"/", 200, 2, JIM_EXPROP_DIV},
6246 {"%", 200, 2, JIM_EXPROP_MOD},
6247
6248 {"-", 100, 2, JIM_EXPROP_SUB},
6249 {"+", 100, 2, JIM_EXPROP_ADD},
6250
6251 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6252 {">>>", 90, 3, JIM_EXPROP_ROTR},
6253 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6254 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6255
6256 {"<", 80, 2, JIM_EXPROP_LT},
6257 {">", 80, 2, JIM_EXPROP_GT},
6258 {"<=", 80, 2, JIM_EXPROP_LTE},
6259 {">=", 80, 2, JIM_EXPROP_GTE},
6260
6261 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6262 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6263
6264 {"eq", 60, 2, JIM_EXPROP_STREQ},
6265 {"ne", 60, 2, JIM_EXPROP_STRNE},
6266
6267 {"&", 50, 2, JIM_EXPROP_BITAND},
6268 {"^", 49, 2, JIM_EXPROP_BITXOR},
6269 {"|", 48, 2, JIM_EXPROP_BITOR},
6270
6271 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6272 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6273
6274 {"?", 5, 3, JIM_EXPROP_TERNARY},
6275 /* private operators */
6276 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6277 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6278 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6279 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6280 };
6281
6282 #define JIM_EXPR_OPERATORS_NUM \
6283 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6284
6285 int JimParseExpression(struct JimParserCtx *pc)
6286 {
6287 /* Discard spaces and quoted newline */
6288 while (*(pc->p) == ' ' ||
6289 *(pc->p) == '\t' ||
6290 *(pc->p) == '\r' ||
6291 *(pc->p) == '\n' ||
6292 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6293 pc->p++; pc->len--;
6294 }
6295
6296 if (pc->len == 0) {
6297 pc->tstart = pc->tend = pc->p;
6298 pc->tline = pc->linenr;
6299 pc->tt = JIM_TT_EOL;
6300 pc->eof = 1;
6301 return JIM_OK;
6302 }
6303 switch (*(pc->p)) {
6304 case '(':
6305 pc->tstart = pc->tend = pc->p;
6306 pc->tline = pc->linenr;
6307 pc->tt = JIM_TT_SUBEXPR_START;
6308 pc->p++; pc->len--;
6309 break;
6310 case ')':
6311 pc->tstart = pc->tend = pc->p;
6312 pc->tline = pc->linenr;
6313 pc->tt = JIM_TT_SUBEXPR_END;
6314 pc->p++; pc->len--;
6315 break;
6316 case '[':
6317 return JimParseCmd(pc);
6318 break;
6319 case '$':
6320 if (JimParseVar(pc) == JIM_ERR)
6321 return JimParseExprOperator(pc);
6322 else
6323 return JIM_OK;
6324 break;
6325 case '-':
6326 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6327 isdigit((int)*(pc->p + 1)))
6328 return JimParseExprNumber(pc);
6329 else
6330 return JimParseExprOperator(pc);
6331 break;
6332 case '0': case '1': case '2': case '3': case '4':
6333 case '5': case '6': case '7': case '8': case '9': case '.':
6334 return JimParseExprNumber(pc);
6335 break;
6336 case '"':
6337 case '{':
6338 /* Here it's possible to reuse the List String parsing. */
6339 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6340 return JimParseListStr(pc);
6341 break;
6342 case 'N': case 'I':
6343 case 'n': case 'i':
6344 if (JimParseExprIrrational(pc) == JIM_ERR)
6345 return JimParseExprOperator(pc);
6346 break;
6347 default:
6348 return JimParseExprOperator(pc);
6349 break;
6350 }
6351 return JIM_OK;
6352 }
6353
6354 int JimParseExprNumber(struct JimParserCtx *pc)
6355 {
6356 int allowdot = 1;
6357 int allowhex = 0;
6358
6359 pc->tstart = pc->p;
6360 pc->tline = pc->linenr;
6361 if (*pc->p == '-') {
6362 pc->p++; pc->len--;
6363 }
6364 while (isdigit((int)*pc->p)
6365 || (allowhex && isxdigit((int)*pc->p))
6366 || (allowdot && *pc->p == '.')
6367 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6368 (*pc->p == 'x' || *pc->p == 'X'))
6369 )
6370 {
6371 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6372 allowhex = 1;
6373 allowdot = 0;
6374 }
6375 if (*pc->p == '.')
6376 allowdot = 0;
6377 pc->p++; pc->len--;
6378 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6379 pc->p += 2; pc->len -= 2;
6380 }
6381 }
6382 pc->tend = pc->p-1;
6383 pc->tt = JIM_TT_EXPR_NUMBER;
6384 return JIM_OK;
6385 }
6386
6387 int JimParseExprIrrational(struct JimParserCtx *pc)
6388 {
6389 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6390 const char **token;
6391 for (token = Tokens; *token != NULL; token++) {
6392 int len = strlen(*token);
6393 if (strncmp(*token, pc->p, len) == 0) {
6394 pc->tstart = pc->p;
6395 pc->tend = pc->p + len - 1;
6396 pc->p += len; pc->len -= len;
6397 pc->tline = pc->linenr;
6398 pc->tt = JIM_TT_EXPR_NUMBER;
6399 return JIM_OK;
6400 }
6401 }
6402 return JIM_ERR;
6403 }
6404
6405 int JimParseExprOperator(struct JimParserCtx *pc)
6406 {
6407 int i;
6408 int bestIdx = -1, bestLen = 0;
6409
6410 /* Try to get the longest match. */
6411 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6412 const char *opname;
6413 int oplen;
6414
6415 opname = Jim_ExprOperators[i].name;
6416 if (opname == NULL) continue;
6417 oplen = strlen(opname);
6418
6419 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6420 bestIdx = i;
6421 bestLen = oplen;
6422 }
6423 }
6424 if (bestIdx == -1) return JIM_ERR;
6425 pc->tstart = pc->p;
6426 pc->tend = pc->p + bestLen - 1;
6427 pc->p += bestLen; pc->len -= bestLen;
6428 pc->tline = pc->linenr;
6429 pc->tt = JIM_TT_EXPR_OPERATOR;
6430 return JIM_OK;
6431 }
6432
6433 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6434 {
6435 int i;
6436 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6437 if (Jim_ExprOperators[i].name &&
6438 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6439 return &Jim_ExprOperators[i];
6440 return NULL;
6441 }
6442
6443 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6444 {
6445 int i;
6446 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6447 if (Jim_ExprOperators[i].opcode == opcode)
6448 return &Jim_ExprOperators[i];
6449 return NULL;
6450 }
6451
6452 /* -----------------------------------------------------------------------------
6453 * Expression Object
6454 * ---------------------------------------------------------------------------*/
6455 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6456 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6457 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6458
6459 static Jim_ObjType exprObjType = {
6460 "expression",
6461 FreeExprInternalRep,
6462 DupExprInternalRep,
6463 NULL,
6464 JIM_TYPE_REFERENCES,
6465 };
6466
6467 /* Expr bytecode structure */
6468 typedef struct ExprByteCode {
6469 int *opcode; /* Integer array of opcodes. */
6470 Jim_Obj **obj; /* Array of associated Jim Objects. */
6471 int len; /* Bytecode length */
6472 int inUse; /* Used for sharing. */
6473 } ExprByteCode;
6474
6475 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6476 {
6477 int i;
6478 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6479
6480 expr->inUse--;
6481 if (expr->inUse != 0) return;
6482 for (i = 0; i < expr->len; i++)
6483 Jim_DecrRefCount(interp, expr->obj[i]);
6484 Jim_Free(expr->opcode);
6485 Jim_Free(expr->obj);
6486 Jim_Free(expr);
6487 }
6488
6489 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6490 {
6491 JIM_NOTUSED(interp);
6492 JIM_NOTUSED(srcPtr);
6493
6494 /* Just returns an simple string. */
6495 dupPtr->typePtr = NULL;
6496 }
6497
6498 /* Add a new instruction to an expression bytecode structure. */
6499 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6500 int opcode, char *str, int len)
6501 {
6502 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6503 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6504 expr->opcode[expr->len] = opcode;
6505 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6506 Jim_IncrRefCount(expr->obj[expr->len]);
6507 expr->len++;
6508 }
6509
6510 /* Check if an expr program looks correct. */
6511 static int ExprCheckCorrectness(ExprByteCode *expr)
6512 {
6513 int i;
6514 int stacklen = 0;
6515
6516 /* Try to check if there are stack underflows,
6517 * and make sure at the end of the program there is
6518 * a single result on the stack. */
6519 for (i = 0; i < expr->len; i++) {
6520 switch (expr->opcode[i]) {
6521 case JIM_EXPROP_NUMBER:
6522 case JIM_EXPROP_STRING:
6523 case JIM_EXPROP_SUBST:
6524 case JIM_EXPROP_VARIABLE:
6525 case JIM_EXPROP_DICTSUGAR:
6526 case JIM_EXPROP_COMMAND:
6527 stacklen++;
6528 break;
6529 case JIM_EXPROP_NOT:
6530 case JIM_EXPROP_BITNOT:
6531 case JIM_EXPROP_UNARYMINUS:
6532 case JIM_EXPROP_UNARYPLUS:
6533 /* Unary operations */
6534 if (stacklen < 1) return JIM_ERR;
6535 break;
6536 case JIM_EXPROP_ADD:
6537 case JIM_EXPROP_SUB:
6538 case JIM_EXPROP_MUL:
6539 case JIM_EXPROP_DIV:
6540 case JIM_EXPROP_MOD:
6541 case JIM_EXPROP_LT:
6542 case JIM_EXPROP_GT:
6543 case JIM_EXPROP_LTE:
6544 case JIM_EXPROP_GTE:
6545 case JIM_EXPROP_ROTL:
6546 case JIM_EXPROP_ROTR:
6547 case JIM_EXPROP_LSHIFT:
6548 case JIM_EXPROP_RSHIFT:
6549 case JIM_EXPROP_NUMEQ:
6550 case JIM_EXPROP_NUMNE:
6551 case JIM_EXPROP_STREQ:
6552 case JIM_EXPROP_STRNE:
6553 case JIM_EXPROP_BITAND:
6554 case JIM_EXPROP_BITXOR:
6555 case JIM_EXPROP_BITOR:
6556 case JIM_EXPROP_LOGICAND:
6557 case JIM_EXPROP_LOGICOR:
6558 case JIM_EXPROP_POW:
6559 /* binary operations */
6560 if (stacklen < 2) return JIM_ERR;
6561 stacklen--;
6562 break;
6563 default:
6564 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6565 break;
6566 }
6567 }
6568 if (stacklen != 1) return JIM_ERR;
6569 return JIM_OK;
6570 }
6571
6572 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6573 ScriptObj *topLevelScript)
6574 {
6575 int i;
6576
6577 return;
6578 for (i = 0; i < expr->len; i++) {
6579 Jim_Obj *foundObjPtr;
6580
6581 if (expr->obj[i] == NULL) continue;
6582 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6583 NULL, expr->obj[i]);
6584 if (foundObjPtr != NULL) {
6585 Jim_IncrRefCount(foundObjPtr);
6586 Jim_DecrRefCount(interp, expr->obj[i]);
6587 expr->obj[i] = foundObjPtr;
6588 }
6589 }
6590 }
6591
6592 /* This procedure converts every occurrence of || and && opereators
6593 * in lazy unary versions.
6594 *
6595 * a b || is converted into:
6596 *
6597 * a <offset> |L b |R
6598 *
6599 * a b && is converted into:
6600 *
6601 * a <offset> &L b &R
6602 *
6603 * "|L" checks if 'a' is true:
6604 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6605 * the opcode just after |R.
6606 * 2) if it is false does nothing.
6607 * "|R" checks if 'b' is true:
6608 * 1) if it is true pushes 1, otherwise pushes 0.
6609 *
6610 * "&L" checks if 'a' is true:
6611 * 1) if it is true does nothing.
6612 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6613 * the opcode just after &R
6614 * "&R" checks if 'a' is true:
6615 * if it is true pushes 1, otherwise pushes 0.
6616 */
6617 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6618 {
6619 while (1) {
6620 int index = -1, leftindex, arity, i, offset;
6621 Jim_ExprOperator *op;
6622
6623 /* Search for || or && */
6624 for (i = 0; i < expr->len; i++) {
6625 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6626 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6627 index = i;
6628 break;
6629 }
6630 }
6631 if (index == -1) return;
6632 /* Search for the end of the first operator */
6633 leftindex = index-1;
6634 arity = 1;
6635 while (arity) {
6636 switch (expr->opcode[leftindex]) {
6637 case JIM_EXPROP_NUMBER:
6638 case JIM_EXPROP_COMMAND:
6639 case JIM_EXPROP_VARIABLE:
6640 case JIM_EXPROP_DICTSUGAR:
6641 case JIM_EXPROP_SUBST:
6642 case JIM_EXPROP_STRING:
6643 break;
6644 default:
6645 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6646 if (op == NULL) {
6647 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6648 }
6649 arity += op->arity;
6650 break;
6651 }
6652 arity--;
6653 leftindex--;
6654 }
6655 leftindex++;
6656 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6657 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6658 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6659 sizeof(int)*(expr->len-leftindex));
6660 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6661 sizeof(Jim_Obj*)*(expr->len-leftindex));
6662 expr->len += 2;
6663 index += 2;
6664 offset = (index-leftindex)-1;
6665 Jim_DecrRefCount(interp, expr->obj[index]);
6666 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6667 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6668 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6669 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6670 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6671 } else {
6672 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6673 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6674 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6675 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6676 }
6677 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6678 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6679 Jim_IncrRefCount(expr->obj[index]);
6680 Jim_IncrRefCount(expr->obj[leftindex]);
6681 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6682 }
6683 }
6684
6685 /* This method takes the string representation of an expression
6686 * and generates a program for the Expr's stack-based VM. */
6687 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6688 {
6689 int exprTextLen;
6690 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6691 struct JimParserCtx parser;
6692 int i, shareLiterals;
6693 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6694 Jim_Stack stack;
6695 Jim_ExprOperator *op;
6696
6697 /* Perform literal sharing with the current procedure
6698 * running only if this expression appears to be not generated
6699 * at runtime. */
6700 shareLiterals = objPtr->typePtr == &sourceObjType;
6701
6702 expr->opcode = NULL;
6703 expr->obj = NULL;
6704 expr->len = 0;
6705 expr->inUse = 1;
6706
6707 Jim_InitStack(&stack);
6708 JimParserInit(&parser, exprText, exprTextLen, 1);
6709 while (!JimParserEof(&parser)) {
6710 char *token;
6711 int len, type;
6712
6713 if (JimParseExpression(&parser) != JIM_OK) {
6714 Jim_SetResultString(interp, "Syntax error in expression", -1);
6715 goto err;
6716 }
6717 token = JimParserGetToken(&parser, &len, &type, NULL);
6718 if (type == JIM_TT_EOL) {
6719 Jim_Free(token);
6720 break;
6721 }
6722 switch (type) {
6723 case JIM_TT_STR:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6725 break;
6726 case JIM_TT_ESC:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6728 break;
6729 case JIM_TT_VAR:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6731 break;
6732 case JIM_TT_DICTSUGAR:
6733 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6734 break;
6735 case JIM_TT_CMD:
6736 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6737 break;
6738 case JIM_TT_EXPR_NUMBER:
6739 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6740 break;
6741 case JIM_TT_EXPR_OPERATOR:
6742 op = JimExprOperatorInfo(token);
6743 while (1) {
6744 Jim_ExprOperator *stackTopOp;
6745
6746 if (Jim_StackPeek(&stack) != NULL) {
6747 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6748 } else {
6749 stackTopOp = NULL;
6750 }
6751 if (Jim_StackLen(&stack) && op->arity != 1 &&
6752 stackTopOp && stackTopOp->precedence >= op->precedence)
6753 {
6754 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6755 Jim_StackPeek(&stack), -1);
6756 Jim_StackPop(&stack);
6757 } else {
6758 break;
6759 }
6760 }
6761 Jim_StackPush(&stack, token);
6762 break;
6763 case JIM_TT_SUBEXPR_START:
6764 Jim_StackPush(&stack, Jim_StrDup("("));
6765 Jim_Free(token);
6766 break;
6767 case JIM_TT_SUBEXPR_END:
6768 {
6769 int found = 0;
6770 while (Jim_StackLen(&stack)) {
6771 char *opstr = Jim_StackPop(&stack);
6772 if (!strcmp(opstr, "(")) {
6773 Jim_Free(opstr);
6774 found = 1;
6775 break;
6776 }
6777 op = JimExprOperatorInfo(opstr);
6778 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6779 }
6780 if (!found) {
6781 Jim_SetResultString(interp,
6782 "Unexpected close parenthesis", -1);
6783 goto err;
6784 }
6785 }
6786 Jim_Free(token);
6787 break;
6788 default:
6789 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6790 break;
6791 }
6792 }
6793 while (Jim_StackLen(&stack)) {
6794 char *opstr = Jim_StackPop(&stack);
6795 op = JimExprOperatorInfo(opstr);
6796 if (op == NULL && !strcmp(opstr, "(")) {
6797 Jim_Free(opstr);
6798 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6799 goto err;
6800 }
6801 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6802 }
6803 /* Check program correctness. */
6804 if (ExprCheckCorrectness(expr) != JIM_OK) {
6805 Jim_SetResultString(interp, "Invalid expression", -1);
6806 goto err;
6807 }
6808
6809 /* Free the stack used for the compilation. */
6810 Jim_FreeStackElements(&stack, Jim_Free);
6811 Jim_FreeStack(&stack);
6812
6813 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6814 ExprMakeLazy(interp, expr);
6815
6816 /* Perform literal sharing */
6817 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6818 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6819 if (bodyObjPtr->typePtr == &scriptObjType) {
6820 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6821 ExprShareLiterals(interp, expr, bodyScript);
6822 }
6823 }
6824
6825 /* Free the old internal rep and set the new one. */
6826 Jim_FreeIntRep(interp, objPtr);
6827 Jim_SetIntRepPtr(objPtr, expr);
6828 objPtr->typePtr = &exprObjType;
6829 return JIM_OK;
6830
6831 err: /* we jump here on syntax/compile errors. */
6832 Jim_FreeStackElements(&stack, Jim_Free);
6833 Jim_FreeStack(&stack);
6834 Jim_Free(expr->opcode);
6835 for (i = 0; i < expr->len; i++) {
6836 Jim_DecrRefCount(interp,expr->obj[i]);
6837 }
6838 Jim_Free(expr->obj);
6839 Jim_Free(expr);
6840 return JIM_ERR;
6841 }
6842
6843 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6844 {
6845 if (objPtr->typePtr != &exprObjType) {
6846 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6847 return NULL;
6848 }
6849 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6850 }
6851
6852 /* -----------------------------------------------------------------------------
6853 * Expressions evaluation.
6854 * Jim uses a specialized stack-based virtual machine for expressions,
6855 * that takes advantage of the fact that expr's operators
6856 * can't be redefined.
6857 *
6858 * Jim_EvalExpression() uses the bytecode compiled by
6859 * SetExprFromAny() method of the "expression" object.
6860 *
6861 * On success a Tcl Object containing the result of the evaluation
6862 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6863 * returned.
6864 * On error the function returns a retcode != to JIM_OK and set a suitable
6865 * error on the interp.
6866 * ---------------------------------------------------------------------------*/
6867 #define JIM_EE_STATICSTACK_LEN 10
6868
6869 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6870 Jim_Obj **exprResultPtrPtr)
6871 {
6872 ExprByteCode *expr;
6873 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6874 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6875
6876 Jim_IncrRefCount(exprObjPtr);
6877 expr = Jim_GetExpression(interp, exprObjPtr);
6878 if (!expr) {
6879 Jim_DecrRefCount(interp, exprObjPtr);
6880 return JIM_ERR; /* error in expression. */
6881 }
6882 /* In order to avoid that the internal repr gets freed due to
6883 * shimmering of the exprObjPtr's object, we make the internal rep
6884 * shared. */
6885 expr->inUse++;
6886
6887 /* The stack-based expr VM itself */
6888
6889 /* Stack allocation. Expr programs have the feature that
6890 * a program of length N can't require a stack longer than
6891 * N. */
6892 if (expr->len > JIM_EE_STATICSTACK_LEN)
6893 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6894 else
6895 stack = staticStack;
6896
6897 /* Execute every istruction */
6898 for (i = 0; i < expr->len; i++) {
6899 Jim_Obj *A, *B, *objPtr;
6900 jim_wide wA, wB, wC;
6901 double dA, dB, dC;
6902 const char *sA, *sB;
6903 int Alen, Blen, retcode;
6904 int opcode = expr->opcode[i];
6905
6906 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6907 stack[stacklen++] = expr->obj[i];
6908 Jim_IncrRefCount(expr->obj[i]);
6909 } else if (opcode == JIM_EXPROP_VARIABLE) {
6910 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6911 if (objPtr == NULL) {
6912 error = 1;
6913 goto err;
6914 }
6915 stack[stacklen++] = objPtr;
6916 Jim_IncrRefCount(objPtr);
6917 } else if (opcode == JIM_EXPROP_SUBST) {
6918 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6919 &objPtr, JIM_NONE)) != JIM_OK)
6920 {
6921 error = 1;
6922 errRetCode = retcode;
6923 goto err;
6924 }
6925 stack[stacklen++] = objPtr;
6926 Jim_IncrRefCount(objPtr);
6927 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6928 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6929 if (objPtr == NULL) {
6930 error = 1;
6931 goto err;
6932 }
6933 stack[stacklen++] = objPtr;
6934 Jim_IncrRefCount(objPtr);
6935 } else if (opcode == JIM_EXPROP_COMMAND) {
6936 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6937 error = 1;
6938 errRetCode = retcode;
6939 goto err;
6940 }
6941 stack[stacklen++] = interp->result;
6942 Jim_IncrRefCount(interp->result);
6943 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6944 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6945 {
6946 /* Note that there isn't to increment the
6947 * refcount of objects. the references are moved
6948 * from stack to A and B. */
6949 B = stack[--stacklen];
6950 A = stack[--stacklen];
6951
6952 /* --- Integer --- */
6953 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6954 (B->typePtr == &doubleObjType && !B->bytes) ||
6955 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6956 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6957 goto trydouble;
6958 }
6959 Jim_DecrRefCount(interp, A);
6960 Jim_DecrRefCount(interp, B);
6961 switch (expr->opcode[i]) {
6962 case JIM_EXPROP_ADD: wC = wA + wB; break;
6963 case JIM_EXPROP_SUB: wC = wA-wB; break;
6964 case JIM_EXPROP_MUL: wC = wA*wB; break;
6965 case JIM_EXPROP_LT: wC = wA < wB; break;
6966 case JIM_EXPROP_GT: wC = wA > wB; break;
6967 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6968 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6969 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6970 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6971 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6972 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6973 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6974 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6975 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6976 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6977 case JIM_EXPROP_LOGICAND_LEFT:
6978 if (wA == 0) {
6979 i += (int)wB;
6980 wC = 0;
6981 } else {
6982 continue;
6983 }
6984 break;
6985 case JIM_EXPROP_LOGICOR_LEFT:
6986 if (wA != 0) {
6987 i += (int)wB;
6988 wC = 1;
6989 } else {
6990 continue;
6991 }
6992 break;
6993 case JIM_EXPROP_DIV:
6994 if (wB == 0) goto divbyzero;
6995 wC = wA/wB;
6996 break;
6997 case JIM_EXPROP_MOD:
6998 if (wB == 0) goto divbyzero;
6999 wC = wA%wB;
7000 break;
7001 case JIM_EXPROP_ROTL: {
7002 /* uint32_t would be better. But not everyone has inttypes.h?*/
7003 unsigned long uA = (unsigned long)wA;
7004 #ifdef _MSC_VER
7005 wC = _rotl(uA,(unsigned long)wB);
7006 #else
7007 const unsigned int S = sizeof(unsigned long) * 8;
7008 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7009 #endif
7010 break;
7011 }
7012 case JIM_EXPROP_ROTR: {
7013 unsigned long uA = (unsigned long)wA;
7014 #ifdef _MSC_VER
7015 wC = _rotr(uA,(unsigned long)wB);
7016 #else
7017 const unsigned int S = sizeof(unsigned long) * 8;
7018 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7019 #endif
7020 break;
7021 }
7022
7023 default:
7024 wC = 0; /* avoid gcc warning */
7025 break;
7026 }
7027 stack[stacklen] = Jim_NewIntObj(interp, wC);
7028 Jim_IncrRefCount(stack[stacklen]);
7029 stacklen++;
7030 continue;
7031 trydouble:
7032 /* --- Double --- */
7033 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7034 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7035
7036 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7037 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7038 opcode = JIM_EXPROP_STRNE;
7039 goto retry_as_string;
7040 }
7041 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7042 opcode = JIM_EXPROP_STREQ;
7043 goto retry_as_string;
7044 }
7045 Jim_DecrRefCount(interp, A);
7046 Jim_DecrRefCount(interp, B);
7047 error = 1;
7048 goto err;
7049 }
7050 Jim_DecrRefCount(interp, A);
7051 Jim_DecrRefCount(interp, B);
7052 switch (expr->opcode[i]) {
7053 case JIM_EXPROP_ROTL:
7054 case JIM_EXPROP_ROTR:
7055 case JIM_EXPROP_LSHIFT:
7056 case JIM_EXPROP_RSHIFT:
7057 case JIM_EXPROP_BITAND:
7058 case JIM_EXPROP_BITXOR:
7059 case JIM_EXPROP_BITOR:
7060 case JIM_EXPROP_MOD:
7061 case JIM_EXPROP_POW:
7062 Jim_SetResultString(interp,
7063 "Got floating-point value where integer was expected", -1);
7064 error = 1;
7065 goto err;
7066 case JIM_EXPROP_ADD: dC = dA + dB; break;
7067 case JIM_EXPROP_SUB: dC = dA-dB; break;
7068 case JIM_EXPROP_MUL: dC = dA*dB; break;
7069 case JIM_EXPROP_LT: dC = dA < dB; break;
7070 case JIM_EXPROP_GT: dC = dA > dB; break;
7071 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7072 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7073 /* FIXME comparing floats for equality/inequality is bad juju */
7074 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7075 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7076 case JIM_EXPROP_LOGICAND_LEFT:
7077 if (dA == 0) {
7078 i += (int)dB;
7079 dC = 0;
7080 } else {
7081 continue;
7082 }
7083 break;
7084 case JIM_EXPROP_LOGICOR_LEFT:
7085 if (dA != 0) {
7086 i += (int)dB;
7087 dC = 1;
7088 } else {
7089 continue;
7090 }
7091 break;
7092 case JIM_EXPROP_DIV:
7093 if (dB == 0) goto divbyzero;
7094 dC = dA/dB;
7095 break;
7096 default:
7097 dC = 0; /* avoid gcc warning */
7098 break;
7099 }
7100 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7101 Jim_IncrRefCount(stack[stacklen]);
7102 stacklen++;
7103 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7104 B = stack[--stacklen];
7105 A = stack[--stacklen];
7106 retry_as_string:
7107 sA = Jim_GetString(A, &Alen);
7108 sB = Jim_GetString(B, &Blen);
7109 switch (opcode) {
7110 case JIM_EXPROP_STREQ:
7111 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7112 wC = 1;
7113 else
7114 wC = 0;
7115 break;
7116 case JIM_EXPROP_STRNE:
7117 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7118 wC = 1;
7119 else
7120 wC = 0;
7121 break;
7122 default:
7123 wC = 0; /* avoid gcc warning */
7124 break;
7125 }
7126 Jim_DecrRefCount(interp, A);
7127 Jim_DecrRefCount(interp, B);
7128 stack[stacklen] = Jim_NewIntObj(interp, wC);
7129 Jim_IncrRefCount(stack[stacklen]);
7130 stacklen++;
7131 } else if (opcode == JIM_EXPROP_NOT ||
7132 opcode == JIM_EXPROP_BITNOT ||
7133 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7134 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7135 /* Note that there isn't to increment the
7136 * refcount of objects. the references are moved
7137 * from stack to A and B. */
7138 A = stack[--stacklen];
7139
7140 /* --- Integer --- */
7141 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7142 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7143 goto trydouble_unary;
7144 }
7145 Jim_DecrRefCount(interp, A);
7146 switch (expr->opcode[i]) {
7147 case JIM_EXPROP_NOT: wC = !wA; break;
7148 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7149 case JIM_EXPROP_LOGICAND_RIGHT:
7150 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7151 default:
7152 wC = 0; /* avoid gcc warning */
7153 break;
7154 }
7155 stack[stacklen] = Jim_NewIntObj(interp, wC);
7156 Jim_IncrRefCount(stack[stacklen]);
7157 stacklen++;
7158 continue;
7159 trydouble_unary:
7160 /* --- Double --- */
7161 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7162 Jim_DecrRefCount(interp, A);
7163 error = 1;
7164 goto err;
7165 }
7166 Jim_DecrRefCount(interp, A);
7167 switch (expr->opcode[i]) {
7168 case JIM_EXPROP_NOT: dC = !dA; break;
7169 case JIM_EXPROP_LOGICAND_RIGHT:
7170 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7171 case JIM_EXPROP_BITNOT:
7172 Jim_SetResultString(interp,
7173 "Got floating-point value where integer was expected", -1);
7174 error = 1;
7175 goto err;
7176 break;
7177 default:
7178 dC = 0; /* avoid gcc warning */
7179 break;
7180 }
7181 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7182 Jim_IncrRefCount(stack[stacklen]);
7183 stacklen++;
7184 } else {
7185 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7186 }
7187 }
7188 err:
7189 /* There is no need to decerement the inUse field because
7190 * this reference is transfered back into the exprObjPtr. */
7191 Jim_FreeIntRep(interp, exprObjPtr);
7192 exprObjPtr->typePtr = &exprObjType;
7193 Jim_SetIntRepPtr(exprObjPtr, expr);
7194 Jim_DecrRefCount(interp, exprObjPtr);
7195 if (!error) {
7196 *exprResultPtrPtr = stack[0];
7197 Jim_IncrRefCount(stack[0]);
7198 errRetCode = JIM_OK;
7199 }
7200 for (i = 0; i < stacklen; i++) {
7201 Jim_DecrRefCount(interp, stack[i]);
7202 }
7203 if (stack != staticStack)
7204 Jim_Free(stack);
7205 return errRetCode;
7206 divbyzero:
7207 error = 1;
7208 Jim_SetResultString(interp, "Division by zero", -1);
7209 goto err;
7210 }
7211
7212 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7213 {
7214 int retcode;
7215 jim_wide wideValue;
7216 double doubleValue;
7217 Jim_Obj *exprResultPtr;
7218
7219 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7220 if (retcode != JIM_OK)
7221 return retcode;
7222 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7223 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7224 {
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 return JIM_ERR;
7227 } else {
7228 Jim_DecrRefCount(interp, exprResultPtr);
7229 *boolPtr = doubleValue != 0;
7230 return JIM_OK;
7231 }
7232 }
7233 Jim_DecrRefCount(interp, exprResultPtr);
7234 *boolPtr = wideValue != 0;
7235 return JIM_OK;
7236 }
7237
7238 /* -----------------------------------------------------------------------------
7239 * ScanFormat String Object
7240 * ---------------------------------------------------------------------------*/
7241
7242 /* This Jim_Obj will held a parsed representation of a format string passed to
7243 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7244 * to be parsed in its entirely first and then, if correct, can be used for
7245 * scanning. To avoid endless re-parsing, the parsed representation will be
7246 * stored in an internal representation and re-used for performance reason. */
7247
7248 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7249 * scanformat string. This part will later be used to extract information
7250 * out from the string to be parsed by Jim_ScanString */
7251
7252 typedef struct ScanFmtPartDescr {
7253 char type; /* Type of conversion (e.g. c, d, f) */
7254 char modifier; /* Modify type (e.g. l - long, h - short */
7255 size_t width; /* Maximal width of input to be converted */
7256 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7257 char *arg; /* Specification of a CHARSET conversion */
7258 char *prefix; /* Prefix to be scanned literally before conversion */
7259 } ScanFmtPartDescr;
7260
7261 /* The ScanFmtStringObj will held the internal representation of a scanformat
7262 * string parsed and separated in part descriptions. Furthermore it contains
7263 * the original string representation of the scanformat string to allow for
7264 * fast update of the Jim_Obj's string representation part.
7265 *
7266 * As add-on the internal object representation add some scratch pad area
7267 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7268 * memory for purpose of string scanning.
7269 *
7270 * The error member points to a static allocated string in case of a mal-
7271 * formed scanformat string or it contains '0' (NULL) in case of a valid
7272 * parse representation.
7273 *
7274 * The whole memory of the internal representation is allocated as a single
7275 * area of memory that will be internally separated. So freeing and duplicating
7276 * of such an object is cheap */
7277
7278 typedef struct ScanFmtStringObj {
7279 jim_wide size; /* Size of internal repr in bytes */
7280 char *stringRep; /* Original string representation */
7281 size_t count; /* Number of ScanFmtPartDescr contained */
7282 size_t convCount; /* Number of conversions that will assign */
7283 size_t maxPos; /* Max position index if XPG3 is used */
7284 const char *error; /* Ptr to error text (NULL if no error */
7285 char *scratch; /* Some scratch pad used by Jim_ScanString */
7286 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7287 } ScanFmtStringObj;
7288
7289
7290 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7291 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7292 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7293
7294 static Jim_ObjType scanFmtStringObjType = {
7295 "scanformatstring",
7296 FreeScanFmtInternalRep,
7297 DupScanFmtInternalRep,
7298 UpdateStringOfScanFmt,
7299 JIM_TYPE_NONE,
7300 };
7301
7302 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7303 {
7304 JIM_NOTUSED(interp);
7305 Jim_Free((char*)objPtr->internalRep.ptr);
7306 objPtr->internalRep.ptr = 0;
7307 }
7308
7309 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7310 {
7311 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7312 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7313
7314 JIM_NOTUSED(interp);
7315 memcpy(newVec, srcPtr->internalRep.ptr, size);
7316 dupPtr->internalRep.ptr = newVec;
7317 dupPtr->typePtr = &scanFmtStringObjType;
7318 }
7319
7320 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7321 {
7322 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7323
7324 objPtr->bytes = Jim_StrDup(bytes);
7325 objPtr->length = strlen(bytes);
7326 }
7327
7328 /* SetScanFmtFromAny will parse a given string and create the internal
7329 * representation of the format specification. In case of an error
7330 * the error data member of the internal representation will be set
7331 * to an descriptive error text and the function will be left with
7332 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7333 * specification */
7334
7335 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7336 {
7337 ScanFmtStringObj *fmtObj;
7338 char *buffer;
7339 int maxCount, i, approxSize, lastPos = -1;
7340 const char *fmt = objPtr->bytes;
7341 int maxFmtLen = objPtr->length;
7342 const char *fmtEnd = fmt + maxFmtLen;
7343 int curr;
7344
7345 Jim_FreeIntRep(interp, objPtr);
7346 /* Count how many conversions could take place maximally */
7347 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7348 if (fmt[i] == '%')
7349 ++maxCount;
7350 /* Calculate an approximation of the memory necessary */
7351 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7352 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7353 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7354 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7355 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7356 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7357 + 1; /* safety byte */
7358 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7359 memset(fmtObj, 0, approxSize);
7360 fmtObj->size = approxSize;
7361 fmtObj->maxPos = 0;
7362 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7363 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7364 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7365 buffer = fmtObj->stringRep + maxFmtLen + 1;
7366 objPtr->internalRep.ptr = fmtObj;
7367 objPtr->typePtr = &scanFmtStringObjType;
7368 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7369 int width = 0, skip;
7370 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7371 fmtObj->count++;
7372 descr->width = 0; /* Assume width unspecified */
7373 /* Overread and store any "literal" prefix */
7374 if (*fmt != '%' || fmt[1] == '%') {
7375 descr->type = 0;
7376 descr->prefix = &buffer[i];
7377 for (; fmt < fmtEnd; ++fmt) {
7378 if (*fmt == '%') {
7379 if (fmt[1] != '%') break;
7380 ++fmt;
7381 }
7382 buffer[i++] = *fmt;
7383 }
7384 buffer[i++] = 0;
7385 }
7386 /* Skip the conversion introducing '%' sign */
7387 ++fmt;
7388 /* End reached due to non-conversion literal only? */
7389 if (fmt >= fmtEnd)
7390 goto done;
7391 descr->pos = 0; /* Assume "natural" positioning */
7392 if (*fmt == '*') {
7393 descr->pos = -1; /* Okay, conversion will not be assigned */
7394 ++fmt;
7395 } else
7396 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7397 /* Check if next token is a number (could be width or pos */
7398 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7399 fmt += skip;
7400 /* Was the number a XPG3 position specifier? */
7401 if (descr->pos != -1 && *fmt == '$') {
7402 int prev;
7403 ++fmt;
7404 descr->pos = width;
7405 width = 0;
7406 /* Look if "natural" postioning and XPG3 one was mixed */
7407 if ((lastPos == 0 && descr->pos > 0)
7408 || (lastPos > 0 && descr->pos == 0)) {
7409 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7410 return JIM_ERR;
7411 }
7412 /* Look if this position was already used */
7413 for (prev = 0; prev < curr; ++prev) {
7414 if (fmtObj->descr[prev].pos == -1) continue;
7415 if (fmtObj->descr[prev].pos == descr->pos) {
7416 fmtObj->error = "same \"%n$\" conversion specifier "
7417 "used more than once";
7418 return JIM_ERR;
7419 }
7420 }
7421 /* Try to find a width after the XPG3 specifier */
7422 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7423 descr->width = width;
7424 fmt += skip;
7425 }
7426 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7427 fmtObj->maxPos = descr->pos;
7428 } else {
7429 /* Number was not a XPG3, so it has to be a width */
7430 descr->width = width;
7431 }
7432 }
7433 /* If positioning mode was undetermined yet, fix this */
7434 if (lastPos == -1)
7435 lastPos = descr->pos;
7436 /* Handle CHARSET conversion type ... */
7437 if (*fmt == '[') {
7438 int swapped = 1, beg = i, end, j;
7439 descr->type = '[';
7440 descr->arg = &buffer[i];
7441 ++fmt;
7442 if (*fmt == '^') buffer[i++] = *fmt++;
7443 if (*fmt == ']') buffer[i++] = *fmt++;
7444 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7445 if (*fmt != ']') {
7446 fmtObj->error = "unmatched [ in format string";
7447 return JIM_ERR;
7448 }
7449 end = i;
7450 buffer[i++] = 0;
7451 /* In case a range fence was given "backwards", swap it */
7452 while (swapped) {
7453 swapped = 0;
7454 for (j = beg + 1; j < end-1; ++j) {
7455 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7456 char tmp = buffer[j-1];
7457 buffer[j-1] = buffer[j + 1];
7458 buffer[j + 1] = tmp;
7459 swapped = 1;
7460 }
7461 }
7462 }
7463 } else {
7464 /* Remember any valid modifier if given */
7465 if (strchr("hlL", *fmt) != 0)
7466 descr->modifier = tolower((int)*fmt++);
7467
7468 descr->type = *fmt;
7469 if (strchr("efgcsndoxui", *fmt) == 0) {
7470 fmtObj->error = "bad scan conversion character";
7471 return JIM_ERR;
7472 } else if (*fmt == 'c' && descr->width != 0) {
7473 fmtObj->error = "field width may not be specified in %c "
7474 "conversion";
7475 return JIM_ERR;
7476 } else if (*fmt == 'u' && descr->modifier == 'l') {
7477 fmtObj->error = "unsigned wide not supported";
7478 return JIM_ERR;
7479 }
7480 }
7481 curr++;
7482 }
7483 done:
7484 if (fmtObj->convCount == 0) {
7485 fmtObj->error = "no any conversion specifier given";
7486 return JIM_ERR;
7487 }
7488 return JIM_OK;
7489 }
7490
7491 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7492
7493 #define FormatGetCnvCount(_fo_) \
7494 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7495 #define FormatGetMaxPos(_fo_) \
7496 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7497 #define FormatGetError(_fo_) \
7498 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7499
7500 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7501 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7502 * bitvector implementation in Jim? */
7503
7504 static int JimTestBit(const char *bitvec, char ch)
7505 {
7506 div_t pos = div(ch-1, 8);
7507 return bitvec[pos.quot] & (1 << pos.rem);
7508 }
7509
7510 static void JimSetBit(char *bitvec, char ch)
7511 {
7512 div_t pos = div(ch-1, 8);
7513 bitvec[pos.quot] |= (1 << pos.rem);
7514 }
7515
7516 #if 0 /* currently not used */
7517 static void JimClearBit(char *bitvec, char ch)
7518 {
7519 div_t pos = div(ch-1, 8);
7520 bitvec[pos.quot] &= ~(1 << pos.rem);
7521 }
7522 #endif
7523
7524 /* JimScanAString is used to scan an unspecified string that ends with
7525 * next WS, or a string that is specified via a charset. The charset
7526 * is currently implemented in a way to only allow for usage with
7527 * ASCII. Whenever we will switch to UNICODE, another idea has to
7528 * be born :-/
7529 *
7530 * FIXME: Works only with ASCII */
7531
7532 static Jim_Obj *
7533 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7534 {
7535 size_t i;
7536 Jim_Obj *result;
7537 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7538 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7539
7540 /* First init charset to nothing or all, depending if a specified
7541 * or an unspecified string has to be parsed */
7542 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7543 if (sdescr) {
7544 /* There was a set description given, that means we are parsing
7545 * a specified string. So we have to build a corresponding
7546 * charset reflecting the description */
7547 int notFlag = 0;
7548 /* Should the set be negated at the end? */
7549 if (*sdescr == '^') {
7550 notFlag = 1;
7551 ++sdescr;
7552 }
7553 /* Here '-' is meant literally and not to define a range */
7554 if (*sdescr == '-') {
7555 JimSetBit(charset, '-');
7556 ++sdescr;
7557 }
7558 while (*sdescr) {
7559 if (sdescr[1] == '-' && sdescr[2] != 0) {
7560 /* Handle range definitions */
7561 int i;
7562 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7563 JimSetBit(charset, (char)i);
7564 sdescr += 3;
7565 } else {
7566 /* Handle verbatim character definitions */
7567 JimSetBit(charset, *sdescr++);
7568 }
7569 }
7570 /* Negate the charset if there was a NOT given */
7571 for (i = 0; notFlag && i < sizeof(charset); ++i)
7572 charset[i] = ~charset[i];
7573 }
7574 /* And after all the mess above, the real work begin ... */
7575 while (str && *str) {
7576 if (!sdescr && isspace((int)*str))
7577 break; /* EOS via WS if unspecified */
7578 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7579 else break; /* EOS via mismatch if specified scanning */
7580 }
7581 *buffer = 0; /* Close the string properly ... */
7582 result = Jim_NewStringObj(interp, anchor, -1);
7583 Jim_Free(anchor); /* ... and free it afer usage */
7584 return result;
7585 }
7586
7587 /* ScanOneEntry will scan one entry out of the string passed as argument.
7588 * It use the sscanf() function for this task. After extracting and
7589 * converting of the value, the count of scanned characters will be
7590 * returned of -1 in case of no conversion tool place and string was
7591 * already scanned thru */
7592
7593 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7594 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7595 {
7596 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7597 ? sizeof(jim_wide) \
7598 : sizeof(double))
7599 char buffer[MAX_SIZE];
7600 char *value = buffer;
7601 const char *tok;
7602 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7603 size_t sLen = strlen(&str[pos]), scanned = 0;
7604 size_t anchor = pos;
7605 int i;
7606
7607 /* First pessimiticly assume, we will not scan anything :-) */
7608 *valObjPtr = 0;
7609 if (descr->prefix) {
7610 /* There was a prefix given before the conversion, skip it and adjust
7611 * the string-to-be-parsed accordingly */
7612 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7613 /* If prefix require, skip WS */
7614 if (isspace((int)descr->prefix[i]))
7615 while (str[pos] && isspace((int)str[pos])) ++pos;
7616 else if (descr->prefix[i] != str[pos])
7617 break; /* Prefix do not match here, leave the loop */
7618 else
7619 ++pos; /* Prefix matched so far, next round */
7620 }
7621 if (str[pos] == 0)
7622 return -1; /* All of str consumed: EOF condition */
7623 else if (descr->prefix[i] != 0)
7624 return 0; /* Not whole prefix consumed, no conversion possible */
7625 }
7626 /* For all but following conversion, skip leading WS */
7627 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7628 while (isspace((int)str[pos])) ++pos;
7629 /* Determine how much skipped/scanned so far */
7630 scanned = pos - anchor;
7631 if (descr->type == 'n') {
7632 /* Return pseudo conversion means: how much scanned so far? */
7633 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7634 } else if (str[pos] == 0) {
7635 /* Cannot scan anything, as str is totally consumed */
7636 return -1;
7637 } else {
7638 /* Processing of conversions follows ... */
7639 if (descr->width > 0) {
7640 /* Do not try to scan as fas as possible but only the given width.
7641 * To ensure this, we copy the part that should be scanned. */
7642 size_t tLen = descr->width > sLen ? sLen : descr->width;
7643 tok = Jim_StrDupLen(&str[pos], tLen);
7644 } else {
7645 /* As no width was given, simply refer to the original string */
7646 tok = &str[pos];
7647 }
7648 switch (descr->type) {
7649 case 'c':
7650 *valObjPtr = Jim_NewIntObj(interp, *tok);
7651 scanned += 1;
7652 break;
7653 case 'd': case 'o': case 'x': case 'u': case 'i': {
7654 jim_wide jwvalue = 0;
7655 long lvalue = 0;
7656 char *endp; /* Position where the number finished */
7657 int base = descr->type == 'o' ? 8
7658 : descr->type == 'x' ? 16
7659 : descr->type == 'i' ? 0
7660 : 10;
7661
7662 do {
7663 /* Try to scan a number with the given base */
7664 if (descr->modifier == 'l')
7665 {
7666 #ifdef HAVE_LONG_LONG_INT
7667 jwvalue = JimStrtoll(tok, &endp, base),
7668 #else
7669 jwvalue = strtol(tok, &endp, base),
7670 #endif
7671 memcpy(value, &jwvalue, sizeof(jim_wide));
7672 }
7673 else
7674 {
7675 if (descr->type == 'u')
7676 lvalue = strtoul(tok, &endp, base);
7677 else
7678 lvalue = strtol(tok, &endp, base);
7679 memcpy(value, &lvalue, sizeof(lvalue));
7680 }
7681 /* If scanning failed, and base was undetermined, simply
7682 * put it to 10 and try once more. This should catch the
7683 * case where %i begin to parse a number prefix (e.g.
7684 * '0x' but no further digits follows. This will be
7685 * handled as a ZERO followed by a char 'x' by Tcl */
7686 if (endp == tok && base == 0) base = 10;
7687 else break;
7688 } while (1);
7689 if (endp != tok) {
7690 /* There was some number sucessfully scanned! */
7691 if (descr->modifier == 'l')
7692 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7693 else
7694 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7695 /* Adjust the number-of-chars scanned so far */
7696 scanned += endp - tok;
7697 } else {
7698 /* Nothing was scanned. We have to determine if this
7699 * happened due to e.g. prefix mismatch or input str
7700 * exhausted */
7701 scanned = *tok ? 0 : -1;
7702 }
7703 break;
7704 }
7705 case 's': case '[': {
7706 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7707 scanned += Jim_Length(*valObjPtr);
7708 break;
7709 }
7710 case 'e': case 'f': case 'g': {
7711 char *endp;
7712
7713 double dvalue = strtod(tok, &endp);
7714 memcpy(value, &dvalue, sizeof(double));
7715 if (endp != tok) {
7716 /* There was some number sucessfully scanned! */
7717 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7718 /* Adjust the number-of-chars scanned so far */
7719 scanned += endp - tok;
7720 } else {
7721 /* Nothing was scanned. We have to determine if this
7722 * happened due to e.g. prefix mismatch or input str
7723 * exhausted */
7724 scanned = *tok ? 0 : -1;
7725 }
7726 break;
7727 }
7728 }
7729 /* If a substring was allocated (due to pre-defined width) do not
7730 * forget to free it */
7731 if (tok != &str[pos])
7732 Jim_Free((char*)tok);
7733 }
7734 return scanned;
7735 }
7736
7737 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7738 * string and returns all converted (and not ignored) values in a list back
7739 * to the caller. If an error occured, a NULL pointer will be returned */
7740
7741 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7742 Jim_Obj *fmtObjPtr, int flags)
7743 {
7744 size_t i, pos;
7745 int scanned = 1;
7746 const char *str = Jim_GetString(strObjPtr, 0);
7747 Jim_Obj *resultList = 0;
7748 Jim_Obj **resultVec =NULL;
7749 int resultc;
7750 Jim_Obj *emptyStr = 0;
7751 ScanFmtStringObj *fmtObj;
7752
7753 /* If format specification is not an object, convert it! */
7754 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7755 SetScanFmtFromAny(interp, fmtObjPtr);
7756 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7757 /* Check if format specification was valid */
7758 if (fmtObj->error != 0) {
7759 if (flags & JIM_ERRMSG)
7760 Jim_SetResultString(interp, fmtObj->error, -1);
7761 return 0;
7762 }
7763 /* Allocate a new "shared" empty string for all unassigned conversions */
7764 emptyStr = Jim_NewEmptyStringObj(interp);
7765 Jim_IncrRefCount(emptyStr);
7766 /* Create a list and fill it with empty strings up to max specified XPG3 */
7767 resultList = Jim_NewListObj(interp, 0, 0);
7768 if (fmtObj->maxPos > 0) {
7769 for (i = 0; i < fmtObj->maxPos; ++i)
7770 Jim_ListAppendElement(interp, resultList, emptyStr);
7771 JimListGetElements(interp, resultList, &resultc, &resultVec);
7772 }
7773 /* Now handle every partial format description */
7774 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7775 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7776 Jim_Obj *value = 0;
7777 /* Only last type may be "literal" w/o conversion - skip it! */
7778 if (descr->type == 0) continue;
7779 /* As long as any conversion could be done, we will proceed */
7780 if (scanned > 0)
7781 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7782 /* In case our first try results in EOF, we will leave */
7783 if (scanned == -1 && i == 0)
7784 goto eof;
7785 /* Advance next pos-to-be-scanned for the amount scanned already */
7786 pos += scanned;
7787 /* value == 0 means no conversion took place so take empty string */
7788 if (value == 0)
7789 value = Jim_NewEmptyStringObj(interp);
7790 /* If value is a non-assignable one, skip it */
7791 if (descr->pos == -1) {
7792 Jim_FreeNewObj(interp, value);
7793 } else if (descr->pos == 0)
7794 /* Otherwise append it to the result list if no XPG3 was given */
7795 Jim_ListAppendElement(interp, resultList, value);
7796 else if (resultVec[descr->pos-1] == emptyStr) {
7797 /* But due to given XPG3, put the value into the corr. slot */
7798 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7799 Jim_IncrRefCount(value);
7800 resultVec[descr->pos-1] = value;
7801 } else {
7802 /* Otherwise, the slot was already used - free obj and ERROR */
7803 Jim_FreeNewObj(interp, value);
7804 goto err;
7805 }
7806 }
7807 Jim_DecrRefCount(interp, emptyStr);
7808 return resultList;
7809 eof:
7810 Jim_DecrRefCount(interp, emptyStr);
7811 Jim_FreeNewObj(interp, resultList);
7812 return (Jim_Obj*)EOF;
7813 err:
7814 Jim_DecrRefCount(interp, emptyStr);
7815 Jim_FreeNewObj(interp, resultList);
7816 return 0;
7817 }
7818
7819 /* -----------------------------------------------------------------------------
7820 * Pseudo Random Number Generation
7821 * ---------------------------------------------------------------------------*/
7822 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7823 int seedLen);
7824
7825 /* Initialize the sbox with the numbers from 0 to 255 */
7826 static void JimPrngInit(Jim_Interp *interp)
7827 {
7828 int i;
7829 unsigned int seed[256];
7830
7831 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7832 for (i = 0; i < 256; i++)
7833 seed[i] = (rand() ^ time(NULL) ^ clock());
7834 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7835 }
7836
7837 /* Generates N bytes of random data */
7838 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7839 {
7840 Jim_PrngState *prng;
7841 unsigned char *destByte = (unsigned char*) dest;
7842 unsigned int si, sj, x;
7843
7844 /* initialization, only needed the first time */
7845 if (interp->prngState == NULL)
7846 JimPrngInit(interp);
7847 prng = interp->prngState;
7848 /* generates 'len' bytes of pseudo-random numbers */
7849 for (x = 0; x < len; x++) {
7850 prng->i = (prng->i + 1) & 0xff;
7851 si = prng->sbox[prng->i];
7852 prng->j = (prng->j + si) & 0xff;
7853 sj = prng->sbox[prng->j];
7854 prng->sbox[prng->i] = sj;
7855 prng->sbox[prng->j] = si;
7856 *destByte++ = prng->sbox[(si + sj)&0xff];
7857 }
7858 }
7859
7860 /* Re-seed the generator with user-provided bytes */
7861 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7862 int seedLen)
7863 {
7864 int i;
7865 unsigned char buf[256];
7866 Jim_PrngState *prng;
7867
7868 /* initialization, only needed the first time */
7869 if (interp->prngState == NULL)
7870 JimPrngInit(interp);
7871 prng = interp->prngState;
7872
7873 /* Set the sbox[i] with i */
7874 for (i = 0; i < 256; i++)
7875 prng->sbox[i] = i;
7876 /* Now use the seed to perform a random permutation of the sbox */
7877 for (i = 0; i < seedLen; i++) {
7878 unsigned char t;
7879
7880 t = prng->sbox[i&0xFF];
7881 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7882 prng->sbox[seed[i]] = t;
7883 }
7884 prng->i = prng->j = 0;
7885 /* discard the first 256 bytes of stream. */
7886 JimRandomBytes(interp, buf, 256);
7887 }
7888
7889 /* -----------------------------------------------------------------------------
7890 * Dynamic libraries support (WIN32 not supported)
7891 * ---------------------------------------------------------------------------*/
7892
7893 #ifdef JIM_DYNLIB
7894 #ifdef WIN32
7895 #define RTLD_LAZY 0
7896 void * dlopen(const char *path, int mode)
7897 {
7898 JIM_NOTUSED(mode);
7899
7900 return (void *)LoadLibraryA(path);
7901 }
7902 int dlclose(void *handle)
7903 {
7904 FreeLibrary((HANDLE)handle);
7905 return 0;
7906 }
7907 void *dlsym(void *handle, const char *symbol)
7908 {
7909 return GetProcAddress((HMODULE)handle, symbol);
7910 }
7911 static char win32_dlerror_string[121];
7912 const char *dlerror(void)
7913 {
7914 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7915 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7916 return win32_dlerror_string;
7917 }
7918 #endif /* WIN32 */
7919
7920 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7921 {
7922 Jim_Obj *libPathObjPtr;
7923 int prefixc, i;
7924 void *handle;
7925 int (*onload)(Jim_Interp *interp);
7926
7927 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7928 if (libPathObjPtr == NULL) {
7929 prefixc = 0;
7930 libPathObjPtr = NULL;
7931 } else {
7932 Jim_IncrRefCount(libPathObjPtr);
7933 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7934 }
7935
7936 for (i = -1; i < prefixc; i++) {
7937 if (i < 0) {
7938 handle = dlopen(pathName, RTLD_LAZY);
7939 } else {
7940 FILE *fp;
7941 char buf[JIM_PATH_LEN];
7942 const char *prefix;
7943 int prefixlen;
7944 Jim_Obj *prefixObjPtr;
7945
7946 buf[0] = '\0';
7947 if (Jim_ListIndex(interp, libPathObjPtr, i,
7948 &prefixObjPtr, JIM_NONE) != JIM_OK)
7949 continue;
7950 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7951 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7952 continue;
7953 if (*pathName == '/') {
7954 strcpy(buf, pathName);
7955 }
7956 else if (prefixlen && prefix[prefixlen-1] == '/')
7957 sprintf(buf, "%s%s", prefix, pathName);
7958 else
7959 sprintf(buf, "%s/%s", prefix, pathName);
7960 fp = fopen(buf, "r");
7961 if (fp == NULL)
7962 continue;
7963 fclose(fp);
7964 handle = dlopen(buf, RTLD_LAZY);
7965 }
7966 if (handle == NULL) {
7967 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7968 Jim_AppendStrings(interp, Jim_GetResult(interp),
7969 "error loading extension \"", pathName,
7970 "\": ", dlerror(), NULL);
7971 if (i < 0)
7972 continue;
7973 goto err;
7974 }
7975 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7976 Jim_SetResultString(interp,
7977 "No Jim_OnLoad symbol found on extension", -1);
7978 goto err;
7979 }
7980 if (onload(interp) == JIM_ERR) {
7981 dlclose(handle);
7982 goto err;
7983 }
7984 Jim_SetEmptyResult(interp);
7985 if (libPathObjPtr != NULL)
7986 Jim_DecrRefCount(interp, libPathObjPtr);
7987 return JIM_OK;
7988 }
7989 err:
7990 if (libPathObjPtr != NULL)
7991 Jim_DecrRefCount(interp, libPathObjPtr);
7992 return JIM_ERR;
7993 }
7994 #else /* JIM_DYNLIB */
7995 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7996 {
7997 JIM_NOTUSED(interp);
7998 JIM_NOTUSED(pathName);
7999
8000 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
8001 return JIM_ERR;
8002 }
8003 #endif/* JIM_DYNLIB */
8004
8005 /* -----------------------------------------------------------------------------
8006 * Packages handling
8007 * ---------------------------------------------------------------------------*/
8008
8009 #define JIM_PKG_ANY_VERSION -1
8010
8011 /* Convert a string of the type "1.2" into an integer.
8012 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8013 * to the integer with value 102 */
8014 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8015 int *intPtr, int flags)
8016 {
8017 char *copy;
8018 jim_wide major, minor;
8019 char *majorStr, *minorStr, *p;
8020
8021 if (v[0] == '\0') {
8022 *intPtr = JIM_PKG_ANY_VERSION;
8023 return JIM_OK;
8024 }
8025
8026 copy = Jim_StrDup(v);
8027 p = strchr(copy, '.');
8028 if (p == NULL) goto badfmt;
8029 *p = '\0';
8030 majorStr = copy;
8031 minorStr = p + 1;
8032
8033 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8034 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8035 goto badfmt;
8036 *intPtr = (int)(major*100 + minor);
8037 Jim_Free(copy);
8038 return JIM_OK;
8039
8040 badfmt:
8041 Jim_Free(copy);
8042 if (flags & JIM_ERRMSG) {
8043 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8044 Jim_AppendStrings(interp, Jim_GetResult(interp),
8045 "invalid package version '", v, "'", NULL);
8046 }
8047 return JIM_ERR;
8048 }
8049
8050 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8051 static int JimPackageMatchVersion(int needed, int actual, int flags)
8052 {
8053 if (needed == JIM_PKG_ANY_VERSION) return 1;
8054 if (flags & JIM_MATCHVER_EXACT) {
8055 return needed == actual;
8056 } else {
8057 return needed/100 == actual/100 && (needed <= actual);
8058 }
8059 }
8060
8061 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8062 int flags)
8063 {
8064 int intVersion;
8065 /* Check if the version format is ok */
8066 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8067 return JIM_ERR;
8068 /* If the package was already provided returns an error. */
8069 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8070 if (flags & JIM_ERRMSG) {
8071 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8072 Jim_AppendStrings(interp, Jim_GetResult(interp),
8073 "package '", name, "' was already provided", NULL);
8074 }
8075 return JIM_ERR;
8076 }
8077 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8078 return JIM_OK;
8079 }
8080
8081 #ifndef JIM_ANSIC
8082
8083 #ifndef WIN32
8084 # include <sys/types.h>
8085 # include <dirent.h>
8086 #else
8087 # include <io.h>
8088 /* Posix dirent.h compatiblity layer for WIN32.
8089 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8090 * Copyright Salvatore Sanfilippo ,2005.
8091 *
8092 * Permission to use, copy, modify, and distribute this software and its
8093 * documentation for any purpose is hereby granted without fee, provided
8094 * that this copyright and permissions notice appear in all copies and
8095 * derivatives.
8096 *
8097 * This software is supplied "as is" without express or implied warranty.
8098 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8099 */
8100
8101 struct dirent {
8102 char *d_name;
8103 };
8104
8105 typedef struct DIR {
8106 long handle; /* -1 for failed rewind */
8107 struct _finddata_t info;
8108 struct dirent result; /* d_name null iff first time */
8109 char *name; /* null-terminated char string */
8110 } DIR;
8111
8112 DIR *opendir(const char *name)
8113 {
8114 DIR *dir = 0;
8115
8116 if (name && name[0]) {
8117 size_t base_length = strlen(name);
8118 const char *all = /* search pattern must end with suitable wildcard */
8119 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8120
8121 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8122 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8123 {
8124 strcat(strcpy(dir->name, name), all);
8125
8126 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8127 dir->result.d_name = 0;
8128 else { /* rollback */
8129 Jim_Free(dir->name);
8130 Jim_Free(dir);
8131 dir = 0;
8132 }
8133 } else { /* rollback */
8134 Jim_Free(dir);
8135 dir = 0;
8136 errno = ENOMEM;
8137 }
8138 } else {
8139 errno = EINVAL;
8140 }
8141 return dir;
8142 }
8143
8144 int closedir(DIR *dir)
8145 {
8146 int result = -1;
8147
8148 if (dir) {
8149 if (dir->handle != -1)
8150 result = _findclose(dir->handle);
8151 Jim_Free(dir->name);
8152 Jim_Free(dir);
8153 }
8154 if (result == -1) /* map all errors to EBADF */
8155 errno = EBADF;
8156 return result;
8157 }
8158
8159 struct dirent *readdir(DIR *dir)
8160 {
8161 struct dirent *result = 0;
8162
8163 if (dir && dir->handle != -1) {
8164 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8165 result = &dir->result;
8166 result->d_name = dir->info.name;
8167 }
8168 } else {
8169 errno = EBADF;
8170 }
8171 return result;
8172 }
8173
8174 #endif /* WIN32 */
8175
8176 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8177 int prefixc, const char *pkgName, int pkgVer, int flags)
8178 {
8179 int bestVer = -1, i;
8180 int pkgNameLen = strlen(pkgName);
8181 char *bestPackage = NULL;
8182 struct dirent *de;
8183
8184 for (i = 0; i < prefixc; i++) {
8185 DIR *dir;
8186 char buf[JIM_PATH_LEN];
8187 int prefixLen;
8188
8189 if (prefixes[i] == NULL) continue;
8190 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8191 buf[JIM_PATH_LEN-1] = '\0';
8192 prefixLen = strlen(buf);
8193 if (prefixLen && buf[prefixLen-1] == '/')
8194 buf[prefixLen-1] = '\0';
8195
8196 if ((dir = opendir(buf)) == NULL) continue;
8197 while ((de = readdir(dir)) != NULL) {
8198 char *fileName = de->d_name;
8199 int fileNameLen = strlen(fileName);
8200
8201 if (strncmp(fileName, "jim-", 4) == 0 &&
8202 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8203 *(fileName + 4+pkgNameLen) == '-' &&
8204 fileNameLen > 4 && /* note that this is not really useful */
8205 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8206 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8207 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8208 {
8209 char ver[6]; /* xx.yy < nulterm> */
8210 char *p = strrchr(fileName, '.');
8211 int verLen, fileVer;
8212
8213 verLen = p - (fileName + 4+pkgNameLen + 1);
8214 if (verLen < 3 || verLen > 5) continue;
8215 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8216 ver[verLen] = '\0';
8217 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8218 != JIM_OK) continue;
8219 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8220 (bestVer == -1 || bestVer < fileVer))
8221 {
8222 bestVer = fileVer;
8223 Jim_Free(bestPackage);
8224 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8225 sprintf(bestPackage, "%s/%s", buf, fileName);
8226 }
8227 }
8228 }
8229 closedir(dir);
8230 }
8231 return bestPackage;
8232 }
8233
8234 #else /* JIM_ANSIC */
8235
8236 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8237 int prefixc, const char *pkgName, int pkgVer, int flags)
8238 {
8239 JIM_NOTUSED(interp);
8240 JIM_NOTUSED(prefixes);
8241 JIM_NOTUSED(prefixc);
8242 JIM_NOTUSED(pkgName);
8243 JIM_NOTUSED(pkgVer);
8244 JIM_NOTUSED(flags);
8245 return NULL;
8246 }
8247
8248 #endif /* JIM_ANSIC */
8249
8250 /* Search for a suitable package under every dir specified by jim_libpath
8251 * and load it if possible. If a suitable package was loaded with success
8252 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8253 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8254 int flags)
8255 {
8256 Jim_Obj *libPathObjPtr;
8257 char **prefixes, *best;
8258 int prefixc, i, retCode = JIM_OK;
8259
8260 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8261 if (libPathObjPtr == NULL) {
8262 prefixc = 0;
8263 libPathObjPtr = NULL;
8264 } else {
8265 Jim_IncrRefCount(libPathObjPtr);
8266 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8267 }
8268
8269 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8270 for (i = 0; i < prefixc; i++) {
8271 Jim_Obj *prefixObjPtr;
8272 if (Jim_ListIndex(interp, libPathObjPtr, i,
8273 &prefixObjPtr, JIM_NONE) != JIM_OK)
8274 {
8275 prefixes[i] = NULL;
8276 continue;
8277 }
8278 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8279 }
8280 /* Scan every directory to find the "best" package. */
8281 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8282 if (best != NULL) {
8283 char *p = strrchr(best, '.');
8284 /* Try to load/source it */
8285 if (p && strcmp(p, ".tcl") == 0) {
8286 retCode = Jim_EvalFile(interp, best);
8287 } else {
8288 retCode = Jim_LoadLibrary(interp, best);
8289 }
8290 } else {
8291 retCode = JIM_ERR;
8292 }
8293 Jim_Free(best);
8294 for (i = 0; i < prefixc; i++)
8295 Jim_Free(prefixes[i]);
8296 Jim_Free(prefixes);
8297 if (libPathObjPtr)
8298 Jim_DecrRefCount(interp, libPathObjPtr);
8299 return retCode;
8300 }
8301
8302 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8303 const char *ver, int flags)
8304 {
8305 Jim_HashEntry *he;
8306 int requiredVer;
8307
8308 /* Start with an empty error string */
8309 Jim_SetResultString(interp, "", 0);
8310
8311 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8312 return NULL;
8313 he = Jim_FindHashEntry(&interp->packages, name);
8314 if (he == NULL) {
8315 /* Try to load the package. */
8316 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8317 he = Jim_FindHashEntry(&interp->packages, name);
8318 if (he == NULL) {
8319 return "?";
8320 }
8321 return he->val;
8322 }
8323 /* No way... return an error. */
8324 if (flags & JIM_ERRMSG) {
8325 int len;
8326 Jim_GetString(Jim_GetResult(interp), &len);
8327 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8328 "Can't find package '", name, "'", NULL);
8329 }
8330 return NULL;
8331 } else {
8332 int actualVer;
8333 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8334 != JIM_OK)
8335 {
8336 return NULL;
8337 }
8338 /* Check if version matches. */
8339 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8340 Jim_AppendStrings(interp, Jim_GetResult(interp),
8341 "Package '", name, "' already loaded, but with version ",
8342 he->val, NULL);
8343 return NULL;
8344 }
8345 return he->val;
8346 }
8347 }
8348
8349 /* -----------------------------------------------------------------------------
8350 * Eval
8351 * ---------------------------------------------------------------------------*/
8352 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8353 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8354
8355 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8356 Jim_Obj *const *argv);
8357
8358 /* Handle calls to the [unknown] command */
8359 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8360 {
8361 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8362 int retCode;
8363
8364 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8365 * done here
8366 */
8367 if (interp->unknown_called) {
8368 return JIM_ERR;
8369 }
8370
8371 /* If the [unknown] command does not exists returns
8372 * just now */
8373 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8374 return JIM_ERR;
8375
8376 /* The object interp->unknown just contains
8377 * the "unknown" string, it is used in order to
8378 * avoid to lookup the unknown command every time
8379 * but instread to cache the result. */
8380 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8381 v = sv;
8382 else
8383 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8384 /* Make a copy of the arguments vector, but shifted on
8385 * the right of one position. The command name of the
8386 * command will be instead the first argument of the
8387 * [unknonw] call. */
8388 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8389 v[0] = interp->unknown;
8390 /* Call it */
8391 interp->unknown_called++;
8392 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8393 interp->unknown_called--;
8394
8395 /* Clean up */
8396 if (v != sv)
8397 Jim_Free(v);
8398 return retCode;
8399 }
8400
8401 /* Eval the object vector 'objv' composed of 'objc' elements.
8402 * Every element is used as single argument.
8403 * Jim_EvalObj() will call this function every time its object
8404 * argument is of "list" type, with no string representation.
8405 *
8406 * This is possible because the string representation of a
8407 * list object generated by the UpdateStringOfList is made
8408 * in a way that ensures that every list element is a different
8409 * command argument. */
8410 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8411 {
8412 int i, retcode;
8413 Jim_Cmd *cmdPtr;
8414
8415 /* Incr refcount of arguments. */
8416 for (i = 0; i < objc; i++)
8417 Jim_IncrRefCount(objv[i]);
8418 /* Command lookup */
8419 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8420 if (cmdPtr == NULL) {
8421 retcode = JimUnknown(interp, objc, objv);
8422 } else {
8423 /* Call it -- Make sure result is an empty object. */
8424 Jim_SetEmptyResult(interp);
8425 if (cmdPtr->cmdProc) {
8426 interp->cmdPrivData = cmdPtr->privData;
8427 retcode = cmdPtr->cmdProc(interp, objc, objv);
8428 if (retcode == JIM_ERR_ADDSTACK) {
8429 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8430 retcode = JIM_ERR;
8431 }
8432 } else {
8433 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8434 if (retcode == JIM_ERR) {
8435 JimAppendStackTrace(interp,
8436 Jim_GetString(objv[0], NULL), "", 1);
8437 }
8438 }
8439 }
8440 /* Decr refcount of arguments and return the retcode */
8441 for (i = 0; i < objc; i++)
8442 Jim_DecrRefCount(interp, objv[i]);
8443 return retcode;
8444 }
8445
8446 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8447 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8448 * The returned object has refcount = 0. */
8449 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8450 int tokens, Jim_Obj **objPtrPtr)
8451 {
8452 int totlen = 0, i, retcode;
8453 Jim_Obj **intv;
8454 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8455 Jim_Obj *objPtr;
8456 char *s;
8457
8458 if (tokens <= JIM_EVAL_SINTV_LEN)
8459 intv = sintv;
8460 else
8461 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8462 tokens);
8463 /* Compute every token forming the argument
8464 * in the intv objects vector. */
8465 for (i = 0; i < tokens; i++) {
8466 switch (token[i].type) {
8467 case JIM_TT_ESC:
8468 case JIM_TT_STR:
8469 intv[i] = token[i].objPtr;
8470 break;
8471 case JIM_TT_VAR:
8472 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8473 if (!intv[i]) {
8474 retcode = JIM_ERR;
8475 goto err;
8476 }
8477 break;
8478 case JIM_TT_DICTSUGAR:
8479 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8480 if (!intv[i]) {
8481 retcode = JIM_ERR;
8482 goto err;
8483 }
8484 break;
8485 case JIM_TT_CMD:
8486 retcode = Jim_EvalObj(interp, token[i].objPtr);
8487 if (retcode != JIM_OK)
8488 goto err;
8489 intv[i] = Jim_GetResult(interp);
8490 break;
8491 default:
8492 Jim_Panic(interp,
8493 "default token type reached "
8494 "in Jim_InterpolateTokens().");
8495 break;
8496 }
8497 Jim_IncrRefCount(intv[i]);
8498 /* Make sure there is a valid
8499 * string rep, and add the string
8500 * length to the total legnth. */
8501 Jim_GetString(intv[i], NULL);
8502 totlen += intv[i]->length;
8503 }
8504 /* Concatenate every token in an unique
8505 * object. */
8506 objPtr = Jim_NewStringObjNoAlloc(interp,
8507 NULL, 0);
8508 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8509 objPtr->length = totlen;
8510 for (i = 0; i < tokens; i++) {
8511 memcpy(s, intv[i]->bytes, intv[i]->length);
8512 s += intv[i]->length;
8513 Jim_DecrRefCount(interp, intv[i]);
8514 }
8515 objPtr->bytes[totlen] = '\0';
8516 /* Free the intv vector if not static. */
8517 if (tokens > JIM_EVAL_SINTV_LEN)
8518 Jim_Free(intv);
8519 *objPtrPtr = objPtr;
8520 return JIM_OK;
8521 err:
8522 i--;
8523 for (; i >= 0; i--)
8524 Jim_DecrRefCount(interp, intv[i]);
8525 if (tokens > JIM_EVAL_SINTV_LEN)
8526 Jim_Free(intv);
8527 return retcode;
8528 }
8529
8530 /* Helper of Jim_EvalObj() to perform argument expansion.
8531 * Basically this function append an argument to 'argv'
8532 * (and increments argc by reference accordingly), performing
8533 * expansion of the list object if 'expand' is non-zero, or
8534 * just adding objPtr to argv if 'expand' is zero. */
8535 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8536 int *argcPtr, int expand, Jim_Obj *objPtr)
8537 {
8538 if (!expand) {
8539 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8540 /* refcount of objPtr not incremented because
8541 * we are actually transfering a reference from
8542 * the old 'argv' to the expanded one. */
8543 (*argv)[*argcPtr] = objPtr;
8544 (*argcPtr)++;
8545 } else {
8546 int len, i;
8547
8548 Jim_ListLength(interp, objPtr, &len);
8549 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8550 for (i = 0; i < len; i++) {
8551 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8552 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8553 (*argcPtr)++;
8554 }
8555 /* The original object reference is no longer needed,
8556 * after the expansion it is no longer present on
8557 * the argument vector, but the single elements are
8558 * in its place. */
8559 Jim_DecrRefCount(interp, objPtr);
8560 }
8561 }
8562
8563 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8564 {
8565 int i, j = 0, len;
8566 ScriptObj *script;
8567 ScriptToken *token;
8568 int *cs; /* command structure array */
8569 int retcode = JIM_OK;
8570 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8571
8572 interp->errorFlag = 0;
8573
8574 /* If the object is of type "list" and there is no
8575 * string representation for this object, we can call
8576 * a specialized version of Jim_EvalObj() */
8577 if (scriptObjPtr->typePtr == &listObjType &&
8578 scriptObjPtr->internalRep.listValue.len &&
8579 scriptObjPtr->bytes == NULL) {
8580 Jim_IncrRefCount(scriptObjPtr);
8581 retcode = Jim_EvalObjVector(interp,
8582 scriptObjPtr->internalRep.listValue.len,
8583 scriptObjPtr->internalRep.listValue.ele);
8584 Jim_DecrRefCount(interp, scriptObjPtr);
8585 return retcode;
8586 }
8587
8588 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8589 script = Jim_GetScript(interp, scriptObjPtr);
8590 /* Now we have to make sure the internal repr will not be
8591 * freed on shimmering.
8592 *
8593 * Think for example to this:
8594 *
8595 * set x {llength $x; ... some more code ...}; eval $x
8596 *
8597 * In order to preserve the internal rep, we increment the
8598 * inUse field of the script internal rep structure. */
8599 script->inUse++;
8600
8601 token = script->token;
8602 len = script->len;
8603 cs = script->cmdStruct;
8604 i = 0; /* 'i' is the current token index. */
8605
8606 /* Reset the interpreter result. This is useful to
8607 * return the emtpy result in the case of empty program. */
8608 Jim_SetEmptyResult(interp);
8609
8610 /* Execute every command sequentially, returns on
8611 * error (i.e. if a command does not return JIM_OK) */
8612 while (i < len) {
8613 int expand = 0;
8614 int argc = *cs++; /* Get the number of arguments */
8615 Jim_Cmd *cmd;
8616
8617 /* Set the expand flag if needed. */
8618 if (argc == -1) {
8619 expand++;
8620 argc = *cs++;
8621 }
8622 /* Allocate the arguments vector */
8623 if (argc <= JIM_EVAL_SARGV_LEN)
8624 argv = sargv;
8625 else
8626 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8627 /* Populate the arguments objects. */
8628 for (j = 0; j < argc; j++) {
8629 int tokens = *cs++;
8630
8631 /* tokens is negative if expansion is needed.
8632 * for this argument. */
8633 if (tokens < 0) {
8634 tokens = (-tokens)-1;
8635 i++;
8636 }
8637 if (tokens == 1) {
8638 /* Fast path if the token does not
8639 * need interpolation */
8640 switch (token[i].type) {
8641 case JIM_TT_ESC:
8642 case JIM_TT_STR:
8643 argv[j] = token[i].objPtr;
8644 break;
8645 case JIM_TT_VAR:
8646 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8647 JIM_ERRMSG);
8648 if (!tmpObjPtr) {
8649 retcode = JIM_ERR;
8650 goto err;
8651 }
8652 argv[j] = tmpObjPtr;
8653 break;
8654 case JIM_TT_DICTSUGAR:
8655 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8656 if (!tmpObjPtr) {
8657 retcode = JIM_ERR;
8658 goto err;
8659 }
8660 argv[j] = tmpObjPtr;
8661 break;
8662 case JIM_TT_CMD:
8663 retcode = Jim_EvalObj(interp, token[i].objPtr);
8664 if (retcode != JIM_OK)
8665 goto err;
8666 argv[j] = Jim_GetResult(interp);
8667 break;
8668 default:
8669 Jim_Panic(interp,
8670 "default token type reached "
8671 "in Jim_EvalObj().");
8672 break;
8673 }
8674 Jim_IncrRefCount(argv[j]);
8675 i += 2;
8676 } else {
8677 /* For interpolation we call an helper
8678 * function doing the work for us. */
8679 if ((retcode = Jim_InterpolateTokens(interp,
8680 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8681 {
8682 goto err;
8683 }
8684 argv[j] = tmpObjPtr;
8685 Jim_IncrRefCount(argv[j]);
8686 i += tokens + 1;
8687 }
8688 }
8689 /* Handle {expand} expansion */
8690 if (expand) {
8691 int *ecs = cs - argc;
8692 int eargc = 0;
8693 Jim_Obj **eargv = NULL;
8694
8695 for (j = 0; j < argc; j++) {
8696 Jim_ExpandArgument(interp, &eargv, &eargc,
8697 ecs[j] < 0, argv[j]);
8698 }
8699 if (argv != sargv)
8700 Jim_Free(argv);
8701 argc = eargc;
8702 argv = eargv;
8703 j = argc;
8704 if (argc == 0) {
8705 /* Nothing to do with zero args. */
8706 Jim_Free(eargv);
8707 continue;
8708 }
8709 }
8710 /* Lookup the command to call */
8711 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8712 if (cmd != NULL) {
8713 /* Call it -- Make sure result is an empty object. */
8714 Jim_SetEmptyResult(interp);
8715 if (cmd->cmdProc) {
8716 interp->cmdPrivData = cmd->privData;
8717 retcode = cmd->cmdProc(interp, argc, argv);
8718 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8719 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8720 retcode = JIM_ERR;
8721 }
8722 } else {
8723 retcode = JimCallProcedure(interp, cmd, argc, argv);
8724 if (retcode == JIM_ERR) {
8725 JimAppendStackTrace(interp,
8726 Jim_GetString(argv[0], NULL), script->fileName,
8727 token[i-argc*2].linenr);
8728 }
8729 }
8730 } else {
8731 /* Call [unknown] */
8732 retcode = JimUnknown(interp, argc, argv);
8733 if (retcode == JIM_ERR) {
8734 JimAppendStackTrace(interp,
8735 "", script->fileName,
8736 token[i-argc*2].linenr);
8737 }
8738 }
8739 if (retcode != JIM_OK) {
8740 i -= argc*2; /* point to the command name. */
8741 goto err;
8742 }
8743 /* Decrement the arguments count */
8744 for (j = 0; j < argc; j++) {
8745 Jim_DecrRefCount(interp, argv[j]);
8746 }
8747
8748 if (argv != sargv) {
8749 Jim_Free(argv);
8750 argv = NULL;
8751 }
8752 }
8753 /* Note that we don't have to decrement inUse, because the
8754 * following code transfers our use of the reference again to
8755 * the script object. */
8756 j = 0; /* on normal termination, the argv array is already
8757 Jim_DecrRefCount-ed. */
8758 err:
8759 /* Handle errors. */
8760 if (retcode == JIM_ERR && !interp->errorFlag) {
8761 interp->errorFlag = 1;
8762 JimSetErrorFileName(interp, script->fileName);
8763 JimSetErrorLineNumber(interp, token[i].linenr);
8764 JimResetStackTrace(interp);
8765 }
8766 Jim_FreeIntRep(interp, scriptObjPtr);
8767 scriptObjPtr->typePtr = &scriptObjType;
8768 Jim_SetIntRepPtr(scriptObjPtr, script);
8769 Jim_DecrRefCount(interp, scriptObjPtr);
8770 for (i = 0; i < j; i++) {
8771 Jim_DecrRefCount(interp, argv[i]);
8772 }
8773 if (argv != sargv)
8774 Jim_Free(argv);
8775 return retcode;
8776 }
8777
8778 /* Call a procedure implemented in Tcl.
8779 * It's possible to speed-up a lot this function, currently
8780 * the callframes are not cached, but allocated and
8781 * destroied every time. What is expecially costly is
8782 * to create/destroy the local vars hash table every time.
8783 *
8784 * This can be fixed just implementing callframes caching
8785 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8786 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8787 Jim_Obj *const *argv)
8788 {
8789 int i, retcode;
8790 Jim_CallFrame *callFramePtr;
8791 int num_args;
8792
8793 /* Check arity */
8794 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8795 argc > cmd->arityMax)) {
8796 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8797 Jim_AppendStrings(interp, objPtr,
8798 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8799 (cmd->arityMin > 1) ? " " : "",
8800 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8801 Jim_SetResult(interp, objPtr);
8802 return JIM_ERR;
8803 }
8804 /* Check if there are too nested calls */
8805 if (interp->numLevels == interp->maxNestingDepth) {
8806 Jim_SetResultString(interp,
8807 "Too many nested calls. Infinite recursion?", -1);
8808 return JIM_ERR;
8809 }
8810 /* Create a new callframe */
8811 callFramePtr = JimCreateCallFrame(interp);
8812 callFramePtr->parentCallFrame = interp->framePtr;
8813 callFramePtr->argv = argv;
8814 callFramePtr->argc = argc;
8815 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8816 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8817 callFramePtr->staticVars = cmd->staticVars;
8818 Jim_IncrRefCount(cmd->argListObjPtr);
8819 Jim_IncrRefCount(cmd->bodyObjPtr);
8820 interp->framePtr = callFramePtr;
8821 interp->numLevels ++;
8822
8823 /* Set arguments */
8824 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8825
8826 /* If last argument is 'args', don't set it here */
8827 if (cmd->arityMax == -1) {
8828 num_args--;
8829 }
8830
8831 for (i = 0; i < num_args; i++) {
8832 Jim_Obj *argObjPtr=NULL;
8833 Jim_Obj *nameObjPtr=NULL;
8834 Jim_Obj *valueObjPtr=NULL;
8835
8836 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8837 if (i + 1 >= cmd->arityMin) {
8838 /* The name is the first element of the list */
8839 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8840 }
8841 else {
8842 /* The element arg is the name */
8843 nameObjPtr = argObjPtr;
8844 }
8845
8846 if (i + 1 >= argc) {
8847 /* No more values, so use default */
8848 /* The value is the second element of the list */
8849 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8850 }
8851 else {
8852 valueObjPtr = argv[i + 1];
8853 }
8854 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8855 }
8856 /* Set optional arguments */
8857 if (cmd->arityMax == -1) {
8858 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8859
8860 i++;
8861 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8862 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8863 Jim_SetVariable(interp, objPtr, listObjPtr);
8864 }
8865 /* Eval the body */
8866 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8867
8868 /* Destroy the callframe */
8869 interp->numLevels --;
8870 interp->framePtr = interp->framePtr->parentCallFrame;
8871 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8872 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8873 } else {
8874 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8875 }
8876 /* Handle the JIM_EVAL return code */
8877 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8878 int savedLevel = interp->evalRetcodeLevel;
8879
8880 interp->evalRetcodeLevel = interp->numLevels;
8881 while (retcode == JIM_EVAL) {
8882 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8883 Jim_IncrRefCount(resultScriptObjPtr);
8884 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8885 Jim_DecrRefCount(interp, resultScriptObjPtr);
8886 }
8887 interp->evalRetcodeLevel = savedLevel;
8888 }
8889 /* Handle the JIM_RETURN return code */
8890 if (retcode == JIM_RETURN) {
8891 retcode = interp->returnCode;
8892 interp->returnCode = JIM_OK;
8893 }
8894 return retcode;
8895 }
8896
8897 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8898 {
8899 int retval;
8900 Jim_Obj *scriptObjPtr;
8901
8902 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8903 Jim_IncrRefCount(scriptObjPtr);
8904
8905
8906 if (filename) {
8907 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8908 }
8909
8910 retval = Jim_EvalObj(interp, scriptObjPtr);
8911 Jim_DecrRefCount(interp, scriptObjPtr);
8912 return retval;
8913 }
8914
8915 int Jim_Eval(Jim_Interp *interp, const char *script)
8916 {
8917 return Jim_Eval_Named(interp, script, NULL, 0);
8918 }
8919
8920
8921
8922 /* Execute script in the scope of the global level */
8923 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8924 {
8925 Jim_CallFrame *savedFramePtr;
8926 int retval;
8927
8928 savedFramePtr = interp->framePtr;
8929 interp->framePtr = interp->topFramePtr;
8930 retval = Jim_Eval(interp, script);
8931 interp->framePtr = savedFramePtr;
8932 return retval;
8933 }
8934
8935 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8936 {
8937 Jim_CallFrame *savedFramePtr;
8938 int retval;
8939
8940 savedFramePtr = interp->framePtr;
8941 interp->framePtr = interp->topFramePtr;
8942 retval = Jim_EvalObj(interp, scriptObjPtr);
8943 interp->framePtr = savedFramePtr;
8944 /* Try to report the error (if any) via the bgerror proc */
8945 if (retval != JIM_OK) {
8946 Jim_Obj *objv[2];
8947
8948 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8949 objv[1] = Jim_GetResult(interp);
8950 Jim_IncrRefCount(objv[0]);
8951 Jim_IncrRefCount(objv[1]);
8952 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8953 /* Report the error to stderr. */
8954 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8955 Jim_PrintErrorMessage(interp);
8956 }
8957 Jim_DecrRefCount(interp, objv[0]);
8958 Jim_DecrRefCount(interp, objv[1]);
8959 }
8960 return retval;
8961 }
8962
8963 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8964 {
8965 char *prg = NULL;
8966 FILE *fp;
8967 int nread, totread, maxlen, buflen;
8968 int retval;
8969 Jim_Obj *scriptObjPtr;
8970
8971 if ((fp = fopen(filename, "r")) == NULL) {
8972 const int cwd_len = 2048;
8973 char *cwd = malloc(cwd_len);
8974 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8975 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8976 Jim_AppendStrings(interp, Jim_GetResult(interp),
8977 "Error loading script \"", filename, "\"",
8978 " cwd: ", cwd,
8979 " err: ", strerror(errno), NULL);
8980 free(cwd);
8981 return JIM_ERR;
8982 }
8983 buflen = 1024;
8984 maxlen = totread = 0;
8985 while (1) {
8986 if (maxlen < totread + buflen + 1) {
8987 maxlen = totread + buflen + 1;
8988 prg = Jim_Realloc(prg, maxlen);
8989 }
8990 /* do not use Jim_fread() - this is really a file */
8991 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8992 totread += nread;
8993 }
8994 prg[totread] = '\0';
8995 /* do not use Jim_fclose() - this is really a file */
8996 fclose(fp);
8997
8998 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8999 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
9000 Jim_IncrRefCount(scriptObjPtr);
9001 retval = Jim_EvalObj(interp, scriptObjPtr);
9002 Jim_DecrRefCount(interp, scriptObjPtr);
9003 return retval;
9004 }
9005
9006 /* -----------------------------------------------------------------------------
9007 * Subst
9008 * ---------------------------------------------------------------------------*/
9009 static int JimParseSubstStr(struct JimParserCtx *pc)
9010 {
9011 pc->tstart = pc->p;
9012 pc->tline = pc->linenr;
9013 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9014 pc->p++; pc->len--;
9015 }
9016 pc->tend = pc->p-1;
9017 pc->tt = JIM_TT_ESC;
9018 return JIM_OK;
9019 }
9020
9021 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9022 {
9023 int retval;
9024
9025 if (pc->len == 0) {
9026 pc->tstart = pc->tend = pc->p;
9027 pc->tline = pc->linenr;
9028 pc->tt = JIM_TT_EOL;
9029 pc->eof = 1;
9030 return JIM_OK;
9031 }
9032 switch (*pc->p) {
9033 case '[':
9034 retval = JimParseCmd(pc);
9035 if (flags & JIM_SUBST_NOCMD) {
9036 pc->tstart--;
9037 pc->tend++;
9038 pc->tt = (flags & JIM_SUBST_NOESC) ?
9039 JIM_TT_STR : JIM_TT_ESC;
9040 }
9041 return retval;
9042 break;
9043 case '$':
9044 if (JimParseVar(pc) == JIM_ERR) {
9045 pc->tstart = pc->tend = pc->p++; pc->len--;
9046 pc->tline = pc->linenr;
9047 pc->tt = JIM_TT_STR;
9048 } else {
9049 if (flags & JIM_SUBST_NOVAR) {
9050 pc->tstart--;
9051 if (flags & JIM_SUBST_NOESC)
9052 pc->tt = JIM_TT_STR;
9053 else
9054 pc->tt = JIM_TT_ESC;
9055 if (*pc->tstart == '{') {
9056 pc->tstart--;
9057 if (*(pc->tend + 1))
9058 pc->tend++;
9059 }
9060 }
9061 }
9062 break;
9063 default:
9064 retval = JimParseSubstStr(pc);
9065 if (flags & JIM_SUBST_NOESC)
9066 pc->tt = JIM_TT_STR;
9067 return retval;
9068 break;
9069 }
9070 return JIM_OK;
9071 }
9072
9073 /* The subst object type reuses most of the data structures and functions
9074 * of the script object. Script's data structures are a bit more complex
9075 * for what is needed for [subst]itution tasks, but the reuse helps to
9076 * deal with a single data structure at the cost of some more memory
9077 * usage for substitutions. */
9078 static Jim_ObjType substObjType = {
9079 "subst",
9080 FreeScriptInternalRep,
9081 DupScriptInternalRep,
9082 NULL,
9083 JIM_TYPE_REFERENCES,
9084 };
9085
9086 /* This method takes the string representation of an object
9087 * as a Tcl string where to perform [subst]itution, and generates
9088 * the pre-parsed internal representation. */
9089 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9090 {
9091 int scriptTextLen;
9092 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9093 struct JimParserCtx parser;
9094 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9095
9096 script->len = 0;
9097 script->csLen = 0;
9098 script->commands = 0;
9099 script->token = NULL;
9100 script->cmdStruct = NULL;
9101 script->inUse = 1;
9102 script->substFlags = flags;
9103 script->fileName = NULL;
9104
9105 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9106 while (1) {
9107 char *token;
9108 int len, type, linenr;
9109
9110 JimParseSubst(&parser, flags);
9111 if (JimParserEof(&parser)) break;
9112 token = JimParserGetToken(&parser, &len, &type, &linenr);
9113 ScriptObjAddToken(interp, script, token, len, type,
9114 NULL, linenr);
9115 }
9116 /* Free the old internal rep and set the new one. */
9117 Jim_FreeIntRep(interp, objPtr);
9118 Jim_SetIntRepPtr(objPtr, script);
9119 objPtr->typePtr = &scriptObjType;
9120 return JIM_OK;
9121 }
9122
9123 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9124 {
9125 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9126
9127 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9128 SetSubstFromAny(interp, objPtr, flags);
9129 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9130 }
9131
9132 /* Performs commands,variables,blackslashes substitution,
9133 * storing the result object (with refcount 0) into
9134 * resObjPtrPtr. */
9135 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9136 Jim_Obj **resObjPtrPtr, int flags)
9137 {
9138 ScriptObj *script;
9139 ScriptToken *token;
9140 int i, len, retcode = JIM_OK;
9141 Jim_Obj *resObjPtr, *savedResultObjPtr;
9142
9143 script = Jim_GetSubst(interp, substObjPtr, flags);
9144 #ifdef JIM_OPTIMIZATION
9145 /* Fast path for a very common case with array-alike syntax,
9146 * that's: $foo($bar) */
9147 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9148 Jim_Obj *varObjPtr = script->token[0].objPtr;
9149
9150 Jim_IncrRefCount(varObjPtr);
9151 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9152 if (resObjPtr == NULL) {
9153 Jim_DecrRefCount(interp, varObjPtr);
9154 return JIM_ERR;
9155 }
9156 Jim_DecrRefCount(interp, varObjPtr);
9157 *resObjPtrPtr = resObjPtr;
9158 return JIM_OK;
9159 }
9160 #endif
9161
9162 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9163 /* In order to preserve the internal rep, we increment the
9164 * inUse field of the script internal rep structure. */
9165 script->inUse++;
9166
9167 token = script->token;
9168 len = script->len;
9169
9170 /* Save the interp old result, to set it again before
9171 * to return. */
9172 savedResultObjPtr = interp->result;
9173 Jim_IncrRefCount(savedResultObjPtr);
9174
9175 /* Perform the substitution. Starts with an empty object
9176 * and adds every token (performing the appropriate
9177 * var/command/escape substitution). */
9178 resObjPtr = Jim_NewStringObj(interp, "", 0);
9179 for (i = 0; i < len; i++) {
9180 Jim_Obj *objPtr;
9181
9182 switch (token[i].type) {
9183 case JIM_TT_STR:
9184 case JIM_TT_ESC:
9185 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9186 break;
9187 case JIM_TT_VAR:
9188 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9189 if (objPtr == NULL) goto err;
9190 Jim_IncrRefCount(objPtr);
9191 Jim_AppendObj(interp, resObjPtr, objPtr);
9192 Jim_DecrRefCount(interp, objPtr);
9193 break;
9194 case JIM_TT_DICTSUGAR:
9195 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9196 if (!objPtr) {
9197 retcode = JIM_ERR;
9198 goto err;
9199 }
9200 break;
9201 case JIM_TT_CMD:
9202 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9203 goto err;
9204 Jim_AppendObj(interp, resObjPtr, interp->result);
9205 break;
9206 default:
9207 Jim_Panic(interp,
9208 "default token type (%d) reached "
9209 "in Jim_SubstObj().", token[i].type);
9210 break;
9211 }
9212 }
9213 ok:
9214 if (retcode == JIM_OK)
9215 Jim_SetResult(interp, savedResultObjPtr);
9216 Jim_DecrRefCount(interp, savedResultObjPtr);
9217 /* Note that we don't have to decrement inUse, because the
9218 * following code transfers our use of the reference again to
9219 * the script object. */
9220 Jim_FreeIntRep(interp, substObjPtr);
9221 substObjPtr->typePtr = &scriptObjType;
9222 Jim_SetIntRepPtr(substObjPtr, script);
9223 Jim_DecrRefCount(interp, substObjPtr);
9224 *resObjPtrPtr = resObjPtr;
9225 return retcode;
9226 err:
9227 Jim_FreeNewObj(interp, resObjPtr);
9228 retcode = JIM_ERR;
9229 goto ok;
9230 }
9231
9232 /* -----------------------------------------------------------------------------
9233 * API Input/Export functions
9234 * ---------------------------------------------------------------------------*/
9235
9236 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9237 {
9238 Jim_HashEntry *he;
9239
9240 he = Jim_FindHashEntry(&interp->stub, funcname);
9241 if (!he)
9242 return JIM_ERR;
9243 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9244 return JIM_OK;
9245 }
9246
9247 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9248 {
9249 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9250 }
9251
9252 #define JIM_REGISTER_API(name) \
9253 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9254
9255 void JimRegisterCoreApi(Jim_Interp *interp)
9256 {
9257 interp->getApiFuncPtr = Jim_GetApi;
9258 JIM_REGISTER_API(Alloc);
9259 JIM_REGISTER_API(Free);
9260 JIM_REGISTER_API(Eval);
9261 JIM_REGISTER_API(Eval_Named);
9262 JIM_REGISTER_API(EvalGlobal);
9263 JIM_REGISTER_API(EvalFile);
9264 JIM_REGISTER_API(EvalObj);
9265 JIM_REGISTER_API(EvalObjBackground);
9266 JIM_REGISTER_API(EvalObjVector);
9267 JIM_REGISTER_API(InitHashTable);
9268 JIM_REGISTER_API(ExpandHashTable);
9269 JIM_REGISTER_API(AddHashEntry);
9270 JIM_REGISTER_API(ReplaceHashEntry);
9271 JIM_REGISTER_API(DeleteHashEntry);
9272 JIM_REGISTER_API(FreeHashTable);
9273 JIM_REGISTER_API(FindHashEntry);
9274 JIM_REGISTER_API(ResizeHashTable);
9275 JIM_REGISTER_API(GetHashTableIterator);
9276 JIM_REGISTER_API(NextHashEntry);
9277 JIM_REGISTER_API(NewObj);
9278 JIM_REGISTER_API(FreeObj);
9279 JIM_REGISTER_API(InvalidateStringRep);
9280 JIM_REGISTER_API(InitStringRep);
9281 JIM_REGISTER_API(DuplicateObj);
9282 JIM_REGISTER_API(GetString);
9283 JIM_REGISTER_API(Length);
9284 JIM_REGISTER_API(InvalidateStringRep);
9285 JIM_REGISTER_API(NewStringObj);
9286 JIM_REGISTER_API(NewStringObjNoAlloc);
9287 JIM_REGISTER_API(AppendString);
9288 JIM_REGISTER_API(AppendString_sprintf);
9289 JIM_REGISTER_API(AppendObj);
9290 JIM_REGISTER_API(AppendStrings);
9291 JIM_REGISTER_API(StringEqObj);
9292 JIM_REGISTER_API(StringMatchObj);
9293 JIM_REGISTER_API(StringRangeObj);
9294 JIM_REGISTER_API(FormatString);
9295 JIM_REGISTER_API(CompareStringImmediate);
9296 JIM_REGISTER_API(NewReference);
9297 JIM_REGISTER_API(GetReference);
9298 JIM_REGISTER_API(SetFinalizer);
9299 JIM_REGISTER_API(GetFinalizer);
9300 JIM_REGISTER_API(CreateInterp);
9301 JIM_REGISTER_API(FreeInterp);
9302 JIM_REGISTER_API(GetExitCode);
9303 JIM_REGISTER_API(SetStdin);
9304 JIM_REGISTER_API(SetStdout);
9305 JIM_REGISTER_API(SetStderr);
9306 JIM_REGISTER_API(CreateCommand);
9307 JIM_REGISTER_API(CreateProcedure);
9308 JIM_REGISTER_API(DeleteCommand);
9309 JIM_REGISTER_API(RenameCommand);
9310 JIM_REGISTER_API(GetCommand);
9311 JIM_REGISTER_API(SetVariable);
9312 JIM_REGISTER_API(SetVariableStr);
9313 JIM_REGISTER_API(SetGlobalVariableStr);
9314 JIM_REGISTER_API(SetVariableStrWithStr);
9315 JIM_REGISTER_API(SetVariableLink);
9316 JIM_REGISTER_API(GetVariable);
9317 JIM_REGISTER_API(GetCallFrameByLevel);
9318 JIM_REGISTER_API(Collect);
9319 JIM_REGISTER_API(CollectIfNeeded);
9320 JIM_REGISTER_API(GetIndex);
9321 JIM_REGISTER_API(NewListObj);
9322 JIM_REGISTER_API(ListAppendElement);
9323 JIM_REGISTER_API(ListAppendList);
9324 JIM_REGISTER_API(ListLength);
9325 JIM_REGISTER_API(ListIndex);
9326 JIM_REGISTER_API(SetListIndex);
9327 JIM_REGISTER_API(ConcatObj);
9328 JIM_REGISTER_API(NewDictObj);
9329 JIM_REGISTER_API(DictKey);
9330 JIM_REGISTER_API(DictKeysVector);
9331 JIM_REGISTER_API(GetIndex);
9332 JIM_REGISTER_API(GetReturnCode);
9333 JIM_REGISTER_API(EvalExpression);
9334 JIM_REGISTER_API(GetBoolFromExpr);
9335 JIM_REGISTER_API(GetWide);
9336 JIM_REGISTER_API(GetLong);
9337 JIM_REGISTER_API(SetWide);
9338 JIM_REGISTER_API(NewIntObj);
9339 JIM_REGISTER_API(GetDouble);
9340 JIM_REGISTER_API(SetDouble);
9341 JIM_REGISTER_API(NewDoubleObj);
9342 JIM_REGISTER_API(WrongNumArgs);
9343 JIM_REGISTER_API(SetDictKeysVector);
9344 JIM_REGISTER_API(SubstObj);
9345 JIM_REGISTER_API(RegisterApi);
9346 JIM_REGISTER_API(PrintErrorMessage);
9347 JIM_REGISTER_API(InteractivePrompt);
9348 JIM_REGISTER_API(RegisterCoreCommands);
9349 JIM_REGISTER_API(GetSharedString);
9350 JIM_REGISTER_API(ReleaseSharedString);
9351 JIM_REGISTER_API(Panic);
9352 JIM_REGISTER_API(StrDup);
9353 JIM_REGISTER_API(UnsetVariable);
9354 JIM_REGISTER_API(GetVariableStr);
9355 JIM_REGISTER_API(GetGlobalVariable);
9356 JIM_REGISTER_API(GetGlobalVariableStr);
9357 JIM_REGISTER_API(GetAssocData);
9358 JIM_REGISTER_API(SetAssocData);
9359 JIM_REGISTER_API(DeleteAssocData);
9360 JIM_REGISTER_API(GetEnum);
9361 JIM_REGISTER_API(ScriptIsComplete);
9362 JIM_REGISTER_API(PackageRequire);
9363 JIM_REGISTER_API(PackageProvide);
9364 JIM_REGISTER_API(InitStack);
9365 JIM_REGISTER_API(FreeStack);
9366 JIM_REGISTER_API(StackLen);
9367 JIM_REGISTER_API(StackPush);
9368 JIM_REGISTER_API(StackPop);
9369 JIM_REGISTER_API(StackPeek);
9370 JIM_REGISTER_API(FreeStackElements);
9371 JIM_REGISTER_API(fprintf);
9372 JIM_REGISTER_API(vfprintf);
9373 JIM_REGISTER_API(fwrite);
9374 JIM_REGISTER_API(fread);
9375 JIM_REGISTER_API(fflush);
9376 JIM_REGISTER_API(fgets);
9377 JIM_REGISTER_API(GetNvp);
9378 JIM_REGISTER_API(Nvp_name2value);
9379 JIM_REGISTER_API(Nvp_name2value_simple);
9380 JIM_REGISTER_API(Nvp_name2value_obj);
9381 JIM_REGISTER_API(Nvp_name2value_nocase);
9382 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9383
9384 JIM_REGISTER_API(Nvp_value2name);
9385 JIM_REGISTER_API(Nvp_value2name_simple);
9386 JIM_REGISTER_API(Nvp_value2name_obj);
9387
9388 JIM_REGISTER_API(GetOpt_Setup);
9389 JIM_REGISTER_API(GetOpt_Debug);
9390 JIM_REGISTER_API(GetOpt_Obj);
9391 JIM_REGISTER_API(GetOpt_String);
9392 JIM_REGISTER_API(GetOpt_Double);
9393 JIM_REGISTER_API(GetOpt_Wide);
9394 JIM_REGISTER_API(GetOpt_Nvp);
9395 JIM_REGISTER_API(GetOpt_NvpUnknown);
9396 JIM_REGISTER_API(GetOpt_Enum);
9397
9398 JIM_REGISTER_API(Debug_ArgvString);
9399 JIM_REGISTER_API(SetResult_sprintf);
9400 JIM_REGISTER_API(SetResult_NvpUnknown);
9401
9402 }
9403
9404 /* -----------------------------------------------------------------------------
9405 * Core commands utility functions
9406 * ---------------------------------------------------------------------------*/
9407 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9408 const char *msg)
9409 {
9410 int i;
9411 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9412
9413 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9414 for (i = 0; i < argc; i++) {
9415 Jim_AppendObj(interp, objPtr, argv[i]);
9416 if (!(i + 1 == argc && msg[0] == '\0'))
9417 Jim_AppendString(interp, objPtr, " ", 1);
9418 }
9419 Jim_AppendString(interp, objPtr, msg, -1);
9420 Jim_AppendString(interp, objPtr, "\"", 1);
9421 Jim_SetResult(interp, objPtr);
9422 }
9423
9424 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9425 {
9426 Jim_HashTableIterator *htiter;
9427 Jim_HashEntry *he;
9428 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9429 const char *pattern;
9430 int patternLen=0;
9431
9432 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9433 htiter = Jim_GetHashTableIterator(&interp->commands);
9434 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9435 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9436 strlen((const char*)he->key), 0))
9437 continue;
9438 Jim_ListAppendElement(interp, listObjPtr,
9439 Jim_NewStringObj(interp, he->key, -1));
9440 }
9441 Jim_FreeHashTableIterator(htiter);
9442 return listObjPtr;
9443 }
9444
9445 #define JIM_VARLIST_GLOBALS 0
9446 #define JIM_VARLIST_LOCALS 1
9447 #define JIM_VARLIST_VARS 2
9448
9449 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9450 int mode)
9451 {
9452 Jim_HashTableIterator *htiter;
9453 Jim_HashEntry *he;
9454 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9455 const char *pattern;
9456 int patternLen=0;
9457
9458 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9459 if (mode == JIM_VARLIST_GLOBALS) {
9460 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9461 } else {
9462 /* For [info locals], if we are at top level an emtpy list
9463 * is returned. I don't agree, but we aim at compatibility (SS) */
9464 if (mode == JIM_VARLIST_LOCALS &&
9465 interp->framePtr == interp->topFramePtr)
9466 return listObjPtr;
9467 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9468 }
9469 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9470 Jim_Var *varPtr = (Jim_Var*) he->val;
9471 if (mode == JIM_VARLIST_LOCALS) {
9472 if (varPtr->linkFramePtr != NULL)
9473 continue;
9474 }
9475 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9476 strlen((const char*)he->key), 0))
9477 continue;
9478 Jim_ListAppendElement(interp, listObjPtr,
9479 Jim_NewStringObj(interp, he->key, -1));
9480 }
9481 Jim_FreeHashTableIterator(htiter);
9482 return listObjPtr;
9483 }
9484
9485 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9486 Jim_Obj **objPtrPtr)
9487 {
9488 Jim_CallFrame *targetCallFrame;
9489
9490 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9491 != JIM_OK)
9492 return JIM_ERR;
9493 /* No proc call at toplevel callframe */
9494 if (targetCallFrame == interp->topFramePtr) {
9495 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9496 Jim_AppendStrings(interp, Jim_GetResult(interp),
9497 "bad level \"",
9498 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9499 return JIM_ERR;
9500 }
9501 *objPtrPtr = Jim_NewListObj(interp,
9502 targetCallFrame->argv,
9503 targetCallFrame->argc);
9504 return JIM_OK;
9505 }
9506
9507 /* -----------------------------------------------------------------------------
9508 * Core commands
9509 * ---------------------------------------------------------------------------*/
9510
9511 /* fake [puts] -- not the real puts, just for debugging. */
9512 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9513 Jim_Obj *const *argv)
9514 {
9515 const char *str;
9516 int len, nonewline = 0;
9517
9518 if (argc != 2 && argc != 3) {
9519 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9520 return JIM_ERR;
9521 }
9522 if (argc == 3) {
9523 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9524 {
9525 Jim_SetResultString(interp, "The second argument must "
9526 "be -nonewline", -1);
9527 return JIM_OK;
9528 } else {
9529 nonewline = 1;
9530 argv++;
9531 }
9532 }
9533 str = Jim_GetString(argv[1], &len);
9534 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9535 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9536 return JIM_OK;
9537 }
9538
9539 /* Helper for [+] and [*] */
9540 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9541 Jim_Obj *const *argv, int op)
9542 {
9543 jim_wide wideValue, res;
9544 double doubleValue, doubleRes;
9545 int i;
9546
9547 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9548
9549 for (i = 1; i < argc; i++) {
9550 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9551 goto trydouble;
9552 if (op == JIM_EXPROP_ADD)
9553 res += wideValue;
9554 else
9555 res *= wideValue;
9556 }
9557 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9558 return JIM_OK;
9559 trydouble:
9560 doubleRes = (double) res;
9561 for (;i < argc; i++) {
9562 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9563 return JIM_ERR;
9564 if (op == JIM_EXPROP_ADD)
9565 doubleRes += doubleValue;
9566 else
9567 doubleRes *= doubleValue;
9568 }
9569 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9570 return JIM_OK;
9571 }
9572
9573 /* Helper for [-] and [/] */
9574 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9575 Jim_Obj *const *argv, int op)
9576 {
9577 jim_wide wideValue, res = 0;
9578 double doubleValue, doubleRes = 0;
9579 int i = 2;
9580
9581 if (argc < 2) {
9582 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9583 return JIM_ERR;
9584 } else if (argc == 2) {
9585 /* The arity = 2 case is different. For [- x] returns -x,
9586 * while [/ x] returns 1/x. */
9587 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9588 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9589 JIM_OK)
9590 {
9591 return JIM_ERR;
9592 } else {
9593 if (op == JIM_EXPROP_SUB)
9594 doubleRes = -doubleValue;
9595 else
9596 doubleRes = 1.0/doubleValue;
9597 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9598 doubleRes));
9599 return JIM_OK;
9600 }
9601 }
9602 if (op == JIM_EXPROP_SUB) {
9603 res = -wideValue;
9604 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9605 } else {
9606 doubleRes = 1.0/wideValue;
9607 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9608 doubleRes));
9609 }
9610 return JIM_OK;
9611 } else {
9612 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9613 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9614 != JIM_OK) {
9615 return JIM_ERR;
9616 } else {
9617 goto trydouble;
9618 }
9619 }
9620 }
9621 for (i = 2; i < argc; i++) {
9622 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9623 doubleRes = (double) res;
9624 goto trydouble;
9625 }
9626 if (op == JIM_EXPROP_SUB)
9627 res -= wideValue;
9628 else
9629 res /= wideValue;
9630 }
9631 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9632 return JIM_OK;
9633 trydouble:
9634 for (;i < argc; i++) {
9635 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9636 return JIM_ERR;
9637 if (op == JIM_EXPROP_SUB)
9638 doubleRes -= doubleValue;
9639 else
9640 doubleRes /= doubleValue;
9641 }
9642 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9643 return JIM_OK;
9644 }
9645
9646
9647 /* [+] */
9648 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9649 Jim_Obj *const *argv)
9650 {
9651 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9652 }
9653
9654 /* [*] */
9655 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9656 Jim_Obj *const *argv)
9657 {
9658 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9659 }
9660
9661 /* [-] */
9662 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9663 Jim_Obj *const *argv)
9664 {
9665 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9666 }
9667
9668 /* [/] */
9669 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9670 Jim_Obj *const *argv)
9671 {
9672 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9673 }
9674
9675 /* [set] */
9676 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9677 Jim_Obj *const *argv)
9678 {
9679 if (argc != 2 && argc != 3) {
9680 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9681 return JIM_ERR;
9682 }
9683 if (argc == 2) {
9684 Jim_Obj *objPtr;
9685 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9686 if (!objPtr)
9687 return JIM_ERR;
9688 Jim_SetResult(interp, objPtr);
9689 return JIM_OK;
9690 }
9691 /* argc == 3 case. */
9692 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9693 return JIM_ERR;
9694 Jim_SetResult(interp, argv[2]);
9695 return JIM_OK;
9696 }
9697
9698 /* [unset] */
9699 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9700 Jim_Obj *const *argv)
9701 {
9702 int i;
9703
9704 if (argc < 2) {
9705 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9706 return JIM_ERR;
9707 }
9708 for (i = 1; i < argc; i++) {
9709 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9710 return JIM_ERR;
9711 }
9712 return JIM_OK;
9713 }
9714
9715 /* [incr] */
9716 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9717 Jim_Obj *const *argv)
9718 {
9719 jim_wide wideValue, increment = 1;
9720 Jim_Obj *intObjPtr;
9721
9722 if (argc != 2 && argc != 3) {
9723 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9724 return JIM_ERR;
9725 }
9726 if (argc == 3) {
9727 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9728 return JIM_ERR;
9729 }
9730 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9731 if (!intObjPtr) return JIM_ERR;
9732 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9733 return JIM_ERR;
9734 if (Jim_IsShared(intObjPtr)) {
9735 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9736 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9737 Jim_FreeNewObj(interp, intObjPtr);
9738 return JIM_ERR;
9739 }
9740 } else {
9741 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9742 /* The following step is required in order to invalidate the
9743 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9744 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9745 return JIM_ERR;
9746 }
9747 }
9748 Jim_SetResult(interp, intObjPtr);
9749 return JIM_OK;
9750 }
9751
9752 /* [while] */
9753 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9754 Jim_Obj *const *argv)
9755 {
9756 if (argc != 3) {
9757 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9758 return JIM_ERR;
9759 }
9760 /* Try to run a specialized version of while if the expression
9761 * is in one of the following forms:
9762 *
9763 * $a < CONST, $a < $b
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
9770 * !$a
9771 * CONST
9772 */
9773
9774 #ifdef JIM_OPTIMIZATION
9775 {
9776 ExprByteCode *expr;
9777 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9778 int exprLen, retval;
9779
9780 /* STEP 1 -- Check if there are the conditions to run the specialized
9781 * version of while */
9782
9783 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9784 if (expr->len <= 0 || expr->len > 3) goto noopt;
9785 switch (expr->len) {
9786 case 1:
9787 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9788 expr->opcode[0] != JIM_EXPROP_NUMBER)
9789 goto noopt;
9790 break;
9791 case 2:
9792 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9793 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9794 goto noopt;
9795 break;
9796 case 3:
9797 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9798 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9799 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9800 goto noopt;
9801 switch (expr->opcode[2]) {
9802 case JIM_EXPROP_LT:
9803 case JIM_EXPROP_LTE:
9804 case JIM_EXPROP_GT:
9805 case JIM_EXPROP_GTE:
9806 case JIM_EXPROP_NUMEQ:
9807 case JIM_EXPROP_NUMNE:
9808 /* nothing to do */
9809 break;
9810 default:
9811 goto noopt;
9812 }
9813 break;
9814 default:
9815 Jim_Panic(interp,
9816 "Unexpected default reached in Jim_WhileCoreCommand()");
9817 break;
9818 }
9819
9820 /* STEP 2 -- conditions meet. Initialization. Take different
9821 * branches for different expression lengths. */
9822 exprLen = expr->len;
9823
9824 if (exprLen == 1) {
9825 jim_wide wideValue=0;
9826
9827 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9828 varAObjPtr = expr->obj[0];
9829 Jim_IncrRefCount(varAObjPtr);
9830 } else {
9831 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9832 goto noopt;
9833 }
9834 while (1) {
9835 if (varAObjPtr) {
9836 if (!(objPtr =
9837 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9838 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9839 {
9840 Jim_DecrRefCount(interp, varAObjPtr);
9841 goto noopt;
9842 }
9843 }
9844 if (!wideValue) break;
9845 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9846 switch (retval) {
9847 case JIM_BREAK:
9848 if (varAObjPtr)
9849 Jim_DecrRefCount(interp, varAObjPtr);
9850 goto out;
9851 break;
9852 case JIM_CONTINUE:
9853 continue;
9854 break;
9855 default:
9856 if (varAObjPtr)
9857 Jim_DecrRefCount(interp, varAObjPtr);
9858 return retval;
9859 }
9860 }
9861 }
9862 if (varAObjPtr)
9863 Jim_DecrRefCount(interp, varAObjPtr);
9864 } else if (exprLen == 3) {
9865 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9866 int cmpType = expr->opcode[2];
9867
9868 varAObjPtr = expr->obj[0];
9869 Jim_IncrRefCount(varAObjPtr);
9870 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9871 varBObjPtr = expr->obj[1];
9872 Jim_IncrRefCount(varBObjPtr);
9873 } else {
9874 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9875 goto noopt;
9876 }
9877 while (1) {
9878 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9879 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9880 {
9881 Jim_DecrRefCount(interp, varAObjPtr);
9882 if (varBObjPtr)
9883 Jim_DecrRefCount(interp, varBObjPtr);
9884 goto noopt;
9885 }
9886 if (varBObjPtr) {
9887 if (!(objPtr =
9888 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9889 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9890 {
9891 Jim_DecrRefCount(interp, varAObjPtr);
9892 Jim_DecrRefCount(interp, varBObjPtr);
9893 goto noopt;
9894 }
9895 }
9896 switch (cmpType) {
9897 case JIM_EXPROP_LT:
9898 cmpRes = wideValueA < wideValueB; break;
9899 case JIM_EXPROP_LTE:
9900 cmpRes = wideValueA <= wideValueB; break;
9901 case JIM_EXPROP_GT:
9902 cmpRes = wideValueA > wideValueB; break;
9903 case JIM_EXPROP_GTE:
9904 cmpRes = wideValueA >= wideValueB; break;
9905 case JIM_EXPROP_NUMEQ:
9906 cmpRes = wideValueA == wideValueB; break;
9907 case JIM_EXPROP_NUMNE:
9908 cmpRes = wideValueA != wideValueB; break;
9909 }
9910 if (!cmpRes) break;
9911 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9912 switch (retval) {
9913 case JIM_BREAK:
9914 Jim_DecrRefCount(interp, varAObjPtr);
9915 if (varBObjPtr)
9916 Jim_DecrRefCount(interp, varBObjPtr);
9917 goto out;
9918 break;
9919 case JIM_CONTINUE:
9920 continue;
9921 break;
9922 default:
9923 Jim_DecrRefCount(interp, varAObjPtr);
9924 if (varBObjPtr)
9925 Jim_DecrRefCount(interp, varBObjPtr);
9926 return retval;
9927 }
9928 }
9929 }
9930 Jim_DecrRefCount(interp, varAObjPtr);
9931 if (varBObjPtr)
9932 Jim_DecrRefCount(interp, varBObjPtr);
9933 } else {
9934 /* TODO: case for len == 2 */
9935 goto noopt;
9936 }
9937 Jim_SetEmptyResult(interp);
9938 return JIM_OK;
9939 }
9940 noopt:
9941 #endif
9942
9943 /* The general purpose implementation of while starts here */
9944 while (1) {
9945 int boolean, retval;
9946
9947 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9948 &boolean)) != JIM_OK)
9949 return retval;
9950 if (!boolean) break;
9951 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9952 switch (retval) {
9953 case JIM_BREAK:
9954 goto out;
9955 break;
9956 case JIM_CONTINUE:
9957 continue;
9958 break;
9959 default:
9960 return retval;
9961 }
9962 }
9963 }
9964 out:
9965 Jim_SetEmptyResult(interp);
9966 return JIM_OK;
9967 }
9968
9969 /* [for] */
9970 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9971 Jim_Obj *const *argv)
9972 {
9973 int retval;
9974
9975 if (argc != 5) {
9976 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9977 return JIM_ERR;
9978 }
9979 /* Check if the for is on the form:
9980 * for {set i CONST} {$i < CONST} {incr i}
9981 * for {set i CONST} {$i < $j} {incr i}
9982 * for {set i CONST} {$i <= CONST} {incr i}
9983 * for {set i CONST} {$i <= $j} {incr i}
9984 * XXX: NOTE: if variable traces are implemented, this optimization
9985 * need to be modified to check for the proc epoch at every variable
9986 * update. */
9987 #ifdef JIM_OPTIMIZATION
9988 {
9989 ScriptObj *initScript, *incrScript;
9990 ExprByteCode *expr;
9991 jim_wide start, stop=0, currentVal;
9992 unsigned jim_wide procEpoch = interp->procEpoch;
9993 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9994 int cmpType;
9995 struct Jim_Cmd *cmdPtr;
9996
9997 /* Do it only if there aren't shared arguments */
9998 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9999 goto evalstart;
10000 initScript = Jim_GetScript(interp, argv[1]);
10001 expr = Jim_GetExpression(interp, argv[2]);
10002 incrScript = Jim_GetScript(interp, argv[3]);
10003
10004 /* Ensure proper lengths to start */
10005 if (initScript->len != 6) goto evalstart;
10006 if (incrScript->len != 4) goto evalstart;
10007 if (expr->len != 3) goto evalstart;
10008 /* Ensure proper token types. */
10009 if (initScript->token[2].type != JIM_TT_ESC ||
10010 initScript->token[4].type != JIM_TT_ESC ||
10011 incrScript->token[2].type != JIM_TT_ESC ||
10012 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10013 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10014 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10015 (expr->opcode[2] != JIM_EXPROP_LT &&
10016 expr->opcode[2] != JIM_EXPROP_LTE))
10017 goto evalstart;
10018 cmpType = expr->opcode[2];
10019 /* Initialization command must be [set] */
10020 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10021 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10022 goto evalstart;
10023 /* Update command must be incr */
10024 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10025 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10026 goto evalstart;
10027 /* set, incr, expression must be about the same variable */
10028 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10029 incrScript->token[2].objPtr, 0))
10030 goto evalstart;
10031 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10032 expr->obj[0], 0))
10033 goto evalstart;
10034 /* Check that the initialization and comparison are valid integers */
10035 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10036 goto evalstart;
10037 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10038 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10039 {
10040 goto evalstart;
10041 }
10042
10043 /* Initialization */
10044 varNamePtr = expr->obj[0];
10045 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10046 stopVarNamePtr = expr->obj[1];
10047 Jim_IncrRefCount(stopVarNamePtr);
10048 }
10049 Jim_IncrRefCount(varNamePtr);
10050
10051 /* --- OPTIMIZED FOR --- */
10052 /* Start to loop */
10053 objPtr = Jim_NewIntObj(interp, start);
10054 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10055 Jim_DecrRefCount(interp, varNamePtr);
10056 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10057 Jim_FreeNewObj(interp, objPtr);
10058 goto evalstart;
10059 }
10060 while (1) {
10061 /* === Check condition === */
10062 /* Common code: */
10063 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10064 if (objPtr == NULL ||
10065 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10066 {
10067 Jim_DecrRefCount(interp, varNamePtr);
10068 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10069 goto testcond;
10070 }
10071 /* Immediate or Variable? get the 'stop' value if the latter. */
10072 if (stopVarNamePtr) {
10073 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10074 if (objPtr == NULL ||
10075 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10076 {
10077 Jim_DecrRefCount(interp, varNamePtr);
10078 Jim_DecrRefCount(interp, stopVarNamePtr);
10079 goto testcond;
10080 }
10081 }
10082 if (cmpType == JIM_EXPROP_LT) {
10083 if (currentVal >= stop) break;
10084 } else {
10085 if (currentVal > stop) break;
10086 }
10087 /* Eval body */
10088 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10089 switch (retval) {
10090 case JIM_BREAK:
10091 if (stopVarNamePtr)
10092 Jim_DecrRefCount(interp, stopVarNamePtr);
10093 Jim_DecrRefCount(interp, varNamePtr);
10094 goto out;
10095 case JIM_CONTINUE:
10096 /* nothing to do */
10097 break;
10098 default:
10099 if (stopVarNamePtr)
10100 Jim_DecrRefCount(interp, stopVarNamePtr);
10101 Jim_DecrRefCount(interp, varNamePtr);
10102 return retval;
10103 }
10104 }
10105 /* If there was a change in procedures/command continue
10106 * with the usual [for] command implementation */
10107 if (procEpoch != interp->procEpoch) {
10108 if (stopVarNamePtr)
10109 Jim_DecrRefCount(interp, stopVarNamePtr);
10110 Jim_DecrRefCount(interp, varNamePtr);
10111 goto evalnext;
10112 }
10113 /* Increment */
10114 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10115 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10116 objPtr->internalRep.wideValue ++;
10117 Jim_InvalidateStringRep(objPtr);
10118 } else {
10119 Jim_Obj *auxObjPtr;
10120
10121 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10122 if (stopVarNamePtr)
10123 Jim_DecrRefCount(interp, stopVarNamePtr);
10124 Jim_DecrRefCount(interp, varNamePtr);
10125 goto evalnext;
10126 }
10127 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10128 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10129 if (stopVarNamePtr)
10130 Jim_DecrRefCount(interp, stopVarNamePtr);
10131 Jim_DecrRefCount(interp, varNamePtr);
10132 Jim_FreeNewObj(interp, auxObjPtr);
10133 goto evalnext;
10134 }
10135 }
10136 }
10137 if (stopVarNamePtr)
10138 Jim_DecrRefCount(interp, stopVarNamePtr);
10139 Jim_DecrRefCount(interp, varNamePtr);
10140 Jim_SetEmptyResult(interp);
10141 return JIM_OK;
10142 }
10143 #endif
10144 evalstart:
10145 /* Eval start */
10146 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10147 return retval;
10148 while (1) {
10149 int boolean;
10150 testcond:
10151 /* Test the condition */
10152 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10153 != JIM_OK)
10154 return retval;
10155 if (!boolean) break;
10156 /* Eval body */
10157 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10158 switch (retval) {
10159 case JIM_BREAK:
10160 goto out;
10161 break;
10162 case JIM_CONTINUE:
10163 /* Nothing to do */
10164 break;
10165 default:
10166 return retval;
10167 }
10168 }
10169 evalnext:
10170 /* Eval next */
10171 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10172 switch (retval) {
10173 case JIM_BREAK:
10174 goto out;
10175 break;
10176 case JIM_CONTINUE:
10177 continue;
10178 break;
10179 default:
10180 return retval;
10181 }
10182 }
10183 }
10184 out:
10185 Jim_SetEmptyResult(interp);
10186 return JIM_OK;
10187 }
10188
10189 /* foreach + lmap implementation. */
10190 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10191 Jim_Obj *const *argv, int doMap)
10192 {
10193 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10194 int nbrOfLoops = 0;
10195 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10196
10197 if (argc < 4 || argc % 2 != 0) {
10198 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10199 return JIM_ERR;
10200 }
10201 if (doMap) {
10202 mapRes = Jim_NewListObj(interp, NULL, 0);
10203 Jim_IncrRefCount(mapRes);
10204 }
10205 emptyStr = Jim_NewEmptyStringObj(interp);
10206 Jim_IncrRefCount(emptyStr);
10207 script = argv[argc-1]; /* Last argument is a script */
10208 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10209 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10210 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10211 /* Initialize iterators and remember max nbr elements each list */
10212 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10213 /* Remember lengths of all lists and calculate how much rounds to loop */
10214 for (i = 0; i < nbrOfLists*2; i += 2) {
10215 div_t cnt;
10216 int count;
10217 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10218 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10219 if (listsEnd[i] == 0) {
10220 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10221 goto err;
10222 }
10223 cnt = div(listsEnd[i + 1], listsEnd[i]);
10224 count = cnt.quot + (cnt.rem ? 1 : 0);
10225 if (count > nbrOfLoops)
10226 nbrOfLoops = count;
10227 }
10228 for (; nbrOfLoops-- > 0;) {
10229 for (i = 0; i < nbrOfLists; ++i) {
10230 int varIdx = 0, var = i * 2;
10231 while (varIdx < listsEnd[var]) {
10232 Jim_Obj *varName, *ele;
10233 int lst = i * 2 + 1;
10234 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10235 != JIM_OK)
10236 goto err;
10237 if (listsIdx[i] < listsEnd[lst]) {
10238 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10239 != JIM_OK)
10240 goto err;
10241 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10242 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10243 goto err;
10244 }
10245 ++listsIdx[i]; /* Remember next iterator of current list */
10246 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10247 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10248 goto err;
10249 }
10250 ++varIdx; /* Next variable */
10251 }
10252 }
10253 switch (result = Jim_EvalObj(interp, script)) {
10254 case JIM_OK:
10255 if (doMap)
10256 Jim_ListAppendElement(interp, mapRes, interp->result);
10257 break;
10258 case JIM_CONTINUE:
10259 break;
10260 case JIM_BREAK:
10261 goto out;
10262 break;
10263 default:
10264 goto err;
10265 }
10266 }
10267 out:
10268 result = JIM_OK;
10269 if (doMap)
10270 Jim_SetResult(interp, mapRes);
10271 else
10272 Jim_SetEmptyResult(interp);
10273 err:
10274 if (doMap)
10275 Jim_DecrRefCount(interp, mapRes);
10276 Jim_DecrRefCount(interp, emptyStr);
10277 Jim_Free(listsIdx);
10278 Jim_Free(listsEnd);
10279 return result;
10280 }
10281
10282 /* [foreach] */
10283 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10284 Jim_Obj *const *argv)
10285 {
10286 return JimForeachMapHelper(interp, argc, argv, 0);
10287 }
10288
10289 /* [lmap] */
10290 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10291 Jim_Obj *const *argv)
10292 {
10293 return JimForeachMapHelper(interp, argc, argv, 1);
10294 }
10295
10296 /* [if] */
10297 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10298 Jim_Obj *const *argv)
10299 {
10300 int boolean, retval, current = 1, falsebody = 0;
10301 if (argc >= 3) {
10302 while (1) {
10303 /* Far not enough arguments given! */
10304 if (current >= argc) goto err;
10305 if ((retval = Jim_GetBoolFromExpr(interp,
10306 argv[current++], &boolean))
10307 != JIM_OK)
10308 return retval;
10309 /* There lacks something, isn't it? */
10310 if (current >= argc) goto err;
10311 if (Jim_CompareStringImmediate(interp, argv[current],
10312 "then")) current++;
10313 /* Tsk tsk, no then-clause? */
10314 if (current >= argc) goto err;
10315 if (boolean)
10316 return Jim_EvalObj(interp, argv[current]);
10317 /* Ok: no else-clause follows */
10318 if (++current >= argc) {
10319 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10320 return JIM_OK;
10321 }
10322 falsebody = current++;
10323 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10324 "else")) {
10325 /* IIICKS - else-clause isn't last cmd? */
10326 if (current != argc-1) goto err;
10327 return Jim_EvalObj(interp, argv[current]);
10328 } else if (Jim_CompareStringImmediate(interp,
10329 argv[falsebody], "elseif"))
10330 /* Ok: elseif follows meaning all the stuff
10331 * again (how boring...) */
10332 continue;
10333 /* OOPS - else-clause is not last cmd?*/
10334 else if (falsebody != argc-1)
10335 goto err;
10336 return Jim_EvalObj(interp, argv[falsebody]);
10337 }
10338 return JIM_OK;
10339 }
10340 err:
10341 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10342 return JIM_ERR;
10343 }
10344
10345 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10346
10347 /* [switch] */
10348 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10349 Jim_Obj *const *argv)
10350 {
10351 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10352 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10353 Jim_Obj *script = 0;
10354 if (argc < 3) goto wrongnumargs;
10355 for (opt = 1; opt < argc; ++opt) {
10356 const char *option = Jim_GetString(argv[opt], 0);
10357 if (*option != '-') break;
10358 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10359 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10360 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10361 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10362 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10363 if ((argc - opt) < 2) goto wrongnumargs;
10364 command = argv[++opt];
10365 } else {
10366 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10367 Jim_AppendStrings(interp, Jim_GetResult(interp),
10368 "bad option \"", option, "\": must be -exact, -glob, "
10369 "-regexp, -command procname or --", 0);
10370 goto err;
10371 }
10372 if ((argc - opt) < 2) goto wrongnumargs;
10373 }
10374 strObj = argv[opt++];
10375 patCount = argc - opt;
10376 if (patCount == 1) {
10377 Jim_Obj **vector;
10378 JimListGetElements(interp, argv[opt], &patCount, &vector);
10379 caseList = vector;
10380 } else
10381 caseList = &argv[opt];
10382 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10383 for (i = 0; script == 0 && i < patCount; i += 2) {
10384 Jim_Obj *patObj = caseList[i];
10385 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10386 || i < (patCount-2)) {
10387 switch (matchOpt) {
10388 case SWITCH_EXACT:
10389 if (Jim_StringEqObj(strObj, patObj, 0))
10390 script = caseList[i + 1];
10391 break;
10392 case SWITCH_GLOB:
10393 if (Jim_StringMatchObj(patObj, strObj, 0))
10394 script = caseList[i + 1];
10395 break;
10396 case SWITCH_RE:
10397 command = Jim_NewStringObj(interp, "regexp", -1);
10398 /* Fall thru intentionally */
10399 case SWITCH_CMD: {
10400 Jim_Obj *parms[] = {command, patObj, strObj};
10401 int rc = Jim_EvalObjVector(interp, 3, parms);
10402 long matching;
10403 /* After the execution of a command we need to
10404 * make sure to reconvert the object into a list
10405 * again. Only for the single-list style [switch]. */
10406 if (argc-opt == 1) {
10407 Jim_Obj **vector;
10408 JimListGetElements(interp, argv[opt], &patCount,
10409 &vector);
10410 caseList = vector;
10411 }
10412 /* command is here already decref'd */
10413 if (rc != JIM_OK) {
10414 retcode = rc;
10415 goto err;
10416 }
10417 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10418 if (rc != JIM_OK) {
10419 retcode = rc;
10420 goto err;
10421 }
10422 if (matching)
10423 script = caseList[i + 1];
10424 break;
10425 }
10426 default:
10427 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10428 Jim_AppendStrings(interp, Jim_GetResult(interp),
10429 "internal error: no such option implemented", 0);
10430 goto err;
10431 }
10432 } else {
10433 script = caseList[i + 1];
10434 }
10435 }
10436 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10437 i += 2)
10438 script = caseList[i + 1];
10439 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10440 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10441 Jim_AppendStrings(interp, Jim_GetResult(interp),
10442 "no body specified for pattern \"",
10443 Jim_GetString(caseList[i-2], 0), "\"", 0);
10444 goto err;
10445 }
10446 retcode = JIM_OK;
10447 Jim_SetEmptyResult(interp);
10448 if (script != 0)
10449 retcode = Jim_EvalObj(interp, script);
10450 return retcode;
10451 wrongnumargs:
10452 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10453 "pattern body ... ?default body? or "
10454 "{pattern body ?pattern body ...?}");
10455 err:
10456 return retcode;
10457 }
10458
10459 /* [list] */
10460 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10461 Jim_Obj *const *argv)
10462 {
10463 Jim_Obj *listObjPtr;
10464
10465 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10466 Jim_SetResult(interp, listObjPtr);
10467 return JIM_OK;
10468 }
10469
10470 /* [lindex] */
10471 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10472 Jim_Obj *const *argv)
10473 {
10474 Jim_Obj *objPtr, *listObjPtr;
10475 int i;
10476 int index;
10477
10478 if (argc < 3) {
10479 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10480 return JIM_ERR;
10481 }
10482 objPtr = argv[1];
10483 Jim_IncrRefCount(objPtr);
10484 for (i = 2; i < argc; i++) {
10485 listObjPtr = objPtr;
10486 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10487 Jim_DecrRefCount(interp, listObjPtr);
10488 return JIM_ERR;
10489 }
10490 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10491 JIM_NONE) != JIM_OK) {
10492 /* Returns an empty object if the index
10493 * is out of range. */
10494 Jim_DecrRefCount(interp, listObjPtr);
10495 Jim_SetEmptyResult(interp);
10496 return JIM_OK;
10497 }
10498 Jim_IncrRefCount(objPtr);
10499 Jim_DecrRefCount(interp, listObjPtr);
10500 }
10501 Jim_SetResult(interp, objPtr);
10502 Jim_DecrRefCount(interp, objPtr);
10503 return JIM_OK;
10504 }
10505
10506 /* [llength] */
10507 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10508 Jim_Obj *const *argv)
10509 {
10510 int len;
10511
10512 if (argc != 2) {
10513 Jim_WrongNumArgs(interp, 1, argv, "list");
10514 return JIM_ERR;
10515 }
10516 Jim_ListLength(interp, argv[1], &len);
10517 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10518 return JIM_OK;
10519 }
10520
10521 /* [lappend] */
10522 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10523 Jim_Obj *const *argv)
10524 {
10525 Jim_Obj *listObjPtr;
10526 int shared, i;
10527
10528 if (argc < 2) {
10529 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10530 return JIM_ERR;
10531 }
10532 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10533 if (!listObjPtr) {
10534 /* Create the list if it does not exists */
10535 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10536 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10537 Jim_FreeNewObj(interp, listObjPtr);
10538 return JIM_ERR;
10539 }
10540 }
10541 shared = Jim_IsShared(listObjPtr);
10542 if (shared)
10543 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10544 for (i = 2; i < argc; i++)
10545 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10546 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10547 if (shared)
10548 Jim_FreeNewObj(interp, listObjPtr);
10549 return JIM_ERR;
10550 }
10551 Jim_SetResult(interp, listObjPtr);
10552 return JIM_OK;
10553 }
10554
10555 /* [linsert] */
10556 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10557 Jim_Obj *const *argv)
10558 {
10559 int index, len;
10560 Jim_Obj *listPtr;
10561
10562 if (argc < 4) {
10563 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10564 "?element ...?");
10565 return JIM_ERR;
10566 }
10567 listPtr = argv[1];
10568 if (Jim_IsShared(listPtr))
10569 listPtr = Jim_DuplicateObj(interp, listPtr);
10570 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10571 goto err;
10572 Jim_ListLength(interp, listPtr, &len);
10573 if (index >= len)
10574 index = len;
10575 else if (index < 0)
10576 index = len + index + 1;
10577 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10578 Jim_SetResult(interp, listPtr);
10579 return JIM_OK;
10580 err:
10581 if (listPtr != argv[1]) {
10582 Jim_FreeNewObj(interp, listPtr);
10583 }
10584 return JIM_ERR;
10585 }
10586
10587 /* [lset] */
10588 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10589 Jim_Obj *const *argv)
10590 {
10591 if (argc < 3) {
10592 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10593 return JIM_ERR;
10594 } else if (argc == 3) {
10595 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10596 return JIM_ERR;
10597 Jim_SetResult(interp, argv[2]);
10598 return JIM_OK;
10599 }
10600 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10601 == JIM_ERR) return JIM_ERR;
10602 return JIM_OK;
10603 }
10604
10605 /* [lsort] */
10606 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10607 {
10608 const char *options[] = {
10609 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10610 };
10611 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10612 Jim_Obj *resObj;
10613 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10614 int decreasing = 0;
10615
10616 if (argc < 2) {
10617 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10618 return JIM_ERR;
10619 }
10620 for (i = 1; i < (argc-1); i++) {
10621 int option;
10622
10623 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10624 != JIM_OK)
10625 return JIM_ERR;
10626 switch (option) {
10627 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10628 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10629 case OPT_INCREASING: decreasing = 0; break;
10630 case OPT_DECREASING: decreasing = 1; break;
10631 }
10632 }
10633 if (decreasing) {
10634 switch (lsortType) {
10635 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10636 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10637 }
10638 }
10639 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10640 ListSortElements(interp, resObj, lsortType);
10641 Jim_SetResult(interp, resObj);
10642 return JIM_OK;
10643 }
10644
10645 /* [append] */
10646 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10647 Jim_Obj *const *argv)
10648 {
10649 Jim_Obj *stringObjPtr;
10650 int shared, i;
10651
10652 if (argc < 2) {
10653 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10654 return JIM_ERR;
10655 }
10656 if (argc == 2) {
10657 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10658 if (!stringObjPtr) return JIM_ERR;
10659 } else {
10660 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10661 if (!stringObjPtr) {
10662 /* Create the string if it does not exists */
10663 stringObjPtr = Jim_NewEmptyStringObj(interp);
10664 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10665 != JIM_OK) {
10666 Jim_FreeNewObj(interp, stringObjPtr);
10667 return JIM_ERR;
10668 }
10669 }
10670 }
10671 shared = Jim_IsShared(stringObjPtr);
10672 if (shared)
10673 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10674 for (i = 2; i < argc; i++)
10675 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10676 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10677 if (shared)
10678 Jim_FreeNewObj(interp, stringObjPtr);
10679 return JIM_ERR;
10680 }
10681 Jim_SetResult(interp, stringObjPtr);
10682 return JIM_OK;
10683 }
10684
10685 /* [debug] */
10686 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10687 Jim_Obj *const *argv)
10688 {
10689 const char *options[] = {
10690 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10691 "exprbc",
10692 NULL
10693 };
10694 enum {
10695 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10696 OPT_EXPRLEN, OPT_EXPRBC
10697 };
10698 int option;
10699
10700 if (argc < 2) {
10701 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10702 return JIM_ERR;
10703 }
10704 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10705 JIM_ERRMSG) != JIM_OK)
10706 return JIM_ERR;
10707 if (option == OPT_REFCOUNT) {
10708 if (argc != 3) {
10709 Jim_WrongNumArgs(interp, 2, argv, "object");
10710 return JIM_ERR;
10711 }
10712 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10713 return JIM_OK;
10714 } else if (option == OPT_OBJCOUNT) {
10715 int freeobj = 0, liveobj = 0;
10716 char buf[256];
10717 Jim_Obj *objPtr;
10718
10719 if (argc != 2) {
10720 Jim_WrongNumArgs(interp, 2, argv, "");
10721 return JIM_ERR;
10722 }
10723 /* Count the number of free objects. */
10724 objPtr = interp->freeList;
10725 while (objPtr) {
10726 freeobj++;
10727 objPtr = objPtr->nextObjPtr;
10728 }
10729 /* Count the number of live objects. */
10730 objPtr = interp->liveList;
10731 while (objPtr) {
10732 liveobj++;
10733 objPtr = objPtr->nextObjPtr;
10734 }
10735 /* Set the result string and return. */
10736 sprintf(buf, "free %d used %d", freeobj, liveobj);
10737 Jim_SetResultString(interp, buf, -1);
10738 return JIM_OK;
10739 } else if (option == OPT_OBJECTS) {
10740 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10741 /* Count the number of live objects. */
10742 objPtr = interp->liveList;
10743 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10744 while (objPtr) {
10745 char buf[128];
10746 const char *type = objPtr->typePtr ?
10747 objPtr->typePtr->name : "";
10748 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10749 sprintf(buf, "%p", objPtr);
10750 Jim_ListAppendElement(interp, subListObjPtr,
10751 Jim_NewStringObj(interp, buf, -1));
10752 Jim_ListAppendElement(interp, subListObjPtr,
10753 Jim_NewStringObj(interp, type, -1));
10754 Jim_ListAppendElement(interp, subListObjPtr,
10755 Jim_NewIntObj(interp, objPtr->refCount));
10756 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10757 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10758 objPtr = objPtr->nextObjPtr;
10759 }
10760 Jim_SetResult(interp, listObjPtr);
10761 return JIM_OK;
10762 } else if (option == OPT_INVSTR) {
10763 Jim_Obj *objPtr;
10764
10765 if (argc != 3) {
10766 Jim_WrongNumArgs(interp, 2, argv, "object");
10767 return JIM_ERR;
10768 }
10769 objPtr = argv[2];
10770 if (objPtr->typePtr != NULL)
10771 Jim_InvalidateStringRep(objPtr);
10772 Jim_SetEmptyResult(interp);
10773 return JIM_OK;
10774 } else if (option == OPT_SCRIPTLEN) {
10775 ScriptObj *script;
10776 if (argc != 3) {
10777 Jim_WrongNumArgs(interp, 2, argv, "script");
10778 return JIM_ERR;
10779 }
10780 script = Jim_GetScript(interp, argv[2]);
10781 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10782 return JIM_OK;
10783 } else if (option == OPT_EXPRLEN) {
10784 ExprByteCode *expr;
10785 if (argc != 3) {
10786 Jim_WrongNumArgs(interp, 2, argv, "expression");
10787 return JIM_ERR;
10788 }
10789 expr = Jim_GetExpression(interp, argv[2]);
10790 if (expr == NULL)
10791 return JIM_ERR;
10792 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10793 return JIM_OK;
10794 } else if (option == OPT_EXPRBC) {
10795 Jim_Obj *objPtr;
10796 ExprByteCode *expr;
10797 int i;
10798
10799 if (argc != 3) {
10800 Jim_WrongNumArgs(interp, 2, argv, "expression");
10801 return JIM_ERR;
10802 }
10803 expr = Jim_GetExpression(interp, argv[2]);
10804 if (expr == NULL)
10805 return JIM_ERR;
10806 objPtr = Jim_NewListObj(interp, NULL, 0);
10807 for (i = 0; i < expr->len; i++) {
10808 const char *type;
10809 Jim_ExprOperator *op;
10810
10811 switch (expr->opcode[i]) {
10812 case JIM_EXPROP_NUMBER: type = "number"; break;
10813 case JIM_EXPROP_COMMAND: type = "command"; break;
10814 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10815 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10816 case JIM_EXPROP_SUBST: type = "subst"; break;
10817 case JIM_EXPROP_STRING: type = "string"; break;
10818 default:
10819 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10820 if (op == NULL) {
10821 type = "private";
10822 } else {
10823 type = "operator";
10824 }
10825 break;
10826 }
10827 Jim_ListAppendElement(interp, objPtr,
10828 Jim_NewStringObj(interp, type, -1));
10829 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10830 }
10831 Jim_SetResult(interp, objPtr);
10832 return JIM_OK;
10833 } else {
10834 Jim_SetResultString(interp,
10835 "bad option. Valid options are refcount, "
10836 "objcount, objects, invstr", -1);
10837 return JIM_ERR;
10838 }
10839 return JIM_OK; /* unreached */
10840 }
10841
10842 /* [eval] */
10843 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10844 Jim_Obj *const *argv)
10845 {
10846 if (argc == 2) {
10847 return Jim_EvalObj(interp, argv[1]);
10848 } else if (argc > 2) {
10849 Jim_Obj *objPtr;
10850 int retcode;
10851
10852 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10853 Jim_IncrRefCount(objPtr);
10854 retcode = Jim_EvalObj(interp, objPtr);
10855 Jim_DecrRefCount(interp, objPtr);
10856 return retcode;
10857 } else {
10858 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10859 return JIM_ERR;
10860 }
10861 }
10862
10863 /* [uplevel] */
10864 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10865 Jim_Obj *const *argv)
10866 {
10867 if (argc >= 2) {
10868 int retcode, newLevel, oldLevel;
10869 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10870 Jim_Obj *objPtr;
10871 const char *str;
10872
10873 /* Save the old callframe pointer */
10874 savedCallFrame = interp->framePtr;
10875
10876 /* Lookup the target frame pointer */
10877 str = Jim_GetString(argv[1], NULL);
10878 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10879 {
10880 if (Jim_GetCallFrameByLevel(interp, argv[1],
10881 &targetCallFrame,
10882 &newLevel) != JIM_OK)
10883 return JIM_ERR;
10884 argc--;
10885 argv++;
10886 } else {
10887 if (Jim_GetCallFrameByLevel(interp, NULL,
10888 &targetCallFrame,
10889 &newLevel) != JIM_OK)
10890 return JIM_ERR;
10891 }
10892 if (argc < 2) {
10893 argc++;
10894 argv--;
10895 Jim_WrongNumArgs(interp, 1, argv,
10896 "?level? command ?arg ...?");
10897 return JIM_ERR;
10898 }
10899 /* Eval the code in the target callframe. */
10900 interp->framePtr = targetCallFrame;
10901 oldLevel = interp->numLevels;
10902 interp->numLevels = newLevel;
10903 if (argc == 2) {
10904 retcode = Jim_EvalObj(interp, argv[1]);
10905 } else {
10906 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10907 Jim_IncrRefCount(objPtr);
10908 retcode = Jim_EvalObj(interp, objPtr);
10909 Jim_DecrRefCount(interp, objPtr);
10910 }
10911 interp->numLevels = oldLevel;
10912 interp->framePtr = savedCallFrame;
10913 return retcode;
10914 } else {
10915 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10916 return JIM_ERR;
10917 }
10918 }
10919
10920 /* [expr] */
10921 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10922 Jim_Obj *const *argv)
10923 {
10924 Jim_Obj *exprResultPtr;
10925 int retcode;
10926
10927 if (argc == 2) {
10928 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10929 } else if (argc > 2) {
10930 Jim_Obj *objPtr;
10931
10932 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10933 Jim_IncrRefCount(objPtr);
10934 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10935 Jim_DecrRefCount(interp, objPtr);
10936 } else {
10937 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10938 return JIM_ERR;
10939 }
10940 if (retcode != JIM_OK) return retcode;
10941 Jim_SetResult(interp, exprResultPtr);
10942 Jim_DecrRefCount(interp, exprResultPtr);
10943 return JIM_OK;
10944 }
10945
10946 /* [break] */
10947 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10948 Jim_Obj *const *argv)
10949 {
10950 if (argc != 1) {
10951 Jim_WrongNumArgs(interp, 1, argv, "");
10952 return JIM_ERR;
10953 }
10954 return JIM_BREAK;
10955 }
10956
10957 /* [continue] */
10958 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10959 Jim_Obj *const *argv)
10960 {
10961 if (argc != 1) {
10962 Jim_WrongNumArgs(interp, 1, argv, "");
10963 return JIM_ERR;
10964 }
10965 return JIM_CONTINUE;
10966 }
10967
10968 /* [return] */
10969 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10970 Jim_Obj *const *argv)
10971 {
10972 if (argc == 1) {
10973 return JIM_RETURN;
10974 } else if (argc == 2) {
10975 Jim_SetResult(interp, argv[1]);
10976 interp->returnCode = JIM_OK;
10977 return JIM_RETURN;
10978 } else if (argc == 3 || argc == 4) {
10979 int returnCode;
10980 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10981 return JIM_ERR;
10982 interp->returnCode = returnCode;
10983 if (argc == 4)
10984 Jim_SetResult(interp, argv[3]);
10985 return JIM_RETURN;
10986 } else {
10987 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10988 return JIM_ERR;
10989 }
10990 return JIM_RETURN; /* unreached */
10991 }
10992
10993 /* [tailcall] */
10994 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10995 Jim_Obj *const *argv)
10996 {
10997 Jim_Obj *objPtr;
10998
10999 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
11000 Jim_SetResult(interp, objPtr);
11001 return JIM_EVAL;
11002 }
11003
11004 /* [proc] */
11005 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11006 Jim_Obj *const *argv)
11007 {
11008 int argListLen;
11009 int arityMin, arityMax;
11010
11011 if (argc != 4 && argc != 5) {
11012 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11013 return JIM_ERR;
11014 }
11015 Jim_ListLength(interp, argv[2], &argListLen);
11016 arityMin = arityMax = argListLen + 1;
11017
11018 if (argListLen) {
11019 const char *str;
11020 int len;
11021 Jim_Obj *argPtr=NULL;
11022
11023 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11024 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11025 str = Jim_GetString(argPtr, &len);
11026 if (len == 4 && memcmp(str, "args", 4) == 0) {
11027 arityMin--;
11028 arityMax = -1;
11029 }
11030
11031 /* Check for default arguments and reduce arityMin if necessary */
11032 while (arityMin > 1) {
11033 int len;
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, 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) != JIM_OK)
11315 return JIM_ERR;
11316 str = Jim_GetString(argv[2], &len);
11317 if (index != INT_MIN && index != INT_MAX)
11318 index = JimRelToAbsIndex(len, index);
11319 if (index < 0 || index >= len) {
11320 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11321 return JIM_OK;
11322 } else {
11323 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11324 return JIM_OK;
11325 }
11326 } else if (option == OPT_FIRST) {
11327 int index = 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) != JIM_OK)
11338 return JIM_ERR;
11339 index = JimRelToAbsIndex(l2, index);
11340 }
11341 Jim_SetResult(interp, Jim_NewIntObj(interp,
11342 JimStringFirst(s1, l1, s2, l2, index)));
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 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 (count != 0 && count < argc-3) {
11916 Jim_SetResultString(interp, "variable is not assigned by any "
11917 "conversion specifiers", -1);
11918 return JIM_ERR;
11919 } else if (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)