Update copyright statements. Make it easier to sync with Jim Tcl
[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 #include <string.h>
57 #include <stdarg.h>
58 #include <ctype.h>
59 #include <limits.h>
60 #include <assert.h>
61 #include <errno.h>
62 #include <time.h>
63 #endif
64 #ifndef JIM_ANSIC
65 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
66 #endif /* JIM_ANSIC */
67
68 #include <stdarg.h>
69 #include <limits.h>
70
71 /* Include the platform dependent libraries for
72 * dynamic loading of libraries. */
73 #ifdef JIM_DYNLIB
74 #if defined(_WIN32) || defined(WIN32)
75 #ifndef WIN32
76 #define WIN32 1
77 #endif
78 #ifndef STRICT
79 #define STRICT
80 #endif
81 #define WIN32_LEAN_AND_MEAN
82 #include <windows.h>
83 #if _MSC_VER >= 1000
84 #pragma warning(disable:4146)
85 #endif /* _MSC_VER */
86 #else
87 #include <dlfcn.h>
88 #endif /* WIN32 */
89 #endif /* JIM_DYNLIB */
90
91 #ifdef __ECOS
92 #include <cyg/jimtcl/jim.h>
93 #else
94 #include "jim.h"
95 #endif
96
97 #ifdef HAVE_BACKTRACE
98 #include <execinfo.h>
99 #endif
100
101 /* -----------------------------------------------------------------------------
102 * Global variables
103 * ---------------------------------------------------------------------------*/
104
105 /* A shared empty string for the objects string representation.
106 * Jim_InvalidateStringRep knows about it and don't try to free. */
107 static char *JimEmptyStringRep = (char*) "";
108
109 /* -----------------------------------------------------------------------------
110 * Required prototypes of not exported functions
111 * ---------------------------------------------------------------------------*/
112 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
113 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
114 static void JimRegisterCoreApi(Jim_Interp *interp);
115
116 static Jim_HashTableType *getJimVariablesHashTableType(void);
117
118 /* -----------------------------------------------------------------------------
119 * Utility functions
120 * ---------------------------------------------------------------------------*/
121
122 static char *
123 jim_vasprintf(const char *fmt, va_list ap)
124 {
125 #ifndef HAVE_VASPRINTF
126 /* yucky way */
127 static char buf[2048];
128 vsnprintf(buf, sizeof(buf), fmt, ap);
129 /* garentee termination */
130 buf[sizeof(buf)-1] = 0;
131 #else
132 char *buf;
133 int result;
134 result = vasprintf(&buf, fmt, ap);
135 if (result < 0) exit(-1);
136 #endif
137 return buf;
138 }
139
140 static void
141 jim_vasprintf_done(void *buf)
142 {
143 #ifndef HAVE_VASPRINTF
144 (void)(buf);
145 #else
146 free(buf);
147 #endif
148 }
149
150
151 /*
152 * Convert a string to a jim_wide INTEGER.
153 * This function originates from BSD.
154 *
155 * Ignores `locale' stuff. Assumes that the upper and lower case
156 * alphabets and digits are each contiguous.
157 */
158 #ifdef HAVE_LONG_LONG_INT
159 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
160 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
161 {
162 register const char *s;
163 register unsigned jim_wide acc;
164 register unsigned char c;
165 register unsigned jim_wide qbase, cutoff;
166 register int neg, any, cutlim;
167
168 /*
169 * Skip white space and pick up leading +/- sign if any.
170 * If base is 0, allow 0x for hex and 0 for octal, else
171 * assume decimal; if base is already 16, allow 0x.
172 */
173 s = nptr;
174 do {
175 c = *s++;
176 } while (isspace(c));
177 if (c == '-') {
178 neg = 1;
179 c = *s++;
180 } else {
181 neg = 0;
182 if (c == '+')
183 c = *s++;
184 }
185 if ((base == 0 || base == 16) &&
186 c == '0' && (*s == 'x' || *s == 'X')) {
187 c = s[1];
188 s += 2;
189 base = 16;
190 }
191 if (base == 0)
192 base = c == '0' ? 8 : 10;
193
194 /*
195 * Compute the cutoff value between legal numbers and illegal
196 * numbers. That is the largest legal value, divided by the
197 * base. An input number that is greater than this value, if
198 * followed by a legal input character, is too big. One that
199 * is equal to this value may be valid or not; the limit
200 * between valid and invalid numbers is then based on the last
201 * digit. For instance, if the range for quads is
202 * [-9223372036854775808..9223372036854775807] and the input base
203 * is 10, cutoff will be set to 922337203685477580 and cutlim to
204 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
205 * accumulated a value > 922337203685477580, or equal but the
206 * next digit is > 7 (or 8), the number is too big, and we will
207 * return a range error.
208 *
209 * Set any if any `digits' consumed; make it negative to indicate
210 * overflow.
211 */
212 qbase = (unsigned)base;
213 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
214 : LLONG_MAX;
215 cutlim = (int)(cutoff % qbase);
216 cutoff /= qbase;
217 for (acc = 0, any = 0;; c = *s++) {
218 if (!JimIsAscii(c))
219 break;
220 if (isdigit(c))
221 c -= '0';
222 else if (isalpha(c))
223 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
224 else
225 break;
226 if (c >= base)
227 break;
228 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
229 any = -1;
230 else {
231 any = 1;
232 acc *= qbase;
233 acc += c;
234 }
235 }
236 if (any < 0) {
237 acc = neg ? LLONG_MIN : LLONG_MAX;
238 errno = ERANGE;
239 } else if (neg)
240 acc = -acc;
241 if (endptr != 0)
242 *endptr = (char *)(any ? s - 1 : nptr);
243 return (acc);
244 }
245 #endif
246
247 /* Glob-style pattern matching. */
248 static int JimStringMatch(const char *pattern, int patternLen,
249 const char *string, int stringLen, int nocase)
250 {
251 while (patternLen) {
252 switch (pattern[0]) {
253 case '*':
254 while (pattern[1] == '*') {
255 pattern++;
256 patternLen--;
257 }
258 if (patternLen == 1)
259 return 1; /* match */
260 while (stringLen) {
261 if (JimStringMatch(pattern + 1, patternLen-1,
262 string, stringLen, nocase))
263 return 1; /* match */
264 string++;
265 stringLen--;
266 }
267 return 0; /* no match */
268 break;
269 case '?':
270 if (stringLen == 0)
271 return 0; /* no match */
272 string++;
273 stringLen--;
274 break;
275 case '[':
276 {
277 int not, match;
278
279 pattern++;
280 patternLen--;
281 not = pattern[0] == '^';
282 if (not) {
283 pattern++;
284 patternLen--;
285 }
286 match = 0;
287 while (1) {
288 if (pattern[0] == '\\') {
289 pattern++;
290 patternLen--;
291 if (pattern[0] == string[0])
292 match = 1;
293 } else if (pattern[0] == ']') {
294 break;
295 } else if (patternLen == 0) {
296 pattern--;
297 patternLen++;
298 break;
299 } else if (pattern[1] == '-' && patternLen >= 3) {
300 int start = pattern[0];
301 int end = pattern[2];
302 int c = string[0];
303 if (start > end) {
304 int t = start;
305 start = end;
306 end = t;
307 }
308 if (nocase) {
309 start = tolower(start);
310 end = tolower(end);
311 c = tolower(c);
312 }
313 pattern += 2;
314 patternLen -= 2;
315 if (c >= start && c <= end)
316 match = 1;
317 } else {
318 if (!nocase) {
319 if (pattern[0] == string[0])
320 match = 1;
321 } else {
322 if (tolower((int)pattern[0]) == tolower((int)string[0]))
323 match = 1;
324 }
325 }
326 pattern++;
327 patternLen--;
328 }
329 if (not)
330 match = !match;
331 if (!match)
332 return 0; /* no match */
333 string++;
334 stringLen--;
335 break;
336 }
337 case '\\':
338 if (patternLen >= 2) {
339 pattern++;
340 patternLen--;
341 }
342 /* fall through */
343 default:
344 if (!nocase) {
345 if (pattern[0] != string[0])
346 return 0; /* no match */
347 } else {
348 if (tolower((int)pattern[0]) != tolower((int)string[0]))
349 return 0; /* no match */
350 }
351 string++;
352 stringLen--;
353 break;
354 }
355 pattern++;
356 patternLen--;
357 if (stringLen == 0) {
358 while (*pattern == '*') {
359 pattern++;
360 patternLen--;
361 }
362 break;
363 }
364 }
365 if (patternLen == 0 && stringLen == 0)
366 return 1;
367 return 0;
368 }
369
370 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
371 int nocase)
372 {
373 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
374
375 if (nocase == 0) {
376 while (l1 && l2) {
377 if (*u1 != *u2)
378 return (int)*u1-*u2;
379 u1++; u2++; l1--; l2--;
380 }
381 if (!l1 && !l2) return 0;
382 return l1-l2;
383 } else {
384 while (l1 && l2) {
385 if (tolower((int)*u1) != tolower((int)*u2))
386 return tolower((int)*u1)-tolower((int)*u2);
387 u1++; u2++; l1--; l2--;
388 }
389 if (!l1 && !l2) return 0;
390 return l1-l2;
391 }
392 }
393
394 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
395 * The index of the first occurrence of s1 in s2 is returned.
396 * If s1 is not found inside s2, -1 is returned. */
397 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
398 {
399 int i;
400
401 if (!l1 || !l2 || l1 > l2) return -1;
402 if (index < 0) index = 0;
403 s2 += index;
404 for (i = index; i <= l2-l1; i++) {
405 if (memcmp(s2, s1, l1) == 0)
406 return i;
407 s2++;
408 }
409 return -1;
410 }
411
412 int Jim_WideToString(char *buf, jim_wide wideValue)
413 {
414 const char *fmt = "%" JIM_WIDE_MODIFIER;
415 return sprintf(buf, fmt, wideValue);
416 }
417
418 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
419 {
420 char *endptr;
421
422 #ifdef HAVE_LONG_LONG_INT
423 *widePtr = JimStrtoll(str, &endptr, base);
424 #else
425 *widePtr = strtol(str, &endptr, base);
426 #endif
427 if ((str[0] == '\0') || (str == endptr))
428 return JIM_ERR;
429 if (endptr[0] != '\0') {
430 while (*endptr) {
431 if (!isspace((int)*endptr))
432 return JIM_ERR;
433 endptr++;
434 }
435 }
436 return JIM_OK;
437 }
438
439 int Jim_StringToIndex(const char *str, int *intPtr)
440 {
441 char *endptr;
442
443 *intPtr = strtol(str, &endptr, 10);
444 if ((str[0] == '\0') || (str == endptr))
445 return JIM_ERR;
446 if (endptr[0] != '\0') {
447 while (*endptr) {
448 if (!isspace((int)*endptr))
449 return JIM_ERR;
450 endptr++;
451 }
452 }
453 return JIM_OK;
454 }
455
456 /* The string representation of references has two features in order
457 * to make the GC faster. The first is that every reference starts
458 * with a non common character '~', in order to make the string matching
459 * fater. The second is that the reference string rep his 32 characters
460 * in length, this allows to avoid to check every object with a string
461 * repr < 32, and usually there are many of this objects. */
462
463 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
464
465 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
466 {
467 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
468 sprintf(buf, fmt, refPtr->tag, id);
469 return JIM_REFERENCE_SPACE;
470 }
471
472 int Jim_DoubleToString(char *buf, double doubleValue)
473 {
474 char *s;
475 int len;
476
477 len = sprintf(buf, "%.17g", doubleValue);
478 s = buf;
479 while (*s) {
480 if (*s == '.') return len;
481 s++;
482 }
483 /* Add a final ".0" if it's a number. But not
484 * for NaN or InF */
485 if (isdigit((int)buf[0])
486 || ((buf[0] == '-' || buf[0] == '+')
487 && isdigit((int)buf[1]))) {
488 s[0] = '.';
489 s[1] = '0';
490 s[2] = '\0';
491 return len + 2;
492 }
493 return len;
494 }
495
496 int Jim_StringToDouble(const char *str, double *doublePtr)
497 {
498 char *endptr;
499
500 *doublePtr = strtod(str, &endptr);
501 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
502 return JIM_ERR;
503 return JIM_OK;
504 }
505
506 static jim_wide JimPowWide(jim_wide b, jim_wide e)
507 {
508 jim_wide i, res = 1;
509 if ((b == 0 && e != 0) || (e < 0)) return 0;
510 for (i = 0; i < e; i++) {res *= b;}
511 return res;
512 }
513
514 /* -----------------------------------------------------------------------------
515 * Special functions
516 * ---------------------------------------------------------------------------*/
517
518 /* Note that 'interp' may be NULL if not available in the
519 * context of the panic. It's only useful to get the error
520 * file descriptor, it will default to stderr otherwise. */
521 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
522 {
523 va_list ap;
524
525 va_start(ap, fmt);
526 /*
527 * Send it here first.. Assuming STDIO still works
528 */
529 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
530 vfprintf(stderr, fmt, ap);
531 fprintf(stderr, JIM_NL JIM_NL);
532 va_end(ap);
533
534 #ifdef HAVE_BACKTRACE
535 {
536 void *array[40];
537 int size, i;
538 char **strings;
539
540 size = backtrace(array, 40);
541 strings = backtrace_symbols(array, size);
542 for (i = 0; i < size; i++)
543 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
544 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
545 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
546 }
547 #endif
548
549 /* This may actually crash... we do it last */
550 if (interp && interp->cookie_stderr) {
551 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
552 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
553 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
554 }
555 abort();
556 }
557
558 /* -----------------------------------------------------------------------------
559 * Memory allocation
560 * ---------------------------------------------------------------------------*/
561
562 /* Macro used for memory debugging.
563 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
564 * and similary for Jim_Realloc and Jim_Free */
565 #if 0
566 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
567 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
568 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
569 #endif
570
571 void *Jim_Alloc(int size)
572 {
573 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
574 if (size == 0)
575 size = 1;
576 void *p = malloc(size);
577 if (p == NULL)
578 Jim_Panic(NULL,"malloc: Out of memory");
579 return p;
580 }
581
582 void Jim_Free(void *ptr) {
583 free(ptr);
584 }
585
586 void *Jim_Realloc(void *ptr, int size)
587 {
588 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
589 if (size == 0)
590 size = 1;
591 void *p = realloc(ptr, size);
592 if (p == NULL)
593 Jim_Panic(NULL,"realloc: Out of memory");
594 return p;
595 }
596
597 char *Jim_StrDup(const char *s)
598 {
599 int l = strlen(s);
600 char *copy = Jim_Alloc(l + 1);
601
602 memcpy(copy, s, l + 1);
603 return copy;
604 }
605
606 char *Jim_StrDupLen(const char *s, int l)
607 {
608 char *copy = Jim_Alloc(l + 1);
609
610 memcpy(copy, s, l + 1);
611 copy[l] = 0; /* Just to be sure, original could be substring */
612 return copy;
613 }
614
615 /* -----------------------------------------------------------------------------
616 * Time related functions
617 * ---------------------------------------------------------------------------*/
618 /* Returns microseconds of CPU used since start. */
619 static jim_wide JimClock(void)
620 {
621 #if (defined WIN32) && !(defined JIM_ANSIC)
622 LARGE_INTEGER t, f;
623 QueryPerformanceFrequency(&f);
624 QueryPerformanceCounter(&t);
625 return (long)((t.QuadPart * 1000000) / f.QuadPart);
626 #else /* !WIN32 */
627 clock_t clocks = clock();
628
629 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
630 #endif /* WIN32 */
631 }
632
633 /* -----------------------------------------------------------------------------
634 * Hash Tables
635 * ---------------------------------------------------------------------------*/
636
637 /* -------------------------- private prototypes ---------------------------- */
638 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
639 static unsigned int JimHashTableNextPower(unsigned int size);
640 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
641
642 /* -------------------------- hash functions -------------------------------- */
643
644 /* Thomas Wang's 32 bit Mix Function */
645 unsigned int Jim_IntHashFunction(unsigned int key)
646 {
647 key += ~(key << 15);
648 key ^= (key >> 10);
649 key += (key << 3);
650 key ^= (key >> 6);
651 key += ~(key << 11);
652 key ^= (key >> 16);
653 return key;
654 }
655
656 /* Identity hash function for integer keys */
657 unsigned int Jim_IdentityHashFunction(unsigned int key)
658 {
659 return key;
660 }
661
662 /* Generic hash function (we are using to multiply by 9 and add the byte
663 * as Tcl) */
664 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
665 {
666 unsigned int h = 0;
667 while (len--)
668 h += (h << 3)+*buf++;
669 return h;
670 }
671
672 /* ----------------------------- API implementation ------------------------- */
673 /* reset an hashtable already initialized with ht_init().
674 * NOTE: This function should only called by ht_destroy(). */
675 static void JimResetHashTable(Jim_HashTable *ht)
676 {
677 ht->table = NULL;
678 ht->size = 0;
679 ht->sizemask = 0;
680 ht->used = 0;
681 ht->collisions = 0;
682 }
683
684 /* Initialize the hash table */
685 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
686 void *privDataPtr)
687 {
688 JimResetHashTable(ht);
689 ht->type = type;
690 ht->privdata = privDataPtr;
691 return JIM_OK;
692 }
693
694 /* Resize the table to the minimal size that contains all the elements,
695 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
696 int Jim_ResizeHashTable(Jim_HashTable *ht)
697 {
698 int minimal = ht->used;
699
700 if (minimal < JIM_HT_INITIAL_SIZE)
701 minimal = JIM_HT_INITIAL_SIZE;
702 return Jim_ExpandHashTable(ht, minimal);
703 }
704
705 /* Expand or create the hashtable */
706 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
707 {
708 Jim_HashTable n; /* the new hashtable */
709 unsigned int realsize = JimHashTableNextPower(size), i;
710
711 /* the size is invalid if it is smaller than the number of
712 * elements already inside the hashtable */
713 if (ht->used >= size)
714 return JIM_ERR;
715
716 Jim_InitHashTable(&n, ht->type, ht->privdata);
717 n.size = realsize;
718 n.sizemask = realsize-1;
719 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
720
721 /* Initialize all the pointers to NULL */
722 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
723
724 /* Copy all the elements from the old to the new table:
725 * note that if the old hash table is empty ht->size is zero,
726 * so Jim_ExpandHashTable just creates an hash table. */
727 n.used = ht->used;
728 for (i = 0; i < ht->size && ht->used > 0; i++) {
729 Jim_HashEntry *he, *nextHe;
730
731 if (ht->table[i] == NULL) continue;
732
733 /* For each hash entry on this slot... */
734 he = ht->table[i];
735 while (he) {
736 unsigned int h;
737
738 nextHe = he->next;
739 /* Get the new element index */
740 h = Jim_HashKey(ht, he->key) & n.sizemask;
741 he->next = n.table[h];
742 n.table[h] = he;
743 ht->used--;
744 /* Pass to the next element */
745 he = nextHe;
746 }
747 }
748 assert(ht->used == 0);
749 Jim_Free(ht->table);
750
751 /* Remap the new hashtable in the old */
752 *ht = n;
753 return JIM_OK;
754 }
755
756 /* Add an element to the target hash table */
757 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
758 {
759 int index;
760 Jim_HashEntry *entry;
761
762 /* Get the index of the new element, or -1 if
763 * the element already exists. */
764 if ((index = JimInsertHashEntry(ht, key)) == -1)
765 return JIM_ERR;
766
767 /* Allocates the memory and stores key */
768 entry = Jim_Alloc(sizeof(*entry));
769 entry->next = ht->table[index];
770 ht->table[index] = entry;
771
772 /* Set the hash entry fields. */
773 Jim_SetHashKey(ht, entry, key);
774 Jim_SetHashVal(ht, entry, val);
775 ht->used++;
776 return JIM_OK;
777 }
778
779 /* Add an element, discarding the old if the key already exists */
780 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
781 {
782 Jim_HashEntry *entry;
783
784 /* Try to add the element. If the key
785 * does not exists Jim_AddHashEntry will suceed. */
786 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
787 return JIM_OK;
788 /* It already exists, get the entry */
789 entry = Jim_FindHashEntry(ht, key);
790 /* Free the old value and set the new one */
791 Jim_FreeEntryVal(ht, entry);
792 Jim_SetHashVal(ht, entry, val);
793 return JIM_OK;
794 }
795
796 /* Search and remove an element */
797 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
798 {
799 unsigned int h;
800 Jim_HashEntry *he, *prevHe;
801
802 if (ht->size == 0)
803 return JIM_ERR;
804 h = Jim_HashKey(ht, key) & ht->sizemask;
805 he = ht->table[h];
806
807 prevHe = NULL;
808 while (he) {
809 if (Jim_CompareHashKeys(ht, key, he->key)) {
810 /* Unlink the element from the list */
811 if (prevHe)
812 prevHe->next = he->next;
813 else
814 ht->table[h] = he->next;
815 Jim_FreeEntryKey(ht, he);
816 Jim_FreeEntryVal(ht, he);
817 Jim_Free(he);
818 ht->used--;
819 return JIM_OK;
820 }
821 prevHe = he;
822 he = he->next;
823 }
824 return JIM_ERR; /* not found */
825 }
826
827 /* Destroy an entire hash table */
828 int Jim_FreeHashTable(Jim_HashTable *ht)
829 {
830 unsigned int i;
831
832 /* Free all the elements */
833 for (i = 0; i < ht->size && ht->used > 0; i++) {
834 Jim_HashEntry *he, *nextHe;
835
836 if ((he = ht->table[i]) == NULL) continue;
837 while (he) {
838 nextHe = he->next;
839 Jim_FreeEntryKey(ht, he);
840 Jim_FreeEntryVal(ht, he);
841 Jim_Free(he);
842 ht->used--;
843 he = nextHe;
844 }
845 }
846 /* Free the table and the allocated cache structure */
847 Jim_Free(ht->table);
848 /* Re-initialize the table */
849 JimResetHashTable(ht);
850 return JIM_OK; /* never fails */
851 }
852
853 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
854 {
855 Jim_HashEntry *he;
856 unsigned int h;
857
858 if (ht->size == 0) return NULL;
859 h = Jim_HashKey(ht, key) & ht->sizemask;
860 he = ht->table[h];
861 while (he) {
862 if (Jim_CompareHashKeys(ht, key, he->key))
863 return he;
864 he = he->next;
865 }
866 return NULL;
867 }
868
869 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
870 {
871 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
872
873 iter->ht = ht;
874 iter->index = -1;
875 iter->entry = NULL;
876 iter->nextEntry = NULL;
877 return iter;
878 }
879
880 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
881 {
882 while (1) {
883 if (iter->entry == NULL) {
884 iter->index++;
885 if (iter->index >=
886 (signed)iter->ht->size) break;
887 iter->entry = iter->ht->table[iter->index];
888 } else {
889 iter->entry = iter->nextEntry;
890 }
891 if (iter->entry) {
892 /* We need to save the 'next' here, the iterator user
893 * may delete the entry we are returning. */
894 iter->nextEntry = iter->entry->next;
895 return iter->entry;
896 }
897 }
898 return NULL;
899 }
900
901 /* ------------------------- private functions ------------------------------ */
902
903 /* Expand the hash table if needed */
904 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
905 {
906 /* If the hash table is empty expand it to the intial size,
907 * if the table is "full" dobule its size. */
908 if (ht->size == 0)
909 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
910 if (ht->size == ht->used)
911 return Jim_ExpandHashTable(ht, ht->size*2);
912 return JIM_OK;
913 }
914
915 /* Our hash table capability is a power of two */
916 static unsigned int JimHashTableNextPower(unsigned int size)
917 {
918 unsigned int i = JIM_HT_INITIAL_SIZE;
919
920 if (size >= 2147483648U)
921 return 2147483648U;
922 while (1) {
923 if (i >= size)
924 return i;
925 i *= 2;
926 }
927 }
928
929 /* Returns the index of a free slot that can be populated with
930 * an hash entry for the given 'key'.
931 * If the key already exists, -1 is returned. */
932 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
933 {
934 unsigned int h;
935 Jim_HashEntry *he;
936
937 /* Expand the hashtable if needed */
938 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
939 return -1;
940 /* Compute the key hash value */
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 /* Search if this slot does not already contain the given key */
943 he = ht->table[h];
944 while (he) {
945 if (Jim_CompareHashKeys(ht, key, he->key))
946 return -1;
947 he = he->next;
948 }
949 return h;
950 }
951
952 /* ----------------------- StringCopy Hash Table Type ------------------------*/
953
954 static unsigned int JimStringCopyHTHashFunction(const void *key)
955 {
956 return Jim_GenHashFunction(key, strlen(key));
957 }
958
959 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
960 {
961 int len = strlen(key);
962 char *copy = Jim_Alloc(len + 1);
963 JIM_NOTUSED(privdata);
964
965 memcpy(copy, key, len);
966 copy[len] = '\0';
967 return copy;
968 }
969
970 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
971 {
972 int len = strlen(val);
973 char *copy = Jim_Alloc(len + 1);
974 JIM_NOTUSED(privdata);
975
976 memcpy(copy, val, len);
977 copy[len] = '\0';
978 return copy;
979 }
980
981 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
982 const void *key2)
983 {
984 JIM_NOTUSED(privdata);
985
986 return strcmp(key1, key2) == 0;
987 }
988
989 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
990 {
991 JIM_NOTUSED(privdata);
992
993 Jim_Free((void*)key); /* ATTENTION: const cast */
994 }
995
996 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
997 {
998 JIM_NOTUSED(privdata);
999
1000 Jim_Free((void*)val); /* ATTENTION: const cast */
1001 }
1002
1003 static Jim_HashTableType JimStringCopyHashTableType = {
1004 JimStringCopyHTHashFunction, /* hash function */
1005 JimStringCopyHTKeyDup, /* key dup */
1006 NULL, /* val dup */
1007 JimStringCopyHTKeyCompare, /* key compare */
1008 JimStringCopyHTKeyDestructor, /* key destructor */
1009 NULL /* val destructor */
1010 };
1011
1012 /* This is like StringCopy but does not auto-duplicate the key.
1013 * It's used for intepreter's shared strings. */
1014 static Jim_HashTableType JimSharedStringsHashTableType = {
1015 JimStringCopyHTHashFunction, /* hash function */
1016 NULL, /* key dup */
1017 NULL, /* val dup */
1018 JimStringCopyHTKeyCompare, /* key compare */
1019 JimStringCopyHTKeyDestructor, /* key destructor */
1020 NULL /* val destructor */
1021 };
1022
1023 /* This is like StringCopy but also automatically handle dynamic
1024 * allocated C strings as values. */
1025 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1026 JimStringCopyHTHashFunction, /* hash function */
1027 JimStringCopyHTKeyDup, /* key dup */
1028 JimStringKeyValCopyHTValDup, /* val dup */
1029 JimStringCopyHTKeyCompare, /* key compare */
1030 JimStringCopyHTKeyDestructor, /* key destructor */
1031 JimStringKeyValCopyHTValDestructor, /* val destructor */
1032 };
1033
1034 typedef struct AssocDataValue {
1035 Jim_InterpDeleteProc *delProc;
1036 void *data;
1037 } AssocDataValue;
1038
1039 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1040 {
1041 AssocDataValue *assocPtr = (AssocDataValue *)data;
1042 if (assocPtr->delProc != NULL)
1043 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1044 Jim_Free(data);
1045 }
1046
1047 static Jim_HashTableType JimAssocDataHashTableType = {
1048 JimStringCopyHTHashFunction, /* hash function */
1049 JimStringCopyHTKeyDup, /* key dup */
1050 NULL, /* val dup */
1051 JimStringCopyHTKeyCompare, /* key compare */
1052 JimStringCopyHTKeyDestructor, /* key destructor */
1053 JimAssocDataHashTableValueDestructor /* val destructor */
1054 };
1055
1056 /* -----------------------------------------------------------------------------
1057 * Stack - This is a simple generic stack implementation. It is used for
1058 * example in the 'expr' expression compiler.
1059 * ---------------------------------------------------------------------------*/
1060 void Jim_InitStack(Jim_Stack *stack)
1061 {
1062 stack->len = 0;
1063 stack->maxlen = 0;
1064 stack->vector = NULL;
1065 }
1066
1067 void Jim_FreeStack(Jim_Stack *stack)
1068 {
1069 Jim_Free(stack->vector);
1070 }
1071
1072 int Jim_StackLen(Jim_Stack *stack)
1073 {
1074 return stack->len;
1075 }
1076
1077 void Jim_StackPush(Jim_Stack *stack, void *element) {
1078 int neededLen = stack->len + 1;
1079 if (neededLen > stack->maxlen) {
1080 stack->maxlen = neededLen*2;
1081 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1082 }
1083 stack->vector[stack->len] = element;
1084 stack->len++;
1085 }
1086
1087 void *Jim_StackPop(Jim_Stack *stack)
1088 {
1089 if (stack->len == 0) return NULL;
1090 stack->len--;
1091 return stack->vector[stack->len];
1092 }
1093
1094 void *Jim_StackPeek(Jim_Stack *stack)
1095 {
1096 if (stack->len == 0) return NULL;
1097 return stack->vector[stack->len-1];
1098 }
1099
1100 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1101 {
1102 int i;
1103
1104 for (i = 0; i < stack->len; i++)
1105 freeFunc(stack->vector[i]);
1106 }
1107
1108 /* -----------------------------------------------------------------------------
1109 * Parser
1110 * ---------------------------------------------------------------------------*/
1111
1112 /* Token types */
1113 #define JIM_TT_NONE -1 /* No token returned */
1114 #define JIM_TT_STR 0 /* simple string */
1115 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1116 #define JIM_TT_VAR 2 /* var substitution */
1117 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1118 #define JIM_TT_CMD 4 /* command substitution */
1119 #define JIM_TT_SEP 5 /* word separator */
1120 #define JIM_TT_EOL 6 /* line separator */
1121
1122 /* Additional token types needed for expressions */
1123 #define JIM_TT_SUBEXPR_START 7
1124 #define JIM_TT_SUBEXPR_END 8
1125 #define JIM_TT_EXPR_NUMBER 9
1126 #define JIM_TT_EXPR_OPERATOR 10
1127
1128 /* Parser states */
1129 #define JIM_PS_DEF 0 /* Default state */
1130 #define JIM_PS_QUOTE 1 /* Inside "" */
1131
1132 /* Parser context structure. The same context is used both to parse
1133 * Tcl scripts and lists. */
1134 struct JimParserCtx {
1135 const char *prg; /* Program text */
1136 const char *p; /* Pointer to the point of the program we are parsing */
1137 int len; /* Left length of 'prg' */
1138 int linenr; /* Current line number */
1139 const char *tstart;
1140 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1141 int tline; /* Line number of the returned token */
1142 int tt; /* Token type */
1143 int eof; /* Non zero if EOF condition is true. */
1144 int state; /* Parser state */
1145 int comment; /* Non zero if the next chars may be a comment. */
1146 };
1147
1148 #define JimParserEof(c) ((c)->eof)
1149 #define JimParserTstart(c) ((c)->tstart)
1150 #define JimParserTend(c) ((c)->tend)
1151 #define JimParserTtype(c) ((c)->tt)
1152 #define JimParserTline(c) ((c)->tline)
1153
1154 static int JimParseScript(struct JimParserCtx *pc);
1155 static int JimParseSep(struct JimParserCtx *pc);
1156 static int JimParseEol(struct JimParserCtx *pc);
1157 static int JimParseCmd(struct JimParserCtx *pc);
1158 static int JimParseVar(struct JimParserCtx *pc);
1159 static int JimParseBrace(struct JimParserCtx *pc);
1160 static int JimParseStr(struct JimParserCtx *pc);
1161 static int JimParseComment(struct JimParserCtx *pc);
1162 static char *JimParserGetToken(struct JimParserCtx *pc,
1163 int *lenPtr, int *typePtr, int *linePtr);
1164
1165 /* Initialize a parser context.
1166 * 'prg' is a pointer to the program text, linenr is the line
1167 * number of the first line contained in the program. */
1168 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1169 int len, int linenr)
1170 {
1171 pc->prg = prg;
1172 pc->p = prg;
1173 pc->len = len;
1174 pc->tstart = NULL;
1175 pc->tend = NULL;
1176 pc->tline = 0;
1177 pc->tt = JIM_TT_NONE;
1178 pc->eof = 0;
1179 pc->state = JIM_PS_DEF;
1180 pc->linenr = linenr;
1181 pc->comment = 1;
1182 }
1183
1184 int JimParseScript(struct JimParserCtx *pc)
1185 {
1186 while (1) { /* the while is used to reiterate with continue if needed */
1187 if (!pc->len) {
1188 pc->tstart = pc->p;
1189 pc->tend = pc->p-1;
1190 pc->tline = pc->linenr;
1191 pc->tt = JIM_TT_EOL;
1192 pc->eof = 1;
1193 return JIM_OK;
1194 }
1195 switch (*(pc->p)) {
1196 case '\\':
1197 if (*(pc->p + 1) == '\n')
1198 return JimParseSep(pc);
1199 else {
1200 pc->comment = 0;
1201 return JimParseStr(pc);
1202 }
1203 break;
1204 case ' ':
1205 case '\t':
1206 case '\r':
1207 if (pc->state == JIM_PS_DEF)
1208 return JimParseSep(pc);
1209 else {
1210 pc->comment = 0;
1211 return JimParseStr(pc);
1212 }
1213 break;
1214 case '\n':
1215 case ';':
1216 pc->comment = 1;
1217 if (pc->state == JIM_PS_DEF)
1218 return JimParseEol(pc);
1219 else
1220 return JimParseStr(pc);
1221 break;
1222 case '[':
1223 pc->comment = 0;
1224 return JimParseCmd(pc);
1225 break;
1226 case '$':
1227 pc->comment = 0;
1228 if (JimParseVar(pc) == JIM_ERR) {
1229 pc->tstart = pc->tend = pc->p++; pc->len--;
1230 pc->tline = pc->linenr;
1231 pc->tt = JIM_TT_STR;
1232 return JIM_OK;
1233 } else
1234 return JIM_OK;
1235 break;
1236 case '#':
1237 if (pc->comment) {
1238 JimParseComment(pc);
1239 continue;
1240 } else {
1241 return JimParseStr(pc);
1242 }
1243 default:
1244 pc->comment = 0;
1245 return JimParseStr(pc);
1246 break;
1247 }
1248 return JIM_OK;
1249 }
1250 }
1251
1252 int JimParseSep(struct JimParserCtx *pc)
1253 {
1254 pc->tstart = pc->p;
1255 pc->tline = pc->linenr;
1256 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1257 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1258 if (*pc->p == '\\') {
1259 pc->p++; pc->len--;
1260 pc->linenr++;
1261 }
1262 pc->p++; pc->len--;
1263 }
1264 pc->tend = pc->p-1;
1265 pc->tt = JIM_TT_SEP;
1266 return JIM_OK;
1267 }
1268
1269 int JimParseEol(struct JimParserCtx *pc)
1270 {
1271 pc->tstart = pc->p;
1272 pc->tline = pc->linenr;
1273 while (*pc->p == ' ' || *pc->p == '\n' ||
1274 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1275 if (*pc->p == '\n')
1276 pc->linenr++;
1277 pc->p++; pc->len--;
1278 }
1279 pc->tend = pc->p-1;
1280 pc->tt = JIM_TT_EOL;
1281 return JIM_OK;
1282 }
1283
1284 /* Todo. Don't stop if ']' appears inside {} or quoted.
1285 * Also should handle the case of puts [string length "]"] */
1286 int JimParseCmd(struct JimParserCtx *pc)
1287 {
1288 int level = 1;
1289 int blevel = 0;
1290
1291 pc->tstart = ++pc->p; pc->len--;
1292 pc->tline = pc->linenr;
1293 while (1) {
1294 if (pc->len == 0) {
1295 break;
1296 } else if (*pc->p == '[' && blevel == 0) {
1297 level++;
1298 } else if (*pc->p == ']' && blevel == 0) {
1299 level--;
1300 if (!level) break;
1301 } else if (*pc->p == '\\') {
1302 pc->p++; pc->len--;
1303 } else if (*pc->p == '{') {
1304 blevel++;
1305 } else if (*pc->p == '}') {
1306 if (blevel != 0)
1307 blevel--;
1308 } else if (*pc->p == '\n')
1309 pc->linenr++;
1310 pc->p++; pc->len--;
1311 }
1312 pc->tend = pc->p-1;
1313 pc->tt = JIM_TT_CMD;
1314 if (*pc->p == ']') {
1315 pc->p++; pc->len--;
1316 }
1317 return JIM_OK;
1318 }
1319
1320 int JimParseVar(struct JimParserCtx *pc)
1321 {
1322 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1323
1324 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1325 pc->tline = pc->linenr;
1326 if (*pc->p == '{') {
1327 pc->tstart = ++pc->p; pc->len--;
1328 brace = 1;
1329 }
1330 if (brace) {
1331 while (!stop) {
1332 if (*pc->p == '}' || pc->len == 0) {
1333 pc->tend = pc->p-1;
1334 stop = 1;
1335 if (pc->len == 0)
1336 break;
1337 }
1338 else if (*pc->p == '\n')
1339 pc->linenr++;
1340 pc->p++; pc->len--;
1341 }
1342 } else {
1343 /* Include leading colons */
1344 while (*pc->p == ':') {
1345 pc->p++;
1346 pc->len--;
1347 }
1348 while (!stop) {
1349 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1350 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1351 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1352 stop = 1;
1353 else {
1354 pc->p++; pc->len--;
1355 }
1356 }
1357 /* Parse [dict get] syntax sugar. */
1358 if (*pc->p == '(') {
1359 while (*pc->p != ')' && pc->len) {
1360 pc->p++; pc->len--;
1361 if (*pc->p == '\\' && pc->len >= 2) {
1362 pc->p += 2; pc->len -= 2;
1363 }
1364 }
1365 if (*pc->p != '\0') {
1366 pc->p++; pc->len--;
1367 }
1368 ttype = JIM_TT_DICTSUGAR;
1369 }
1370 pc->tend = pc->p-1;
1371 }
1372 /* Check if we parsed just the '$' character.
1373 * That's not a variable so an error is returned
1374 * to tell the state machine to consider this '$' just
1375 * a string. */
1376 if (pc->tstart == pc->p) {
1377 pc->p--; pc->len++;
1378 return JIM_ERR;
1379 }
1380 pc->tt = ttype;
1381 return JIM_OK;
1382 }
1383
1384 int JimParseBrace(struct JimParserCtx *pc)
1385 {
1386 int level = 1;
1387
1388 pc->tstart = ++pc->p; pc->len--;
1389 pc->tline = pc->linenr;
1390 while (1) {
1391 if (*pc->p == '\\' && pc->len >= 2) {
1392 pc->p++; pc->len--;
1393 if (*pc->p == '\n')
1394 pc->linenr++;
1395 } else if (*pc->p == '{') {
1396 level++;
1397 } else if (pc->len == 0 || *pc->p == '}') {
1398 level--;
1399 if (pc->len == 0 || level == 0) {
1400 pc->tend = pc->p-1;
1401 if (pc->len != 0) {
1402 pc->p++; pc->len--;
1403 }
1404 pc->tt = JIM_TT_STR;
1405 return JIM_OK;
1406 }
1407 } else if (*pc->p == '\n') {
1408 pc->linenr++;
1409 }
1410 pc->p++; pc->len--;
1411 }
1412 return JIM_OK; /* unreached */
1413 }
1414
1415 int JimParseStr(struct JimParserCtx *pc)
1416 {
1417 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1418 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1419 if (newword && *pc->p == '{') {
1420 return JimParseBrace(pc);
1421 } else if (newword && *pc->p == '"') {
1422 pc->state = JIM_PS_QUOTE;
1423 pc->p++; pc->len--;
1424 }
1425 pc->tstart = pc->p;
1426 pc->tline = pc->linenr;
1427 while (1) {
1428 if (pc->len == 0) {
1429 pc->tend = pc->p-1;
1430 pc->tt = JIM_TT_ESC;
1431 return JIM_OK;
1432 }
1433 switch (*pc->p) {
1434 case '\\':
1435 if (pc->state == JIM_PS_DEF &&
1436 *(pc->p + 1) == '\n') {
1437 pc->tend = pc->p-1;
1438 pc->tt = JIM_TT_ESC;
1439 return JIM_OK;
1440 }
1441 if (pc->len >= 2) {
1442 pc->p++; pc->len--;
1443 }
1444 break;
1445 case '$':
1446 case '[':
1447 pc->tend = pc->p-1;
1448 pc->tt = JIM_TT_ESC;
1449 return JIM_OK;
1450 case ' ':
1451 case '\t':
1452 case '\n':
1453 case '\r':
1454 case ';':
1455 if (pc->state == JIM_PS_DEF) {
1456 pc->tend = pc->p-1;
1457 pc->tt = JIM_TT_ESC;
1458 return JIM_OK;
1459 } else if (*pc->p == '\n') {
1460 pc->linenr++;
1461 }
1462 break;
1463 case '"':
1464 if (pc->state == JIM_PS_QUOTE) {
1465 pc->tend = pc->p-1;
1466 pc->tt = JIM_TT_ESC;
1467 pc->p++; pc->len--;
1468 pc->state = JIM_PS_DEF;
1469 return JIM_OK;
1470 }
1471 break;
1472 }
1473 pc->p++; pc->len--;
1474 }
1475 return JIM_OK; /* unreached */
1476 }
1477
1478 int JimParseComment(struct JimParserCtx *pc)
1479 {
1480 while (*pc->p) {
1481 if (*pc->p == '\n') {
1482 pc->linenr++;
1483 if (*(pc->p-1) != '\\') {
1484 pc->p++; pc->len--;
1485 return JIM_OK;
1486 }
1487 }
1488 pc->p++; pc->len--;
1489 }
1490 return JIM_OK;
1491 }
1492
1493 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1494 static int xdigitval(int c)
1495 {
1496 if (c >= '0' && c <= '9') return c-'0';
1497 if (c >= 'a' && c <= 'f') return c-'a'+10;
1498 if (c >= 'A' && c <= 'F') return c-'A'+10;
1499 return -1;
1500 }
1501
1502 static int odigitval(int c)
1503 {
1504 if (c >= '0' && c <= '7') return c-'0';
1505 return -1;
1506 }
1507
1508 /* Perform Tcl escape substitution of 's', storing the result
1509 * string into 'dest'. The escaped string is guaranteed to
1510 * be the same length or shorted than the source string.
1511 * Slen is the length of the string at 's', if it's -1 the string
1512 * length will be calculated by the function.
1513 *
1514 * The function returns the length of the resulting string. */
1515 static int JimEscape(char *dest, const char *s, int slen)
1516 {
1517 char *p = dest;
1518 int i, len;
1519
1520 if (slen == -1)
1521 slen = strlen(s);
1522
1523 for (i = 0; i < slen; i++) {
1524 switch (s[i]) {
1525 case '\\':
1526 switch (s[i + 1]) {
1527 case 'a': *p++ = 0x7; i++; break;
1528 case 'b': *p++ = 0x8; i++; break;
1529 case 'f': *p++ = 0xc; i++; break;
1530 case 'n': *p++ = 0xa; i++; break;
1531 case 'r': *p++ = 0xd; i++; break;
1532 case 't': *p++ = 0x9; i++; break;
1533 case 'v': *p++ = 0xb; i++; break;
1534 case '\0': *p++ = '\\'; i++; break;
1535 case '\n': *p++ = ' '; i++; break;
1536 default:
1537 if (s[i + 1] == 'x') {
1538 int val = 0;
1539 int c = xdigitval(s[i + 2]);
1540 if (c == -1) {
1541 *p++ = 'x';
1542 i++;
1543 break;
1544 }
1545 val = c;
1546 c = xdigitval(s[i + 3]);
1547 if (c == -1) {
1548 *p++ = val;
1549 i += 2;
1550 break;
1551 }
1552 val = (val*16) + c;
1553 *p++ = val;
1554 i += 3;
1555 break;
1556 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1557 {
1558 int val = 0;
1559 int c = odigitval(s[i + 1]);
1560 val = c;
1561 c = odigitval(s[i + 2]);
1562 if (c == -1) {
1563 *p++ = val;
1564 i ++;
1565 break;
1566 }
1567 val = (val*8) + c;
1568 c = odigitval(s[i + 3]);
1569 if (c == -1) {
1570 *p++ = val;
1571 i += 2;
1572 break;
1573 }
1574 val = (val*8) + c;
1575 *p++ = val;
1576 i += 3;
1577 } else {
1578 *p++ = s[i + 1];
1579 i++;
1580 }
1581 break;
1582 }
1583 break;
1584 default:
1585 *p++ = s[i];
1586 break;
1587 }
1588 }
1589 len = p-dest;
1590 *p++ = '\0';
1591 return len;
1592 }
1593
1594 /* Returns a dynamically allocated copy of the current token in the
1595 * parser context. The function perform conversion of escapes if
1596 * the token is of type JIM_TT_ESC.
1597 *
1598 * Note that after the conversion, tokens that are grouped with
1599 * braces in the source code, are always recognizable from the
1600 * identical string obtained in a different way from the type.
1601 *
1602 * For exmple the string:
1603 *
1604 * {expand}$a
1605 *
1606 * will return as first token "expand", of type JIM_TT_STR
1607 *
1608 * While the string:
1609 *
1610 * expand$a
1611 *
1612 * will return as first token "expand", of type JIM_TT_ESC
1613 */
1614 char *JimParserGetToken(struct JimParserCtx *pc,
1615 int *lenPtr, int *typePtr, int *linePtr)
1616 {
1617 const char *start, *end;
1618 char *token;
1619 int len;
1620
1621 start = JimParserTstart(pc);
1622 end = JimParserTend(pc);
1623 if (start > end) {
1624 if (lenPtr) *lenPtr = 0;
1625 if (typePtr) *typePtr = JimParserTtype(pc);
1626 if (linePtr) *linePtr = JimParserTline(pc);
1627 token = Jim_Alloc(1);
1628 token[0] = '\0';
1629 return token;
1630 }
1631 len = (end-start) + 1;
1632 token = Jim_Alloc(len + 1);
1633 if (JimParserTtype(pc) != JIM_TT_ESC) {
1634 /* No escape conversion needed? Just copy it. */
1635 memcpy(token, start, len);
1636 token[len] = '\0';
1637 } else {
1638 /* Else convert the escape chars. */
1639 len = JimEscape(token, start, len);
1640 }
1641 if (lenPtr) *lenPtr = len;
1642 if (typePtr) *typePtr = JimParserTtype(pc);
1643 if (linePtr) *linePtr = JimParserTline(pc);
1644 return token;
1645 }
1646
1647 /* The following functin is not really part of the parsing engine of Jim,
1648 * but it somewhat related. Given an string and its length, it tries
1649 * to guess if the script is complete or there are instead " " or { }
1650 * open and not completed. This is useful for interactive shells
1651 * implementation and for [info complete].
1652 *
1653 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1654 * '{' on scripts incomplete missing one or more '}' to be balanced.
1655 * '"' on scripts incomplete missing a '"' char.
1656 *
1657 * If the script is complete, 1 is returned, otherwise 0. */
1658 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1659 {
1660 int level = 0;
1661 int state = ' ';
1662
1663 while (len) {
1664 switch (*s) {
1665 case '\\':
1666 if (len > 1)
1667 s++;
1668 break;
1669 case '"':
1670 if (state == ' ') {
1671 state = '"';
1672 } else if (state == '"') {
1673 state = ' ';
1674 }
1675 break;
1676 case '{':
1677 if (state == '{') {
1678 level++;
1679 } else if (state == ' ') {
1680 state = '{';
1681 level++;
1682 }
1683 break;
1684 case '}':
1685 if (state == '{') {
1686 level--;
1687 if (level == 0)
1688 state = ' ';
1689 }
1690 break;
1691 }
1692 s++;
1693 len--;
1694 }
1695 if (stateCharPtr)
1696 *stateCharPtr = state;
1697 return state == ' ';
1698 }
1699
1700 /* -----------------------------------------------------------------------------
1701 * Tcl Lists parsing
1702 * ---------------------------------------------------------------------------*/
1703 static int JimParseListSep(struct JimParserCtx *pc);
1704 static int JimParseListStr(struct JimParserCtx *pc);
1705
1706 int JimParseList(struct JimParserCtx *pc)
1707 {
1708 if (pc->len == 0) {
1709 pc->tstart = pc->tend = pc->p;
1710 pc->tline = pc->linenr;
1711 pc->tt = JIM_TT_EOL;
1712 pc->eof = 1;
1713 return JIM_OK;
1714 }
1715 switch (*pc->p) {
1716 case ' ':
1717 case '\n':
1718 case '\t':
1719 case '\r':
1720 if (pc->state == JIM_PS_DEF)
1721 return JimParseListSep(pc);
1722 else
1723 return JimParseListStr(pc);
1724 break;
1725 default:
1726 return JimParseListStr(pc);
1727 break;
1728 }
1729 return JIM_OK;
1730 }
1731
1732 int JimParseListSep(struct JimParserCtx *pc)
1733 {
1734 pc->tstart = pc->p;
1735 pc->tline = pc->linenr;
1736 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1737 {
1738 pc->p++; pc->len--;
1739 }
1740 pc->tend = pc->p-1;
1741 pc->tt = JIM_TT_SEP;
1742 return JIM_OK;
1743 }
1744
1745 int JimParseListStr(struct JimParserCtx *pc)
1746 {
1747 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1748 pc->tt == JIM_TT_NONE);
1749 if (newword && *pc->p == '{') {
1750 return JimParseBrace(pc);
1751 } else if (newword && *pc->p == '"') {
1752 pc->state = JIM_PS_QUOTE;
1753 pc->p++; pc->len--;
1754 }
1755 pc->tstart = pc->p;
1756 pc->tline = pc->linenr;
1757 while (1) {
1758 if (pc->len == 0) {
1759 pc->tend = pc->p-1;
1760 pc->tt = JIM_TT_ESC;
1761 return JIM_OK;
1762 }
1763 switch (*pc->p) {
1764 case '\\':
1765 pc->p++; pc->len--;
1766 break;
1767 case ' ':
1768 case '\t':
1769 case '\n':
1770 case '\r':
1771 if (pc->state == JIM_PS_DEF) {
1772 pc->tend = pc->p-1;
1773 pc->tt = JIM_TT_ESC;
1774 return JIM_OK;
1775 } else if (*pc->p == '\n') {
1776 pc->linenr++;
1777 }
1778 break;
1779 case '"':
1780 if (pc->state == JIM_PS_QUOTE) {
1781 pc->tend = pc->p-1;
1782 pc->tt = JIM_TT_ESC;
1783 pc->p++; pc->len--;
1784 pc->state = JIM_PS_DEF;
1785 return JIM_OK;
1786 }
1787 break;
1788 }
1789 pc->p++; pc->len--;
1790 }
1791 return JIM_OK; /* unreached */
1792 }
1793
1794 /* -----------------------------------------------------------------------------
1795 * Jim_Obj related functions
1796 * ---------------------------------------------------------------------------*/
1797
1798 /* Return a new initialized object. */
1799 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1800 {
1801 Jim_Obj *objPtr;
1802
1803 /* -- Check if there are objects in the free list -- */
1804 if (interp->freeList != NULL) {
1805 /* -- Unlink the object from the free list -- */
1806 objPtr = interp->freeList;
1807 interp->freeList = objPtr->nextObjPtr;
1808 } else {
1809 /* -- No ready to use objects: allocate a new one -- */
1810 objPtr = Jim_Alloc(sizeof(*objPtr));
1811 }
1812
1813 /* Object is returned with refCount of 0. Every
1814 * kind of GC implemented should take care to don't try
1815 * to scan objects with refCount == 0. */
1816 objPtr->refCount = 0;
1817 /* All the other fields are left not initialized to save time.
1818 * The caller will probably want set they to the right
1819 * value anyway. */
1820
1821 /* -- Put the object into the live list -- */
1822 objPtr->prevObjPtr = NULL;
1823 objPtr->nextObjPtr = interp->liveList;
1824 if (interp->liveList)
1825 interp->liveList->prevObjPtr = objPtr;
1826 interp->liveList = objPtr;
1827
1828 return objPtr;
1829 }
1830
1831 /* Free an object. Actually objects are never freed, but
1832 * just moved to the free objects list, where they will be
1833 * reused by Jim_NewObj(). */
1834 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1835 {
1836 /* Check if the object was already freed, panic. */
1837 if (objPtr->refCount != 0) {
1838 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1839 objPtr->refCount);
1840 }
1841 /* Free the internal representation */
1842 Jim_FreeIntRep(interp, objPtr);
1843 /* Free the string representation */
1844 if (objPtr->bytes != NULL) {
1845 if (objPtr->bytes != JimEmptyStringRep)
1846 Jim_Free(objPtr->bytes);
1847 }
1848 /* Unlink the object from the live objects list */
1849 if (objPtr->prevObjPtr)
1850 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1851 if (objPtr->nextObjPtr)
1852 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1853 if (interp->liveList == objPtr)
1854 interp->liveList = objPtr->nextObjPtr;
1855 /* Link the object into the free objects list */
1856 objPtr->prevObjPtr = NULL;
1857 objPtr->nextObjPtr = interp->freeList;
1858 if (interp->freeList)
1859 interp->freeList->prevObjPtr = objPtr;
1860 interp->freeList = objPtr;
1861 objPtr->refCount = -1;
1862 }
1863
1864 /* Invalidate the string representation of an object. */
1865 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1866 {
1867 if (objPtr->bytes != NULL) {
1868 if (objPtr->bytes != JimEmptyStringRep)
1869 Jim_Free(objPtr->bytes);
1870 }
1871 objPtr->bytes = NULL;
1872 }
1873
1874 #define Jim_SetStringRep(o, b, l) \
1875 do { (o)->bytes = b; (o)->length = l; } while (0)
1876
1877 /* Set the initial string representation for an object.
1878 * Does not try to free an old one. */
1879 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1880 {
1881 if (length == 0) {
1882 objPtr->bytes = JimEmptyStringRep;
1883 objPtr->length = 0;
1884 } else {
1885 objPtr->bytes = Jim_Alloc(length + 1);
1886 objPtr->length = length;
1887 memcpy(objPtr->bytes, bytes, length);
1888 objPtr->bytes[length] = '\0';
1889 }
1890 }
1891
1892 /* Duplicate an object. The returned object has refcount = 0. */
1893 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1894 {
1895 Jim_Obj *dupPtr;
1896
1897 dupPtr = Jim_NewObj(interp);
1898 if (objPtr->bytes == NULL) {
1899 /* Object does not have a valid string representation. */
1900 dupPtr->bytes = NULL;
1901 } else {
1902 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1903 }
1904 if (objPtr->typePtr != NULL) {
1905 if (objPtr->typePtr->dupIntRepProc == NULL) {
1906 dupPtr->internalRep = objPtr->internalRep;
1907 } else {
1908 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1909 }
1910 dupPtr->typePtr = objPtr->typePtr;
1911 } else {
1912 dupPtr->typePtr = NULL;
1913 }
1914 return dupPtr;
1915 }
1916
1917 /* Return the string representation for objPtr. If the object
1918 * string representation is invalid, calls the method to create
1919 * a new one starting from the internal representation of the object. */
1920 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1921 {
1922 if (objPtr->bytes == NULL) {
1923 /* Invalid string repr. Generate it. */
1924 if (objPtr->typePtr->updateStringProc == NULL) {
1925 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1926 objPtr->typePtr->name);
1927 }
1928 objPtr->typePtr->updateStringProc(objPtr);
1929 }
1930 if (lenPtr)
1931 *lenPtr = objPtr->length;
1932 return objPtr->bytes;
1933 }
1934
1935 /* Just returns the length of the object's string rep */
1936 int Jim_Length(Jim_Obj *objPtr)
1937 {
1938 int len;
1939
1940 Jim_GetString(objPtr, &len);
1941 return len;
1942 }
1943
1944 /* -----------------------------------------------------------------------------
1945 * String Object
1946 * ---------------------------------------------------------------------------*/
1947 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1948 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1949
1950 static Jim_ObjType stringObjType = {
1951 "string",
1952 NULL,
1953 DupStringInternalRep,
1954 NULL,
1955 JIM_TYPE_REFERENCES,
1956 };
1957
1958 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1959 {
1960 JIM_NOTUSED(interp);
1961
1962 /* This is a bit subtle: the only caller of this function
1963 * should be Jim_DuplicateObj(), that will copy the
1964 * string representaion. After the copy, the duplicated
1965 * object will not have more room in teh buffer than
1966 * srcPtr->length bytes. So we just set it to length. */
1967 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1968 }
1969
1970 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1971 {
1972 /* Get a fresh string representation. */
1973 (void) Jim_GetString(objPtr, NULL);
1974 /* Free any other internal representation. */
1975 Jim_FreeIntRep(interp, objPtr);
1976 /* Set it as string, i.e. just set the maxLength field. */
1977 objPtr->typePtr = &stringObjType;
1978 objPtr->internalRep.strValue.maxLength = objPtr->length;
1979 return JIM_OK;
1980 }
1981
1982 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1983 {
1984 Jim_Obj *objPtr = Jim_NewObj(interp);
1985
1986 if (len == -1)
1987 len = strlen(s);
1988 /* Alloc/Set the string rep. */
1989 if (len == 0) {
1990 objPtr->bytes = JimEmptyStringRep;
1991 objPtr->length = 0;
1992 } else {
1993 objPtr->bytes = Jim_Alloc(len + 1);
1994 objPtr->length = len;
1995 memcpy(objPtr->bytes, s, len);
1996 objPtr->bytes[len] = '\0';
1997 }
1998
1999 /* No typePtr field for the vanilla string object. */
2000 objPtr->typePtr = NULL;
2001 return objPtr;
2002 }
2003
2004 /* This version does not try to duplicate the 's' pointer, but
2005 * use it directly. */
2006 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2007 {
2008 Jim_Obj *objPtr = Jim_NewObj(interp);
2009
2010 if (len == -1)
2011 len = strlen(s);
2012 Jim_SetStringRep(objPtr, s, len);
2013 objPtr->typePtr = NULL;
2014 return objPtr;
2015 }
2016
2017 /* Low-level string append. Use it only against objects
2018 * of type "string". */
2019 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2020 {
2021 int needlen;
2022
2023 if (len == -1)
2024 len = strlen(str);
2025 needlen = objPtr->length + len;
2026 if (objPtr->internalRep.strValue.maxLength < needlen ||
2027 objPtr->internalRep.strValue.maxLength == 0) {
2028 if (objPtr->bytes == JimEmptyStringRep) {
2029 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2030 } else {
2031 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2032 }
2033 objPtr->internalRep.strValue.maxLength = needlen*2;
2034 }
2035 memcpy(objPtr->bytes + objPtr->length, str, len);
2036 objPtr->bytes[objPtr->length + len] = '\0';
2037 objPtr->length += len;
2038 }
2039
2040 /* Low-level wrapper to append an object. */
2041 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2042 {
2043 int len;
2044 const char *str;
2045
2046 str = Jim_GetString(appendObjPtr, &len);
2047 StringAppendString(objPtr, str, len);
2048 }
2049
2050 /* Higher level API to append strings to objects. */
2051 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2052 int len)
2053 {
2054 if (Jim_IsShared(objPtr))
2055 Jim_Panic(interp,"Jim_AppendString called with shared object");
2056 if (objPtr->typePtr != &stringObjType)
2057 SetStringFromAny(interp, objPtr);
2058 StringAppendString(objPtr, str, len);
2059 }
2060
2061 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2062 {
2063 char *buf;
2064 va_list ap;
2065
2066 va_start(ap, fmt);
2067 buf = jim_vasprintf(fmt, ap);
2068 va_end(ap);
2069
2070 if (buf) {
2071 Jim_AppendString(interp, objPtr, buf, -1);
2072 jim_vasprintf_done(buf);
2073 }
2074 }
2075
2076
2077 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2078 Jim_Obj *appendObjPtr)
2079 {
2080 int len;
2081 const char *str;
2082
2083 str = Jim_GetString(appendObjPtr, &len);
2084 Jim_AppendString(interp, objPtr, str, len);
2085 }
2086
2087 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2088 {
2089 va_list ap;
2090
2091 if (objPtr->typePtr != &stringObjType)
2092 SetStringFromAny(interp, objPtr);
2093 va_start(ap, objPtr);
2094 while (1) {
2095 char *s = va_arg(ap, char*);
2096
2097 if (s == NULL) break;
2098 Jim_AppendString(interp, objPtr, s, -1);
2099 }
2100 va_end(ap);
2101 }
2102
2103 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2104 {
2105 const char *aStr, *bStr;
2106 int aLen, bLen, i;
2107
2108 if (aObjPtr == bObjPtr) return 1;
2109 aStr = Jim_GetString(aObjPtr, &aLen);
2110 bStr = Jim_GetString(bObjPtr, &bLen);
2111 if (aLen != bLen) return 0;
2112 if (nocase == 0)
2113 return memcmp(aStr, bStr, aLen) == 0;
2114 for (i = 0; i < aLen; i++) {
2115 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2116 return 0;
2117 }
2118 return 1;
2119 }
2120
2121 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2122 int nocase)
2123 {
2124 const char *pattern, *string;
2125 int patternLen, stringLen;
2126
2127 pattern = Jim_GetString(patternObjPtr, &patternLen);
2128 string = Jim_GetString(objPtr, &stringLen);
2129 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2130 }
2131
2132 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2133 Jim_Obj *secondObjPtr, int nocase)
2134 {
2135 const char *s1, *s2;
2136 int l1, l2;
2137
2138 s1 = Jim_GetString(firstObjPtr, &l1);
2139 s2 = Jim_GetString(secondObjPtr, &l2);
2140 return JimStringCompare(s1, l1, s2, l2, nocase);
2141 }
2142
2143 /* Convert a range, as returned by Jim_GetRange(), into
2144 * an absolute index into an object of the specified length.
2145 * This function may return negative values, or values
2146 * bigger or equal to the length of the list if the index
2147 * is out of range. */
2148 static int JimRelToAbsIndex(int len, int index)
2149 {
2150 if (index < 0)
2151 return len + index;
2152 return index;
2153 }
2154
2155 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2156 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2157 * for implementation of commands like [string range] and [lrange].
2158 *
2159 * The resulting range is guaranteed to address valid elements of
2160 * the structure. */
2161 static void JimRelToAbsRange(int len, int first, int last,
2162 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2163 {
2164 int rangeLen;
2165
2166 if (first > last) {
2167 rangeLen = 0;
2168 } else {
2169 rangeLen = last-first + 1;
2170 if (rangeLen) {
2171 if (first < 0) {
2172 rangeLen += first;
2173 first = 0;
2174 }
2175 if (last >= len) {
2176 rangeLen -= (last-(len-1));
2177 last = len-1;
2178 }
2179 }
2180 }
2181 if (rangeLen < 0) rangeLen = 0;
2182
2183 *firstPtr = first;
2184 *lastPtr = last;
2185 *rangeLenPtr = rangeLen;
2186 }
2187
2188 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2189 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2190 {
2191 int first, last;
2192 const char *str;
2193 int len, rangeLen;
2194
2195 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2196 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2197 return NULL;
2198 str = Jim_GetString(strObjPtr, &len);
2199 first = JimRelToAbsIndex(len, first);
2200 last = JimRelToAbsIndex(len, last);
2201 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2202 return Jim_NewStringObj(interp, str + first, rangeLen);
2203 }
2204
2205 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2206 {
2207 char *buf;
2208 int i;
2209 if (strObjPtr->typePtr != &stringObjType) {
2210 SetStringFromAny(interp, strObjPtr);
2211 }
2212
2213 buf = Jim_Alloc(strObjPtr->length + 1);
2214
2215 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2216 for (i = 0; i < strObjPtr->length; i++)
2217 buf[i] = tolower(buf[i]);
2218 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2219 }
2220
2221 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2222 {
2223 char *buf;
2224 int i;
2225 if (strObjPtr->typePtr != &stringObjType) {
2226 SetStringFromAny(interp, strObjPtr);
2227 }
2228
2229 buf = Jim_Alloc(strObjPtr->length + 1);
2230
2231 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2232 for (i = 0; i < strObjPtr->length; i++)
2233 buf[i] = toupper(buf[i]);
2234 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2235 }
2236
2237 /* This is the core of the [format] command.
2238 * TODO: Lots of things work - via a hack
2239 * However, no format item can be >= JIM_MAX_FMT
2240 */
2241 #define JIM_MAX_FMT 2048
2242 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2243 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2244 {
2245 const char *fmt, *_fmt;
2246 int fmtLen;
2247 Jim_Obj *resObjPtr;
2248
2249
2250 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2251 _fmt = fmt;
2252 resObjPtr = Jim_NewStringObj(interp, "", 0);
2253 while (fmtLen) {
2254 const char *p = fmt;
2255 char spec[2], c;
2256 jim_wide wideValue;
2257 double doubleValue;
2258 /* we cheat and use Sprintf()! */
2259 char fmt_str[100];
2260 char *cp;
2261 int width;
2262 int ljust;
2263 int zpad;
2264 int spad;
2265 int altfm;
2266 int forceplus;
2267 int prec;
2268 int inprec;
2269 int haveprec;
2270 int accum;
2271
2272 while (*fmt != '%' && fmtLen) {
2273 fmt++; fmtLen--;
2274 }
2275 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2276 if (fmtLen == 0)
2277 break;
2278 fmt++; fmtLen--; /* skip '%' */
2279 zpad = 0;
2280 spad = 0;
2281 width = -1;
2282 ljust = 0;
2283 altfm = 0;
2284 forceplus = 0;
2285 inprec = 0;
2286 haveprec = 0;
2287 prec = -1; /* not found yet */
2288 next_fmt:
2289 if (fmtLen <= 0) {
2290 break;
2291 }
2292 switch (*fmt) {
2293 /* terminals */
2294 case 'b': /* binary - not all printfs() do this */
2295 case 's': /* string */
2296 case 'i': /* integer */
2297 case 'd': /* decimal */
2298 case 'x': /* hex */
2299 case 'X': /* CAP hex */
2300 case 'c': /* char */
2301 case 'o': /* octal */
2302 case 'u': /* unsigned */
2303 case 'f': /* float */
2304 break;
2305
2306 /* non-terminals */
2307 case '0': /* zero pad */
2308 zpad = 1;
2309 fmt++; fmtLen--;
2310 goto next_fmt;
2311 break;
2312 case '+':
2313 forceplus = 1;
2314 fmt++; fmtLen--;
2315 goto next_fmt;
2316 break;
2317 case ' ': /* sign space */
2318 spad = 1;
2319 fmt++; fmtLen--;
2320 goto next_fmt;
2321 break;
2322 case '-':
2323 ljust = 1;
2324 fmt++; fmtLen--;
2325 goto next_fmt;
2326 break;
2327 case '#':
2328 altfm = 1;
2329 fmt++; fmtLen--;
2330 goto next_fmt;
2331
2332 case '.':
2333 inprec = 1;
2334 fmt++; fmtLen--;
2335 goto next_fmt;
2336 break;
2337 case '1':
2338 case '2':
2339 case '3':
2340 case '4':
2341 case '5':
2342 case '6':
2343 case '7':
2344 case '8':
2345 case '9':
2346 accum = 0;
2347 while (isdigit(*fmt) && (fmtLen > 0)) {
2348 accum = (accum * 10) + (*fmt - '0');
2349 fmt++; fmtLen--;
2350 }
2351 if (inprec) {
2352 haveprec = 1;
2353 prec = accum;
2354 } else {
2355 width = accum;
2356 }
2357 goto next_fmt;
2358 case '*':
2359 /* suck up the next item as an integer */
2360 fmt++; fmtLen--;
2361 objc--;
2362 if (objc <= 0) {
2363 goto not_enough_args;
2364 }
2365 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2366 Jim_FreeNewObj(interp, resObjPtr);
2367 return NULL;
2368 }
2369 if (inprec) {
2370 haveprec = 1;
2371 prec = wideValue;
2372 if (prec < 0) {
2373 /* man 3 printf says */
2374 /* if prec is negative, it is zero */
2375 prec = 0;
2376 }
2377 } else {
2378 width = wideValue;
2379 if (width < 0) {
2380 ljust = 1;
2381 width = -width;
2382 }
2383 }
2384 objv++;
2385 goto next_fmt;
2386 break;
2387 }
2388
2389
2390 if (*fmt != '%') {
2391 if (objc == 0) {
2392 not_enough_args:
2393 Jim_FreeNewObj(interp, resObjPtr);
2394 Jim_SetResultString(interp,
2395 "not enough arguments for all format specifiers", -1);
2396 return NULL;
2397 } else {
2398 objc--;
2399 }
2400 }
2401
2402 /*
2403 * Create the formatter
2404 * cause we cheat and use sprintf()
2405 */
2406 cp = fmt_str;
2407 *cp++ = '%';
2408 if (altfm) {
2409 *cp++ = '#';
2410 }
2411 if (forceplus) {
2412 *cp++ = '+';
2413 } else if (spad) {
2414 /* PLUS overrides */
2415 *cp++ = ' ';
2416 }
2417 if (ljust) {
2418 *cp++ = '-';
2419 }
2420 if (zpad) {
2421 *cp++ = '0';
2422 }
2423 if (width > 0) {
2424 sprintf(cp, "%d", width);
2425 /* skip ahead */
2426 cp = strchr(cp,0);
2427 }
2428 /* did we find a period? */
2429 if (inprec) {
2430 /* then add it */
2431 *cp++ = '.';
2432 /* did something occur after the period? */
2433 if (haveprec) {
2434 sprintf(cp, "%d", prec);
2435 }
2436 cp = strchr(cp,0);
2437 }
2438 *cp = 0;
2439
2440 /* here we do the work */
2441 /* actually - we make sprintf() do it for us */
2442 switch (*fmt) {
2443 case 's':
2444 *cp++ = 's';
2445 *cp = 0;
2446 /* BUG: we do not handled embeded NULLs */
2447 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2448 break;
2449 case 'c':
2450 *cp++ = 'c';
2451 *cp = 0;
2452 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2453 Jim_FreeNewObj(interp, resObjPtr);
2454 return NULL;
2455 }
2456 c = (char) wideValue;
2457 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2458 break;
2459 case 'f':
2460 case 'F':
2461 case 'g':
2462 case 'G':
2463 case 'e':
2464 case 'E':
2465 *cp++ = *fmt;
2466 *cp = 0;
2467 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2468 Jim_FreeNewObj(interp, resObjPtr);
2469 return NULL;
2470 }
2471 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2472 break;
2473 case 'b':
2474 case 'd':
2475 case 'o':
2476 case 'i':
2477 case 'u':
2478 case 'x':
2479 case 'X':
2480 /* jim widevaluse are 64bit */
2481 if (sizeof(jim_wide) == sizeof(long long)) {
2482 *cp++ = 'l';
2483 *cp++ = 'l';
2484 } else {
2485 *cp++ = 'l';
2486 }
2487 *cp++ = *fmt;
2488 *cp = 0;
2489 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2490 Jim_FreeNewObj(interp, resObjPtr);
2491 return NULL;
2492 }
2493 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2494 break;
2495 case '%':
2496 sprintf_buf[0] = '%';
2497 sprintf_buf[1] = 0;
2498 objv--; /* undo the objv++ below */
2499 break;
2500 default:
2501 spec[0] = *fmt; spec[1] = '\0';
2502 Jim_FreeNewObj(interp, resObjPtr);
2503 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2504 Jim_AppendStrings(interp, Jim_GetResult(interp),
2505 "bad field specifier \"", spec, "\"", NULL);
2506 return NULL;
2507 }
2508 /* force terminate */
2509 #if 0
2510 printf("FMT was: %s\n", fmt_str);
2511 printf("RES was: |%s|\n", sprintf_buf);
2512 #endif
2513
2514 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2515 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2516 /* next obj */
2517 objv++;
2518 fmt++;
2519 fmtLen--;
2520 }
2521 return resObjPtr;
2522 }
2523
2524 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2525 int objc, Jim_Obj *const *objv)
2526 {
2527 char *sprintf_buf = malloc(JIM_MAX_FMT);
2528 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2529 free(sprintf_buf);
2530 return t;
2531 }
2532
2533 /* -----------------------------------------------------------------------------
2534 * Compared String Object
2535 * ---------------------------------------------------------------------------*/
2536
2537 /* This is strange object that allows to compare a C literal string
2538 * with a Jim object in very short time if the same comparison is done
2539 * multiple times. For example every time the [if] command is executed,
2540 * Jim has to check if a given argument is "else". This comparions if
2541 * the code has no errors are true most of the times, so we can cache
2542 * inside the object the pointer of the string of the last matching
2543 * comparison. Because most C compilers perform literal sharing,
2544 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2545 * this works pretty well even if comparisons are at different places
2546 * inside the C code. */
2547
2548 static Jim_ObjType comparedStringObjType = {
2549 "compared-string",
2550 NULL,
2551 NULL,
2552 NULL,
2553 JIM_TYPE_REFERENCES,
2554 };
2555
2556 /* The only way this object is exposed to the API is via the following
2557 * function. Returns true if the string and the object string repr.
2558 * are the same, otherwise zero is returned.
2559 *
2560 * Note: this isn't binary safe, but it hardly needs to be.*/
2561 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2562 const char *str)
2563 {
2564 if (objPtr->typePtr == &comparedStringObjType &&
2565 objPtr->internalRep.ptr == str)
2566 return 1;
2567 else {
2568 const char *objStr = Jim_GetString(objPtr, NULL);
2569 if (strcmp(str, objStr) != 0) return 0;
2570 if (objPtr->typePtr != &comparedStringObjType) {
2571 Jim_FreeIntRep(interp, objPtr);
2572 objPtr->typePtr = &comparedStringObjType;
2573 }
2574 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2575 return 1;
2576 }
2577 }
2578
2579 int qsortCompareStringPointers(const void *a, const void *b)
2580 {
2581 char * const *sa = (char * const *)a;
2582 char * const *sb = (char * const *)b;
2583 return strcmp(*sa, *sb);
2584 }
2585
2586 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2587 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2588 {
2589 const char * const *entryPtr = NULL;
2590 char **tablePtrSorted;
2591 int i, count = 0;
2592
2593 *indexPtr = -1;
2594 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2595 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2596 *indexPtr = i;
2597 return JIM_OK;
2598 }
2599 count++; /* If nothing matches, this will reach the len of tablePtr */
2600 }
2601 if (flags & JIM_ERRMSG) {
2602 if (name == NULL)
2603 name = "option";
2604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2605 Jim_AppendStrings(interp, Jim_GetResult(interp),
2606 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2607 NULL);
2608 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2609 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2610 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2611 for (i = 0; i < count; i++) {
2612 if (i + 1 == count && count > 1)
2613 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2614 Jim_AppendString(interp, Jim_GetResult(interp),
2615 tablePtrSorted[i], -1);
2616 if (i + 1 != count)
2617 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2618 }
2619 Jim_Free(tablePtrSorted);
2620 }
2621 return JIM_ERR;
2622 }
2623
2624 int Jim_GetNvp(Jim_Interp *interp,
2625 Jim_Obj *objPtr,
2626 const Jim_Nvp *nvp_table,
2627 const Jim_Nvp ** result)
2628 {
2629 Jim_Nvp *n;
2630 int e;
2631
2632 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2633 if (e == JIM_ERR) {
2634 return e;
2635 }
2636
2637 /* Success? found? */
2638 if (n->name) {
2639 /* remove const */
2640 *result = (Jim_Nvp *)n;
2641 return JIM_OK;
2642 } else {
2643 return JIM_ERR;
2644 }
2645 }
2646
2647 /* -----------------------------------------------------------------------------
2648 * Source Object
2649 *
2650 * This object is just a string from the language point of view, but
2651 * in the internal representation it contains the filename and line number
2652 * where this given token was read. This information is used by
2653 * Jim_EvalObj() if the object passed happens to be of type "source".
2654 *
2655 * This allows to propagate the information about line numbers and file
2656 * names and give error messages with absolute line numbers.
2657 *
2658 * Note that this object uses shared strings for filenames, and the
2659 * pointer to the filename together with the line number is taken into
2660 * the space for the "inline" internal represenation of the Jim_Object,
2661 * so there is almost memory zero-overhead.
2662 *
2663 * Also the object will be converted to something else if the given
2664 * token it represents in the source file is not something to be
2665 * evaluated (not a script), and will be specialized in some other way,
2666 * so the time overhead is alzo null.
2667 * ---------------------------------------------------------------------------*/
2668
2669 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2670 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2671
2672 static Jim_ObjType sourceObjType = {
2673 "source",
2674 FreeSourceInternalRep,
2675 DupSourceInternalRep,
2676 NULL,
2677 JIM_TYPE_REFERENCES,
2678 };
2679
2680 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2681 {
2682 Jim_ReleaseSharedString(interp,
2683 objPtr->internalRep.sourceValue.fileName);
2684 }
2685
2686 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2687 {
2688 dupPtr->internalRep.sourceValue.fileName =
2689 Jim_GetSharedString(interp,
2690 srcPtr->internalRep.sourceValue.fileName);
2691 dupPtr->internalRep.sourceValue.lineNumber =
2692 dupPtr->internalRep.sourceValue.lineNumber;
2693 dupPtr->typePtr = &sourceObjType;
2694 }
2695
2696 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2697 const char *fileName, int lineNumber)
2698 {
2699 if (Jim_IsShared(objPtr))
2700 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2701 if (objPtr->typePtr != NULL)
2702 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2703 objPtr->internalRep.sourceValue.fileName =
2704 Jim_GetSharedString(interp, fileName);
2705 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2706 objPtr->typePtr = &sourceObjType;
2707 }
2708
2709 /* -----------------------------------------------------------------------------
2710 * Script Object
2711 * ---------------------------------------------------------------------------*/
2712
2713 #define JIM_CMDSTRUCT_EXPAND -1
2714
2715 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2716 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2717 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2718
2719 static Jim_ObjType scriptObjType = {
2720 "script",
2721 FreeScriptInternalRep,
2722 DupScriptInternalRep,
2723 NULL,
2724 JIM_TYPE_REFERENCES,
2725 };
2726
2727 /* The ScriptToken structure represents every token into a scriptObj.
2728 * Every token contains an associated Jim_Obj that can be specialized
2729 * by commands operating on it. */
2730 typedef struct ScriptToken {
2731 int type;
2732 Jim_Obj *objPtr;
2733 int linenr;
2734 } ScriptToken;
2735
2736 /* This is the script object internal representation. An array of
2737 * ScriptToken structures, with an associated command structure array.
2738 * The command structure is a pre-computed representation of the
2739 * command length and arguments structure as a simple liner array
2740 * of integers.
2741 *
2742 * For example the script:
2743 *
2744 * puts hello
2745 * set $i $x$y [foo]BAR
2746 *
2747 * will produce a ScriptObj with the following Tokens:
2748 *
2749 * ESC puts
2750 * SEP
2751 * ESC hello
2752 * EOL
2753 * ESC set
2754 * EOL
2755 * VAR i
2756 * SEP
2757 * VAR x
2758 * VAR y
2759 * SEP
2760 * CMD foo
2761 * ESC BAR
2762 * EOL
2763 *
2764 * This is a description of the tokens, separators, and of lines.
2765 * The command structure instead represents the number of arguments
2766 * of every command, followed by the tokens of which every argument
2767 * is composed. So for the example script, the cmdstruct array will
2768 * contain:
2769 *
2770 * 2 1 1 4 1 1 2 2
2771 *
2772 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2773 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2774 * composed of single tokens (1 1) and the last two of double tokens
2775 * (2 2).
2776 *
2777 * The precomputation of the command structure makes Jim_Eval() faster,
2778 * and simpler because there aren't dynamic lengths / allocations.
2779 *
2780 * -- {expand} handling --
2781 *
2782 * Expand is handled in a special way. When a command
2783 * contains at least an argument with the {expand} prefix,
2784 * the command structure presents a -1 before the integer
2785 * describing the number of arguments. This is used in order
2786 * to send the command exection to a different path in case
2787 * of {expand} and guarantee a fast path for the more common
2788 * case. Also, the integers describing the number of tokens
2789 * are expressed with negative sign, to allow for fast check
2790 * of what's an {expand}-prefixed argument and what not.
2791 *
2792 * For example the command:
2793 *
2794 * list {expand}{1 2}
2795 *
2796 * Will produce the following cmdstruct array:
2797 *
2798 * -1 2 1 -2
2799 *
2800 * -- the substFlags field of the structure --
2801 *
2802 * The scriptObj structure is used to represent both "script" objects
2803 * and "subst" objects. In the second case, the cmdStruct related
2804 * fields are not used at all, but there is an additional field used
2805 * that is 'substFlags': this represents the flags used to turn
2806 * the string into the intenral representation used to perform the
2807 * substitution. If this flags are not what the application requires
2808 * the scriptObj is created again. For example the script:
2809 *
2810 * subst -nocommands $string
2811 * subst -novariables $string
2812 *
2813 * Will recreate the internal representation of the $string object
2814 * two times.
2815 */
2816 typedef struct ScriptObj {
2817 int len; /* Length as number of tokens. */
2818 int commands; /* number of top-level commands in script. */
2819 ScriptToken *token; /* Tokens array. */
2820 int *cmdStruct; /* commands structure */
2821 int csLen; /* length of the cmdStruct array. */
2822 int substFlags; /* flags used for the compilation of "subst" objects */
2823 int inUse; /* Used to share a ScriptObj. Currently
2824 only used by Jim_EvalObj() as protection against
2825 shimmering of the currently evaluated object. */
2826 char *fileName;
2827 } ScriptObj;
2828
2829 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2830 {
2831 int i;
2832 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2833
2834 if (!script)
2835 return;
2836
2837 script->inUse--;
2838 if (script->inUse != 0) return;
2839 for (i = 0; i < script->len; i++) {
2840 if (script->token[i].objPtr != NULL)
2841 Jim_DecrRefCount(interp, script->token[i].objPtr);
2842 }
2843 Jim_Free(script->token);
2844 Jim_Free(script->cmdStruct);
2845 Jim_Free(script->fileName);
2846 Jim_Free(script);
2847 }
2848
2849 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2850 {
2851 JIM_NOTUSED(interp);
2852 JIM_NOTUSED(srcPtr);
2853
2854 /* Just returns an simple string. */
2855 dupPtr->typePtr = NULL;
2856 }
2857
2858 /* Add a new token to the internal repr of a script object */
2859 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2860 char *strtoken, int len, int type, char *filename, int linenr)
2861 {
2862 int prevtype;
2863 struct ScriptToken *token;
2864
2865 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2866 script->token[script->len-1].type;
2867 /* Skip tokens without meaning, like words separators
2868 * following a word separator or an end of command and
2869 * so on. */
2870 if (prevtype == JIM_TT_EOL) {
2871 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2872 Jim_Free(strtoken);
2873 return;
2874 }
2875 } else if (prevtype == JIM_TT_SEP) {
2876 if (type == JIM_TT_SEP) {
2877 Jim_Free(strtoken);
2878 return;
2879 } else if (type == JIM_TT_EOL) {
2880 /* If an EOL is following by a SEP, drop the previous
2881 * separator. */
2882 script->len--;
2883 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2884 }
2885 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2886 type == JIM_TT_ESC && len == 0)
2887 {
2888 /* Don't add empty tokens used in interpolation */
2889 Jim_Free(strtoken);
2890 return;
2891 }
2892 /* Make space for a new istruction */
2893 script->len++;
2894 script->token = Jim_Realloc(script->token,
2895 sizeof(ScriptToken)*script->len);
2896 /* Initialize the new token */
2897 token = script->token + (script->len-1);
2898 token->type = type;
2899 /* Every object is intially as a string, but the
2900 * internal type may be specialized during execution of the
2901 * script. */
2902 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2903 /* To add source info to SEP and EOL tokens is useless because
2904 * they will never by called as arguments of Jim_EvalObj(). */
2905 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2906 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2907 Jim_IncrRefCount(token->objPtr);
2908 token->linenr = linenr;
2909 }
2910
2911 /* Add an integer into the command structure field of the script object. */
2912 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2913 {
2914 script->csLen++;
2915 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2916 sizeof(int)*script->csLen);
2917 script->cmdStruct[script->csLen-1] = val;
2918 }
2919
2920 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2921 * of objPtr. Search nested script objects recursively. */
2922 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2923 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2924 {
2925 int i;
2926
2927 for (i = 0; i < script->len; i++) {
2928 if (script->token[i].objPtr != objPtr &&
2929 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2930 return script->token[i].objPtr;
2931 }
2932 /* Enter recursively on scripts only if the object
2933 * is not the same as the one we are searching for
2934 * shared occurrences. */
2935 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2936 script->token[i].objPtr != objPtr) {
2937 Jim_Obj *foundObjPtr;
2938
2939 ScriptObj *subScript =
2940 script->token[i].objPtr->internalRep.ptr;
2941 /* Don't recursively enter the script we are trying
2942 * to make shared to avoid circular references. */
2943 if (subScript == scriptBarrier) continue;
2944 if (subScript != script) {
2945 foundObjPtr =
2946 ScriptSearchLiteral(interp, subScript,
2947 scriptBarrier, objPtr);
2948 if (foundObjPtr != NULL)
2949 return foundObjPtr;
2950 }
2951 }
2952 }
2953 return NULL;
2954 }
2955
2956 /* Share literals of a script recursively sharing sub-scripts literals. */
2957 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2958 ScriptObj *topLevelScript)
2959 {
2960 int i, j;
2961
2962 return;
2963 /* Try to share with toplevel object. */
2964 if (topLevelScript != NULL) {
2965 for (i = 0; i < script->len; i++) {
2966 Jim_Obj *foundObjPtr;
2967 char *str = script->token[i].objPtr->bytes;
2968
2969 if (script->token[i].objPtr->refCount != 1) continue;
2970 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2971 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2972 foundObjPtr = ScriptSearchLiteral(interp,
2973 topLevelScript,
2974 script, /* barrier */
2975 script->token[i].objPtr);
2976 if (foundObjPtr != NULL) {
2977 Jim_IncrRefCount(foundObjPtr);
2978 Jim_DecrRefCount(interp,
2979 script->token[i].objPtr);
2980 script->token[i].objPtr = foundObjPtr;
2981 }
2982 }
2983 }
2984 /* Try to share locally */
2985 for (i = 0; i < script->len; i++) {
2986 char *str = script->token[i].objPtr->bytes;
2987
2988 if (script->token[i].objPtr->refCount != 1) continue;
2989 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2990 for (j = 0; j < script->len; j++) {
2991 if (script->token[i].objPtr !=
2992 script->token[j].objPtr &&
2993 Jim_StringEqObj(script->token[i].objPtr,
2994 script->token[j].objPtr, 0))
2995 {
2996 Jim_IncrRefCount(script->token[j].objPtr);
2997 Jim_DecrRefCount(interp,
2998 script->token[i].objPtr);
2999 script->token[i].objPtr =
3000 script->token[j].objPtr;
3001 }
3002 }
3003 }
3004 }
3005
3006 /* This method takes the string representation of an object
3007 * as a Tcl script, and generates the pre-parsed internal representation
3008 * of the script. */
3009 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3010 {
3011 int scriptTextLen;
3012 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3013 struct JimParserCtx parser;
3014 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3015 ScriptToken *token;
3016 int args, tokens, start, end, i;
3017 int initialLineNumber;
3018 int propagateSourceInfo = 0;
3019
3020 script->len = 0;
3021 script->csLen = 0;
3022 script->commands = 0;
3023 script->token = NULL;
3024 script->cmdStruct = NULL;
3025 script->inUse = 1;
3026 /* Try to get information about filename / line number */
3027 if (objPtr->typePtr == &sourceObjType) {
3028 script->fileName =
3029 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3030 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3031 propagateSourceInfo = 1;
3032 } else {
3033 script->fileName = Jim_StrDup("");
3034 initialLineNumber = 1;
3035 }
3036
3037 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3038 while (!JimParserEof(&parser)) {
3039 char *token;
3040 int len, type, linenr;
3041
3042 JimParseScript(&parser);
3043 token = JimParserGetToken(&parser, &len, &type, &linenr);
3044 ScriptObjAddToken(interp, script, token, len, type,
3045 propagateSourceInfo ? script->fileName : NULL,
3046 linenr);
3047 }
3048 token = script->token;
3049
3050 /* Compute the command structure array
3051 * (see the ScriptObj struct definition for more info) */
3052 start = 0; /* Current command start token index */
3053 end = -1; /* Current command end token index */
3054 while (1) {
3055 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3056 int interpolation = 0; /* set to 1 if there is at least one
3057 argument of the command obtained via
3058 interpolation of more tokens. */
3059 /* Search for the end of command, while
3060 * count the number of args. */
3061 start = ++end;
3062 if (start >= script->len) break;
3063 args = 1; /* Number of args in current command */
3064 while (token[end].type != JIM_TT_EOL) {
3065 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3066 token[end-1].type == JIM_TT_EOL)
3067 {
3068 if (token[end].type == JIM_TT_STR &&
3069 token[end + 1].type != JIM_TT_SEP &&
3070 token[end + 1].type != JIM_TT_EOL &&
3071 (!strcmp(token[end].objPtr->bytes, "expand") ||
3072 !strcmp(token[end].objPtr->bytes, "*")))
3073 expand++;
3074 }
3075 if (token[end].type == JIM_TT_SEP)
3076 args++;
3077 end++;
3078 }
3079 interpolation = !((end-start + 1) == args*2);
3080 /* Add the 'number of arguments' info into cmdstruct.
3081 * Negative value if there is list expansion involved. */
3082 if (expand)
3083 ScriptObjAddInt(script, -1);
3084 ScriptObjAddInt(script, args);
3085 /* Now add info about the number of tokens. */
3086 tokens = 0; /* Number of tokens in current argument. */
3087 expand = 0;
3088 for (i = start; i <= end; i++) {
3089 if (token[i].type == JIM_TT_SEP ||
3090 token[i].type == JIM_TT_EOL)
3091 {
3092 if (tokens == 1 && expand)
3093 expand = 0;
3094 ScriptObjAddInt(script,
3095 expand ? -tokens : tokens);
3096
3097 expand = 0;
3098 tokens = 0;
3099 continue;
3100 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3101 (!strcmp(token[i].objPtr->bytes, "expand") ||
3102 !strcmp(token[i].objPtr->bytes, "*")))
3103 {
3104 expand++;
3105 }
3106 tokens++;
3107 }
3108 }
3109 /* Perform literal sharing, but only for objects that appear
3110 * to be scripts written as literals inside the source code,
3111 * and not computed at runtime. Literal sharing is a costly
3112 * operation that should be done only against objects that
3113 * are likely to require compilation only the first time, and
3114 * then are executed multiple times. */
3115 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3116 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3117 if (bodyObjPtr->typePtr == &scriptObjType) {
3118 ScriptObj *bodyScript =
3119 bodyObjPtr->internalRep.ptr;
3120 ScriptShareLiterals(interp, script, bodyScript);
3121 }
3122 } else if (propagateSourceInfo) {
3123 ScriptShareLiterals(interp, script, NULL);
3124 }
3125 /* Free the old internal rep and set the new one. */
3126 Jim_FreeIntRep(interp, objPtr);
3127 Jim_SetIntRepPtr(objPtr, script);
3128 objPtr->typePtr = &scriptObjType;
3129 return JIM_OK;
3130 }
3131
3132 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3133 {
3134 if (objPtr->typePtr != &scriptObjType) {
3135 SetScriptFromAny(interp, objPtr);
3136 }
3137 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3138 }
3139
3140 /* -----------------------------------------------------------------------------
3141 * Commands
3142 * ---------------------------------------------------------------------------*/
3143
3144 /* Commands HashTable Type.
3145 *
3146 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3147 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3148 {
3149 Jim_Cmd *cmdPtr = (void*) val;
3150
3151 if (cmdPtr->cmdProc == NULL) {
3152 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3153 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3154 if (cmdPtr->staticVars) {
3155 Jim_FreeHashTable(cmdPtr->staticVars);
3156 Jim_Free(cmdPtr->staticVars);
3157 }
3158 } else if (cmdPtr->delProc != NULL) {
3159 /* If it was a C coded command, call the delProc if any */
3160 cmdPtr->delProc(interp, cmdPtr->privData);
3161 }
3162 Jim_Free(val);
3163 }
3164
3165 static Jim_HashTableType JimCommandsHashTableType = {
3166 JimStringCopyHTHashFunction, /* hash function */
3167 JimStringCopyHTKeyDup, /* key dup */
3168 NULL, /* val dup */
3169 JimStringCopyHTKeyCompare, /* key compare */
3170 JimStringCopyHTKeyDestructor, /* key destructor */
3171 Jim_CommandsHT_ValDestructor /* val destructor */
3172 };
3173
3174 /* ------------------------- Commands related functions --------------------- */
3175
3176 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3177 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3178 {
3179 Jim_HashEntry *he;
3180 Jim_Cmd *cmdPtr;
3181
3182 he = Jim_FindHashEntry(&interp->commands, cmdName);
3183 if (he == NULL) { /* New command to create */
3184 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3185 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3186 } else {
3187 Jim_InterpIncrProcEpoch(interp);
3188 /* Free the arglist/body objects if it was a Tcl procedure */
3189 cmdPtr = he->val;
3190 if (cmdPtr->cmdProc == NULL) {
3191 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3192 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3193 if (cmdPtr->staticVars) {
3194 Jim_FreeHashTable(cmdPtr->staticVars);
3195 Jim_Free(cmdPtr->staticVars);
3196 }
3197 cmdPtr->staticVars = NULL;
3198 } else if (cmdPtr->delProc != NULL) {
3199 /* If it was a C coded command, call the delProc if any */
3200 cmdPtr->delProc(interp, cmdPtr->privData);
3201 }
3202 }
3203
3204 /* Store the new details for this proc */
3205 cmdPtr->delProc = delProc;
3206 cmdPtr->cmdProc = cmdProc;
3207 cmdPtr->privData = privData;
3208
3209 /* There is no need to increment the 'proc epoch' because
3210 * creation of a new procedure can never affect existing
3211 * cached commands. We don't do negative caching. */
3212 return JIM_OK;
3213 }
3214
3215 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3216 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3217 int arityMin, int arityMax)
3218 {
3219 Jim_Cmd *cmdPtr;
3220
3221 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3222 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3223 cmdPtr->argListObjPtr = argListObjPtr;
3224 cmdPtr->bodyObjPtr = bodyObjPtr;
3225 Jim_IncrRefCount(argListObjPtr);
3226 Jim_IncrRefCount(bodyObjPtr);
3227 cmdPtr->arityMin = arityMin;
3228 cmdPtr->arityMax = arityMax;
3229 cmdPtr->staticVars = NULL;
3230
3231 /* Create the statics hash table. */
3232 if (staticsListObjPtr) {
3233 int len, i;
3234
3235 Jim_ListLength(interp, staticsListObjPtr, &len);
3236 if (len != 0) {
3237 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3238 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3239 interp);
3240 for (i = 0; i < len; i++) {
3241 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3242 Jim_Var *varPtr;
3243 int subLen;
3244
3245 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3246 /* Check if it's composed of two elements. */
3247 Jim_ListLength(interp, objPtr, &subLen);
3248 if (subLen == 1 || subLen == 2) {
3249 /* Try to get the variable value from the current
3250 * environment. */
3251 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3252 if (subLen == 1) {
3253 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3254 JIM_NONE);
3255 if (initObjPtr == NULL) {
3256 Jim_SetResult(interp,
3257 Jim_NewEmptyStringObj(interp));
3258 Jim_AppendStrings(interp, Jim_GetResult(interp),
3259 "variable for initialization of static \"",
3260 Jim_GetString(nameObjPtr, NULL),
3261 "\" not found in the local context",
3262 NULL);
3263 goto err;
3264 }
3265 } else {
3266 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3267 }
3268 varPtr = Jim_Alloc(sizeof(*varPtr));
3269 varPtr->objPtr = initObjPtr;
3270 Jim_IncrRefCount(initObjPtr);
3271 varPtr->linkFramePtr = NULL;
3272 if (Jim_AddHashEntry(cmdPtr->staticVars,
3273 Jim_GetString(nameObjPtr, NULL),
3274 varPtr) != JIM_OK)
3275 {
3276 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3277 Jim_AppendStrings(interp, Jim_GetResult(interp),
3278 "static variable name \"",
3279 Jim_GetString(objPtr, NULL), "\"",
3280 " duplicated in statics list", NULL);
3281 Jim_DecrRefCount(interp, initObjPtr);
3282 Jim_Free(varPtr);
3283 goto err;
3284 }
3285 } else {
3286 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3287 Jim_AppendStrings(interp, Jim_GetResult(interp),
3288 "too many fields in static specifier \"",
3289 objPtr, "\"", NULL);
3290 goto err;
3291 }
3292 }
3293 }
3294 }
3295
3296 /* Add the new command */
3297
3298 /* it may already exist, so we try to delete the old one */
3299 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3300 /* There was an old procedure with the same name, this requires
3301 * a 'proc epoch' update. */
3302 Jim_InterpIncrProcEpoch(interp);
3303 }
3304 /* If a procedure with the same name didn't existed there is no need
3305 * to increment the 'proc epoch' because creation of a new procedure
3306 * can never affect existing cached commands. We don't do
3307 * negative caching. */
3308 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3309 return JIM_OK;
3310
3311 err:
3312 Jim_FreeHashTable(cmdPtr->staticVars);
3313 Jim_Free(cmdPtr->staticVars);
3314 Jim_DecrRefCount(interp, argListObjPtr);
3315 Jim_DecrRefCount(interp, bodyObjPtr);
3316 Jim_Free(cmdPtr);
3317 return JIM_ERR;
3318 }
3319
3320 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3321 {
3322 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3323 return JIM_ERR;
3324 Jim_InterpIncrProcEpoch(interp);
3325 return JIM_OK;
3326 }
3327
3328 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3329 const char *newName)
3330 {
3331 Jim_Cmd *cmdPtr;
3332 Jim_HashEntry *he;
3333 Jim_Cmd *copyCmdPtr;
3334
3335 if (newName[0] == '\0') /* Delete! */
3336 return Jim_DeleteCommand(interp, oldName);
3337 /* Rename */
3338 he = Jim_FindHashEntry(&interp->commands, oldName);
3339 if (he == NULL)
3340 return JIM_ERR; /* Invalid command name */
3341 cmdPtr = he->val;
3342 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3343 *copyCmdPtr = *cmdPtr;
3344 /* In order to avoid that a procedure will get arglist/body/statics
3345 * freed by the hash table methods, fake a C-coded command
3346 * setting cmdPtr->cmdProc as not NULL */
3347 cmdPtr->cmdProc = (void*)1;
3348 /* Also make sure delProc is NULL. */
3349 cmdPtr->delProc = NULL;
3350 /* Destroy the old command, and make sure the new is freed
3351 * as well. */
3352 Jim_DeleteHashEntry(&interp->commands, oldName);
3353 Jim_DeleteHashEntry(&interp->commands, newName);
3354 /* Now the new command. We are sure it can't fail because
3355 * the target name was already freed. */
3356 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3357 /* Increment the epoch */
3358 Jim_InterpIncrProcEpoch(interp);
3359 return JIM_OK;
3360 }
3361
3362 /* -----------------------------------------------------------------------------
3363 * Command object
3364 * ---------------------------------------------------------------------------*/
3365
3366 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3367
3368 static Jim_ObjType commandObjType = {
3369 "command",
3370 NULL,
3371 NULL,
3372 NULL,
3373 JIM_TYPE_REFERENCES,
3374 };
3375
3376 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3377 {
3378 Jim_HashEntry *he;
3379 const char *cmdName;
3380
3381 /* Get the string representation */
3382 cmdName = Jim_GetString(objPtr, NULL);
3383 /* Lookup this name into the commands hash table */
3384 he = Jim_FindHashEntry(&interp->commands, cmdName);
3385 if (he == NULL)
3386 return JIM_ERR;
3387
3388 /* Free the old internal repr and set the new one. */
3389 Jim_FreeIntRep(interp, objPtr);
3390 objPtr->typePtr = &commandObjType;
3391 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3392 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3393 return JIM_OK;
3394 }
3395
3396 /* This function returns the command structure for the command name
3397 * stored in objPtr. It tries to specialize the objPtr to contain
3398 * a cached info instead to perform the lookup into the hash table
3399 * every time. The information cached may not be uptodate, in such
3400 * a case the lookup is performed and the cache updated. */
3401 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3402 {
3403 if ((objPtr->typePtr != &commandObjType ||
3404 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3405 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3406 if (flags & JIM_ERRMSG) {
3407 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3408 Jim_AppendStrings(interp, Jim_GetResult(interp),
3409 "invalid command name \"", objPtr->bytes, "\"",
3410 NULL);
3411 }
3412 return NULL;
3413 }
3414 return objPtr->internalRep.cmdValue.cmdPtr;
3415 }
3416
3417 /* -----------------------------------------------------------------------------
3418 * Variables
3419 * ---------------------------------------------------------------------------*/
3420
3421 /* Variables HashTable Type.
3422 *
3423 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3424 static void JimVariablesHTValDestructor(void *interp, void *val)
3425 {
3426 Jim_Var *varPtr = (void*) val;
3427
3428 Jim_DecrRefCount(interp, varPtr->objPtr);
3429 Jim_Free(val);
3430 }
3431
3432 static Jim_HashTableType JimVariablesHashTableType = {
3433 JimStringCopyHTHashFunction, /* hash function */
3434 JimStringCopyHTKeyDup, /* key dup */
3435 NULL, /* val dup */
3436 JimStringCopyHTKeyCompare, /* key compare */
3437 JimStringCopyHTKeyDestructor, /* key destructor */
3438 JimVariablesHTValDestructor /* val destructor */
3439 };
3440
3441 static Jim_HashTableType *getJimVariablesHashTableType(void)
3442 {
3443 return &JimVariablesHashTableType;
3444 }
3445
3446 /* -----------------------------------------------------------------------------
3447 * Variable object
3448 * ---------------------------------------------------------------------------*/
3449
3450 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3451
3452 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3453
3454 static Jim_ObjType variableObjType = {
3455 "variable",
3456 NULL,
3457 NULL,
3458 NULL,
3459 JIM_TYPE_REFERENCES,
3460 };
3461
3462 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3463 * is in the form "varname(key)". */
3464 static int Jim_NameIsDictSugar(const char *str, int len)
3465 {
3466 if (len == -1)
3467 len = strlen(str);
3468 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3469 return 1;
3470 return 0;
3471 }
3472
3473 /* This method should be called only by the variable API.
3474 * It returns JIM_OK on success (variable already exists),
3475 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3476 * a variable name, but syntax glue for [dict] i.e. the last
3477 * character is ')' */
3478 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3479 {
3480 Jim_HashEntry *he;
3481 const char *varName;
3482 int len;
3483
3484 /* Check if the object is already an uptodate variable */
3485 if (objPtr->typePtr == &variableObjType &&
3486 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3487 return JIM_OK; /* nothing to do */
3488 /* Get the string representation */
3489 varName = Jim_GetString(objPtr, &len);
3490 /* Make sure it's not syntax glue to get/set dict. */
3491 if (Jim_NameIsDictSugar(varName, len))
3492 return JIM_DICT_SUGAR;
3493 if (varName[0] == ':' && varName[1] == ':') {
3494 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3495 if (he == NULL) {
3496 return JIM_ERR;
3497 }
3498 }
3499 else {
3500 /* Lookup this name into the variables hash table */
3501 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3502 if (he == NULL) {
3503 /* Try with static vars. */
3504 if (interp->framePtr->staticVars == NULL)
3505 return JIM_ERR;
3506 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3507 return JIM_ERR;
3508 }
3509 }
3510 /* Free the old internal repr and set the new one. */
3511 Jim_FreeIntRep(interp, objPtr);
3512 objPtr->typePtr = &variableObjType;
3513 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3514 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3515 return JIM_OK;
3516 }
3517
3518 /* -------------------- Variables related functions ------------------------- */
3519 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3520 Jim_Obj *valObjPtr);
3521 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3522
3523 /* For now that's dummy. Variables lookup should be optimized
3524 * in many ways, with caching of lookups, and possibly with
3525 * a table of pre-allocated vars in every CallFrame for local vars.
3526 * All the caching should also have an 'epoch' mechanism similar
3527 * to the one used by Tcl for procedures lookup caching. */
3528
3529 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3530 {
3531 const char *name;
3532 Jim_Var *var;
3533 int err;
3534
3535 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3536 /* Check for [dict] syntax sugar. */
3537 if (err == JIM_DICT_SUGAR)
3538 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3539 /* New variable to create */
3540 name = Jim_GetString(nameObjPtr, NULL);
3541
3542 var = Jim_Alloc(sizeof(*var));
3543 var->objPtr = valObjPtr;
3544 Jim_IncrRefCount(valObjPtr);
3545 var->linkFramePtr = NULL;
3546 /* Insert the new variable */
3547 if (name[0] == ':' && name[1] == ':') {
3548 /* Into to the top evel frame */
3549 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3550 }
3551 else {
3552 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3553 }
3554 /* Make the object int rep a variable */
3555 Jim_FreeIntRep(interp, nameObjPtr);
3556 nameObjPtr->typePtr = &variableObjType;
3557 nameObjPtr->internalRep.varValue.callFrameId =
3558 interp->framePtr->id;
3559 nameObjPtr->internalRep.varValue.varPtr = var;
3560 } else {
3561 var = nameObjPtr->internalRep.varValue.varPtr;
3562 if (var->linkFramePtr == NULL) {
3563 Jim_IncrRefCount(valObjPtr);
3564 Jim_DecrRefCount(interp, var->objPtr);
3565 var->objPtr = valObjPtr;
3566 } else { /* Else handle the link */
3567 Jim_CallFrame *savedCallFrame;
3568
3569 savedCallFrame = interp->framePtr;
3570 interp->framePtr = var->linkFramePtr;
3571 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3572 interp->framePtr = savedCallFrame;
3573 if (err != JIM_OK)
3574 return err;
3575 }
3576 }
3577 return JIM_OK;
3578 }
3579
3580 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3581 {
3582 Jim_Obj *nameObjPtr;
3583 int result;
3584
3585 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3586 Jim_IncrRefCount(nameObjPtr);
3587 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3588 Jim_DecrRefCount(interp, nameObjPtr);
3589 return result;
3590 }
3591
3592 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3593 {
3594 Jim_CallFrame *savedFramePtr;
3595 int result;
3596
3597 savedFramePtr = interp->framePtr;
3598 interp->framePtr = interp->topFramePtr;
3599 result = Jim_SetVariableStr(interp, name, objPtr);
3600 interp->framePtr = savedFramePtr;
3601 return result;
3602 }
3603
3604 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3605 {
3606 Jim_Obj *nameObjPtr, *valObjPtr;
3607 int result;
3608
3609 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3610 valObjPtr = Jim_NewStringObj(interp, val, -1);
3611 Jim_IncrRefCount(nameObjPtr);
3612 Jim_IncrRefCount(valObjPtr);
3613 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3614 Jim_DecrRefCount(interp, nameObjPtr);
3615 Jim_DecrRefCount(interp, valObjPtr);
3616 return result;
3617 }
3618
3619 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3620 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3621 {
3622 const char *varName;
3623 int len;
3624
3625 /* Check for cycles. */
3626 if (interp->framePtr == targetCallFrame) {
3627 Jim_Obj *objPtr = targetNameObjPtr;
3628 Jim_Var *varPtr;
3629 /* Cycles are only possible with 'uplevel 0' */
3630 while (1) {
3631 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3632 Jim_SetResultString(interp,
3633 "can't upvar from variable to itself", -1);
3634 return JIM_ERR;
3635 }
3636 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3637 break;
3638 varPtr = objPtr->internalRep.varValue.varPtr;
3639 if (varPtr->linkFramePtr != targetCallFrame) break;
3640 objPtr = varPtr->objPtr;
3641 }
3642 }
3643 varName = Jim_GetString(nameObjPtr, &len);
3644 if (Jim_NameIsDictSugar(varName, len)) {
3645 Jim_SetResultString(interp,
3646 "Dict key syntax invalid as link source", -1);
3647 return JIM_ERR;
3648 }
3649 /* Perform the binding */
3650 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3651 /* We are now sure 'nameObjPtr' type is variableObjType */
3652 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3653 return JIM_OK;
3654 }
3655
3656 /* Return the Jim_Obj pointer associated with a variable name,
3657 * or NULL if the variable was not found in the current context.
3658 * The same optimization discussed in the comment to the
3659 * 'SetVariable' function should apply here. */
3660 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3661 {
3662 int err;
3663
3664 /* All the rest is handled here */
3665 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3666 /* Check for [dict] syntax sugar. */
3667 if (err == JIM_DICT_SUGAR)
3668 return JimDictSugarGet(interp, nameObjPtr);
3669 if (flags & JIM_ERRMSG) {
3670 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3671 Jim_AppendStrings(interp, Jim_GetResult(interp),
3672 "can't read \"", nameObjPtr->bytes,
3673 "\": no such variable", NULL);
3674 }
3675 return NULL;
3676 } else {
3677 Jim_Var *varPtr;
3678 Jim_Obj *objPtr;
3679 Jim_CallFrame *savedCallFrame;
3680
3681 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3682 if (varPtr->linkFramePtr == NULL)
3683 return varPtr->objPtr;
3684 /* The variable is a link? Resolve it. */
3685 savedCallFrame = interp->framePtr;
3686 interp->framePtr = varPtr->linkFramePtr;
3687 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3688 if (objPtr == NULL && flags & JIM_ERRMSG) {
3689 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3690 Jim_AppendStrings(interp, Jim_GetResult(interp),
3691 "can't read \"", nameObjPtr->bytes,
3692 "\": no such variable", NULL);
3693 }
3694 interp->framePtr = savedCallFrame;
3695 return objPtr;
3696 }
3697 }
3698
3699 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3700 int flags)
3701 {
3702 Jim_CallFrame *savedFramePtr;
3703 Jim_Obj *objPtr;
3704
3705 savedFramePtr = interp->framePtr;
3706 interp->framePtr = interp->topFramePtr;
3707 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3708 interp->framePtr = savedFramePtr;
3709
3710 return objPtr;
3711 }
3712
3713 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3714 {
3715 Jim_Obj *nameObjPtr, *varObjPtr;
3716
3717 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3718 Jim_IncrRefCount(nameObjPtr);
3719 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3720 Jim_DecrRefCount(interp, nameObjPtr);
3721 return varObjPtr;
3722 }
3723
3724 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3725 int flags)
3726 {
3727 Jim_CallFrame *savedFramePtr;
3728 Jim_Obj *objPtr;
3729
3730 savedFramePtr = interp->framePtr;
3731 interp->framePtr = interp->topFramePtr;
3732 objPtr = Jim_GetVariableStr(interp, name, flags);
3733 interp->framePtr = savedFramePtr;
3734
3735 return objPtr;
3736 }
3737
3738 /* Unset a variable.
3739 * Note: On success unset invalidates all the variable objects created
3740 * in the current call frame incrementing. */
3741 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3742 {
3743 const char *name;
3744 Jim_Var *varPtr;
3745 int err;
3746
3747 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3748 /* Check for [dict] syntax sugar. */
3749 if (err == JIM_DICT_SUGAR)
3750 return JimDictSugarSet(interp, nameObjPtr, NULL);
3751 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3752 Jim_AppendStrings(interp, Jim_GetResult(interp),
3753 "can't unset \"", nameObjPtr->bytes,
3754 "\": no such variable", NULL);
3755 return JIM_ERR; /* var not found */
3756 }
3757 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3758 /* If it's a link call UnsetVariable recursively */
3759 if (varPtr->linkFramePtr) {
3760 int retval;
3761
3762 Jim_CallFrame *savedCallFrame;
3763
3764 savedCallFrame = interp->framePtr;
3765 interp->framePtr = varPtr->linkFramePtr;
3766 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3767 interp->framePtr = savedCallFrame;
3768 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3769 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3770 Jim_AppendStrings(interp, Jim_GetResult(interp),
3771 "can't unset \"", nameObjPtr->bytes,
3772 "\": no such variable", NULL);
3773 }
3774 return retval;
3775 } else {
3776 name = Jim_GetString(nameObjPtr, NULL);
3777 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3778 != JIM_OK) return JIM_ERR;
3779 /* Change the callframe id, invalidating var lookup caching */
3780 JimChangeCallFrameId(interp, interp->framePtr);
3781 return JIM_OK;
3782 }
3783 }
3784
3785 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3786
3787 /* Given a variable name for [dict] operation syntax sugar,
3788 * this function returns two objects, the first with the name
3789 * of the variable to set, and the second with the rispective key.
3790 * For example "foo(bar)" will return objects with string repr. of
3791 * "foo" and "bar".
3792 *
3793 * The returned objects have refcount = 1. The function can't fail. */
3794 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3795 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3796 {
3797 const char *str, *p;
3798 char *t;
3799 int len, keyLen, nameLen;
3800 Jim_Obj *varObjPtr, *keyObjPtr;
3801
3802 str = Jim_GetString(objPtr, &len);
3803 p = strchr(str, '(');
3804 p++;
3805 keyLen = len-((p-str) + 1);
3806 nameLen = (p-str)-1;
3807 /* Create the objects with the variable name and key. */
3808 t = Jim_Alloc(nameLen + 1);
3809 memcpy(t, str, nameLen);
3810 t[nameLen] = '\0';
3811 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3812
3813 t = Jim_Alloc(keyLen + 1);
3814 memcpy(t, p, keyLen);
3815 t[keyLen] = '\0';
3816 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3817
3818 Jim_IncrRefCount(varObjPtr);
3819 Jim_IncrRefCount(keyObjPtr);
3820 *varPtrPtr = varObjPtr;
3821 *keyPtrPtr = keyObjPtr;
3822 }
3823
3824 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3825 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3826 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3827 Jim_Obj *valObjPtr)
3828 {
3829 Jim_Obj *varObjPtr, *keyObjPtr;
3830 int err = JIM_OK;
3831
3832 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3833 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3834 valObjPtr);
3835 Jim_DecrRefCount(interp, varObjPtr);
3836 Jim_DecrRefCount(interp, keyObjPtr);
3837 return err;
3838 }
3839
3840 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3841 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3842 {
3843 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3844
3845 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3846 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3847 if (!dictObjPtr) {
3848 resObjPtr = NULL;
3849 goto err;
3850 }
3851 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3852 != JIM_OK) {
3853 resObjPtr = NULL;
3854 }
3855 err:
3856 Jim_DecrRefCount(interp, varObjPtr);
3857 Jim_DecrRefCount(interp, keyObjPtr);
3858 return resObjPtr;
3859 }
3860
3861 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3862
3863 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3864 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3865 Jim_Obj *dupPtr);
3866
3867 static Jim_ObjType dictSubstObjType = {
3868 "dict-substitution",
3869 FreeDictSubstInternalRep,
3870 DupDictSubstInternalRep,
3871 NULL,
3872 JIM_TYPE_NONE,
3873 };
3874
3875 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3876 {
3877 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3878 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3879 }
3880
3881 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3882 Jim_Obj *dupPtr)
3883 {
3884 JIM_NOTUSED(interp);
3885
3886 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3887 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3888 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3889 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3890 dupPtr->typePtr = &dictSubstObjType;
3891 }
3892
3893 /* This function is used to expand [dict get] sugar in the form
3894 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3895 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3896 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3897 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3898 * the [dict]ionary contained in variable VARNAME. */
3899 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3900 {
3901 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3902 Jim_Obj *substKeyObjPtr = NULL;
3903
3904 if (objPtr->typePtr != &dictSubstObjType) {
3905 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3906 Jim_FreeIntRep(interp, objPtr);
3907 objPtr->typePtr = &dictSubstObjType;
3908 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3909 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3910 }
3911 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3912 &substKeyObjPtr, JIM_NONE)
3913 != JIM_OK) {
3914 substKeyObjPtr = NULL;
3915 goto err;
3916 }
3917 Jim_IncrRefCount(substKeyObjPtr);
3918 dictObjPtr = Jim_GetVariable(interp,
3919 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3920 if (!dictObjPtr) {
3921 resObjPtr = NULL;
3922 goto err;
3923 }
3924 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3925 != JIM_OK) {
3926 resObjPtr = NULL;
3927 goto err;
3928 }
3929 err:
3930 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3931 return resObjPtr;
3932 }
3933
3934 /* -----------------------------------------------------------------------------
3935 * CallFrame
3936 * ---------------------------------------------------------------------------*/
3937
3938 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3939 {
3940 Jim_CallFrame *cf;
3941 if (interp->freeFramesList) {
3942 cf = interp->freeFramesList;
3943 interp->freeFramesList = cf->nextFramePtr;
3944 } else {
3945 cf = Jim_Alloc(sizeof(*cf));
3946 cf->vars.table = NULL;
3947 }
3948
3949 cf->id = interp->callFrameEpoch++;
3950 cf->parentCallFrame = NULL;
3951 cf->argv = NULL;
3952 cf->argc = 0;
3953 cf->procArgsObjPtr = NULL;
3954 cf->procBodyObjPtr = NULL;
3955 cf->nextFramePtr = NULL;
3956 cf->staticVars = NULL;
3957 if (cf->vars.table == NULL)
3958 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3959 return cf;
3960 }
3961
3962 /* Used to invalidate every caching related to callframe stability. */
3963 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3964 {
3965 cf->id = interp->callFrameEpoch++;
3966 }
3967
3968 #define JIM_FCF_NONE 0 /* no flags */
3969 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3970 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3971 int flags)
3972 {
3973 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3974 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3975 if (!(flags & JIM_FCF_NOHT))
3976 Jim_FreeHashTable(&cf->vars);
3977 else {
3978 int i;
3979 Jim_HashEntry **table = cf->vars.table, *he;
3980
3981 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3982 he = table[i];
3983 while (he != NULL) {
3984 Jim_HashEntry *nextEntry = he->next;
3985 Jim_Var *varPtr = (void*) he->val;
3986
3987 Jim_DecrRefCount(interp, varPtr->objPtr);
3988 Jim_Free(he->val);
3989 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3990 Jim_Free(he);
3991 table[i] = NULL;
3992 he = nextEntry;
3993 }
3994 }
3995 cf->vars.used = 0;
3996 }
3997 cf->nextFramePtr = interp->freeFramesList;
3998 interp->freeFramesList = cf;
3999 }
4000
4001 /* -----------------------------------------------------------------------------
4002 * References
4003 * ---------------------------------------------------------------------------*/
4004
4005 /* References HashTable Type.
4006 *
4007 * Keys are jim_wide integers, dynamically allocated for now but in the
4008 * future it's worth to cache this 8 bytes objects. Values are poitners
4009 * to Jim_References. */
4010 static void JimReferencesHTValDestructor(void *interp, void *val)
4011 {
4012 Jim_Reference *refPtr = (void*) val;
4013
4014 Jim_DecrRefCount(interp, refPtr->objPtr);
4015 if (refPtr->finalizerCmdNamePtr != NULL) {
4016 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4017 }
4018 Jim_Free(val);
4019 }
4020
4021 unsigned int JimReferencesHTHashFunction(const void *key)
4022 {
4023 /* Only the least significant bits are used. */
4024 const jim_wide *widePtr = key;
4025 unsigned int intValue = (unsigned int) *widePtr;
4026 return Jim_IntHashFunction(intValue);
4027 }
4028
4029 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4030 {
4031 /* Only the least significant bits are used. */
4032 const jim_wide *widePtr = key;
4033 unsigned int intValue = (unsigned int) *widePtr;
4034 return intValue; /* identity function. */
4035 }
4036
4037 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4038 {
4039 void *copy = Jim_Alloc(sizeof(jim_wide));
4040 JIM_NOTUSED(privdata);
4041
4042 memcpy(copy, key, sizeof(jim_wide));
4043 return copy;
4044 }
4045
4046 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4047 const void *key2)
4048 {
4049 JIM_NOTUSED(privdata);
4050
4051 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4052 }
4053
4054 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4055 {
4056 JIM_NOTUSED(privdata);
4057
4058 Jim_Free((void*)key);
4059 }
4060
4061 static Jim_HashTableType JimReferencesHashTableType = {
4062 JimReferencesHTHashFunction, /* hash function */
4063 JimReferencesHTKeyDup, /* key dup */
4064 NULL, /* val dup */
4065 JimReferencesHTKeyCompare, /* key compare */
4066 JimReferencesHTKeyDestructor, /* key destructor */
4067 JimReferencesHTValDestructor /* val destructor */
4068 };
4069
4070 /* -----------------------------------------------------------------------------
4071 * Reference object type and References API
4072 * ---------------------------------------------------------------------------*/
4073
4074 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4075
4076 static Jim_ObjType referenceObjType = {
4077 "reference",
4078 NULL,
4079 NULL,
4080 UpdateStringOfReference,
4081 JIM_TYPE_REFERENCES,
4082 };
4083
4084 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4085 {
4086 int len;
4087 char buf[JIM_REFERENCE_SPACE + 1];
4088 Jim_Reference *refPtr;
4089
4090 refPtr = objPtr->internalRep.refValue.refPtr;
4091 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4092 objPtr->bytes = Jim_Alloc(len + 1);
4093 memcpy(objPtr->bytes, buf, len + 1);
4094 objPtr->length = len;
4095 }
4096
4097 /* returns true if 'c' is a valid reference tag character.
4098 * i.e. inside the range [_a-zA-Z0-9] */
4099 static int isrefchar(int c)
4100 {
4101 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4102 (c >= '0' && c <= '9')) return 1;
4103 return 0;
4104 }
4105
4106 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4107 {
4108 jim_wide wideValue;
4109 int i, len;
4110 const char *str, *start, *end;
4111 char refId[21];
4112 Jim_Reference *refPtr;
4113 Jim_HashEntry *he;
4114
4115 /* Get the string representation */
4116 str = Jim_GetString(objPtr, &len);
4117 /* Check if it looks like a reference */
4118 if (len < JIM_REFERENCE_SPACE) goto badformat;
4119 /* Trim spaces */
4120 start = str;
4121 end = str + len-1;
4122 while (*start == ' ') start++;
4123 while (*end == ' ' && end > start) end--;
4124 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4125 /* <reference.<1234567>.%020> */
4126 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4127 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4128 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4129 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4130 if (!isrefchar(start[12 + i])) goto badformat;
4131 }
4132 /* Extract info from the refernece. */
4133 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4134 refId[20] = '\0';
4135 /* Try to convert the ID into a jim_wide */
4136 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4137 /* Check if the reference really exists! */
4138 he = Jim_FindHashEntry(&interp->references, &wideValue);
4139 if (he == NULL) {
4140 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4141 Jim_AppendStrings(interp, Jim_GetResult(interp),
4142 "Invalid reference ID \"", str, "\"", NULL);
4143 return JIM_ERR;
4144 }
4145 refPtr = he->val;
4146 /* Free the old internal repr and set the new one. */
4147 Jim_FreeIntRep(interp, objPtr);
4148 objPtr->typePtr = &referenceObjType;
4149 objPtr->internalRep.refValue.id = wideValue;
4150 objPtr->internalRep.refValue.refPtr = refPtr;
4151 return JIM_OK;
4152
4153 badformat:
4154 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4155 Jim_AppendStrings(interp, Jim_GetResult(interp),
4156 "expected reference but got \"", str, "\"", NULL);
4157 return JIM_ERR;
4158 }
4159
4160 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4161 * as finalizer command (or NULL if there is no finalizer).
4162 * The returned reference object has refcount = 0. */
4163 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4164 Jim_Obj *cmdNamePtr)
4165 {
4166 struct Jim_Reference *refPtr;
4167 jim_wide wideValue = interp->referenceNextId;
4168 Jim_Obj *refObjPtr;
4169 const char *tag;
4170 int tagLen, i;
4171
4172 /* Perform the Garbage Collection if needed. */
4173 Jim_CollectIfNeeded(interp);
4174
4175 refPtr = Jim_Alloc(sizeof(*refPtr));
4176 refPtr->objPtr = objPtr;
4177 Jim_IncrRefCount(objPtr);
4178 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4179 if (cmdNamePtr)
4180 Jim_IncrRefCount(cmdNamePtr);
4181 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4182 refObjPtr = Jim_NewObj(interp);
4183 refObjPtr->typePtr = &referenceObjType;
4184 refObjPtr->bytes = NULL;
4185 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4186 refObjPtr->internalRep.refValue.refPtr = refPtr;
4187 interp->referenceNextId++;
4188 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4189 * that does not pass the 'isrefchar' test is replaced with '_' */
4190 tag = Jim_GetString(tagPtr, &tagLen);
4191 if (tagLen > JIM_REFERENCE_TAGLEN)
4192 tagLen = JIM_REFERENCE_TAGLEN;
4193 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4194 if (i < tagLen)
4195 refPtr->tag[i] = tag[i];
4196 else
4197 refPtr->tag[i] = '_';
4198 }
4199 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4200 return refObjPtr;
4201 }
4202
4203 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4204 {
4205 if (objPtr->typePtr != &referenceObjType &&
4206 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4207 return NULL;
4208 return objPtr->internalRep.refValue.refPtr;
4209 }
4210
4211 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4212 {
4213 Jim_Reference *refPtr;
4214
4215 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4216 return JIM_ERR;
4217 Jim_IncrRefCount(cmdNamePtr);
4218 if (refPtr->finalizerCmdNamePtr)
4219 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4220 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4221 return JIM_OK;
4222 }
4223
4224 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4225 {
4226 Jim_Reference *refPtr;
4227
4228 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4229 return JIM_ERR;
4230 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4231 return JIM_OK;
4232 }
4233
4234 /* -----------------------------------------------------------------------------
4235 * References Garbage Collection
4236 * ---------------------------------------------------------------------------*/
4237
4238 /* This the hash table type for the "MARK" phase of the GC */
4239 static Jim_HashTableType JimRefMarkHashTableType = {
4240 JimReferencesHTHashFunction, /* hash function */
4241 JimReferencesHTKeyDup, /* key dup */
4242 NULL, /* val dup */
4243 JimReferencesHTKeyCompare, /* key compare */
4244 JimReferencesHTKeyDestructor, /* key destructor */
4245 NULL /* val destructor */
4246 };
4247
4248 /* #define JIM_DEBUG_GC 1 */
4249
4250 /* Performs the garbage collection. */
4251 int Jim_Collect(Jim_Interp *interp)
4252 {
4253 Jim_HashTable marks;
4254 Jim_HashTableIterator *htiter;
4255 Jim_HashEntry *he;
4256 Jim_Obj *objPtr;
4257 int collected = 0;
4258
4259 /* Avoid recursive calls */
4260 if (interp->lastCollectId == -1) {
4261 /* Jim_Collect() already running. Return just now. */
4262 return 0;
4263 }
4264 interp->lastCollectId = -1;
4265
4266 /* Mark all the references found into the 'mark' hash table.
4267 * The references are searched in every live object that
4268 * is of a type that can contain references. */
4269 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4270 objPtr = interp->liveList;
4271 while (objPtr) {
4272 if (objPtr->typePtr == NULL ||
4273 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4274 const char *str, *p;
4275 int len;
4276
4277 /* If the object is of type reference, to get the
4278 * Id is simple... */
4279 if (objPtr->typePtr == &referenceObjType) {
4280 Jim_AddHashEntry(&marks,
4281 &objPtr->internalRep.refValue.id, NULL);
4282 #ifdef JIM_DEBUG_GC
4283 Jim_fprintf(interp,interp->cookie_stdout,
4284 "MARK (reference): %d refcount: %d" JIM_NL,
4285 (int) objPtr->internalRep.refValue.id,
4286 objPtr->refCount);
4287 #endif
4288 objPtr = objPtr->nextObjPtr;
4289 continue;
4290 }
4291 /* Get the string repr of the object we want
4292 * to scan for references. */
4293 p = str = Jim_GetString(objPtr, &len);
4294 /* Skip objects too little to contain references. */
4295 if (len < JIM_REFERENCE_SPACE) {
4296 objPtr = objPtr->nextObjPtr;
4297 continue;
4298 }
4299 /* Extract references from the object string repr. */
4300 while (1) {
4301 int i;
4302 jim_wide id;
4303 char buf[21];
4304
4305 if ((p = strstr(p, "<reference.<")) == NULL)
4306 break;
4307 /* Check if it's a valid reference. */
4308 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4309 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4310 for (i = 21; i <= 40; i++)
4311 if (!isdigit((int)p[i]))
4312 break;
4313 /* Get the ID */
4314 memcpy(buf, p + 21, 20);
4315 buf[20] = '\0';
4316 Jim_StringToWide(buf, &id, 10);
4317
4318 /* Ok, a reference for the given ID
4319 * was found. Mark it. */
4320 Jim_AddHashEntry(&marks, &id, NULL);
4321 #ifdef JIM_DEBUG_GC
4322 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4323 #endif
4324 p += JIM_REFERENCE_SPACE;
4325 }
4326 }
4327 objPtr = objPtr->nextObjPtr;
4328 }
4329
4330 /* Run the references hash table to destroy every reference that
4331 * is not referenced outside (not present in the mark HT). */
4332 htiter = Jim_GetHashTableIterator(&interp->references);
4333 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4334 const jim_wide *refId;
4335 Jim_Reference *refPtr;
4336
4337 refId = he->key;
4338 /* Check if in the mark phase we encountered
4339 * this reference. */
4340 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4341 #ifdef JIM_DEBUG_GC
4342 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4343 #endif
4344 collected++;
4345 /* Drop the reference, but call the
4346 * finalizer first if registered. */
4347 refPtr = he->val;
4348 if (refPtr->finalizerCmdNamePtr) {
4349 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4350 Jim_Obj *objv[3], *oldResult;
4351
4352 JimFormatReference(refstr, refPtr, *refId);
4353
4354 objv[0] = refPtr->finalizerCmdNamePtr;
4355 objv[1] = Jim_NewStringObjNoAlloc(interp,
4356 refstr, 32);
4357 objv[2] = refPtr->objPtr;
4358 Jim_IncrRefCount(objv[0]);
4359 Jim_IncrRefCount(objv[1]);
4360 Jim_IncrRefCount(objv[2]);
4361
4362 /* Drop the reference itself */
4363 Jim_DeleteHashEntry(&interp->references, refId);
4364
4365 /* Call the finalizer. Errors ignored. */
4366 oldResult = interp->result;
4367 Jim_IncrRefCount(oldResult);
4368 Jim_EvalObjVector(interp, 3, objv);
4369 Jim_SetResult(interp, oldResult);
4370 Jim_DecrRefCount(interp, oldResult);
4371
4372 Jim_DecrRefCount(interp, objv[0]);
4373 Jim_DecrRefCount(interp, objv[1]);
4374 Jim_DecrRefCount(interp, objv[2]);
4375 } else {
4376 Jim_DeleteHashEntry(&interp->references, refId);
4377 }
4378 }
4379 }
4380 Jim_FreeHashTableIterator(htiter);
4381 Jim_FreeHashTable(&marks);
4382 interp->lastCollectId = interp->referenceNextId;
4383 interp->lastCollectTime = time(NULL);
4384 return collected;
4385 }
4386
4387 #define JIM_COLLECT_ID_PERIOD 5000
4388 #define JIM_COLLECT_TIME_PERIOD 300
4389
4390 void Jim_CollectIfNeeded(Jim_Interp *interp)
4391 {
4392 jim_wide elapsedId;
4393 int elapsedTime;
4394
4395 elapsedId = interp->referenceNextId - interp->lastCollectId;
4396 elapsedTime = time(NULL) - interp->lastCollectTime;
4397
4398
4399 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4400 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4401 Jim_Collect(interp);
4402 }
4403 }
4404
4405 /* -----------------------------------------------------------------------------
4406 * Interpreter related functions
4407 * ---------------------------------------------------------------------------*/
4408
4409 Jim_Interp *Jim_CreateInterp(void)
4410 {
4411 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4412 Jim_Obj *pathPtr;
4413
4414 i->errorLine = 0;
4415 i->errorFileName = Jim_StrDup("");
4416 i->numLevels = 0;
4417 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4418 i->returnCode = JIM_OK;
4419 i->exitCode = 0;
4420 i->procEpoch = 0;
4421 i->callFrameEpoch = 0;
4422 i->liveList = i->freeList = NULL;
4423 i->scriptFileName = Jim_StrDup("");
4424 i->referenceNextId = 0;
4425 i->lastCollectId = 0;
4426 i->lastCollectTime = time(NULL);
4427 i->freeFramesList = NULL;
4428 i->prngState = NULL;
4429 i->evalRetcodeLevel = -1;
4430 i->cookie_stdin = stdin;
4431 i->cookie_stdout = stdout;
4432 i->cookie_stderr = stderr;
4433 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4434 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4435 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4436 i->cb_fflush = ((int (*)(void *))(fflush));
4437 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4438
4439 /* Note that we can create objects only after the
4440 * interpreter liveList and freeList pointers are
4441 * initialized to NULL. */
4442 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4443 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4444 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4445 NULL);
4446 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4447 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4448 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4449 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4450 i->emptyObj = Jim_NewEmptyStringObj(i);
4451 i->result = i->emptyObj;
4452 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4453 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4454 i->unknown_called = 0;
4455 Jim_IncrRefCount(i->emptyObj);
4456 Jim_IncrRefCount(i->result);
4457 Jim_IncrRefCount(i->stackTrace);
4458 Jim_IncrRefCount(i->unknown);
4459
4460 /* Initialize key variables every interpreter should contain */
4461 pathPtr = Jim_NewStringObj(i, "./", -1);
4462 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4463 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4464
4465 /* Export the core API to extensions */
4466 JimRegisterCoreApi(i);
4467 return i;
4468 }
4469
4470 /* This is the only function Jim exports directly without
4471 * to use the STUB system. It is only used by embedders
4472 * in order to get an interpreter with the Jim API pointers
4473 * registered. */
4474 Jim_Interp *ExportedJimCreateInterp(void)
4475 {
4476 return Jim_CreateInterp();
4477 }
4478
4479 void Jim_FreeInterp(Jim_Interp *i)
4480 {
4481 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4482 Jim_Obj *objPtr, *nextObjPtr;
4483
4484 Jim_DecrRefCount(i, i->emptyObj);
4485 Jim_DecrRefCount(i, i->result);
4486 Jim_DecrRefCount(i, i->stackTrace);
4487 Jim_DecrRefCount(i, i->unknown);
4488 Jim_Free((void*)i->errorFileName);
4489 Jim_Free((void*)i->scriptFileName);
4490 Jim_FreeHashTable(&i->commands);
4491 Jim_FreeHashTable(&i->references);
4492 Jim_FreeHashTable(&i->stub);
4493 Jim_FreeHashTable(&i->assocData);
4494 Jim_FreeHashTable(&i->packages);
4495 Jim_Free(i->prngState);
4496 /* Free the call frames list */
4497 while (cf) {
4498 prevcf = cf->parentCallFrame;
4499 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4500 cf = prevcf;
4501 }
4502 /* Check that the live object list is empty, otherwise
4503 * there is a memory leak. */
4504 if (i->liveList != NULL) {
4505 Jim_Obj *objPtr = i->liveList;
4506
4507 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4508 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4509 while (objPtr) {
4510 const char *type = objPtr->typePtr ?
4511 objPtr->typePtr->name : "";
4512 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4513 objPtr, type,
4514 objPtr->bytes ? objPtr->bytes
4515 : "(null)", objPtr->refCount);
4516 if (objPtr->typePtr == &sourceObjType) {
4517 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4518 objPtr->internalRep.sourceValue.fileName,
4519 objPtr->internalRep.sourceValue.lineNumber);
4520 }
4521 objPtr = objPtr->nextObjPtr;
4522 }
4523 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4524 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4525 }
4526 /* Free all the freed objects. */
4527 objPtr = i->freeList;
4528 while (objPtr) {
4529 nextObjPtr = objPtr->nextObjPtr;
4530 Jim_Free(objPtr);
4531 objPtr = nextObjPtr;
4532 }
4533 /* Free cached CallFrame structures */
4534 cf = i->freeFramesList;
4535 while (cf) {
4536 nextcf = cf->nextFramePtr;
4537 if (cf->vars.table != NULL)
4538 Jim_Free(cf->vars.table);
4539 Jim_Free(cf);
4540 cf = nextcf;
4541 }
4542 /* Free the sharedString hash table. Make sure to free it
4543 * after every other Jim_Object was freed. */
4544 Jim_FreeHashTable(&i->sharedStrings);
4545 /* Free the interpreter structure. */
4546 Jim_Free(i);
4547 }
4548
4549 /* Store the call frame relative to the level represented by
4550 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4551 * level is assumed to be '1'.
4552 *
4553 * If a newLevelptr int pointer is specified, the function stores
4554 * the absolute level integer value of the new target callframe into
4555 * *newLevelPtr. (this is used to adjust interp->numLevels
4556 * in the implementation of [uplevel], so that [info level] will
4557 * return a correct information).
4558 *
4559 * This function accepts the 'level' argument in the form
4560 * of the commands [uplevel] and [upvar].
4561 *
4562 * For a function accepting a relative integer as level suitable
4563 * for implementation of [info level ?level?] check the
4564 * GetCallFrameByInteger() function. */
4565 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4566 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4567 {
4568 long level;
4569 const char *str;
4570 Jim_CallFrame *framePtr;
4571
4572 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4573 if (levelObjPtr) {
4574 str = Jim_GetString(levelObjPtr, NULL);
4575 if (str[0] == '#') {
4576 char *endptr;
4577 /* speedup for the toplevel (level #0) */
4578 if (str[1] == '0' && str[2] == '\0') {
4579 if (newLevelPtr) *newLevelPtr = 0;
4580 *framePtrPtr = interp->topFramePtr;
4581 return JIM_OK;
4582 }
4583
4584 level = strtol(str + 1, &endptr, 0);
4585 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4586 goto badlevel;
4587 /* An 'absolute' level is converted into the
4588 * 'number of levels to go back' format. */
4589 level = interp->numLevels - level;
4590 if (level < 0) goto badlevel;
4591 } else {
4592 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4593 goto badlevel;
4594 }
4595 } else {
4596 str = "1"; /* Needed to format the error message. */
4597 level = 1;
4598 }
4599 /* Lookup */
4600 framePtr = interp->framePtr;
4601 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4602 while (level--) {
4603 framePtr = framePtr->parentCallFrame;
4604 if (framePtr == NULL) goto badlevel;
4605 }
4606 *framePtrPtr = framePtr;
4607 return JIM_OK;
4608 badlevel:
4609 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4610 Jim_AppendStrings(interp, Jim_GetResult(interp),
4611 "bad level \"", str, "\"", NULL);
4612 return JIM_ERR;
4613 }
4614
4615 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4616 * as a relative integer like in the [info level ?level?] command. */
4617 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4618 Jim_CallFrame **framePtrPtr)
4619 {
4620 jim_wide level;
4621 jim_wide relLevel; /* level relative to the current one. */
4622 Jim_CallFrame *framePtr;
4623
4624 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4625 goto badlevel;
4626 if (level > 0) {
4627 /* An 'absolute' level is converted into the
4628 * 'number of levels to go back' format. */
4629 relLevel = interp->numLevels - level;
4630 } else {
4631 relLevel = -level;
4632 }
4633 /* Lookup */
4634 framePtr = interp->framePtr;
4635 while (relLevel--) {
4636 framePtr = framePtr->parentCallFrame;
4637 if (framePtr == NULL) goto badlevel;
4638 }
4639 *framePtrPtr = framePtr;
4640 return JIM_OK;
4641 badlevel:
4642 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4643 Jim_AppendStrings(interp, Jim_GetResult(interp),
4644 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4645 return JIM_ERR;
4646 }
4647
4648 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4649 {
4650 Jim_Free((void*)interp->errorFileName);
4651 interp->errorFileName = Jim_StrDup(filename);
4652 }
4653
4654 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4655 {
4656 interp->errorLine = linenr;
4657 }
4658
4659 static void JimResetStackTrace(Jim_Interp *interp)
4660 {
4661 Jim_DecrRefCount(interp, interp->stackTrace);
4662 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4663 Jim_IncrRefCount(interp->stackTrace);
4664 }
4665
4666 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4667 const char *filename, int linenr)
4668 {
4669 /* No need to add this dummy entry to the stack trace */
4670 if (strcmp(procname, "unknown") == 0) {
4671 return;
4672 }
4673
4674 if (Jim_IsShared(interp->stackTrace)) {
4675 interp->stackTrace =
4676 Jim_DuplicateObj(interp, interp->stackTrace);
4677 Jim_IncrRefCount(interp->stackTrace);
4678 }
4679 Jim_ListAppendElement(interp, interp->stackTrace,
4680 Jim_NewStringObj(interp, procname, -1));
4681 Jim_ListAppendElement(interp, interp->stackTrace,
4682 Jim_NewStringObj(interp, filename, -1));
4683 Jim_ListAppendElement(interp, interp->stackTrace,
4684 Jim_NewIntObj(interp, linenr));
4685 }
4686
4687 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4688 {
4689 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4690 assocEntryPtr->delProc = delProc;
4691 assocEntryPtr->data = data;
4692 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4693 }
4694
4695 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4696 {
4697 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4698 if (entryPtr != NULL) {
4699 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4700 return assocEntryPtr->data;
4701 }
4702 return NULL;
4703 }
4704
4705 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4706 {
4707 return Jim_DeleteHashEntry(&interp->assocData, key);
4708 }
4709
4710 int Jim_GetExitCode(Jim_Interp *interp) {
4711 return interp->exitCode;
4712 }
4713
4714 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4715 {
4716 if (fp != NULL) interp->cookie_stdin = fp;
4717 return interp->cookie_stdin;
4718 }
4719
4720 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4721 {
4722 if (fp != NULL) interp->cookie_stdout = fp;
4723 return interp->cookie_stdout;
4724 }
4725
4726 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4727 {
4728 if (fp != NULL) interp->cookie_stderr = fp;
4729 return interp->cookie_stderr;
4730 }
4731
4732 /* -----------------------------------------------------------------------------
4733 * Shared strings.
4734 * Every interpreter has an hash table where to put shared dynamically
4735 * allocate strings that are likely to be used a lot of times.
4736 * For example, in the 'source' object type, there is a pointer to
4737 * the filename associated with that object. Every script has a lot
4738 * of this objects with the identical file name, so it is wise to share
4739 * this info.
4740 *
4741 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4742 * returns the pointer to the shared string. Every time a reference
4743 * to the string is no longer used, the user should call
4744 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4745 * a given string, it is removed from the hash table.
4746 * ---------------------------------------------------------------------------*/
4747 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4748 {
4749 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4750
4751 if (he == NULL) {
4752 char *strCopy = Jim_StrDup(str);
4753
4754 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4755 return strCopy;
4756 } else {
4757 long refCount = (long) he->val;
4758
4759 refCount++;
4760 he->val = (void*) refCount;
4761 return he->key;
4762 }
4763 }
4764
4765 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4766 {
4767 long refCount;
4768 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4769
4770 if (he == NULL)
4771 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4772 "unknown shared string '%s'", str);
4773 refCount = (long) he->val;
4774 refCount--;
4775 if (refCount == 0) {
4776 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4777 } else {
4778 he->val = (void*) refCount;
4779 }
4780 }
4781
4782 /* -----------------------------------------------------------------------------
4783 * Integer object
4784 * ---------------------------------------------------------------------------*/
4785 #define JIM_INTEGER_SPACE 24
4786
4787 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4788 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4789
4790 static Jim_ObjType intObjType = {
4791 "int",
4792 NULL,
4793 NULL,
4794 UpdateStringOfInt,
4795 JIM_TYPE_NONE,
4796 };
4797
4798 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4799 {
4800 int len;
4801 char buf[JIM_INTEGER_SPACE + 1];
4802
4803 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4804 objPtr->bytes = Jim_Alloc(len + 1);
4805 memcpy(objPtr->bytes, buf, len + 1);
4806 objPtr->length = len;
4807 }
4808
4809 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4810 {
4811 jim_wide wideValue;
4812 const char *str;
4813
4814 /* Get the string representation */
4815 str = Jim_GetString(objPtr, NULL);
4816 /* Try to convert into a jim_wide */
4817 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4818 if (flags & JIM_ERRMSG) {
4819 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4820 Jim_AppendStrings(interp, Jim_GetResult(interp),
4821 "expected integer but got \"", str, "\"", NULL);
4822 }
4823 return JIM_ERR;
4824 }
4825 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4826 errno == ERANGE) {
4827 Jim_SetResultString(interp,
4828 "Integer value too big to be represented", -1);
4829 return JIM_ERR;
4830 }
4831 /* Free the old internal repr and set the new one. */
4832 Jim_FreeIntRep(interp, objPtr);
4833 objPtr->typePtr = &intObjType;
4834 objPtr->internalRep.wideValue = wideValue;
4835 return JIM_OK;
4836 }
4837
4838 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4839 {
4840 if (objPtr->typePtr != &intObjType &&
4841 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4842 return JIM_ERR;
4843 *widePtr = objPtr->internalRep.wideValue;
4844 return JIM_OK;
4845 }
4846
4847 /* Get a wide but does not set an error if the format is bad. */
4848 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4849 jim_wide *widePtr)
4850 {
4851 if (objPtr->typePtr != &intObjType &&
4852 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4853 return JIM_ERR;
4854 *widePtr = objPtr->internalRep.wideValue;
4855 return JIM_OK;
4856 }
4857
4858 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4859 {
4860 jim_wide wideValue;
4861 int retval;
4862
4863 retval = Jim_GetWide(interp, objPtr, &wideValue);
4864 if (retval == JIM_OK) {
4865 *longPtr = (long) wideValue;
4866 return JIM_OK;
4867 }
4868 return JIM_ERR;
4869 }
4870
4871 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4872 {
4873 if (Jim_IsShared(objPtr))
4874 Jim_Panic(interp,"Jim_SetWide called with shared object");
4875 if (objPtr->typePtr != &intObjType) {
4876 Jim_FreeIntRep(interp, objPtr);
4877 objPtr->typePtr = &intObjType;
4878 }
4879 Jim_InvalidateStringRep(objPtr);
4880 objPtr->internalRep.wideValue = wideValue;
4881 }
4882
4883 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4884 {
4885 Jim_Obj *objPtr;
4886
4887 objPtr = Jim_NewObj(interp);
4888 objPtr->typePtr = &intObjType;
4889 objPtr->bytes = NULL;
4890 objPtr->internalRep.wideValue = wideValue;
4891 return objPtr;
4892 }
4893
4894 /* -----------------------------------------------------------------------------
4895 * Double object
4896 * ---------------------------------------------------------------------------*/
4897 #define JIM_DOUBLE_SPACE 30
4898
4899 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4900 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4901
4902 static Jim_ObjType doubleObjType = {
4903 "double",
4904 NULL,
4905 NULL,
4906 UpdateStringOfDouble,
4907 JIM_TYPE_NONE,
4908 };
4909
4910 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4911 {
4912 int len;
4913 char buf[JIM_DOUBLE_SPACE + 1];
4914
4915 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4916 objPtr->bytes = Jim_Alloc(len + 1);
4917 memcpy(objPtr->bytes, buf, len + 1);
4918 objPtr->length = len;
4919 }
4920
4921 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4922 {
4923 double doubleValue;
4924 const char *str;
4925
4926 /* Get the string representation */
4927 str = Jim_GetString(objPtr, NULL);
4928 /* Try to convert into a double */
4929 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4930 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4931 Jim_AppendStrings(interp, Jim_GetResult(interp),
4932 "expected number but got '", str, "'", NULL);
4933 return JIM_ERR;
4934 }
4935 /* Free the old internal repr and set the new one. */
4936 Jim_FreeIntRep(interp, objPtr);
4937 objPtr->typePtr = &doubleObjType;
4938 objPtr->internalRep.doubleValue = doubleValue;
4939 return JIM_OK;
4940 }
4941
4942 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4943 {
4944 if (objPtr->typePtr != &doubleObjType &&
4945 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4946 return JIM_ERR;
4947 *doublePtr = objPtr->internalRep.doubleValue;
4948 return JIM_OK;
4949 }
4950
4951 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4952 {
4953 if (Jim_IsShared(objPtr))
4954 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4955 if (objPtr->typePtr != &doubleObjType) {
4956 Jim_FreeIntRep(interp, objPtr);
4957 objPtr->typePtr = &doubleObjType;
4958 }
4959 Jim_InvalidateStringRep(objPtr);
4960 objPtr->internalRep.doubleValue = doubleValue;
4961 }
4962
4963 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4964 {
4965 Jim_Obj *objPtr;
4966
4967 objPtr = Jim_NewObj(interp);
4968 objPtr->typePtr = &doubleObjType;
4969 objPtr->bytes = NULL;
4970 objPtr->internalRep.doubleValue = doubleValue;
4971 return objPtr;
4972 }
4973
4974 /* -----------------------------------------------------------------------------
4975 * List object
4976 * ---------------------------------------------------------------------------*/
4977 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4978 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4979 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4980 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4981 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4982
4983 /* Note that while the elements of the list may contain references,
4984 * the list object itself can't. This basically means that the
4985 * list object string representation as a whole can't contain references
4986 * that are not presents in the single elements. */
4987 static Jim_ObjType listObjType = {
4988 "list",
4989 FreeListInternalRep,
4990 DupListInternalRep,
4991 UpdateStringOfList,
4992 JIM_TYPE_NONE,
4993 };
4994
4995 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4996 {
4997 int i;
4998
4999 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5000 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5001 }
5002 Jim_Free(objPtr->internalRep.listValue.ele);
5003 }
5004
5005 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5006 {
5007 int i;
5008 JIM_NOTUSED(interp);
5009
5010 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5011 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5012 dupPtr->internalRep.listValue.ele =
5013 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5014 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5015 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5016 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5017 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5018 }
5019 dupPtr->typePtr = &listObjType;
5020 }
5021
5022 /* The following function checks if a given string can be encoded
5023 * into a list element without any kind of quoting, surrounded by braces,
5024 * or using escapes to quote. */
5025 #define JIM_ELESTR_SIMPLE 0
5026 #define JIM_ELESTR_BRACE 1
5027 #define JIM_ELESTR_QUOTE 2
5028 static int ListElementQuotingType(const char *s, int len)
5029 {
5030 int i, level, trySimple = 1;
5031
5032 /* Try with the SIMPLE case */
5033 if (len == 0) return JIM_ELESTR_BRACE;
5034 if (s[0] == '"' || s[0] == '{') {
5035 trySimple = 0;
5036 goto testbrace;
5037 }
5038 for (i = 0; i < len; i++) {
5039 switch (s[i]) {
5040 case ' ':
5041 case '$':
5042 case '"':
5043 case '[':
5044 case ']':
5045 case ';':
5046 case '\\':
5047 case '\r':
5048 case '\n':
5049 case '\t':
5050 case '\f':
5051 case '\v':
5052 trySimple = 0;
5053 case '{':
5054 case '}':
5055 goto testbrace;
5056 }
5057 }
5058 return JIM_ELESTR_SIMPLE;
5059
5060 testbrace:
5061 /* Test if it's possible to do with braces */
5062 if (s[len-1] == '\\' ||
5063 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5064 level = 0;
5065 for (i = 0; i < len; i++) {
5066 switch (s[i]) {
5067 case '{': level++; break;
5068 case '}': level--;
5069 if (level < 0) return JIM_ELESTR_QUOTE;
5070 break;
5071 case '\\':
5072 if (s[i + 1] == '\n')
5073 return JIM_ELESTR_QUOTE;
5074 else
5075 if (s[i + 1] != '\0') i++;
5076 break;
5077 }
5078 }
5079 if (level == 0) {
5080 if (!trySimple) return JIM_ELESTR_BRACE;
5081 for (i = 0; i < len; i++) {
5082 switch (s[i]) {
5083 case ' ':
5084 case '$':
5085 case '"':
5086 case '[':
5087 case ']':
5088 case ';':
5089 case '\\':
5090 case '\r':
5091 case '\n':
5092 case '\t':
5093 case '\f':
5094 case '\v':
5095 return JIM_ELESTR_BRACE;
5096 break;
5097 }
5098 }
5099 return JIM_ELESTR_SIMPLE;
5100 }
5101 return JIM_ELESTR_QUOTE;
5102 }
5103
5104 /* Returns the malloc-ed representation of a string
5105 * using backslash to quote special chars. */
5106 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5107 {
5108 char *q = Jim_Alloc(len*2 + 1), *p;
5109
5110 p = q;
5111 while (*s) {
5112 switch (*s) {
5113 case ' ':
5114 case '$':
5115 case '"':
5116 case '[':
5117 case ']':
5118 case '{':
5119 case '}':
5120 case ';':
5121 case '\\':
5122 *p++ = '\\';
5123 *p++ = *s++;
5124 break;
5125 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5126 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5127 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5128 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5129 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5130 default:
5131 *p++ = *s++;
5132 break;
5133 }
5134 }
5135 *p = '\0';
5136 *qlenPtr = p-q;
5137 return q;
5138 }
5139
5140 void UpdateStringOfList(struct Jim_Obj *objPtr)
5141 {
5142 int i, bufLen, realLength;
5143 const char *strRep;
5144 char *p;
5145 int *quotingType;
5146 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5147
5148 /* (Over) Estimate the space needed. */
5149 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5150 bufLen = 0;
5151 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5152 int len;
5153
5154 strRep = Jim_GetString(ele[i], &len);
5155 quotingType[i] = ListElementQuotingType(strRep, len);
5156 switch (quotingType[i]) {
5157 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5158 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5159 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5160 }
5161 bufLen++; /* elements separator. */
5162 }
5163 bufLen++;
5164
5165 /* Generate the string rep. */
5166 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5167 realLength = 0;
5168 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5169 int len, qlen;
5170 const char *strRep = Jim_GetString(ele[i], &len);
5171 char *q;
5172
5173 switch (quotingType[i]) {
5174 case JIM_ELESTR_SIMPLE:
5175 memcpy(p, strRep, len);
5176 p += len;
5177 realLength += len;
5178 break;
5179 case JIM_ELESTR_BRACE:
5180 *p++ = '{';
5181 memcpy(p, strRep, len);
5182 p += len;
5183 *p++ = '}';
5184 realLength += len + 2;
5185 break;
5186 case JIM_ELESTR_QUOTE:
5187 q = BackslashQuoteString(strRep, len, &qlen);
5188 memcpy(p, q, qlen);
5189 Jim_Free(q);
5190 p += qlen;
5191 realLength += qlen;
5192 break;
5193 }
5194 /* Add a separating space */
5195 if (i + 1 != objPtr->internalRep.listValue.len) {
5196 *p++ = ' ';
5197 realLength ++;
5198 }
5199 }
5200 *p = '\0'; /* nul term. */
5201 objPtr->length = realLength;
5202 Jim_Free(quotingType);
5203 }
5204
5205 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5206 {
5207 struct JimParserCtx parser;
5208 const char *str;
5209 int strLen;
5210
5211 /* Get the string representation */
5212 str = Jim_GetString(objPtr, &strLen);
5213
5214 /* Free the old internal repr just now and initialize the
5215 * new one just now. The string->list conversion can't fail. */
5216 Jim_FreeIntRep(interp, objPtr);
5217 objPtr->typePtr = &listObjType;
5218 objPtr->internalRep.listValue.len = 0;
5219 objPtr->internalRep.listValue.maxLen = 0;
5220 objPtr->internalRep.listValue.ele = NULL;
5221
5222 /* Convert into a list */
5223 JimParserInit(&parser, str, strLen, 1);
5224 while (!JimParserEof(&parser)) {
5225 char *token;
5226 int tokenLen, type;
5227 Jim_Obj *elementPtr;
5228
5229 JimParseList(&parser);
5230 if (JimParserTtype(&parser) != JIM_TT_STR &&
5231 JimParserTtype(&parser) != JIM_TT_ESC)
5232 continue;
5233 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5234 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5235 ListAppendElement(objPtr, elementPtr);
5236 }
5237 return JIM_OK;
5238 }
5239
5240 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5241 int len)
5242 {
5243 Jim_Obj *objPtr;
5244 int i;
5245
5246 objPtr = Jim_NewObj(interp);
5247 objPtr->typePtr = &listObjType;
5248 objPtr->bytes = NULL;
5249 objPtr->internalRep.listValue.ele = NULL;
5250 objPtr->internalRep.listValue.len = 0;
5251 objPtr->internalRep.listValue.maxLen = 0;
5252 for (i = 0; i < len; i++) {
5253 ListAppendElement(objPtr, elements[i]);
5254 }
5255 return objPtr;
5256 }
5257
5258 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5259 * length of the vector. Note that the user of this function should make
5260 * sure that the list object can't shimmer while the vector returned
5261 * is in use, this vector is the one stored inside the internal representation
5262 * of the list object. This function is not exported, extensions should
5263 * always access to the List object elements using Jim_ListIndex(). */
5264 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5265 Jim_Obj ***listVec)
5266 {
5267 Jim_ListLength(interp, listObj, argc);
5268 assert(listObj->typePtr == &listObjType);
5269 *listVec = listObj->internalRep.listValue.ele;
5270 }
5271
5272 /* ListSortElements type values */
5273 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5274 JIM_LSORT_NOCASE_DECR};
5275
5276 /* Sort the internal rep of a list. */
5277 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5278 {
5279 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5280 }
5281
5282 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5283 {
5284 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5285 }
5286
5287 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5288 {
5289 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5290 }
5291
5292 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5293 {
5294 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5295 }
5296
5297 /* Sort a list *in place*. MUST be called with non-shared objects. */
5298 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5299 {
5300 typedef int (qsort_comparator)(const void *, const void *);
5301 int (*fn)(Jim_Obj**, Jim_Obj**);
5302 Jim_Obj **vector;
5303 int len;
5304
5305 if (Jim_IsShared(listObjPtr))
5306 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5307 if (listObjPtr->typePtr != &listObjType)
5308 SetListFromAny(interp, listObjPtr);
5309
5310 vector = listObjPtr->internalRep.listValue.ele;
5311 len = listObjPtr->internalRep.listValue.len;
5312 switch (type) {
5313 case JIM_LSORT_ASCII: fn = ListSortString; break;
5314 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5315 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5316 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5317 default:
5318 fn = NULL; /* avoid warning */
5319 Jim_Panic(interp,"ListSort called with invalid sort type");
5320 }
5321 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5322 Jim_InvalidateStringRep(listObjPtr);
5323 }
5324
5325 /* This is the low-level function to append an element to a list.
5326 * The higher-level Jim_ListAppendElement() performs shared object
5327 * check and invalidate the string repr. This version is used
5328 * in the internals of the List Object and is not exported.
5329 *
5330 * NOTE: this function can be called only against objects
5331 * with internal type of List. */
5332 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5333 {
5334 int requiredLen = listPtr->internalRep.listValue.len + 1;
5335
5336 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5337 int maxLen = requiredLen * 2;
5338
5339 listPtr->internalRep.listValue.ele =
5340 Jim_Realloc(listPtr->internalRep.listValue.ele,
5341 sizeof(Jim_Obj*)*maxLen);
5342 listPtr->internalRep.listValue.maxLen = maxLen;
5343 }
5344 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5345 objPtr;
5346 listPtr->internalRep.listValue.len ++;
5347 Jim_IncrRefCount(objPtr);
5348 }
5349
5350 /* This is the low-level function to insert elements into a list.
5351 * The higher-level Jim_ListInsertElements() performs shared object
5352 * check and invalidate the string repr. This version is used
5353 * in the internals of the List Object and is not exported.
5354 *
5355 * NOTE: this function can be called only against objects
5356 * with internal type of List. */
5357 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5358 Jim_Obj *const *elemVec)
5359 {
5360 int currentLen = listPtr->internalRep.listValue.len;
5361 int requiredLen = currentLen + elemc;
5362 int i;
5363 Jim_Obj **point;
5364
5365 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5366 int maxLen = requiredLen * 2;
5367
5368 listPtr->internalRep.listValue.ele =
5369 Jim_Realloc(listPtr->internalRep.listValue.ele,
5370 sizeof(Jim_Obj*)*maxLen);
5371 listPtr->internalRep.listValue.maxLen = maxLen;
5372 }
5373 point = listPtr->internalRep.listValue.ele + index;
5374 memmove(point + elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5375 for (i = 0; i < elemc; ++i) {
5376 point[i] = elemVec[i];
5377 Jim_IncrRefCount(point[i]);
5378 }
5379 listPtr->internalRep.listValue.len += elemc;
5380 }
5381
5382 /* Appends every element of appendListPtr into listPtr.
5383 * Both have to be of the list type. */
5384 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5385 {
5386 int i, oldLen = listPtr->internalRep.listValue.len;
5387 int appendLen = appendListPtr->internalRep.listValue.len;
5388 int requiredLen = oldLen + appendLen;
5389
5390 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5391 int maxLen = requiredLen * 2;
5392
5393 listPtr->internalRep.listValue.ele =
5394 Jim_Realloc(listPtr->internalRep.listValue.ele,
5395 sizeof(Jim_Obj*)*maxLen);
5396 listPtr->internalRep.listValue.maxLen = maxLen;
5397 }
5398 for (i = 0; i < appendLen; i++) {
5399 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5400 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5401 Jim_IncrRefCount(objPtr);
5402 }
5403 listPtr->internalRep.listValue.len += appendLen;
5404 }
5405
5406 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5407 {
5408 if (Jim_IsShared(listPtr))
5409 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5410 if (listPtr->typePtr != &listObjType)
5411 SetListFromAny(interp, listPtr);
5412 Jim_InvalidateStringRep(listPtr);
5413 ListAppendElement(listPtr, objPtr);
5414 }
5415
5416 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5417 {
5418 if (Jim_IsShared(listPtr))
5419 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5420 if (listPtr->typePtr != &listObjType)
5421 SetListFromAny(interp, listPtr);
5422 Jim_InvalidateStringRep(listPtr);
5423 ListAppendList(listPtr, appendListPtr);
5424 }
5425
5426 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5427 {
5428 if (listPtr->typePtr != &listObjType)
5429 SetListFromAny(interp, listPtr);
5430 *intPtr = listPtr->internalRep.listValue.len;
5431 }
5432
5433 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5434 int objc, Jim_Obj *const *objVec)
5435 {
5436 if (Jim_IsShared(listPtr))
5437 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5438 if (listPtr->typePtr != &listObjType)
5439 SetListFromAny(interp, listPtr);
5440 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5441 index = listPtr->internalRep.listValue.len;
5442 else if (index < 0)
5443 index = 0;
5444 Jim_InvalidateStringRep(listPtr);
5445 ListInsertElements(listPtr, index, objc, objVec);
5446 }
5447
5448 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5449 Jim_Obj **objPtrPtr, int flags)
5450 {
5451 if (listPtr->typePtr != &listObjType)
5452 SetListFromAny(interp, listPtr);
5453 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5454 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5455 if (flags & JIM_ERRMSG) {
5456 Jim_SetResultString(interp,
5457 "list index out of range", -1);
5458 }
5459 return JIM_ERR;
5460 }
5461 if (index < 0)
5462 index = listPtr->internalRep.listValue.len + index;
5463 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5464 return JIM_OK;
5465 }
5466
5467 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5468 Jim_Obj *newObjPtr, int flags)
5469 {
5470 if (listPtr->typePtr != &listObjType)
5471 SetListFromAny(interp, listPtr);
5472 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5473 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5474 if (flags & JIM_ERRMSG) {
5475 Jim_SetResultString(interp,
5476 "list index out of range", -1);
5477 }
5478 return JIM_ERR;
5479 }
5480 if (index < 0)
5481 index = listPtr->internalRep.listValue.len + index;
5482 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5483 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5484 Jim_IncrRefCount(newObjPtr);
5485 return JIM_OK;
5486 }
5487
5488 /* Modify the list stored into the variable named 'varNamePtr'
5489 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5490 * with the new element 'newObjptr'. */
5491 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5492 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5493 {
5494 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5495 int shared, i, index;
5496
5497 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5498 if (objPtr == NULL)
5499 return JIM_ERR;
5500 if ((shared = Jim_IsShared(objPtr)))
5501 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5502 for (i = 0; i < indexc-1; i++) {
5503 listObjPtr = objPtr;
5504 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5505 goto err;
5506 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5507 JIM_ERRMSG) != JIM_OK) {
5508 goto err;
5509 }
5510 if (Jim_IsShared(objPtr)) {
5511 objPtr = Jim_DuplicateObj(interp, objPtr);
5512 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5513 }
5514 Jim_InvalidateStringRep(listObjPtr);
5515 }
5516 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5517 goto err;
5518 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5519 goto err;
5520 Jim_InvalidateStringRep(objPtr);
5521 Jim_InvalidateStringRep(varObjPtr);
5522 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5523 goto err;
5524 Jim_SetResult(interp, varObjPtr);
5525 return JIM_OK;
5526 err:
5527 if (shared) {
5528 Jim_FreeNewObj(interp, varObjPtr);
5529 }
5530 return JIM_ERR;
5531 }
5532
5533 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5534 {
5535 int i;
5536
5537 /* If all the objects in objv are lists without string rep.
5538 * it's possible to return a list as result, that's the
5539 * concatenation of all the lists. */
5540 for (i = 0; i < objc; i++) {
5541 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5542 break;
5543 }
5544 if (i == objc) {
5545 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5546 for (i = 0; i < objc; i++)
5547 Jim_ListAppendList(interp, objPtr, objv[i]);
5548 return objPtr;
5549 } else {
5550 /* Else... we have to glue strings together */
5551 int len = 0, objLen;
5552 char *bytes, *p;
5553
5554 /* Compute the length */
5555 for (i = 0; i < objc; i++) {
5556 Jim_GetString(objv[i], &objLen);
5557 len += objLen;
5558 }
5559 if (objc) len += objc-1;
5560 /* Create the string rep, and a stinrg object holding it. */
5561 p = bytes = Jim_Alloc(len + 1);
5562 for (i = 0; i < objc; i++) {
5563 const char *s = Jim_GetString(objv[i], &objLen);
5564 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5565 {
5566 s++; objLen--; len--;
5567 }
5568 while (objLen && (s[objLen-1] == ' ' ||
5569 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5570 objLen--; len--;
5571 }
5572 memcpy(p, s, objLen);
5573 p += objLen;
5574 if (objLen && i + 1 != objc) {
5575 *p++ = ' ';
5576 } else if (i + 1 != objc) {
5577 /* Drop the space calcuated for this
5578 * element that is instead null. */
5579 len--;
5580 }
5581 }
5582 *p = '\0';
5583 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5584 }
5585 }
5586
5587 /* Returns a list composed of the elements in the specified range.
5588 * first and start are directly accepted as Jim_Objects and
5589 * processed for the end?-index? case. */
5590 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5591 {
5592 int first, last;
5593 int len, rangeLen;
5594
5595 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5596 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5597 return NULL;
5598 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5599 first = JimRelToAbsIndex(len, first);
5600 last = JimRelToAbsIndex(len, last);
5601 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5602 return Jim_NewListObj(interp,
5603 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5604 }
5605
5606 /* -----------------------------------------------------------------------------
5607 * Dict object
5608 * ---------------------------------------------------------------------------*/
5609 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5610 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5611 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5612 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5613
5614 /* Dict HashTable Type.
5615 *
5616 * Keys and Values are Jim objects. */
5617
5618 unsigned int JimObjectHTHashFunction(const void *key)
5619 {
5620 const char *str;
5621 Jim_Obj *objPtr = (Jim_Obj*) key;
5622 int len, h;
5623
5624 str = Jim_GetString(objPtr, &len);
5625 h = Jim_GenHashFunction((unsigned char*)str, len);
5626 return h;
5627 }
5628
5629 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5630 {
5631 JIM_NOTUSED(privdata);
5632
5633 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5634 }
5635
5636 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5637 {
5638 Jim_Obj *objPtr = val;
5639
5640 Jim_DecrRefCount(interp, objPtr);
5641 }
5642
5643 static Jim_HashTableType JimDictHashTableType = {
5644 JimObjectHTHashFunction, /* hash function */
5645 NULL, /* key dup */
5646 NULL, /* val dup */
5647 JimObjectHTKeyCompare, /* key compare */
5648 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5649 JimObjectHTKeyValDestructor, /* key destructor */
5650 JimObjectHTKeyValDestructor /* val destructor */
5651 };
5652
5653 /* Note that while the elements of the dict may contain references,
5654 * the list object itself can't. This basically means that the
5655 * dict object string representation as a whole can't contain references
5656 * that are not presents in the single elements. */
5657 static Jim_ObjType dictObjType = {
5658 "dict",
5659 FreeDictInternalRep,
5660 DupDictInternalRep,
5661 UpdateStringOfDict,
5662 JIM_TYPE_NONE,
5663 };
5664
5665 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5666 {
5667 JIM_NOTUSED(interp);
5668
5669 Jim_FreeHashTable(objPtr->internalRep.ptr);
5670 Jim_Free(objPtr->internalRep.ptr);
5671 }
5672
5673 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5674 {
5675 Jim_HashTable *ht, *dupHt;
5676 Jim_HashTableIterator *htiter;
5677 Jim_HashEntry *he;
5678
5679 /* Create a new hash table */
5680 ht = srcPtr->internalRep.ptr;
5681 dupHt = Jim_Alloc(sizeof(*dupHt));
5682 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5683 if (ht->size != 0)
5684 Jim_ExpandHashTable(dupHt, ht->size);
5685 /* Copy every element from the source to the dup hash table */
5686 htiter = Jim_GetHashTableIterator(ht);
5687 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5688 const Jim_Obj *keyObjPtr = he->key;
5689 Jim_Obj *valObjPtr = he->val;
5690
5691 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5692 Jim_IncrRefCount(valObjPtr);
5693 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5694 }
5695 Jim_FreeHashTableIterator(htiter);
5696
5697 dupPtr->internalRep.ptr = dupHt;
5698 dupPtr->typePtr = &dictObjType;
5699 }
5700
5701 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5702 {
5703 int i, bufLen, realLength;
5704 const char *strRep;
5705 char *p;
5706 int *quotingType, objc;
5707 Jim_HashTable *ht;
5708 Jim_HashTableIterator *htiter;
5709 Jim_HashEntry *he;
5710 Jim_Obj **objv;
5711
5712 /* Trun the hash table into a flat vector of Jim_Objects. */
5713 ht = objPtr->internalRep.ptr;
5714 objc = ht->used*2;
5715 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5716 htiter = Jim_GetHashTableIterator(ht);
5717 i = 0;
5718 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5719 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5720 objv[i++] = he->val;
5721 }
5722 Jim_FreeHashTableIterator(htiter);
5723 /* (Over) Estimate the space needed. */
5724 quotingType = Jim_Alloc(sizeof(int)*objc);
5725 bufLen = 0;
5726 for (i = 0; i < objc; i++) {
5727 int len;
5728
5729 strRep = Jim_GetString(objv[i], &len);
5730 quotingType[i] = ListElementQuotingType(strRep, len);
5731 switch (quotingType[i]) {
5732 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5733 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5734 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5735 }
5736 bufLen++; /* elements separator. */
5737 }
5738 bufLen++;
5739
5740 /* Generate the string rep. */
5741 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5742 realLength = 0;
5743 for (i = 0; i < objc; i++) {
5744 int len, qlen;
5745 const char *strRep = Jim_GetString(objv[i], &len);
5746 char *q;
5747
5748 switch (quotingType[i]) {
5749 case JIM_ELESTR_SIMPLE:
5750 memcpy(p, strRep, len);
5751 p += len;
5752 realLength += len;
5753 break;
5754 case JIM_ELESTR_BRACE:
5755 *p++ = '{';
5756 memcpy(p, strRep, len);
5757 p += len;
5758 *p++ = '}';
5759 realLength += len + 2;
5760 break;
5761 case JIM_ELESTR_QUOTE:
5762 q = BackslashQuoteString(strRep, len, &qlen);
5763 memcpy(p, q, qlen);
5764 Jim_Free(q);
5765 p += qlen;
5766 realLength += qlen;
5767 break;
5768 }
5769 /* Add a separating space */
5770 if (i + 1 != objc) {
5771 *p++ = ' ';
5772 realLength ++;
5773 }
5774 }
5775 *p = '\0'; /* nul term. */
5776 objPtr->length = realLength;
5777 Jim_Free(quotingType);
5778 Jim_Free(objv);
5779 }
5780
5781 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5782 {
5783 struct JimParserCtx parser;
5784 Jim_HashTable *ht;
5785 Jim_Obj *objv[2];
5786 const char *str;
5787 int i, strLen;
5788
5789 /* Get the string representation */
5790 str = Jim_GetString(objPtr, &strLen);
5791
5792 /* Free the old internal repr just now and initialize the
5793 * new one just now. The string->list conversion can't fail. */
5794 Jim_FreeIntRep(interp, objPtr);
5795 ht = Jim_Alloc(sizeof(*ht));
5796 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5797 objPtr->typePtr = &dictObjType;
5798 objPtr->internalRep.ptr = ht;
5799
5800 /* Convert into a dict */
5801 JimParserInit(&parser, str, strLen, 1);
5802 i = 0;
5803 while (!JimParserEof(&parser)) {
5804 char *token;
5805 int tokenLen, type;
5806
5807 JimParseList(&parser);
5808 if (JimParserTtype(&parser) != JIM_TT_STR &&
5809 JimParserTtype(&parser) != JIM_TT_ESC)
5810 continue;
5811 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5812 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5813 if (i == 2) {
5814 i = 0;
5815 Jim_IncrRefCount(objv[0]);
5816 Jim_IncrRefCount(objv[1]);
5817 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5818 Jim_HashEntry *he;
5819 he = Jim_FindHashEntry(ht, objv[0]);
5820 Jim_DecrRefCount(interp, objv[0]);
5821 /* ATTENTION: const cast */
5822 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5823 he->val = objv[1];
5824 }
5825 }
5826 }
5827 if (i) {
5828 Jim_FreeNewObj(interp, objv[0]);
5829 objPtr->typePtr = NULL;
5830 Jim_FreeHashTable(ht);
5831 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5832 return JIM_ERR;
5833 }
5834 return JIM_OK;
5835 }
5836
5837 /* Dict object API */
5838
5839 /* Add an element to a dict. objPtr must be of the "dict" type.
5840 * The higer-level exported function is Jim_DictAddElement().
5841 * If an element with the specified key already exists, the value
5842 * associated is replaced with the new one.
5843 *
5844 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5845 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5846 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5847 {
5848 Jim_HashTable *ht = objPtr->internalRep.ptr;
5849
5850 if (valueObjPtr == NULL) { /* unset */
5851 Jim_DeleteHashEntry(ht, keyObjPtr);
5852 return;
5853 }
5854 Jim_IncrRefCount(keyObjPtr);
5855 Jim_IncrRefCount(valueObjPtr);
5856 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5857 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5858 Jim_DecrRefCount(interp, keyObjPtr);
5859 /* ATTENTION: const cast */
5860 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5861 he->val = valueObjPtr;
5862 }
5863 }
5864
5865 /* Add an element, higher-level interface for DictAddElement().
5866 * If valueObjPtr == NULL, the key is removed if it exists. */
5867 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5868 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5869 {
5870 if (Jim_IsShared(objPtr))
5871 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5872 if (objPtr->typePtr != &dictObjType) {
5873 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5874 return JIM_ERR;
5875 }
5876 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5877 Jim_InvalidateStringRep(objPtr);
5878 return JIM_OK;
5879 }
5880
5881 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5882 {
5883 Jim_Obj *objPtr;
5884 int i;
5885
5886 if (len % 2)
5887 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5888
5889 objPtr = Jim_NewObj(interp);
5890 objPtr->typePtr = &dictObjType;
5891 objPtr->bytes = NULL;
5892 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5893 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5894 for (i = 0; i < len; i += 2)
5895 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5896 return objPtr;
5897 }
5898
5899 /* Return the value associated to the specified dict key */
5900 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5901 Jim_Obj **objPtrPtr, int flags)
5902 {
5903 Jim_HashEntry *he;
5904 Jim_HashTable *ht;
5905
5906 if (dictPtr->typePtr != &dictObjType) {
5907 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5908 return JIM_ERR;
5909 }
5910 ht = dictPtr->internalRep.ptr;
5911 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5912 if (flags & JIM_ERRMSG) {
5913 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5914 Jim_AppendStrings(interp, Jim_GetResult(interp),
5915 "key \"", Jim_GetString(keyPtr, NULL),
5916 "\" not found in dictionary", NULL);
5917 }
5918 return JIM_ERR;
5919 }
5920 *objPtrPtr = he->val;
5921 return JIM_OK;
5922 }
5923
5924 /* Return the value associated to the specified dict keys */
5925 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5926 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5927 {
5928 Jim_Obj *objPtr = NULL;
5929 int i;
5930
5931 if (keyc == 0) {
5932 *objPtrPtr = dictPtr;
5933 return JIM_OK;
5934 }
5935
5936 for (i = 0; i < keyc; i++) {
5937 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5938 != JIM_OK)
5939 return JIM_ERR;
5940 dictPtr = objPtr;
5941 }
5942 *objPtrPtr = objPtr;
5943 return JIM_OK;
5944 }
5945
5946 /* Modify the dict stored into the variable named 'varNamePtr'
5947 * setting the element specified by the 'keyc' keys objects in 'keyv',
5948 * with the new value of the element 'newObjPtr'.
5949 *
5950 * If newObjPtr == NULL the operation is to remove the given key
5951 * from the dictionary. */
5952 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5953 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5954 {
5955 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5956 int shared, i;
5957
5958 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5959 if (objPtr == NULL) {
5960 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5961 return JIM_ERR;
5962 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5963 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5964 Jim_FreeNewObj(interp, varObjPtr);
5965 return JIM_ERR;
5966 }
5967 }
5968 if ((shared = Jim_IsShared(objPtr)))
5969 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5970 for (i = 0; i < keyc-1; i++) {
5971 dictObjPtr = objPtr;
5972
5973 /* Check if it's a valid dictionary */
5974 if (dictObjPtr->typePtr != &dictObjType) {
5975 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5976 goto err;
5977 }
5978 /* Check if the given key exists. */
5979 Jim_InvalidateStringRep(dictObjPtr);
5980 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5981 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5982 {
5983 /* This key exists at the current level.
5984 * Make sure it's not shared!. */
5985 if (Jim_IsShared(objPtr)) {
5986 objPtr = Jim_DuplicateObj(interp, objPtr);
5987 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5988 }
5989 } else {
5990 /* Key not found. If it's an [unset] operation
5991 * this is an error. Only the last key may not
5992 * exist. */
5993 if (newObjPtr == NULL)
5994 goto err;
5995 /* Otherwise set an empty dictionary
5996 * as key's value. */
5997 objPtr = Jim_NewDictObj(interp, NULL, 0);
5998 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5999 }
6000 }
6001 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6002 != JIM_OK)
6003 goto err;
6004 Jim_InvalidateStringRep(objPtr);
6005 Jim_InvalidateStringRep(varObjPtr);
6006 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6007 goto err;
6008 Jim_SetResult(interp, varObjPtr);
6009 return JIM_OK;
6010 err:
6011 if (shared) {
6012 Jim_FreeNewObj(interp, varObjPtr);
6013 }
6014 return JIM_ERR;
6015 }
6016
6017 /* -----------------------------------------------------------------------------
6018 * Index object
6019 * ---------------------------------------------------------------------------*/
6020 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6021 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6022
6023 static Jim_ObjType indexObjType = {
6024 "index",
6025 NULL,
6026 NULL,
6027 UpdateStringOfIndex,
6028 JIM_TYPE_NONE,
6029 };
6030
6031 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6032 {
6033 int len;
6034 char buf[JIM_INTEGER_SPACE + 1];
6035
6036 if (objPtr->internalRep.indexValue >= 0)
6037 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6038 else if (objPtr->internalRep.indexValue == -1)
6039 len = sprintf(buf, "end");
6040 else {
6041 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6042 }
6043 objPtr->bytes = Jim_Alloc(len + 1);
6044 memcpy(objPtr->bytes, buf, len + 1);
6045 objPtr->length = len;
6046 }
6047
6048 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6049 {
6050 int index, end = 0;
6051 const char *str;
6052
6053 /* Get the string representation */
6054 str = Jim_GetString(objPtr, NULL);
6055 /* Try to convert into an index */
6056 if (!strcmp(str, "end")) {
6057 index = 0;
6058 end = 1;
6059 } else {
6060 if (!strncmp(str, "end-", 4)) {
6061 str += 4;
6062 end = 1;
6063 }
6064 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6065 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6066 Jim_AppendStrings(interp, Jim_GetResult(interp),
6067 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6068 "must be integer or end?-integer?", NULL);
6069 return JIM_ERR;
6070 }
6071 }
6072 if (end) {
6073 if (index < 0)
6074 index = INT_MAX;
6075 else
6076 index = -(index + 1);
6077 } else if (!end && index < 0)
6078 index = -INT_MAX;
6079 /* Free the old internal repr and set the new one. */
6080 Jim_FreeIntRep(interp, objPtr);
6081 objPtr->typePtr = &indexObjType;
6082 objPtr->internalRep.indexValue = index;
6083 return JIM_OK;
6084 }
6085
6086 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6087 {
6088 /* Avoid shimmering if the object is an integer. */
6089 if (objPtr->typePtr == &intObjType) {
6090 jim_wide val = objPtr->internalRep.wideValue;
6091 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6092 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6093 return JIM_OK;
6094 }
6095 }
6096 if (objPtr->typePtr != &indexObjType &&
6097 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6098 return JIM_ERR;
6099 *indexPtr = objPtr->internalRep.indexValue;
6100 return JIM_OK;
6101 }
6102
6103 /* -----------------------------------------------------------------------------
6104 * Return Code Object.
6105 * ---------------------------------------------------------------------------*/
6106
6107 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6108
6109 static Jim_ObjType returnCodeObjType = {
6110 "return-code",
6111 NULL,
6112 NULL,
6113 NULL,
6114 JIM_TYPE_NONE,
6115 };
6116
6117 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6118 {
6119 const char *str;
6120 int strLen, returnCode;
6121 jim_wide wideValue;
6122
6123 /* Get the string representation */
6124 str = Jim_GetString(objPtr, &strLen);
6125 /* Try to convert into an integer */
6126 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6127 returnCode = (int) wideValue;
6128 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6129 returnCode = JIM_OK;
6130 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6131 returnCode = JIM_ERR;
6132 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6133 returnCode = JIM_RETURN;
6134 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6135 returnCode = JIM_BREAK;
6136 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6137 returnCode = JIM_CONTINUE;
6138 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6139 returnCode = JIM_EVAL;
6140 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6141 returnCode = JIM_EXIT;
6142 else {
6143 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6144 Jim_AppendStrings(interp, Jim_GetResult(interp),
6145 "expected return code but got '", str, "'",
6146 NULL);
6147 return JIM_ERR;
6148 }
6149 /* Free the old internal repr and set the new one. */
6150 Jim_FreeIntRep(interp, objPtr);
6151 objPtr->typePtr = &returnCodeObjType;
6152 objPtr->internalRep.returnCode = returnCode;
6153 return JIM_OK;
6154 }
6155
6156 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6157 {
6158 if (objPtr->typePtr != &returnCodeObjType &&
6159 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6160 return JIM_ERR;
6161 *intPtr = objPtr->internalRep.returnCode;
6162 return JIM_OK;
6163 }
6164
6165 /* -----------------------------------------------------------------------------
6166 * Expression Parsing
6167 * ---------------------------------------------------------------------------*/
6168 static int JimParseExprOperator(struct JimParserCtx *pc);
6169 static int JimParseExprNumber(struct JimParserCtx *pc);
6170 static int JimParseExprIrrational(struct JimParserCtx *pc);
6171
6172 /* Exrp's Stack machine operators opcodes. */
6173
6174 /* Binary operators (numbers) */
6175 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6176 #define JIM_EXPROP_MUL 0
6177 #define JIM_EXPROP_DIV 1
6178 #define JIM_EXPROP_MOD 2
6179 #define JIM_EXPROP_SUB 3
6180 #define JIM_EXPROP_ADD 4
6181 #define JIM_EXPROP_LSHIFT 5
6182 #define JIM_EXPROP_RSHIFT 6
6183 #define JIM_EXPROP_ROTL 7
6184 #define JIM_EXPROP_ROTR 8
6185 #define JIM_EXPROP_LT 9
6186 #define JIM_EXPROP_GT 10
6187 #define JIM_EXPROP_LTE 11
6188 #define JIM_EXPROP_GTE 12
6189 #define JIM_EXPROP_NUMEQ 13
6190 #define JIM_EXPROP_NUMNE 14
6191 #define JIM_EXPROP_BITAND 15
6192 #define JIM_EXPROP_BITXOR 16
6193 #define JIM_EXPROP_BITOR 17
6194 #define JIM_EXPROP_LOGICAND 18
6195 #define JIM_EXPROP_LOGICOR 19
6196 #define JIM_EXPROP_LOGICAND_LEFT 20
6197 #define JIM_EXPROP_LOGICOR_LEFT 21
6198 #define JIM_EXPROP_POW 22
6199 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6200
6201 /* Binary operators (strings) */
6202 #define JIM_EXPROP_STREQ 23
6203 #define JIM_EXPROP_STRNE 24
6204
6205 /* Unary operators (numbers) */
6206 #define JIM_EXPROP_NOT 25
6207 #define JIM_EXPROP_BITNOT 26
6208 #define JIM_EXPROP_UNARYMINUS 27
6209 #define JIM_EXPROP_UNARYPLUS 28
6210 #define JIM_EXPROP_LOGICAND_RIGHT 29
6211 #define JIM_EXPROP_LOGICOR_RIGHT 30
6212
6213 /* Ternary operators */
6214 #define JIM_EXPROP_TERNARY 31
6215
6216 /* Operands */
6217 #define JIM_EXPROP_NUMBER 32
6218 #define JIM_EXPROP_COMMAND 33
6219 #define JIM_EXPROP_VARIABLE 34
6220 #define JIM_EXPROP_DICTSUGAR 35
6221 #define JIM_EXPROP_SUBST 36
6222 #define JIM_EXPROP_STRING 37
6223
6224 /* Operators table */
6225 typedef struct Jim_ExprOperator {
6226 const char *name;
6227 int precedence;
6228 int arity;
6229 int opcode;
6230 } Jim_ExprOperator;
6231
6232 /* name - precedence - arity - opcode */
6233 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6234 {"!", 300, 1, JIM_EXPROP_NOT},
6235 {"~", 300, 1, JIM_EXPROP_BITNOT},
6236 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6237 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6238
6239 {"**", 250, 2, JIM_EXPROP_POW},
6240
6241 {"*", 200, 2, JIM_EXPROP_MUL},
6242 {"/", 200, 2, JIM_EXPROP_DIV},
6243 {"%", 200, 2, JIM_EXPROP_MOD},
6244
6245 {"-", 100, 2, JIM_EXPROP_SUB},
6246 {"+", 100, 2, JIM_EXPROP_ADD},
6247
6248 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6249 {">>>", 90, 3, JIM_EXPROP_ROTR},
6250 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6251 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6252
6253 {"<", 80, 2, JIM_EXPROP_LT},
6254 {">", 80, 2, JIM_EXPROP_GT},
6255 {"<=", 80, 2, JIM_EXPROP_LTE},
6256 {">=", 80, 2, JIM_EXPROP_GTE},
6257
6258 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6259 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6260
6261 {"eq", 60, 2, JIM_EXPROP_STREQ},
6262 {"ne", 60, 2, JIM_EXPROP_STRNE},
6263
6264 {"&", 50, 2, JIM_EXPROP_BITAND},
6265 {"^", 49, 2, JIM_EXPROP_BITXOR},
6266 {"|", 48, 2, JIM_EXPROP_BITOR},
6267
6268 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6269 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6270
6271 {"?", 5, 3, JIM_EXPROP_TERNARY},
6272 /* private operators */
6273 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6274 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6275 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6276 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6277 };
6278
6279 #define JIM_EXPR_OPERATORS_NUM \
6280 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6281
6282 int JimParseExpression(struct JimParserCtx *pc)
6283 {
6284 /* Discard spaces and quoted newline */
6285 while (*(pc->p) == ' ' ||
6286 *(pc->p) == '\t' ||
6287 *(pc->p) == '\r' ||
6288 *(pc->p) == '\n' ||
6289 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6290 pc->p++; pc->len--;
6291 }
6292
6293 if (pc->len == 0) {
6294 pc->tstart = pc->tend = pc->p;
6295 pc->tline = pc->linenr;
6296 pc->tt = JIM_TT_EOL;
6297 pc->eof = 1;
6298 return JIM_OK;
6299 }
6300 switch (*(pc->p)) {
6301 case '(':
6302 pc->tstart = pc->tend = pc->p;
6303 pc->tline = pc->linenr;
6304 pc->tt = JIM_TT_SUBEXPR_START;
6305 pc->p++; pc->len--;
6306 break;
6307 case ')':
6308 pc->tstart = pc->tend = pc->p;
6309 pc->tline = pc->linenr;
6310 pc->tt = JIM_TT_SUBEXPR_END;
6311 pc->p++; pc->len--;
6312 break;
6313 case '[':
6314 return JimParseCmd(pc);
6315 break;
6316 case '$':
6317 if (JimParseVar(pc) == JIM_ERR)
6318 return JimParseExprOperator(pc);
6319 else
6320 return JIM_OK;
6321 break;
6322 case '-':
6323 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6324 isdigit((int)*(pc->p + 1)))
6325 return JimParseExprNumber(pc);
6326 else
6327 return JimParseExprOperator(pc);
6328 break;
6329 case '0': case '1': case '2': case '3': case '4':
6330 case '5': case '6': case '7': case '8': case '9': case '.':
6331 return JimParseExprNumber(pc);
6332 break;
6333 case '"':
6334 case '{':
6335 /* Here it's possible to reuse the List String parsing. */
6336 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6337 return JimParseListStr(pc);
6338 break;
6339 case 'N': case 'I':
6340 case 'n': case 'i':
6341 if (JimParseExprIrrational(pc) == JIM_ERR)
6342 return JimParseExprOperator(pc);
6343 break;
6344 default:
6345 return JimParseExprOperator(pc);
6346 break;
6347 }
6348 return JIM_OK;
6349 }
6350
6351 int JimParseExprNumber(struct JimParserCtx *pc)
6352 {
6353 int allowdot = 1;
6354 int allowhex = 0;
6355
6356 pc->tstart = pc->p;
6357 pc->tline = pc->linenr;
6358 if (*pc->p == '-') {
6359 pc->p++; pc->len--;
6360 }
6361 while (isdigit((int)*pc->p)
6362 || (allowhex && isxdigit((int)*pc->p))
6363 || (allowdot && *pc->p == '.')
6364 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6365 (*pc->p == 'x' || *pc->p == 'X'))
6366 )
6367 {
6368 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6369 allowhex = 1;
6370 allowdot = 0;
6371 }
6372 if (*pc->p == '.')
6373 allowdot = 0;
6374 pc->p++; pc->len--;
6375 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6376 pc->p += 2; pc->len -= 2;
6377 }
6378 }
6379 pc->tend = pc->p-1;
6380 pc->tt = JIM_TT_EXPR_NUMBER;
6381 return JIM_OK;
6382 }
6383
6384 int JimParseExprIrrational(struct JimParserCtx *pc)
6385 {
6386 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6387 const char **token;
6388 for (token = Tokens; *token != NULL; token++) {
6389 int len = strlen(*token);
6390 if (strncmp(*token, pc->p, len) == 0) {
6391 pc->tstart = pc->p;
6392 pc->tend = pc->p + len - 1;
6393 pc->p += len; pc->len -= len;
6394 pc->tline = pc->linenr;
6395 pc->tt = JIM_TT_EXPR_NUMBER;
6396 return JIM_OK;
6397 }
6398 }
6399 return JIM_ERR;
6400 }
6401
6402 int JimParseExprOperator(struct JimParserCtx *pc)
6403 {
6404 int i;
6405 int bestIdx = -1, bestLen = 0;
6406
6407 /* Try to get the longest match. */
6408 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6409 const char *opname;
6410 int oplen;
6411
6412 opname = Jim_ExprOperators[i].name;
6413 if (opname == NULL) continue;
6414 oplen = strlen(opname);
6415
6416 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6417 bestIdx = i;
6418 bestLen = oplen;
6419 }
6420 }
6421 if (bestIdx == -1) return JIM_ERR;
6422 pc->tstart = pc->p;
6423 pc->tend = pc->p + bestLen - 1;
6424 pc->p += bestLen; pc->len -= bestLen;
6425 pc->tline = pc->linenr;
6426 pc->tt = JIM_TT_EXPR_OPERATOR;
6427 return JIM_OK;
6428 }
6429
6430 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6431 {
6432 int i;
6433 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6434 if (Jim_ExprOperators[i].name &&
6435 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6436 return &Jim_ExprOperators[i];
6437 return NULL;
6438 }
6439
6440 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6441 {
6442 int i;
6443 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6444 if (Jim_ExprOperators[i].opcode == opcode)
6445 return &Jim_ExprOperators[i];
6446 return NULL;
6447 }
6448
6449 /* -----------------------------------------------------------------------------
6450 * Expression Object
6451 * ---------------------------------------------------------------------------*/
6452 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6453 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6454 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6455
6456 static Jim_ObjType exprObjType = {
6457 "expression",
6458 FreeExprInternalRep,
6459 DupExprInternalRep,
6460 NULL,
6461 JIM_TYPE_REFERENCES,
6462 };
6463
6464 /* Expr bytecode structure */
6465 typedef struct ExprByteCode {
6466 int *opcode; /* Integer array of opcodes. */
6467 Jim_Obj **obj; /* Array of associated Jim Objects. */
6468 int len; /* Bytecode length */
6469 int inUse; /* Used for sharing. */
6470 } ExprByteCode;
6471
6472 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6473 {
6474 int i;
6475 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6476
6477 expr->inUse--;
6478 if (expr->inUse != 0) return;
6479 for (i = 0; i < expr->len; i++)
6480 Jim_DecrRefCount(interp, expr->obj[i]);
6481 Jim_Free(expr->opcode);
6482 Jim_Free(expr->obj);
6483 Jim_Free(expr);
6484 }
6485
6486 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6487 {
6488 JIM_NOTUSED(interp);
6489 JIM_NOTUSED(srcPtr);
6490
6491 /* Just returns an simple string. */
6492 dupPtr->typePtr = NULL;
6493 }
6494
6495 /* Add a new instruction to an expression bytecode structure. */
6496 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6497 int opcode, char *str, int len)
6498 {
6499 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6500 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6501 expr->opcode[expr->len] = opcode;
6502 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6503 Jim_IncrRefCount(expr->obj[expr->len]);
6504 expr->len++;
6505 }
6506
6507 /* Check if an expr program looks correct. */
6508 static int ExprCheckCorrectness(ExprByteCode *expr)
6509 {
6510 int i;
6511 int stacklen = 0;
6512
6513 /* Try to check if there are stack underflows,
6514 * and make sure at the end of the program there is
6515 * a single result on the stack. */
6516 for (i = 0; i < expr->len; i++) {
6517 switch (expr->opcode[i]) {
6518 case JIM_EXPROP_NUMBER:
6519 case JIM_EXPROP_STRING:
6520 case JIM_EXPROP_SUBST:
6521 case JIM_EXPROP_VARIABLE:
6522 case JIM_EXPROP_DICTSUGAR:
6523 case JIM_EXPROP_COMMAND:
6524 stacklen++;
6525 break;
6526 case JIM_EXPROP_NOT:
6527 case JIM_EXPROP_BITNOT:
6528 case JIM_EXPROP_UNARYMINUS:
6529 case JIM_EXPROP_UNARYPLUS:
6530 /* Unary operations */
6531 if (stacklen < 1) return JIM_ERR;
6532 break;
6533 case JIM_EXPROP_ADD:
6534 case JIM_EXPROP_SUB:
6535 case JIM_EXPROP_MUL:
6536 case JIM_EXPROP_DIV:
6537 case JIM_EXPROP_MOD:
6538 case JIM_EXPROP_LT:
6539 case JIM_EXPROP_GT:
6540 case JIM_EXPROP_LTE:
6541 case JIM_EXPROP_GTE:
6542 case JIM_EXPROP_ROTL:
6543 case JIM_EXPROP_ROTR:
6544 case JIM_EXPROP_LSHIFT:
6545 case JIM_EXPROP_RSHIFT:
6546 case JIM_EXPROP_NUMEQ:
6547 case JIM_EXPROP_NUMNE:
6548 case JIM_EXPROP_STREQ:
6549 case JIM_EXPROP_STRNE:
6550 case JIM_EXPROP_BITAND:
6551 case JIM_EXPROP_BITXOR:
6552 case JIM_EXPROP_BITOR:
6553 case JIM_EXPROP_LOGICAND:
6554 case JIM_EXPROP_LOGICOR:
6555 case JIM_EXPROP_POW:
6556 /* binary operations */
6557 if (stacklen < 2) return JIM_ERR;
6558 stacklen--;
6559 break;
6560 default:
6561 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6562 break;
6563 }
6564 }
6565 if (stacklen != 1) return JIM_ERR;
6566 return JIM_OK;
6567 }
6568
6569 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6570 ScriptObj *topLevelScript)
6571 {
6572 int i;
6573
6574 return;
6575 for (i = 0; i < expr->len; i++) {
6576 Jim_Obj *foundObjPtr;
6577
6578 if (expr->obj[i] == NULL) continue;
6579 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6580 NULL, expr->obj[i]);
6581 if (foundObjPtr != NULL) {
6582 Jim_IncrRefCount(foundObjPtr);
6583 Jim_DecrRefCount(interp, expr->obj[i]);
6584 expr->obj[i] = foundObjPtr;
6585 }
6586 }
6587 }
6588
6589 /* This procedure converts every occurrence of || and && opereators
6590 * in lazy unary versions.
6591 *
6592 * a b || is converted into:
6593 *
6594 * a <offset> |L b |R
6595 *
6596 * a b && is converted into:
6597 *
6598 * a <offset> &L b &R
6599 *
6600 * "|L" checks if 'a' is true:
6601 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6602 * the opcode just after |R.
6603 * 2) if it is false does nothing.
6604 * "|R" checks if 'b' is true:
6605 * 1) if it is true pushes 1, otherwise pushes 0.
6606 *
6607 * "&L" checks if 'a' is true:
6608 * 1) if it is true does nothing.
6609 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6610 * the opcode just after &R
6611 * "&R" checks if 'a' is true:
6612 * if it is true pushes 1, otherwise pushes 0.
6613 */
6614 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6615 {
6616 while (1) {
6617 int index = -1, leftindex, arity, i, offset;
6618 Jim_ExprOperator *op;
6619
6620 /* Search for || or && */
6621 for (i = 0; i < expr->len; i++) {
6622 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6623 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6624 index = i;
6625 break;
6626 }
6627 }
6628 if (index == -1) return;
6629 /* Search for the end of the first operator */
6630 leftindex = index-1;
6631 arity = 1;
6632 while (arity) {
6633 switch (expr->opcode[leftindex]) {
6634 case JIM_EXPROP_NUMBER:
6635 case JIM_EXPROP_COMMAND:
6636 case JIM_EXPROP_VARIABLE:
6637 case JIM_EXPROP_DICTSUGAR:
6638 case JIM_EXPROP_SUBST:
6639 case JIM_EXPROP_STRING:
6640 break;
6641 default:
6642 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6643 if (op == NULL) {
6644 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6645 }
6646 arity += op->arity;
6647 break;
6648 }
6649 arity--;
6650 leftindex--;
6651 }
6652 leftindex++;
6653 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6654 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6655 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6656 sizeof(int)*(expr->len-leftindex));
6657 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6658 sizeof(Jim_Obj*)*(expr->len-leftindex));
6659 expr->len += 2;
6660 index += 2;
6661 offset = (index-leftindex)-1;
6662 Jim_DecrRefCount(interp, expr->obj[index]);
6663 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6664 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6665 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6666 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6667 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6668 } else {
6669 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6670 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6671 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6672 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6673 }
6674 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6675 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6676 Jim_IncrRefCount(expr->obj[index]);
6677 Jim_IncrRefCount(expr->obj[leftindex]);
6678 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6679 }
6680 }
6681
6682 /* This method takes the string representation of an expression
6683 * and generates a program for the Expr's stack-based VM. */
6684 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6685 {
6686 int exprTextLen;
6687 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6688 struct JimParserCtx parser;
6689 int i, shareLiterals;
6690 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6691 Jim_Stack stack;
6692 Jim_ExprOperator *op;
6693
6694 /* Perform literal sharing with the current procedure
6695 * running only if this expression appears to be not generated
6696 * at runtime. */
6697 shareLiterals = objPtr->typePtr == &sourceObjType;
6698
6699 expr->opcode = NULL;
6700 expr->obj = NULL;
6701 expr->len = 0;
6702 expr->inUse = 1;
6703
6704 Jim_InitStack(&stack);
6705 JimParserInit(&parser, exprText, exprTextLen, 1);
6706 while (!JimParserEof(&parser)) {
6707 char *token;
6708 int len, type;
6709
6710 if (JimParseExpression(&parser) != JIM_OK) {
6711 Jim_SetResultString(interp, "Syntax error in expression", -1);
6712 goto err;
6713 }
6714 token = JimParserGetToken(&parser, &len, &type, NULL);
6715 if (type == JIM_TT_EOL) {
6716 Jim_Free(token);
6717 break;
6718 }
6719 switch (type) {
6720 case JIM_TT_STR:
6721 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6722 break;
6723 case JIM_TT_ESC:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6725 break;
6726 case JIM_TT_VAR:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6728 break;
6729 case JIM_TT_DICTSUGAR:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6731 break;
6732 case JIM_TT_CMD:
6733 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6734 break;
6735 case JIM_TT_EXPR_NUMBER:
6736 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6737 break;
6738 case JIM_TT_EXPR_OPERATOR:
6739 op = JimExprOperatorInfo(token);
6740 while (1) {
6741 Jim_ExprOperator *stackTopOp;
6742
6743 if (Jim_StackPeek(&stack) != NULL) {
6744 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6745 } else {
6746 stackTopOp = NULL;
6747 }
6748 if (Jim_StackLen(&stack) && op->arity != 1 &&
6749 stackTopOp && stackTopOp->precedence >= op->precedence)
6750 {
6751 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6752 Jim_StackPeek(&stack), -1);
6753 Jim_StackPop(&stack);
6754 } else {
6755 break;
6756 }
6757 }
6758 Jim_StackPush(&stack, token);
6759 break;
6760 case JIM_TT_SUBEXPR_START:
6761 Jim_StackPush(&stack, Jim_StrDup("("));
6762 Jim_Free(token);
6763 break;
6764 case JIM_TT_SUBEXPR_END:
6765 {
6766 int found = 0;
6767 while (Jim_StackLen(&stack)) {
6768 char *opstr = Jim_StackPop(&stack);
6769 if (!strcmp(opstr, "(")) {
6770 Jim_Free(opstr);
6771 found = 1;
6772 break;
6773 }
6774 op = JimExprOperatorInfo(opstr);
6775 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6776 }
6777 if (!found) {
6778 Jim_SetResultString(interp,
6779 "Unexpected close parenthesis", -1);
6780 goto err;
6781 }
6782 }
6783 Jim_Free(token);
6784 break;
6785 default:
6786 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6787 break;
6788 }
6789 }
6790 while (Jim_StackLen(&stack)) {
6791 char *opstr = Jim_StackPop(&stack);
6792 op = JimExprOperatorInfo(opstr);
6793 if (op == NULL && !strcmp(opstr, "(")) {
6794 Jim_Free(opstr);
6795 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6796 goto err;
6797 }
6798 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6799 }
6800 /* Check program correctness. */
6801 if (ExprCheckCorrectness(expr) != JIM_OK) {
6802 Jim_SetResultString(interp, "Invalid expression", -1);
6803 goto err;
6804 }
6805
6806 /* Free the stack used for the compilation. */
6807 Jim_FreeStackElements(&stack, Jim_Free);
6808 Jim_FreeStack(&stack);
6809
6810 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6811 ExprMakeLazy(interp, expr);
6812
6813 /* Perform literal sharing */
6814 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6815 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6816 if (bodyObjPtr->typePtr == &scriptObjType) {
6817 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6818 ExprShareLiterals(interp, expr, bodyScript);
6819 }
6820 }
6821
6822 /* Free the old internal rep and set the new one. */
6823 Jim_FreeIntRep(interp, objPtr);
6824 Jim_SetIntRepPtr(objPtr, expr);
6825 objPtr->typePtr = &exprObjType;
6826 return JIM_OK;
6827
6828 err: /* we jump here on syntax/compile errors. */
6829 Jim_FreeStackElements(&stack, Jim_Free);
6830 Jim_FreeStack(&stack);
6831 Jim_Free(expr->opcode);
6832 for (i = 0; i < expr->len; i++) {
6833 Jim_DecrRefCount(interp,expr->obj[i]);
6834 }
6835 Jim_Free(expr->obj);
6836 Jim_Free(expr);
6837 return JIM_ERR;
6838 }
6839
6840 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6841 {
6842 if (objPtr->typePtr != &exprObjType) {
6843 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6844 return NULL;
6845 }
6846 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6847 }
6848
6849 /* -----------------------------------------------------------------------------
6850 * Expressions evaluation.
6851 * Jim uses a specialized stack-based virtual machine for expressions,
6852 * that takes advantage of the fact that expr's operators
6853 * can't be redefined.
6854 *
6855 * Jim_EvalExpression() uses the bytecode compiled by
6856 * SetExprFromAny() method of the "expression" object.
6857 *
6858 * On success a Tcl Object containing the result of the evaluation
6859 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6860 * returned.
6861 * On error the function returns a retcode != to JIM_OK and set a suitable
6862 * error on the interp.
6863 * ---------------------------------------------------------------------------*/
6864 #define JIM_EE_STATICSTACK_LEN 10
6865
6866 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6867 Jim_Obj **exprResultPtrPtr)
6868 {
6869 ExprByteCode *expr;
6870 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6871 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6872
6873 Jim_IncrRefCount(exprObjPtr);
6874 expr = Jim_GetExpression(interp, exprObjPtr);
6875 if (!expr) {
6876 Jim_DecrRefCount(interp, exprObjPtr);
6877 return JIM_ERR; /* error in expression. */
6878 }
6879 /* In order to avoid that the internal repr gets freed due to
6880 * shimmering of the exprObjPtr's object, we make the internal rep
6881 * shared. */
6882 expr->inUse++;
6883
6884 /* The stack-based expr VM itself */
6885
6886 /* Stack allocation. Expr programs have the feature that
6887 * a program of length N can't require a stack longer than
6888 * N. */
6889 if (expr->len > JIM_EE_STATICSTACK_LEN)
6890 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6891 else
6892 stack = staticStack;
6893
6894 /* Execute every istruction */
6895 for (i = 0; i < expr->len; i++) {
6896 Jim_Obj *A, *B, *objPtr;
6897 jim_wide wA, wB, wC;
6898 double dA, dB, dC;
6899 const char *sA, *sB;
6900 int Alen, Blen, retcode;
6901 int opcode = expr->opcode[i];
6902
6903 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6904 stack[stacklen++] = expr->obj[i];
6905 Jim_IncrRefCount(expr->obj[i]);
6906 } else if (opcode == JIM_EXPROP_VARIABLE) {
6907 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6908 if (objPtr == NULL) {
6909 error = 1;
6910 goto err;
6911 }
6912 stack[stacklen++] = objPtr;
6913 Jim_IncrRefCount(objPtr);
6914 } else if (opcode == JIM_EXPROP_SUBST) {
6915 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6916 &objPtr, JIM_NONE)) != JIM_OK)
6917 {
6918 error = 1;
6919 errRetCode = retcode;
6920 goto err;
6921 }
6922 stack[stacklen++] = objPtr;
6923 Jim_IncrRefCount(objPtr);
6924 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6925 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6926 if (objPtr == NULL) {
6927 error = 1;
6928 goto err;
6929 }
6930 stack[stacklen++] = objPtr;
6931 Jim_IncrRefCount(objPtr);
6932 } else if (opcode == JIM_EXPROP_COMMAND) {
6933 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6934 error = 1;
6935 errRetCode = retcode;
6936 goto err;
6937 }
6938 stack[stacklen++] = interp->result;
6939 Jim_IncrRefCount(interp->result);
6940 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6941 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6942 {
6943 /* Note that there isn't to increment the
6944 * refcount of objects. the references are moved
6945 * from stack to A and B. */
6946 B = stack[--stacklen];
6947 A = stack[--stacklen];
6948
6949 /* --- Integer --- */
6950 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6951 (B->typePtr == &doubleObjType && !B->bytes) ||
6952 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6953 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6954 goto trydouble;
6955 }
6956 Jim_DecrRefCount(interp, A);
6957 Jim_DecrRefCount(interp, B);
6958 switch (expr->opcode[i]) {
6959 case JIM_EXPROP_ADD: wC = wA + wB; break;
6960 case JIM_EXPROP_SUB: wC = wA-wB; break;
6961 case JIM_EXPROP_MUL: wC = wA*wB; break;
6962 case JIM_EXPROP_LT: wC = wA < wB; break;
6963 case JIM_EXPROP_GT: wC = wA > wB; break;
6964 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6965 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6966 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6967 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6968 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6969 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6970 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6971 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6972 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6973 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6974 case JIM_EXPROP_LOGICAND_LEFT:
6975 if (wA == 0) {
6976 i += (int)wB;
6977 wC = 0;
6978 } else {
6979 continue;
6980 }
6981 break;
6982 case JIM_EXPROP_LOGICOR_LEFT:
6983 if (wA != 0) {
6984 i += (int)wB;
6985 wC = 1;
6986 } else {
6987 continue;
6988 }
6989 break;
6990 case JIM_EXPROP_DIV:
6991 if (wB == 0) goto divbyzero;
6992 wC = wA/wB;
6993 break;
6994 case JIM_EXPROP_MOD:
6995 if (wB == 0) goto divbyzero;
6996 wC = wA%wB;
6997 break;
6998 case JIM_EXPROP_ROTL: {
6999 /* uint32_t would be better. But not everyone has inttypes.h?*/
7000 unsigned long uA = (unsigned long)wA;
7001 #ifdef _MSC_VER
7002 wC = _rotl(uA,(unsigned long)wB);
7003 #else
7004 const unsigned int S = sizeof(unsigned long) * 8;
7005 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7006 #endif
7007 break;
7008 }
7009 case JIM_EXPROP_ROTR: {
7010 unsigned long uA = (unsigned long)wA;
7011 #ifdef _MSC_VER
7012 wC = _rotr(uA,(unsigned long)wB);
7013 #else
7014 const unsigned int S = sizeof(unsigned long) * 8;
7015 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7016 #endif
7017 break;
7018 }
7019
7020 default:
7021 wC = 0; /* avoid gcc warning */
7022 break;
7023 }
7024 stack[stacklen] = Jim_NewIntObj(interp, wC);
7025 Jim_IncrRefCount(stack[stacklen]);
7026 stacklen++;
7027 continue;
7028 trydouble:
7029 /* --- Double --- */
7030 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7031 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7032
7033 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7034 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7035 opcode = JIM_EXPROP_STRNE;
7036 goto retry_as_string;
7037 }
7038 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7039 opcode = JIM_EXPROP_STREQ;
7040 goto retry_as_string;
7041 }
7042 Jim_DecrRefCount(interp, A);
7043 Jim_DecrRefCount(interp, B);
7044 error = 1;
7045 goto err;
7046 }
7047 Jim_DecrRefCount(interp, A);
7048 Jim_DecrRefCount(interp, B);
7049 switch (expr->opcode[i]) {
7050 case JIM_EXPROP_ROTL:
7051 case JIM_EXPROP_ROTR:
7052 case JIM_EXPROP_LSHIFT:
7053 case JIM_EXPROP_RSHIFT:
7054 case JIM_EXPROP_BITAND:
7055 case JIM_EXPROP_BITXOR:
7056 case JIM_EXPROP_BITOR:
7057 case JIM_EXPROP_MOD:
7058 case JIM_EXPROP_POW:
7059 Jim_SetResultString(interp,
7060 "Got floating-point value where integer was expected", -1);
7061 error = 1;
7062 goto err;
7063 break;
7064 case JIM_EXPROP_ADD: dC = dA + dB; break;
7065 case JIM_EXPROP_SUB: dC = dA-dB; break;
7066 case JIM_EXPROP_MUL: dC = dA*dB; break;
7067 case JIM_EXPROP_LT: dC = dA < dB; break;
7068 case JIM_EXPROP_GT: dC = dA > dB; break;
7069 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7070 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7071 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7072 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7073 case JIM_EXPROP_LOGICAND_LEFT:
7074 if (dA == 0) {
7075 i += (int)dB;
7076 dC = 0;
7077 } else {
7078 continue;
7079 }
7080 break;
7081 case JIM_EXPROP_LOGICOR_LEFT:
7082 if (dA != 0) {
7083 i += (int)dB;
7084 dC = 1;
7085 } else {
7086 continue;
7087 }
7088 break;
7089 case JIM_EXPROP_DIV:
7090 if (dB == 0) goto divbyzero;
7091 dC = dA/dB;
7092 break;
7093 default:
7094 dC = 0; /* avoid gcc warning */
7095 break;
7096 }
7097 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7098 Jim_IncrRefCount(stack[stacklen]);
7099 stacklen++;
7100 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7101 B = stack[--stacklen];
7102 A = stack[--stacklen];
7103 retry_as_string:
7104 sA = Jim_GetString(A, &Alen);
7105 sB = Jim_GetString(B, &Blen);
7106 switch (opcode) {
7107 case JIM_EXPROP_STREQ:
7108 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7109 wC = 1;
7110 else
7111 wC = 0;
7112 break;
7113 case JIM_EXPROP_STRNE:
7114 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7115 wC = 1;
7116 else
7117 wC = 0;
7118 break;
7119 default:
7120 wC = 0; /* avoid gcc warning */
7121 break;
7122 }
7123 Jim_DecrRefCount(interp, A);
7124 Jim_DecrRefCount(interp, B);
7125 stack[stacklen] = Jim_NewIntObj(interp, wC);
7126 Jim_IncrRefCount(stack[stacklen]);
7127 stacklen++;
7128 } else if (opcode == JIM_EXPROP_NOT ||
7129 opcode == JIM_EXPROP_BITNOT ||
7130 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7131 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7132 /* Note that there isn't to increment the
7133 * refcount of objects. the references are moved
7134 * from stack to A and B. */
7135 A = stack[--stacklen];
7136
7137 /* --- Integer --- */
7138 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7139 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7140 goto trydouble_unary;
7141 }
7142 Jim_DecrRefCount(interp, A);
7143 switch (expr->opcode[i]) {
7144 case JIM_EXPROP_NOT: wC = !wA; break;
7145 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7146 case JIM_EXPROP_LOGICAND_RIGHT:
7147 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7148 default:
7149 wC = 0; /* avoid gcc warning */
7150 break;
7151 }
7152 stack[stacklen] = Jim_NewIntObj(interp, wC);
7153 Jim_IncrRefCount(stack[stacklen]);
7154 stacklen++;
7155 continue;
7156 trydouble_unary:
7157 /* --- Double --- */
7158 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7159 Jim_DecrRefCount(interp, A);
7160 error = 1;
7161 goto err;
7162 }
7163 Jim_DecrRefCount(interp, A);
7164 switch (expr->opcode[i]) {
7165 case JIM_EXPROP_NOT: dC = !dA; break;
7166 case JIM_EXPROP_LOGICAND_RIGHT:
7167 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7168 case JIM_EXPROP_BITNOT:
7169 Jim_SetResultString(interp,
7170 "Got floating-point value where integer was expected", -1);
7171 error = 1;
7172 goto err;
7173 break;
7174 default:
7175 dC = 0; /* avoid gcc warning */
7176 break;
7177 }
7178 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7179 Jim_IncrRefCount(stack[stacklen]);
7180 stacklen++;
7181 } else {
7182 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7183 }
7184 }
7185 err:
7186 /* There is no need to decerement the inUse field because
7187 * this reference is transfered back into the exprObjPtr. */
7188 Jim_FreeIntRep(interp, exprObjPtr);
7189 exprObjPtr->typePtr = &exprObjType;
7190 Jim_SetIntRepPtr(exprObjPtr, expr);
7191 Jim_DecrRefCount(interp, exprObjPtr);
7192 if (!error) {
7193 *exprResultPtrPtr = stack[0];
7194 Jim_IncrRefCount(stack[0]);
7195 errRetCode = JIM_OK;
7196 }
7197 for (i = 0; i < stacklen; i++) {
7198 Jim_DecrRefCount(interp, stack[i]);
7199 }
7200 if (stack != staticStack)
7201 Jim_Free(stack);
7202 return errRetCode;
7203 divbyzero:
7204 error = 1;
7205 Jim_SetResultString(interp, "Division by zero", -1);
7206 goto err;
7207 }
7208
7209 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7210 {
7211 int retcode;
7212 jim_wide wideValue;
7213 double doubleValue;
7214 Jim_Obj *exprResultPtr;
7215
7216 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7217 if (retcode != JIM_OK)
7218 return retcode;
7219 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7220 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7221 {
7222 Jim_DecrRefCount(interp, exprResultPtr);
7223 return JIM_ERR;
7224 } else {
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 *boolPtr = doubleValue != 0;
7227 return JIM_OK;
7228 }
7229 }
7230 Jim_DecrRefCount(interp, exprResultPtr);
7231 *boolPtr = wideValue != 0;
7232 return JIM_OK;
7233 }
7234
7235 /* -----------------------------------------------------------------------------
7236 * ScanFormat String Object
7237 * ---------------------------------------------------------------------------*/
7238
7239 /* This Jim_Obj will held a parsed representation of a format string passed to
7240 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7241 * to be parsed in its entirely first and then, if correct, can be used for
7242 * scanning. To avoid endless re-parsing, the parsed representation will be
7243 * stored in an internal representation and re-used for performance reason. */
7244
7245 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7246 * scanformat string. This part will later be used to extract information
7247 * out from the string to be parsed by Jim_ScanString */
7248
7249 typedef struct ScanFmtPartDescr {
7250 char type; /* Type of conversion (e.g. c, d, f) */
7251 char modifier; /* Modify type (e.g. l - long, h - short */
7252 size_t width; /* Maximal width of input to be converted */
7253 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7254 char *arg; /* Specification of a CHARSET conversion */
7255 char *prefix; /* Prefix to be scanned literally before conversion */
7256 } ScanFmtPartDescr;
7257
7258 /* The ScanFmtStringObj will held the internal representation of a scanformat
7259 * string parsed and separated in part descriptions. Furthermore it contains
7260 * the original string representation of the scanformat string to allow for
7261 * fast update of the Jim_Obj's string representation part.
7262 *
7263 * As add-on the internal object representation add some scratch pad area
7264 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7265 * memory for purpose of string scanning.
7266 *
7267 * The error member points to a static allocated string in case of a mal-
7268 * formed scanformat string or it contains '0' (NULL) in case of a valid
7269 * parse representation.
7270 *
7271 * The whole memory of the internal representation is allocated as a single
7272 * area of memory that will be internally separated. So freeing and duplicating
7273 * of such an object is cheap */
7274
7275 typedef struct ScanFmtStringObj {
7276 jim_wide size; /* Size of internal repr in bytes */
7277 char *stringRep; /* Original string representation */
7278 size_t count; /* Number of ScanFmtPartDescr contained */
7279 size_t convCount; /* Number of conversions that will assign */
7280 size_t maxPos; /* Max position index if XPG3 is used */
7281 const char *error; /* Ptr to error text (NULL if no error */
7282 char *scratch; /* Some scratch pad used by Jim_ScanString */
7283 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7284 } ScanFmtStringObj;
7285
7286
7287 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7288 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7289 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7290
7291 static Jim_ObjType scanFmtStringObjType = {
7292 "scanformatstring",
7293 FreeScanFmtInternalRep,
7294 DupScanFmtInternalRep,
7295 UpdateStringOfScanFmt,
7296 JIM_TYPE_NONE,
7297 };
7298
7299 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7300 {
7301 JIM_NOTUSED(interp);
7302 Jim_Free((char*)objPtr->internalRep.ptr);
7303 objPtr->internalRep.ptr = 0;
7304 }
7305
7306 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7307 {
7308 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7309 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7310
7311 JIM_NOTUSED(interp);
7312 memcpy(newVec, srcPtr->internalRep.ptr, size);
7313 dupPtr->internalRep.ptr = newVec;
7314 dupPtr->typePtr = &scanFmtStringObjType;
7315 }
7316
7317 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7318 {
7319 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7320
7321 objPtr->bytes = Jim_StrDup(bytes);
7322 objPtr->length = strlen(bytes);
7323 }
7324
7325 /* SetScanFmtFromAny will parse a given string and create the internal
7326 * representation of the format specification. In case of an error
7327 * the error data member of the internal representation will be set
7328 * to an descriptive error text and the function will be left with
7329 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7330 * specification */
7331
7332 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7333 {
7334 ScanFmtStringObj *fmtObj;
7335 char *buffer;
7336 int maxCount, i, approxSize, lastPos = -1;
7337 const char *fmt = objPtr->bytes;
7338 int maxFmtLen = objPtr->length;
7339 const char *fmtEnd = fmt + maxFmtLen;
7340 int curr;
7341
7342 Jim_FreeIntRep(interp, objPtr);
7343 /* Count how many conversions could take place maximally */
7344 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7345 if (fmt[i] == '%')
7346 ++maxCount;
7347 /* Calculate an approximation of the memory necessary */
7348 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7349 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7350 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7351 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7352 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7353 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7354 + 1; /* safety byte */
7355 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7356 memset(fmtObj, 0, approxSize);
7357 fmtObj->size = approxSize;
7358 fmtObj->maxPos = 0;
7359 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7360 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7361 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7362 buffer = fmtObj->stringRep + maxFmtLen + 1;
7363 objPtr->internalRep.ptr = fmtObj;
7364 objPtr->typePtr = &scanFmtStringObjType;
7365 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7366 int width = 0, skip;
7367 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7368 fmtObj->count++;
7369 descr->width = 0; /* Assume width unspecified */
7370 /* Overread and store any "literal" prefix */
7371 if (*fmt != '%' || fmt[1] == '%') {
7372 descr->type = 0;
7373 descr->prefix = &buffer[i];
7374 for (; fmt < fmtEnd; ++fmt) {
7375 if (*fmt == '%') {
7376 if (fmt[1] != '%') break;
7377 ++fmt;
7378 }
7379 buffer[i++] = *fmt;
7380 }
7381 buffer[i++] = 0;
7382 }
7383 /* Skip the conversion introducing '%' sign */
7384 ++fmt;
7385 /* End reached due to non-conversion literal only? */
7386 if (fmt >= fmtEnd)
7387 goto done;
7388 descr->pos = 0; /* Assume "natural" positioning */
7389 if (*fmt == '*') {
7390 descr->pos = -1; /* Okay, conversion will not be assigned */
7391 ++fmt;
7392 } else
7393 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7394 /* Check if next token is a number (could be width or pos */
7395 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7396 fmt += skip;
7397 /* Was the number a XPG3 position specifier? */
7398 if (descr->pos != -1 && *fmt == '$') {
7399 int prev;
7400 ++fmt;
7401 descr->pos = width;
7402 width = 0;
7403 /* Look if "natural" postioning and XPG3 one was mixed */
7404 if ((lastPos == 0 && descr->pos > 0)
7405 || (lastPos > 0 && descr->pos == 0)) {
7406 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7407 return JIM_ERR;
7408 }
7409 /* Look if this position was already used */
7410 for (prev = 0; prev < curr; ++prev) {
7411 if (fmtObj->descr[prev].pos == -1) continue;
7412 if (fmtObj->descr[prev].pos == descr->pos) {
7413 fmtObj->error = "same \"%n$\" conversion specifier "
7414 "used more than once";
7415 return JIM_ERR;
7416 }
7417 }
7418 /* Try to find a width after the XPG3 specifier */
7419 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7420 descr->width = width;
7421 fmt += skip;
7422 }
7423 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7424 fmtObj->maxPos = descr->pos;
7425 } else {
7426 /* Number was not a XPG3, so it has to be a width */
7427 descr->width = width;
7428 }
7429 }
7430 /* If positioning mode was undetermined yet, fix this */
7431 if (lastPos == -1)
7432 lastPos = descr->pos;
7433 /* Handle CHARSET conversion type ... */
7434 if (*fmt == '[') {
7435 int swapped = 1, beg = i, end, j;
7436 descr->type = '[';
7437 descr->arg = &buffer[i];
7438 ++fmt;
7439 if (*fmt == '^') buffer[i++] = *fmt++;
7440 if (*fmt == ']') buffer[i++] = *fmt++;
7441 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7442 if (*fmt != ']') {
7443 fmtObj->error = "unmatched [ in format string";
7444 return JIM_ERR;
7445 }
7446 end = i;
7447 buffer[i++] = 0;
7448 /* In case a range fence was given "backwards", swap it */
7449 while (swapped) {
7450 swapped = 0;
7451 for (j = beg + 1; j < end-1; ++j) {
7452 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7453 char tmp = buffer[j-1];
7454 buffer[j-1] = buffer[j + 1];
7455 buffer[j + 1] = tmp;
7456 swapped = 1;
7457 }
7458 }
7459 }
7460 } else {
7461 /* Remember any valid modifier if given */
7462 if (strchr("hlL", *fmt) != 0)
7463 descr->modifier = tolower((int)*fmt++);
7464
7465 descr->type = *fmt;
7466 if (strchr("efgcsndoxui", *fmt) == 0) {
7467 fmtObj->error = "bad scan conversion character";
7468 return JIM_ERR;
7469 } else if (*fmt == 'c' && descr->width != 0) {
7470 fmtObj->error = "field width may not be specified in %c "
7471 "conversion";
7472 return JIM_ERR;
7473 } else if (*fmt == 'u' && descr->modifier == 'l') {
7474 fmtObj->error = "unsigned wide not supported";
7475 return JIM_ERR;
7476 }
7477 }
7478 curr++;
7479 }
7480 done:
7481 if (fmtObj->convCount == 0) {
7482 fmtObj->error = "no any conversion specifier given";
7483 return JIM_ERR;
7484 }
7485 return JIM_OK;
7486 }
7487
7488 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7489
7490 #define FormatGetCnvCount(_fo_) \
7491 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7492 #define FormatGetMaxPos(_fo_) \
7493 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7494 #define FormatGetError(_fo_) \
7495 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7496
7497 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7498 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7499 * bitvector implementation in Jim? */
7500
7501 static int JimTestBit(const char *bitvec, char ch)
7502 {
7503 div_t pos = div(ch-1, 8);
7504 return bitvec[pos.quot] & (1 << pos.rem);
7505 }
7506
7507 static void JimSetBit(char *bitvec, char ch)
7508 {
7509 div_t pos = div(ch-1, 8);
7510 bitvec[pos.quot] |= (1 << pos.rem);
7511 }
7512
7513 #if 0 /* currently not used */
7514 static void JimClearBit(char *bitvec, char ch)
7515 {
7516 div_t pos = div(ch-1, 8);
7517 bitvec[pos.quot] &= ~(1 << pos.rem);
7518 }
7519 #endif
7520
7521 /* JimScanAString is used to scan an unspecified string that ends with
7522 * next WS, or a string that is specified via a charset. The charset
7523 * is currently implemented in a way to only allow for usage with
7524 * ASCII. Whenever we will switch to UNICODE, another idea has to
7525 * be born :-/
7526 *
7527 * FIXME: Works only with ASCII */
7528
7529 static Jim_Obj *
7530 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7531 {
7532 size_t i;
7533 Jim_Obj *result;
7534 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7535 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7536
7537 /* First init charset to nothing or all, depending if a specified
7538 * or an unspecified string has to be parsed */
7539 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7540 if (sdescr) {
7541 /* There was a set description given, that means we are parsing
7542 * a specified string. So we have to build a corresponding
7543 * charset reflecting the description */
7544 int notFlag = 0;
7545 /* Should the set be negated at the end? */
7546 if (*sdescr == '^') {
7547 notFlag = 1;
7548 ++sdescr;
7549 }
7550 /* Here '-' is meant literally and not to define a range */
7551 if (*sdescr == '-') {
7552 JimSetBit(charset, '-');
7553 ++sdescr;
7554 }
7555 while (*sdescr) {
7556 if (sdescr[1] == '-' && sdescr[2] != 0) {
7557 /* Handle range definitions */
7558 int i;
7559 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7560 JimSetBit(charset, (char)i);
7561 sdescr += 3;
7562 } else {
7563 /* Handle verbatim character definitions */
7564 JimSetBit(charset, *sdescr++);
7565 }
7566 }
7567 /* Negate the charset if there was a NOT given */
7568 for (i = 0; notFlag && i < sizeof(charset); ++i)
7569 charset[i] = ~charset[i];
7570 }
7571 /* And after all the mess above, the real work begin ... */
7572 while (str && *str) {
7573 if (!sdescr && isspace((int)*str))
7574 break; /* EOS via WS if unspecified */
7575 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7576 else break; /* EOS via mismatch if specified scanning */
7577 }
7578 *buffer = 0; /* Close the string properly ... */
7579 result = Jim_NewStringObj(interp, anchor, -1);
7580 Jim_Free(anchor); /* ... and free it afer usage */
7581 return result;
7582 }
7583
7584 /* ScanOneEntry will scan one entry out of the string passed as argument.
7585 * It use the sscanf() function for this task. After extracting and
7586 * converting of the value, the count of scanned characters will be
7587 * returned of -1 in case of no conversion tool place and string was
7588 * already scanned thru */
7589
7590 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7591 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7592 {
7593 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7594 ? sizeof(jim_wide) \
7595 : sizeof(double))
7596 char buffer[MAX_SIZE];
7597 char *value = buffer;
7598 const char *tok;
7599 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7600 size_t sLen = strlen(&str[pos]), scanned = 0;
7601 size_t anchor = pos;
7602 int i;
7603
7604 /* First pessimiticly assume, we will not scan anything :-) */
7605 *valObjPtr = 0;
7606 if (descr->prefix) {
7607 /* There was a prefix given before the conversion, skip it and adjust
7608 * the string-to-be-parsed accordingly */
7609 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7610 /* If prefix require, skip WS */
7611 if (isspace((int)descr->prefix[i]))
7612 while (str[pos] && isspace((int)str[pos])) ++pos;
7613 else if (descr->prefix[i] != str[pos])
7614 break; /* Prefix do not match here, leave the loop */
7615 else
7616 ++pos; /* Prefix matched so far, next round */
7617 }
7618 if (str[pos] == 0)
7619 return -1; /* All of str consumed: EOF condition */
7620 else if (descr->prefix[i] != 0)
7621 return 0; /* Not whole prefix consumed, no conversion possible */
7622 }
7623 /* For all but following conversion, skip leading WS */
7624 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7625 while (isspace((int)str[pos])) ++pos;
7626 /* Determine how much skipped/scanned so far */
7627 scanned = pos - anchor;
7628 if (descr->type == 'n') {
7629 /* Return pseudo conversion means: how much scanned so far? */
7630 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7631 } else if (str[pos] == 0) {
7632 /* Cannot scan anything, as str is totally consumed */
7633 return -1;
7634 } else {
7635 /* Processing of conversions follows ... */
7636 if (descr->width > 0) {
7637 /* Do not try to scan as fas as possible but only the given width.
7638 * To ensure this, we copy the part that should be scanned. */
7639 size_t tLen = descr->width > sLen ? sLen : descr->width;
7640 tok = Jim_StrDupLen(&str[pos], tLen);
7641 } else {
7642 /* As no width was given, simply refer to the original string */
7643 tok = &str[pos];
7644 }
7645 switch (descr->type) {
7646 case 'c':
7647 *valObjPtr = Jim_NewIntObj(interp, *tok);
7648 scanned += 1;
7649 break;
7650 case 'd': case 'o': case 'x': case 'u': case 'i': {
7651 jim_wide jwvalue = 0;
7652 long lvalue = 0;
7653 char *endp; /* Position where the number finished */
7654 int base = descr->type == 'o' ? 8
7655 : descr->type == 'x' ? 16
7656 : descr->type == 'i' ? 0
7657 : 10;
7658
7659 do {
7660 /* Try to scan a number with the given base */
7661 if (descr->modifier == 'l')
7662 {
7663 #ifdef HAVE_LONG_LONG_INT
7664 jwvalue = JimStrtoll(tok, &endp, base),
7665 #else
7666 jwvalue = strtol(tok, &endp, base),
7667 #endif
7668 memcpy(value, &jwvalue, sizeof(jim_wide));
7669 }
7670 else
7671 {
7672 if (descr->type == 'u')
7673 lvalue = strtoul(tok, &endp, base);
7674 else
7675 lvalue = strtol(tok, &endp, base);
7676 memcpy(value, &lvalue, sizeof(lvalue));
7677 }
7678 /* If scanning failed, and base was undetermined, simply
7679 * put it to 10 and try once more. This should catch the
7680 * case where %i begin to parse a number prefix (e.g.
7681 * '0x' but no further digits follows. This will be
7682 * handled as a ZERO followed by a char 'x' by Tcl */
7683 if (endp == tok && base == 0) base = 10;
7684 else break;
7685 } while (1);
7686 if (endp != tok) {
7687 /* There was some number sucessfully scanned! */
7688 if (descr->modifier == 'l')
7689 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7690 else
7691 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7692 /* Adjust the number-of-chars scanned so far */
7693 scanned += endp - tok;
7694 } else {
7695 /* Nothing was scanned. We have to determine if this
7696 * happened due to e.g. prefix mismatch or input str
7697 * exhausted */
7698 scanned = *tok ? 0 : -1;
7699 }
7700 break;
7701 }
7702 case 's': case '[': {
7703 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7704 scanned += Jim_Length(*valObjPtr);
7705 break;
7706 }
7707 case 'e': case 'f': case 'g': {
7708 char *endp;
7709
7710 double dvalue = strtod(tok, &endp);
7711 memcpy(value, &dvalue, sizeof(double));
7712 if (endp != tok) {
7713 /* There was some number sucessfully scanned! */
7714 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7715 /* Adjust the number-of-chars scanned so far */
7716 scanned += endp - tok;
7717 } else {
7718 /* Nothing was scanned. We have to determine if this
7719 * happened due to e.g. prefix mismatch or input str
7720 * exhausted */
7721 scanned = *tok ? 0 : -1;
7722 }
7723 break;
7724 }
7725 }
7726 /* If a substring was allocated (due to pre-defined width) do not
7727 * forget to free it */
7728 if (tok != &str[pos])
7729 Jim_Free((char*)tok);
7730 }
7731 return scanned;
7732 }
7733
7734 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7735 * string and returns all converted (and not ignored) values in a list back
7736 * to the caller. If an error occured, a NULL pointer will be returned */
7737
7738 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7739 Jim_Obj *fmtObjPtr, int flags)
7740 {
7741 size_t i, pos;
7742 int scanned = 1;
7743 const char *str = Jim_GetString(strObjPtr, 0);
7744 Jim_Obj *resultList = 0;
7745 Jim_Obj **resultVec =NULL;
7746 int resultc;
7747 Jim_Obj *emptyStr = 0;
7748 ScanFmtStringObj *fmtObj;
7749
7750 /* If format specification is not an object, convert it! */
7751 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7752 SetScanFmtFromAny(interp, fmtObjPtr);
7753 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7754 /* Check if format specification was valid */
7755 if (fmtObj->error != 0) {
7756 if (flags & JIM_ERRMSG)
7757 Jim_SetResultString(interp, fmtObj->error, -1);
7758 return 0;
7759 }
7760 /* Allocate a new "shared" empty string for all unassigned conversions */
7761 emptyStr = Jim_NewEmptyStringObj(interp);
7762 Jim_IncrRefCount(emptyStr);
7763 /* Create a list and fill it with empty strings up to max specified XPG3 */
7764 resultList = Jim_NewListObj(interp, 0, 0);
7765 if (fmtObj->maxPos > 0) {
7766 for (i = 0; i < fmtObj->maxPos; ++i)
7767 Jim_ListAppendElement(interp, resultList, emptyStr);
7768 JimListGetElements(interp, resultList, &resultc, &resultVec);
7769 }
7770 /* Now handle every partial format description */
7771 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7772 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7773 Jim_Obj *value = 0;
7774 /* Only last type may be "literal" w/o conversion - skip it! */
7775 if (descr->type == 0) continue;
7776 /* As long as any conversion could be done, we will proceed */
7777 if (scanned > 0)
7778 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7779 /* In case our first try results in EOF, we will leave */
7780 if (scanned == -1 && i == 0)
7781 goto eof;
7782 /* Advance next pos-to-be-scanned for the amount scanned already */
7783 pos += scanned;
7784 /* value == 0 means no conversion took place so take empty string */
7785 if (value == 0)
7786 value = Jim_NewEmptyStringObj(interp);
7787 /* If value is a non-assignable one, skip it */
7788 if (descr->pos == -1) {
7789 Jim_FreeNewObj(interp, value);
7790 } else if (descr->pos == 0)
7791 /* Otherwise append it to the result list if no XPG3 was given */
7792 Jim_ListAppendElement(interp, resultList, value);
7793 else if (resultVec[descr->pos-1] == emptyStr) {
7794 /* But due to given XPG3, put the value into the corr. slot */
7795 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7796 Jim_IncrRefCount(value);
7797 resultVec[descr->pos-1] = value;
7798 } else {
7799 /* Otherwise, the slot was already used - free obj and ERROR */
7800 Jim_FreeNewObj(interp, value);
7801 goto err;
7802 }
7803 }
7804 Jim_DecrRefCount(interp, emptyStr);
7805 return resultList;
7806 eof:
7807 Jim_DecrRefCount(interp, emptyStr);
7808 Jim_FreeNewObj(interp, resultList);
7809 return (Jim_Obj*)EOF;
7810 err:
7811 Jim_DecrRefCount(interp, emptyStr);
7812 Jim_FreeNewObj(interp, resultList);
7813 return 0;
7814 }
7815
7816 /* -----------------------------------------------------------------------------
7817 * Pseudo Random Number Generation
7818 * ---------------------------------------------------------------------------*/
7819 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7820 int seedLen);
7821
7822 /* Initialize the sbox with the numbers from 0 to 255 */
7823 static void JimPrngInit(Jim_Interp *interp)
7824 {
7825 int i;
7826 unsigned int seed[256];
7827
7828 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7829 for (i = 0; i < 256; i++)
7830 seed[i] = (rand() ^ time(NULL) ^ clock());
7831 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7832 }
7833
7834 /* Generates N bytes of random data */
7835 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7836 {
7837 Jim_PrngState *prng;
7838 unsigned char *destByte = (unsigned char*) dest;
7839 unsigned int si, sj, x;
7840
7841 /* initialization, only needed the first time */
7842 if (interp->prngState == NULL)
7843 JimPrngInit(interp);
7844 prng = interp->prngState;
7845 /* generates 'len' bytes of pseudo-random numbers */
7846 for (x = 0; x < len; x++) {
7847 prng->i = (prng->i + 1) & 0xff;
7848 si = prng->sbox[prng->i];
7849 prng->j = (prng->j + si) & 0xff;
7850 sj = prng->sbox[prng->j];
7851 prng->sbox[prng->i] = sj;
7852 prng->sbox[prng->j] = si;
7853 *destByte++ = prng->sbox[(si + sj)&0xff];
7854 }
7855 }
7856
7857 /* Re-seed the generator with user-provided bytes */
7858 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7859 int seedLen)
7860 {
7861 int i;
7862 unsigned char buf[256];
7863 Jim_PrngState *prng;
7864
7865 /* initialization, only needed the first time */
7866 if (interp->prngState == NULL)
7867 JimPrngInit(interp);
7868 prng = interp->prngState;
7869
7870 /* Set the sbox[i] with i */
7871 for (i = 0; i < 256; i++)
7872 prng->sbox[i] = i;
7873 /* Now use the seed to perform a random permutation of the sbox */
7874 for (i = 0; i < seedLen; i++) {
7875 unsigned char t;
7876
7877 t = prng->sbox[i&0xFF];
7878 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7879 prng->sbox[seed[i]] = t;
7880 }
7881 prng->i = prng->j = 0;
7882 /* discard the first 256 bytes of stream. */
7883 JimRandomBytes(interp, buf, 256);
7884 }
7885
7886 /* -----------------------------------------------------------------------------
7887 * Dynamic libraries support (WIN32 not supported)
7888 * ---------------------------------------------------------------------------*/
7889
7890 #ifdef JIM_DYNLIB
7891 #ifdef WIN32
7892 #define RTLD_LAZY 0
7893 void * dlopen(const char *path, int mode)
7894 {
7895 JIM_NOTUSED(mode);
7896
7897 return (void *)LoadLibraryA(path);
7898 }
7899 int dlclose(void *handle)
7900 {
7901 FreeLibrary((HANDLE)handle);
7902 return 0;
7903 }
7904 void *dlsym(void *handle, const char *symbol)
7905 {
7906 return GetProcAddress((HMODULE)handle, symbol);
7907 }
7908 static char win32_dlerror_string[121];
7909 const char *dlerror(void)
7910 {
7911 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7912 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7913 return win32_dlerror_string;
7914 }
7915 #endif /* WIN32 */
7916
7917 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7918 {
7919 Jim_Obj *libPathObjPtr;
7920 int prefixc, i;
7921 void *handle;
7922 int (*onload)(Jim_Interp *interp);
7923
7924 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7925 if (libPathObjPtr == NULL) {
7926 prefixc = 0;
7927 libPathObjPtr = NULL;
7928 } else {
7929 Jim_IncrRefCount(libPathObjPtr);
7930 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7931 }
7932
7933 for (i = -1; i < prefixc; i++) {
7934 if (i < 0) {
7935 handle = dlopen(pathName, RTLD_LAZY);
7936 } else {
7937 FILE *fp;
7938 char buf[JIM_PATH_LEN];
7939 const char *prefix;
7940 int prefixlen;
7941 Jim_Obj *prefixObjPtr;
7942
7943 buf[0] = '\0';
7944 if (Jim_ListIndex(interp, libPathObjPtr, i,
7945 &prefixObjPtr, JIM_NONE) != JIM_OK)
7946 continue;
7947 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7948 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7949 continue;
7950 if (*pathName == '/') {
7951 strcpy(buf, pathName);
7952 }
7953 else if (prefixlen && prefix[prefixlen-1] == '/')
7954 sprintf(buf, "%s%s", prefix, pathName);
7955 else
7956 sprintf(buf, "%s/%s", prefix, pathName);
7957 fp = fopen(buf, "r");
7958 if (fp == NULL)
7959 continue;
7960 fclose(fp);
7961 handle = dlopen(buf, RTLD_LAZY);
7962 }
7963 if (handle == NULL) {
7964 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7965 Jim_AppendStrings(interp, Jim_GetResult(interp),
7966 "error loading extension \"", pathName,
7967 "\": ", dlerror(), NULL);
7968 if (i < 0)
7969 continue;
7970 goto err;
7971 }
7972 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7973 Jim_SetResultString(interp,
7974 "No Jim_OnLoad symbol found on extension", -1);
7975 goto err;
7976 }
7977 if (onload(interp) == JIM_ERR) {
7978 dlclose(handle);
7979 goto err;
7980 }
7981 Jim_SetEmptyResult(interp);
7982 if (libPathObjPtr != NULL)
7983 Jim_DecrRefCount(interp, libPathObjPtr);
7984 return JIM_OK;
7985 }
7986 err:
7987 if (libPathObjPtr != NULL)
7988 Jim_DecrRefCount(interp, libPathObjPtr);
7989 return JIM_ERR;
7990 }
7991 #else /* JIM_DYNLIB */
7992 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7993 {
7994 JIM_NOTUSED(interp);
7995 JIM_NOTUSED(pathName);
7996
7997 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7998 return JIM_ERR;
7999 }
8000 #endif/* JIM_DYNLIB */
8001
8002 /* -----------------------------------------------------------------------------
8003 * Packages handling
8004 * ---------------------------------------------------------------------------*/
8005
8006 #define JIM_PKG_ANY_VERSION -1
8007
8008 /* Convert a string of the type "1.2" into an integer.
8009 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8010 * to the integer with value 102 */
8011 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8012 int *intPtr, int flags)
8013 {
8014 char *copy;
8015 jim_wide major, minor;
8016 char *majorStr, *minorStr, *p;
8017
8018 if (v[0] == '\0') {
8019 *intPtr = JIM_PKG_ANY_VERSION;
8020 return JIM_OK;
8021 }
8022
8023 copy = Jim_StrDup(v);
8024 p = strchr(copy, '.');
8025 if (p == NULL) goto badfmt;
8026 *p = '\0';
8027 majorStr = copy;
8028 minorStr = p + 1;
8029
8030 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8031 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8032 goto badfmt;
8033 *intPtr = (int)(major*100 + minor);
8034 Jim_Free(copy);
8035 return JIM_OK;
8036
8037 badfmt:
8038 Jim_Free(copy);
8039 if (flags & JIM_ERRMSG) {
8040 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8041 Jim_AppendStrings(interp, Jim_GetResult(interp),
8042 "invalid package version '", v, "'", NULL);
8043 }
8044 return JIM_ERR;
8045 }
8046
8047 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8048 static int JimPackageMatchVersion(int needed, int actual, int flags)
8049 {
8050 if (needed == JIM_PKG_ANY_VERSION) return 1;
8051 if (flags & JIM_MATCHVER_EXACT) {
8052 return needed == actual;
8053 } else {
8054 return needed/100 == actual/100 && (needed <= actual);
8055 }
8056 }
8057
8058 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8059 int flags)
8060 {
8061 int intVersion;
8062 /* Check if the version format is ok */
8063 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8064 return JIM_ERR;
8065 /* If the package was already provided returns an error. */
8066 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8067 if (flags & JIM_ERRMSG) {
8068 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8069 Jim_AppendStrings(interp, Jim_GetResult(interp),
8070 "package '", name, "' was already provided", NULL);
8071 }
8072 return JIM_ERR;
8073 }
8074 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8075 return JIM_OK;
8076 }
8077
8078 #ifndef JIM_ANSIC
8079
8080 #ifndef WIN32
8081 # include <sys/types.h>
8082 # include <dirent.h>
8083 #else
8084 # include <io.h>
8085 /* Posix dirent.h compatiblity layer for WIN32.
8086 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8087 * Copyright Salvatore Sanfilippo ,2005.
8088 *
8089 * Permission to use, copy, modify, and distribute this software and its
8090 * documentation for any purpose is hereby granted without fee, provided
8091 * that this copyright and permissions notice appear in all copies and
8092 * derivatives.
8093 *
8094 * This software is supplied "as is" without express or implied warranty.
8095 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8096 */
8097
8098 struct dirent {
8099 char *d_name;
8100 };
8101
8102 typedef struct DIR {
8103 long handle; /* -1 for failed rewind */
8104 struct _finddata_t info;
8105 struct dirent result; /* d_name null iff first time */
8106 char *name; /* null-terminated char string */
8107 } DIR;
8108
8109 DIR *opendir(const char *name)
8110 {
8111 DIR *dir = 0;
8112
8113 if (name && name[0]) {
8114 size_t base_length = strlen(name);
8115 const char *all = /* search pattern must end with suitable wildcard */
8116 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8117
8118 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8119 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8120 {
8121 strcat(strcpy(dir->name, name), all);
8122
8123 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8124 dir->result.d_name = 0;
8125 else { /* rollback */
8126 Jim_Free(dir->name);
8127 Jim_Free(dir);
8128 dir = 0;
8129 }
8130 } else { /* rollback */
8131 Jim_Free(dir);
8132 dir = 0;
8133 errno = ENOMEM;
8134 }
8135 } else {
8136 errno = EINVAL;
8137 }
8138 return dir;
8139 }
8140
8141 int closedir(DIR *dir)
8142 {
8143 int result = -1;
8144
8145 if (dir) {
8146 if (dir->handle != -1)
8147 result = _findclose(dir->handle);
8148 Jim_Free(dir->name);
8149 Jim_Free(dir);
8150 }
8151 if (result == -1) /* map all errors to EBADF */
8152 errno = EBADF;
8153 return result;
8154 }
8155
8156 struct dirent *readdir(DIR *dir)
8157 {
8158 struct dirent *result = 0;
8159
8160 if (dir && dir->handle != -1) {
8161 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8162 result = &dir->result;
8163 result->d_name = dir->info.name;
8164 }
8165 } else {
8166 errno = EBADF;
8167 }
8168 return result;
8169 }
8170
8171 #endif /* WIN32 */
8172
8173 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8174 int prefixc, const char *pkgName, int pkgVer, int flags)
8175 {
8176 int bestVer = -1, i;
8177 int pkgNameLen = strlen(pkgName);
8178 char *bestPackage = NULL;
8179 struct dirent *de;
8180
8181 for (i = 0; i < prefixc; i++) {
8182 DIR *dir;
8183 char buf[JIM_PATH_LEN];
8184 int prefixLen;
8185
8186 if (prefixes[i] == NULL) continue;
8187 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8188 buf[JIM_PATH_LEN-1] = '\0';
8189 prefixLen = strlen(buf);
8190 if (prefixLen && buf[prefixLen-1] == '/')
8191 buf[prefixLen-1] = '\0';
8192
8193 if ((dir = opendir(buf)) == NULL) continue;
8194 while ((de = readdir(dir)) != NULL) {
8195 char *fileName = de->d_name;
8196 int fileNameLen = strlen(fileName);
8197
8198 if (strncmp(fileName, "jim-", 4) == 0 &&
8199 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8200 *(fileName + 4+pkgNameLen) == '-' &&
8201 fileNameLen > 4 && /* note that this is not really useful */
8202 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8203 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8204 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8205 {
8206 char ver[6]; /* xx.yy < nulterm> */
8207 char *p = strrchr(fileName, '.');
8208 int verLen, fileVer;
8209
8210 verLen = p - (fileName + 4+pkgNameLen + 1);
8211 if (verLen < 3 || verLen > 5) continue;
8212 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8213 ver[verLen] = '\0';
8214 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8215 != JIM_OK) continue;
8216 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8217 (bestVer == -1 || bestVer < fileVer))
8218 {
8219 bestVer = fileVer;
8220 Jim_Free(bestPackage);
8221 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8222 sprintf(bestPackage, "%s/%s", buf, fileName);
8223 }
8224 }
8225 }
8226 closedir(dir);
8227 }
8228 return bestPackage;
8229 }
8230
8231 #else /* JIM_ANSIC */
8232
8233 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8234 int prefixc, const char *pkgName, int pkgVer, int flags)
8235 {
8236 JIM_NOTUSED(interp);
8237 JIM_NOTUSED(prefixes);
8238 JIM_NOTUSED(prefixc);
8239 JIM_NOTUSED(pkgName);
8240 JIM_NOTUSED(pkgVer);
8241 JIM_NOTUSED(flags);
8242 return NULL;
8243 }
8244
8245 #endif /* JIM_ANSIC */
8246
8247 /* Search for a suitable package under every dir specified by jim_libpath
8248 * and load it if possible. If a suitable package was loaded with success
8249 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8250 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8251 int flags)
8252 {
8253 Jim_Obj *libPathObjPtr;
8254 char **prefixes, *best;
8255 int prefixc, i, retCode = JIM_OK;
8256
8257 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8258 if (libPathObjPtr == NULL) {
8259 prefixc = 0;
8260 libPathObjPtr = NULL;
8261 } else {
8262 Jim_IncrRefCount(libPathObjPtr);
8263 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8264 }
8265
8266 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8267 for (i = 0; i < prefixc; i++) {
8268 Jim_Obj *prefixObjPtr;
8269 if (Jim_ListIndex(interp, libPathObjPtr, i,
8270 &prefixObjPtr, JIM_NONE) != JIM_OK)
8271 {
8272 prefixes[i] = NULL;
8273 continue;
8274 }
8275 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8276 }
8277 /* Scan every directory to find the "best" package. */
8278 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8279 if (best != NULL) {
8280 char *p = strrchr(best, '.');
8281 /* Try to load/source it */
8282 if (p && strcmp(p, ".tcl") == 0) {
8283 retCode = Jim_EvalFile(interp, best);
8284 } else {
8285 retCode = Jim_LoadLibrary(interp, best);
8286 }
8287 } else {
8288 retCode = JIM_ERR;
8289 }
8290 Jim_Free(best);
8291 for (i = 0; i < prefixc; i++)
8292 Jim_Free(prefixes[i]);
8293 Jim_Free(prefixes);
8294 if (libPathObjPtr)
8295 Jim_DecrRefCount(interp, libPathObjPtr);
8296 return retCode;
8297 }
8298
8299 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8300 const char *ver, int flags)
8301 {
8302 Jim_HashEntry *he;
8303 int requiredVer;
8304
8305 /* Start with an empty error string */
8306 Jim_SetResultString(interp, "", 0);
8307
8308 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8309 return NULL;
8310 he = Jim_FindHashEntry(&interp->packages, name);
8311 if (he == NULL) {
8312 /* Try to load the package. */
8313 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8314 he = Jim_FindHashEntry(&interp->packages, name);
8315 if (he == NULL) {
8316 return "?";
8317 }
8318 return he->val;
8319 }
8320 /* No way... return an error. */
8321 if (flags & JIM_ERRMSG) {
8322 int len;
8323 Jim_GetString(Jim_GetResult(interp), &len);
8324 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8325 "Can't find package '", name, "'", NULL);
8326 }
8327 return NULL;
8328 } else {
8329 int actualVer;
8330 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8331 != JIM_OK)
8332 {
8333 return NULL;
8334 }
8335 /* Check if version matches. */
8336 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8337 Jim_AppendStrings(interp, Jim_GetResult(interp),
8338 "Package '", name, "' already loaded, but with version ",
8339 he->val, NULL);
8340 return NULL;
8341 }
8342 return he->val;
8343 }
8344 }
8345
8346 /* -----------------------------------------------------------------------------
8347 * Eval
8348 * ---------------------------------------------------------------------------*/
8349 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8350 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8351
8352 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8353 Jim_Obj *const *argv);
8354
8355 /* Handle calls to the [unknown] command */
8356 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8357 {
8358 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8359 int retCode;
8360
8361 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8362 * done here
8363 */
8364 if (interp->unknown_called) {
8365 return JIM_ERR;
8366 }
8367
8368 /* If the [unknown] command does not exists returns
8369 * just now */
8370 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8371 return JIM_ERR;
8372
8373 /* The object interp->unknown just contains
8374 * the "unknown" string, it is used in order to
8375 * avoid to lookup the unknown command every time
8376 * but instread to cache the result. */
8377 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8378 v = sv;
8379 else
8380 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8381 /* Make a copy of the arguments vector, but shifted on
8382 * the right of one position. The command name of the
8383 * command will be instead the first argument of the
8384 * [unknonw] call. */
8385 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8386 v[0] = interp->unknown;
8387 /* Call it */
8388 interp->unknown_called++;
8389 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8390 interp->unknown_called--;
8391
8392 /* Clean up */
8393 if (v != sv)
8394 Jim_Free(v);
8395 return retCode;
8396 }
8397
8398 /* Eval the object vector 'objv' composed of 'objc' elements.
8399 * Every element is used as single argument.
8400 * Jim_EvalObj() will call this function every time its object
8401 * argument is of "list" type, with no string representation.
8402 *
8403 * This is possible because the string representation of a
8404 * list object generated by the UpdateStringOfList is made
8405 * in a way that ensures that every list element is a different
8406 * command argument. */
8407 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8408 {
8409 int i, retcode;
8410 Jim_Cmd *cmdPtr;
8411
8412 /* Incr refcount of arguments. */
8413 for (i = 0; i < objc; i++)
8414 Jim_IncrRefCount(objv[i]);
8415 /* Command lookup */
8416 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8417 if (cmdPtr == NULL) {
8418 retcode = JimUnknown(interp, objc, objv);
8419 } else {
8420 /* Call it -- Make sure result is an empty object. */
8421 Jim_SetEmptyResult(interp);
8422 if (cmdPtr->cmdProc) {
8423 interp->cmdPrivData = cmdPtr->privData;
8424 retcode = cmdPtr->cmdProc(interp, objc, objv);
8425 if (retcode == JIM_ERR_ADDSTACK) {
8426 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8427 retcode = JIM_ERR;
8428 }
8429 } else {
8430 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8431 if (retcode == JIM_ERR) {
8432 JimAppendStackTrace(interp,
8433 Jim_GetString(objv[0], NULL), "", 1);
8434 }
8435 }
8436 }
8437 /* Decr refcount of arguments and return the retcode */
8438 for (i = 0; i < objc; i++)
8439 Jim_DecrRefCount(interp, objv[i]);
8440 return retcode;
8441 }
8442
8443 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8444 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8445 * The returned object has refcount = 0. */
8446 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8447 int tokens, Jim_Obj **objPtrPtr)
8448 {
8449 int totlen = 0, i, retcode;
8450 Jim_Obj **intv;
8451 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8452 Jim_Obj *objPtr;
8453 char *s;
8454
8455 if (tokens <= JIM_EVAL_SINTV_LEN)
8456 intv = sintv;
8457 else
8458 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8459 tokens);
8460 /* Compute every token forming the argument
8461 * in the intv objects vector. */
8462 for (i = 0; i < tokens; i++) {
8463 switch (token[i].type) {
8464 case JIM_TT_ESC:
8465 case JIM_TT_STR:
8466 intv[i] = token[i].objPtr;
8467 break;
8468 case JIM_TT_VAR:
8469 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8470 if (!intv[i]) {
8471 retcode = JIM_ERR;
8472 goto err;
8473 }
8474 break;
8475 case JIM_TT_DICTSUGAR:
8476 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8477 if (!intv[i]) {
8478 retcode = JIM_ERR;
8479 goto err;
8480 }
8481 break;
8482 case JIM_TT_CMD:
8483 retcode = Jim_EvalObj(interp, token[i].objPtr);
8484 if (retcode != JIM_OK)
8485 goto err;
8486 intv[i] = Jim_GetResult(interp);
8487 break;
8488 default:
8489 Jim_Panic(interp,
8490 "default token type reached "
8491 "in Jim_InterpolateTokens().");
8492 break;
8493 }
8494 Jim_IncrRefCount(intv[i]);
8495 /* Make sure there is a valid
8496 * string rep, and add the string
8497 * length to the total legnth. */
8498 Jim_GetString(intv[i], NULL);
8499 totlen += intv[i]->length;
8500 }
8501 /* Concatenate every token in an unique
8502 * object. */
8503 objPtr = Jim_NewStringObjNoAlloc(interp,
8504 NULL, 0);
8505 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8506 objPtr->length = totlen;
8507 for (i = 0; i < tokens; i++) {
8508 memcpy(s, intv[i]->bytes, intv[i]->length);
8509 s += intv[i]->length;
8510 Jim_DecrRefCount(interp, intv[i]);
8511 }
8512 objPtr->bytes[totlen] = '\0';
8513 /* Free the intv vector if not static. */
8514 if (tokens > JIM_EVAL_SINTV_LEN)
8515 Jim_Free(intv);
8516 *objPtrPtr = objPtr;
8517 return JIM_OK;
8518 err:
8519 i--;
8520 for (; i >= 0; i--)
8521 Jim_DecrRefCount(interp, intv[i]);
8522 if (tokens > JIM_EVAL_SINTV_LEN)
8523 Jim_Free(intv);
8524 return retcode;
8525 }
8526
8527 /* Helper of Jim_EvalObj() to perform argument expansion.
8528 * Basically this function append an argument to 'argv'
8529 * (and increments argc by reference accordingly), performing
8530 * expansion of the list object if 'expand' is non-zero, or
8531 * just adding objPtr to argv if 'expand' is zero. */
8532 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8533 int *argcPtr, int expand, Jim_Obj *objPtr)
8534 {
8535 if (!expand) {
8536 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8537 /* refcount of objPtr not incremented because
8538 * we are actually transfering a reference from
8539 * the old 'argv' to the expanded one. */
8540 (*argv)[*argcPtr] = objPtr;
8541 (*argcPtr)++;
8542 } else {
8543 int len, i;
8544
8545 Jim_ListLength(interp, objPtr, &len);
8546 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8547 for (i = 0; i < len; i++) {
8548 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8549 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8550 (*argcPtr)++;
8551 }
8552 /* The original object reference is no longer needed,
8553 * after the expansion it is no longer present on
8554 * the argument vector, but the single elements are
8555 * in its place. */
8556 Jim_DecrRefCount(interp, objPtr);
8557 }
8558 }
8559
8560 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8561 {
8562 int i, j = 0, len;
8563 ScriptObj *script;
8564 ScriptToken *token;
8565 int *cs; /* command structure array */
8566 int retcode = JIM_OK;
8567 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8568
8569 interp->errorFlag = 0;
8570
8571 /* If the object is of type "list" and there is no
8572 * string representation for this object, we can call
8573 * a specialized version of Jim_EvalObj() */
8574 if (scriptObjPtr->typePtr == &listObjType &&
8575 scriptObjPtr->internalRep.listValue.len &&
8576 scriptObjPtr->bytes == NULL) {
8577 Jim_IncrRefCount(scriptObjPtr);
8578 retcode = Jim_EvalObjVector(interp,
8579 scriptObjPtr->internalRep.listValue.len,
8580 scriptObjPtr->internalRep.listValue.ele);
8581 Jim_DecrRefCount(interp, scriptObjPtr);
8582 return retcode;
8583 }
8584
8585 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8586 script = Jim_GetScript(interp, scriptObjPtr);
8587 /* Now we have to make sure the internal repr will not be
8588 * freed on shimmering.
8589 *
8590 * Think for example to this:
8591 *
8592 * set x {llength $x; ... some more code ...}; eval $x
8593 *
8594 * In order to preserve the internal rep, we increment the
8595 * inUse field of the script internal rep structure. */
8596 script->inUse++;
8597
8598 token = script->token;
8599 len = script->len;
8600 cs = script->cmdStruct;
8601 i = 0; /* 'i' is the current token index. */
8602
8603 /* Reset the interpreter result. This is useful to
8604 * return the emtpy result in the case of empty program. */
8605 Jim_SetEmptyResult(interp);
8606
8607 /* Execute every command sequentially, returns on
8608 * error (i.e. if a command does not return JIM_OK) */
8609 while (i < len) {
8610 int expand = 0;
8611 int argc = *cs++; /* Get the number of arguments */
8612 Jim_Cmd *cmd;
8613
8614 /* Set the expand flag if needed. */
8615 if (argc == -1) {
8616 expand++;
8617 argc = *cs++;
8618 }
8619 /* Allocate the arguments vector */
8620 if (argc <= JIM_EVAL_SARGV_LEN)
8621 argv = sargv;
8622 else
8623 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8624 /* Populate the arguments objects. */
8625 for (j = 0; j < argc; j++) {
8626 int tokens = *cs++;
8627
8628 /* tokens is negative if expansion is needed.
8629 * for this argument. */
8630 if (tokens < 0) {
8631 tokens = (-tokens)-1;
8632 i++;
8633 }
8634 if (tokens == 1) {
8635 /* Fast path if the token does not
8636 * need interpolation */
8637 switch (token[i].type) {
8638 case JIM_TT_ESC:
8639 case JIM_TT_STR:
8640 argv[j] = token[i].objPtr;
8641 break;
8642 case JIM_TT_VAR:
8643 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8644 JIM_ERRMSG);
8645 if (!tmpObjPtr) {
8646 retcode = JIM_ERR;
8647 goto err;
8648 }
8649 argv[j] = tmpObjPtr;
8650 break;
8651 case JIM_TT_DICTSUGAR:
8652 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8653 if (!tmpObjPtr) {
8654 retcode = JIM_ERR;
8655 goto err;
8656 }
8657 argv[j] = tmpObjPtr;
8658 break;
8659 case JIM_TT_CMD:
8660 retcode = Jim_EvalObj(interp, token[i].objPtr);
8661 if (retcode != JIM_OK)
8662 goto err;
8663 argv[j] = Jim_GetResult(interp);
8664 break;
8665 default:
8666 Jim_Panic(interp,
8667 "default token type reached "
8668 "in Jim_EvalObj().");
8669 break;
8670 }
8671 Jim_IncrRefCount(argv[j]);
8672 i += 2;
8673 } else {
8674 /* For interpolation we call an helper
8675 * function doing the work for us. */
8676 if ((retcode = Jim_InterpolateTokens(interp,
8677 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8678 {
8679 goto err;
8680 }
8681 argv[j] = tmpObjPtr;
8682 Jim_IncrRefCount(argv[j]);
8683 i += tokens + 1;
8684 }
8685 }
8686 /* Handle {expand} expansion */
8687 if (expand) {
8688 int *ecs = cs - argc;
8689 int eargc = 0;
8690 Jim_Obj **eargv = NULL;
8691
8692 for (j = 0; j < argc; j++) {
8693 Jim_ExpandArgument(interp, &eargv, &eargc,
8694 ecs[j] < 0, argv[j]);
8695 }
8696 if (argv != sargv)
8697 Jim_Free(argv);
8698 argc = eargc;
8699 argv = eargv;
8700 j = argc;
8701 if (argc == 0) {
8702 /* Nothing to do with zero args. */
8703 Jim_Free(eargv);
8704 continue;
8705 }
8706 }
8707 /* Lookup the command to call */
8708 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8709 if (cmd != NULL) {
8710 /* Call it -- Make sure result is an empty object. */
8711 Jim_SetEmptyResult(interp);
8712 if (cmd->cmdProc) {
8713 interp->cmdPrivData = cmd->privData;
8714 retcode = cmd->cmdProc(interp, argc, argv);
8715 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8716 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8717 retcode = JIM_ERR;
8718 }
8719 } else {
8720 retcode = JimCallProcedure(interp, cmd, argc, argv);
8721 if (retcode == JIM_ERR) {
8722 JimAppendStackTrace(interp,
8723 Jim_GetString(argv[0], NULL), script->fileName,
8724 token[i-argc*2].linenr);
8725 }
8726 }
8727 } else {
8728 /* Call [unknown] */
8729 retcode = JimUnknown(interp, argc, argv);
8730 if (retcode == JIM_ERR) {
8731 JimAppendStackTrace(interp,
8732 "", script->fileName,
8733 token[i-argc*2].linenr);
8734 }
8735 }
8736 if (retcode != JIM_OK) {
8737 i -= argc*2; /* point to the command name. */
8738 goto err;
8739 }
8740 /* Decrement the arguments count */
8741 for (j = 0; j < argc; j++) {
8742 Jim_DecrRefCount(interp, argv[j]);
8743 }
8744
8745 if (argv != sargv) {
8746 Jim_Free(argv);
8747 argv = NULL;
8748 }
8749 }
8750 /* Note that we don't have to decrement inUse, because the
8751 * following code transfers our use of the reference again to
8752 * the script object. */
8753 j = 0; /* on normal termination, the argv array is already
8754 Jim_DecrRefCount-ed. */
8755 err:
8756 /* Handle errors. */
8757 if (retcode == JIM_ERR && !interp->errorFlag) {
8758 interp->errorFlag = 1;
8759 JimSetErrorFileName(interp, script->fileName);
8760 JimSetErrorLineNumber(interp, token[i].linenr);
8761 JimResetStackTrace(interp);
8762 }
8763 Jim_FreeIntRep(interp, scriptObjPtr);
8764 scriptObjPtr->typePtr = &scriptObjType;
8765 Jim_SetIntRepPtr(scriptObjPtr, script);
8766 Jim_DecrRefCount(interp, scriptObjPtr);
8767 for (i = 0; i < j; i++) {
8768 Jim_DecrRefCount(interp, argv[i]);
8769 }
8770 if (argv != sargv)
8771 Jim_Free(argv);
8772 return retcode;
8773 }
8774
8775 /* Call a procedure implemented in Tcl.
8776 * It's possible to speed-up a lot this function, currently
8777 * the callframes are not cached, but allocated and
8778 * destroied every time. What is expecially costly is
8779 * to create/destroy the local vars hash table every time.
8780 *
8781 * This can be fixed just implementing callframes caching
8782 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8783 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8784 Jim_Obj *const *argv)
8785 {
8786 int i, retcode;
8787 Jim_CallFrame *callFramePtr;
8788 int num_args;
8789
8790 /* Check arity */
8791 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8792 argc > cmd->arityMax)) {
8793 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8794 Jim_AppendStrings(interp, objPtr,
8795 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8796 (cmd->arityMin > 1) ? " " : "",
8797 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8798 Jim_SetResult(interp, objPtr);
8799 return JIM_ERR;
8800 }
8801 /* Check if there are too nested calls */
8802 if (interp->numLevels == interp->maxNestingDepth) {
8803 Jim_SetResultString(interp,
8804 "Too many nested calls. Infinite recursion?", -1);
8805 return JIM_ERR;
8806 }
8807 /* Create a new callframe */
8808 callFramePtr = JimCreateCallFrame(interp);
8809 callFramePtr->parentCallFrame = interp->framePtr;
8810 callFramePtr->argv = argv;
8811 callFramePtr->argc = argc;
8812 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8813 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8814 callFramePtr->staticVars = cmd->staticVars;
8815 Jim_IncrRefCount(cmd->argListObjPtr);
8816 Jim_IncrRefCount(cmd->bodyObjPtr);
8817 interp->framePtr = callFramePtr;
8818 interp->numLevels ++;
8819
8820 /* Set arguments */
8821 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8822
8823 /* If last argument is 'args', don't set it here */
8824 if (cmd->arityMax == -1) {
8825 num_args--;
8826 }
8827
8828 for (i = 0; i < num_args; i++) {
8829 Jim_Obj *argObjPtr=NULL;
8830 Jim_Obj *nameObjPtr=NULL;
8831 Jim_Obj *valueObjPtr=NULL;
8832
8833 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8834 if (i + 1 >= cmd->arityMin) {
8835 /* The name is the first element of the list */
8836 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8837 }
8838 else {
8839 /* The element arg is the name */
8840 nameObjPtr = argObjPtr;
8841 }
8842
8843 if (i + 1 >= argc) {
8844 /* No more values, so use default */
8845 /* The value is the second element of the list */
8846 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8847 }
8848 else {
8849 valueObjPtr = argv[i + 1];
8850 }
8851 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8852 }
8853 /* Set optional arguments */
8854 if (cmd->arityMax == -1) {
8855 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8856
8857 i++;
8858 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8859 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8860 Jim_SetVariable(interp, objPtr, listObjPtr);
8861 }
8862 /* Eval the body */
8863 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8864
8865 /* Destroy the callframe */
8866 interp->numLevels --;
8867 interp->framePtr = interp->framePtr->parentCallFrame;
8868 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8869 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8870 } else {
8871 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8872 }
8873 /* Handle the JIM_EVAL return code */
8874 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8875 int savedLevel = interp->evalRetcodeLevel;
8876
8877 interp->evalRetcodeLevel = interp->numLevels;
8878 while (retcode == JIM_EVAL) {
8879 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8880 Jim_IncrRefCount(resultScriptObjPtr);
8881 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8882 Jim_DecrRefCount(interp, resultScriptObjPtr);
8883 }
8884 interp->evalRetcodeLevel = savedLevel;
8885 }
8886 /* Handle the JIM_RETURN return code */
8887 if (retcode == JIM_RETURN) {
8888 retcode = interp->returnCode;
8889 interp->returnCode = JIM_OK;
8890 }
8891 return retcode;
8892 }
8893
8894 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8895 {
8896 int retval;
8897 Jim_Obj *scriptObjPtr;
8898
8899 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8900 Jim_IncrRefCount(scriptObjPtr);
8901
8902
8903 if (filename) {
8904 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8905 }
8906
8907 retval = Jim_EvalObj(interp, scriptObjPtr);
8908 Jim_DecrRefCount(interp, scriptObjPtr);
8909 return retval;
8910 }
8911
8912 int Jim_Eval(Jim_Interp *interp, const char *script)
8913 {
8914 return Jim_Eval_Named(interp, script, NULL, 0);
8915 }
8916
8917
8918
8919 /* Execute script in the scope of the global level */
8920 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8921 {
8922 Jim_CallFrame *savedFramePtr;
8923 int retval;
8924
8925 savedFramePtr = interp->framePtr;
8926 interp->framePtr = interp->topFramePtr;
8927 retval = Jim_Eval(interp, script);
8928 interp->framePtr = savedFramePtr;
8929 return retval;
8930 }
8931
8932 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8933 {
8934 Jim_CallFrame *savedFramePtr;
8935 int retval;
8936
8937 savedFramePtr = interp->framePtr;
8938 interp->framePtr = interp->topFramePtr;
8939 retval = Jim_EvalObj(interp, scriptObjPtr);
8940 interp->framePtr = savedFramePtr;
8941 /* Try to report the error (if any) via the bgerror proc */
8942 if (retval != JIM_OK) {
8943 Jim_Obj *objv[2];
8944
8945 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8946 objv[1] = Jim_GetResult(interp);
8947 Jim_IncrRefCount(objv[0]);
8948 Jim_IncrRefCount(objv[1]);
8949 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8950 /* Report the error to stderr. */
8951 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8952 Jim_PrintErrorMessage(interp);
8953 }
8954 Jim_DecrRefCount(interp, objv[0]);
8955 Jim_DecrRefCount(interp, objv[1]);
8956 }
8957 return retval;
8958 }
8959
8960 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8961 {
8962 char *prg = NULL;
8963 FILE *fp;
8964 int nread, totread, maxlen, buflen;
8965 int retval;
8966 Jim_Obj *scriptObjPtr;
8967
8968 if ((fp = fopen(filename, "r")) == NULL) {
8969 const int cwd_len = 2048;
8970 char *cwd = malloc(cwd_len);
8971 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8972 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8973 Jim_AppendStrings(interp, Jim_GetResult(interp),
8974 "Error loading script \"", filename, "\"",
8975 " cwd: ", cwd,
8976 " err: ", strerror(errno), NULL);
8977 free(cwd);
8978 return JIM_ERR;
8979 }
8980 buflen = 1024;
8981 maxlen = totread = 0;
8982 while (1) {
8983 if (maxlen < totread + buflen + 1) {
8984 maxlen = totread + buflen + 1;
8985 prg = Jim_Realloc(prg, maxlen);
8986 }
8987 /* do not use Jim_fread() - this is really a file */
8988 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8989 totread += nread;
8990 }
8991 prg[totread] = '\0';
8992 /* do not use Jim_fclose() - this is really a file */
8993 fclose(fp);
8994
8995 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8996 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8997 Jim_IncrRefCount(scriptObjPtr);
8998 retval = Jim_EvalObj(interp, scriptObjPtr);
8999 Jim_DecrRefCount(interp, scriptObjPtr);
9000 return retval;
9001 }
9002
9003 /* -----------------------------------------------------------------------------
9004 * Subst
9005 * ---------------------------------------------------------------------------*/
9006 static int JimParseSubstStr(struct JimParserCtx *pc)
9007 {
9008 pc->tstart = pc->p;
9009 pc->tline = pc->linenr;
9010 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9011 pc->p++; pc->len--;
9012 }
9013 pc->tend = pc->p-1;
9014 pc->tt = JIM_TT_ESC;
9015 return JIM_OK;
9016 }
9017
9018 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9019 {
9020 int retval;
9021
9022 if (pc->len == 0) {
9023 pc->tstart = pc->tend = pc->p;
9024 pc->tline = pc->linenr;
9025 pc->tt = JIM_TT_EOL;
9026 pc->eof = 1;
9027 return JIM_OK;
9028 }
9029 switch (*pc->p) {
9030 case '[':
9031 retval = JimParseCmd(pc);
9032 if (flags & JIM_SUBST_NOCMD) {
9033 pc->tstart--;
9034 pc->tend++;
9035 pc->tt = (flags & JIM_SUBST_NOESC) ?
9036 JIM_TT_STR : JIM_TT_ESC;
9037 }
9038 return retval;
9039 break;
9040 case '$':
9041 if (JimParseVar(pc) == JIM_ERR) {
9042 pc->tstart = pc->tend = pc->p++; pc->len--;
9043 pc->tline = pc->linenr;
9044 pc->tt = JIM_TT_STR;
9045 } else {
9046 if (flags & JIM_SUBST_NOVAR) {
9047 pc->tstart--;
9048 if (flags & JIM_SUBST_NOESC)
9049 pc->tt = JIM_TT_STR;
9050 else
9051 pc->tt = JIM_TT_ESC;
9052 if (*pc->tstart == '{') {
9053 pc->tstart--;
9054 if (*(pc->tend + 1))
9055 pc->tend++;
9056 }
9057 }
9058 }
9059 break;
9060 default:
9061 retval = JimParseSubstStr(pc);
9062 if (flags & JIM_SUBST_NOESC)
9063 pc->tt = JIM_TT_STR;
9064 return retval;
9065 break;
9066 }
9067 return JIM_OK;
9068 }
9069
9070 /* The subst object type reuses most of the data structures and functions
9071 * of the script object. Script's data structures are a bit more complex
9072 * for what is needed for [subst]itution tasks, but the reuse helps to
9073 * deal with a single data structure at the cost of some more memory
9074 * usage for substitutions. */
9075 static Jim_ObjType substObjType = {
9076 "subst",
9077 FreeScriptInternalRep,
9078 DupScriptInternalRep,
9079 NULL,
9080 JIM_TYPE_REFERENCES,
9081 };
9082
9083 /* This method takes the string representation of an object
9084 * as a Tcl string where to perform [subst]itution, and generates
9085 * the pre-parsed internal representation. */
9086 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9087 {
9088 int scriptTextLen;
9089 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9090 struct JimParserCtx parser;
9091 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9092
9093 script->len = 0;
9094 script->csLen = 0;
9095 script->commands = 0;
9096 script->token = NULL;
9097 script->cmdStruct = NULL;
9098 script->inUse = 1;
9099 script->substFlags = flags;
9100 script->fileName = NULL;
9101
9102 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9103 while (1) {
9104 char *token;
9105 int len, type, linenr;
9106
9107 JimParseSubst(&parser, flags);
9108 if (JimParserEof(&parser)) break;
9109 token = JimParserGetToken(&parser, &len, &type, &linenr);
9110 ScriptObjAddToken(interp, script, token, len, type,
9111 NULL, linenr);
9112 }
9113 /* Free the old internal rep and set the new one. */
9114 Jim_FreeIntRep(interp, objPtr);
9115 Jim_SetIntRepPtr(objPtr, script);
9116 objPtr->typePtr = &scriptObjType;
9117 return JIM_OK;
9118 }
9119
9120 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9121 {
9122 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9123
9124 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9125 SetSubstFromAny(interp, objPtr, flags);
9126 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9127 }
9128
9129 /* Performs commands,variables,blackslashes substitution,
9130 * storing the result object (with refcount 0) into
9131 * resObjPtrPtr. */
9132 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9133 Jim_Obj **resObjPtrPtr, int flags)
9134 {
9135 ScriptObj *script;
9136 ScriptToken *token;
9137 int i, len, retcode = JIM_OK;
9138 Jim_Obj *resObjPtr, *savedResultObjPtr;
9139
9140 script = Jim_GetSubst(interp, substObjPtr, flags);
9141 #ifdef JIM_OPTIMIZATION
9142 /* Fast path for a very common case with array-alike syntax,
9143 * that's: $foo($bar) */
9144 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9145 Jim_Obj *varObjPtr = script->token[0].objPtr;
9146
9147 Jim_IncrRefCount(varObjPtr);
9148 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9149 if (resObjPtr == NULL) {
9150 Jim_DecrRefCount(interp, varObjPtr);
9151 return JIM_ERR;
9152 }
9153 Jim_DecrRefCount(interp, varObjPtr);
9154 *resObjPtrPtr = resObjPtr;
9155 return JIM_OK;
9156 }
9157 #endif
9158
9159 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9160 /* In order to preserve the internal rep, we increment the
9161 * inUse field of the script internal rep structure. */
9162 script->inUse++;
9163
9164 token = script->token;
9165 len = script->len;
9166
9167 /* Save the interp old result, to set it again before
9168 * to return. */
9169 savedResultObjPtr = interp->result;
9170 Jim_IncrRefCount(savedResultObjPtr);
9171
9172 /* Perform the substitution. Starts with an empty object
9173 * and adds every token (performing the appropriate
9174 * var/command/escape substitution). */
9175 resObjPtr = Jim_NewStringObj(interp, "", 0);
9176 for (i = 0; i < len; i++) {
9177 Jim_Obj *objPtr;
9178
9179 switch (token[i].type) {
9180 case JIM_TT_STR:
9181 case JIM_TT_ESC:
9182 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9183 break;
9184 case JIM_TT_VAR:
9185 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9186 if (objPtr == NULL) goto err;
9187 Jim_IncrRefCount(objPtr);
9188 Jim_AppendObj(interp, resObjPtr, objPtr);
9189 Jim_DecrRefCount(interp, objPtr);
9190 break;
9191 case JIM_TT_DICTSUGAR:
9192 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9193 if (!objPtr) {
9194 retcode = JIM_ERR;
9195 goto err;
9196 }
9197 break;
9198 case JIM_TT_CMD:
9199 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9200 goto err;
9201 Jim_AppendObj(interp, resObjPtr, interp->result);
9202 break;
9203 default:
9204 Jim_Panic(interp,
9205 "default token type (%d) reached "
9206 "in Jim_SubstObj().", token[i].type);
9207 break;
9208 }
9209 }
9210 ok:
9211 if (retcode == JIM_OK)
9212 Jim_SetResult(interp, savedResultObjPtr);
9213 Jim_DecrRefCount(interp, savedResultObjPtr);
9214 /* Note that we don't have to decrement inUse, because the
9215 * following code transfers our use of the reference again to
9216 * the script object. */
9217 Jim_FreeIntRep(interp, substObjPtr);
9218 substObjPtr->typePtr = &scriptObjType;
9219 Jim_SetIntRepPtr(substObjPtr, script);
9220 Jim_DecrRefCount(interp, substObjPtr);
9221 *resObjPtrPtr = resObjPtr;
9222 return retcode;
9223 err:
9224 Jim_FreeNewObj(interp, resObjPtr);
9225 retcode = JIM_ERR;
9226 goto ok;
9227 }
9228
9229 /* -----------------------------------------------------------------------------
9230 * API Input/Export functions
9231 * ---------------------------------------------------------------------------*/
9232
9233 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9234 {
9235 Jim_HashEntry *he;
9236
9237 he = Jim_FindHashEntry(&interp->stub, funcname);
9238 if (!he)
9239 return JIM_ERR;
9240 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9241 return JIM_OK;
9242 }
9243
9244 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9245 {
9246 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9247 }
9248
9249 #define JIM_REGISTER_API(name) \
9250 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9251
9252 void JimRegisterCoreApi(Jim_Interp *interp)
9253 {
9254 interp->getApiFuncPtr = Jim_GetApi;
9255 JIM_REGISTER_API(Alloc);
9256 JIM_REGISTER_API(Free);
9257 JIM_REGISTER_API(Eval);
9258 JIM_REGISTER_API(Eval_Named);
9259 JIM_REGISTER_API(EvalGlobal);
9260 JIM_REGISTER_API(EvalFile);
9261 JIM_REGISTER_API(EvalObj);
9262 JIM_REGISTER_API(EvalObjBackground);
9263 JIM_REGISTER_API(EvalObjVector);
9264 JIM_REGISTER_API(InitHashTable);
9265 JIM_REGISTER_API(ExpandHashTable);
9266 JIM_REGISTER_API(AddHashEntry);
9267 JIM_REGISTER_API(ReplaceHashEntry);
9268 JIM_REGISTER_API(DeleteHashEntry);
9269 JIM_REGISTER_API(FreeHashTable);
9270 JIM_REGISTER_API(FindHashEntry);
9271 JIM_REGISTER_API(ResizeHashTable);
9272 JIM_REGISTER_API(GetHashTableIterator);
9273 JIM_REGISTER_API(NextHashEntry);
9274 JIM_REGISTER_API(NewObj);
9275 JIM_REGISTER_API(FreeObj);
9276 JIM_REGISTER_API(InvalidateStringRep);
9277 JIM_REGISTER_API(InitStringRep);
9278 JIM_REGISTER_API(DuplicateObj);
9279 JIM_REGISTER_API(GetString);
9280 JIM_REGISTER_API(Length);
9281 JIM_REGISTER_API(InvalidateStringRep);
9282 JIM_REGISTER_API(NewStringObj);
9283 JIM_REGISTER_API(NewStringObjNoAlloc);
9284 JIM_REGISTER_API(AppendString);
9285 JIM_REGISTER_API(AppendString_sprintf);
9286 JIM_REGISTER_API(AppendObj);
9287 JIM_REGISTER_API(AppendStrings);
9288 JIM_REGISTER_API(StringEqObj);
9289 JIM_REGISTER_API(StringMatchObj);
9290 JIM_REGISTER_API(StringRangeObj);
9291 JIM_REGISTER_API(FormatString);
9292 JIM_REGISTER_API(CompareStringImmediate);
9293 JIM_REGISTER_API(NewReference);
9294 JIM_REGISTER_API(GetReference);
9295 JIM_REGISTER_API(SetFinalizer);
9296 JIM_REGISTER_API(GetFinalizer);
9297 JIM_REGISTER_API(CreateInterp);
9298 JIM_REGISTER_API(FreeInterp);
9299 JIM_REGISTER_API(GetExitCode);
9300 JIM_REGISTER_API(SetStdin);
9301 JIM_REGISTER_API(SetStdout);
9302 JIM_REGISTER_API(SetStderr);
9303 JIM_REGISTER_API(CreateCommand);
9304 JIM_REGISTER_API(CreateProcedure);
9305 JIM_REGISTER_API(DeleteCommand);
9306 JIM_REGISTER_API(RenameCommand);
9307 JIM_REGISTER_API(GetCommand);
9308 JIM_REGISTER_API(SetVariable);
9309 JIM_REGISTER_API(SetVariableStr);
9310 JIM_REGISTER_API(SetGlobalVariableStr);
9311 JIM_REGISTER_API(SetVariableStrWithStr);
9312 JIM_REGISTER_API(SetVariableLink);
9313 JIM_REGISTER_API(GetVariable);
9314 JIM_REGISTER_API(GetCallFrameByLevel);
9315 JIM_REGISTER_API(Collect);
9316 JIM_REGISTER_API(CollectIfNeeded);
9317 JIM_REGISTER_API(GetIndex);
9318 JIM_REGISTER_API(NewListObj);
9319 JIM_REGISTER_API(ListAppendElement);
9320 JIM_REGISTER_API(ListAppendList);
9321 JIM_REGISTER_API(ListLength);
9322 JIM_REGISTER_API(ListIndex);
9323 JIM_REGISTER_API(SetListIndex);
9324 JIM_REGISTER_API(ConcatObj);
9325 JIM_REGISTER_API(NewDictObj);
9326 JIM_REGISTER_API(DictKey);
9327 JIM_REGISTER_API(DictKeysVector);
9328 JIM_REGISTER_API(GetIndex);
9329 JIM_REGISTER_API(GetReturnCode);
9330 JIM_REGISTER_API(EvalExpression);
9331 JIM_REGISTER_API(GetBoolFromExpr);
9332 JIM_REGISTER_API(GetWide);
9333 JIM_REGISTER_API(GetLong);
9334 JIM_REGISTER_API(SetWide);
9335 JIM_REGISTER_API(NewIntObj);
9336 JIM_REGISTER_API(GetDouble);
9337 JIM_REGISTER_API(SetDouble);
9338 JIM_REGISTER_API(NewDoubleObj);
9339 JIM_REGISTER_API(WrongNumArgs);
9340 JIM_REGISTER_API(SetDictKeysVector);
9341 JIM_REGISTER_API(SubstObj);
9342 JIM_REGISTER_API(RegisterApi);
9343 JIM_REGISTER_API(PrintErrorMessage);
9344 JIM_REGISTER_API(InteractivePrompt);
9345 JIM_REGISTER_API(RegisterCoreCommands);
9346 JIM_REGISTER_API(GetSharedString);
9347 JIM_REGISTER_API(ReleaseSharedString);
9348 JIM_REGISTER_API(Panic);
9349 JIM_REGISTER_API(StrDup);
9350 JIM_REGISTER_API(UnsetVariable);
9351 JIM_REGISTER_API(GetVariableStr);
9352 JIM_REGISTER_API(GetGlobalVariable);
9353 JIM_REGISTER_API(GetGlobalVariableStr);
9354 JIM_REGISTER_API(GetAssocData);
9355 JIM_REGISTER_API(SetAssocData);
9356 JIM_REGISTER_API(DeleteAssocData);
9357 JIM_REGISTER_API(GetEnum);
9358 JIM_REGISTER_API(ScriptIsComplete);
9359 JIM_REGISTER_API(PackageRequire);
9360 JIM_REGISTER_API(PackageProvide);
9361 JIM_REGISTER_API(InitStack);
9362 JIM_REGISTER_API(FreeStack);
9363 JIM_REGISTER_API(StackLen);
9364 JIM_REGISTER_API(StackPush);
9365 JIM_REGISTER_API(StackPop);
9366 JIM_REGISTER_API(StackPeek);
9367 JIM_REGISTER_API(FreeStackElements);
9368 JIM_REGISTER_API(fprintf);
9369 JIM_REGISTER_API(vfprintf);
9370 JIM_REGISTER_API(fwrite);
9371 JIM_REGISTER_API(fread);
9372 JIM_REGISTER_API(fflush);
9373 JIM_REGISTER_API(fgets);
9374 JIM_REGISTER_API(GetNvp);
9375 JIM_REGISTER_API(Nvp_name2value);
9376 JIM_REGISTER_API(Nvp_name2value_simple);
9377 JIM_REGISTER_API(Nvp_name2value_obj);
9378 JIM_REGISTER_API(Nvp_name2value_nocase);
9379 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9380
9381 JIM_REGISTER_API(Nvp_value2name);
9382 JIM_REGISTER_API(Nvp_value2name_simple);
9383 JIM_REGISTER_API(Nvp_value2name_obj);
9384
9385 JIM_REGISTER_API(GetOpt_Setup);
9386 JIM_REGISTER_API(GetOpt_Debug);
9387 JIM_REGISTER_API(GetOpt_Obj);
9388 JIM_REGISTER_API(GetOpt_String);
9389 JIM_REGISTER_API(GetOpt_Double);
9390 JIM_REGISTER_API(GetOpt_Wide);
9391 JIM_REGISTER_API(GetOpt_Nvp);
9392 JIM_REGISTER_API(GetOpt_NvpUnknown);
9393 JIM_REGISTER_API(GetOpt_Enum);
9394
9395 JIM_REGISTER_API(Debug_ArgvString);
9396 JIM_REGISTER_API(SetResult_sprintf);
9397 JIM_REGISTER_API(SetResult_NvpUnknown);
9398
9399 }
9400
9401 /* -----------------------------------------------------------------------------
9402 * Core commands utility functions
9403 * ---------------------------------------------------------------------------*/
9404 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9405 const char *msg)
9406 {
9407 int i;
9408 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9409
9410 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9411 for (i = 0; i < argc; i++) {
9412 Jim_AppendObj(interp, objPtr, argv[i]);
9413 if (!(i + 1 == argc && msg[0] == '\0'))
9414 Jim_AppendString(interp, objPtr, " ", 1);
9415 }
9416 Jim_AppendString(interp, objPtr, msg, -1);
9417 Jim_AppendString(interp, objPtr, "\"", 1);
9418 Jim_SetResult(interp, objPtr);
9419 }
9420
9421 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9422 {
9423 Jim_HashTableIterator *htiter;
9424 Jim_HashEntry *he;
9425 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9426 const char *pattern;
9427 int patternLen=0;
9428
9429 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9430 htiter = Jim_GetHashTableIterator(&interp->commands);
9431 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9432 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9433 strlen((const char*)he->key), 0))
9434 continue;
9435 Jim_ListAppendElement(interp, listObjPtr,
9436 Jim_NewStringObj(interp, he->key, -1));
9437 }
9438 Jim_FreeHashTableIterator(htiter);
9439 return listObjPtr;
9440 }
9441
9442 #define JIM_VARLIST_GLOBALS 0
9443 #define JIM_VARLIST_LOCALS 1
9444 #define JIM_VARLIST_VARS 2
9445
9446 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9447 int mode)
9448 {
9449 Jim_HashTableIterator *htiter;
9450 Jim_HashEntry *he;
9451 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9452 const char *pattern;
9453 int patternLen=0;
9454
9455 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9456 if (mode == JIM_VARLIST_GLOBALS) {
9457 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9458 } else {
9459 /* For [info locals], if we are at top level an emtpy list
9460 * is returned. I don't agree, but we aim at compatibility (SS) */
9461 if (mode == JIM_VARLIST_LOCALS &&
9462 interp->framePtr == interp->topFramePtr)
9463 return listObjPtr;
9464 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9465 }
9466 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9467 Jim_Var *varPtr = (Jim_Var*) he->val;
9468 if (mode == JIM_VARLIST_LOCALS) {
9469 if (varPtr->linkFramePtr != NULL)
9470 continue;
9471 }
9472 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9473 strlen((const char*)he->key), 0))
9474 continue;
9475 Jim_ListAppendElement(interp, listObjPtr,
9476 Jim_NewStringObj(interp, he->key, -1));
9477 }
9478 Jim_FreeHashTableIterator(htiter);
9479 return listObjPtr;
9480 }
9481
9482 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9483 Jim_Obj **objPtrPtr)
9484 {
9485 Jim_CallFrame *targetCallFrame;
9486
9487 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9488 != JIM_OK)
9489 return JIM_ERR;
9490 /* No proc call at toplevel callframe */
9491 if (targetCallFrame == interp->topFramePtr) {
9492 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9493 Jim_AppendStrings(interp, Jim_GetResult(interp),
9494 "bad level \"",
9495 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9496 return JIM_ERR;
9497 }
9498 *objPtrPtr = Jim_NewListObj(interp,
9499 targetCallFrame->argv,
9500 targetCallFrame->argc);
9501 return JIM_OK;
9502 }
9503
9504 /* -----------------------------------------------------------------------------
9505 * Core commands
9506 * ---------------------------------------------------------------------------*/
9507
9508 /* fake [puts] -- not the real puts, just for debugging. */
9509 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9510 Jim_Obj *const *argv)
9511 {
9512 const char *str;
9513 int len, nonewline = 0;
9514
9515 if (argc != 2 && argc != 3) {
9516 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9517 return JIM_ERR;
9518 }
9519 if (argc == 3) {
9520 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9521 {
9522 Jim_SetResultString(interp, "The second argument must "
9523 "be -nonewline", -1);
9524 return JIM_OK;
9525 } else {
9526 nonewline = 1;
9527 argv++;
9528 }
9529 }
9530 str = Jim_GetString(argv[1], &len);
9531 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9532 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9533 return JIM_OK;
9534 }
9535
9536 /* Helper for [+] and [*] */
9537 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9538 Jim_Obj *const *argv, int op)
9539 {
9540 jim_wide wideValue, res;
9541 double doubleValue, doubleRes;
9542 int i;
9543
9544 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9545
9546 for (i = 1; i < argc; i++) {
9547 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9548 goto trydouble;
9549 if (op == JIM_EXPROP_ADD)
9550 res += wideValue;
9551 else
9552 res *= wideValue;
9553 }
9554 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9555 return JIM_OK;
9556 trydouble:
9557 doubleRes = (double) res;
9558 for (;i < argc; i++) {
9559 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9560 return JIM_ERR;
9561 if (op == JIM_EXPROP_ADD)
9562 doubleRes += doubleValue;
9563 else
9564 doubleRes *= doubleValue;
9565 }
9566 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9567 return JIM_OK;
9568 }
9569
9570 /* Helper for [-] and [/] */
9571 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9572 Jim_Obj *const *argv, int op)
9573 {
9574 jim_wide wideValue, res = 0;
9575 double doubleValue, doubleRes = 0;
9576 int i = 2;
9577
9578 if (argc < 2) {
9579 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9580 return JIM_ERR;
9581 } else if (argc == 2) {
9582 /* The arity = 2 case is different. For [- x] returns -x,
9583 * while [/ x] returns 1/x. */
9584 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9585 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9586 JIM_OK)
9587 {
9588 return JIM_ERR;
9589 } else {
9590 if (op == JIM_EXPROP_SUB)
9591 doubleRes = -doubleValue;
9592 else
9593 doubleRes = 1.0/doubleValue;
9594 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9595 doubleRes));
9596 return JIM_OK;
9597 }
9598 }
9599 if (op == JIM_EXPROP_SUB) {
9600 res = -wideValue;
9601 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9602 } else {
9603 doubleRes = 1.0/wideValue;
9604 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9605 doubleRes));
9606 }
9607 return JIM_OK;
9608 } else {
9609 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9610 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9611 != JIM_OK) {
9612 return JIM_ERR;
9613 } else {
9614 goto trydouble;
9615 }
9616 }
9617 }
9618 for (i = 2; i < argc; i++) {
9619 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9620 doubleRes = (double) res;
9621 goto trydouble;
9622 }
9623 if (op == JIM_EXPROP_SUB)
9624 res -= wideValue;
9625 else
9626 res /= wideValue;
9627 }
9628 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9629 return JIM_OK;
9630 trydouble:
9631 for (;i < argc; i++) {
9632 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9633 return JIM_ERR;
9634 if (op == JIM_EXPROP_SUB)
9635 doubleRes -= doubleValue;
9636 else
9637 doubleRes /= doubleValue;
9638 }
9639 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9640 return JIM_OK;
9641 }
9642
9643
9644 /* [+] */
9645 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9646 Jim_Obj *const *argv)
9647 {
9648 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9649 }
9650
9651 /* [*] */
9652 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9653 Jim_Obj *const *argv)
9654 {
9655 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9656 }
9657
9658 /* [-] */
9659 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9660 Jim_Obj *const *argv)
9661 {
9662 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9663 }
9664
9665 /* [/] */
9666 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9667 Jim_Obj *const *argv)
9668 {
9669 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9670 }
9671
9672 /* [set] */
9673 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9674 Jim_Obj *const *argv)
9675 {
9676 if (argc != 2 && argc != 3) {
9677 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9678 return JIM_ERR;
9679 }
9680 if (argc == 2) {
9681 Jim_Obj *objPtr;
9682 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9683 if (!objPtr)
9684 return JIM_ERR;
9685 Jim_SetResult(interp, objPtr);
9686 return JIM_OK;
9687 }
9688 /* argc == 3 case. */
9689 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9690 return JIM_ERR;
9691 Jim_SetResult(interp, argv[2]);
9692 return JIM_OK;
9693 }
9694
9695 /* [unset] */
9696 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9697 Jim_Obj *const *argv)
9698 {
9699 int i;
9700
9701 if (argc < 2) {
9702 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9703 return JIM_ERR;
9704 }
9705 for (i = 1; i < argc; i++) {
9706 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9707 return JIM_ERR;
9708 }
9709 return JIM_OK;
9710 }
9711
9712 /* [incr] */
9713 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9714 Jim_Obj *const *argv)
9715 {
9716 jim_wide wideValue, increment = 1;
9717 Jim_Obj *intObjPtr;
9718
9719 if (argc != 2 && argc != 3) {
9720 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9721 return JIM_ERR;
9722 }
9723 if (argc == 3) {
9724 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9725 return JIM_ERR;
9726 }
9727 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9728 if (!intObjPtr) return JIM_ERR;
9729 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9730 return JIM_ERR;
9731 if (Jim_IsShared(intObjPtr)) {
9732 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9733 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9734 Jim_FreeNewObj(interp, intObjPtr);
9735 return JIM_ERR;
9736 }
9737 } else {
9738 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9739 /* The following step is required in order to invalidate the
9740 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9741 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9742 return JIM_ERR;
9743 }
9744 }
9745 Jim_SetResult(interp, intObjPtr);
9746 return JIM_OK;
9747 }
9748
9749 /* [while] */
9750 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9751 Jim_Obj *const *argv)
9752 {
9753 if (argc != 3) {
9754 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9755 return JIM_ERR;
9756 }
9757 /* Try to run a specialized version of while if the expression
9758 * is in one of the following forms:
9759 *
9760 * $a < CONST, $a < $b
9761 * $a <= CONST, $a <= $b
9762 * $a > CONST, $a > $b
9763 * $a >= CONST, $a >= $b
9764 * $a != CONST, $a != $b
9765 * $a == CONST, $a == $b
9766 * $a
9767 * !$a
9768 * CONST
9769 */
9770
9771 #ifdef JIM_OPTIMIZATION
9772 {
9773 ExprByteCode *expr;
9774 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9775 int exprLen, retval;
9776
9777 /* STEP 1 -- Check if there are the conditions to run the specialized
9778 * version of while */
9779
9780 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9781 if (expr->len <= 0 || expr->len > 3) goto noopt;
9782 switch (expr->len) {
9783 case 1:
9784 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9785 expr->opcode[0] != JIM_EXPROP_NUMBER)
9786 goto noopt;
9787 break;
9788 case 2:
9789 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9790 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9791 goto noopt;
9792 break;
9793 case 3:
9794 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9795 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9796 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9797 goto noopt;
9798 switch (expr->opcode[2]) {
9799 case JIM_EXPROP_LT:
9800 case JIM_EXPROP_LTE:
9801 case JIM_EXPROP_GT:
9802 case JIM_EXPROP_GTE:
9803 case JIM_EXPROP_NUMEQ:
9804 case JIM_EXPROP_NUMNE:
9805 /* nothing to do */
9806 break;
9807 default:
9808 goto noopt;
9809 }
9810 break;
9811 default:
9812 Jim_Panic(interp,
9813 "Unexpected default reached in Jim_WhileCoreCommand()");
9814 break;
9815 }
9816
9817 /* STEP 2 -- conditions meet. Initialization. Take different
9818 * branches for different expression lengths. */
9819 exprLen = expr->len;
9820
9821 if (exprLen == 1) {
9822 jim_wide wideValue=0;
9823
9824 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9825 varAObjPtr = expr->obj[0];
9826 Jim_IncrRefCount(varAObjPtr);
9827 } else {
9828 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9829 goto noopt;
9830 }
9831 while (1) {
9832 if (varAObjPtr) {
9833 if (!(objPtr =
9834 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9835 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9836 {
9837 Jim_DecrRefCount(interp, varAObjPtr);
9838 goto noopt;
9839 }
9840 }
9841 if (!wideValue) break;
9842 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9843 switch (retval) {
9844 case JIM_BREAK:
9845 if (varAObjPtr)
9846 Jim_DecrRefCount(interp, varAObjPtr);
9847 goto out;
9848 break;
9849 case JIM_CONTINUE:
9850 continue;
9851 break;
9852 default:
9853 if (varAObjPtr)
9854 Jim_DecrRefCount(interp, varAObjPtr);
9855 return retval;
9856 }
9857 }
9858 }
9859 if (varAObjPtr)
9860 Jim_DecrRefCount(interp, varAObjPtr);
9861 } else if (exprLen == 3) {
9862 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9863 int cmpType = expr->opcode[2];
9864
9865 varAObjPtr = expr->obj[0];
9866 Jim_IncrRefCount(varAObjPtr);
9867 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9868 varBObjPtr = expr->obj[1];
9869 Jim_IncrRefCount(varBObjPtr);
9870 } else {
9871 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9872 goto noopt;
9873 }
9874 while (1) {
9875 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9876 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9877 {
9878 Jim_DecrRefCount(interp, varAObjPtr);
9879 if (varBObjPtr)
9880 Jim_DecrRefCount(interp, varBObjPtr);
9881 goto noopt;
9882 }
9883 if (varBObjPtr) {
9884 if (!(objPtr =
9885 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9886 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9887 {
9888 Jim_DecrRefCount(interp, varAObjPtr);
9889 if (varBObjPtr)
9890 Jim_DecrRefCount(interp, varBObjPtr);
9891 goto noopt;
9892 }
9893 }
9894 switch (cmpType) {
9895 case JIM_EXPROP_LT:
9896 cmpRes = wideValueA < wideValueB; break;
9897 case JIM_EXPROP_LTE:
9898 cmpRes = wideValueA <= wideValueB; break;
9899 case JIM_EXPROP_GT:
9900 cmpRes = wideValueA > wideValueB; break;
9901 case JIM_EXPROP_GTE:
9902 cmpRes = wideValueA >= wideValueB; break;
9903 case JIM_EXPROP_NUMEQ:
9904 cmpRes = wideValueA == wideValueB; break;
9905 case JIM_EXPROP_NUMNE:
9906 cmpRes = wideValueA != wideValueB; break;
9907 }
9908 if (!cmpRes) break;
9909 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9910 switch (retval) {
9911 case JIM_BREAK:
9912 Jim_DecrRefCount(interp, varAObjPtr);
9913 if (varBObjPtr)
9914 Jim_DecrRefCount(interp, varBObjPtr);
9915 goto out;
9916 break;
9917 case JIM_CONTINUE:
9918 continue;
9919 break;
9920 default:
9921 Jim_DecrRefCount(interp, varAObjPtr);
9922 if (varBObjPtr)
9923 Jim_DecrRefCount(interp, varBObjPtr);
9924 return retval;
9925 }
9926 }
9927 }
9928 Jim_DecrRefCount(interp, varAObjPtr);
9929 if (varBObjPtr)
9930 Jim_DecrRefCount(interp, varBObjPtr);
9931 } else {
9932 /* TODO: case for len == 2 */
9933 goto noopt;
9934 }
9935 Jim_SetEmptyResult(interp);
9936 return JIM_OK;
9937 }
9938 noopt:
9939 #endif
9940
9941 /* The general purpose implementation of while starts here */
9942 while (1) {
9943 int boolean, retval;
9944
9945 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9946 &boolean)) != JIM_OK)
9947 return retval;
9948 if (!boolean) break;
9949 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9950 switch (retval) {
9951 case JIM_BREAK:
9952 goto out;
9953 break;
9954 case JIM_CONTINUE:
9955 continue;
9956 break;
9957 default:
9958 return retval;
9959 }
9960 }
9961 }
9962 out:
9963 Jim_SetEmptyResult(interp);
9964 return JIM_OK;
9965 }
9966
9967 /* [for] */
9968 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9969 Jim_Obj *const *argv)
9970 {
9971 int retval;
9972
9973 if (argc != 5) {
9974 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9975 return JIM_ERR;
9976 }
9977 /* Check if the for is on the form:
9978 * for {set i CONST} {$i < CONST} {incr i}
9979 * for {set i CONST} {$i < $j} {incr i}
9980 * for {set i CONST} {$i <= CONST} {incr i}
9981 * for {set i CONST} {$i <= $j} {incr i}
9982 * XXX: NOTE: if variable traces are implemented, this optimization
9983 * need to be modified to check for the proc epoch at every variable
9984 * update. */
9985 #ifdef JIM_OPTIMIZATION
9986 {
9987 ScriptObj *initScript, *incrScript;
9988 ExprByteCode *expr;
9989 jim_wide start, stop=0, currentVal;
9990 unsigned jim_wide procEpoch = interp->procEpoch;
9991 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9992 int cmpType;
9993 struct Jim_Cmd *cmdPtr;
9994
9995 /* Do it only if there aren't shared arguments */
9996 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9997 goto evalstart;
9998 initScript = Jim_GetScript(interp, argv[1]);
9999 expr = Jim_GetExpression(interp, argv[2]);
10000 incrScript = Jim_GetScript(interp, argv[3]);
10001
10002 /* Ensure proper lengths to start */
10003 if (initScript->len != 6) goto evalstart;
10004 if (incrScript->len != 4) goto evalstart;
10005 if (expr->len != 3) goto evalstart;
10006 /* Ensure proper token types. */
10007 if (initScript->token[2].type != JIM_TT_ESC ||
10008 initScript->token[4].type != JIM_TT_ESC ||
10009 incrScript->token[2].type != JIM_TT_ESC ||
10010 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10011 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10012 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10013 (expr->opcode[2] != JIM_EXPROP_LT &&
10014 expr->opcode[2] != JIM_EXPROP_LTE))
10015 goto evalstart;
10016 cmpType = expr->opcode[2];
10017 /* Initialization command must be [set] */
10018 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10019 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10020 goto evalstart;
10021 /* Update command must be incr */
10022 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10023 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10024 goto evalstart;
10025 /* set, incr, expression must be about the same variable */
10026 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10027 incrScript->token[2].objPtr, 0))
10028 goto evalstart;
10029 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10030 expr->obj[0], 0))
10031 goto evalstart;
10032 /* Check that the initialization and comparison are valid integers */
10033 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10034 goto evalstart;
10035 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10036 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10037 {
10038 goto evalstart;
10039 }
10040
10041 /* Initialization */
10042 varNamePtr = expr->obj[0];
10043 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10044 stopVarNamePtr = expr->obj[1];
10045 Jim_IncrRefCount(stopVarNamePtr);
10046 }
10047 Jim_IncrRefCount(varNamePtr);
10048
10049 /* --- OPTIMIZED FOR --- */
10050 /* Start to loop */
10051 objPtr = Jim_NewIntObj(interp, start);
10052 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10053 Jim_DecrRefCount(interp, varNamePtr);
10054 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10055 Jim_FreeNewObj(interp, objPtr);
10056 goto evalstart;
10057 }
10058 while (1) {
10059 /* === Check condition === */
10060 /* Common code: */
10061 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10062 if (objPtr == NULL ||
10063 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10064 {
10065 Jim_DecrRefCount(interp, varNamePtr);
10066 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10067 goto testcond;
10068 }
10069 /* Immediate or Variable? get the 'stop' value if the latter. */
10070 if (stopVarNamePtr) {
10071 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10072 if (objPtr == NULL ||
10073 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10074 {
10075 Jim_DecrRefCount(interp, varNamePtr);
10076 Jim_DecrRefCount(interp, stopVarNamePtr);
10077 goto testcond;
10078 }
10079 }
10080 if (cmpType == JIM_EXPROP_LT) {
10081 if (currentVal >= stop) break;
10082 } else {
10083 if (currentVal > stop) break;
10084 }
10085 /* Eval body */
10086 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10087 switch (retval) {
10088 case JIM_BREAK:
10089 if (stopVarNamePtr)
10090 Jim_DecrRefCount(interp, stopVarNamePtr);
10091 Jim_DecrRefCount(interp, varNamePtr);
10092 goto out;
10093 case JIM_CONTINUE:
10094 /* nothing to do */
10095 break;
10096 default:
10097 if (stopVarNamePtr)
10098 Jim_DecrRefCount(interp, stopVarNamePtr);
10099 Jim_DecrRefCount(interp, varNamePtr);
10100 return retval;
10101 }
10102 }
10103 /* If there was a change in procedures/command continue
10104 * with the usual [for] command implementation */
10105 if (procEpoch != interp->procEpoch) {
10106 if (stopVarNamePtr)
10107 Jim_DecrRefCount(interp, stopVarNamePtr);
10108 Jim_DecrRefCount(interp, varNamePtr);
10109 goto evalnext;
10110 }
10111 /* Increment */
10112 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10113 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10114 objPtr->internalRep.wideValue ++;
10115 Jim_InvalidateStringRep(objPtr);
10116 } else {
10117 Jim_Obj *auxObjPtr;
10118
10119 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10120 if (stopVarNamePtr)
10121 Jim_DecrRefCount(interp, stopVarNamePtr);
10122 Jim_DecrRefCount(interp, varNamePtr);
10123 goto evalnext;
10124 }
10125 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10126 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10127 if (stopVarNamePtr)
10128 Jim_DecrRefCount(interp, stopVarNamePtr);
10129 Jim_DecrRefCount(interp, varNamePtr);
10130 Jim_FreeNewObj(interp, auxObjPtr);
10131 goto evalnext;
10132 }
10133 }
10134 }
10135 if (stopVarNamePtr)
10136 Jim_DecrRefCount(interp, stopVarNamePtr);
10137 Jim_DecrRefCount(interp, varNamePtr);
10138 Jim_SetEmptyResult(interp);
10139 return JIM_OK;
10140 }
10141 #endif
10142 evalstart:
10143 /* Eval start */
10144 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10145 return retval;
10146 while (1) {
10147 int boolean;
10148 testcond:
10149 /* Test the condition */
10150 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10151 != JIM_OK)
10152 return retval;
10153 if (!boolean) break;
10154 /* Eval body */
10155 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10156 switch (retval) {
10157 case JIM_BREAK:
10158 goto out;
10159 break;
10160 case JIM_CONTINUE:
10161 /* Nothing to do */
10162 break;
10163 default:
10164 return retval;
10165 }
10166 }
10167 evalnext:
10168 /* Eval next */
10169 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10170 switch (retval) {
10171 case JIM_BREAK:
10172 goto out;
10173 break;
10174 case JIM_CONTINUE:
10175 continue;
10176 break;
10177 default:
10178 return retval;
10179 }
10180 }
10181 }
10182 out:
10183 Jim_SetEmptyResult(interp);
10184 return JIM_OK;
10185 }
10186
10187 /* foreach + lmap implementation. */
10188 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10189 Jim_Obj *const *argv, int doMap)
10190 {
10191 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10192 int nbrOfLoops = 0;
10193 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10194
10195 if (argc < 4 || argc % 2 != 0) {
10196 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10197 return JIM_ERR;
10198 }
10199 if (doMap) {
10200 mapRes = Jim_NewListObj(interp, NULL, 0);
10201 Jim_IncrRefCount(mapRes);
10202 }
10203 emptyStr = Jim_NewEmptyStringObj(interp);
10204 Jim_IncrRefCount(emptyStr);
10205 script = argv[argc-1]; /* Last argument is a script */
10206 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10207 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10208 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10209 /* Initialize iterators and remember max nbr elements each list */
10210 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10211 /* Remember lengths of all lists and calculate how much rounds to loop */
10212 for (i = 0; i < nbrOfLists*2; i += 2) {
10213 div_t cnt;
10214 int count;
10215 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10216 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10217 if (listsEnd[i] == 0) {
10218 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10219 goto err;
10220 }
10221 cnt = div(listsEnd[i + 1], listsEnd[i]);
10222 count = cnt.quot + (cnt.rem ? 1 : 0);
10223 if (count > nbrOfLoops)
10224 nbrOfLoops = count;
10225 }
10226 for (; nbrOfLoops-- > 0;) {
10227 for (i = 0; i < nbrOfLists; ++i) {
10228 int varIdx = 0, var = i * 2;
10229 while (varIdx < listsEnd[var]) {
10230 Jim_Obj *varName, *ele;
10231 int lst = i * 2 + 1;
10232 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10233 != JIM_OK)
10234 goto err;
10235 if (listsIdx[i] < listsEnd[lst]) {
10236 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10237 != JIM_OK)
10238 goto err;
10239 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10240 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10241 goto err;
10242 }
10243 ++listsIdx[i]; /* Remember next iterator of current list */
10244 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10245 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10246 goto err;
10247 }
10248 ++varIdx; /* Next variable */
10249 }
10250 }
10251 switch (result = Jim_EvalObj(interp, script)) {
10252 case JIM_OK:
10253 if (doMap)
10254 Jim_ListAppendElement(interp, mapRes, interp->result);
10255 break;
10256 case JIM_CONTINUE:
10257 break;
10258 case JIM_BREAK:
10259 goto out;
10260 break;
10261 default:
10262 goto err;
10263 }
10264 }
10265 out:
10266 result = JIM_OK;
10267 if (doMap)
10268 Jim_SetResult(interp, mapRes);
10269 else
10270 Jim_SetEmptyResult(interp);
10271 err:
10272 if (doMap)
10273 Jim_DecrRefCount(interp, mapRes);
10274 Jim_DecrRefCount(interp, emptyStr);
10275 Jim_Free(listsIdx);
10276 Jim_Free(listsEnd);
10277 return result;
10278 }
10279
10280 /* [foreach] */
10281 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10282 Jim_Obj *const *argv)
10283 {
10284 return JimForeachMapHelper(interp, argc, argv, 0);
10285 }
10286
10287 /* [lmap] */
10288 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10289 Jim_Obj *const *argv)
10290 {
10291 return JimForeachMapHelper(interp, argc, argv, 1);
10292 }
10293
10294 /* [if] */
10295 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10296 Jim_Obj *const *argv)
10297 {
10298 int boolean, retval, current = 1, falsebody = 0;
10299 if (argc >= 3) {
10300 while (1) {
10301 /* Far not enough arguments given! */
10302 if (current >= argc) goto err;
10303 if ((retval = Jim_GetBoolFromExpr(interp,
10304 argv[current++], &boolean))
10305 != JIM_OK)
10306 return retval;
10307 /* There lacks something, isn't it? */
10308 if (current >= argc) goto err;
10309 if (Jim_CompareStringImmediate(interp, argv[current],
10310 "then")) current++;
10311 /* Tsk tsk, no then-clause? */
10312 if (current >= argc) goto err;
10313 if (boolean)
10314 return Jim_EvalObj(interp, argv[current]);
10315 /* Ok: no else-clause follows */
10316 if (++current >= argc) {
10317 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10318 return JIM_OK;
10319 }
10320 falsebody = current++;
10321 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10322 "else")) {
10323 /* IIICKS - else-clause isn't last cmd? */
10324 if (current != argc-1) goto err;
10325 return Jim_EvalObj(interp, argv[current]);
10326 } else if (Jim_CompareStringImmediate(interp,
10327 argv[falsebody], "elseif"))
10328 /* Ok: elseif follows meaning all the stuff
10329 * again (how boring...) */
10330 continue;
10331 /* OOPS - else-clause is not last cmd?*/
10332 else if (falsebody != argc-1)
10333 goto err;
10334 return Jim_EvalObj(interp, argv[falsebody]);
10335 }
10336 return JIM_OK;
10337 }
10338 err:
10339 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10340 return JIM_ERR;
10341 }
10342
10343 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10344
10345 /* [switch] */
10346 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10347 Jim_Obj *const *argv)
10348 {
10349 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10350 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10351 Jim_Obj *script = 0;
10352 if (argc < 3) goto wrongnumargs;
10353 for (opt = 1; opt < argc; ++opt) {
10354 const char *option = Jim_GetString(argv[opt], 0);
10355 if (*option != '-') break;
10356 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10357 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10358 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10359 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10360 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10361 if ((argc - opt) < 2) goto wrongnumargs;
10362 command = argv[++opt];
10363 } else {
10364 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10365 Jim_AppendStrings(interp, Jim_GetResult(interp),
10366 "bad option \"", option, "\": must be -exact, -glob, "
10367 "-regexp, -command procname or --", 0);
10368 goto err;
10369 }
10370 if ((argc - opt) < 2) goto wrongnumargs;
10371 }
10372 strObj = argv[opt++];
10373 patCount = argc - opt;
10374 if (patCount == 1) {
10375 Jim_Obj **vector;
10376 JimListGetElements(interp, argv[opt], &patCount, &vector);
10377 caseList = vector;
10378 } else
10379 caseList = &argv[opt];
10380 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10381 for (i = 0; script == 0 && i < patCount; i += 2) {
10382 Jim_Obj *patObj = caseList[i];
10383 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10384 || i < (patCount-2)) {
10385 switch (matchOpt) {
10386 case SWITCH_EXACT:
10387 if (Jim_StringEqObj(strObj, patObj, 0))
10388 script = caseList[i + 1];
10389 break;
10390 case SWITCH_GLOB:
10391 if (Jim_StringMatchObj(patObj, strObj, 0))
10392 script = caseList[i + 1];
10393 break;
10394 case SWITCH_RE:
10395 command = Jim_NewStringObj(interp, "regexp", -1);
10396 /* Fall thru intentionally */
10397 case SWITCH_CMD: {
10398 Jim_Obj *parms[] = {command, patObj, strObj};
10399 int rc = Jim_EvalObjVector(interp, 3, parms);
10400 long matching;
10401 /* After the execution of a command we need to
10402 * make sure to reconvert the object into a list
10403 * again. Only for the single-list style [switch]. */
10404 if (argc-opt == 1) {
10405 Jim_Obj **vector;
10406 JimListGetElements(interp, argv[opt], &patCount,
10407 &vector);
10408 caseList = vector;
10409 }
10410 /* command is here already decref'd */
10411 if (rc != JIM_OK) {
10412 retcode = rc;
10413 goto err;
10414 }
10415 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10416 if (rc != JIM_OK) {
10417 retcode = rc;
10418 goto err;
10419 }
10420 if (matching)
10421 script = caseList[i + 1];
10422 break;
10423 }
10424 default:
10425 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10426 Jim_AppendStrings(interp, Jim_GetResult(interp),
10427 "internal error: no such option implemented", 0);
10428 goto err;
10429 }
10430 } else {
10431 script = caseList[i + 1];
10432 }
10433 }
10434 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10435 i += 2)
10436 script = caseList[i + 1];
10437 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10438 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10439 Jim_AppendStrings(interp, Jim_GetResult(interp),
10440 "no body specified for pattern \"",
10441 Jim_GetString(caseList[i-2], 0), "\"", 0);
10442 goto err;
10443 }
10444 retcode = JIM_OK;
10445 Jim_SetEmptyResult(interp);
10446 if (script != 0)
10447 retcode = Jim_EvalObj(interp, script);
10448 return retcode;
10449 wrongnumargs:
10450 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10451 "pattern body ... ?default body? or "
10452 "{pattern body ?pattern body ...?}");
10453 err:
10454 return retcode;
10455 }
10456
10457 /* [list] */
10458 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10459 Jim_Obj *const *argv)
10460 {
10461 Jim_Obj *listObjPtr;
10462
10463 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10464 Jim_SetResult(interp, listObjPtr);
10465 return JIM_OK;
10466 }
10467
10468 /* [lindex] */
10469 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10470 Jim_Obj *const *argv)
10471 {
10472 Jim_Obj *objPtr, *listObjPtr;
10473 int i;
10474 int index;
10475
10476 if (argc < 3) {
10477 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10478 return JIM_ERR;
10479 }
10480 objPtr = argv[1];
10481 Jim_IncrRefCount(objPtr);
10482 for (i = 2; i < argc; i++) {
10483 listObjPtr = objPtr;
10484 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10485 Jim_DecrRefCount(interp, listObjPtr);
10486 return JIM_ERR;
10487 }
10488 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10489 JIM_NONE) != JIM_OK) {
10490 /* Returns an empty object if the index
10491 * is out of range. */
10492 Jim_DecrRefCount(interp, listObjPtr);
10493 Jim_SetEmptyResult(interp);
10494 return JIM_OK;
10495 }
10496 Jim_IncrRefCount(objPtr);
10497 Jim_DecrRefCount(interp, listObjPtr);
10498 }
10499 Jim_SetResult(interp, objPtr);
10500 Jim_DecrRefCount(interp, objPtr);
10501 return JIM_OK;
10502 }
10503
10504 /* [llength] */
10505 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10506 Jim_Obj *const *argv)
10507 {
10508 int len;
10509
10510 if (argc != 2) {
10511 Jim_WrongNumArgs(interp, 1, argv, "list");
10512 return JIM_ERR;
10513 }
10514 Jim_ListLength(interp, argv[1], &len);
10515 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10516 return JIM_OK;
10517 }
10518
10519 /* [lappend] */
10520 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10521 Jim_Obj *const *argv)
10522 {
10523 Jim_Obj *listObjPtr;
10524 int shared, i;
10525
10526 if (argc < 2) {
10527 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10528 return JIM_ERR;
10529 }
10530 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10531 if (!listObjPtr) {
10532 /* Create the list if it does not exists */
10533 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10534 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10535 Jim_FreeNewObj(interp, listObjPtr);
10536 return JIM_ERR;
10537 }
10538 }
10539 shared = Jim_IsShared(listObjPtr);
10540 if (shared)
10541 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10542 for (i = 2; i < argc; i++)
10543 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10544 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10545 if (shared)
10546 Jim_FreeNewObj(interp, listObjPtr);
10547 return JIM_ERR;
10548 }
10549 Jim_SetResult(interp, listObjPtr);
10550 return JIM_OK;
10551 }
10552
10553 /* [linsert] */
10554 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10555 Jim_Obj *const *argv)
10556 {
10557 int index, len;
10558 Jim_Obj *listPtr;
10559
10560 if (argc < 4) {
10561 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10562 "?element ...?");
10563 return JIM_ERR;
10564 }
10565 listPtr = argv[1];
10566 if (Jim_IsShared(listPtr))
10567 listPtr = Jim_DuplicateObj(interp, listPtr);
10568 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10569 goto err;
10570 Jim_ListLength(interp, listPtr, &len);
10571 if (index >= len)
10572 index = len;
10573 else if (index < 0)
10574 index = len + index + 1;
10575 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10576 Jim_SetResult(interp, listPtr);
10577 return JIM_OK;
10578 err:
10579 if (listPtr != argv[1]) {
10580 Jim_FreeNewObj(interp, listPtr);
10581 }
10582 return JIM_ERR;
10583 }
10584
10585 /* [lset] */
10586 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10587 Jim_Obj *const *argv)
10588 {
10589 if (argc < 3) {
10590 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10591 return JIM_ERR;
10592 } else if (argc == 3) {
10593 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10594 return JIM_ERR;
10595 Jim_SetResult(interp, argv[2]);
10596 return JIM_OK;
10597 }
10598 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10599 == JIM_ERR) return JIM_ERR;
10600 return JIM_OK;
10601 }
10602
10603 /* [lsort] */
10604 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10605 {
10606 const char *options[] = {
10607 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10608 };
10609 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10610 Jim_Obj *resObj;
10611 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10612 int decreasing = 0;
10613
10614 if (argc < 2) {
10615 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10616 return JIM_ERR;
10617 }
10618 for (i = 1; i < (argc-1); i++) {
10619 int option;
10620
10621 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10622 != JIM_OK)
10623 return JIM_ERR;
10624 switch (option) {
10625 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10626 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10627 case OPT_INCREASING: decreasing = 0; break;
10628 case OPT_DECREASING: decreasing = 1; break;
10629 }
10630 }
10631 if (decreasing) {
10632 switch (lsortType) {
10633 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10634 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10635 }
10636 }
10637 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10638 ListSortElements(interp, resObj, lsortType);
10639 Jim_SetResult(interp, resObj);
10640 return JIM_OK;
10641 }
10642
10643 /* [append] */
10644 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10645 Jim_Obj *const *argv)
10646 {
10647 Jim_Obj *stringObjPtr;
10648 int shared, i;
10649
10650 if (argc < 2) {
10651 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10652 return JIM_ERR;
10653 }
10654 if (argc == 2) {
10655 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10656 if (!stringObjPtr) return JIM_ERR;
10657 } else {
10658 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10659 if (!stringObjPtr) {
10660 /* Create the string if it does not exists */
10661 stringObjPtr = Jim_NewEmptyStringObj(interp);
10662 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10663 != JIM_OK) {
10664 Jim_FreeNewObj(interp, stringObjPtr);
10665 return JIM_ERR;
10666 }
10667 }
10668 }
10669 shared = Jim_IsShared(stringObjPtr);
10670 if (shared)
10671 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10672 for (i = 2; i < argc; i++)
10673 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10674 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10675 if (shared)
10676 Jim_FreeNewObj(interp, stringObjPtr);
10677 return JIM_ERR;
10678 }
10679 Jim_SetResult(interp, stringObjPtr);
10680 return JIM_OK;
10681 }
10682
10683 /* [debug] */
10684 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10685 Jim_Obj *const *argv)
10686 {
10687 const char *options[] = {
10688 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10689 "exprbc",
10690 NULL
10691 };
10692 enum {
10693 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10694 OPT_EXPRLEN, OPT_EXPRBC
10695 };
10696 int option;
10697
10698 if (argc < 2) {
10699 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10700 return JIM_ERR;
10701 }
10702 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10703 JIM_ERRMSG) != JIM_OK)
10704 return JIM_ERR;
10705 if (option == OPT_REFCOUNT) {
10706 if (argc != 3) {
10707 Jim_WrongNumArgs(interp, 2, argv, "object");
10708 return JIM_ERR;
10709 }
10710 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10711 return JIM_OK;
10712 } else if (option == OPT_OBJCOUNT) {
10713 int freeobj = 0, liveobj = 0;
10714 char buf[256];
10715 Jim_Obj *objPtr;
10716
10717 if (argc != 2) {
10718 Jim_WrongNumArgs(interp, 2, argv, "");
10719 return JIM_ERR;
10720 }
10721 /* Count the number of free objects. */
10722 objPtr = interp->freeList;
10723 while (objPtr) {
10724 freeobj++;
10725 objPtr = objPtr->nextObjPtr;
10726 }
10727 /* Count the number of live objects. */
10728 objPtr = interp->liveList;
10729 while (objPtr) {
10730 liveobj++;
10731 objPtr = objPtr->nextObjPtr;
10732 }
10733 /* Set the result string and return. */
10734 sprintf(buf, "free %d used %d", freeobj, liveobj);
10735 Jim_SetResultString(interp, buf, -1);
10736 return JIM_OK;
10737 } else if (option == OPT_OBJECTS) {
10738 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10739 /* Count the number of live objects. */
10740 objPtr = interp->liveList;
10741 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10742 while (objPtr) {
10743 char buf[128];
10744 const char *type = objPtr->typePtr ?
10745 objPtr->typePtr->name : "";
10746 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10747 sprintf(buf, "%p", objPtr);
10748 Jim_ListAppendElement(interp, subListObjPtr,
10749 Jim_NewStringObj(interp, buf, -1));
10750 Jim_ListAppendElement(interp, subListObjPtr,
10751 Jim_NewStringObj(interp, type, -1));
10752 Jim_ListAppendElement(interp, subListObjPtr,
10753 Jim_NewIntObj(interp, objPtr->refCount));
10754 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10755 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10756 objPtr = objPtr->nextObjPtr;
10757 }
10758 Jim_SetResult(interp, listObjPtr);
10759 return JIM_OK;
10760 } else if (option == OPT_INVSTR) {
10761 Jim_Obj *objPtr;
10762
10763 if (argc != 3) {
10764 Jim_WrongNumArgs(interp, 2, argv, "object");
10765 return JIM_ERR;
10766 }
10767 objPtr = argv[2];
10768 if (objPtr->typePtr != NULL)
10769 Jim_InvalidateStringRep(objPtr);
10770 Jim_SetEmptyResult(interp);
10771 return JIM_OK;
10772 } else if (option == OPT_SCRIPTLEN) {
10773 ScriptObj *script;
10774 if (argc != 3) {
10775 Jim_WrongNumArgs(interp, 2, argv, "script");
10776 return JIM_ERR;
10777 }
10778 script = Jim_GetScript(interp, argv[2]);
10779 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10780 return JIM_OK;
10781 } else if (option == OPT_EXPRLEN) {
10782 ExprByteCode *expr;
10783 if (argc != 3) {
10784 Jim_WrongNumArgs(interp, 2, argv, "expression");
10785 return JIM_ERR;
10786 }
10787 expr = Jim_GetExpression(interp, argv[2]);
10788 if (expr == NULL)
10789 return JIM_ERR;
10790 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10791 return JIM_OK;
10792 } else if (option == OPT_EXPRBC) {
10793 Jim_Obj *objPtr;
10794 ExprByteCode *expr;
10795 int i;
10796
10797 if (argc != 3) {
10798 Jim_WrongNumArgs(interp, 2, argv, "expression");
10799 return JIM_ERR;
10800 }
10801 expr = Jim_GetExpression(interp, argv[2]);
10802 if (expr == NULL)
10803 return JIM_ERR;
10804 objPtr = Jim_NewListObj(interp, NULL, 0);
10805 for (i = 0; i < expr->len; i++) {
10806 const char *type;
10807 Jim_ExprOperator *op;
10808
10809 switch (expr->opcode[i]) {
10810 case JIM_EXPROP_NUMBER: type = "number"; break;
10811 case JIM_EXPROP_COMMAND: type = "command"; break;
10812 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10813 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10814 case JIM_EXPROP_SUBST: type = "subst"; break;
10815 case JIM_EXPROP_STRING: type = "string"; break;
10816 default:
10817 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10818 if (op == NULL) {
10819 type = "private";
10820 } else {
10821 type = "operator";
10822 }
10823 break;
10824 }
10825 Jim_ListAppendElement(interp, objPtr,
10826 Jim_NewStringObj(interp, type, -1));
10827 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10828 }
10829 Jim_SetResult(interp, objPtr);
10830 return JIM_OK;
10831 } else {
10832 Jim_SetResultString(interp,
10833 "bad option. Valid options are refcount, "
10834 "objcount, objects, invstr", -1);
10835 return JIM_ERR;
10836 }
10837 return JIM_OK; /* unreached */
10838 }
10839
10840 /* [eval] */
10841 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10842 Jim_Obj *const *argv)
10843 {
10844 if (argc == 2) {
10845 return Jim_EvalObj(interp, argv[1]);
10846 } else if (argc > 2) {
10847 Jim_Obj *objPtr;
10848 int retcode;
10849
10850 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10851 Jim_IncrRefCount(objPtr);
10852 retcode = Jim_EvalObj(interp, objPtr);
10853 Jim_DecrRefCount(interp, objPtr);
10854 return retcode;
10855 } else {
10856 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10857 return JIM_ERR;
10858 }
10859 }
10860
10861 /* [uplevel] */
10862 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10863 Jim_Obj *const *argv)
10864 {
10865 if (argc >= 2) {
10866 int retcode, newLevel, oldLevel;
10867 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10868 Jim_Obj *objPtr;
10869 const char *str;
10870
10871 /* Save the old callframe pointer */
10872 savedCallFrame = interp->framePtr;
10873
10874 /* Lookup the target frame pointer */
10875 str = Jim_GetString(argv[1], NULL);
10876 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10877 {
10878 if (Jim_GetCallFrameByLevel(interp, argv[1],
10879 &targetCallFrame,
10880 &newLevel) != JIM_OK)
10881 return JIM_ERR;
10882 argc--;
10883 argv++;
10884 } else {
10885 if (Jim_GetCallFrameByLevel(interp, NULL,
10886 &targetCallFrame,
10887 &newLevel) != JIM_OK)
10888 return JIM_ERR;
10889 }
10890 if (argc < 2) {
10891 argc++;
10892 argv--;
10893 Jim_WrongNumArgs(interp, 1, argv,
10894 "?level? command ?arg ...?");
10895 return JIM_ERR;
10896 }
10897 /* Eval the code in the target callframe. */
10898 interp->framePtr = targetCallFrame;
10899 oldLevel = interp->numLevels;
10900 interp->numLevels = newLevel;
10901 if (argc == 2) {
10902 retcode = Jim_EvalObj(interp, argv[1]);
10903 } else {
10904 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10905 Jim_IncrRefCount(objPtr);
10906 retcode = Jim_EvalObj(interp, objPtr);
10907 Jim_DecrRefCount(interp, objPtr);
10908 }
10909 interp->numLevels = oldLevel;
10910 interp->framePtr = savedCallFrame;
10911 return retcode;
10912 } else {
10913 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10914 return JIM_ERR;
10915 }
10916 }
10917
10918 /* [expr] */
10919 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10920 Jim_Obj *const *argv)
10921 {
10922 Jim_Obj *exprResultPtr;
10923 int retcode;
10924
10925 if (argc == 2) {
10926 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10927 } else if (argc > 2) {
10928 Jim_Obj *objPtr;
10929
10930 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10931 Jim_IncrRefCount(objPtr);
10932 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10933 Jim_DecrRefCount(interp, objPtr);
10934 } else {
10935 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10936 return JIM_ERR;
10937 }
10938 if (retcode != JIM_OK) return retcode;
10939 Jim_SetResult(interp, exprResultPtr);
10940 Jim_DecrRefCount(interp, exprResultPtr);
10941 return JIM_OK;
10942 }
10943
10944 /* [break] */
10945 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10946 Jim_Obj *const *argv)
10947 {
10948 if (argc != 1) {
10949 Jim_WrongNumArgs(interp, 1, argv, "");
10950 return JIM_ERR;
10951 }
10952 return JIM_BREAK;
10953 }
10954
10955 /* [continue] */
10956 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10957 Jim_Obj *const *argv)
10958 {
10959 if (argc != 1) {
10960 Jim_WrongNumArgs(interp, 1, argv, "");
10961 return JIM_ERR;
10962 }
10963 return JIM_CONTINUE;
10964 }
10965
10966 /* [return] */
10967 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10968 Jim_Obj *const *argv)
10969 {
10970 if (argc == 1) {
10971 return JIM_RETURN;
10972 } else if (argc == 2) {
10973 Jim_SetResult(interp, argv[1]);
10974 interp->returnCode = JIM_OK;
10975 return JIM_RETURN;
10976 } else if (argc == 3 || argc == 4) {
10977 int returnCode;
10978 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10979 return JIM_ERR;
10980 interp->returnCode = returnCode;
10981 if (argc == 4)
10982 Jim_SetResult(interp, argv[3]);
10983 return JIM_RETURN;
10984 } else {
10985 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10986 return JIM_ERR;
10987 }
10988 return JIM_RETURN; /* unreached */
10989 }
10990
10991 /* [tailcall] */
10992 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10993 Jim_Obj *const *argv)
10994 {
10995 Jim_Obj *objPtr;
10996
10997 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10998 Jim_SetResult(interp, objPtr);
10999 return JIM_EVAL;
11000 }
11001
11002 /* [proc] */
11003 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11004 Jim_Obj *const *argv)
11005 {
11006 int argListLen;
11007 int arityMin, arityMax;
11008
11009 if (argc != 4 && argc != 5) {
11010 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11011 return JIM_ERR;
11012 }
11013 Jim_ListLength(interp, argv[2], &argListLen);
11014 arityMin = arityMax = argListLen + 1;
11015
11016 if (argListLen) {
11017 const char *str;
11018 int len;
11019 Jim_Obj *argPtr=NULL;
11020
11021 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11022 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11023 str = Jim_GetString(argPtr, &len);
11024 if (len == 4 && memcmp(str, "args", 4) == 0) {
11025 arityMin--;
11026 arityMax = -1;
11027 }
11028
11029 /* Check for default arguments and reduce arityMin if necessary */
11030 while (arityMin > 1) {
11031 int len;
11032 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11033 Jim_ListLength(interp, argPtr, &len);
11034 if (len != 2) {
11035 /* No default argument */
11036 break;
11037 }
11038 arityMin--;
11039 }
11040 }
11041 if (argc == 4) {
11042 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11043 argv[2], NULL, argv[3], arityMin, arityMax);
11044 } else {
11045 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11046 argv[2], argv[3], argv[4], arityMin, arityMax);
11047 }
11048 }
11049
11050 /* [concat] */
11051 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11052 Jim_Obj *const *argv)
11053 {
11054 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11055 return JIM_OK;
11056 }
11057
11058 /* [upvar] */
11059 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11060 Jim_Obj *const *argv)
11061 {
11062 const char *str;
11063 int i;
11064 Jim_CallFrame *targetCallFrame;
11065
11066 /* Lookup the target frame pointer */
11067 str = Jim_GetString(argv[1], NULL);
11068 if (argc > 3 &&
11069 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11070 {
11071 if (Jim_GetCallFrameByLevel(interp, argv[1],
11072 &targetCallFrame, NULL) != JIM_OK)
11073 return JIM_ERR;
11074 argc--;
11075 argv++;
11076 } else {
11077 if (Jim_GetCallFrameByLevel(interp, NULL,
11078 &targetCallFrame, NULL) != JIM_OK)
11079 return JIM_ERR;
11080 }
11081 /* Check for arity */
11082 if (argc < 3 || ((argc-1)%2) != 0) {
11083 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11084 return JIM_ERR;
11085 }
11086 /* Now... for every other/local couple: */
11087 for (i = 1; i < argc; i += 2) {
11088 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11089 targetCallFrame) != JIM_OK) return JIM_ERR;
11090 }
11091 return JIM_OK;
11092 }
11093
11094 /* [global] */
11095 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11096 Jim_Obj *const *argv)
11097 {
11098 int i;
11099
11100 if (argc < 2) {
11101 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11102 return JIM_ERR;
11103 }
11104 /* Link every var to the toplevel having the same name */
11105 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11106 for (i = 1; i < argc; i++) {
11107 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11108 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11109 }
11110 return JIM_OK;
11111 }
11112
11113 /* does the [string map] operation. On error NULL is returned,
11114 * otherwise a new string object with the result, having refcount = 0,
11115 * is returned. */
11116 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11117 Jim_Obj *objPtr, int nocase)
11118 {
11119 int numMaps;
11120 const char **key, *str, *noMatchStart = NULL;
11121 Jim_Obj **value;
11122 int *keyLen, strLen, i;
11123 Jim_Obj *resultObjPtr;
11124
11125 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11126 if (numMaps % 2) {
11127 Jim_SetResultString(interp,
11128 "list must contain an even number of elements", -1);
11129 return NULL;
11130 }
11131 /* Initialization */
11132 numMaps /= 2;
11133 key = Jim_Alloc(sizeof(char*)*numMaps);
11134 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11135 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11136 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11137 for (i = 0; i < numMaps; i++) {
11138 Jim_Obj *eleObjPtr=NULL;
11139
11140 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11141 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11142 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11143 value[i] = eleObjPtr;
11144 }
11145 str = Jim_GetString(objPtr, &strLen);
11146 /* Map it */
11147 while (strLen) {
11148 for (i = 0; i < numMaps; i++) {
11149 if (strLen >= keyLen[i] && keyLen[i]) {
11150 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11151 nocase))
11152 {
11153 if (noMatchStart) {
11154 Jim_AppendString(interp, resultObjPtr,
11155 noMatchStart, str-noMatchStart);
11156 noMatchStart = NULL;
11157 }
11158 Jim_AppendObj(interp, resultObjPtr, value[i]);
11159 str += keyLen[i];
11160 strLen -= keyLen[i];
11161 break;
11162 }
11163 }
11164 }
11165 if (i == numMaps) { /* no match */
11166 if (noMatchStart == NULL)
11167 noMatchStart = str;
11168 str ++;
11169 strLen --;
11170 }
11171 }
11172 if (noMatchStart) {
11173 Jim_AppendString(interp, resultObjPtr,
11174 noMatchStart, str-noMatchStart);
11175 }
11176 Jim_Free((void*)key);
11177 Jim_Free(keyLen);
11178 Jim_Free(value);
11179 return resultObjPtr;
11180 }
11181
11182 /* [string] */
11183 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11184 Jim_Obj *const *argv)
11185 {
11186 int option;
11187 const char *options[] = {
11188 "length", "compare", "match", "equal", "range", "map", "repeat",
11189 "index", "first", "tolower", "toupper", NULL
11190 };
11191 enum {
11192 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11193 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11194 };
11195
11196 if (argc < 2) {
11197 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11198 return JIM_ERR;
11199 }
11200 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11201 JIM_ERRMSG) != JIM_OK)
11202 return JIM_ERR;
11203
11204 if (option == OPT_LENGTH) {
11205 int len;
11206
11207 if (argc != 3) {
11208 Jim_WrongNumArgs(interp, 2, argv, "string");
11209 return JIM_ERR;
11210 }
11211 Jim_GetString(argv[2], &len);
11212 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11213 return JIM_OK;
11214 } else if (option == OPT_COMPARE) {
11215 int nocase = 0;
11216 if ((argc != 4 && argc != 5) ||
11217 (argc == 5 && Jim_CompareStringImmediate(interp,
11218 argv[2], "-nocase") == 0)) {
11219 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11220 return JIM_ERR;
11221 }
11222 if (argc == 5) {
11223 nocase = 1;
11224 argv++;
11225 }
11226 Jim_SetResult(interp, Jim_NewIntObj(interp,
11227 Jim_StringCompareObj(argv[2],
11228 argv[3], nocase)));
11229 return JIM_OK;
11230 } else if (option == OPT_MATCH) {
11231 int nocase = 0;
11232 if ((argc != 4 && argc != 5) ||
11233 (argc == 5 && Jim_CompareStringImmediate(interp,
11234 argv[2], "-nocase") == 0)) {
11235 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11236 "string");
11237 return JIM_ERR;
11238 }
11239 if (argc == 5) {
11240 nocase = 1;
11241 argv++;
11242 }
11243 Jim_SetResult(interp,
11244 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11245 argv[3], nocase)));
11246 return JIM_OK;
11247 } else if (option == OPT_EQUAL) {
11248 if (argc != 4) {
11249 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11250 return JIM_ERR;
11251 }
11252 Jim_SetResult(interp,
11253 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11254 argv[3], 0)));
11255 return JIM_OK;
11256 } else if (option == OPT_RANGE) {
11257 Jim_Obj *objPtr;
11258
11259 if (argc != 5) {
11260 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11261 return JIM_ERR;
11262 }
11263 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11264 if (objPtr == NULL)
11265 return JIM_ERR;
11266 Jim_SetResult(interp, objPtr);
11267 return JIM_OK;
11268 } else if (option == OPT_MAP) {
11269 int nocase = 0;
11270 Jim_Obj *objPtr;
11271
11272 if ((argc != 4 && argc != 5) ||
11273 (argc == 5 && Jim_CompareStringImmediate(interp,
11274 argv[2], "-nocase") == 0)) {
11275 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11276 "string");
11277 return JIM_ERR;
11278 }
11279 if (argc == 5) {
11280 nocase = 1;
11281 argv++;
11282 }
11283 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11284 if (objPtr == NULL)
11285 return JIM_ERR;
11286 Jim_SetResult(interp, objPtr);
11287 return JIM_OK;
11288 } else if (option == OPT_REPEAT) {
11289 Jim_Obj *objPtr;
11290 jim_wide count;
11291
11292 if (argc != 4) {
11293 Jim_WrongNumArgs(interp, 2, argv, "string count");
11294 return JIM_ERR;
11295 }
11296 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11297 return JIM_ERR;
11298 objPtr = Jim_NewStringObj(interp, "", 0);
11299 while (count--) {
11300 Jim_AppendObj(interp, objPtr, argv[2]);
11301 }
11302 Jim_SetResult(interp, objPtr);
11303 return JIM_OK;
11304 } else if (option == OPT_INDEX) {
11305 int index, len;
11306 const char *str;
11307
11308 if (argc != 4) {
11309 Jim_WrongNumArgs(interp, 2, argv, "string index");
11310 return JIM_ERR;
11311 }
11312 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11313 return JIM_ERR;
11314 str = Jim_GetString(argv[2], &len);
11315 if (index != INT_MIN && index != INT_MAX)
11316 index = JimRelToAbsIndex(len, index);
11317 if (index < 0 || index >= len) {
11318 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11319 return JIM_OK;
11320 } else {
11321 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11322 return JIM_OK;
11323 }
11324 } else if (option == OPT_FIRST) {
11325 int index = 0, l1, l2;
11326 const char *s1, *s2;
11327
11328 if (argc != 4 && argc != 5) {
11329 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11330 return JIM_ERR;
11331 }
11332 s1 = Jim_GetString(argv[2], &l1);
11333 s2 = Jim_GetString(argv[3], &l2);
11334 if (argc == 5) {
11335 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11336 return JIM_ERR;
11337 index = JimRelToAbsIndex(l2, index);
11338 }
11339 Jim_SetResult(interp, Jim_NewIntObj(interp,
11340 JimStringFirst(s1, l1, s2, l2, index)));
11341 return JIM_OK;
11342 } else if (option == OPT_TOLOWER) {
11343 if (argc != 3) {
11344 Jim_WrongNumArgs(interp, 2, argv, "string");
11345 return JIM_ERR;
11346 }
11347 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11348 } else if (option == OPT_TOUPPER) {
11349 if (argc != 3) {
11350 Jim_WrongNumArgs(interp, 2, argv, "string");
11351 return JIM_ERR;
11352 }
11353 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11354 }
11355 return JIM_OK;
11356 }
11357
11358 /* [time] */
11359 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11360 Jim_Obj *const *argv)
11361 {
11362 long i, count = 1;
11363 jim_wide start, elapsed;
11364 char buf [256];
11365 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11366
11367 if (argc < 2) {
11368 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11369 return JIM_ERR;
11370 }
11371 if (argc == 3) {
11372 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11373 return JIM_ERR;
11374 }
11375 if (count < 0)
11376 return JIM_OK;
11377 i = count;
11378 start = JimClock();
11379 while (i-- > 0) {
11380 int retval;
11381
11382 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11383 return retval;
11384 }
11385 elapsed = JimClock() - start;
11386 sprintf(buf, fmt, elapsed/count);
11387 Jim_SetResultString(interp, buf, -1);
11388 return JIM_OK;
11389 }
11390
11391 /* [exit] */
11392 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11393 Jim_Obj *const *argv)
11394 {
11395 long exitCode = 0;
11396
11397 if (argc > 2) {
11398 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11399 return JIM_ERR;
11400 }
11401 if (argc == 2) {
11402 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11403 return JIM_ERR;
11404 }
11405 interp->exitCode = exitCode;
11406 return JIM_EXIT;
11407 }
11408
11409 /* [catch] */
11410 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11411 Jim_Obj *const *argv)
11412 {
11413 int exitCode = 0;
11414
11415 if (argc != 2 && argc != 3) {
11416 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11417 return JIM_ERR;
11418 }
11419 exitCode = Jim_EvalObj(interp, argv[1]);
11420 if (argc == 3) {
11421 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11422 != JIM_OK)
11423 return JIM_ERR;
11424 }
11425 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11426 return JIM_OK;
11427 }
11428
11429 /* [ref] */
11430 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11431 Jim_Obj *const *argv)
11432 {
11433 if (argc != 3 && argc != 4) {
11434 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11435 return JIM_ERR;
11436 }
11437 if (argc == 3) {
11438 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11439 } else {
11440 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11441 argv[3]));
11442 }
11443 return JIM_OK;
11444 }
11445
11446 /* [getref] */
11447 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11448 Jim_Obj *const *argv)
11449 {
11450 Jim_Reference *refPtr;
11451
11452 if (argc != 2) {
11453 Jim_WrongNumArgs(interp, 1, argv, "reference");
11454 return JIM_ERR;
11455 }
11456 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11457 return JIM_ERR;
11458 Jim_SetResult(interp, refPtr->objPtr);
11459 return JIM_OK;
11460 }
11461
11462 /* [setref] */
11463 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11464 Jim_Obj *const *argv)
11465 {
11466 Jim_Reference *refPtr;
11467
11468 if (argc != 3) {
11469 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11470 return JIM_ERR;
11471 }
11472 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11473 return JIM_ERR;
11474 Jim_IncrRefCount(argv[2]);
11475 Jim_DecrRefCount(interp, refPtr->objPtr);
11476 refPtr->objPtr = argv[2];
11477 Jim_SetResult(interp, argv[2]);
11478 return JIM_OK;
11479 }
11480
11481 /* [collect] */
11482 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11483 Jim_Obj *const *argv)
11484 {
11485 if (argc != 1) {
11486 Jim_WrongNumArgs(interp, 1, argv, "");
11487 return JIM_ERR;
11488 }
11489 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11490 return JIM_OK;
11491 }
11492
11493 /* [finalize] reference ?newValue? */
11494 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11495 Jim_Obj *const *argv)
11496 {
11497 if (argc != 2 && argc != 3) {
11498 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11499 return JIM_ERR;
11500 }
11501 if (argc == 2) {
11502 Jim_Obj *cmdNamePtr;
11503
11504 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11505 return JIM_ERR;
11506 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11507 Jim_SetResult(interp, cmdNamePtr);
11508 } else {
11509 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11510 return JIM_ERR;
11511 Jim_SetResult(interp, argv[2]);
11512 }
11513 return JIM_OK;
11514 }
11515
11516 /* TODO */
11517 /* [info references] (list of all the references/finalizers) */
11518
11519 /* [rename] */
11520 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11521 Jim_Obj *const *argv)
11522 {
11523 const char *oldName, *newName;
11524
11525 if (argc != 3) {
11526 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11527 return JIM_ERR;
11528 }
11529 oldName = Jim_GetString(argv[1], NULL);
11530 newName = Jim_GetString(argv[2], NULL);
11531 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11532 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11533 Jim_AppendStrings(interp, Jim_GetResult(interp),
11534 "can't rename \"", oldName, "\": ",
11535 "command doesn't exist", NULL);
11536 return JIM_ERR;
11537 }
11538 return JIM_OK;
11539 }
11540
11541 /* [dict] */
11542 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11543 Jim_Obj *const *argv)
11544 {
11545 int option;
11546 const char *options[] = {
11547 "create", "get", "set", "unset", "exists", NULL
11548 };
11549 enum {
11550 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11551 };
11552
11553 if (argc < 2) {
11554 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11555 return JIM_ERR;
11556 }
11557
11558 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11559 JIM_ERRMSG) != JIM_OK)
11560 return JIM_ERR;
11561
11562 if (option == OPT_CREATE) {
11563 Jim_Obj *objPtr;
11564
11565 if (argc % 2) {
11566 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11567 return JIM_ERR;
11568 }
11569 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11570 Jim_SetResult(interp, objPtr);
11571 return JIM_OK;
11572 } else if (option == OPT_GET) {
11573 Jim_Obj *objPtr;
11574
11575 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11576 JIM_ERRMSG) != JIM_OK)
11577 return JIM_ERR;
11578 Jim_SetResult(interp, objPtr);
11579 return JIM_OK;
11580 } else if (option == OPT_SET) {
11581 if (argc < 5) {
11582 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11583 return JIM_ERR;
11584 }
11585 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11586 argv[argc-1]);
11587 } else if (option == OPT_UNSET) {
11588 if (argc < 4) {
11589 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11590 return JIM_ERR;
11591 }
11592 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11593 NULL);
11594 } else if (option == OPT_EXIST) {
11595 Jim_Obj *objPtr;
11596 int exists;
11597
11598 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11599 JIM_ERRMSG) == JIM_OK)
11600 exists = 1;
11601 else
11602 exists = 0;
11603 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11604 return JIM_OK;
11605 } else {
11606 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11607 Jim_AppendStrings(interp, Jim_GetResult(interp),
11608 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11609 " must be create, get, set", NULL);
11610 return JIM_ERR;
11611 }
11612 return JIM_OK;
11613 }
11614
11615 /* [load] */
11616 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11617 Jim_Obj *const *argv)
11618 {
11619 if (argc < 2) {
11620 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11621 return JIM_ERR;
11622 }
11623 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11624 }
11625
11626 /* [subst] */
11627 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11628 Jim_Obj *const *argv)
11629 {
11630 int i, flags = 0;
11631 Jim_Obj *objPtr;
11632
11633 if (argc < 2) {
11634 Jim_WrongNumArgs(interp, 1, argv,
11635 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11636 return JIM_ERR;
11637 }
11638 i = argc-2;
11639 while (i--) {
11640 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11641 "-nobackslashes"))
11642 flags |= JIM_SUBST_NOESC;
11643 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11644 "-novariables"))
11645 flags |= JIM_SUBST_NOVAR;
11646 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11647 "-nocommands"))
11648 flags |= JIM_SUBST_NOCMD;
11649 else {
11650 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11651 Jim_AppendStrings(interp, Jim_GetResult(interp),
11652 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11653 "\": must be -nobackslashes, -nocommands, or "
11654 "-novariables", NULL);
11655 return JIM_ERR;
11656 }
11657 }
11658 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11659 return JIM_ERR;
11660 Jim_SetResult(interp, objPtr);
11661 return JIM_OK;
11662 }
11663
11664 /* [info] */
11665 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11666 Jim_Obj *const *argv)
11667 {
11668 int cmd, result = JIM_OK;
11669 static const char *commands[] = {
11670 "body", "commands", "exists", "globals", "level", "locals",
11671 "vars", "version", "complete", "args", "hostname", NULL
11672 };
11673 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11674 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11675
11676 if (argc < 2) {
11677 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11678 return JIM_ERR;
11679 }
11680 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11681 != JIM_OK) {
11682 return JIM_ERR;
11683 }
11684
11685 if (cmd == INFO_COMMANDS) {
11686 if (argc != 2 && argc != 3) {
11687 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11688 return JIM_ERR;
11689 }
11690 if (argc == 3)
11691 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11692 else
11693 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11694 } else if (cmd == INFO_EXISTS) {
11695 Jim_Obj *exists;
11696 if (argc != 3) {
11697 Jim_WrongNumArgs(interp, 2, argv, "varName");
11698 return JIM_ERR;
11699 }
11700 exists = Jim_GetVariable(interp, argv[2], 0);
11701 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11702 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11703 int mode;
11704 switch (cmd) {
11705 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11706 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11707 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11708 default: mode = 0; /* avoid warning */; break;
11709 }
11710 if (argc != 2 && argc != 3) {
11711 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11712 return JIM_ERR;
11713 }
11714 if (argc == 3)
11715 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11716 else
11717 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11718 } else if (cmd == INFO_LEVEL) {
11719 Jim_Obj *objPtr;
11720 switch (argc) {
11721 case 2:
11722 Jim_SetResult(interp,
11723 Jim_NewIntObj(interp, interp->numLevels));
11724 break;
11725 case 3:
11726 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11727 return JIM_ERR;
11728 Jim_SetResult(interp, objPtr);
11729 break;
11730 default:
11731 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11732 return JIM_ERR;
11733 }
11734 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11735 Jim_Cmd *cmdPtr;
11736
11737 if (argc != 3) {
11738 Jim_WrongNumArgs(interp, 2, argv, "procname");
11739 return JIM_ERR;
11740 }
11741 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11742 return JIM_ERR;
11743 if (cmdPtr->cmdProc != NULL) {
11744 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11745 Jim_AppendStrings(interp, Jim_GetResult(interp),
11746 "command \"", Jim_GetString(argv[2], NULL),
11747 "\" is not a procedure", NULL);
11748 return JIM_ERR;
11749 }
11750 if (cmd == INFO_BODY)
11751 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11752 else
11753 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11754 } else if (cmd == INFO_VERSION) {
11755 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11756 sprintf(buf, "%d.%d",
11757 JIM_VERSION / 100, JIM_VERSION % 100);
11758 Jim_SetResultString(interp, buf, -1);
11759 } else if (cmd == INFO_COMPLETE) {
11760 const char *s;
11761 int len;
11762
11763 if (argc != 3) {
11764 Jim_WrongNumArgs(interp, 2, argv, "script");
11765 return JIM_ERR;
11766 }
11767 s = Jim_GetString(argv[2], &len);
11768 Jim_SetResult(interp,
11769 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11770 } else if (cmd == INFO_HOSTNAME) {
11771 /* Redirect to os.hostname if it exists */
11772 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11773 result = Jim_EvalObjVector(interp, 1, &command);
11774 }
11775 return result;
11776 }
11777
11778 /* [split] */
11779 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11780 Jim_Obj *const *argv)
11781 {
11782 const char *str, *splitChars, *noMatchStart;
11783 int splitLen, strLen, i;
11784 Jim_Obj *resObjPtr;
11785
11786 if (argc != 2 && argc != 3) {
11787 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11788 return JIM_ERR;
11789 }
11790 /* Init */
11791 if (argc == 2) {
11792 splitChars = " \n\t\r";
11793 splitLen = 4;
11794 } else {
11795 splitChars = Jim_GetString(argv[2], &splitLen);
11796 }
11797 str = Jim_GetString(argv[1], &strLen);
11798 if (!strLen) return JIM_OK;
11799 noMatchStart = str;
11800 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11801 /* Split */
11802 if (splitLen) {
11803 while (strLen) {
11804 for (i = 0; i < splitLen; i++) {
11805 if (*str == splitChars[i]) {
11806 Jim_Obj *objPtr;
11807
11808 objPtr = Jim_NewStringObj(interp, noMatchStart,
11809 (str-noMatchStart));
11810 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11811 noMatchStart = str + 1;
11812 break;
11813 }
11814 }
11815 str ++;
11816 strLen --;
11817 }
11818 Jim_ListAppendElement(interp, resObjPtr,
11819 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11820 } else {
11821 /* This handles the special case of splitchars eq {}. This
11822 * is trivial but we want to perform object sharing as Tcl does. */
11823 Jim_Obj *objCache[256];
11824 const unsigned char *u = (unsigned char*) str;
11825 memset(objCache, 0, sizeof(objCache));
11826 for (i = 0; i < strLen; i++) {
11827 int c = u[i];
11828
11829 if (objCache[c] == NULL)
11830 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11831 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11832 }
11833 }
11834 Jim_SetResult(interp, resObjPtr);
11835 return JIM_OK;
11836 }
11837
11838 /* [join] */
11839 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11840 Jim_Obj *const *argv)
11841 {
11842 const char *joinStr;
11843 int joinStrLen, i, listLen;
11844 Jim_Obj *resObjPtr;
11845
11846 if (argc != 2 && argc != 3) {
11847 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11848 return JIM_ERR;
11849 }
11850 /* Init */
11851 if (argc == 2) {
11852 joinStr = " ";
11853 joinStrLen = 1;
11854 } else {
11855 joinStr = Jim_GetString(argv[2], &joinStrLen);
11856 }
11857 Jim_ListLength(interp, argv[1], &listLen);
11858 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11859 /* Split */
11860 for (i = 0; i < listLen; i++) {
11861 Jim_Obj *objPtr=NULL;
11862
11863 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11864 Jim_AppendObj(interp, resObjPtr, objPtr);
11865 if (i + 1 != listLen) {
11866 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11867 }
11868 }
11869 Jim_SetResult(interp, resObjPtr);
11870 return JIM_OK;
11871 }
11872
11873 /* [format] */
11874 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11875 Jim_Obj *const *argv)
11876 {
11877 Jim_Obj *objPtr;
11878
11879 if (argc < 2) {
11880 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11881 return JIM_ERR;
11882 }
11883 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11884 if (objPtr == NULL)
11885 return JIM_ERR;
11886 Jim_SetResult(interp, objPtr);
11887 return JIM_OK;
11888 }
11889
11890 /* [scan] */
11891 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11892 Jim_Obj *const *argv)
11893 {
11894 Jim_Obj *listPtr, **outVec;
11895 int outc, i, count = 0;
11896
11897 if (argc < 3) {
11898 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11899 return JIM_ERR;
11900 }
11901 if (argv[2]->typePtr != &scanFmtStringObjType)
11902 SetScanFmtFromAny(interp, argv[2]);
11903 if (FormatGetError(argv[2]) != 0) {
11904 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11905 return JIM_ERR;
11906 }
11907 if (argc > 3) {
11908 int maxPos = FormatGetMaxPos(argv[2]);
11909 int count = FormatGetCnvCount(argv[2]);
11910 if (maxPos > argc-3) {
11911 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11912 return JIM_ERR;
11913 } else if (count != 0 && count < argc-3) {
11914 Jim_SetResultString(interp, "variable is not assigned by any "
11915 "conversion specifiers", -1);
11916 return JIM_ERR;
11917 } else if (count > argc-3) {
11918 Jim_SetResultString(interp, "different numbers of variable names and "
11919 "field specifiers", -1);
11920 return JIM_ERR;
11921 }
11922 }
11923 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11924 if (listPtr == 0)
11925 return JIM_ERR;
11926 if (argc > 3) {
11927 int len = 0;
11928 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11929 Jim_ListLength(interp, listPtr, &len);
11930 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11931 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11932 return JIM_OK;
11933 }
11934 JimListGetElements(interp, listPtr, &outc, &outVec);
11935 for (i = 0; i < outc; ++i) {
11936 if (Jim_Length(outVec[i]) > 0) {
11937 ++count;
11938 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11939 goto err;
11940 }
11941 }
11942 Jim_FreeNewObj(interp, listPtr);
11943 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11944 } else {
11945 if (listPtr == (Jim_Obj*)EOF) {
11946 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11947 return JIM_OK;
11948 }
11949 Jim_SetResult(interp, listPtr);
11950 }
11951 return JIM_OK;
11952 err:
11953 Jim_FreeNewObj(interp, listPtr);
11954 return JIM_ERR;
11955 }
11956
11957 /* [error] */
11958 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11959 Jim_Obj *const *argv)
11960 {
11961 if (argc != 2) {
11962 Jim_WrongNumArgs(interp, 1, argv, "message");
11963 return JIM_ERR;
11964 }
11965 Jim_SetResult(interp, argv[1]);
11966 return JIM_ERR;
11967 }
11968
11969 /* [lrange] */
11970 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11971 Jim_Obj *const *argv)
11972 {
11973 Jim_Obj *objPtr;
11974
11975 if (argc != 4) {
11976 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11977 return JIM_ERR;
11978 }
11979 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11980 return JIM_ERR;
11981 Jim_SetResult(interp, objPtr);
11982 return JIM_OK;
11983 }
11984
11985 /* [env] */
11986 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11987 Jim_Obj *const *argv)
11988 {
11989 const char *key;
11990 char *val;
11991
11992 if (argc == 1) {
11993
11994 #ifdef NEED_ENVIRON_EXTERN
11995 extern char **environ;
11996 #endif
11997
11998 int i;
11999 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12000
12001 for (i = 0; environ[i]; i++) {
12002 const char *equals = strchr(environ[i], '=');
12003 if (equals) {
12004 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
12005 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12006 }
12007 }
12008
12009 Jim_SetResult(interp, listObjPtr);
12010 return JIM_OK;
12011 }
12012
12013 if (argc != 2) {
12014 Jim_WrongNumArgs(interp, 1, argv, "varName");
12015 return JIM_ERR;
12016 }
12017 key = Jim_GetString(argv[1], NULL);
12018 val = getenv(key);
12019 if (val == NULL) {
12020 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12021 Jim_AppendStrings(interp, Jim_GetResult(interp),
12022 "environment variable \"",
12023 key, "\" does not exist", NULL);
12024 return JIM_ERR;
12025 }
12026 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12027 return JIM_OK;
12028 }
12029
12030 /* [source] */
12031 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12032 Jim_Obj *const *argv)
12033 {
12034 int retval;
12035
12036 if (argc != 2) {
12037 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12038 return JIM_ERR;
12039 }
12040 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12041 if (retval == JIM_ERR) {
12042 return JIM_ERR_ADDSTACK;
12043 }
12044 if (retval == JIM_RETURN)
12045 return JIM_OK;
12046 return retval;
12047 }
12048
12049 /* [lreverse] */
12050 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12051 Jim_Obj *const *argv)
12052 {
12053 Jim_Obj *revObjPtr, **ele;
12054 int len;
12055
12056 if (argc != 2) {
12057 Jim_WrongNumArgs(interp, 1, argv, "list");
12058 return JIM_ERR;
12059 }
12060 JimListGetElements(interp, argv[1], &len, &ele);
12061 len--;
12062 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12063 while (len >= 0)
12064 ListAppendElement(revObjPtr, ele[len--]);
12065 Jim_SetResult(interp, revObjPtr);
12066 return JIM_OK;
12067 }
12068
12069 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12070 {
12071 jim_wide len;
12072
12073 if (step == 0) return -1;
12074 if (start == end) return 0;
12075 else if (step > 0 && start > end) return -1;
12076 else if (step < 0 && end > start) return -1;
12077 len = end-start;
12078 if (len < 0) len = -len; /* abs(len) */
12079 if (step < 0) step = -step; /* abs(step) */
12080 len = 1 + ((len-1)/step);
12081 /* We can truncate safely to INT_MAX, the range command
12082 * will always return an error for a such long range
12083 * because Tcl lists can't be so long. */
12084 if (len > INT_MAX) len = INT_MAX;
12085 return (int)((len < 0) ? -1 : len);
12086 }
12087
12088 /* [range] */
12089 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12090 Jim_Obj *const *argv)
12091 {
12092 jim_wide start = 0, end, step = 1;
12093 int len, i;
12094 Jim_Obj *objPtr;
12095
12096 if (argc < 2 || argc > 4) {
12097 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12098 return JIM_ERR;
12099 }
12100 if (argc == 2) {
12101 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12102 return JIM_ERR;
12103 } else {
12104 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12105 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12106 return JIM_ERR;
12107 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12108 return JIM_ERR;
12109 }
12110 if ((len = JimRangeLen(start, end, step)) == -1) {
12111 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12112 return JIM_ERR;
12113 }
12114 objPtr = Jim_NewListObj(interp, NULL, 0);
12115 for (i = 0; i < len; i++)
12116 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12117 Jim_SetResult(interp, objPtr);
12118 return JIM_OK;
12119 }
12120
12121 /* [rand] */
12122 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12123 Jim_Obj *const *argv)
12124 {
12125 jim_wide min = 0, max =0, len, maxMul;
12126
12127 if (argc < 1 || argc > 3) {
12128 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12129 return JIM_ERR;
12130 }
12131 if (argc == 1) {
12132 max = JIM_WIDE_MAX;
12133 } else if (argc == 2) {
12134 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12135 return JIM_ERR;
12136 } else if (argc == 3) {
12137 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12138 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12139 return JIM_ERR;
12140 }
12141 len = max-min;
12142 if (len < 0) {
12143 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12144 return JIM_ERR;
12145 }
12146 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12147 while (1) {
12148 jim_wide r;
12149
12150 JimRandomBytes(interp, &r, sizeof(jim_wide));
12151 if (r < 0 || r >= maxMul) continue;
12152 r = (len == 0) ? 0 : r%len;
12153 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12154 return JIM_OK;
12155 }
12156 }
12157
12158 /* [package] */
12159 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12160 Jim_Obj *const *argv)
12161 {
12162 int option;
12163 const char *options[] = {
12164 "require", "provide", NULL
12165 };
12166 enum {OPT_REQUIRE, OPT_PROVIDE};
12167
12168 if (argc < 2) {
12169 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12170 return JIM_ERR;
12171 }
12172 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12173 JIM_ERRMSG) != JIM_OK)
12174 return JIM_ERR;
12175
12176 if (option == OPT_REQUIRE) {
12177 int exact = 0;
12178 const char *ver;
12179
12180 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12181 exact = 1;
12182 argv++;
12183 argc--;
12184 }
12185 if (argc != 3 && argc != 4) {
12186 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12187 return JIM_ERR;
12188 }
12189 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12190 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12191 JIM_ERRMSG);
12192 if (ver == NULL)
12193 return JIM_ERR_ADDSTACK;
12194 Jim_SetResultString(interp, ver, -1);
12195 } else if (option == OPT_PROVIDE) {
12196 if (argc != 4) {
12197 Jim_WrongNumArgs(interp, 2, argv, "package version");
12198 return JIM_ERR;
12199 }
12200 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12201 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12202 }
12203 return JIM_OK;
12204 }
12205
12206 static struct {
12207 const char *name;
12208 Jim_CmdProc cmdProc;
12209 } Jim_CoreCommandsTable[] = {
12210 {"set", Jim_SetCoreCommand},
12211 {"unset", Jim_UnsetCoreCommand},
12212 {"puts", Jim_PutsCoreCommand},
12213 {"+", Jim_AddCoreCommand},
12214 {"*", Jim_MulCoreCommand},
12215 {"-", Jim_SubCoreCommand},
12216 {"/", Jim_DivCoreCommand},
12217 {"incr", Jim_IncrCoreCommand},
12218 {"while", Jim_WhileCoreCommand},
12219 {"for", Jim_ForCoreCommand},
12220 {"foreach", Jim_ForeachCoreCommand},
12221 {"lmap", Jim_LmapCoreCommand},
12222 {"if", Jim_IfCoreCommand},
12223 {"switch", Jim_SwitchCoreCommand},
12224 {"list", Jim_ListCoreCommand},
12225 {"lindex", Jim_LindexCoreCommand},
12226 {"lset", Jim_LsetCoreCommand},
12227 {"llength", Jim_LlengthCoreCommand},
12228 {"lappend", Jim_LappendCoreCommand},
12229 {"linsert", Jim_LinsertCoreCommand},
12230 {"lsort", Jim_LsortCoreCommand},
12231 {"append", Jim_AppendCoreCommand},
12232 {"debug", Jim_DebugCoreCommand},
12233 {"eval", Jim_EvalCoreCommand},
12234 {"uplevel", Jim_UplevelCoreCommand},
12235 {"expr", Jim_ExprCoreCommand},
12236 {"break", Jim_BreakCoreCommand},
12237 {"continue", Jim_ContinueCoreCommand},
12238 {"proc", Jim_ProcCoreCommand},
12239 {"concat", Jim_ConcatCoreCommand},
12240 {"return", Jim_ReturnCoreCommand},
12241 {"upvar", Jim_UpvarCoreCommand},
12242 {"global", Jim_GlobalCoreCommand},
12243 {"string", Jim_StringCoreCommand},
12244 {"time", Jim_TimeCoreCommand},
12245 {"exit", Jim_ExitCoreCommand},
12246 {"catch", Jim_CatchCoreCommand},
12247 {"ref", Jim_RefCoreCommand},
12248 {"getref", Jim_GetrefCoreCommand},
12249 {"setref", Jim_SetrefCoreCommand},
12250 {"finalize", Jim_FinalizeCoreCommand},
12251 {"collect", Jim_CollectCoreCommand},
12252 {"rename", Jim_RenameCoreCommand},
12253 {"dict", Jim_DictCoreCommand},
12254 {"load", Jim_LoadCoreCommand},
12255 {"subst", Jim_SubstCoreCommand},
12256 {"info", Jim_InfoCoreCommand},
12257 {"split", Jim_SplitCoreCommand},
12258 {"join", Jim_JoinCoreCommand},
12259 {"format", Jim_FormatCoreCommand},
12260 {"scan", Jim_ScanCoreCommand},
12261 {"error", Jim_ErrorCoreCommand},
12262 {"lrange", Jim_LrangeCoreCommand},
12263 {"env", Jim_EnvCoreCommand},
12264 {"source", Jim_SourceCoreCommand},
12265 {"lreverse", Jim_LreverseCoreCommand},
12266 {"range", Jim_RangeCoreCommand},
12267 {"rand", Jim_RandCoreCommand},
12268 {"package", Jim_PackageCoreCommand},
12269 {"tailcall", Jim_TailcallCoreCommand},
12270 {NULL, NULL},
12271 };
12272
12273 /* Some Jim core command is actually a procedure written in Jim itself. */
12274 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12275 {
12276 Jim_Eval(interp, (char*)
12277 "proc lambda {arglist args} {\n"
12278 " set name [ref {} function lambdaFinalizer]\n"
12279 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12280 " return $name\n"
12281 "}\n"
12282 "proc lambdaFinalizer {name val} {\n"
12283 " rename $name {}\n"
12284 "}\n"
12285 );
12286 }
12287
12288 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12289 {
12290 int i = 0;
12291
12292 while (Jim_CoreCommandsTable[i].name != NULL) {
12293 Jim_CreateCommand(interp,
12294 Jim_CoreCommandsTable[i].name,
12295 Jim_CoreCommandsTable[i].cmdProc,
12296 NULL, NULL);
12297 i++;
12298 }
12299 Jim_RegisterCoreProcedures(interp);
12300 }
12301
12302 /* -----------------------------------------------------------------------------
12303 * Interactive prompt
12304 * ---------------------------------------------------------------------------*/
12305 void Jim_PrintErrorMessage(Jim_Interp *interp)
12306 {
12307 int len, i;
12308
12309 if (*interp->errorFileName) {
12310 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12311 interp->errorFileName, interp->errorLine);
12312 }
12313 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12314 Jim_GetString(interp->result, NULL));
12315 Jim_ListLength(interp, interp->stackTrace, &len);
12316 for (i = len-3; i >= 0; i-= 3) {
12317 Jim_Obj *objPtr=NULL;
12318 const char *proc, *file, *line;
12319
12320 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12321 proc = Jim_GetString(objPtr, NULL);
12322 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12323 JIM_NONE);
12324 file = Jim_GetString(objPtr, NULL);
12325 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12326 JIM_NONE);
12327 line = Jim_GetString(objPtr, NULL);
12328 if (*proc) {
12329 Jim_fprintf(interp, interp->cookie_stderr,
12330 "in procedure '%s' ", proc);
12331 }
12332 if (*file) {
12333 Jim_fprintf(interp, interp->cookie_stderr,
12334 "called at file \"%s\", line %s",
12335 file, line);
12336 }
12337 if (*file || *proc) {
12338 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12339 }
12340 }
12341 }
12342
12343 int Jim_InteractivePrompt(Jim_Interp *interp)
12344 {
12345 int retcode = JIM_OK;
12346 Jim_Obj *scriptObjPtr;
12347
12348 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12349 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12350 JIM_VERSION / 100, JIM_VERSION % 100);
12351 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12352 while (1) {
12353 char buf[1024];
12354 const char *result;
12355 const char *retcodestr[] = {
12356 "ok", "error", "return", "break", "continue", "eval", "exit"
12357 };
12358 int reslen;
12359
12360 if (retcode != 0) {
12361 if (retcode >= 2 && retcode <= 6)
12362 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12363 else
12364 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12365 } else
12366 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12367 Jim_fflush(interp, interp->cookie_stdout);
12368 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12369 Jim_IncrRefCount(scriptObjPtr);
12370 while (1) {
12371 const char *str;
12372 char state;
12373 int len;
12374
12375 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12376 Jim_DecrRefCount(interp, scriptObjPtr);
12377 goto out;
12378 }
12379 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12380 str = Jim_GetString(scriptObjPtr, &len);
12381 if (Jim_ScriptIsComplete(str, len, &state))
12382 break;
12383 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12384 Jim_fflush(interp, interp->cookie_stdout);
12385 }
12386 retcode = Jim_EvalObj(interp, scriptObjPtr);
12387 Jim_DecrRefCount(interp, scriptObjPtr);
12388 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12389 if (retcode == JIM_ERR) {
12390 Jim_PrintErrorMessage(interp);
12391 } else if (retcode == JIM_EXIT) {
12392 exit(Jim_GetExitCode(interp));
12393 } else {
12394 if (reslen) {
12395 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12396 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12397 }
12398 }
12399 }
12400 out:
12401 return 0;
12402 }
12403
12404 /* -----------------------------------------------------------------------------
12405 * Jim's idea of STDIO..
12406 * ---------------------------------------------------------------------------*/
12407
12408 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12409 {
12410 int r;
12411
12412 va_list ap;
12413 va_start(ap,fmt);
12414 r = Jim_vfprintf(interp, cookie, fmt,ap);
12415 va_end(ap);
12416 return r;
12417 }
12418
12419 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12420 {
12421 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12422 errno = ENOTSUP;
12423 return -1;
12424 }
12425 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12426 }
12427
12428 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12429 {
12430 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12431 errno = ENOTSUP;
12432 return 0;
12433 }
12434 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12435 }
12436
12437 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12438 {
12439 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12440 errno = ENOTSUP;
12441 return 0;
12442 }
12443 return (*(interp->cb_fread))(ptr, size, n, cookie);
12444 }
12445
12446 int Jim_fflush(Jim_Interp *interp, void *cookie)
12447 {
12448 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12449 /* pretend all is well */
12450 return 0;
12451 }
12452 return (*(interp->cb_fflush))(cookie);
12453 }
12454
12455 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12456 {
12457 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12458 errno = ENOTSUP;
12459 return NULL;
12460 }
12461 return (*(interp->cb_fgets))(s, size, cookie);
12462 }
12463 Jim_Nvp *
12464 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12465 {
12466 while (p->name) {
12467 if (0 == strcmp(name, p->name)) {
12468 break;
12469 }
12470 p++;
12471 }
12472 return ((Jim_Nvp *)(p));
12473 }
12474
12475 Jim_Nvp *
12476 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12477 {
12478 while (p->name) {
12479 if (0 == strcasecmp(name, p->name)) {
12480 break;
12481 }
12482 p++;
12483 }
12484 return ((Jim_Nvp *)(p));
12485 }
12486
12487 int
12488 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12489 const Jim_Nvp *p,
12490 Jim_Obj *o,
12491 Jim_Nvp **result)
12492 {
12493 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12494 }
12495
12496
12497 int
12498 Jim_Nvp_name2value(Jim_Interp *interp,
12499 const Jim_Nvp *_p,
12500 const char *name,
12501 Jim_Nvp **result)
12502 {
12503 const Jim_Nvp *p;
12504
12505 p = Jim_Nvp_name2value_simple(_p, name);
12506
12507 /* result */
12508 if (result) {
12509 *result = (Jim_Nvp *)(p);
12510 }
12511
12512 /* found? */
12513 if (p->name) {
12514 return JIM_OK;
12515 } else {
12516 return JIM_ERR;
12517 }
12518 }
12519
12520 int
12521 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12522 {
12523 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12524 }
12525
12526 int
12527 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12528 {
12529 const Jim_Nvp *p;
12530
12531 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12532
12533 if (puthere) {
12534 *puthere = (Jim_Nvp *)(p);
12535 }
12536 /* found */
12537 if (p->name) {
12538 return JIM_OK;
12539 } else {
12540 return JIM_ERR;
12541 }
12542 }
12543
12544
12545 int
12546 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12547 {
12548 int e;;
12549 jim_wide w;
12550
12551 e = Jim_GetWide(interp, o, &w);
12552 if (e != JIM_OK) {
12553 return e;
12554 }
12555
12556 return Jim_Nvp_value2name(interp, p, w, result);
12557 }
12558
12559 Jim_Nvp *
12560 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12561 {
12562 while (p->name) {
12563 if (value == p->value) {
12564 break;
12565 }
12566 p++;
12567 }
12568 return ((Jim_Nvp *)(p));
12569 }
12570
12571
12572 int
12573 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12574 {
12575 const Jim_Nvp *p;
12576
12577 p = Jim_Nvp_value2name_simple(_p, value);
12578
12579 if (result) {
12580 *result = (Jim_Nvp *)(p);
12581 }
12582
12583 if (p->name) {
12584 return JIM_OK;
12585 } else {
12586 return JIM_ERR;
12587 }
12588 }
12589
12590
12591 int
12592 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12593 {
12594 memset(p, 0, sizeof(*p));
12595 p->interp = interp;
12596 p->argc = argc;
12597 p->argv = argv;
12598
12599 return JIM_OK;
12600 }
12601
12602 void
12603 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12604 {
12605 int x;
12606
12607 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12608 for (x = 0 ; x < p->argc ; x++) {
12609 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12610 "%2d) %s\n",
12611 x,
12612 Jim_GetString(p->argv[x], NULL));
12613 }
12614 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12615 }
12616
12617
12618 int
12619 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12620 {
12621 Jim_Obj *o;
12622
12623 o = NULL; // failure
12624 if (goi->argc) {
12625 // success
12626 o = goi->argv[0];
12627 goi->argc -= 1;
12628 goi->argv += 1;
12629 }
12630 if (puthere) {
12631 *puthere = o;
12632 }
12633 if (o != NULL) {
12634 return JIM_OK;
12635 } else {
12636 return JIM_ERR;
12637 }
12638 }
12639
12640 int
12641 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12642 {
12643 int r;
12644 Jim_Obj *o;
12645 const char *cp;
12646
12647
12648 r = Jim_GetOpt_Obj(goi, &o);
12649 if (r == JIM_OK) {
12650 cp = Jim_GetString(o, len);
12651 if (puthere) {
12652 /* remove const */
12653 *puthere = (char *)(cp);
12654 }
12655 }
12656 return r;
12657 }
12658
12659 int
12660 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12661 {
12662 int r;
12663 Jim_Obj *o;
12664 double _safe;
12665
12666 if (puthere == NULL) {
12667 puthere = &_safe;
12668 }
12669
12670 r = Jim_GetOpt_Obj(goi, &o);
12671 if (r == JIM_OK) {
12672 r = Jim_GetDouble(goi->interp, o, puthere);
12673 if (r != JIM_OK) {
12674 Jim_SetResult_sprintf(goi->interp,
12675 "not a number: %s",
12676 Jim_GetString(o, NULL));
12677 }
12678 }
12679 return r;
12680 }
12681
12682 int
12683 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12684 {
12685 int r;
12686 Jim_Obj *o;
12687 jim_wide _safe;
12688
12689 if (puthere == NULL) {
12690 puthere = &_safe;
12691 }
12692
12693 r = Jim_GetOpt_Obj(goi, &o);
12694 if (r == JIM_OK) {
12695 r = Jim_GetWide(goi->interp, o, puthere);
12696 }
12697 return r;
12698 }
12699
12700 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12701 const Jim_Nvp *nvp,
12702 Jim_Nvp **puthere)
12703 {
12704 Jim_Nvp *_safe;
12705 Jim_Obj *o;
12706 int e;
12707
12708 if (puthere == NULL) {
12709 puthere = &_safe;
12710 }
12711
12712 e = Jim_GetOpt_Obj(goi, &o);
12713 if (e == JIM_OK) {
12714 e = Jim_Nvp_name2value_obj(goi->interp,
12715 nvp,
12716 o,
12717 puthere);
12718 }
12719
12720 return e;
12721 }
12722
12723 void
12724 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12725 const Jim_Nvp *nvptable,
12726 int hadprefix)
12727 {
12728 if (hadprefix) {
12729 Jim_SetResult_NvpUnknown(goi->interp,
12730 goi->argv[-2],
12731 goi->argv[-1],
12732 nvptable);
12733 } else {
12734 Jim_SetResult_NvpUnknown(goi->interp,
12735 NULL,
12736 goi->argv[-1],
12737 nvptable);
12738 }
12739 }
12740
12741
12742 int
12743 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12744 const char * const * lookup,
12745 int *puthere)
12746 {
12747 int _safe;
12748 Jim_Obj *o;
12749 int e;
12750
12751 if (puthere == NULL) {
12752 puthere = &_safe;
12753 }
12754 e = Jim_GetOpt_Obj(goi, &o);
12755 if (e == JIM_OK) {
12756 e = Jim_GetEnum(goi->interp,
12757 o,
12758 lookup,
12759 puthere,
12760 "option",
12761 JIM_ERRMSG);
12762 }
12763 return e;
12764 }
12765
12766
12767
12768 int
12769 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12770 {
12771 va_list ap;
12772 char *buf;
12773
12774 va_start(ap,fmt);
12775 buf = jim_vasprintf(fmt, ap);
12776 va_end(ap);
12777 if (buf) {
12778 Jim_SetResultString(interp, buf, -1);
12779 jim_vasprintf_done(buf);
12780 }
12781 return JIM_OK;
12782 }
12783
12784
12785 void
12786 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12787 Jim_Obj *param_name,
12788 Jim_Obj *param_value,
12789 const Jim_Nvp *nvp)
12790 {
12791 if (param_name) {
12792 Jim_SetResult_sprintf(interp,
12793 "%s: Unknown: %s, try one of: ",
12794 Jim_GetString(param_name, NULL),
12795 Jim_GetString(param_value, NULL));
12796 } else {
12797 Jim_SetResult_sprintf(interp,
12798 "Unknown param: %s, try one of: ",
12799 Jim_GetString(param_value, NULL));
12800 }
12801 while (nvp->name) {
12802 const char *a;
12803 const char *b;
12804
12805 if ((nvp + 1)->name) {
12806 a = nvp->name;
12807 b = ", ";
12808 } else {
12809 a = "or ";
12810 b = nvp->name;
12811 }
12812 Jim_AppendStrings(interp,
12813 Jim_GetResult(interp),
12814 a, b, NULL);
12815 nvp++;
12816 }
12817 }
12818
12819
12820 static Jim_Obj *debug_string_obj;
12821
12822 const char *
12823 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12824 {
12825 int x;
12826
12827 if (debug_string_obj) {
12828 Jim_FreeObj(interp, debug_string_obj);
12829 }
12830
12831 debug_string_obj = Jim_NewEmptyStringObj(interp);
12832 for (x = 0 ; x < argc ; x++) {
12833 Jim_AppendStrings(interp,
12834 debug_string_obj,
12835 Jim_GetString(argv[x], NULL),
12836 " ",
12837 NULL);
12838 }
12839
12840 return Jim_GetString(debug_string_obj, NULL);
12841 }

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)