don't add confusing source info to Jim
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
14 *
15 * The FreeBSD license
16 *
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
19 * are met:
20 *
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
27 *
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 *
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
44 **/
45 #ifdef HAVE_CONFIG_H
46 #include "config.h"
47 #endif
48
49 #define __JIM_CORE__
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
51
52 #ifdef __ECOS
53 #include <pkgconf/jimtcl.h>
54 #include <stdio.h>
55 #include <stdlib.h>
56
57 typedef CYG_ADDRWORD intptr_t;
58
59 #include <string.h>
60 #include <stdarg.h>
61 #include <ctype.h>
62 #include <limits.h>
63 #include <assert.h>
64 #include <errno.h>
65 #include <time.h>
66 #endif
67 #ifndef JIM_ANSIC
68 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
69 #endif /* JIM_ANSIC */
70
71 #include <stdarg.h>
72 #include <limits.h>
73
74 /* Include the platform dependent libraries for
75 * dynamic loading of libraries. */
76 #ifdef JIM_DYNLIB
77 #if defined(_WIN32) || defined(WIN32)
78 #ifndef WIN32
79 #define WIN32 1
80 #endif
81 #ifndef STRICT
82 #define STRICT
83 #endif
84 #define WIN32_LEAN_AND_MEAN
85 #include <windows.h>
86 #if _MSC_VER >= 1000
87 #pragma warning(disable:4146)
88 #endif /* _MSC_VER */
89 #else
90 #include <dlfcn.h>
91 #endif /* WIN32 */
92 #endif /* JIM_DYNLIB */
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType *getJimVariablesHashTableType(void);
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf(const char *fmt, va_list ap)
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf(buf, sizeof(buf), fmt, ap);
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 int result;
137 result = vasprintf(&buf, fmt, ap);
138 if (result < 0) exit(-1);
139 #endif
140 return buf;
141 }
142
143 static void
144 jim_vasprintf_done(void *buf)
145 {
146 #ifndef HAVE_VASPRINTF
147 (void)(buf);
148 #else
149 free(buf);
150 #endif
151 }
152
153
154 /*
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
157 *
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
160 */
161 #ifdef HAVE_LONG_LONG_INT
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
164 {
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
170
171 /*
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
175 */
176 s = nptr;
177 do {
178 c = *s++;
179 } while (isspace(c));
180 if (c == '-') {
181 neg = 1;
182 c = *s++;
183 } else {
184 neg = 0;
185 if (c == '+')
186 c = *s++;
187 }
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
190 c = s[1];
191 s += 2;
192 base = 16;
193 }
194 if (base == 0)
195 base = c == '0' ? 8 : 10;
196
197 /*
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
211 *
212 * Set any if any `digits' consumed; make it negative to indicate
213 * overflow.
214 */
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
217 : LLONG_MAX;
218 cutlim = (int)(cutoff % qbase);
219 cutoff /= qbase;
220 for (acc = 0, any = 0;; c = *s++) {
221 if (!JimIsAscii(c))
222 break;
223 if (isdigit(c))
224 c -= '0';
225 else if (isalpha(c))
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
227 else
228 break;
229 if (c >= base)
230 break;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
232 any = -1;
233 else {
234 any = 1;
235 acc *= qbase;
236 acc += c;
237 }
238 }
239 if (any < 0) {
240 acc = neg ? LLONG_MIN : LLONG_MAX;
241 errno = ERANGE;
242 } else if (neg)
243 acc = -acc;
244 if (endptr != 0)
245 *endptr = (char *)(any ? s - 1 : nptr);
246 return (acc);
247 }
248 #endif
249
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
253 {
254 while (patternLen) {
255 switch (pattern[0]) {
256 case '*':
257 while (pattern[1] == '*') {
258 pattern++;
259 patternLen--;
260 }
261 if (patternLen == 1)
262 return 1; /* match */
263 while (stringLen) {
264 if (JimStringMatch(pattern + 1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
267 string++;
268 stringLen--;
269 }
270 return 0; /* no match */
271 break;
272 case '?':
273 if (stringLen == 0)
274 return 0; /* no match */
275 string++;
276 stringLen--;
277 break;
278 case '[':
279 {
280 int not, match;
281
282 pattern++;
283 patternLen--;
284 not = pattern[0] == '^';
285 if (not) {
286 pattern++;
287 patternLen--;
288 }
289 match = 0;
290 while (1) {
291 if (pattern[0] == '\\') {
292 pattern++;
293 patternLen--;
294 if (pattern[0] == string[0])
295 match = 1;
296 } else if (pattern[0] == ']') {
297 break;
298 } else if (patternLen == 0) {
299 pattern--;
300 patternLen++;
301 break;
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
305 int c = string[0];
306 if (start > end) {
307 int t = start;
308 start = end;
309 end = t;
310 }
311 if (nocase) {
312 start = tolower(start);
313 end = tolower(end);
314 c = tolower(c);
315 }
316 pattern += 2;
317 patternLen -= 2;
318 if (c >= start && c <= end)
319 match = 1;
320 } else {
321 if (!nocase) {
322 if (pattern[0] == string[0])
323 match = 1;
324 } else {
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
326 match = 1;
327 }
328 }
329 pattern++;
330 patternLen--;
331 }
332 if (not)
333 match = !match;
334 if (!match)
335 return 0; /* no match */
336 string++;
337 stringLen--;
338 break;
339 }
340 case '\\':
341 if (patternLen >= 2) {
342 pattern++;
343 patternLen--;
344 }
345 /* fall through */
346 default:
347 if (!nocase) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
350 } else {
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
353 }
354 string++;
355 stringLen--;
356 break;
357 }
358 pattern++;
359 patternLen--;
360 if (stringLen == 0) {
361 while (*pattern == '*') {
362 pattern++;
363 patternLen--;
364 }
365 break;
366 }
367 }
368 if (patternLen == 0 && stringLen == 0)
369 return 1;
370 return 0;
371 }
372
373 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
374 int nocase)
375 {
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
377
378 if (nocase == 0) {
379 while (l1 && l2) {
380 if (*u1 != *u2)
381 return (int)*u1-*u2;
382 u1++; u2++; l1--; l2--;
383 }
384 if (!l1 && !l2) return 0;
385 return l1-l2;
386 } else {
387 while (l1 && l2) {
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
391 }
392 if (!l1 && !l2) return 0;
393 return l1-l2;
394 }
395 }
396
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index_t)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index_t < 0) index_t = 0;
406 s2 += index_t;
407 for (i = index_t; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 static int Jim_WideToString(char *buf, jim_wide wideValue)
416 {
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
419 }
420
421 static int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
422 {
423 char *endptr;
424
425 #ifdef HAVE_LONG_LONG_INT
426 *widePtr = JimStrtoll(str, &endptr, base);
427 #else
428 *widePtr = strtol(str, &endptr, base);
429 #endif
430 if ((str[0] == '\0') || (str == endptr))
431 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace((int)*endptr))
435 return JIM_ERR;
436 endptr++;
437 }
438 }
439 return JIM_OK;
440 }
441
442 static int Jim_StringToIndex(const char *str, int *intPtr)
443 {
444 char *endptr;
445
446 *intPtr = strtol(str, &endptr, 10);
447 if ((str[0] == '\0') || (str == endptr))
448 return JIM_ERR;
449 if (endptr[0] != '\0') {
450 while (*endptr) {
451 if (!isspace((int)*endptr))
452 return JIM_ERR;
453 endptr++;
454 }
455 }
456 return JIM_OK;
457 }
458
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
465
466 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
467
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
469 {
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
473 }
474
475 static int Jim_DoubleToString(char *buf, double doubleValue)
476 {
477 char *s;
478 int len;
479
480 len = sprintf(buf, "%.17g", doubleValue);
481 s = buf;
482 while (*s) {
483 if (*s == '.') return len;
484 s++;
485 }
486 /* Add a final ".0" if it's a number. But not
487 * for NaN or InF */
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
491 s[0] = '.';
492 s[1] = '0';
493 s[2] = '\0';
494 return len + 2;
495 }
496 return len;
497 }
498
499 static int Jim_StringToDouble(const char *str, double *doublePtr)
500 {
501 char *endptr;
502
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
505 return JIM_ERR;
506 return JIM_OK;
507 }
508
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
510 {
511 jim_wide i, res = 1;
512 if ((b == 0 && e != 0) || (e < 0)) return 0;
513 for (i = 0; i < e; i++) {res *= b;}
514 return res;
515 }
516
517 /* -----------------------------------------------------------------------------
518 * Special functions
519 * ---------------------------------------------------------------------------*/
520
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
525 {
526 va_list ap;
527
528 va_start(ap, fmt);
529 /*
530 * Send it here first.. Assuming STDIO still works
531 */
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
535 va_end(ap);
536
537 #ifdef HAVE_BACKTRACE
538 {
539 void *array[40];
540 int size, i;
541 char **strings;
542
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
549 }
550 #endif
551
552 /* This may actually crash... we do it last */
553 if (interp && interp->cookie_stderr) {
554 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
556 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
557 }
558 abort();
559 }
560
561 /* -----------------------------------------------------------------------------
562 * Memory allocation
563 * ---------------------------------------------------------------------------*/
564
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
568 #if 0
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
572 #endif
573
574 void *Jim_Alloc(int size)
575 {
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
577 if (size == 0)
578 size = 1;
579 void *p = malloc(size);
580 if (p == NULL)
581 Jim_Panic(NULL,"malloc: Out of memory");
582 return p;
583 }
584
585 void Jim_Free(void *ptr) {
586 free(ptr);
587 }
588
589 static void *Jim_Realloc(void *ptr, int size)
590 {
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
592 if (size == 0)
593 size = 1;
594 void *p = realloc(ptr, size);
595 if (p == NULL)
596 Jim_Panic(NULL,"realloc: Out of memory");
597 return p;
598 }
599
600 char *Jim_StrDup(const char *s)
601 {
602 int l = strlen(s);
603 char *copy = Jim_Alloc(l + 1);
604
605 memcpy(copy, s, l + 1);
606 return copy;
607 }
608
609 static char *Jim_StrDupLen(const char *s, int l)
610 {
611 char *copy = Jim_Alloc(l + 1);
612
613 memcpy(copy, s, l + 1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
615 return copy;
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
623 {
624 #if (defined WIN32) && !(defined JIM_ANSIC)
625 LARGE_INTEGER t, f;
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
629 #else /* !WIN32 */
630 clock_t clocks = clock();
631
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
633 #endif /* WIN32 */
634 }
635
636 /* -----------------------------------------------------------------------------
637 * Hash Tables
638 * ---------------------------------------------------------------------------*/
639
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
644
645 /* -------------------------- hash functions -------------------------------- */
646
647 /* Thomas Wang's 32 bit Mix Function */
648 static unsigned int Jim_IntHashFunction(unsigned int key)
649 {
650 key += ~(key << 15);
651 key ^= (key >> 10);
652 key += (key << 3);
653 key ^= (key >> 6);
654 key += ~(key << 11);
655 key ^= (key >> 16);
656 return key;
657 }
658
659 /* Generic hash function (we are using to multiply by 9 and add the byte
660 * as Tcl) */
661 static unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
662 {
663 unsigned int h = 0;
664 while (len--)
665 h += (h << 3)+*buf++;
666 return h;
667 }
668
669 /* ----------------------------- API implementation ------------------------- */
670 /* reset an hashtable already initialized with ht_init().
671 * NOTE: This function should only called by ht_destroy(). */
672 static void JimResetHashTable(Jim_HashTable *ht)
673 {
674 ht->table = NULL;
675 ht->size = 0;
676 ht->sizemask = 0;
677 ht->used = 0;
678 ht->collisions = 0;
679 }
680
681 /* Initialize the hash table */
682 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
683 void *privDataPtr)
684 {
685 JimResetHashTable(ht);
686 ht->type = type;
687 ht->privdata = privDataPtr;
688 return JIM_OK;
689 }
690
691 /* Resize the table to the minimal size that contains all the elements,
692 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
693 int Jim_ResizeHashTable(Jim_HashTable *ht)
694 {
695 int minimal = ht->used;
696
697 if (minimal < JIM_HT_INITIAL_SIZE)
698 minimal = JIM_HT_INITIAL_SIZE;
699 return Jim_ExpandHashTable(ht, minimal);
700 }
701
702 /* Expand or create the hashtable */
703 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
704 {
705 Jim_HashTable n; /* the new hashtable */
706 unsigned int realsize = JimHashTableNextPower(size), i;
707
708 /* the size is invalid if it is smaller than the number of
709 * elements already inside the hashtable */
710 if (ht->used >= size)
711 return JIM_ERR;
712
713 Jim_InitHashTable(&n, ht->type, ht->privdata);
714 n.size = realsize;
715 n.sizemask = realsize-1;
716 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
717
718 /* Initialize all the pointers to NULL */
719 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
720
721 /* Copy all the elements from the old to the new table:
722 * note that if the old hash table is empty ht->size is zero,
723 * so Jim_ExpandHashTable just creates an hash table. */
724 n.used = ht->used;
725 for (i = 0; i < ht->size && ht->used > 0; i++) {
726 Jim_HashEntry *he, *nextHe;
727
728 if (ht->table[i] == NULL) continue;
729
730 /* For each hash entry on this slot... */
731 he = ht->table[i];
732 while (he) {
733 unsigned int h;
734
735 nextHe = he->next;
736 /* Get the new element index */
737 h = Jim_HashKey(ht, he->key) & n.sizemask;
738 he->next = n.table[h];
739 n.table[h] = he;
740 ht->used--;
741 /* Pass to the next element */
742 he = nextHe;
743 }
744 }
745 assert(ht->used == 0);
746 Jim_Free(ht->table);
747
748 /* Remap the new hashtable in the old */
749 *ht = n;
750 return JIM_OK;
751 }
752
753 /* Add an element to the target hash table */
754 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
755 {
756 int index_t;
757 Jim_HashEntry *entry;
758
759 /* Get the index of the new element, or -1 if
760 * the element already exists. */
761 if ((index_t = JimInsertHashEntry(ht, key)) == -1)
762 return JIM_ERR;
763
764 /* Allocates the memory and stores key */
765 entry = Jim_Alloc(sizeof(*entry));
766 entry->next = ht->table[index_t];
767 ht->table[index_t] = entry;
768
769 /* Set the hash entry fields. */
770 Jim_SetHashKey(ht, entry, key);
771 Jim_SetHashVal(ht, entry, val);
772 ht->used++;
773 return JIM_OK;
774 }
775
776 /* Add an element, discarding the old if the key already exists */
777 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
778 {
779 Jim_HashEntry *entry;
780
781 /* Try to add the element. If the key
782 * does not exists Jim_AddHashEntry will suceed. */
783 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
784 return JIM_OK;
785 /* It already exists, get the entry */
786 entry = Jim_FindHashEntry(ht, key);
787 /* Free the old value and set the new one */
788 Jim_FreeEntryVal(ht, entry);
789 Jim_SetHashVal(ht, entry, val);
790 return JIM_OK;
791 }
792
793 /* Search and remove an element */
794 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
795 {
796 unsigned int h;
797 Jim_HashEntry *he, *prevHe;
798
799 if (ht->size == 0)
800 return JIM_ERR;
801 h = Jim_HashKey(ht, key) & ht->sizemask;
802 he = ht->table[h];
803
804 prevHe = NULL;
805 while (he) {
806 if (Jim_CompareHashKeys(ht, key, he->key)) {
807 /* Unlink the element from the list */
808 if (prevHe)
809 prevHe->next = he->next;
810 else
811 ht->table[h] = he->next;
812 Jim_FreeEntryKey(ht, he);
813 Jim_FreeEntryVal(ht, he);
814 Jim_Free(he);
815 ht->used--;
816 return JIM_OK;
817 }
818 prevHe = he;
819 he = he->next;
820 }
821 return JIM_ERR; /* not found */
822 }
823
824 /* Destroy an entire hash table */
825 int Jim_FreeHashTable(Jim_HashTable *ht)
826 {
827 unsigned int i;
828
829 /* Free all the elements */
830 for (i = 0; i < ht->size && ht->used > 0; i++) {
831 Jim_HashEntry *he, *nextHe;
832
833 if ((he = ht->table[i]) == NULL) continue;
834 while (he) {
835 nextHe = he->next;
836 Jim_FreeEntryKey(ht, he);
837 Jim_FreeEntryVal(ht, he);
838 Jim_Free(he);
839 ht->used--;
840 he = nextHe;
841 }
842 }
843 /* Free the table and the allocated cache structure */
844 Jim_Free(ht->table);
845 /* Re-initialize the table */
846 JimResetHashTable(ht);
847 return JIM_OK; /* never fails */
848 }
849
850 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
851 {
852 Jim_HashEntry *he;
853 unsigned int h;
854
855 if (ht->size == 0) return NULL;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
858 while (he) {
859 if (Jim_CompareHashKeys(ht, key, he->key))
860 return he;
861 he = he->next;
862 }
863 return NULL;
864 }
865
866 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
867 {
868 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
869
870 iter->ht = ht;
871 iter->index = -1;
872 iter->entry = NULL;
873 iter->nextEntry = NULL;
874 return iter;
875 }
876
877 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
878 {
879 while (1) {
880 if (iter->entry == NULL) {
881 iter->index++;
882 if (iter->index >=
883 (signed)iter->ht->size) break;
884 iter->entry = iter->ht->table[iter->index];
885 } else {
886 iter->entry = iter->nextEntry;
887 }
888 if (iter->entry) {
889 /* We need to save the 'next' here, the iterator user
890 * may delete the entry we are returning. */
891 iter->nextEntry = iter->entry->next;
892 return iter->entry;
893 }
894 }
895 return NULL;
896 }
897
898 /* ------------------------- private functions ------------------------------ */
899
900 /* Expand the hash table if needed */
901 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
902 {
903 /* If the hash table is empty expand it to the intial size,
904 * if the table is "full" dobule its size. */
905 if (ht->size == 0)
906 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
907 if (ht->size == ht->used)
908 return Jim_ExpandHashTable(ht, ht->size*2);
909 return JIM_OK;
910 }
911
912 /* Our hash table capability is a power of two */
913 static unsigned int JimHashTableNextPower(unsigned int size)
914 {
915 unsigned int i = JIM_HT_INITIAL_SIZE;
916
917 if (size >= 2147483648U)
918 return 2147483648U;
919 while (1) {
920 if (i >= size)
921 return i;
922 i *= 2;
923 }
924 }
925
926 /* Returns the index of a free slot that can be populated with
927 * an hash entry for the given 'key'.
928 * If the key already exists, -1 is returned. */
929 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
930 {
931 unsigned int h;
932 Jim_HashEntry *he;
933
934 /* Expand the hashtable if needed */
935 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
936 return -1;
937 /* Compute the key hash value */
938 h = Jim_HashKey(ht, key) & ht->sizemask;
939 /* Search if this slot does not already contain the given key */
940 he = ht->table[h];
941 while (he) {
942 if (Jim_CompareHashKeys(ht, key, he->key))
943 return -1;
944 he = he->next;
945 }
946 return h;
947 }
948
949 /* ----------------------- StringCopy Hash Table Type ------------------------*/
950
951 static unsigned int JimStringCopyHTHashFunction(const void *key)
952 {
953 return Jim_GenHashFunction(key, strlen(key));
954 }
955
956 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
957 {
958 int len = strlen(key);
959 char *copy = Jim_Alloc(len + 1);
960 JIM_NOTUSED(privdata);
961
962 memcpy(copy, key, len);
963 copy[len] = '\0';
964 return copy;
965 }
966
967 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
968 {
969 int len = strlen(val);
970 char *copy = Jim_Alloc(len + 1);
971 JIM_NOTUSED(privdata);
972
973 memcpy(copy, val, len);
974 copy[len] = '\0';
975 return copy;
976 }
977
978 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
979 const void *key2)
980 {
981 JIM_NOTUSED(privdata);
982
983 return strcmp(key1, key2) == 0;
984 }
985
986 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
987 {
988 JIM_NOTUSED(privdata);
989
990 Jim_Free((void*)key); /* ATTENTION: const cast */
991 }
992
993 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
994 {
995 JIM_NOTUSED(privdata);
996
997 Jim_Free((void*)val); /* ATTENTION: const cast */
998 }
999
1000 static Jim_HashTableType JimStringCopyHashTableType = {
1001 JimStringCopyHTHashFunction, /* hash function */
1002 JimStringCopyHTKeyDup, /* key dup */
1003 NULL, /* val dup */
1004 JimStringCopyHTKeyCompare, /* key compare */
1005 JimStringCopyHTKeyDestructor, /* key destructor */
1006 NULL /* val destructor */
1007 };
1008
1009 /* This is like StringCopy but does not auto-duplicate the key.
1010 * It's used for intepreter's shared strings. */
1011 static Jim_HashTableType JimSharedStringsHashTableType = {
1012 JimStringCopyHTHashFunction, /* hash function */
1013 NULL, /* key dup */
1014 NULL, /* val dup */
1015 JimStringCopyHTKeyCompare, /* key compare */
1016 JimStringCopyHTKeyDestructor, /* key destructor */
1017 NULL /* val destructor */
1018 };
1019
1020 /* This is like StringCopy but also automatically handle dynamic
1021 * allocated C strings as values. */
1022 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1023 JimStringCopyHTHashFunction, /* hash function */
1024 JimStringCopyHTKeyDup, /* key dup */
1025 JimStringKeyValCopyHTValDup, /* val dup */
1026 JimStringCopyHTKeyCompare, /* key compare */
1027 JimStringCopyHTKeyDestructor, /* key destructor */
1028 JimStringKeyValCopyHTValDestructor, /* val destructor */
1029 };
1030
1031 typedef struct AssocDataValue {
1032 Jim_InterpDeleteProc *delProc;
1033 void *data;
1034 } AssocDataValue;
1035
1036 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1037 {
1038 AssocDataValue *assocPtr = (AssocDataValue *)data;
1039 if (assocPtr->delProc != NULL)
1040 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1041 Jim_Free(data);
1042 }
1043
1044 static Jim_HashTableType JimAssocDataHashTableType = {
1045 JimStringCopyHTHashFunction, /* hash function */
1046 JimStringCopyHTKeyDup, /* key dup */
1047 NULL, /* val dup */
1048 JimStringCopyHTKeyCompare, /* key compare */
1049 JimStringCopyHTKeyDestructor, /* key destructor */
1050 JimAssocDataHashTableValueDestructor /* val destructor */
1051 };
1052
1053 /* -----------------------------------------------------------------------------
1054 * Stack - This is a simple generic stack implementation. It is used for
1055 * example in the 'expr' expression compiler.
1056 * ---------------------------------------------------------------------------*/
1057 void Jim_InitStack(Jim_Stack *stack)
1058 {
1059 stack->len = 0;
1060 stack->maxlen = 0;
1061 stack->vector = NULL;
1062 }
1063
1064 void Jim_FreeStack(Jim_Stack *stack)
1065 {
1066 Jim_Free(stack->vector);
1067 }
1068
1069 int Jim_StackLen(Jim_Stack *stack)
1070 {
1071 return stack->len;
1072 }
1073
1074 void Jim_StackPush(Jim_Stack *stack, void *element) {
1075 int neededLen = stack->len + 1;
1076 if (neededLen > stack->maxlen) {
1077 stack->maxlen = neededLen*2;
1078 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1079 }
1080 stack->vector[stack->len] = element;
1081 stack->len++;
1082 }
1083
1084 void *Jim_StackPop(Jim_Stack *stack)
1085 {
1086 if (stack->len == 0) return NULL;
1087 stack->len--;
1088 return stack->vector[stack->len];
1089 }
1090
1091 void *Jim_StackPeek(Jim_Stack *stack)
1092 {
1093 if (stack->len == 0) return NULL;
1094 return stack->vector[stack->len-1];
1095 }
1096
1097 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1098 {
1099 int i;
1100
1101 for (i = 0; i < stack->len; i++)
1102 freeFunc(stack->vector[i]);
1103 }
1104
1105 /* -----------------------------------------------------------------------------
1106 * Parser
1107 * ---------------------------------------------------------------------------*/
1108
1109 /* Token types */
1110 #define JIM_TT_NONE -1 /* No token returned */
1111 #define JIM_TT_STR 0 /* simple string */
1112 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1113 #define JIM_TT_VAR 2 /* var substitution */
1114 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1115 #define JIM_TT_CMD 4 /* command substitution */
1116 #define JIM_TT_SEP 5 /* word separator */
1117 #define JIM_TT_EOL 6 /* line separator */
1118
1119 /* Additional token types needed for expressions */
1120 #define JIM_TT_SUBEXPR_START 7
1121 #define JIM_TT_SUBEXPR_END 8
1122 #define JIM_TT_EXPR_NUMBER 9
1123 #define JIM_TT_EXPR_OPERATOR 10
1124
1125 /* Parser states */
1126 #define JIM_PS_DEF 0 /* Default state */
1127 #define JIM_PS_QUOTE 1 /* Inside "" */
1128
1129 /* Parser context structure. The same context is used both to parse
1130 * Tcl scripts and lists. */
1131 struct JimParserCtx {
1132 const char *prg; /* Program text */
1133 const char *p; /* Pointer to the point of the program we are parsing */
1134 int len; /* Left length of 'prg' */
1135 int linenr; /* Current line number */
1136 const char *tstart;
1137 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1138 int tline; /* Line number of the returned token */
1139 int tt; /* Token type */
1140 int eof; /* Non zero if EOF condition is true. */
1141 int state; /* Parser state */
1142 int comment; /* Non zero if the next chars may be a comment. */
1143 };
1144
1145 #define JimParserEof(c) ((c)->eof)
1146 #define JimParserTstart(c) ((c)->tstart)
1147 #define JimParserTend(c) ((c)->tend)
1148 #define JimParserTtype(c) ((c)->tt)
1149 #define JimParserTline(c) ((c)->tline)
1150
1151 static int JimParseScript(struct JimParserCtx *pc);
1152 static int JimParseSep(struct JimParserCtx *pc);
1153 static int JimParseEol(struct JimParserCtx *pc);
1154 static int JimParseCmd(struct JimParserCtx *pc);
1155 static int JimParseVar(struct JimParserCtx *pc);
1156 static int JimParseBrace(struct JimParserCtx *pc);
1157 static int JimParseStr(struct JimParserCtx *pc);
1158 static int JimParseComment(struct JimParserCtx *pc);
1159 static char *JimParserGetToken(struct JimParserCtx *pc,
1160 int *lenPtr, int *typePtr, int *linePtr);
1161
1162 /* Initialize a parser context.
1163 * 'prg' is a pointer to the program text, linenr is the line
1164 * number of the first line contained in the program. */
1165 static void JimParserInit(struct JimParserCtx *pc, const char *prg,
1166 int len, int linenr)
1167 {
1168 pc->prg = prg;
1169 pc->p = prg;
1170 pc->len = len;
1171 pc->tstart = NULL;
1172 pc->tend = NULL;
1173 pc->tline = 0;
1174 pc->tt = JIM_TT_NONE;
1175 pc->eof = 0;
1176 pc->state = JIM_PS_DEF;
1177 pc->linenr = linenr;
1178 pc->comment = 1;
1179 }
1180
1181 int JimParseScript(struct JimParserCtx *pc)
1182 {
1183 while (1) { /* the while is used to reiterate with continue if needed */
1184 if (!pc->len) {
1185 pc->tstart = pc->p;
1186 pc->tend = pc->p-1;
1187 pc->tline = pc->linenr;
1188 pc->tt = JIM_TT_EOL;
1189 pc->eof = 1;
1190 return JIM_OK;
1191 }
1192 switch (*(pc->p)) {
1193 case '\\':
1194 if (*(pc->p + 1) == '\n')
1195 return JimParseSep(pc);
1196 else {
1197 pc->comment = 0;
1198 return JimParseStr(pc);
1199 }
1200 break;
1201 case ' ':
1202 case '\t':
1203 case '\r':
1204 if (pc->state == JIM_PS_DEF)
1205 return JimParseSep(pc);
1206 else {
1207 pc->comment = 0;
1208 return JimParseStr(pc);
1209 }
1210 break;
1211 case '\n':
1212 case ';':
1213 pc->comment = 1;
1214 if (pc->state == JIM_PS_DEF)
1215 return JimParseEol(pc);
1216 else
1217 return JimParseStr(pc);
1218 break;
1219 case '[':
1220 pc->comment = 0;
1221 return JimParseCmd(pc);
1222 break;
1223 case '$':
1224 pc->comment = 0;
1225 if (JimParseVar(pc) == JIM_ERR) {
1226 pc->tstart = pc->tend = pc->p++; pc->len--;
1227 pc->tline = pc->linenr;
1228 pc->tt = JIM_TT_STR;
1229 return JIM_OK;
1230 } else
1231 return JIM_OK;
1232 break;
1233 case '#':
1234 if (pc->comment) {
1235 JimParseComment(pc);
1236 continue;
1237 } else {
1238 return JimParseStr(pc);
1239 }
1240 default:
1241 pc->comment = 0;
1242 return JimParseStr(pc);
1243 break;
1244 }
1245 return JIM_OK;
1246 }
1247 }
1248
1249 int JimParseSep(struct JimParserCtx *pc)
1250 {
1251 pc->tstart = pc->p;
1252 pc->tline = pc->linenr;
1253 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1254 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1255 if (*pc->p == '\\') {
1256 pc->p++; pc->len--;
1257 pc->linenr++;
1258 }
1259 pc->p++; pc->len--;
1260 }
1261 pc->tend = pc->p-1;
1262 pc->tt = JIM_TT_SEP;
1263 return JIM_OK;
1264 }
1265
1266 int JimParseEol(struct JimParserCtx *pc)
1267 {
1268 pc->tstart = pc->p;
1269 pc->tline = pc->linenr;
1270 while (*pc->p == ' ' || *pc->p == '\n' ||
1271 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1272 if (*pc->p == '\n')
1273 pc->linenr++;
1274 pc->p++; pc->len--;
1275 }
1276 pc->tend = pc->p-1;
1277 pc->tt = JIM_TT_EOL;
1278 return JIM_OK;
1279 }
1280
1281 /* Todo. Don't stop if ']' appears inside {} or quoted.
1282 * Also should handle the case of puts [string length "]"] */
1283 int JimParseCmd(struct JimParserCtx *pc)
1284 {
1285 int level = 1;
1286 int blevel = 0;
1287
1288 pc->tstart = ++pc->p; pc->len--;
1289 pc->tline = pc->linenr;
1290 while (1) {
1291 if (pc->len == 0) {
1292 break;
1293 } else if (*pc->p == '[' && blevel == 0) {
1294 level++;
1295 } else if (*pc->p == ']' && blevel == 0) {
1296 level--;
1297 if (!level) break;
1298 } else if (*pc->p == '\\') {
1299 pc->p++; pc->len--;
1300 } else if (*pc->p == '{') {
1301 blevel++;
1302 } else if (*pc->p == '}') {
1303 if (blevel != 0)
1304 blevel--;
1305 } else if (*pc->p == '\n')
1306 pc->linenr++;
1307 pc->p++; pc->len--;
1308 }
1309 pc->tend = pc->p-1;
1310 pc->tt = JIM_TT_CMD;
1311 if (*pc->p == ']') {
1312 pc->p++; pc->len--;
1313 }
1314 return JIM_OK;
1315 }
1316
1317 int JimParseVar(struct JimParserCtx *pc)
1318 {
1319 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1320
1321 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1322 pc->tline = pc->linenr;
1323 if (*pc->p == '{') {
1324 pc->tstart = ++pc->p; pc->len--;
1325 brace = 1;
1326 }
1327 if (brace) {
1328 while (!stop) {
1329 if (*pc->p == '}' || pc->len == 0) {
1330 pc->tend = pc->p-1;
1331 stop = 1;
1332 if (pc->len == 0)
1333 break;
1334 }
1335 else if (*pc->p == '\n')
1336 pc->linenr++;
1337 pc->p++; pc->len--;
1338 }
1339 } else {
1340 /* Include leading colons */
1341 while (*pc->p == ':') {
1342 pc->p++;
1343 pc->len--;
1344 }
1345 while (!stop) {
1346 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1347 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1348 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1349 stop = 1;
1350 else {
1351 pc->p++; pc->len--;
1352 }
1353 }
1354 /* Parse [dict get] syntax sugar. */
1355 if (*pc->p == '(') {
1356 while (*pc->p != ')' && pc->len) {
1357 pc->p++; pc->len--;
1358 if (*pc->p == '\\' && pc->len >= 2) {
1359 pc->p += 2; pc->len -= 2;
1360 }
1361 }
1362 if (*pc->p != '\0') {
1363 pc->p++; pc->len--;
1364 }
1365 ttype = JIM_TT_DICTSUGAR;
1366 }
1367 pc->tend = pc->p-1;
1368 }
1369 /* Check if we parsed just the '$' character.
1370 * That's not a variable so an error is returned
1371 * to tell the state machine to consider this '$' just
1372 * a string. */
1373 if (pc->tstart == pc->p) {
1374 pc->p--; pc->len++;
1375 return JIM_ERR;
1376 }
1377 pc->tt = ttype;
1378 return JIM_OK;
1379 }
1380
1381 int JimParseBrace(struct JimParserCtx *pc)
1382 {
1383 int level = 1;
1384
1385 pc->tstart = ++pc->p; pc->len--;
1386 pc->tline = pc->linenr;
1387 while (1) {
1388 if (*pc->p == '\\' && pc->len >= 2) {
1389 pc->p++; pc->len--;
1390 if (*pc->p == '\n')
1391 pc->linenr++;
1392 } else if (*pc->p == '{') {
1393 level++;
1394 } else if (pc->len == 0 || *pc->p == '}') {
1395 level--;
1396 if (pc->len == 0 || level == 0) {
1397 pc->tend = pc->p-1;
1398 if (pc->len != 0) {
1399 pc->p++; pc->len--;
1400 }
1401 pc->tt = JIM_TT_STR;
1402 return JIM_OK;
1403 }
1404 } else if (*pc->p == '\n') {
1405 pc->linenr++;
1406 }
1407 pc->p++; pc->len--;
1408 }
1409 return JIM_OK; /* unreached */
1410 }
1411
1412 int JimParseStr(struct JimParserCtx *pc)
1413 {
1414 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1415 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1416 if (newword && *pc->p == '{') {
1417 return JimParseBrace(pc);
1418 } else if (newword && *pc->p == '"') {
1419 pc->state = JIM_PS_QUOTE;
1420 pc->p++; pc->len--;
1421 }
1422 pc->tstart = pc->p;
1423 pc->tline = pc->linenr;
1424 while (1) {
1425 if (pc->len == 0) {
1426 pc->tend = pc->p-1;
1427 pc->tt = JIM_TT_ESC;
1428 return JIM_OK;
1429 }
1430 switch (*pc->p) {
1431 case '\\':
1432 if (pc->state == JIM_PS_DEF &&
1433 *(pc->p + 1) == '\n') {
1434 pc->tend = pc->p-1;
1435 pc->tt = JIM_TT_ESC;
1436 return JIM_OK;
1437 }
1438 if (pc->len >= 2) {
1439 pc->p++; pc->len--;
1440 }
1441 break;
1442 case '$':
1443 case '[':
1444 pc->tend = pc->p-1;
1445 pc->tt = JIM_TT_ESC;
1446 return JIM_OK;
1447 case ' ':
1448 case '\t':
1449 case '\n':
1450 case '\r':
1451 case ';':
1452 if (pc->state == JIM_PS_DEF) {
1453 pc->tend = pc->p-1;
1454 pc->tt = JIM_TT_ESC;
1455 return JIM_OK;
1456 } else if (*pc->p == '\n') {
1457 pc->linenr++;
1458 }
1459 break;
1460 case '"':
1461 if (pc->state == JIM_PS_QUOTE) {
1462 pc->tend = pc->p-1;
1463 pc->tt = JIM_TT_ESC;
1464 pc->p++; pc->len--;
1465 pc->state = JIM_PS_DEF;
1466 return JIM_OK;
1467 }
1468 break;
1469 }
1470 pc->p++; pc->len--;
1471 }
1472 return JIM_OK; /* unreached */
1473 }
1474
1475 int JimParseComment(struct JimParserCtx *pc)
1476 {
1477 while (*pc->p) {
1478 if (*pc->p == '\n') {
1479 pc->linenr++;
1480 if (*(pc->p-1) != '\\') {
1481 pc->p++; pc->len--;
1482 return JIM_OK;
1483 }
1484 }
1485 pc->p++; pc->len--;
1486 }
1487 return JIM_OK;
1488 }
1489
1490 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1491 static int xdigitval(int c)
1492 {
1493 if (c >= '0' && c <= '9') return c-'0';
1494 if (c >= 'a' && c <= 'f') return c-'a'+10;
1495 if (c >= 'A' && c <= 'F') return c-'A'+10;
1496 return -1;
1497 }
1498
1499 static int odigitval(int c)
1500 {
1501 if (c >= '0' && c <= '7') return c-'0';
1502 return -1;
1503 }
1504
1505 /* Perform Tcl escape substitution of 's', storing the result
1506 * string into 'dest'. The escaped string is guaranteed to
1507 * be the same length or shorted than the source string.
1508 * Slen is the length of the string at 's', if it's -1 the string
1509 * length will be calculated by the function.
1510 *
1511 * The function returns the length of the resulting string. */
1512 static int JimEscape(char *dest, const char *s, int slen)
1513 {
1514 char *p = dest;
1515 int i, len;
1516
1517 if (slen == -1)
1518 slen = strlen(s);
1519
1520 for (i = 0; i < slen; i++) {
1521 switch (s[i]) {
1522 case '\\':
1523 switch (s[i + 1]) {
1524 case 'a': *p++ = 0x7; i++; break;
1525 case 'b': *p++ = 0x8; i++; break;
1526 case 'f': *p++ = 0xc; i++; break;
1527 case 'n': *p++ = 0xa; i++; break;
1528 case 'r': *p++ = 0xd; i++; break;
1529 case 't': *p++ = 0x9; i++; break;
1530 case 'v': *p++ = 0xb; i++; break;
1531 case '\0': *p++ = '\\'; i++; break;
1532 case '\n': *p++ = ' '; i++; break;
1533 default:
1534 if (s[i + 1] == 'x') {
1535 int val = 0;
1536 int c = xdigitval(s[i + 2]);
1537 if (c == -1) {
1538 *p++ = 'x';
1539 i++;
1540 break;
1541 }
1542 val = c;
1543 c = xdigitval(s[i + 3]);
1544 if (c == -1) {
1545 *p++ = val;
1546 i += 2;
1547 break;
1548 }
1549 val = (val*16) + c;
1550 *p++ = val;
1551 i += 3;
1552 break;
1553 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1554 {
1555 int val = 0;
1556 int c = odigitval(s[i + 1]);
1557 val = c;
1558 c = odigitval(s[i + 2]);
1559 if (c == -1) {
1560 *p++ = val;
1561 i ++;
1562 break;
1563 }
1564 val = (val*8) + c;
1565 c = odigitval(s[i + 3]);
1566 if (c == -1) {
1567 *p++ = val;
1568 i += 2;
1569 break;
1570 }
1571 val = (val*8) + c;
1572 *p++ = val;
1573 i += 3;
1574 } else {
1575 *p++ = s[i + 1];
1576 i++;
1577 }
1578 break;
1579 }
1580 break;
1581 default:
1582 *p++ = s[i];
1583 break;
1584 }
1585 }
1586 len = p-dest;
1587 *p++ = '\0';
1588 return len;
1589 }
1590
1591 /* Returns a dynamically allocated copy of the current token in the
1592 * parser context. The function perform conversion of escapes if
1593 * the token is of type JIM_TT_ESC.
1594 *
1595 * Note that after the conversion, tokens that are grouped with
1596 * braces in the source code, are always recognizable from the
1597 * identical string obtained in a different way from the type.
1598 *
1599 * For exmple the string:
1600 *
1601 * {expand}$a
1602 *
1603 * will return as first token "expand", of type JIM_TT_STR
1604 *
1605 * While the string:
1606 *
1607 * expand$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_ESC
1610 */
1611 char *JimParserGetToken(struct JimParserCtx *pc,
1612 int *lenPtr, int *typePtr, int *linePtr)
1613 {
1614 const char *start, *end;
1615 char *token;
1616 int len;
1617
1618 start = JimParserTstart(pc);
1619 end = JimParserTend(pc);
1620 if (start > end) {
1621 if (lenPtr) *lenPtr = 0;
1622 if (typePtr) *typePtr = JimParserTtype(pc);
1623 if (linePtr) *linePtr = JimParserTline(pc);
1624 token = Jim_Alloc(1);
1625 token[0] = '\0';
1626 return token;
1627 }
1628 len = (end-start) + 1;
1629 token = Jim_Alloc(len + 1);
1630 if (JimParserTtype(pc) != JIM_TT_ESC) {
1631 /* No escape conversion needed? Just copy it. */
1632 memcpy(token, start, len);
1633 token[len] = '\0';
1634 } else {
1635 /* Else convert the escape chars. */
1636 len = JimEscape(token, start, len);
1637 }
1638 if (lenPtr) *lenPtr = len;
1639 if (typePtr) *typePtr = JimParserTtype(pc);
1640 if (linePtr) *linePtr = JimParserTline(pc);
1641 return token;
1642 }
1643
1644 /* The following functin is not really part of the parsing engine of Jim,
1645 * but it somewhat related. Given an string and its length, it tries
1646 * to guess if the script is complete or there are instead " " or { }
1647 * open and not completed. This is useful for interactive shells
1648 * implementation and for [info complete].
1649 *
1650 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1651 * '{' on scripts incomplete missing one or more '}' to be balanced.
1652 * '"' on scripts incomplete missing a '"' char.
1653 *
1654 * If the script is complete, 1 is returned, otherwise 0. */
1655 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1656 {
1657 int level = 0;
1658 int state = ' ';
1659
1660 while (len) {
1661 switch (*s) {
1662 case '\\':
1663 if (len > 1)
1664 s++;
1665 break;
1666 case '"':
1667 if (state == ' ') {
1668 state = '"';
1669 } else if (state == '"') {
1670 state = ' ';
1671 }
1672 break;
1673 case '{':
1674 if (state == '{') {
1675 level++;
1676 } else if (state == ' ') {
1677 state = '{';
1678 level++;
1679 }
1680 break;
1681 case '}':
1682 if (state == '{') {
1683 level--;
1684 if (level == 0)
1685 state = ' ';
1686 }
1687 break;
1688 }
1689 s++;
1690 len--;
1691 }
1692 if (stateCharPtr)
1693 *stateCharPtr = state;
1694 return state == ' ';
1695 }
1696
1697 /* -----------------------------------------------------------------------------
1698 * Tcl Lists parsing
1699 * ---------------------------------------------------------------------------*/
1700 static int JimParseListSep(struct JimParserCtx *pc);
1701 static int JimParseListStr(struct JimParserCtx *pc);
1702
1703 static int JimParseList(struct JimParserCtx *pc)
1704 {
1705 if (pc->len == 0) {
1706 pc->tstart = pc->tend = pc->p;
1707 pc->tline = pc->linenr;
1708 pc->tt = JIM_TT_EOL;
1709 pc->eof = 1;
1710 return JIM_OK;
1711 }
1712 switch (*pc->p) {
1713 case ' ':
1714 case '\n':
1715 case '\t':
1716 case '\r':
1717 if (pc->state == JIM_PS_DEF)
1718 return JimParseListSep(pc);
1719 else
1720 return JimParseListStr(pc);
1721 break;
1722 default:
1723 return JimParseListStr(pc);
1724 break;
1725 }
1726 return JIM_OK;
1727 }
1728
1729 int JimParseListSep(struct JimParserCtx *pc)
1730 {
1731 pc->tstart = pc->p;
1732 pc->tline = pc->linenr;
1733 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1734 {
1735 pc->p++; pc->len--;
1736 }
1737 pc->tend = pc->p-1;
1738 pc->tt = JIM_TT_SEP;
1739 return JIM_OK;
1740 }
1741
1742 int JimParseListStr(struct JimParserCtx *pc)
1743 {
1744 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1745 pc->tt == JIM_TT_NONE);
1746 if (newword && *pc->p == '{') {
1747 return JimParseBrace(pc);
1748 } else if (newword && *pc->p == '"') {
1749 pc->state = JIM_PS_QUOTE;
1750 pc->p++; pc->len--;
1751 }
1752 pc->tstart = pc->p;
1753 pc->tline = pc->linenr;
1754 while (1) {
1755 if (pc->len == 0) {
1756 pc->tend = pc->p-1;
1757 pc->tt = JIM_TT_ESC;
1758 return JIM_OK;
1759 }
1760 switch (*pc->p) {
1761 case '\\':
1762 pc->p++; pc->len--;
1763 break;
1764 case ' ':
1765 case '\t':
1766 case '\n':
1767 case '\r':
1768 if (pc->state == JIM_PS_DEF) {
1769 pc->tend = pc->p-1;
1770 pc->tt = JIM_TT_ESC;
1771 return JIM_OK;
1772 } else if (*pc->p == '\n') {
1773 pc->linenr++;
1774 }
1775 break;
1776 case '"':
1777 if (pc->state == JIM_PS_QUOTE) {
1778 pc->tend = pc->p-1;
1779 pc->tt = JIM_TT_ESC;
1780 pc->p++; pc->len--;
1781 pc->state = JIM_PS_DEF;
1782 return JIM_OK;
1783 }
1784 break;
1785 }
1786 pc->p++; pc->len--;
1787 }
1788 return JIM_OK; /* unreached */
1789 }
1790
1791 /* -----------------------------------------------------------------------------
1792 * Jim_Obj related functions
1793 * ---------------------------------------------------------------------------*/
1794
1795 /* Return a new initialized object. */
1796 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1797 {
1798 Jim_Obj *objPtr;
1799
1800 /* -- Check if there are objects in the free list -- */
1801 if (interp->freeList != NULL) {
1802 /* -- Unlink the object from the free list -- */
1803 objPtr = interp->freeList;
1804 interp->freeList = objPtr->nextObjPtr;
1805 } else {
1806 /* -- No ready to use objects: allocate a new one -- */
1807 objPtr = Jim_Alloc(sizeof(*objPtr));
1808 }
1809
1810 /* Object is returned with refCount of 0. Every
1811 * kind of GC implemented should take care to don't try
1812 * to scan objects with refCount == 0. */
1813 objPtr->refCount = 0;
1814 /* All the other fields are left not initialized to save time.
1815 * The caller will probably want set they to the right
1816 * value anyway. */
1817
1818 /* -- Put the object into the live list -- */
1819 objPtr->prevObjPtr = NULL;
1820 objPtr->nextObjPtr = interp->liveList;
1821 if (interp->liveList)
1822 interp->liveList->prevObjPtr = objPtr;
1823 interp->liveList = objPtr;
1824
1825 return objPtr;
1826 }
1827
1828 /* Free an object. Actually objects are never freed, but
1829 * just moved to the free objects list, where they will be
1830 * reused by Jim_NewObj(). */
1831 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1832 {
1833 /* Check if the object was already freed, panic. */
1834 if (objPtr->refCount != 0) {
1835 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1836 objPtr->refCount);
1837 }
1838 /* Free the internal representation */
1839 Jim_FreeIntRep(interp, objPtr);
1840 /* Free the string representation */
1841 if (objPtr->bytes != NULL) {
1842 if (objPtr->bytes != JimEmptyStringRep)
1843 Jim_Free(objPtr->bytes);
1844 }
1845 /* Unlink the object from the live objects list */
1846 if (objPtr->prevObjPtr)
1847 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1848 if (objPtr->nextObjPtr)
1849 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1850 if (interp->liveList == objPtr)
1851 interp->liveList = objPtr->nextObjPtr;
1852 /* Link the object into the free objects list */
1853 objPtr->prevObjPtr = NULL;
1854 objPtr->nextObjPtr = interp->freeList;
1855 if (interp->freeList)
1856 interp->freeList->prevObjPtr = objPtr;
1857 interp->freeList = objPtr;
1858 objPtr->refCount = -1;
1859 }
1860
1861 /* Invalidate the string representation of an object. */
1862 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1863 {
1864 if (objPtr->bytes != NULL) {
1865 if (objPtr->bytes != JimEmptyStringRep)
1866 Jim_Free(objPtr->bytes);
1867 }
1868 objPtr->bytes = NULL;
1869 }
1870
1871 #define Jim_SetStringRep(o, b, l) \
1872 do { (o)->bytes = b; (o)->length = l; } while (0)
1873
1874 /* Set the initial string representation for an object.
1875 * Does not try to free an old one. */
1876 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1877 {
1878 if (length == 0) {
1879 objPtr->bytes = JimEmptyStringRep;
1880 objPtr->length = 0;
1881 } else {
1882 objPtr->bytes = Jim_Alloc(length + 1);
1883 objPtr->length = length;
1884 memcpy(objPtr->bytes, bytes, length);
1885 objPtr->bytes[length] = '\0';
1886 }
1887 }
1888
1889 /* Duplicate an object. The returned object has refcount = 0. */
1890 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1891 {
1892 Jim_Obj *dupPtr;
1893
1894 dupPtr = Jim_NewObj(interp);
1895 if (objPtr->bytes == NULL) {
1896 /* Object does not have a valid string representation. */
1897 dupPtr->bytes = NULL;
1898 } else {
1899 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1900 }
1901 if (objPtr->typePtr != NULL) {
1902 if (objPtr->typePtr->dupIntRepProc == NULL) {
1903 dupPtr->internalRep = objPtr->internalRep;
1904 } else {
1905 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1906 }
1907 dupPtr->typePtr = objPtr->typePtr;
1908 } else {
1909 dupPtr->typePtr = NULL;
1910 }
1911 return dupPtr;
1912 }
1913
1914 /* Return the string representation for objPtr. If the object
1915 * string representation is invalid, calls the method to create
1916 * a new one starting from the internal representation of the object. */
1917 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1918 {
1919 if (objPtr->bytes == NULL) {
1920 /* Invalid string repr. Generate it. */
1921 if (objPtr->typePtr->updateStringProc == NULL) {
1922 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1923 objPtr->typePtr->name);
1924 }
1925 objPtr->typePtr->updateStringProc(objPtr);
1926 }
1927 if (lenPtr)
1928 *lenPtr = objPtr->length;
1929 return objPtr->bytes;
1930 }
1931
1932 /* Just returns the length of the object's string rep */
1933 int Jim_Length(Jim_Obj *objPtr)
1934 {
1935 int len;
1936
1937 Jim_GetString(objPtr, &len);
1938 return len;
1939 }
1940
1941 /* -----------------------------------------------------------------------------
1942 * String Object
1943 * ---------------------------------------------------------------------------*/
1944 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1945 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1946
1947 static Jim_ObjType stringObjType = {
1948 "string",
1949 NULL,
1950 DupStringInternalRep,
1951 NULL,
1952 JIM_TYPE_REFERENCES,
1953 };
1954
1955 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1956 {
1957 JIM_NOTUSED(interp);
1958
1959 /* This is a bit subtle: the only caller of this function
1960 * should be Jim_DuplicateObj(), that will copy the
1961 * string representaion. After the copy, the duplicated
1962 * object will not have more room in teh buffer than
1963 * srcPtr->length bytes. So we just set it to length. */
1964 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1965 }
1966
1967 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1968 {
1969 /* Get a fresh string representation. */
1970 (void) Jim_GetString(objPtr, NULL);
1971 /* Free any other internal representation. */
1972 Jim_FreeIntRep(interp, objPtr);
1973 /* Set it as string, i.e. just set the maxLength field. */
1974 objPtr->typePtr = &stringObjType;
1975 objPtr->internalRep.strValue.maxLength = objPtr->length;
1976 return JIM_OK;
1977 }
1978
1979 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1980 {
1981 Jim_Obj *objPtr = Jim_NewObj(interp);
1982
1983 if (len == -1)
1984 len = strlen(s);
1985 /* Alloc/Set the string rep. */
1986 if (len == 0) {
1987 objPtr->bytes = JimEmptyStringRep;
1988 objPtr->length = 0;
1989 } else {
1990 objPtr->bytes = Jim_Alloc(len + 1);
1991 objPtr->length = len;
1992 memcpy(objPtr->bytes, s, len);
1993 objPtr->bytes[len] = '\0';
1994 }
1995
1996 /* No typePtr field for the vanilla string object. */
1997 objPtr->typePtr = NULL;
1998 return objPtr;
1999 }
2000
2001 /* This version does not try to duplicate the 's' pointer, but
2002 * use it directly. */
2003 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2004 {
2005 Jim_Obj *objPtr = Jim_NewObj(interp);
2006
2007 if (len == -1)
2008 len = strlen(s);
2009 Jim_SetStringRep(objPtr, s, len);
2010 objPtr->typePtr = NULL;
2011 return objPtr;
2012 }
2013
2014 /* Low-level string append. Use it only against objects
2015 * of type "string". */
2016 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2017 {
2018 int needlen;
2019
2020 if (len == -1)
2021 len = strlen(str);
2022 needlen = objPtr->length + len;
2023 if (objPtr->internalRep.strValue.maxLength < needlen ||
2024 objPtr->internalRep.strValue.maxLength == 0) {
2025 if (objPtr->bytes == JimEmptyStringRep) {
2026 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2027 } else {
2028 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2029 }
2030 objPtr->internalRep.strValue.maxLength = needlen*2;
2031 }
2032 memcpy(objPtr->bytes + objPtr->length, str, len);
2033 objPtr->bytes[objPtr->length + len] = '\0';
2034 objPtr->length += len;
2035 }
2036
2037 /* Higher level API to append strings to objects. */
2038 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2039 int len)
2040 {
2041 if (Jim_IsShared(objPtr))
2042 Jim_Panic(interp,"Jim_AppendString called with shared object");
2043 if (objPtr->typePtr != &stringObjType)
2044 SetStringFromAny(interp, objPtr);
2045 StringAppendString(objPtr, str, len);
2046 }
2047
2048 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2049 {
2050 char *buf;
2051 va_list ap;
2052
2053 va_start(ap, fmt);
2054 buf = jim_vasprintf(fmt, ap);
2055 va_end(ap);
2056
2057 if (buf) {
2058 Jim_AppendString(interp, objPtr, buf, -1);
2059 jim_vasprintf_done(buf);
2060 }
2061 }
2062
2063
2064 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2065 Jim_Obj *appendObjPtr)
2066 {
2067 int len;
2068 const char *str;
2069
2070 str = Jim_GetString(appendObjPtr, &len);
2071 Jim_AppendString(interp, objPtr, str, len);
2072 }
2073
2074 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2075 {
2076 va_list ap;
2077
2078 if (objPtr->typePtr != &stringObjType)
2079 SetStringFromAny(interp, objPtr);
2080 va_start(ap, objPtr);
2081 while (1) {
2082 char *s = va_arg(ap, char*);
2083
2084 if (s == NULL) break;
2085 Jim_AppendString(interp, objPtr, s, -1);
2086 }
2087 va_end(ap);
2088 }
2089
2090 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2091 {
2092 const char *aStr, *bStr;
2093 int aLen, bLen, i;
2094
2095 if (aObjPtr == bObjPtr) return 1;
2096 aStr = Jim_GetString(aObjPtr, &aLen);
2097 bStr = Jim_GetString(bObjPtr, &bLen);
2098 if (aLen != bLen) return 0;
2099 if (nocase == 0)
2100 return memcmp(aStr, bStr, aLen) == 0;
2101 for (i = 0; i < aLen; i++) {
2102 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2103 return 0;
2104 }
2105 return 1;
2106 }
2107
2108 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2109 int nocase)
2110 {
2111 const char *pattern, *string;
2112 int patternLen, stringLen;
2113
2114 pattern = Jim_GetString(patternObjPtr, &patternLen);
2115 string = Jim_GetString(objPtr, &stringLen);
2116 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2117 }
2118
2119 static int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2120 Jim_Obj *secondObjPtr, int nocase)
2121 {
2122 const char *s1, *s2;
2123 int l1, l2;
2124
2125 s1 = Jim_GetString(firstObjPtr, &l1);
2126 s2 = Jim_GetString(secondObjPtr, &l2);
2127 return JimStringCompare(s1, l1, s2, l2, nocase);
2128 }
2129
2130 /* Convert a range, as returned by Jim_GetRange(), into
2131 * an absolute index into an object of the specified length.
2132 * This function may return negative values, or values
2133 * bigger or equal to the length of the list if the index
2134 * is out of range. */
2135 static int JimRelToAbsIndex(int len, int index_t)
2136 {
2137 if (index_t < 0)
2138 return len + index_t;
2139 return index_t;
2140 }
2141
2142 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2143 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2144 * for implementation of commands like [string range] and [lrange].
2145 *
2146 * The resulting range is guaranteed to address valid elements of
2147 * the structure. */
2148 static void JimRelToAbsRange(int len, int first, int last,
2149 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2150 {
2151 int rangeLen;
2152
2153 if (first > last) {
2154 rangeLen = 0;
2155 } else {
2156 rangeLen = last-first + 1;
2157 if (rangeLen) {
2158 if (first < 0) {
2159 rangeLen += first;
2160 first = 0;
2161 }
2162 if (last >= len) {
2163 rangeLen -= (last-(len-1));
2164 last = len-1;
2165 }
2166 }
2167 }
2168 if (rangeLen < 0) rangeLen = 0;
2169
2170 *firstPtr = first;
2171 *lastPtr = last;
2172 *rangeLenPtr = rangeLen;
2173 }
2174
2175 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2176 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2177 {
2178 int first, last;
2179 const char *str;
2180 int len, rangeLen;
2181
2182 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2183 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2184 return NULL;
2185 str = Jim_GetString(strObjPtr, &len);
2186 first = JimRelToAbsIndex(len, first);
2187 last = JimRelToAbsIndex(len, last);
2188 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2189 return Jim_NewStringObj(interp, str + first, rangeLen);
2190 }
2191
2192 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2193 {
2194 char *buf;
2195 int i;
2196 if (strObjPtr->typePtr != &stringObjType) {
2197 SetStringFromAny(interp, strObjPtr);
2198 }
2199
2200 buf = Jim_Alloc(strObjPtr->length + 1);
2201
2202 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2203 for (i = 0; i < strObjPtr->length; i++)
2204 buf[i] = tolower((unsigned)buf[i]);
2205 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2206 }
2207
2208 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2209 {
2210 char *buf;
2211 int i;
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2214 }
2215
2216 buf = Jim_Alloc(strObjPtr->length + 1);
2217
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = toupper((unsigned)buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2222 }
2223
2224 /* This is the core of the [format] command.
2225 * TODO: Lots of things work - via a hack
2226 * However, no format item can be >= JIM_MAX_FMT
2227 */
2228 #define JIM_MAX_FMT 2048
2229 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2230 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2231 {
2232 const char *fmt, *_fmt;
2233 int fmtLen;
2234 Jim_Obj *resObjPtr;
2235
2236
2237 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2238 _fmt = fmt;
2239 resObjPtr = Jim_NewStringObj(interp, "", 0);
2240 while (fmtLen) {
2241 const char *p = fmt;
2242 char spec[2], c;
2243 jim_wide wideValue;
2244 double doubleValue;
2245 /* we cheat and use Sprintf()! */
2246 char fmt_str[100];
2247 char *cp;
2248 int width;
2249 int ljust;
2250 int zpad;
2251 int spad;
2252 int altfm;
2253 int forceplus;
2254 int prec;
2255 int inprec;
2256 int haveprec;
2257 int accum;
2258
2259 while (*fmt != '%' && fmtLen) {
2260 fmt++; fmtLen--;
2261 }
2262 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2263 if (fmtLen == 0)
2264 break;
2265 fmt++; fmtLen--; /* skip '%' */
2266 zpad = 0;
2267 spad = 0;
2268 width = -1;
2269 ljust = 0;
2270 altfm = 0;
2271 forceplus = 0;
2272 inprec = 0;
2273 haveprec = 0;
2274 prec = -1; /* not found yet */
2275 next_fmt:
2276 if (fmtLen <= 0) {
2277 break;
2278 }
2279 switch (*fmt) {
2280 /* terminals */
2281 case 'b': /* binary - not all printfs() do this */
2282 case 's': /* string */
2283 case 'i': /* integer */
2284 case 'd': /* decimal */
2285 case 'x': /* hex */
2286 case 'X': /* CAP hex */
2287 case 'c': /* char */
2288 case 'o': /* octal */
2289 case 'u': /* unsigned */
2290 case 'f': /* float */
2291 break;
2292
2293 /* non-terminals */
2294 case '0': /* zero pad */
2295 zpad = 1;
2296 fmt++; fmtLen--;
2297 goto next_fmt;
2298 break;
2299 case '+':
2300 forceplus = 1;
2301 fmt++; fmtLen--;
2302 goto next_fmt;
2303 break;
2304 case ' ': /* sign space */
2305 spad = 1;
2306 fmt++; fmtLen--;
2307 goto next_fmt;
2308 break;
2309 case '-':
2310 ljust = 1;
2311 fmt++; fmtLen--;
2312 goto next_fmt;
2313 break;
2314 case '#':
2315 altfm = 1;
2316 fmt++; fmtLen--;
2317 goto next_fmt;
2318
2319 case '.':
2320 inprec = 1;
2321 fmt++; fmtLen--;
2322 goto next_fmt;
2323 break;
2324 case '1':
2325 case '2':
2326 case '3':
2327 case '4':
2328 case '5':
2329 case '6':
2330 case '7':
2331 case '8':
2332 case '9':
2333 accum = 0;
2334 while (isdigit((unsigned)*fmt) && (fmtLen > 0)) {
2335 accum = (accum * 10) + (*fmt - '0');
2336 fmt++; fmtLen--;
2337 }
2338 if (inprec) {
2339 haveprec = 1;
2340 prec = accum;
2341 } else {
2342 width = accum;
2343 }
2344 goto next_fmt;
2345 case '*':
2346 /* suck up the next item as an integer */
2347 fmt++; fmtLen--;
2348 objc--;
2349 if (objc <= 0) {
2350 goto not_enough_args;
2351 }
2352 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2353 Jim_FreeNewObj(interp, resObjPtr);
2354 return NULL;
2355 }
2356 if (inprec) {
2357 haveprec = 1;
2358 prec = wideValue;
2359 if (prec < 0) {
2360 /* man 3 printf says */
2361 /* if prec is negative, it is zero */
2362 prec = 0;
2363 }
2364 } else {
2365 width = wideValue;
2366 if (width < 0) {
2367 ljust = 1;
2368 width = -width;
2369 }
2370 }
2371 objv++;
2372 goto next_fmt;
2373 break;
2374 }
2375
2376
2377 if (*fmt != '%') {
2378 if (objc == 0) {
2379 not_enough_args:
2380 Jim_FreeNewObj(interp, resObjPtr);
2381 Jim_SetResultString(interp,
2382 "not enough arguments for all format specifiers", -1);
2383 return NULL;
2384 } else {
2385 objc--;
2386 }
2387 }
2388
2389 /*
2390 * Create the formatter
2391 * cause we cheat and use sprintf()
2392 */
2393 cp = fmt_str;
2394 *cp++ = '%';
2395 if (altfm) {
2396 *cp++ = '#';
2397 }
2398 if (forceplus) {
2399 *cp++ = '+';
2400 } else if (spad) {
2401 /* PLUS overrides */
2402 *cp++ = ' ';
2403 }
2404 if (ljust) {
2405 *cp++ = '-';
2406 }
2407 if (zpad) {
2408 *cp++ = '0';
2409 }
2410 if (width > 0) {
2411 sprintf(cp, "%d", width);
2412 /* skip ahead */
2413 cp = strchr(cp,0);
2414 }
2415 /* did we find a period? */
2416 if (inprec) {
2417 /* then add it */
2418 *cp++ = '.';
2419 /* did something occur after the period? */
2420 if (haveprec) {
2421 sprintf(cp, "%d", prec);
2422 }
2423 cp = strchr(cp,0);
2424 }
2425 *cp = 0;
2426
2427 /* here we do the work */
2428 /* actually - we make sprintf() do it for us */
2429 switch (*fmt) {
2430 case 's':
2431 *cp++ = 's';
2432 *cp = 0;
2433 /* BUG: we do not handled embeded NULLs */
2434 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2435 break;
2436 case 'c':
2437 *cp++ = 'c';
2438 *cp = 0;
2439 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2440 Jim_FreeNewObj(interp, resObjPtr);
2441 return NULL;
2442 }
2443 c = (char) wideValue;
2444 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2445 break;
2446 case 'f':
2447 case 'F':
2448 case 'g':
2449 case 'G':
2450 case 'e':
2451 case 'E':
2452 *cp++ = *fmt;
2453 *cp = 0;
2454 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2455 Jim_FreeNewObj(interp, resObjPtr);
2456 return NULL;
2457 }
2458 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2459 break;
2460 case 'b':
2461 case 'd':
2462 case 'o':
2463 case 'i':
2464 case 'u':
2465 case 'x':
2466 case 'X':
2467 /* jim widevaluse are 64bit */
2468 if (sizeof(jim_wide) == sizeof(long long)) {
2469 *cp++ = 'l';
2470 *cp++ = 'l';
2471 } else {
2472 *cp++ = 'l';
2473 }
2474 *cp++ = *fmt;
2475 *cp = 0;
2476 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2477 Jim_FreeNewObj(interp, resObjPtr);
2478 return NULL;
2479 }
2480 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2481 break;
2482 case '%':
2483 sprintf_buf[0] = '%';
2484 sprintf_buf[1] = 0;
2485 objv--; /* undo the objv++ below */
2486 break;
2487 default:
2488 spec[0] = *fmt; spec[1] = '\0';
2489 Jim_FreeNewObj(interp, resObjPtr);
2490 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2491 Jim_AppendStrings(interp, Jim_GetResult(interp),
2492 "bad field specifier \"", spec, "\"", NULL);
2493 return NULL;
2494 }
2495 /* force terminate */
2496 #if 0
2497 printf("FMT was: %s\n", fmt_str);
2498 printf("RES was: |%s|\n", sprintf_buf);
2499 #endif
2500
2501 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2502 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2503 /* next obj */
2504 objv++;
2505 fmt++;
2506 fmtLen--;
2507 }
2508 return resObjPtr;
2509 }
2510
2511 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2512 int objc, Jim_Obj *const *objv)
2513 {
2514 char *sprintf_buf = malloc(JIM_MAX_FMT);
2515 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2516 free(sprintf_buf);
2517 return t;
2518 }
2519
2520 /* -----------------------------------------------------------------------------
2521 * Compared String Object
2522 * ---------------------------------------------------------------------------*/
2523
2524 /* This is strange object that allows to compare a C literal string
2525 * with a Jim object in very short time if the same comparison is done
2526 * multiple times. For example every time the [if] command is executed,
2527 * Jim has to check if a given argument is "else". This comparions if
2528 * the code has no errors are true most of the times, so we can cache
2529 * inside the object the pointer of the string of the last matching
2530 * comparison. Because most C compilers perform literal sharing,
2531 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2532 * this works pretty well even if comparisons are at different places
2533 * inside the C code. */
2534
2535 static Jim_ObjType comparedStringObjType = {
2536 "compared-string",
2537 NULL,
2538 NULL,
2539 NULL,
2540 JIM_TYPE_REFERENCES,
2541 };
2542
2543 /* The only way this object is exposed to the API is via the following
2544 * function. Returns true if the string and the object string repr.
2545 * are the same, otherwise zero is returned.
2546 *
2547 * Note: this isn't binary safe, but it hardly needs to be.*/
2548 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2549 const char *str)
2550 {
2551 if (objPtr->typePtr == &comparedStringObjType &&
2552 objPtr->internalRep.ptr == str)
2553 return 1;
2554 else {
2555 const char *objStr = Jim_GetString(objPtr, NULL);
2556 if (strcmp(str, objStr) != 0) return 0;
2557 if (objPtr->typePtr != &comparedStringObjType) {
2558 Jim_FreeIntRep(interp, objPtr);
2559 objPtr->typePtr = &comparedStringObjType;
2560 }
2561 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2562 return 1;
2563 }
2564 }
2565
2566 static int qsortCompareStringPointers(const void *a, const void *b)
2567 {
2568 char * const *sa = (char * const *)a;
2569 char * const *sb = (char * const *)b;
2570 return strcmp(*sa, *sb);
2571 }
2572
2573 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2574 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2575 {
2576 const char * const *entryPtr = NULL;
2577 char **tablePtrSorted;
2578 int i, count = 0;
2579
2580 *indexPtr = -1;
2581 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2582 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2583 *indexPtr = i;
2584 return JIM_OK;
2585 }
2586 count++; /* If nothing matches, this will reach the len of tablePtr */
2587 }
2588 if (flags & JIM_ERRMSG) {
2589 if (name == NULL)
2590 name = "option";
2591 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2592 Jim_AppendStrings(interp, Jim_GetResult(interp),
2593 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2594 NULL);
2595 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2596 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2597 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2598 for (i = 0; i < count; i++) {
2599 if (i + 1 == count && count > 1)
2600 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2601 Jim_AppendString(interp, Jim_GetResult(interp),
2602 tablePtrSorted[i], -1);
2603 if (i + 1 != count)
2604 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2605 }
2606 Jim_Free(tablePtrSorted);
2607 }
2608 return JIM_ERR;
2609 }
2610
2611 int Jim_GetNvp(Jim_Interp *interp,
2612 Jim_Obj *objPtr,
2613 const Jim_Nvp *nvp_table,
2614 const Jim_Nvp ** result)
2615 {
2616 Jim_Nvp *n;
2617 int e;
2618
2619 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2620 if (e == JIM_ERR) {
2621 return e;
2622 }
2623
2624 /* Success? found? */
2625 if (n->name) {
2626 /* remove const */
2627 *result = (Jim_Nvp *)n;
2628 return JIM_OK;
2629 } else {
2630 return JIM_ERR;
2631 }
2632 }
2633
2634 /* -----------------------------------------------------------------------------
2635 * Source Object
2636 *
2637 * This object is just a string from the language point of view, but
2638 * in the internal representation it contains the filename and line number
2639 * where this given token was read. This information is used by
2640 * Jim_EvalObj() if the object passed happens to be of type "source".
2641 *
2642 * This allows to propagate the information about line numbers and file
2643 * names and give error messages with absolute line numbers.
2644 *
2645 * Note that this object uses shared strings for filenames, and the
2646 * pointer to the filename together with the line number is taken into
2647 * the space for the "inline" internal represenation of the Jim_Object,
2648 * so there is almost memory zero-overhead.
2649 *
2650 * Also the object will be converted to something else if the given
2651 * token it represents in the source file is not something to be
2652 * evaluated (not a script), and will be specialized in some other way,
2653 * so the time overhead is alzo null.
2654 * ---------------------------------------------------------------------------*/
2655
2656 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2657 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2658
2659 static Jim_ObjType sourceObjType = {
2660 "source",
2661 FreeSourceInternalRep,
2662 DupSourceInternalRep,
2663 NULL,
2664 JIM_TYPE_REFERENCES,
2665 };
2666
2667 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2668 {
2669 Jim_ReleaseSharedString(interp,
2670 objPtr->internalRep.sourceValue.fileName);
2671 }
2672
2673 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2674 {
2675 dupPtr->internalRep.sourceValue.fileName =
2676 Jim_GetSharedString(interp,
2677 srcPtr->internalRep.sourceValue.fileName);
2678 dupPtr->internalRep.sourceValue.lineNumber =
2679 dupPtr->internalRep.sourceValue.lineNumber;
2680 dupPtr->typePtr = &sourceObjType;
2681 }
2682
2683 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2684 const char *fileName, int lineNumber)
2685 {
2686 if (Jim_IsShared(objPtr))
2687 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2688 if (objPtr->typePtr != NULL)
2689 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2690 objPtr->internalRep.sourceValue.fileName =
2691 Jim_GetSharedString(interp, fileName);
2692 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2693 objPtr->typePtr = &sourceObjType;
2694 }
2695
2696 /* -----------------------------------------------------------------------------
2697 * Script Object
2698 * ---------------------------------------------------------------------------*/
2699
2700 #define JIM_CMDSTRUCT_EXPAND -1
2701
2702 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2703 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2704 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2705
2706 static Jim_ObjType scriptObjType = {
2707 "script",
2708 FreeScriptInternalRep,
2709 DupScriptInternalRep,
2710 NULL,
2711 JIM_TYPE_REFERENCES,
2712 };
2713
2714 /* The ScriptToken structure represents every token into a scriptObj.
2715 * Every token contains an associated Jim_Obj that can be specialized
2716 * by commands operating on it. */
2717 typedef struct ScriptToken {
2718 int type;
2719 Jim_Obj *objPtr;
2720 int linenr;
2721 } ScriptToken;
2722
2723 /* This is the script object internal representation. An array of
2724 * ScriptToken structures, with an associated command structure array.
2725 * The command structure is a pre-computed representation of the
2726 * command length and arguments structure as a simple liner array
2727 * of integers.
2728 *
2729 * For example the script:
2730 *
2731 * puts hello
2732 * set $i $x$y [foo]BAR
2733 *
2734 * will produce a ScriptObj with the following Tokens:
2735 *
2736 * ESC puts
2737 * SEP
2738 * ESC hello
2739 * EOL
2740 * ESC set
2741 * EOL
2742 * VAR i
2743 * SEP
2744 * VAR x
2745 * VAR y
2746 * SEP
2747 * CMD foo
2748 * ESC BAR
2749 * EOL
2750 *
2751 * This is a description of the tokens, separators, and of lines.
2752 * The command structure instead represents the number of arguments
2753 * of every command, followed by the tokens of which every argument
2754 * is composed. So for the example script, the cmdstruct array will
2755 * contain:
2756 *
2757 * 2 1 1 4 1 1 2 2
2758 *
2759 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2760 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2761 * composed of single tokens (1 1) and the last two of double tokens
2762 * (2 2).
2763 *
2764 * The precomputation of the command structure makes Jim_Eval() faster,
2765 * and simpler because there aren't dynamic lengths / allocations.
2766 *
2767 * -- {expand} handling --
2768 *
2769 * Expand is handled in a special way. When a command
2770 * contains at least an argument with the {expand} prefix,
2771 * the command structure presents a -1 before the integer
2772 * describing the number of arguments. This is used in order
2773 * to send the command exection to a different path in case
2774 * of {expand} and guarantee a fast path for the more common
2775 * case. Also, the integers describing the number of tokens
2776 * are expressed with negative sign, to allow for fast check
2777 * of what's an {expand}-prefixed argument and what not.
2778 *
2779 * For example the command:
2780 *
2781 * list {expand}{1 2}
2782 *
2783 * Will produce the following cmdstruct array:
2784 *
2785 * -1 2 1 -2
2786 *
2787 * -- the substFlags field of the structure --
2788 *
2789 * The scriptObj structure is used to represent both "script" objects
2790 * and "subst" objects. In the second case, the cmdStruct related
2791 * fields are not used at all, but there is an additional field used
2792 * that is 'substFlags': this represents the flags used to turn
2793 * the string into the intenral representation used to perform the
2794 * substitution. If this flags are not what the application requires
2795 * the scriptObj is created again. For example the script:
2796 *
2797 * subst -nocommands $string
2798 * subst -novariables $string
2799 *
2800 * Will recreate the internal representation of the $string object
2801 * two times.
2802 */
2803 typedef struct ScriptObj {
2804 int len; /* Length as number of tokens. */
2805 int commands; /* number of top-level commands in script. */
2806 ScriptToken *token; /* Tokens array. */
2807 int *cmdStruct; /* commands structure */
2808 int csLen; /* length of the cmdStruct array. */
2809 int substFlags; /* flags used for the compilation of "subst" objects */
2810 int inUse; /* Used to share a ScriptObj. Currently
2811 only used by Jim_EvalObj() as protection against
2812 shimmering of the currently evaluated object. */
2813 char *fileName;
2814 } ScriptObj;
2815
2816 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2817 {
2818 int i;
2819 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2820
2821 if (!script)
2822 return;
2823
2824 script->inUse--;
2825 if (script->inUse != 0) return;
2826 for (i = 0; i < script->len; i++) {
2827 if (script->token[i].objPtr != NULL)
2828 Jim_DecrRefCount(interp, script->token[i].objPtr);
2829 }
2830 Jim_Free(script->token);
2831 Jim_Free(script->cmdStruct);
2832 Jim_Free(script->fileName);
2833 Jim_Free(script);
2834 }
2835
2836 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2837 {
2838 JIM_NOTUSED(interp);
2839 JIM_NOTUSED(srcPtr);
2840
2841 /* Just returns an simple string. */
2842 dupPtr->typePtr = NULL;
2843 }
2844
2845 /* Add a new token to the internal repr of a script object */
2846 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2847 char *strtoken, int len, int type, char *filename, int linenr)
2848 {
2849 int prevtype;
2850 struct ScriptToken *token;
2851
2852 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2853 script->token[script->len-1].type;
2854 /* Skip tokens without meaning, like words separators
2855 * following a word separator or an end of command and
2856 * so on. */
2857 if (prevtype == JIM_TT_EOL) {
2858 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2859 Jim_Free(strtoken);
2860 return;
2861 }
2862 } else if (prevtype == JIM_TT_SEP) {
2863 if (type == JIM_TT_SEP) {
2864 Jim_Free(strtoken);
2865 return;
2866 } else if (type == JIM_TT_EOL) {
2867 /* If an EOL is following by a SEP, drop the previous
2868 * separator. */
2869 script->len--;
2870 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2871 }
2872 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2873 type == JIM_TT_ESC && len == 0)
2874 {
2875 /* Don't add empty tokens used in interpolation */
2876 Jim_Free(strtoken);
2877 return;
2878 }
2879 /* Make space for a new istruction */
2880 script->len++;
2881 script->token = Jim_Realloc(script->token,
2882 sizeof(ScriptToken)*script->len);
2883 /* Initialize the new token */
2884 token = script->token + (script->len-1);
2885 token->type = type;
2886 /* Every object is intially as a string, but the
2887 * internal type may be specialized during execution of the
2888 * script. */
2889 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2890 /* To add source info to SEP and EOL tokens is useless because
2891 * they will never by called as arguments of Jim_EvalObj(). */
2892 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2893 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2894 Jim_IncrRefCount(token->objPtr);
2895 token->linenr = linenr;
2896 }
2897
2898 /* Add an integer into the command structure field of the script object. */
2899 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2900 {
2901 script->csLen++;
2902 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2903 sizeof(int)*script->csLen);
2904 script->cmdStruct[script->csLen-1] = val;
2905 }
2906
2907 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2908 * of objPtr. Search nested script objects recursively. */
2909 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2910 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2911 {
2912 int i;
2913
2914 for (i = 0; i < script->len; i++) {
2915 if (script->token[i].objPtr != objPtr &&
2916 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2917 return script->token[i].objPtr;
2918 }
2919 /* Enter recursively on scripts only if the object
2920 * is not the same as the one we are searching for
2921 * shared occurrences. */
2922 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2923 script->token[i].objPtr != objPtr) {
2924 Jim_Obj *foundObjPtr;
2925
2926 ScriptObj *subScript =
2927 script->token[i].objPtr->internalRep.ptr;
2928 /* Don't recursively enter the script we are trying
2929 * to make shared to avoid circular references. */
2930 if (subScript == scriptBarrier) continue;
2931 if (subScript != script) {
2932 foundObjPtr =
2933 ScriptSearchLiteral(interp, subScript,
2934 scriptBarrier, objPtr);
2935 if (foundObjPtr != NULL)
2936 return foundObjPtr;
2937 }
2938 }
2939 }
2940 return NULL;
2941 }
2942
2943 /* Share literals of a script recursively sharing sub-scripts literals. */
2944 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2945 ScriptObj *topLevelScript)
2946 {
2947 int i, j;
2948
2949 return;
2950 /* Try to share with toplevel object. */
2951 if (topLevelScript != NULL) {
2952 for (i = 0; i < script->len; i++) {
2953 Jim_Obj *foundObjPtr;
2954 char *str = script->token[i].objPtr->bytes;
2955
2956 if (script->token[i].objPtr->refCount != 1) continue;
2957 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2958 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2959 foundObjPtr = ScriptSearchLiteral(interp,
2960 topLevelScript,
2961 script, /* barrier */
2962 script->token[i].objPtr);
2963 if (foundObjPtr != NULL) {
2964 Jim_IncrRefCount(foundObjPtr);
2965 Jim_DecrRefCount(interp,
2966 script->token[i].objPtr);
2967 script->token[i].objPtr = foundObjPtr;
2968 }
2969 }
2970 }
2971 /* Try to share locally */
2972 for (i = 0; i < script->len; i++) {
2973 char *str = script->token[i].objPtr->bytes;
2974
2975 if (script->token[i].objPtr->refCount != 1) continue;
2976 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2977 for (j = 0; j < script->len; j++) {
2978 if (script->token[i].objPtr !=
2979 script->token[j].objPtr &&
2980 Jim_StringEqObj(script->token[i].objPtr,
2981 script->token[j].objPtr, 0))
2982 {
2983 Jim_IncrRefCount(script->token[j].objPtr);
2984 Jim_DecrRefCount(interp,
2985 script->token[i].objPtr);
2986 script->token[i].objPtr =
2987 script->token[j].objPtr;
2988 }
2989 }
2990 }
2991 }
2992
2993 /* This method takes the string representation of an object
2994 * as a Tcl script, and generates the pre-parsed internal representation
2995 * of the script. */
2996 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2997 {
2998 int scriptTextLen;
2999 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3000 struct JimParserCtx parser;
3001 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3002 ScriptToken *token;
3003 int args, tokens, start, end, i;
3004 int initialLineNumber;
3005 int propagateSourceInfo = 0;
3006
3007 script->len = 0;
3008 script->csLen = 0;
3009 script->commands = 0;
3010 script->token = NULL;
3011 script->cmdStruct = NULL;
3012 script->inUse = 1;
3013 /* Try to get information about filename / line number */
3014 if (objPtr->typePtr == &sourceObjType) {
3015 script->fileName =
3016 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3017 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3018 propagateSourceInfo = 1;
3019 } else {
3020 script->fileName = Jim_StrDup("");
3021 initialLineNumber = 1;
3022 }
3023
3024 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3025 while (!JimParserEof(&parser)) {
3026 char *token_t;
3027 int len, type, linenr;
3028
3029 JimParseScript(&parser);
3030 token_t = JimParserGetToken(&parser, &len, &type, &linenr);
3031 ScriptObjAddToken(interp, script, token_t, len, type,
3032 propagateSourceInfo ? script->fileName : NULL,
3033 linenr);
3034 }
3035 token = script->token;
3036
3037 /* Compute the command structure array
3038 * (see the ScriptObj struct definition for more info) */
3039 start = 0; /* Current command start token index */
3040 end = -1; /* Current command end token index */
3041 while (1) {
3042 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3043 int interpolation = 0; /* set to 1 if there is at least one
3044 argument of the command obtained via
3045 interpolation of more tokens. */
3046 /* Search for the end of command, while
3047 * count the number of args. */
3048 start = ++end;
3049 if (start >= script->len) break;
3050 args = 1; /* Number of args in current command */
3051 while (token[end].type != JIM_TT_EOL) {
3052 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3053 token[end-1].type == JIM_TT_EOL)
3054 {
3055 if (token[end].type == JIM_TT_STR &&
3056 token[end + 1].type != JIM_TT_SEP &&
3057 token[end + 1].type != JIM_TT_EOL &&
3058 (!strcmp(token[end].objPtr->bytes, "expand") ||
3059 !strcmp(token[end].objPtr->bytes, "*")))
3060 expand++;
3061 }
3062 if (token[end].type == JIM_TT_SEP)
3063 args++;
3064 end++;
3065 }
3066 interpolation = !((end-start + 1) == args*2);
3067 /* Add the 'number of arguments' info into cmdstruct.
3068 * Negative value if there is list expansion involved. */
3069 if (expand)
3070 ScriptObjAddInt(script, -1);
3071 ScriptObjAddInt(script, args);
3072 /* Now add info about the number of tokens. */
3073 tokens = 0; /* Number of tokens in current argument. */
3074 expand = 0;
3075 for (i = start; i <= end; i++) {
3076 if (token[i].type == JIM_TT_SEP ||
3077 token[i].type == JIM_TT_EOL)
3078 {
3079 if (tokens == 1 && expand)
3080 expand = 0;
3081 ScriptObjAddInt(script,
3082 expand ? -tokens : tokens);
3083
3084 expand = 0;
3085 tokens = 0;
3086 continue;
3087 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3088 (!strcmp(token[i].objPtr->bytes, "expand") ||
3089 !strcmp(token[i].objPtr->bytes, "*")))
3090 {
3091 expand++;
3092 }
3093 tokens++;
3094 }
3095 }
3096 /* Perform literal sharing, but only for objects that appear
3097 * to be scripts written as literals inside the source code,
3098 * and not computed at runtime. Literal sharing is a costly
3099 * operation that should be done only against objects that
3100 * are likely to require compilation only the first time, and
3101 * then are executed multiple times. */
3102 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3103 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3104 if (bodyObjPtr->typePtr == &scriptObjType) {
3105 ScriptObj *bodyScript =
3106 bodyObjPtr->internalRep.ptr;
3107 ScriptShareLiterals(interp, script, bodyScript);
3108 }
3109 } else if (propagateSourceInfo) {
3110 ScriptShareLiterals(interp, script, NULL);
3111 }
3112 /* Free the old internal rep and set the new one. */
3113 Jim_FreeIntRep(interp, objPtr);
3114 Jim_SetIntRepPtr(objPtr, script);
3115 objPtr->typePtr = &scriptObjType;
3116 return JIM_OK;
3117 }
3118
3119 static ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3120 {
3121 if (objPtr->typePtr != &scriptObjType) {
3122 SetScriptFromAny(interp, objPtr);
3123 }
3124 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3125 }
3126
3127 /* -----------------------------------------------------------------------------
3128 * Commands
3129 * ---------------------------------------------------------------------------*/
3130
3131 /* Commands HashTable Type.
3132 *
3133 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3134 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3135 {
3136 Jim_Cmd *cmdPtr = (void*) val;
3137
3138 if (cmdPtr->cmdProc == NULL) {
3139 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3140 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3141 if (cmdPtr->staticVars) {
3142 Jim_FreeHashTable(cmdPtr->staticVars);
3143 Jim_Free(cmdPtr->staticVars);
3144 }
3145 } else if (cmdPtr->delProc != NULL) {
3146 /* If it was a C coded command, call the delProc if any */
3147 cmdPtr->delProc(interp, cmdPtr->privData);
3148 }
3149 Jim_Free(val);
3150 }
3151
3152 static Jim_HashTableType JimCommandsHashTableType = {
3153 JimStringCopyHTHashFunction, /* hash function */
3154 JimStringCopyHTKeyDup, /* key dup */
3155 NULL, /* val dup */
3156 JimStringCopyHTKeyCompare, /* key compare */
3157 JimStringCopyHTKeyDestructor, /* key destructor */
3158 Jim_CommandsHT_ValDestructor /* val destructor */
3159 };
3160
3161 /* ------------------------- Commands related functions --------------------- */
3162
3163 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3164 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3165 {
3166 Jim_HashEntry *he;
3167 Jim_Cmd *cmdPtr;
3168
3169 he = Jim_FindHashEntry(&interp->commands, cmdName);
3170 if (he == NULL) { /* New command to create */
3171 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3172 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3173 } else {
3174 Jim_InterpIncrProcEpoch(interp);
3175 /* Free the arglist/body objects if it was a Tcl procedure */
3176 cmdPtr = he->val;
3177 if (cmdPtr->cmdProc == NULL) {
3178 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3179 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3180 if (cmdPtr->staticVars) {
3181 Jim_FreeHashTable(cmdPtr->staticVars);
3182 Jim_Free(cmdPtr->staticVars);
3183 }
3184 cmdPtr->staticVars = NULL;
3185 } else if (cmdPtr->delProc != NULL) {
3186 /* If it was a C coded command, call the delProc if any */
3187 cmdPtr->delProc(interp, cmdPtr->privData);
3188 }
3189 }
3190
3191 /* Store the new details for this proc */
3192 cmdPtr->delProc = delProc;
3193 cmdPtr->cmdProc = cmdProc;
3194 cmdPtr->privData = privData;
3195
3196 /* There is no need to increment the 'proc epoch' because
3197 * creation of a new procedure can never affect existing
3198 * cached commands. We don't do negative caching. */
3199 return JIM_OK;
3200 }
3201
3202 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3203 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3204 int arityMin, int arityMax)
3205 {
3206 Jim_Cmd *cmdPtr;
3207
3208 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3209 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3210 cmdPtr->argListObjPtr = argListObjPtr;
3211 cmdPtr->bodyObjPtr = bodyObjPtr;
3212 Jim_IncrRefCount(argListObjPtr);
3213 Jim_IncrRefCount(bodyObjPtr);
3214 cmdPtr->arityMin = arityMin;
3215 cmdPtr->arityMax = arityMax;
3216 cmdPtr->staticVars = NULL;
3217
3218 /* Create the statics hash table. */
3219 if (staticsListObjPtr) {
3220 int len, i;
3221
3222 Jim_ListLength(interp, staticsListObjPtr, &len);
3223 if (len != 0) {
3224 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3225 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3226 interp);
3227 for (i = 0; i < len; i++) {
3228 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3229 Jim_Var *varPtr;
3230 int subLen;
3231
3232 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3233 /* Check if it's composed of two elements. */
3234 Jim_ListLength(interp, objPtr, &subLen);
3235 if (subLen == 1 || subLen == 2) {
3236 /* Try to get the variable value from the current
3237 * environment. */
3238 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3239 if (subLen == 1) {
3240 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3241 JIM_NONE);
3242 if (initObjPtr == NULL) {
3243 Jim_SetResult(interp,
3244 Jim_NewEmptyStringObj(interp));
3245 Jim_AppendStrings(interp, Jim_GetResult(interp),
3246 "variable for initialization of static \"",
3247 Jim_GetString(nameObjPtr, NULL),
3248 "\" not found in the local context",
3249 NULL);
3250 goto err;
3251 }
3252 } else {
3253 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3254 }
3255 varPtr = Jim_Alloc(sizeof(*varPtr));
3256 varPtr->objPtr = initObjPtr;
3257 Jim_IncrRefCount(initObjPtr);
3258 varPtr->linkFramePtr = NULL;
3259 if (Jim_AddHashEntry(cmdPtr->staticVars,
3260 Jim_GetString(nameObjPtr, NULL),
3261 varPtr) != JIM_OK)
3262 {
3263 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3264 Jim_AppendStrings(interp, Jim_GetResult(interp),
3265 "static variable name \"",
3266 Jim_GetString(objPtr, NULL), "\"",
3267 " duplicated in statics list", NULL);
3268 Jim_DecrRefCount(interp, initObjPtr);
3269 Jim_Free(varPtr);
3270 goto err;
3271 }
3272 } else {
3273 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274 Jim_AppendStrings(interp, Jim_GetResult(interp),
3275 "too many fields in static specifier \"",
3276 objPtr, "\"", NULL);
3277 goto err;
3278 }
3279 }
3280 }
3281 }
3282
3283 /* Add the new command */
3284
3285 /* it may already exist, so we try to delete the old one */
3286 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3287 /* There was an old procedure with the same name, this requires
3288 * a 'proc epoch' update. */
3289 Jim_InterpIncrProcEpoch(interp);
3290 }
3291 /* If a procedure with the same name didn't existed there is no need
3292 * to increment the 'proc epoch' because creation of a new procedure
3293 * can never affect existing cached commands. We don't do
3294 * negative caching. */
3295 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3296 return JIM_OK;
3297
3298 err:
3299 Jim_FreeHashTable(cmdPtr->staticVars);
3300 Jim_Free(cmdPtr->staticVars);
3301 Jim_DecrRefCount(interp, argListObjPtr);
3302 Jim_DecrRefCount(interp, bodyObjPtr);
3303 Jim_Free(cmdPtr);
3304 return JIM_ERR;
3305 }
3306
3307 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3308 {
3309 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3310 return JIM_ERR;
3311 Jim_InterpIncrProcEpoch(interp);
3312 return JIM_OK;
3313 }
3314
3315 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3316 const char *newName)
3317 {
3318 Jim_Cmd *cmdPtr;
3319 Jim_HashEntry *he;
3320 Jim_Cmd *copyCmdPtr;
3321
3322 if (newName[0] == '\0') /* Delete! */
3323 return Jim_DeleteCommand(interp, oldName);
3324 /* Rename */
3325 he = Jim_FindHashEntry(&interp->commands, oldName);
3326 if (he == NULL)
3327 return JIM_ERR; /* Invalid command name */
3328 cmdPtr = he->val;
3329 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3330 *copyCmdPtr = *cmdPtr;
3331 /* In order to avoid that a procedure will get arglist/body/statics
3332 * freed by the hash table methods, fake a C-coded command
3333 * setting cmdPtr->cmdProc as not NULL */
3334 cmdPtr->cmdProc = (void*)1;
3335 /* Also make sure delProc is NULL. */
3336 cmdPtr->delProc = NULL;
3337 /* Destroy the old command, and make sure the new is freed
3338 * as well. */
3339 Jim_DeleteHashEntry(&interp->commands, oldName);
3340 Jim_DeleteHashEntry(&interp->commands, newName);
3341 /* Now the new command. We are sure it can't fail because
3342 * the target name was already freed. */
3343 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3344 /* Increment the epoch */
3345 Jim_InterpIncrProcEpoch(interp);
3346 return JIM_OK;
3347 }
3348
3349 /* -----------------------------------------------------------------------------
3350 * Command object
3351 * ---------------------------------------------------------------------------*/
3352
3353 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3354
3355 static Jim_ObjType commandObjType = {
3356 "command",
3357 NULL,
3358 NULL,
3359 NULL,
3360 JIM_TYPE_REFERENCES,
3361 };
3362
3363 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3364 {
3365 Jim_HashEntry *he;
3366 const char *cmdName;
3367
3368 /* Get the string representation */
3369 cmdName = Jim_GetString(objPtr, NULL);
3370 /* Lookup this name into the commands hash table */
3371 he = Jim_FindHashEntry(&interp->commands, cmdName);
3372 if (he == NULL)
3373 return JIM_ERR;
3374
3375 /* Free the old internal repr and set the new one. */
3376 Jim_FreeIntRep(interp, objPtr);
3377 objPtr->typePtr = &commandObjType;
3378 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3379 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3380 return JIM_OK;
3381 }
3382
3383 /* This function returns the command structure for the command name
3384 * stored in objPtr. It tries to specialize the objPtr to contain
3385 * a cached info instead to perform the lookup into the hash table
3386 * every time. The information cached may not be uptodate, in such
3387 * a case the lookup is performed and the cache updated. */
3388 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3389 {
3390 if ((objPtr->typePtr != &commandObjType ||
3391 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3392 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3393 if (flags & JIM_ERRMSG) {
3394 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3395 Jim_AppendStrings(interp, Jim_GetResult(interp),
3396 "invalid command name \"", objPtr->bytes, "\"",
3397 NULL);
3398 }
3399 return NULL;
3400 }
3401 return objPtr->internalRep.cmdValue.cmdPtr;
3402 }
3403
3404 /* -----------------------------------------------------------------------------
3405 * Variables
3406 * ---------------------------------------------------------------------------*/
3407
3408 /* Variables HashTable Type.
3409 *
3410 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3411 static void JimVariablesHTValDestructor(void *interp, void *val)
3412 {
3413 Jim_Var *varPtr = (void*) val;
3414
3415 Jim_DecrRefCount(interp, varPtr->objPtr);
3416 Jim_Free(val);
3417 }
3418
3419 static Jim_HashTableType JimVariablesHashTableType = {
3420 JimStringCopyHTHashFunction, /* hash function */
3421 JimStringCopyHTKeyDup, /* key dup */
3422 NULL, /* val dup */
3423 JimStringCopyHTKeyCompare, /* key compare */
3424 JimStringCopyHTKeyDestructor, /* key destructor */
3425 JimVariablesHTValDestructor /* val destructor */
3426 };
3427
3428 static Jim_HashTableType *getJimVariablesHashTableType(void)
3429 {
3430 return &JimVariablesHashTableType;
3431 }
3432
3433 /* -----------------------------------------------------------------------------
3434 * Variable object
3435 * ---------------------------------------------------------------------------*/
3436
3437 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3438
3439 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3440
3441 static Jim_ObjType variableObjType = {
3442 "variable",
3443 NULL,
3444 NULL,
3445 NULL,
3446 JIM_TYPE_REFERENCES,
3447 };
3448
3449 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3450 * is in the form "varname(key)". */
3451 static int Jim_NameIsDictSugar(const char *str, int len)
3452 {
3453 if (len == -1)
3454 len = strlen(str);
3455 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3456 return 1;
3457 return 0;
3458 }
3459
3460 /* This method should be called only by the variable API.
3461 * It returns JIM_OK on success (variable already exists),
3462 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3463 * a variable name, but syntax glue for [dict] i.e. the last
3464 * character is ')' */
3465 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3466 {
3467 Jim_HashEntry *he;
3468 const char *varName;
3469 int len;
3470
3471 /* Check if the object is already an uptodate variable */
3472 if (objPtr->typePtr == &variableObjType &&
3473 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3474 return JIM_OK; /* nothing to do */
3475 /* Get the string representation */
3476 varName = Jim_GetString(objPtr, &len);
3477 /* Make sure it's not syntax glue to get/set dict. */
3478 if (Jim_NameIsDictSugar(varName, len))
3479 return JIM_DICT_SUGAR;
3480 if (varName[0] == ':' && varName[1] == ':') {
3481 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3482 if (he == NULL) {
3483 return JIM_ERR;
3484 }
3485 }
3486 else {
3487 /* Lookup this name into the variables hash table */
3488 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3489 if (he == NULL) {
3490 /* Try with static vars. */
3491 if (interp->framePtr->staticVars == NULL)
3492 return JIM_ERR;
3493 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3494 return JIM_ERR;
3495 }
3496 }
3497 /* Free the old internal repr and set the new one. */
3498 Jim_FreeIntRep(interp, objPtr);
3499 objPtr->typePtr = &variableObjType;
3500 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3501 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3502 return JIM_OK;
3503 }
3504
3505 /* -------------------- Variables related functions ------------------------- */
3506 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3507 Jim_Obj *valObjPtr);
3508 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3509
3510 /* For now that's dummy. Variables lookup should be optimized
3511 * in many ways, with caching of lookups, and possibly with
3512 * a table of pre-allocated vars in every CallFrame for local vars.
3513 * All the caching should also have an 'epoch' mechanism similar
3514 * to the one used by Tcl for procedures lookup caching. */
3515
3516 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3517 {
3518 const char *name;
3519 Jim_Var *var;
3520 int err;
3521
3522 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3523 /* Check for [dict] syntax sugar. */
3524 if (err == JIM_DICT_SUGAR)
3525 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3526 /* New variable to create */
3527 name = Jim_GetString(nameObjPtr, NULL);
3528
3529 var = Jim_Alloc(sizeof(*var));
3530 var->objPtr = valObjPtr;
3531 Jim_IncrRefCount(valObjPtr);
3532 var->linkFramePtr = NULL;
3533 /* Insert the new variable */
3534 if (name[0] == ':' && name[1] == ':') {
3535 /* Into to the top evel frame */
3536 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3537 }
3538 else {
3539 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3540 }
3541 /* Make the object int rep a variable */
3542 Jim_FreeIntRep(interp, nameObjPtr);
3543 nameObjPtr->typePtr = &variableObjType;
3544 nameObjPtr->internalRep.varValue.callFrameId =
3545 interp->framePtr->id;
3546 nameObjPtr->internalRep.varValue.varPtr = var;
3547 } else {
3548 var = nameObjPtr->internalRep.varValue.varPtr;
3549 if (var->linkFramePtr == NULL) {
3550 Jim_IncrRefCount(valObjPtr);
3551 Jim_DecrRefCount(interp, var->objPtr);
3552 var->objPtr = valObjPtr;
3553 } else { /* Else handle the link */
3554 Jim_CallFrame *savedCallFrame;
3555
3556 savedCallFrame = interp->framePtr;
3557 interp->framePtr = var->linkFramePtr;
3558 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3559 interp->framePtr = savedCallFrame;
3560 if (err != JIM_OK)
3561 return err;
3562 }
3563 }
3564 return JIM_OK;
3565 }
3566
3567 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3568 {
3569 Jim_Obj *nameObjPtr;
3570 int result;
3571
3572 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3573 Jim_IncrRefCount(nameObjPtr);
3574 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3575 Jim_DecrRefCount(interp, nameObjPtr);
3576 return result;
3577 }
3578
3579 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3580 {
3581 Jim_CallFrame *savedFramePtr;
3582 int result;
3583
3584 savedFramePtr = interp->framePtr;
3585 interp->framePtr = interp->topFramePtr;
3586 result = Jim_SetVariableStr(interp, name, objPtr);
3587 interp->framePtr = savedFramePtr;
3588 return result;
3589 }
3590
3591 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3592 {
3593 Jim_Obj *nameObjPtr, *valObjPtr;
3594 int result;
3595
3596 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3597 valObjPtr = Jim_NewStringObj(interp, val, -1);
3598 Jim_IncrRefCount(nameObjPtr);
3599 Jim_IncrRefCount(valObjPtr);
3600 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3601 Jim_DecrRefCount(interp, nameObjPtr);
3602 Jim_DecrRefCount(interp, valObjPtr);
3603 return result;
3604 }
3605
3606 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3607 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3608 {
3609 const char *varName;
3610 int len;
3611
3612 /* Check for cycles. */
3613 if (interp->framePtr == targetCallFrame) {
3614 Jim_Obj *objPtr = targetNameObjPtr;
3615 Jim_Var *varPtr;
3616 /* Cycles are only possible with 'uplevel 0' */
3617 while (1) {
3618 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3619 Jim_SetResultString(interp,
3620 "can't upvar from variable to itself", -1);
3621 return JIM_ERR;
3622 }
3623 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3624 break;
3625 varPtr = objPtr->internalRep.varValue.varPtr;
3626 if (varPtr->linkFramePtr != targetCallFrame) break;
3627 objPtr = varPtr->objPtr;
3628 }
3629 }
3630 varName = Jim_GetString(nameObjPtr, &len);
3631 if (Jim_NameIsDictSugar(varName, len)) {
3632 Jim_SetResultString(interp,
3633 "Dict key syntax invalid as link source", -1);
3634 return JIM_ERR;
3635 }
3636 /* Perform the binding */
3637 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3638 /* We are now sure 'nameObjPtr' type is variableObjType */
3639 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3640 return JIM_OK;
3641 }
3642
3643 /* Return the Jim_Obj pointer associated with a variable name,
3644 * or NULL if the variable was not found in the current context.
3645 * The same optimization discussed in the comment to the
3646 * 'SetVariable' function should apply here. */
3647 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3648 {
3649 int err;
3650
3651 /* All the rest is handled here */
3652 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3653 /* Check for [dict] syntax sugar. */
3654 if (err == JIM_DICT_SUGAR)
3655 return JimDictSugarGet(interp, nameObjPtr);
3656 if (flags & JIM_ERRMSG) {
3657 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3658 Jim_AppendStrings(interp, Jim_GetResult(interp),
3659 "can't read \"", nameObjPtr->bytes,
3660 "\": no such variable", NULL);
3661 }
3662 return NULL;
3663 } else {
3664 Jim_Var *varPtr;
3665 Jim_Obj *objPtr;
3666 Jim_CallFrame *savedCallFrame;
3667
3668 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3669 if (varPtr->linkFramePtr == NULL)
3670 return varPtr->objPtr;
3671 /* The variable is a link? Resolve it. */
3672 savedCallFrame = interp->framePtr;
3673 interp->framePtr = varPtr->linkFramePtr;
3674 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3675 if (objPtr == NULL && flags & JIM_ERRMSG) {
3676 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3677 Jim_AppendStrings(interp, Jim_GetResult(interp),
3678 "can't read \"", nameObjPtr->bytes,
3679 "\": no such variable", NULL);
3680 }
3681 interp->framePtr = savedCallFrame;
3682 return objPtr;
3683 }
3684 }
3685
3686 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3687 int flags)
3688 {
3689 Jim_CallFrame *savedFramePtr;
3690 Jim_Obj *objPtr;
3691
3692 savedFramePtr = interp->framePtr;
3693 interp->framePtr = interp->topFramePtr;
3694 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3695 interp->framePtr = savedFramePtr;
3696
3697 return objPtr;
3698 }
3699
3700 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3701 {
3702 Jim_Obj *nameObjPtr, *varObjPtr;
3703
3704 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3705 Jim_IncrRefCount(nameObjPtr);
3706 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3707 Jim_DecrRefCount(interp, nameObjPtr);
3708 return varObjPtr;
3709 }
3710
3711 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3712 int flags)
3713 {
3714 Jim_CallFrame *savedFramePtr;
3715 Jim_Obj *objPtr;
3716
3717 savedFramePtr = interp->framePtr;
3718 interp->framePtr = interp->topFramePtr;
3719 objPtr = Jim_GetVariableStr(interp, name, flags);
3720 interp->framePtr = savedFramePtr;
3721
3722 return objPtr;
3723 }
3724
3725 /* Unset a variable.
3726 * Note: On success unset invalidates all the variable objects created
3727 * in the current call frame incrementing. */
3728 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3729 {
3730 const char *name;
3731 Jim_Var *varPtr;
3732 int err;
3733
3734 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3735 /* Check for [dict] syntax sugar. */
3736 if (err == JIM_DICT_SUGAR)
3737 return JimDictSugarSet(interp, nameObjPtr, NULL);
3738 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3739 Jim_AppendStrings(interp, Jim_GetResult(interp),
3740 "can't unset \"", nameObjPtr->bytes,
3741 "\": no such variable", NULL);
3742 return JIM_ERR; /* var not found */
3743 }
3744 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3745 /* If it's a link call UnsetVariable recursively */
3746 if (varPtr->linkFramePtr) {
3747 int retval;
3748
3749 Jim_CallFrame *savedCallFrame;
3750
3751 savedCallFrame = interp->framePtr;
3752 interp->framePtr = varPtr->linkFramePtr;
3753 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3754 interp->framePtr = savedCallFrame;
3755 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3756 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3757 Jim_AppendStrings(interp, Jim_GetResult(interp),
3758 "can't unset \"", nameObjPtr->bytes,
3759 "\": no such variable", NULL);
3760 }
3761 return retval;
3762 } else {
3763 name = Jim_GetString(nameObjPtr, NULL);
3764 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3765 != JIM_OK) return JIM_ERR;
3766 /* Change the callframe id, invalidating var lookup caching */
3767 JimChangeCallFrameId(interp, interp->framePtr);
3768 return JIM_OK;
3769 }
3770 }
3771
3772 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3773
3774 /* Given a variable name for [dict] operation syntax sugar,
3775 * this function returns two objects, the first with the name
3776 * of the variable to set, and the second with the rispective key.
3777 * For example "foo(bar)" will return objects with string repr. of
3778 * "foo" and "bar".
3779 *
3780 * The returned objects have refcount = 1. The function can't fail. */
3781 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3782 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3783 {
3784 const char *str, *p;
3785 char *t;
3786 int len, keyLen, nameLen;
3787 Jim_Obj *varObjPtr, *keyObjPtr;
3788
3789 str = Jim_GetString(objPtr, &len);
3790 p = strchr(str, '(');
3791 p++;
3792 keyLen = len-((p-str) + 1);
3793 nameLen = (p-str)-1;
3794 /* Create the objects with the variable name and key. */
3795 t = Jim_Alloc(nameLen + 1);
3796 memcpy(t, str, nameLen);
3797 t[nameLen] = '\0';
3798 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3799
3800 t = Jim_Alloc(keyLen + 1);
3801 memcpy(t, p, keyLen);
3802 t[keyLen] = '\0';
3803 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3804
3805 Jim_IncrRefCount(varObjPtr);
3806 Jim_IncrRefCount(keyObjPtr);
3807 *varPtrPtr = varObjPtr;
3808 *keyPtrPtr = keyObjPtr;
3809 }
3810
3811 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3812 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3813 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3814 Jim_Obj *valObjPtr)
3815 {
3816 Jim_Obj *varObjPtr, *keyObjPtr;
3817 int err = JIM_OK;
3818
3819 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3820 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3821 valObjPtr);
3822 Jim_DecrRefCount(interp, varObjPtr);
3823 Jim_DecrRefCount(interp, keyObjPtr);
3824 return err;
3825 }
3826
3827 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3828 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3829 {
3830 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3831
3832 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3833 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3834 if (!dictObjPtr) {
3835 resObjPtr = NULL;
3836 goto err;
3837 }
3838 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3839 != JIM_OK) {
3840 resObjPtr = NULL;
3841 }
3842 err:
3843 Jim_DecrRefCount(interp, varObjPtr);
3844 Jim_DecrRefCount(interp, keyObjPtr);
3845 return resObjPtr;
3846 }
3847
3848 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3849
3850 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3851 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3852 Jim_Obj *dupPtr);
3853
3854 static Jim_ObjType dictSubstObjType = {
3855 "dict-substitution",
3856 FreeDictSubstInternalRep,
3857 DupDictSubstInternalRep,
3858 NULL,
3859 JIM_TYPE_NONE,
3860 };
3861
3862 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3863 {
3864 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3865 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3866 }
3867
3868 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3869 Jim_Obj *dupPtr)
3870 {
3871 JIM_NOTUSED(interp);
3872
3873 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3874 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3875 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3876 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3877 dupPtr->typePtr = &dictSubstObjType;
3878 }
3879
3880 /* This function is used to expand [dict get] sugar in the form
3881 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3882 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3883 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3884 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3885 * the [dict]ionary contained in variable VARNAME. */
3886 static Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3887 {
3888 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3889 Jim_Obj *substKeyObjPtr = NULL;
3890
3891 if (objPtr->typePtr != &dictSubstObjType) {
3892 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3893 Jim_FreeIntRep(interp, objPtr);
3894 objPtr->typePtr = &dictSubstObjType;
3895 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3896 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3897 }
3898 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3899 &substKeyObjPtr, JIM_NONE)
3900 != JIM_OK) {
3901 substKeyObjPtr = NULL;
3902 goto err;
3903 }
3904 Jim_IncrRefCount(substKeyObjPtr);
3905 dictObjPtr = Jim_GetVariable(interp,
3906 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3907 if (!dictObjPtr) {
3908 resObjPtr = NULL;
3909 goto err;
3910 }
3911 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3912 != JIM_OK) {
3913 resObjPtr = NULL;
3914 goto err;
3915 }
3916 err:
3917 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3918 return resObjPtr;
3919 }
3920
3921 /* -----------------------------------------------------------------------------
3922 * CallFrame
3923 * ---------------------------------------------------------------------------*/
3924
3925 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3926 {
3927 Jim_CallFrame *cf;
3928 if (interp->freeFramesList) {
3929 cf = interp->freeFramesList;
3930 interp->freeFramesList = cf->nextFramePtr;
3931 } else {
3932 cf = Jim_Alloc(sizeof(*cf));
3933 cf->vars.table = NULL;
3934 }
3935
3936 cf->id = interp->callFrameEpoch++;
3937 cf->parentCallFrame = NULL;
3938 cf->argv = NULL;
3939 cf->argc = 0;
3940 cf->procArgsObjPtr = NULL;
3941 cf->procBodyObjPtr = NULL;
3942 cf->nextFramePtr = NULL;
3943 cf->staticVars = NULL;
3944 if (cf->vars.table == NULL)
3945 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3946 return cf;
3947 }
3948
3949 /* Used to invalidate every caching related to callframe stability. */
3950 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3951 {
3952 cf->id = interp->callFrameEpoch++;
3953 }
3954
3955 #define JIM_FCF_NONE 0 /* no flags */
3956 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3957 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3958 int flags)
3959 {
3960 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3961 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3962 if (!(flags & JIM_FCF_NOHT))
3963 Jim_FreeHashTable(&cf->vars);
3964 else {
3965 int i;
3966 Jim_HashEntry **table = cf->vars.table, *he;
3967
3968 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3969 he = table[i];
3970 while (he != NULL) {
3971 Jim_HashEntry *nextEntry = he->next;
3972 Jim_Var *varPtr = (void*) he->val;
3973
3974 Jim_DecrRefCount(interp, varPtr->objPtr);
3975 Jim_Free(he->val);
3976 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3977 Jim_Free(he);
3978 table[i] = NULL;
3979 he = nextEntry;
3980 }
3981 }
3982 cf->vars.used = 0;
3983 }
3984 cf->nextFramePtr = interp->freeFramesList;
3985 interp->freeFramesList = cf;
3986 }
3987
3988 /* -----------------------------------------------------------------------------
3989 * References
3990 * ---------------------------------------------------------------------------*/
3991
3992 /* References HashTable Type.
3993 *
3994 * Keys are jim_wide integers, dynamically allocated for now but in the
3995 * future it's worth to cache this 8 bytes objects. Values are poitners
3996 * to Jim_References. */
3997 static void JimReferencesHTValDestructor(void *interp, void *val)
3998 {
3999 Jim_Reference *refPtr = (void*) val;
4000
4001 Jim_DecrRefCount(interp, refPtr->objPtr);
4002 if (refPtr->finalizerCmdNamePtr != NULL) {
4003 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4004 }
4005 Jim_Free(val);
4006 }
4007
4008 static unsigned int JimReferencesHTHashFunction(const void *key)
4009 {
4010 /* Only the least significant bits are used. */
4011 const jim_wide *widePtr = key;
4012 unsigned int intValue = (unsigned int) *widePtr;
4013 return Jim_IntHashFunction(intValue);
4014 }
4015
4016 static const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4017 {
4018 void *copy = Jim_Alloc(sizeof(jim_wide));
4019 JIM_NOTUSED(privdata);
4020
4021 memcpy(copy, key, sizeof(jim_wide));
4022 return copy;
4023 }
4024
4025 static int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4026 const void *key2)
4027 {
4028 JIM_NOTUSED(privdata);
4029
4030 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4031 }
4032
4033 static void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4034 {
4035 JIM_NOTUSED(privdata);
4036
4037 Jim_Free((void*)key);
4038 }
4039
4040 static Jim_HashTableType JimReferencesHashTableType = {
4041 JimReferencesHTHashFunction, /* hash function */
4042 JimReferencesHTKeyDup, /* key dup */
4043 NULL, /* val dup */
4044 JimReferencesHTKeyCompare, /* key compare */
4045 JimReferencesHTKeyDestructor, /* key destructor */
4046 JimReferencesHTValDestructor /* val destructor */
4047 };
4048
4049 /* -----------------------------------------------------------------------------
4050 * Reference object type and References API
4051 * ---------------------------------------------------------------------------*/
4052
4053 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4054
4055 static Jim_ObjType referenceObjType = {
4056 "reference",
4057 NULL,
4058 NULL,
4059 UpdateStringOfReference,
4060 JIM_TYPE_REFERENCES,
4061 };
4062
4063 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4064 {
4065 int len;
4066 char buf[JIM_REFERENCE_SPACE + 1];
4067 Jim_Reference *refPtr;
4068
4069 refPtr = objPtr->internalRep.refValue.refPtr;
4070 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4071 objPtr->bytes = Jim_Alloc(len + 1);
4072 memcpy(objPtr->bytes, buf, len + 1);
4073 objPtr->length = len;
4074 }
4075
4076 /* returns true if 'c' is a valid reference tag character.
4077 * i.e. inside the range [_a-zA-Z0-9] */
4078 static int isrefchar(int c)
4079 {
4080 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4081 (c >= '0' && c <= '9')) return 1;
4082 return 0;
4083 }
4084
4085 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4086 {
4087 jim_wide wideValue;
4088 int i, len;
4089 const char *str, *start, *end;
4090 char refId[21];
4091 Jim_Reference *refPtr;
4092 Jim_HashEntry *he;
4093
4094 /* Get the string representation */
4095 str = Jim_GetString(objPtr, &len);
4096 /* Check if it looks like a reference */
4097 if (len < JIM_REFERENCE_SPACE) goto badformat;
4098 /* Trim spaces */
4099 start = str;
4100 end = str + len-1;
4101 while (*start == ' ') start++;
4102 while (*end == ' ' && end > start) end--;
4103 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4104 /* <reference.<1234567>.%020> */
4105 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4106 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4107 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4108 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4109 if (!isrefchar(start[12 + i])) goto badformat;
4110 }
4111 /* Extract info from the refernece. */
4112 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4113 refId[20] = '\0';
4114 /* Try to convert the ID into a jim_wide */
4115 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4116 /* Check if the reference really exists! */
4117 he = Jim_FindHashEntry(&interp->references, &wideValue);
4118 if (he == NULL) {
4119 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4120 Jim_AppendStrings(interp, Jim_GetResult(interp),
4121 "Invalid reference ID \"", str, "\"", NULL);
4122 return JIM_ERR;
4123 }
4124 refPtr = he->val;
4125 /* Free the old internal repr and set the new one. */
4126 Jim_FreeIntRep(interp, objPtr);
4127 objPtr->typePtr = &referenceObjType;
4128 objPtr->internalRep.refValue.id = wideValue;
4129 objPtr->internalRep.refValue.refPtr = refPtr;
4130 return JIM_OK;
4131
4132 badformat:
4133 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4134 Jim_AppendStrings(interp, Jim_GetResult(interp),
4135 "expected reference but got \"", str, "\"", NULL);
4136 return JIM_ERR;
4137 }
4138
4139 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4140 * as finalizer command (or NULL if there is no finalizer).
4141 * The returned reference object has refcount = 0. */
4142 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4143 Jim_Obj *cmdNamePtr)
4144 {
4145 struct Jim_Reference *refPtr;
4146 jim_wide wideValue = interp->referenceNextId;
4147 Jim_Obj *refObjPtr;
4148 const char *tag;
4149 int tagLen, i;
4150
4151 /* Perform the Garbage Collection if needed. */
4152 Jim_CollectIfNeeded(interp);
4153
4154 refPtr = Jim_Alloc(sizeof(*refPtr));
4155 refPtr->objPtr = objPtr;
4156 Jim_IncrRefCount(objPtr);
4157 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4158 if (cmdNamePtr)
4159 Jim_IncrRefCount(cmdNamePtr);
4160 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4161 refObjPtr = Jim_NewObj(interp);
4162 refObjPtr->typePtr = &referenceObjType;
4163 refObjPtr->bytes = NULL;
4164 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4165 refObjPtr->internalRep.refValue.refPtr = refPtr;
4166 interp->referenceNextId++;
4167 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4168 * that does not pass the 'isrefchar' test is replaced with '_' */
4169 tag = Jim_GetString(tagPtr, &tagLen);
4170 if (tagLen > JIM_REFERENCE_TAGLEN)
4171 tagLen = JIM_REFERENCE_TAGLEN;
4172 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4173 if (i < tagLen)
4174 refPtr->tag[i] = tag[i];
4175 else
4176 refPtr->tag[i] = '_';
4177 }
4178 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4179 return refObjPtr;
4180 }
4181
4182 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4183 {
4184 if (objPtr->typePtr != &referenceObjType &&
4185 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4186 return NULL;
4187 return objPtr->internalRep.refValue.refPtr;
4188 }
4189
4190 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4191 {
4192 Jim_Reference *refPtr;
4193
4194 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4195 return JIM_ERR;
4196 Jim_IncrRefCount(cmdNamePtr);
4197 if (refPtr->finalizerCmdNamePtr)
4198 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4199 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4200 return JIM_OK;
4201 }
4202
4203 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4204 {
4205 Jim_Reference *refPtr;
4206
4207 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4208 return JIM_ERR;
4209 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4210 return JIM_OK;
4211 }
4212
4213 /* -----------------------------------------------------------------------------
4214 * References Garbage Collection
4215 * ---------------------------------------------------------------------------*/
4216
4217 /* This the hash table type for the "MARK" phase of the GC */
4218 static Jim_HashTableType JimRefMarkHashTableType = {
4219 JimReferencesHTHashFunction, /* hash function */
4220 JimReferencesHTKeyDup, /* key dup */
4221 NULL, /* val dup */
4222 JimReferencesHTKeyCompare, /* key compare */
4223 JimReferencesHTKeyDestructor, /* key destructor */
4224 NULL /* val destructor */
4225 };
4226
4227 /* #define JIM_DEBUG_GC 1 */
4228
4229 /* Performs the garbage collection. */
4230 int Jim_Collect(Jim_Interp *interp)
4231 {
4232 Jim_HashTable marks;
4233 Jim_HashTableIterator *htiter;
4234 Jim_HashEntry *he;
4235 Jim_Obj *objPtr;
4236 int collected = 0;
4237
4238 /* Avoid recursive calls */
4239 if (interp->lastCollectId == -1) {
4240 /* Jim_Collect() already running. Return just now. */
4241 return 0;
4242 }
4243 interp->lastCollectId = -1;
4244
4245 /* Mark all the references found into the 'mark' hash table.
4246 * The references are searched in every live object that
4247 * is of a type that can contain references. */
4248 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4249 objPtr = interp->liveList;
4250 while (objPtr) {
4251 if (objPtr->typePtr == NULL ||
4252 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4253 const char *str, *p;
4254 int len;
4255
4256 /* If the object is of type reference, to get the
4257 * Id is simple... */
4258 if (objPtr->typePtr == &referenceObjType) {
4259 Jim_AddHashEntry(&marks,
4260 &objPtr->internalRep.refValue.id, NULL);
4261 #ifdef JIM_DEBUG_GC
4262 Jim_fprintf(interp,interp->cookie_stdout,
4263 "MARK (reference): %d refcount: %d" JIM_NL,
4264 (int) objPtr->internalRep.refValue.id,
4265 objPtr->refCount);
4266 #endif
4267 objPtr = objPtr->nextObjPtr;
4268 continue;
4269 }
4270 /* Get the string repr of the object we want
4271 * to scan for references. */
4272 p = str = Jim_GetString(objPtr, &len);
4273 /* Skip objects too little to contain references. */
4274 if (len < JIM_REFERENCE_SPACE) {
4275 objPtr = objPtr->nextObjPtr;
4276 continue;
4277 }
4278 /* Extract references from the object string repr. */
4279 while (1) {
4280 int i;
4281 jim_wide id;
4282 char buf[21];
4283
4284 if ((p = strstr(p, "<reference.<")) == NULL)
4285 break;
4286 /* Check if it's a valid reference. */
4287 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4288 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4289 for (i = 21; i <= 40; i++)
4290 if (!isdigit((int)p[i]))
4291 break;
4292 /* Get the ID */
4293 memcpy(buf, p + 21, 20);
4294 buf[20] = '\0';
4295 Jim_StringToWide(buf, &id, 10);
4296
4297 /* Ok, a reference for the given ID
4298 * was found. Mark it. */
4299 Jim_AddHashEntry(&marks, &id, NULL);
4300 #ifdef JIM_DEBUG_GC
4301 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4302 #endif
4303 p += JIM_REFERENCE_SPACE;
4304 }
4305 }
4306 objPtr = objPtr->nextObjPtr;
4307 }
4308
4309 /* Run the references hash table to destroy every reference that
4310 * is not referenced outside (not present in the mark HT). */
4311 htiter = Jim_GetHashTableIterator(&interp->references);
4312 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4313 const jim_wide *refId;
4314 Jim_Reference *refPtr;
4315
4316 refId = he->key;
4317 /* Check if in the mark phase we encountered
4318 * this reference. */
4319 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4320 #ifdef JIM_DEBUG_GC
4321 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4322 #endif
4323 collected++;
4324 /* Drop the reference, but call the
4325 * finalizer first if registered. */
4326 refPtr = he->val;
4327 if (refPtr->finalizerCmdNamePtr) {
4328 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4329 Jim_Obj *objv[3], *oldResult;
4330
4331 JimFormatReference(refstr, refPtr, *refId);
4332
4333 objv[0] = refPtr->finalizerCmdNamePtr;
4334 objv[1] = Jim_NewStringObjNoAlloc(interp,
4335 refstr, 32);
4336 objv[2] = refPtr->objPtr;
4337 Jim_IncrRefCount(objv[0]);
4338 Jim_IncrRefCount(objv[1]);
4339 Jim_IncrRefCount(objv[2]);
4340
4341 /* Drop the reference itself */
4342 Jim_DeleteHashEntry(&interp->references, refId);
4343
4344 /* Call the finalizer. Errors ignored. */
4345 oldResult = interp->result;
4346 Jim_IncrRefCount(oldResult);
4347 Jim_EvalObjVector(interp, 3, objv);
4348 Jim_SetResult(interp, oldResult);
4349 Jim_DecrRefCount(interp, oldResult);
4350
4351 Jim_DecrRefCount(interp, objv[0]);
4352 Jim_DecrRefCount(interp, objv[1]);
4353 Jim_DecrRefCount(interp, objv[2]);
4354 } else {
4355 Jim_DeleteHashEntry(&interp->references, refId);
4356 }
4357 }
4358 }
4359 Jim_FreeHashTableIterator(htiter);
4360 Jim_FreeHashTable(&marks);
4361 interp->lastCollectId = interp->referenceNextId;
4362 interp->lastCollectTime = time(NULL);
4363 return collected;
4364 }
4365
4366 #define JIM_COLLECT_ID_PERIOD 5000
4367 #define JIM_COLLECT_TIME_PERIOD 300
4368
4369 void Jim_CollectIfNeeded(Jim_Interp *interp)
4370 {
4371 jim_wide elapsedId;
4372 int elapsedTime;
4373
4374 elapsedId = interp->referenceNextId - interp->lastCollectId;
4375 elapsedTime = time(NULL) - interp->lastCollectTime;
4376
4377
4378 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4379 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4380 Jim_Collect(interp);
4381 }
4382 }
4383
4384 /* -----------------------------------------------------------------------------
4385 * Interpreter related functions
4386 * ---------------------------------------------------------------------------*/
4387
4388 Jim_Interp *Jim_CreateInterp(void)
4389 {
4390 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4391 Jim_Obj *pathPtr;
4392
4393 i->errorLine = 0;
4394 i->errorFileName = Jim_StrDup("");
4395 i->numLevels = 0;
4396 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4397 i->returnCode = JIM_OK;
4398 i->exitCode = 0;
4399 i->procEpoch = 0;
4400 i->callFrameEpoch = 0;
4401 i->liveList = i->freeList = NULL;
4402 i->scriptFileName = Jim_StrDup("");
4403 i->referenceNextId = 0;
4404 i->lastCollectId = 0;
4405 i->lastCollectTime = time(NULL);
4406 i->freeFramesList = NULL;
4407 i->prngState = NULL;
4408 i->evalRetcodeLevel = -1;
4409 i->cookie_stdin = stdin;
4410 i->cookie_stdout = stdout;
4411 i->cookie_stderr = stderr;
4412 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4413 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4414 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4415 i->cb_fflush = ((int (*)(void *))(fflush));
4416 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4417
4418 /* Note that we can create objects only after the
4419 * interpreter liveList and freeList pointers are
4420 * initialized to NULL. */
4421 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4422 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4423 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4424 NULL);
4425 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4426 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4427 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4428 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4429 i->emptyObj = Jim_NewEmptyStringObj(i);
4430 i->result = i->emptyObj;
4431 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4432 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4433 i->unknown_called = 0;
4434 Jim_IncrRefCount(i->emptyObj);
4435 Jim_IncrRefCount(i->result);
4436 Jim_IncrRefCount(i->stackTrace);
4437 Jim_IncrRefCount(i->unknown);
4438
4439 /* Initialize key variables every interpreter should contain */
4440 pathPtr = Jim_NewStringObj(i, "./", -1);
4441 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4442 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4443
4444 /* Export the core API to extensions */
4445 JimRegisterCoreApi(i);
4446 return i;
4447 }
4448
4449 /* This is the only function Jim exports directly without
4450 * to use the STUB system. It is only used by embedders
4451 * in order to get an interpreter with the Jim API pointers
4452 * registered. */
4453 Jim_Interp *ExportedJimCreateInterp(void)
4454 {
4455 return Jim_CreateInterp();
4456 }
4457
4458 void Jim_FreeInterp(Jim_Interp *i)
4459 {
4460 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4461 Jim_Obj *objPtr, *nextObjPtr;
4462
4463 Jim_DecrRefCount(i, i->emptyObj);
4464 Jim_DecrRefCount(i, i->result);
4465 Jim_DecrRefCount(i, i->stackTrace);
4466 Jim_DecrRefCount(i, i->unknown);
4467 Jim_Free((void*)i->errorFileName);
4468 Jim_Free((void*)i->scriptFileName);
4469 Jim_FreeHashTable(&i->commands);
4470 Jim_FreeHashTable(&i->references);
4471 Jim_FreeHashTable(&i->stub);
4472 Jim_FreeHashTable(&i->assocData);
4473 Jim_FreeHashTable(&i->packages);
4474 Jim_Free(i->prngState);
4475 /* Free the call frames list */
4476 while (cf) {
4477 prevcf = cf->parentCallFrame;
4478 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4479 cf = prevcf;
4480 }
4481 /* Check that the live object list is empty, otherwise
4482 * there is a memory leak. */
4483 if (i->liveList != NULL) {
4484 objPtr = i->liveList;
4485
4486 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4487 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4488 while (objPtr) {
4489 const char *type = objPtr->typePtr ?
4490 objPtr->typePtr->name : "";
4491 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4492 objPtr, type,
4493 objPtr->bytes ? objPtr->bytes
4494 : "(null)", objPtr->refCount);
4495 if (objPtr->typePtr == &sourceObjType) {
4496 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4497 objPtr->internalRep.sourceValue.fileName,
4498 objPtr->internalRep.sourceValue.lineNumber);
4499 }
4500 objPtr = objPtr->nextObjPtr;
4501 }
4502 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4503 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4504 }
4505 /* Free all the freed objects. */
4506 objPtr = i->freeList;
4507 while (objPtr) {
4508 nextObjPtr = objPtr->nextObjPtr;
4509 Jim_Free(objPtr);
4510 objPtr = nextObjPtr;
4511 }
4512 /* Free cached CallFrame structures */
4513 cf = i->freeFramesList;
4514 while (cf) {
4515 nextcf = cf->nextFramePtr;
4516 if (cf->vars.table != NULL)
4517 Jim_Free(cf->vars.table);
4518 Jim_Free(cf);
4519 cf = nextcf;
4520 }
4521 /* Free the sharedString hash table. Make sure to free it
4522 * after every other Jim_Object was freed. */
4523 Jim_FreeHashTable(&i->sharedStrings);
4524 /* Free the interpreter structure. */
4525 Jim_Free(i);
4526 }
4527
4528 /* Store the call frame relative to the level represented by
4529 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4530 * level is assumed to be '1'.
4531 *
4532 * If a newLevelptr int pointer is specified, the function stores
4533 * the absolute level integer value of the new target callframe into
4534 * *newLevelPtr. (this is used to adjust interp->numLevels
4535 * in the implementation of [uplevel], so that [info level] will
4536 * return a correct information).
4537 *
4538 * This function accepts the 'level' argument in the form
4539 * of the commands [uplevel] and [upvar].
4540 *
4541 * For a function accepting a relative integer as level suitable
4542 * for implementation of [info level ?level?] check the
4543 * GetCallFrameByInteger() function. */
4544 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4545 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4546 {
4547 long level;
4548 const char *str;
4549 Jim_CallFrame *framePtr;
4550
4551 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4552 if (levelObjPtr) {
4553 str = Jim_GetString(levelObjPtr, NULL);
4554 if (str[0] == '#') {
4555 char *endptr;
4556 /* speedup for the toplevel (level #0) */
4557 if (str[1] == '0' && str[2] == '\0') {
4558 if (newLevelPtr) *newLevelPtr = 0;
4559 *framePtrPtr = interp->topFramePtr;
4560 return JIM_OK;
4561 }
4562
4563 level = strtol(str + 1, &endptr, 0);
4564 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4565 goto badlevel;
4566 /* An 'absolute' level is converted into the
4567 * 'number of levels to go back' format. */
4568 level = interp->numLevels - level;
4569 if (level < 0) goto badlevel;
4570 } else {
4571 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4572 goto badlevel;
4573 }
4574 } else {
4575 str = "1"; /* Needed to format the error message. */
4576 level = 1;
4577 }
4578 /* Lookup */
4579 framePtr = interp->framePtr;
4580 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4581 while (level--) {
4582 framePtr = framePtr->parentCallFrame;
4583 if (framePtr == NULL) goto badlevel;
4584 }
4585 *framePtrPtr = framePtr;
4586 return JIM_OK;
4587 badlevel:
4588 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4589 Jim_AppendStrings(interp, Jim_GetResult(interp),
4590 "bad level \"", str, "\"", NULL);
4591 return JIM_ERR;
4592 }
4593
4594 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4595 * as a relative integer like in the [info level ?level?] command. */
4596 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4597 Jim_CallFrame **framePtrPtr)
4598 {
4599 jim_wide level;
4600 jim_wide relLevel; /* level relative to the current one. */
4601 Jim_CallFrame *framePtr;
4602
4603 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4604 goto badlevel;
4605 if (level > 0) {
4606 /* An 'absolute' level is converted into the
4607 * 'number of levels to go back' format. */
4608 relLevel = interp->numLevels - level;
4609 } else {
4610 relLevel = -level;
4611 }
4612 /* Lookup */
4613 framePtr = interp->framePtr;
4614 while (relLevel--) {
4615 framePtr = framePtr->parentCallFrame;
4616 if (framePtr == NULL) goto badlevel;
4617 }
4618 *framePtrPtr = framePtr;
4619 return JIM_OK;
4620 badlevel:
4621 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4622 Jim_AppendStrings(interp, Jim_GetResult(interp),
4623 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4624 return JIM_ERR;
4625 }
4626
4627 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4628 {
4629 Jim_Free((void*)interp->errorFileName);
4630 interp->errorFileName = Jim_StrDup(filename);
4631 }
4632
4633 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4634 {
4635 interp->errorLine = linenr;
4636 }
4637
4638 static void JimResetStackTrace(Jim_Interp *interp)
4639 {
4640 Jim_DecrRefCount(interp, interp->stackTrace);
4641 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4642 Jim_IncrRefCount(interp->stackTrace);
4643 }
4644
4645 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4646 const char *filename, int linenr)
4647 {
4648 /* No need to add this dummy entry to the stack trace */
4649 if (strcmp(procname, "unknown") == 0) {
4650 return;
4651 }
4652
4653 if (Jim_IsShared(interp->stackTrace)) {
4654 interp->stackTrace =
4655 Jim_DuplicateObj(interp, interp->stackTrace);
4656 Jim_IncrRefCount(interp->stackTrace);
4657 }
4658 Jim_ListAppendElement(interp, interp->stackTrace,
4659 Jim_NewStringObj(interp, procname, -1));
4660 Jim_ListAppendElement(interp, interp->stackTrace,
4661 Jim_NewStringObj(interp, filename, -1));
4662 Jim_ListAppendElement(interp, interp->stackTrace,
4663 Jim_NewIntObj(interp, linenr));
4664 }
4665
4666 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4667 {
4668 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4669 assocEntryPtr->delProc = delProc;
4670 assocEntryPtr->data = data;
4671 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4672 }
4673
4674 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4675 {
4676 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4677 if (entryPtr != NULL) {
4678 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4679 return assocEntryPtr->data;
4680 }
4681 return NULL;
4682 }
4683
4684 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4685 {
4686 return Jim_DeleteHashEntry(&interp->assocData, key);
4687 }
4688
4689 int Jim_GetExitCode(Jim_Interp *interp) {
4690 return interp->exitCode;
4691 }
4692
4693 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4694 {
4695 if (fp != NULL) interp->cookie_stdin = fp;
4696 return interp->cookie_stdin;
4697 }
4698
4699 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4700 {
4701 if (fp != NULL) interp->cookie_stdout = fp;
4702 return interp->cookie_stdout;
4703 }
4704
4705 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4706 {
4707 if (fp != NULL) interp->cookie_stderr = fp;
4708 return interp->cookie_stderr;
4709 }
4710
4711 /* -----------------------------------------------------------------------------
4712 * Shared strings.
4713 * Every interpreter has an hash table where to put shared dynamically
4714 * allocate strings that are likely to be used a lot of times.
4715 * For example, in the 'source' object type, there is a pointer to
4716 * the filename associated with that object. Every script has a lot
4717 * of this objects with the identical file name, so it is wise to share
4718 * this info.
4719 *
4720 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4721 * returns the pointer to the shared string. Every time a reference
4722 * to the string is no longer used, the user should call
4723 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4724 * a given string, it is removed from the hash table.
4725 * ---------------------------------------------------------------------------*/
4726 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4727 {
4728 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4729
4730 if (he == NULL) {
4731 char *strCopy = Jim_StrDup(str);
4732
4733 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4734 return strCopy;
4735 } else {
4736 intptr_t refCount = (intptr_t) he->val;
4737
4738 refCount++;
4739 he->val = (void*) refCount;
4740 return he->key;
4741 }
4742 }
4743
4744 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4745 {
4746 intptr_t refCount;
4747 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4748
4749 if (he == NULL)
4750 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4751 "unknown shared string '%s'", str);
4752 refCount = (intptr_t) he->val;
4753 refCount--;
4754 if (refCount == 0) {
4755 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4756 } else {
4757 he->val = (void*) refCount;
4758 }
4759 }
4760
4761 /* -----------------------------------------------------------------------------
4762 * Integer object
4763 * ---------------------------------------------------------------------------*/
4764 #define JIM_INTEGER_SPACE 24
4765
4766 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4767 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4768
4769 static Jim_ObjType intObjType = {
4770 "int",
4771 NULL,
4772 NULL,
4773 UpdateStringOfInt,
4774 JIM_TYPE_NONE,
4775 };
4776
4777 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4778 {
4779 int len;
4780 char buf[JIM_INTEGER_SPACE + 1];
4781
4782 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4783 objPtr->bytes = Jim_Alloc(len + 1);
4784 memcpy(objPtr->bytes, buf, len + 1);
4785 objPtr->length = len;
4786 }
4787
4788 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4789 {
4790 jim_wide wideValue;
4791 const char *str;
4792
4793 /* Get the string representation */
4794 str = Jim_GetString(objPtr, NULL);
4795 /* Try to convert into a jim_wide */
4796 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4797 if (flags & JIM_ERRMSG) {
4798 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4799 Jim_AppendStrings(interp, Jim_GetResult(interp),
4800 "expected integer but got \"", str, "\"", NULL);
4801 }
4802 return JIM_ERR;
4803 }
4804 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4805 errno == ERANGE) {
4806 Jim_SetResultString(interp,
4807 "Integer value too big to be represented", -1);
4808 return JIM_ERR;
4809 }
4810 /* Free the old internal repr and set the new one. */
4811 Jim_FreeIntRep(interp, objPtr);
4812 objPtr->typePtr = &intObjType;
4813 objPtr->internalRep.wideValue = wideValue;
4814 return JIM_OK;
4815 }
4816
4817 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4818 {
4819 if (objPtr->typePtr != &intObjType &&
4820 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4821 return JIM_ERR;
4822 *widePtr = objPtr->internalRep.wideValue;
4823 return JIM_OK;
4824 }
4825
4826 /* Get a wide but does not set an error if the format is bad. */
4827 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4828 jim_wide *widePtr)
4829 {
4830 if (objPtr->typePtr != &intObjType &&
4831 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4832 return JIM_ERR;
4833 *widePtr = objPtr->internalRep.wideValue;
4834 return JIM_OK;
4835 }
4836
4837 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4838 {
4839 jim_wide wideValue;
4840 int retval;
4841
4842 retval = Jim_GetWide(interp, objPtr, &wideValue);
4843 if (retval == JIM_OK) {
4844 *longPtr = (long) wideValue;
4845 return JIM_OK;
4846 }
4847 return JIM_ERR;
4848 }
4849
4850 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4851 {
4852 if (Jim_IsShared(objPtr))
4853 Jim_Panic(interp,"Jim_SetWide called with shared object");
4854 if (objPtr->typePtr != &intObjType) {
4855 Jim_FreeIntRep(interp, objPtr);
4856 objPtr->typePtr = &intObjType;
4857 }
4858 Jim_InvalidateStringRep(objPtr);
4859 objPtr->internalRep.wideValue = wideValue;
4860 }
4861
4862 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4863 {
4864 Jim_Obj *objPtr;
4865
4866 objPtr = Jim_NewObj(interp);
4867 objPtr->typePtr = &intObjType;
4868 objPtr->bytes = NULL;
4869 objPtr->internalRep.wideValue = wideValue;
4870 return objPtr;
4871 }
4872
4873 /* -----------------------------------------------------------------------------
4874 * Double object
4875 * ---------------------------------------------------------------------------*/
4876 #define JIM_DOUBLE_SPACE 30
4877
4878 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4879 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4880
4881 static Jim_ObjType doubleObjType = {
4882 "double",
4883 NULL,
4884 NULL,
4885 UpdateStringOfDouble,
4886 JIM_TYPE_NONE,
4887 };
4888
4889 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4890 {
4891 int len;
4892 char buf[JIM_DOUBLE_SPACE + 1];
4893
4894 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4895 objPtr->bytes = Jim_Alloc(len + 1);
4896 memcpy(objPtr->bytes, buf, len + 1);
4897 objPtr->length = len;
4898 }
4899
4900 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4901 {
4902 double doubleValue;
4903 const char *str;
4904
4905 /* Get the string representation */
4906 str = Jim_GetString(objPtr, NULL);
4907 /* Try to convert into a double */
4908 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4909 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4910 Jim_AppendStrings(interp, Jim_GetResult(interp),
4911 "expected number but got '", str, "'", NULL);
4912 return JIM_ERR;
4913 }
4914 /* Free the old internal repr and set the new one. */
4915 Jim_FreeIntRep(interp, objPtr);
4916 objPtr->typePtr = &doubleObjType;
4917 objPtr->internalRep.doubleValue = doubleValue;
4918 return JIM_OK;
4919 }
4920
4921 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4922 {
4923 if (objPtr->typePtr != &doubleObjType &&
4924 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4925 return JIM_ERR;
4926 *doublePtr = objPtr->internalRep.doubleValue;
4927 return JIM_OK;
4928 }
4929
4930 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4931 {
4932 if (Jim_IsShared(objPtr))
4933 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4934 if (objPtr->typePtr != &doubleObjType) {
4935 Jim_FreeIntRep(interp, objPtr);
4936 objPtr->typePtr = &doubleObjType;
4937 }
4938 Jim_InvalidateStringRep(objPtr);
4939 objPtr->internalRep.doubleValue = doubleValue;
4940 }
4941
4942 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4943 {
4944 Jim_Obj *objPtr;
4945
4946 objPtr = Jim_NewObj(interp);
4947 objPtr->typePtr = &doubleObjType;
4948 objPtr->bytes = NULL;
4949 objPtr->internalRep.doubleValue = doubleValue;
4950 return objPtr;
4951 }
4952
4953 /* -----------------------------------------------------------------------------
4954 * List object
4955 * ---------------------------------------------------------------------------*/
4956 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4957 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4958 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4959 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4960 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4961
4962 /* Note that while the elements of the list may contain references,
4963 * the list object itself can't. This basically means that the
4964 * list object string representation as a whole can't contain references
4965 * that are not presents in the single elements. */
4966 static Jim_ObjType listObjType = {
4967 "list",
4968 FreeListInternalRep,
4969 DupListInternalRep,
4970 UpdateStringOfList,
4971 JIM_TYPE_NONE,
4972 };
4973
4974 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4975 {
4976 int i;
4977
4978 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4979 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4980 }
4981 Jim_Free(objPtr->internalRep.listValue.ele);
4982 }
4983
4984 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4985 {
4986 int i;
4987 JIM_NOTUSED(interp);
4988
4989 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4990 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4991 dupPtr->internalRep.listValue.ele =
4992 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4993 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4994 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4995 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4996 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4997 }
4998 dupPtr->typePtr = &listObjType;
4999 }
5000
5001 /* The following function checks if a given string can be encoded
5002 * into a list element without any kind of quoting, surrounded by braces,
5003 * or using escapes to quote. */
5004 #define JIM_ELESTR_SIMPLE 0
5005 #define JIM_ELESTR_BRACE 1
5006 #define JIM_ELESTR_QUOTE 2
5007 static int ListElementQuotingType(const char *s, int len)
5008 {
5009 int i, level, trySimple = 1;
5010
5011 /* Try with the SIMPLE case */
5012 if (len == 0) return JIM_ELESTR_BRACE;
5013 if (s[0] == '"' || s[0] == '{') {
5014 trySimple = 0;
5015 goto testbrace;
5016 }
5017 for (i = 0; i < len; i++) {
5018 switch (s[i]) {
5019 case ' ':
5020 case '$':
5021 case '"':
5022 case '[':
5023 case ']':
5024 case ';':
5025 case '\\':
5026 case '\r':
5027 case '\n':
5028 case '\t':
5029 case '\f':
5030 case '\v':
5031 trySimple = 0;
5032 case '{':
5033 case '}':
5034 goto testbrace;
5035 }
5036 }
5037 return JIM_ELESTR_SIMPLE;
5038
5039 testbrace:
5040 /* Test if it's possible to do with braces */
5041 if (s[len-1] == '\\' ||
5042 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5043 level = 0;
5044 for (i = 0; i < len; i++) {
5045 switch (s[i]) {
5046 case '{': level++; break;
5047 case '}': level--;
5048 if (level < 0) return JIM_ELESTR_QUOTE;
5049 break;
5050 case '\\':
5051 if (s[i + 1] == '\n')
5052 return JIM_ELESTR_QUOTE;
5053 else
5054 if (s[i + 1] != '\0') i++;
5055 break;
5056 }
5057 }
5058 if (level == 0) {
5059 if (!trySimple) return JIM_ELESTR_BRACE;
5060 for (i = 0; i < len; i++) {
5061 switch (s[i]) {
5062 case ' ':
5063 case '$':
5064 case '"':
5065 case '[':
5066 case ']':
5067 case ';':
5068 case '\\':
5069 case '\r':
5070 case '\n':
5071 case '\t':
5072 case '\f':
5073 case '\v':
5074 return JIM_ELESTR_BRACE;
5075 break;
5076 }
5077 }
5078 return JIM_ELESTR_SIMPLE;
5079 }
5080 return JIM_ELESTR_QUOTE;
5081 }
5082
5083 /* Returns the malloc-ed representation of a string
5084 * using backslash to quote special chars. */
5085 static char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5086 {
5087 char *q = Jim_Alloc(len*2 + 1), *p;
5088
5089 p = q;
5090 while (*s) {
5091 switch (*s) {
5092 case ' ':
5093 case '$':
5094 case '"':
5095 case '[':
5096 case ']':
5097 case '{':
5098 case '}':
5099 case ';':
5100 case '\\':
5101 *p++ = '\\';
5102 *p++ = *s++;
5103 break;
5104 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5105 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5106 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5107 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5108 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5109 default:
5110 *p++ = *s++;
5111 break;
5112 }
5113 }
5114 *p = '\0';
5115 *qlenPtr = p-q;
5116 return q;
5117 }
5118
5119 void UpdateStringOfList(struct Jim_Obj *objPtr)
5120 {
5121 int i, bufLen, realLength;
5122 const char *strRep;
5123 char *p;
5124 int *quotingType;
5125 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5126
5127 /* (Over) Estimate the space needed. */
5128 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5129 bufLen = 0;
5130 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5131 int len;
5132
5133 strRep = Jim_GetString(ele[i], &len);
5134 quotingType[i] = ListElementQuotingType(strRep, len);
5135 switch (quotingType[i]) {
5136 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5137 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5138 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5139 }
5140 bufLen++; /* elements separator. */
5141 }
5142 bufLen++;
5143
5144 /* Generate the string rep. */
5145 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5146 realLength = 0;
5147 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5148 int len, qlen;
5149 strRep = Jim_GetString(ele[i], &len);
5150 char *q;
5151
5152 switch (quotingType[i]) {
5153 case JIM_ELESTR_SIMPLE:
5154 memcpy(p, strRep, len);
5155 p += len;
5156 realLength += len;
5157 break;
5158 case JIM_ELESTR_BRACE:
5159 *p++ = '{';
5160 memcpy(p, strRep, len);
5161 p += len;
5162 *p++ = '}';
5163 realLength += len + 2;
5164 break;
5165 case JIM_ELESTR_QUOTE:
5166 q = BackslashQuoteString(strRep, len, &qlen);
5167 memcpy(p, q, qlen);
5168 Jim_Free(q);
5169 p += qlen;
5170 realLength += qlen;
5171 break;
5172 }
5173 /* Add a separating space */
5174 if (i + 1 != objPtr->internalRep.listValue.len) {
5175 *p++ = ' ';
5176 realLength ++;
5177 }
5178 }
5179 *p = '\0'; /* nul term. */
5180 objPtr->length = realLength;
5181 Jim_Free(quotingType);
5182 }
5183
5184 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5185 {
5186 struct JimParserCtx parser;
5187 const char *str;
5188 int strLen;
5189
5190 /* Get the string representation */
5191 str = Jim_GetString(objPtr, &strLen);
5192
5193 /* Free the old internal repr just now and initialize the
5194 * new one just now. The string->list conversion can't fail. */
5195 Jim_FreeIntRep(interp, objPtr);
5196 objPtr->typePtr = &listObjType;
5197 objPtr->internalRep.listValue.len = 0;
5198 objPtr->internalRep.listValue.maxLen = 0;
5199 objPtr->internalRep.listValue.ele = NULL;
5200
5201 /* Convert into a list */
5202 JimParserInit(&parser, str, strLen, 1);
5203 while (!JimParserEof(&parser)) {
5204 char *token;
5205 int tokenLen, type;
5206 Jim_Obj *elementPtr;
5207
5208 JimParseList(&parser);
5209 if (JimParserTtype(&parser) != JIM_TT_STR &&
5210 JimParserTtype(&parser) != JIM_TT_ESC)
5211 continue;
5212 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5213 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5214 ListAppendElement(objPtr, elementPtr);
5215 }
5216 return JIM_OK;
5217 }
5218
5219 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5220 int len)
5221 {
5222 Jim_Obj *objPtr;
5223 int i;
5224
5225 objPtr = Jim_NewObj(interp);
5226 objPtr->typePtr = &listObjType;
5227 objPtr->bytes = NULL;
5228 objPtr->internalRep.listValue.ele = NULL;
5229 objPtr->internalRep.listValue.len = 0;
5230 objPtr->internalRep.listValue.maxLen = 0;
5231 for (i = 0; i < len; i++) {
5232 ListAppendElement(objPtr, elements[i]);
5233 }
5234 return objPtr;
5235 }
5236
5237 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5238 * length of the vector. Note that the user of this function should make
5239 * sure that the list object can't shimmer while the vector returned
5240 * is in use, this vector is the one stored inside the internal representation
5241 * of the list object. This function is not exported, extensions should
5242 * always access to the List object elements using Jim_ListIndex(). */
5243 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5244 Jim_Obj ***listVec)
5245 {
5246 Jim_ListLength(interp, listObj, argc);
5247 assert(listObj->typePtr == &listObjType);
5248 *listVec = listObj->internalRep.listValue.ele;
5249 }
5250
5251 /* ListSortElements type values */
5252 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5253 JIM_LSORT_NOCASE_DECR};
5254
5255 /* Sort the internal rep of a list. */
5256 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5257 {
5258 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5259 }
5260
5261 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5262 {
5263 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5264 }
5265
5266 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5267 {
5268 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5269 }
5270
5271 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5272 {
5273 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5274 }
5275
5276 /* Sort a list *in place*. MUST be called with non-shared objects. */
5277 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5278 {
5279 typedef int (qsort_comparator)(const void *, const void *);
5280 int (*fn)(Jim_Obj**, Jim_Obj**);
5281 Jim_Obj **vector;
5282 int len;
5283
5284 if (Jim_IsShared(listObjPtr))
5285 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5286 if (listObjPtr->typePtr != &listObjType)
5287 SetListFromAny(interp, listObjPtr);
5288
5289 vector = listObjPtr->internalRep.listValue.ele;
5290 len = listObjPtr->internalRep.listValue.len;
5291 switch (type) {
5292 case JIM_LSORT_ASCII: fn = ListSortString; break;
5293 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5294 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5295 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5296 default:
5297 fn = NULL; /* avoid warning */
5298 Jim_Panic(interp,"ListSort called with invalid sort type");
5299 }
5300 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5301 Jim_InvalidateStringRep(listObjPtr);
5302 }
5303
5304 /* This is the low-level function to append an element to a list.
5305 * The higher-level Jim_ListAppendElement() performs shared object
5306 * check and invalidate the string repr. This version is used
5307 * in the internals of the List Object and is not exported.
5308 *
5309 * NOTE: this function can be called only against objects
5310 * with internal type of List. */
5311 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5312 {
5313 int requiredLen = listPtr->internalRep.listValue.len + 1;
5314
5315 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5316 int maxLen = requiredLen * 2;
5317
5318 listPtr->internalRep.listValue.ele =
5319 Jim_Realloc(listPtr->internalRep.listValue.ele,
5320 sizeof(Jim_Obj*)*maxLen);
5321 listPtr->internalRep.listValue.maxLen = maxLen;
5322 }
5323 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5324 objPtr;
5325 listPtr->internalRep.listValue.len ++;
5326 Jim_IncrRefCount(objPtr);
5327 }
5328
5329 /* This is the low-level function to insert elements into a list.
5330 * The higher-level Jim_ListInsertElements() performs shared object
5331 * check and invalidate the string repr. This version is used
5332 * in the internals of the List Object and is not exported.
5333 *
5334 * NOTE: this function can be called only against objects
5335 * with internal type of List. */
5336 static void ListInsertElements(Jim_Obj *listPtr, int index_t, int elemc,
5337 Jim_Obj *const *elemVec)
5338 {
5339 int currentLen = listPtr->internalRep.listValue.len;
5340 int requiredLen = currentLen + elemc;
5341 int i;
5342 Jim_Obj **point;
5343
5344 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5345 int maxLen = requiredLen * 2;
5346
5347 listPtr->internalRep.listValue.ele =
5348 Jim_Realloc(listPtr->internalRep.listValue.ele,
5349 sizeof(Jim_Obj*)*maxLen);
5350 listPtr->internalRep.listValue.maxLen = maxLen;
5351 }
5352 point = listPtr->internalRep.listValue.ele + index_t;
5353 memmove(point + elemc, point, (currentLen-index_t) * sizeof(Jim_Obj*));
5354 for (i = 0; i < elemc; ++i) {
5355 point[i] = elemVec[i];
5356 Jim_IncrRefCount(point[i]);
5357 }
5358 listPtr->internalRep.listValue.len += elemc;
5359 }
5360
5361 /* Appends every element of appendListPtr into listPtr.
5362 * Both have to be of the list type. */
5363 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5364 {
5365 int i, oldLen = listPtr->internalRep.listValue.len;
5366 int appendLen = appendListPtr->internalRep.listValue.len;
5367 int requiredLen = oldLen + appendLen;
5368
5369 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5370 int maxLen = requiredLen * 2;
5371
5372 listPtr->internalRep.listValue.ele =
5373 Jim_Realloc(listPtr->internalRep.listValue.ele,
5374 sizeof(Jim_Obj*)*maxLen);
5375 listPtr->internalRep.listValue.maxLen = maxLen;
5376 }
5377 for (i = 0; i < appendLen; i++) {
5378 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5379 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5380 Jim_IncrRefCount(objPtr);
5381 }
5382 listPtr->internalRep.listValue.len += appendLen;
5383 }
5384
5385 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5386 {
5387 if (Jim_IsShared(listPtr))
5388 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5389 if (listPtr->typePtr != &listObjType)
5390 SetListFromAny(interp, listPtr);
5391 Jim_InvalidateStringRep(listPtr);
5392 ListAppendElement(listPtr, objPtr);
5393 }
5394
5395 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5396 {
5397 if (Jim_IsShared(listPtr))
5398 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5399 if (listPtr->typePtr != &listObjType)
5400 SetListFromAny(interp, listPtr);
5401 Jim_InvalidateStringRep(listPtr);
5402 ListAppendList(listPtr, appendListPtr);
5403 }
5404
5405 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5406 {
5407 if (listPtr->typePtr != &listObjType)
5408 SetListFromAny(interp, listPtr);
5409 *intPtr = listPtr->internalRep.listValue.len;
5410 }
5411
5412 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5413 int objc, Jim_Obj *const *objVec)
5414 {
5415 if (Jim_IsShared(listPtr))
5416 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5417 if (listPtr->typePtr != &listObjType)
5418 SetListFromAny(interp, listPtr);
5419 if (index_t >= 0 && index_t > listPtr->internalRep.listValue.len)
5420 index_t = listPtr->internalRep.listValue.len;
5421 else if (index_t < 0)
5422 index_t = 0;
5423 Jim_InvalidateStringRep(listPtr);
5424 ListInsertElements(listPtr, index_t, objc, objVec);
5425 }
5426
5427 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5428 Jim_Obj **objPtrPtr, int flags)
5429 {
5430 if (listPtr->typePtr != &listObjType)
5431 SetListFromAny(interp, listPtr);
5432 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5433 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5434 if (flags & JIM_ERRMSG) {
5435 Jim_SetResultString(interp,
5436 "list index out of range", -1);
5437 }
5438 return JIM_ERR;
5439 }
5440 if (index_t < 0)
5441 index_t = listPtr->internalRep.listValue.len + index_t;
5442 *objPtrPtr = listPtr->internalRep.listValue.ele[index_t];
5443 return JIM_OK;
5444 }
5445
5446 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index_t,
5447 Jim_Obj *newObjPtr, int flags)
5448 {
5449 if (listPtr->typePtr != &listObjType)
5450 SetListFromAny(interp, listPtr);
5451 if ((index_t >= 0 && index_t >= listPtr->internalRep.listValue.len) ||
5452 (index_t < 0 && (-index_t-1) >= listPtr->internalRep.listValue.len)) {
5453 if (flags & JIM_ERRMSG) {
5454 Jim_SetResultString(interp,
5455 "list index_t out of range", -1);
5456 }
5457 return JIM_ERR;
5458 }
5459 if (index_t < 0)
5460 index_t = listPtr->internalRep.listValue.len + index_t;
5461 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index_t]);
5462 listPtr->internalRep.listValue.ele[index_t] = newObjPtr;
5463 Jim_IncrRefCount(newObjPtr);
5464 return JIM_OK;
5465 }
5466
5467 /* Modify the list stored into the variable named 'varNamePtr'
5468 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5469 * with the new element 'newObjptr'. */
5470 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5471 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5472 {
5473 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5474 int shared, i, index_t;
5475
5476 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5477 if (objPtr == NULL)
5478 return JIM_ERR;
5479 if ((shared = Jim_IsShared(objPtr)))
5480 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5481 for (i = 0; i < indexc-1; i++) {
5482 listObjPtr = objPtr;
5483 if (Jim_GetIndex(interp, indexv[i], &index_t) != JIM_OK)
5484 goto err;
5485 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
5486 JIM_ERRMSG) != JIM_OK) {
5487 goto err;
5488 }
5489 if (Jim_IsShared(objPtr)) {
5490 objPtr = Jim_DuplicateObj(interp, objPtr);
5491 ListSetIndex(interp, listObjPtr, index_t, objPtr, JIM_NONE);
5492 }
5493 Jim_InvalidateStringRep(listObjPtr);
5494 }
5495 if (Jim_GetIndex(interp, indexv[indexc-1], &index_t) != JIM_OK)
5496 goto err;
5497 if (ListSetIndex(interp, objPtr, index_t, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5498 goto err;
5499 Jim_InvalidateStringRep(objPtr);
5500 Jim_InvalidateStringRep(varObjPtr);
5501 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5502 goto err;
5503 Jim_SetResult(interp, varObjPtr);
5504 return JIM_OK;
5505 err:
5506 if (shared) {
5507 Jim_FreeNewObj(interp, varObjPtr);
5508 }
5509 return JIM_ERR;
5510 }
5511
5512 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5513 {
5514 int i;
5515
5516 /* If all the objects in objv are lists without string rep.
5517 * it's possible to return a list as result, that's the
5518 * concatenation of all the lists. */
5519 for (i = 0; i < objc; i++) {
5520 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5521 break;
5522 }
5523 if (i == objc) {
5524 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5525 for (i = 0; i < objc; i++)
5526 Jim_ListAppendList(interp, objPtr, objv[i]);
5527 return objPtr;
5528 } else {
5529 /* Else... we have to glue strings together */
5530 int len = 0, objLen;
5531 char *bytes, *p;
5532
5533 /* Compute the length */
5534 for (i = 0; i < objc; i++) {
5535 Jim_GetString(objv[i], &objLen);
5536 len += objLen;
5537 }
5538 if (objc) len += objc-1;
5539 /* Create the string rep, and a stinrg object holding it. */
5540 p = bytes = Jim_Alloc(len + 1);
5541 for (i = 0; i < objc; i++) {
5542 const char *s = Jim_GetString(objv[i], &objLen);
5543 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5544 {
5545 s++; objLen--; len--;
5546 }
5547 while (objLen && (s[objLen-1] == ' ' ||
5548 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5549 objLen--; len--;
5550 }
5551 memcpy(p, s, objLen);
5552 p += objLen;
5553 if (objLen && i + 1 != objc) {
5554 *p++ = ' ';
5555 } else if (i + 1 != objc) {
5556 /* Drop the space calcuated for this
5557 * element that is instead null. */
5558 len--;
5559 }
5560 }
5561 *p = '\0';
5562 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5563 }
5564 }
5565
5566 /* Returns a list composed of the elements in the specified range.
5567 * first and start are directly accepted as Jim_Objects and
5568 * processed for the end?-index? case. */
5569 static Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr,
5570 Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5571 {
5572 int first, last;
5573 int len, rangeLen;
5574
5575 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5576 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5577 return NULL;
5578 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5579 first = JimRelToAbsIndex(len, first);
5580 last = JimRelToAbsIndex(len, last);
5581 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5582 return Jim_NewListObj(interp,
5583 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5584 }
5585
5586 /* -----------------------------------------------------------------------------
5587 * Dict object
5588 * ---------------------------------------------------------------------------*/
5589 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5590 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5591 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5592 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5593
5594 /* Dict HashTable Type.
5595 *
5596 * Keys and Values are Jim objects. */
5597
5598 static unsigned int JimObjectHTHashFunction(const void *key)
5599 {
5600 const char *str;
5601 Jim_Obj *objPtr = (Jim_Obj*) key;
5602 int len, h;
5603
5604 str = Jim_GetString(objPtr, &len);
5605 h = Jim_GenHashFunction((unsigned char*)str, len);
5606 return h;
5607 }
5608
5609 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5610 {
5611 JIM_NOTUSED(privdata);
5612
5613 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5614 }
5615
5616 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5617 {
5618 Jim_Obj *objPtr = val;
5619
5620 Jim_DecrRefCount(interp, objPtr);
5621 }
5622
5623 static Jim_HashTableType JimDictHashTableType = {
5624 JimObjectHTHashFunction, /* hash function */
5625 NULL, /* key dup */
5626 NULL, /* val dup */
5627 JimObjectHTKeyCompare, /* key compare */
5628 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5629 JimObjectHTKeyValDestructor, /* key destructor */
5630 JimObjectHTKeyValDestructor /* val destructor */
5631 };
5632
5633 /* Note that while the elements of the dict may contain references,
5634 * the list object itself can't. This basically means that the
5635 * dict object string representation as a whole can't contain references
5636 * that are not presents in the single elements. */
5637 static Jim_ObjType dictObjType = {
5638 "dict",
5639 FreeDictInternalRep,
5640 DupDictInternalRep,
5641 UpdateStringOfDict,
5642 JIM_TYPE_NONE,
5643 };
5644
5645 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5646 {
5647 JIM_NOTUSED(interp);
5648
5649 Jim_FreeHashTable(objPtr->internalRep.ptr);
5650 Jim_Free(objPtr->internalRep.ptr);
5651 }
5652
5653 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5654 {
5655 Jim_HashTable *ht, *dupHt;
5656 Jim_HashTableIterator *htiter;
5657 Jim_HashEntry *he;
5658
5659 /* Create a new hash table */
5660 ht = srcPtr->internalRep.ptr;
5661 dupHt = Jim_Alloc(sizeof(*dupHt));
5662 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5663 if (ht->size != 0)
5664 Jim_ExpandHashTable(dupHt, ht->size);
5665 /* Copy every element from the source to the dup hash table */
5666 htiter = Jim_GetHashTableIterator(ht);
5667 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5668 const Jim_Obj *keyObjPtr = he->key;
5669 Jim_Obj *valObjPtr = he->val;
5670
5671 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5672 Jim_IncrRefCount(valObjPtr);
5673 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5674 }
5675 Jim_FreeHashTableIterator(htiter);
5676
5677 dupPtr->internalRep.ptr = dupHt;
5678 dupPtr->typePtr = &dictObjType;
5679 }
5680
5681 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5682 {
5683 int i, bufLen, realLength;
5684 const char *strRep;
5685 char *p;
5686 int *quotingType, objc;
5687 Jim_HashTable *ht;
5688 Jim_HashTableIterator *htiter;
5689 Jim_HashEntry *he;
5690 Jim_Obj **objv;
5691
5692 /* Trun the hash table into a flat vector of Jim_Objects. */
5693 ht = objPtr->internalRep.ptr;
5694 objc = ht->used*2;
5695 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5696 htiter = Jim_GetHashTableIterator(ht);
5697 i = 0;
5698 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5699 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5700 objv[i++] = he->val;
5701 }
5702 Jim_FreeHashTableIterator(htiter);
5703 /* (Over) Estimate the space needed. */
5704 quotingType = Jim_Alloc(sizeof(int)*objc);
5705 bufLen = 0;
5706 for (i = 0; i < objc; i++) {
5707 int len;
5708
5709 strRep = Jim_GetString(objv[i], &len);
5710 quotingType[i] = ListElementQuotingType(strRep, len);
5711 switch (quotingType[i]) {
5712 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5713 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5714 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5715 }
5716 bufLen++; /* elements separator. */
5717 }
5718 bufLen++;
5719
5720 /* Generate the string rep. */
5721 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5722 realLength = 0;
5723 for (i = 0; i < objc; i++) {
5724 int len, qlen;
5725 strRep = Jim_GetString(objv[i], &len);
5726 char *q;
5727
5728 switch (quotingType[i]) {
5729 case JIM_ELESTR_SIMPLE:
5730 memcpy(p, strRep, len);
5731 p += len;
5732 realLength += len;
5733 break;
5734 case JIM_ELESTR_BRACE:
5735 *p++ = '{';
5736 memcpy(p, strRep, len);
5737 p += len;
5738 *p++ = '}';
5739 realLength += len + 2;
5740 break;
5741 case JIM_ELESTR_QUOTE:
5742 q = BackslashQuoteString(strRep, len, &qlen);
5743 memcpy(p, q, qlen);
5744 Jim_Free(q);
5745 p += qlen;
5746 realLength += qlen;
5747 break;
5748 }
5749 /* Add a separating space */
5750 if (i + 1 != objc) {
5751 *p++ = ' ';
5752 realLength ++;
5753 }
5754 }
5755 *p = '\0'; /* nul term. */
5756 objPtr->length = realLength;
5757 Jim_Free(quotingType);
5758 Jim_Free(objv);
5759 }
5760
5761 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5762 {
5763 struct JimParserCtx parser;
5764 Jim_HashTable *ht;
5765 Jim_Obj *objv[2];
5766 const char *str;
5767 int i, strLen;
5768
5769 /* Get the string representation */
5770 str = Jim_GetString(objPtr, &strLen);
5771
5772 /* Free the old internal repr just now and initialize the
5773 * new one just now. The string->list conversion can't fail. */
5774 Jim_FreeIntRep(interp, objPtr);
5775 ht = Jim_Alloc(sizeof(*ht));
5776 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5777 objPtr->typePtr = &dictObjType;
5778 objPtr->internalRep.ptr = ht;
5779
5780 /* Convert into a dict */
5781 JimParserInit(&parser, str, strLen, 1);
5782 i = 0;
5783 while (!JimParserEof(&parser)) {
5784 char *token;
5785 int tokenLen, type;
5786
5787 JimParseList(&parser);
5788 if (JimParserTtype(&parser) != JIM_TT_STR &&
5789 JimParserTtype(&parser) != JIM_TT_ESC)
5790 continue;
5791 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5792 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5793 if (i == 2) {
5794 i = 0;
5795 Jim_IncrRefCount(objv[0]);
5796 Jim_IncrRefCount(objv[1]);
5797 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5798 Jim_HashEntry *he;
5799 he = Jim_FindHashEntry(ht, objv[0]);
5800 Jim_DecrRefCount(interp, objv[0]);
5801 /* ATTENTION: const cast */
5802 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5803 he->val = objv[1];
5804 }
5805 }
5806 }
5807 if (i) {
5808 Jim_FreeNewObj(interp, objv[0]);
5809 objPtr->typePtr = NULL;
5810 Jim_FreeHashTable(ht);
5811 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5812 return JIM_ERR;
5813 }
5814 return JIM_OK;
5815 }
5816
5817 /* Dict object API */
5818
5819 /* Add an element to a dict. objPtr must be of the "dict" type.
5820 * The higer-level exported function is Jim_DictAddElement().
5821 * If an element with the specified key already exists, the value
5822 * associated is replaced with the new one.
5823 *
5824 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5825 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5826 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5827 {
5828 Jim_HashTable *ht = objPtr->internalRep.ptr;
5829
5830 if (valueObjPtr == NULL) { /* unset */
5831 Jim_DeleteHashEntry(ht, keyObjPtr);
5832 return;
5833 }
5834 Jim_IncrRefCount(keyObjPtr);
5835 Jim_IncrRefCount(valueObjPtr);
5836 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5837 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5838 Jim_DecrRefCount(interp, keyObjPtr);
5839 /* ATTENTION: const cast */
5840 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5841 he->val = valueObjPtr;
5842 }
5843 }
5844
5845 /* Add an element, higher-level interface for DictAddElement().
5846 * If valueObjPtr == NULL, the key is removed if it exists. */
5847 static int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5848 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5849 {
5850 if (Jim_IsShared(objPtr))
5851 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5852 if (objPtr->typePtr != &dictObjType) {
5853 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5854 return JIM_ERR;
5855 }
5856 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5857 Jim_InvalidateStringRep(objPtr);
5858 return JIM_OK;
5859 }
5860
5861 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5862 {
5863 Jim_Obj *objPtr;
5864 int i;
5865
5866 if (len % 2)
5867 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5868
5869 objPtr = Jim_NewObj(interp);
5870 objPtr->typePtr = &dictObjType;
5871 objPtr->bytes = NULL;
5872 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5873 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5874 for (i = 0; i < len; i += 2)
5875 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5876 return objPtr;
5877 }
5878
5879 /* Return the value associated to the specified dict key */
5880 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5881 Jim_Obj **objPtrPtr, int flags)
5882 {
5883 Jim_HashEntry *he;
5884 Jim_HashTable *ht;
5885
5886 if (dictPtr->typePtr != &dictObjType) {
5887 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5888 return JIM_ERR;
5889 }
5890 ht = dictPtr->internalRep.ptr;
5891 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5892 if (flags & JIM_ERRMSG) {
5893 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5894 Jim_AppendStrings(interp, Jim_GetResult(interp),
5895 "key \"", Jim_GetString(keyPtr, NULL),
5896 "\" not found in dictionary", NULL);
5897 }
5898 return JIM_ERR;
5899 }
5900 *objPtrPtr = he->val;
5901 return JIM_OK;
5902 }
5903
5904 /* Return the value associated to the specified dict keys */
5905 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5906 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5907 {
5908 Jim_Obj *objPtr = NULL;
5909 int i;
5910
5911 if (keyc == 0) {
5912 *objPtrPtr = dictPtr;
5913 return JIM_OK;
5914 }
5915
5916 for (i = 0; i < keyc; i++) {
5917 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5918 != JIM_OK)
5919 return JIM_ERR;
5920 dictPtr = objPtr;
5921 }
5922 *objPtrPtr = objPtr;
5923 return JIM_OK;
5924 }
5925
5926 /* Modify the dict stored into the variable named 'varNamePtr'
5927 * setting the element specified by the 'keyc' keys objects in 'keyv',
5928 * with the new value of the element 'newObjPtr'.
5929 *
5930 * If newObjPtr == NULL the operation is to remove the given key
5931 * from the dictionary. */
5932 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5933 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5934 {
5935 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5936 int shared, i;
5937
5938 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5939 if (objPtr == NULL) {
5940 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5941 return JIM_ERR;
5942 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5943 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5944 Jim_FreeNewObj(interp, varObjPtr);
5945 return JIM_ERR;
5946 }
5947 }
5948 if ((shared = Jim_IsShared(objPtr)))
5949 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5950 for (i = 0; i < keyc-1; i++) {
5951 dictObjPtr = objPtr;
5952
5953 /* Check if it's a valid dictionary */
5954 if (dictObjPtr->typePtr != &dictObjType) {
5955 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5956 goto err;
5957 }
5958 /* Check if the given key exists. */
5959 Jim_InvalidateStringRep(dictObjPtr);
5960 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5961 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5962 {
5963 /* This key exists at the current level.
5964 * Make sure it's not shared!. */
5965 if (Jim_IsShared(objPtr)) {
5966 objPtr = Jim_DuplicateObj(interp, objPtr);
5967 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5968 }
5969 } else {
5970 /* Key not found. If it's an [unset] operation
5971 * this is an error. Only the last key may not
5972 * exist. */
5973 if (newObjPtr == NULL)
5974 goto err;
5975 /* Otherwise set an empty dictionary
5976 * as key's value. */
5977 objPtr = Jim_NewDictObj(interp, NULL, 0);
5978 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5979 }
5980 }
5981 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5982 != JIM_OK)
5983 goto err;
5984 Jim_InvalidateStringRep(objPtr);
5985 Jim_InvalidateStringRep(varObjPtr);
5986 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5987 goto err;
5988 Jim_SetResult(interp, varObjPtr);
5989 return JIM_OK;
5990 err:
5991 if (shared) {
5992 Jim_FreeNewObj(interp, varObjPtr);
5993 }
5994 return JIM_ERR;
5995 }
5996
5997 /* -----------------------------------------------------------------------------
5998 * Index object
5999 * ---------------------------------------------------------------------------*/
6000 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6001 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6002
6003 static Jim_ObjType indexObjType = {
6004 "index",
6005 NULL,
6006 NULL,
6007 UpdateStringOfIndex,
6008 JIM_TYPE_NONE,
6009 };
6010
6011 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6012 {
6013 int len;
6014 char buf[JIM_INTEGER_SPACE + 1];
6015
6016 if (objPtr->internalRep.indexValue >= 0)
6017 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6018 else if (objPtr->internalRep.indexValue == -1)
6019 len = sprintf(buf, "end");
6020 else {
6021 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6022 }
6023 objPtr->bytes = Jim_Alloc(len + 1);
6024 memcpy(objPtr->bytes, buf, len + 1);
6025 objPtr->length = len;
6026 }
6027
6028 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6029 {
6030 int index_t, end = 0;
6031 const char *str;
6032
6033 /* Get the string representation */
6034 str = Jim_GetString(objPtr, NULL);
6035 /* Try to convert into an index */
6036 if (!strcmp(str, "end")) {
6037 index_t = 0;
6038 end = 1;
6039 } else {
6040 if (!strncmp(str, "end-", 4)) {
6041 str += 4;
6042 end = 1;
6043 }
6044 if (Jim_StringToIndex(str, &index_t) != JIM_OK) {
6045 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6046 Jim_AppendStrings(interp, Jim_GetResult(interp),
6047 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6048 "must be integer or end?-integer?", NULL);
6049 return JIM_ERR;
6050 }
6051 }
6052 if (end) {
6053 if (index_t < 0)
6054 index_t = INT_MAX;
6055 else
6056 index_t = -(index_t + 1);
6057 } else if (index_t < 0)
6058 index_t = -INT_MAX;
6059 /* Free the old internal repr and set the new one. */
6060 Jim_FreeIntRep(interp, objPtr);
6061 objPtr->typePtr = &indexObjType;
6062 objPtr->internalRep.indexValue = index_t;
6063 return JIM_OK;
6064 }
6065
6066 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6067 {
6068 /* Avoid shimmering if the object is an integer. */
6069 if (objPtr->typePtr == &intObjType) {
6070 jim_wide val = objPtr->internalRep.wideValue;
6071 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6072 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6073 return JIM_OK;
6074 }
6075 }
6076 if (objPtr->typePtr != &indexObjType &&
6077 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6078 return JIM_ERR;
6079 *indexPtr = objPtr->internalRep.indexValue;
6080 return JIM_OK;
6081 }
6082
6083 /* -----------------------------------------------------------------------------
6084 * Return Code Object.
6085 * ---------------------------------------------------------------------------*/
6086
6087 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6088
6089 static Jim_ObjType returnCodeObjType = {
6090 "return-code",
6091 NULL,
6092 NULL,
6093 NULL,
6094 JIM_TYPE_NONE,
6095 };
6096
6097 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6098 {
6099 const char *str;
6100 int strLen, returnCode;
6101 jim_wide wideValue;
6102
6103 /* Get the string representation */
6104 str = Jim_GetString(objPtr, &strLen);
6105 /* Try to convert into an integer */
6106 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6107 returnCode = (int) wideValue;
6108 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6109 returnCode = JIM_OK;
6110 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6111 returnCode = JIM_ERR;
6112 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6113 returnCode = JIM_RETURN;
6114 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6115 returnCode = JIM_BREAK;
6116 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6117 returnCode = JIM_CONTINUE;
6118 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6119 returnCode = JIM_EVAL;
6120 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6121 returnCode = JIM_EXIT;
6122 else {
6123 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6124 Jim_AppendStrings(interp, Jim_GetResult(interp),
6125 "expected return code but got '", str, "'",
6126 NULL);
6127 return JIM_ERR;
6128 }
6129 /* Free the old internal repr and set the new one. */
6130 Jim_FreeIntRep(interp, objPtr);
6131 objPtr->typePtr = &returnCodeObjType;
6132 objPtr->internalRep.returnCode = returnCode;
6133 return JIM_OK;
6134 }
6135
6136 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6137 {
6138 if (objPtr->typePtr != &returnCodeObjType &&
6139 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6140 return JIM_ERR;
6141 *intPtr = objPtr->internalRep.returnCode;
6142 return JIM_OK;
6143 }
6144
6145 /* -----------------------------------------------------------------------------
6146 * Expression Parsing
6147 * ---------------------------------------------------------------------------*/
6148 static int JimParseExprOperator(struct JimParserCtx *pc);
6149 static int JimParseExprNumber(struct JimParserCtx *pc);
6150 static int JimParseExprIrrational(struct JimParserCtx *pc);
6151
6152 /* Exrp's Stack machine operators opcodes. */
6153
6154 /* Binary operators (numbers) */
6155 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6156 #define JIM_EXPROP_MUL 0
6157 #define JIM_EXPROP_DIV 1
6158 #define JIM_EXPROP_MOD 2
6159 #define JIM_EXPROP_SUB 3
6160 #define JIM_EXPROP_ADD 4
6161 #define JIM_EXPROP_LSHIFT 5
6162 #define JIM_EXPROP_RSHIFT 6
6163 #define JIM_EXPROP_ROTL 7
6164 #define JIM_EXPROP_ROTR 8
6165 #define JIM_EXPROP_LT 9
6166 #define JIM_EXPROP_GT 10
6167 #define JIM_EXPROP_LTE 11
6168 #define JIM_EXPROP_GTE 12
6169 #define JIM_EXPROP_NUMEQ 13
6170 #define JIM_EXPROP_NUMNE 14
6171 #define JIM_EXPROP_BITAND 15
6172 #define JIM_EXPROP_BITXOR 16
6173 #define JIM_EXPROP_BITOR 17
6174 #define JIM_EXPROP_LOGICAND 18
6175 #define JIM_EXPROP_LOGICOR 19
6176 #define JIM_EXPROP_LOGICAND_LEFT 20
6177 #define JIM_EXPROP_LOGICOR_LEFT 21
6178 #define JIM_EXPROP_POW 22
6179 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6180
6181 /* Binary operators (strings) */
6182 #define JIM_EXPROP_STREQ 23
6183 #define JIM_EXPROP_STRNE 24
6184
6185 /* Unary operators (numbers) */
6186 #define JIM_EXPROP_NOT 25
6187 #define JIM_EXPROP_BITNOT 26
6188 #define JIM_EXPROP_UNARYMINUS 27
6189 #define JIM_EXPROP_UNARYPLUS 28
6190 #define JIM_EXPROP_LOGICAND_RIGHT 29
6191 #define JIM_EXPROP_LOGICOR_RIGHT 30
6192
6193 /* Ternary operators */
6194 #define JIM_EXPROP_TERNARY 31
6195
6196 /* Operands */
6197 #define JIM_EXPROP_NUMBER 32
6198 #define JIM_EXPROP_COMMAND 33
6199 #define JIM_EXPROP_VARIABLE 34
6200 #define JIM_EXPROP_DICTSUGAR 35
6201 #define JIM_EXPROP_SUBST 36
6202 #define JIM_EXPROP_STRING 37
6203
6204 /* Operators table */
6205 typedef struct Jim_ExprOperator {
6206 const char *name;
6207 int precedence;
6208 int arity;
6209 int opcode;
6210 } Jim_ExprOperator;
6211
6212 /* name - precedence - arity - opcode */
6213 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6214 {"!", 300, 1, JIM_EXPROP_NOT},
6215 {"~", 300, 1, JIM_EXPROP_BITNOT},
6216 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6217 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6218
6219 {"**", 250, 2, JIM_EXPROP_POW},
6220
6221 {"*", 200, 2, JIM_EXPROP_MUL},
6222 {"/", 200, 2, JIM_EXPROP_DIV},
6223 {"%", 200, 2, JIM_EXPROP_MOD},
6224
6225 {"-", 100, 2, JIM_EXPROP_SUB},
6226 {"+", 100, 2, JIM_EXPROP_ADD},
6227
6228 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6229 {">>>", 90, 3, JIM_EXPROP_ROTR},
6230 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6231 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6232
6233 {"<", 80, 2, JIM_EXPROP_LT},
6234 {">", 80, 2, JIM_EXPROP_GT},
6235 {"<=", 80, 2, JIM_EXPROP_LTE},
6236 {">=", 80, 2, JIM_EXPROP_GTE},
6237
6238 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6239 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6240
6241 {"eq", 60, 2, JIM_EXPROP_STREQ},
6242 {"ne", 60, 2, JIM_EXPROP_STRNE},
6243
6244 {"&", 50, 2, JIM_EXPROP_BITAND},
6245 {"^", 49, 2, JIM_EXPROP_BITXOR},
6246 {"|", 48, 2, JIM_EXPROP_BITOR},
6247
6248 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6249 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6250
6251 {"?", 5, 3, JIM_EXPROP_TERNARY},
6252 /* private operators */
6253 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6254 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6255 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6256 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6257 };
6258
6259 #define JIM_EXPR_OPERATORS_NUM \
6260 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6261
6262 static int JimParseExpression(struct JimParserCtx *pc)
6263 {
6264 /* Discard spaces and quoted newline */
6265 while (*(pc->p) == ' ' ||
6266 *(pc->p) == '\t' ||
6267 *(pc->p) == '\r' ||
6268 *(pc->p) == '\n' ||
6269 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6270 pc->p++; pc->len--;
6271 }
6272
6273 if (pc->len == 0) {
6274 pc->tstart = pc->tend = pc->p;
6275 pc->tline = pc->linenr;
6276 pc->tt = JIM_TT_EOL;
6277 pc->eof = 1;
6278 return JIM_OK;
6279 }
6280 switch (*(pc->p)) {
6281 case '(':
6282 pc->tstart = pc->tend = pc->p;
6283 pc->tline = pc->linenr;
6284 pc->tt = JIM_TT_SUBEXPR_START;
6285 pc->p++; pc->len--;
6286 break;
6287 case ')':
6288 pc->tstart = pc->tend = pc->p;
6289 pc->tline = pc->linenr;
6290 pc->tt = JIM_TT_SUBEXPR_END;
6291 pc->p++; pc->len--;
6292 break;
6293 case '[':
6294 return JimParseCmd(pc);
6295 break;
6296 case '$':
6297 if (JimParseVar(pc) == JIM_ERR)
6298 return JimParseExprOperator(pc);
6299 else
6300 return JIM_OK;
6301 break;
6302 case '-':
6303 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6304 isdigit((int)*(pc->p + 1)))
6305 return JimParseExprNumber(pc);
6306 else
6307 return JimParseExprOperator(pc);
6308 break;
6309 case '0': case '1': case '2': case '3': case '4':
6310 case '5': case '6': case '7': case '8': case '9': case '.':
6311 return JimParseExprNumber(pc);
6312 break;
6313 case '"':
6314 case '{':
6315 /* Here it's possible to reuse the List String parsing. */
6316 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6317 return JimParseListStr(pc);
6318 break;
6319 case 'N': case 'I':
6320 case 'n': case 'i':
6321 if (JimParseExprIrrational(pc) == JIM_ERR)
6322 return JimParseExprOperator(pc);
6323 break;
6324 default:
6325 return JimParseExprOperator(pc);
6326 break;
6327 }
6328 return JIM_OK;
6329 }
6330
6331 int JimParseExprNumber(struct JimParserCtx *pc)
6332 {
6333 int allowdot = 1;
6334 int allowhex = 0;
6335
6336 pc->tstart = pc->p;
6337 pc->tline = pc->linenr;
6338 if (*pc->p == '-') {
6339 pc->p++; pc->len--;
6340 }
6341 while (isdigit((int)*pc->p)
6342 || (allowhex && isxdigit((int)*pc->p))
6343 || (allowdot && *pc->p == '.')
6344 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6345 (*pc->p == 'x' || *pc->p == 'X'))
6346 )
6347 {
6348 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6349 allowhex = 1;
6350 allowdot = 0;
6351 }
6352 if (*pc->p == '.')
6353 allowdot = 0;
6354 pc->p++; pc->len--;
6355 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6356 pc->p += 2; pc->len -= 2;
6357 }
6358 }
6359 pc->tend = pc->p-1;
6360 pc->tt = JIM_TT_EXPR_NUMBER;
6361 return JIM_OK;
6362 }
6363
6364 int JimParseExprIrrational(struct JimParserCtx *pc)
6365 {
6366 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6367 const char **token;
6368 for (token = Tokens; *token != NULL; token++) {
6369 int len = strlen(*token);
6370 if (strncmp(*token, pc->p, len) == 0) {
6371 pc->tstart = pc->p;
6372 pc->tend = pc->p + len - 1;
6373 pc->p += len; pc->len -= len;
6374 pc->tline = pc->linenr;
6375 pc->tt = JIM_TT_EXPR_NUMBER;
6376 return JIM_OK;
6377 }
6378 }
6379 return JIM_ERR;
6380 }
6381
6382 int JimParseExprOperator(struct JimParserCtx *pc)
6383 {
6384 int i;
6385 int bestIdx = -1, bestLen = 0;
6386
6387 /* Try to get the longest match. */
6388 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6389 const char *opname;
6390 int oplen;
6391
6392 opname = Jim_ExprOperators[i].name;
6393 if (opname == NULL) continue;
6394 oplen = strlen(opname);
6395
6396 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6397 bestIdx = i;
6398 bestLen = oplen;
6399 }
6400 }
6401 if (bestIdx == -1) return JIM_ERR;
6402 pc->tstart = pc->p;
6403 pc->tend = pc->p + bestLen - 1;
6404 pc->p += bestLen; pc->len -= bestLen;
6405 pc->tline = pc->linenr;
6406 pc->tt = JIM_TT_EXPR_OPERATOR;
6407 return JIM_OK;
6408 }
6409
6410 static struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6411 {
6412 int i;
6413 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6414 if (Jim_ExprOperators[i].name &&
6415 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6416 return &Jim_ExprOperators[i];
6417 return NULL;
6418 }
6419
6420 static struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6421 {
6422 int i;
6423 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6424 if (Jim_ExprOperators[i].opcode == opcode)
6425 return &Jim_ExprOperators[i];
6426 return NULL;
6427 }
6428
6429 /* -----------------------------------------------------------------------------
6430 * Expression Object
6431 * ---------------------------------------------------------------------------*/
6432 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6433 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6434 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6435
6436 static Jim_ObjType exprObjType = {
6437 "expression",
6438 FreeExprInternalRep,
6439 DupExprInternalRep,
6440 NULL,
6441 JIM_TYPE_REFERENCES,
6442 };
6443
6444 /* Expr bytecode structure */
6445 typedef struct ExprByteCode {
6446 int *opcode; /* Integer array of opcodes. */
6447 Jim_Obj **obj; /* Array of associated Jim Objects. */
6448 int len; /* Bytecode length */
6449 int inUse; /* Used for sharing. */
6450 } ExprByteCode;
6451
6452 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6453 {
6454 int i;
6455 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6456
6457 expr->inUse--;
6458 if (expr->inUse != 0) return;
6459 for (i = 0; i < expr->len; i++)
6460 Jim_DecrRefCount(interp, expr->obj[i]);
6461 Jim_Free(expr->opcode);
6462 Jim_Free(expr->obj);
6463 Jim_Free(expr);
6464 }
6465
6466 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6467 {
6468 JIM_NOTUSED(interp);
6469 JIM_NOTUSED(srcPtr);
6470
6471 /* Just returns an simple string. */
6472 dupPtr->typePtr = NULL;
6473 }
6474
6475 /* Add a new instruction to an expression bytecode structure. */
6476 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6477 int opcode, char *str, int len)
6478 {
6479 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6480 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6481 expr->opcode[expr->len] = opcode;
6482 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6483 Jim_IncrRefCount(expr->obj[expr->len]);
6484 expr->len++;
6485 }
6486
6487 /* Check if an expr program looks correct. */
6488 static int ExprCheckCorrectness(ExprByteCode *expr)
6489 {
6490 int i;
6491 int stacklen = 0;
6492
6493 /* Try to check if there are stack underflows,
6494 * and make sure at the end of the program there is
6495 * a single result on the stack. */
6496 for (i = 0; i < expr->len; i++) {
6497 switch (expr->opcode[i]) {
6498 case JIM_EXPROP_NUMBER:
6499 case JIM_EXPROP_STRING:
6500 case JIM_EXPROP_SUBST:
6501 case JIM_EXPROP_VARIABLE:
6502 case JIM_EXPROP_DICTSUGAR:
6503 case JIM_EXPROP_COMMAND:
6504 stacklen++;
6505 break;
6506 case JIM_EXPROP_NOT:
6507 case JIM_EXPROP_BITNOT:
6508 case JIM_EXPROP_UNARYMINUS:
6509 case JIM_EXPROP_UNARYPLUS:
6510 /* Unary operations */
6511 if (stacklen < 1) return JIM_ERR;
6512 break;
6513 case JIM_EXPROP_ADD:
6514 case JIM_EXPROP_SUB:
6515 case JIM_EXPROP_MUL:
6516 case JIM_EXPROP_DIV:
6517 case JIM_EXPROP_MOD:
6518 case JIM_EXPROP_LT:
6519 case JIM_EXPROP_GT:
6520 case JIM_EXPROP_LTE:
6521 case JIM_EXPROP_GTE:
6522 case JIM_EXPROP_ROTL:
6523 case JIM_EXPROP_ROTR:
6524 case JIM_EXPROP_LSHIFT:
6525 case JIM_EXPROP_RSHIFT:
6526 case JIM_EXPROP_NUMEQ:
6527 case JIM_EXPROP_NUMNE:
6528 case JIM_EXPROP_STREQ:
6529 case JIM_EXPROP_STRNE:
6530 case JIM_EXPROP_BITAND:
6531 case JIM_EXPROP_BITXOR:
6532 case JIM_EXPROP_BITOR:
6533 case JIM_EXPROP_LOGICAND:
6534 case JIM_EXPROP_LOGICOR:
6535 case JIM_EXPROP_POW:
6536 /* binary operations */
6537 if (stacklen < 2) return JIM_ERR;
6538 stacklen--;
6539 break;
6540 default:
6541 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6542 break;
6543 }
6544 }
6545 if (stacklen != 1) return JIM_ERR;
6546 return JIM_OK;
6547 }
6548
6549 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6550 ScriptObj *topLevelScript)
6551 {
6552 int i;
6553
6554 return;
6555 for (i = 0; i < expr->len; i++) {
6556 Jim_Obj *foundObjPtr;
6557
6558 if (expr->obj[i] == NULL) continue;
6559 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6560 NULL, expr->obj[i]);
6561 if (foundObjPtr != NULL) {
6562 Jim_IncrRefCount(foundObjPtr);
6563 Jim_DecrRefCount(interp, expr->obj[i]);
6564 expr->obj[i] = foundObjPtr;
6565 }
6566 }
6567 }
6568
6569 /* This procedure converts every occurrence of || and && opereators
6570 * in lazy unary versions.
6571 *
6572 * a b || is converted into:
6573 *
6574 * a <offset> |L b |R
6575 *
6576 * a b && is converted into:
6577 *
6578 * a <offset> &L b &R
6579 *
6580 * "|L" checks if 'a' is true:
6581 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6582 * the opcode just after |R.
6583 * 2) if it is false does nothing.
6584 * "|R" checks if 'b' is true:
6585 * 1) if it is true pushes 1, otherwise pushes 0.
6586 *
6587 * "&L" checks if 'a' is true:
6588 * 1) if it is true does nothing.
6589 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6590 * the opcode just after &R
6591 * "&R" checks if 'a' is true:
6592 * if it is true pushes 1, otherwise pushes 0.
6593 */
6594 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6595 {
6596 while (1) {
6597 int index_t = -1, leftindex, arity, i, offset;
6598 Jim_ExprOperator *op;
6599
6600 /* Search for || or && */
6601 for (i = 0; i < expr->len; i++) {
6602 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6603 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6604 index_t = i;
6605 break;
6606 }
6607 }
6608 if (index_t == -1) return;
6609 /* Search for the end of the first operator */
6610 leftindex = index_t-1;
6611 arity = 1;
6612 while (arity) {
6613 switch (expr->opcode[leftindex]) {
6614 case JIM_EXPROP_NUMBER:
6615 case JIM_EXPROP_COMMAND:
6616 case JIM_EXPROP_VARIABLE:
6617 case JIM_EXPROP_DICTSUGAR:
6618 case JIM_EXPROP_SUBST:
6619 case JIM_EXPROP_STRING:
6620 break;
6621 default:
6622 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6623 if (op == NULL) {
6624 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6625 }
6626 arity += op->arity;
6627 break;
6628 }
6629 arity--;
6630 leftindex--;
6631 }
6632 leftindex++;
6633 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6634 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6635 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6636 sizeof(int)*(expr->len-leftindex));
6637 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6638 sizeof(Jim_Obj*)*(expr->len-leftindex));
6639 expr->len += 2;
6640 index_t += 2;
6641 offset = (index_t-leftindex)-1;
6642 Jim_DecrRefCount(interp, expr->obj[index_t]);
6643 if (expr->opcode[index_t] == JIM_EXPROP_LOGICAND) {
6644 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6645 expr->opcode[index_t] = JIM_EXPROP_LOGICAND_RIGHT;
6646 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6647 expr->obj[index_t] = Jim_NewStringObj(interp, "&R", -1);
6648 } else {
6649 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6650 expr->opcode[index_t] = JIM_EXPROP_LOGICOR_RIGHT;
6651 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6652 expr->obj[index_t] = Jim_NewStringObj(interp, "|R", -1);
6653 }
6654 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6655 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6656 Jim_IncrRefCount(expr->obj[index_t]);
6657 Jim_IncrRefCount(expr->obj[leftindex]);
6658 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6659 }
6660 }
6661
6662 /* This method takes the string representation of an expression
6663 * and generates a program for the Expr's stack-based VM. */
6664 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6665 {
6666 int exprTextLen;
6667 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6668 struct JimParserCtx parser;
6669 int i, shareLiterals;
6670 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6671 Jim_Stack stack;
6672 Jim_ExprOperator *op;
6673
6674 /* Perform literal sharing with the current procedure
6675 * running only if this expression appears to be not generated
6676 * at runtime. */
6677 shareLiterals = objPtr->typePtr == &sourceObjType;
6678
6679 expr->opcode = NULL;
6680 expr->obj = NULL;
6681 expr->len = 0;
6682 expr->inUse = 1;
6683
6684 Jim_InitStack(&stack);
6685 JimParserInit(&parser, exprText, exprTextLen, 1);
6686 while (!JimParserEof(&parser)) {
6687 char *token;
6688 int len, type;
6689
6690 if (JimParseExpression(&parser) != JIM_OK) {
6691 Jim_SetResultString(interp, "Syntax error in expression", -1);
6692 goto err;
6693 }
6694 token = JimParserGetToken(&parser, &len, &type, NULL);
6695 if (type == JIM_TT_EOL) {
6696 Jim_Free(token);
6697 break;
6698 }
6699 switch (type) {
6700 case JIM_TT_STR:
6701 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6702 break;
6703 case JIM_TT_ESC:
6704 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6705 break;
6706 case JIM_TT_VAR:
6707 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6708 break;
6709 case JIM_TT_DICTSUGAR:
6710 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6711 break;
6712 case JIM_TT_CMD:
6713 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6714 break;
6715 case JIM_TT_EXPR_NUMBER:
6716 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6717 break;
6718 case JIM_TT_EXPR_OPERATOR:
6719 op = JimExprOperatorInfo(token);
6720 while (1) {
6721 Jim_ExprOperator *stackTopOp;
6722
6723 if (Jim_StackPeek(&stack) != NULL) {
6724 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6725 } else {
6726 stackTopOp = NULL;
6727 }
6728 if (Jim_StackLen(&stack) && op->arity != 1 &&
6729 stackTopOp && stackTopOp->precedence >= op->precedence)
6730 {
6731 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6732 Jim_StackPeek(&stack), -1);
6733 Jim_StackPop(&stack);
6734 } else {
6735 break;
6736 }
6737 }
6738 Jim_StackPush(&stack, token);
6739 break;
6740 case JIM_TT_SUBEXPR_START:
6741 Jim_StackPush(&stack, Jim_StrDup("("));
6742 Jim_Free(token);
6743 break;
6744 case JIM_TT_SUBEXPR_END:
6745 {
6746 int found = 0;
6747 while (Jim_StackLen(&stack)) {
6748 char *opstr = Jim_StackPop(&stack);
6749 if (!strcmp(opstr, "(")) {
6750 Jim_Free(opstr);
6751 found = 1;
6752 break;
6753 }
6754 op = JimExprOperatorInfo(opstr);
6755 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6756 }
6757 if (!found) {
6758 Jim_SetResultString(interp,
6759 "Unexpected close parenthesis", -1);
6760 goto err;
6761 }
6762 }
6763 Jim_Free(token);
6764 break;
6765 default:
6766 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6767 break;
6768 }
6769 }
6770 while (Jim_StackLen(&stack)) {
6771 char *opstr = Jim_StackPop(&stack);
6772 op = JimExprOperatorInfo(opstr);
6773 if (op == NULL && !strcmp(opstr, "(")) {
6774 Jim_Free(opstr);
6775 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6776 goto err;
6777 }
6778 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6779 }
6780 /* Check program correctness. */
6781 if (ExprCheckCorrectness(expr) != JIM_OK) {
6782 Jim_SetResultString(interp, "Invalid expression", -1);
6783 goto err;
6784 }
6785
6786 /* Free the stack used for the compilation. */
6787 Jim_FreeStackElements(&stack, Jim_Free);
6788 Jim_FreeStack(&stack);
6789
6790 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6791 ExprMakeLazy(interp, expr);
6792
6793 /* Perform literal sharing */
6794 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6795 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6796 if (bodyObjPtr->typePtr == &scriptObjType) {
6797 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6798 ExprShareLiterals(interp, expr, bodyScript);
6799 }
6800 }
6801
6802 /* Free the old internal rep and set the new one. */
6803 Jim_FreeIntRep(interp, objPtr);
6804 Jim_SetIntRepPtr(objPtr, expr);
6805 objPtr->typePtr = &exprObjType;
6806 return JIM_OK;
6807
6808 err: /* we jump here on syntax/compile errors. */
6809 Jim_FreeStackElements(&stack, Jim_Free);
6810 Jim_FreeStack(&stack);
6811 Jim_Free(expr->opcode);
6812 for (i = 0; i < expr->len; i++) {
6813 Jim_DecrRefCount(interp,expr->obj[i]);
6814 }
6815 Jim_Free(expr->obj);
6816 Jim_Free(expr);
6817 return JIM_ERR;
6818 }
6819
6820 static ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6821 {
6822 if (objPtr->typePtr != &exprObjType) {
6823 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6824 return NULL;
6825 }
6826 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6827 }
6828
6829 /* -----------------------------------------------------------------------------
6830 * Expressions evaluation.
6831 * Jim uses a specialized stack-based virtual machine for expressions,
6832 * that takes advantage of the fact that expr's operators
6833 * can't be redefined.
6834 *
6835 * Jim_EvalExpression() uses the bytecode compiled by
6836 * SetExprFromAny() method of the "expression" object.
6837 *
6838 * On success a Tcl Object containing the result of the evaluation
6839 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6840 * returned.
6841 * On error the function returns a retcode != to JIM_OK and set a suitable
6842 * error on the interp.
6843 * ---------------------------------------------------------------------------*/
6844 #define JIM_EE_STATICSTACK_LEN 10
6845
6846 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6847 Jim_Obj **exprResultPtrPtr)
6848 {
6849 ExprByteCode *expr;
6850 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6851 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6852
6853 Jim_IncrRefCount(exprObjPtr);
6854 expr = Jim_GetExpression(interp, exprObjPtr);
6855 if (!expr) {
6856 Jim_DecrRefCount(interp, exprObjPtr);
6857 return JIM_ERR; /* error in expression. */
6858 }
6859 /* In order to avoid that the internal repr gets freed due to
6860 * shimmering of the exprObjPtr's object, we make the internal rep
6861 * shared. */
6862 expr->inUse++;
6863
6864 /* The stack-based expr VM itself */
6865
6866 /* Stack allocation. Expr programs have the feature that
6867 * a program of length N can't require a stack longer than
6868 * N. */
6869 if (expr->len > JIM_EE_STATICSTACK_LEN)
6870 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6871 else
6872 stack = staticStack;
6873
6874 /* Execute every istruction */
6875 for (i = 0; i < expr->len; i++) {
6876 Jim_Obj *A, *B, *objPtr;
6877 jim_wide wA, wB, wC;
6878 double dA, dB, dC;
6879 const char *sA, *sB;
6880 int Alen, Blen, retcode;
6881 int opcode = expr->opcode[i];
6882
6883 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6884 stack[stacklen++] = expr->obj[i];
6885 Jim_IncrRefCount(expr->obj[i]);
6886 } else if (opcode == JIM_EXPROP_VARIABLE) {
6887 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6888 if (objPtr == NULL) {
6889 error = 1;
6890 goto err;
6891 }
6892 stack[stacklen++] = objPtr;
6893 Jim_IncrRefCount(objPtr);
6894 } else if (opcode == JIM_EXPROP_SUBST) {
6895 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6896 &objPtr, JIM_NONE)) != JIM_OK)
6897 {
6898 error = 1;
6899 errRetCode = retcode;
6900 goto err;
6901 }
6902 stack[stacklen++] = objPtr;
6903 Jim_IncrRefCount(objPtr);
6904 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6905 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6906 if (objPtr == NULL) {
6907 error = 1;
6908 goto err;
6909 }
6910 stack[stacklen++] = objPtr;
6911 Jim_IncrRefCount(objPtr);
6912 } else if (opcode == JIM_EXPROP_COMMAND) {
6913 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6914 error = 1;
6915 errRetCode = retcode;
6916 goto err;
6917 }
6918 stack[stacklen++] = interp->result;
6919 Jim_IncrRefCount(interp->result);
6920 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6921 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6922 {
6923 /* Note that there isn't to increment the
6924 * refcount of objects. the references are moved
6925 * from stack to A and B. */
6926 B = stack[--stacklen];
6927 A = stack[--stacklen];
6928
6929 /* --- Integer --- */
6930 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6931 (B->typePtr == &doubleObjType && !B->bytes) ||
6932 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6933 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6934 goto trydouble;
6935 }
6936 Jim_DecrRefCount(interp, A);
6937 Jim_DecrRefCount(interp, B);
6938 switch (expr->opcode[i]) {
6939 case JIM_EXPROP_ADD: wC = wA + wB; break;
6940 case JIM_EXPROP_SUB: wC = wA-wB; break;
6941 case JIM_EXPROP_MUL: wC = wA*wB; break;
6942 case JIM_EXPROP_LT: wC = wA < wB; break;
6943 case JIM_EXPROP_GT: wC = wA > wB; break;
6944 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6945 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6946 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6947 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6948 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6949 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6950 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6951 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6952 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6953 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6954 case JIM_EXPROP_LOGICAND_LEFT:
6955 if (wA == 0) {
6956 i += (int)wB;
6957 wC = 0;
6958 } else {
6959 continue;
6960 }
6961 break;
6962 case JIM_EXPROP_LOGICOR_LEFT:
6963 if (wA != 0) {
6964 i += (int)wB;
6965 wC = 1;
6966 } else {
6967 continue;
6968 }
6969 break;
6970 case JIM_EXPROP_DIV:
6971 if (wB == 0) goto divbyzero;
6972 wC = wA/wB;
6973 break;
6974 case JIM_EXPROP_MOD:
6975 if (wB == 0) goto divbyzero;
6976 wC = wA%wB;
6977 break;
6978 case JIM_EXPROP_ROTL: {
6979 /* uint32_t would be better. But not everyone has inttypes.h?*/
6980 unsigned long uA = (unsigned long)wA;
6981 #ifdef _MSC_VER
6982 wC = _rotl(uA,(unsigned long)wB);
6983 #else
6984 const unsigned int S = sizeof(unsigned long) * 8;
6985 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
6986 #endif
6987 break;
6988 }
6989 case JIM_EXPROP_ROTR: {
6990 unsigned long uA = (unsigned long)wA;
6991 #ifdef _MSC_VER
6992 wC = _rotr(uA,(unsigned long)wB);
6993 #else
6994 const unsigned int S = sizeof(unsigned long) * 8;
6995 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
6996 #endif
6997 break;
6998 }
6999
7000 default:
7001 wC = 0; /* avoid gcc warning */
7002 break;
7003 }
7004 stack[stacklen] = Jim_NewIntObj(interp, wC);
7005 Jim_IncrRefCount(stack[stacklen]);
7006 stacklen++;
7007 continue;
7008 trydouble:
7009 /* --- Double --- */
7010 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7011 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7012
7013 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7014 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7015 opcode = JIM_EXPROP_STRNE;
7016 goto retry_as_string;
7017 }
7018 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7019 opcode = JIM_EXPROP_STREQ;
7020 goto retry_as_string;
7021 }
7022 Jim_DecrRefCount(interp, A);
7023 Jim_DecrRefCount(interp, B);
7024 error = 1;
7025 goto err;
7026 }
7027 Jim_DecrRefCount(interp, A);
7028 Jim_DecrRefCount(interp, B);
7029 switch (expr->opcode[i]) {
7030 case JIM_EXPROP_ROTL:
7031 case JIM_EXPROP_ROTR:
7032 case JIM_EXPROP_LSHIFT:
7033 case JIM_EXPROP_RSHIFT:
7034 case JIM_EXPROP_BITAND:
7035 case JIM_EXPROP_BITXOR:
7036 case JIM_EXPROP_BITOR:
7037 case JIM_EXPROP_MOD:
7038 case JIM_EXPROP_POW:
7039 Jim_SetResultString(interp,
7040 "Got floating-point value where integer was expected", -1);
7041 error = 1;
7042 goto err;
7043 case JIM_EXPROP_ADD: dC = dA + dB; break;
7044 case JIM_EXPROP_SUB: dC = dA-dB; break;
7045 case JIM_EXPROP_MUL: dC = dA*dB; break;
7046 case JIM_EXPROP_LT: dC = dA < dB; break;
7047 case JIM_EXPROP_GT: dC = dA > dB; break;
7048 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7049 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7050 /* FIXME comparing floats for equality/inequality is bad juju */
7051 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7052 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7053 case JIM_EXPROP_LOGICAND_LEFT:
7054 if (dA == 0) {
7055 i += (int)dB;
7056 dC = 0;
7057 } else {
7058 continue;
7059 }
7060 break;
7061 case JIM_EXPROP_LOGICOR_LEFT:
7062 if (dA != 0) {
7063 i += (int)dB;
7064 dC = 1;
7065 } else {
7066 continue;
7067 }
7068 break;
7069 case JIM_EXPROP_DIV:
7070 if (dB == 0) goto divbyzero;
7071 dC = dA/dB;
7072 break;
7073 default:
7074 dC = 0; /* avoid gcc warning */
7075 break;
7076 }
7077 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7078 Jim_IncrRefCount(stack[stacklen]);
7079 stacklen++;
7080 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7081 B = stack[--stacklen];
7082 A = stack[--stacklen];
7083 retry_as_string:
7084 sA = Jim_GetString(A, &Alen);
7085 sB = Jim_GetString(B, &Blen);
7086 switch (opcode) {
7087 case JIM_EXPROP_STREQ:
7088 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7089 wC = 1;
7090 else
7091 wC = 0;
7092 break;
7093 case JIM_EXPROP_STRNE:
7094 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7095 wC = 1;
7096 else
7097 wC = 0;
7098 break;
7099 default:
7100 wC = 0; /* avoid gcc warning */
7101 break;
7102 }
7103 Jim_DecrRefCount(interp, A);
7104 Jim_DecrRefCount(interp, B);
7105 stack[stacklen] = Jim_NewIntObj(interp, wC);
7106 Jim_IncrRefCount(stack[stacklen]);
7107 stacklen++;
7108 } else if (opcode == JIM_EXPROP_NOT ||
7109 opcode == JIM_EXPROP_BITNOT ||
7110 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7111 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7112 /* Note that there isn't to increment the
7113 * refcount of objects. the references are moved
7114 * from stack to A and B. */
7115 A = stack[--stacklen];
7116
7117 /* --- Integer --- */
7118 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7119 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7120 goto trydouble_unary;
7121 }
7122 Jim_DecrRefCount(interp, A);
7123 switch (expr->opcode[i]) {
7124 case JIM_EXPROP_NOT: wC = !wA; break;
7125 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7126 case JIM_EXPROP_LOGICAND_RIGHT:
7127 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7128 default:
7129 wC = 0; /* avoid gcc warning */
7130 break;
7131 }
7132 stack[stacklen] = Jim_NewIntObj(interp, wC);
7133 Jim_IncrRefCount(stack[stacklen]);
7134 stacklen++;
7135 continue;
7136 trydouble_unary:
7137 /* --- Double --- */
7138 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7139 Jim_DecrRefCount(interp, A);
7140 error = 1;
7141 goto err;
7142 }
7143 Jim_DecrRefCount(interp, A);
7144 switch (expr->opcode[i]) {
7145 case JIM_EXPROP_NOT: dC = !dA; break;
7146 case JIM_EXPROP_LOGICAND_RIGHT:
7147 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7148 case JIM_EXPROP_BITNOT:
7149 Jim_SetResultString(interp,
7150 "Got floating-point value where integer was expected", -1);
7151 error = 1;
7152 goto err;
7153 break;
7154 default:
7155 dC = 0; /* avoid gcc warning */
7156 break;
7157 }
7158 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7159 Jim_IncrRefCount(stack[stacklen]);
7160 stacklen++;
7161 } else {
7162 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7163 }
7164 }
7165 err:
7166 /* There is no need to decerement the inUse field because
7167 * this reference is transfered back into the exprObjPtr. */
7168 Jim_FreeIntRep(interp, exprObjPtr);
7169 exprObjPtr->typePtr = &exprObjType;
7170 Jim_SetIntRepPtr(exprObjPtr, expr);
7171 Jim_DecrRefCount(interp, exprObjPtr);
7172 if (!error) {
7173 *exprResultPtrPtr = stack[0];
7174 Jim_IncrRefCount(stack[0]);
7175 errRetCode = JIM_OK;
7176 }
7177 for (i = 0; i < stacklen; i++) {
7178 Jim_DecrRefCount(interp, stack[i]);
7179 }
7180 if (stack != staticStack)
7181 Jim_Free(stack);
7182 return errRetCode;
7183 divbyzero:
7184 error = 1;
7185 Jim_SetResultString(interp, "Division by zero", -1);
7186 goto err;
7187 }
7188
7189 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7190 {
7191 int retcode;
7192 jim_wide wideValue;
7193 double doubleValue;
7194 Jim_Obj *exprResultPtr;
7195
7196 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7197 if (retcode != JIM_OK)
7198 return retcode;
7199 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7200 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7201 {
7202 Jim_DecrRefCount(interp, exprResultPtr);
7203 return JIM_ERR;
7204 } else {
7205 Jim_DecrRefCount(interp, exprResultPtr);
7206 *boolPtr = doubleValue != 0;
7207 return JIM_OK;
7208 }
7209 }
7210 Jim_DecrRefCount(interp, exprResultPtr);
7211 *boolPtr = wideValue != 0;
7212 return JIM_OK;
7213 }
7214
7215 /* -----------------------------------------------------------------------------
7216 * ScanFormat String Object
7217 * ---------------------------------------------------------------------------*/
7218
7219 /* This Jim_Obj will held a parsed representation of a format string passed to
7220 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7221 * to be parsed in its entirely first and then, if correct, can be used for
7222 * scanning. To avoid endless re-parsing, the parsed representation will be
7223 * stored in an internal representation and re-used for performance reason. */
7224
7225 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7226 * scanformat string. This part will later be used to extract information
7227 * out from the string to be parsed by Jim_ScanString */
7228
7229 typedef struct ScanFmtPartDescr {
7230 char type; /* Type of conversion (e.g. c, d, f) */
7231 char modifier; /* Modify type (e.g. l - long, h - short */
7232 size_t width; /* Maximal width of input to be converted */
7233 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7234 char *arg; /* Specification of a CHARSET conversion */
7235 char *prefix; /* Prefix to be scanned literally before conversion */
7236 } ScanFmtPartDescr;
7237
7238 /* The ScanFmtStringObj will held the internal representation of a scanformat
7239 * string parsed and separated in part descriptions. Furthermore it contains
7240 * the original string representation of the scanformat string to allow for
7241 * fast update of the Jim_Obj's string representation part.
7242 *
7243 * As add-on the internal object representation add some scratch pad area
7244 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7245 * memory for purpose of string scanning.
7246 *
7247 * The error member points to a static allocated string in case of a mal-
7248 * formed scanformat string or it contains '0' (NULL) in case of a valid
7249 * parse representation.
7250 *
7251 * The whole memory of the internal representation is allocated as a single
7252 * area of memory that will be internally separated. So freeing and duplicating
7253 * of such an object is cheap */
7254
7255 typedef struct ScanFmtStringObj {
7256 jim_wide size; /* Size of internal repr in bytes */
7257 char *stringRep; /* Original string representation */
7258 size_t count; /* Number of ScanFmtPartDescr contained */
7259 size_t convCount; /* Number of conversions that will assign */
7260 size_t maxPos; /* Max position index if XPG3 is used */
7261 const char *error; /* Ptr to error text (NULL if no error */
7262 char *scratch; /* Some scratch pad used by Jim_ScanString */
7263 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7264 } ScanFmtStringObj;
7265
7266
7267 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7268 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7269 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7270
7271 static Jim_ObjType scanFmtStringObjType = {
7272 "scanformatstring",
7273 FreeScanFmtInternalRep,
7274 DupScanFmtInternalRep,
7275 UpdateStringOfScanFmt,
7276 JIM_TYPE_NONE,
7277 };
7278
7279 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7280 {
7281 JIM_NOTUSED(interp);
7282 Jim_Free((char*)objPtr->internalRep.ptr);
7283 objPtr->internalRep.ptr = 0;
7284 }
7285
7286 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7287 {
7288 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7289 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7290
7291 JIM_NOTUSED(interp);
7292 memcpy(newVec, srcPtr->internalRep.ptr, size);
7293 dupPtr->internalRep.ptr = newVec;
7294 dupPtr->typePtr = &scanFmtStringObjType;
7295 }
7296
7297 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7298 {
7299 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7300
7301 objPtr->bytes = Jim_StrDup(bytes);
7302 objPtr->length = strlen(bytes);
7303 }
7304
7305 /* SetScanFmtFromAny will parse a given string and create the internal
7306 * representation of the format specification. In case of an error
7307 * the error data member of the internal representation will be set
7308 * to an descriptive error text and the function will be left with
7309 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7310 * specification */
7311
7312 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7313 {
7314 ScanFmtStringObj *fmtObj;
7315 char *buffer;
7316 int maxCount, i, approxSize, lastPos = -1;
7317 const char *fmt = objPtr->bytes;
7318 int maxFmtLen = objPtr->length;
7319 const char *fmtEnd = fmt + maxFmtLen;
7320 int curr;
7321
7322 Jim_FreeIntRep(interp, objPtr);
7323 /* Count how many conversions could take place maximally */
7324 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7325 if (fmt[i] == '%')
7326 ++maxCount;
7327 /* Calculate an approximation of the memory necessary */
7328 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7329 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7330 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7331 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7332 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7333 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7334 + 1; /* safety byte */
7335 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7336 memset(fmtObj, 0, approxSize);
7337 fmtObj->size = approxSize;
7338 fmtObj->maxPos = 0;
7339 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7340 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7341 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7342 buffer = fmtObj->stringRep + maxFmtLen + 1;
7343 objPtr->internalRep.ptr = fmtObj;
7344 objPtr->typePtr = &scanFmtStringObjType;
7345 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7346 int width = 0, skip;
7347 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7348 fmtObj->count++;
7349 descr->width = 0; /* Assume width unspecified */
7350 /* Overread and store any "literal" prefix */
7351 if (*fmt != '%' || fmt[1] == '%') {
7352 descr->type = 0;
7353 descr->prefix = &buffer[i];
7354 for (; fmt < fmtEnd; ++fmt) {
7355 if (*fmt == '%') {
7356 if (fmt[1] != '%') break;
7357 ++fmt;
7358 }
7359 buffer[i++] = *fmt;
7360 }
7361 buffer[i++] = 0;
7362 }
7363 /* Skip the conversion introducing '%' sign */
7364 ++fmt;
7365 /* End reached due to non-conversion literal only? */
7366 if (fmt >= fmtEnd)
7367 goto done;
7368 descr->pos = 0; /* Assume "natural" positioning */
7369 if (*fmt == '*') {
7370 descr->pos = -1; /* Okay, conversion will not be assigned */
7371 ++fmt;
7372 } else
7373 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7374 /* Check if next token is a number (could be width or pos */
7375 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7376 fmt += skip;
7377 /* Was the number a XPG3 position specifier? */
7378 if (descr->pos != -1 && *fmt == '$') {
7379 int prev;
7380 ++fmt;
7381 descr->pos = width;
7382 width = 0;
7383 /* Look if "natural" postioning and XPG3 one was mixed */
7384 if ((lastPos == 0 && descr->pos > 0)
7385 || (lastPos > 0 && descr->pos == 0)) {
7386 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7387 return JIM_ERR;
7388 }
7389 /* Look if this position was already used */
7390 for (prev = 0; prev < curr; ++prev) {
7391 if (fmtObj->descr[prev].pos == -1) continue;
7392 if (fmtObj->descr[prev].pos == descr->pos) {
7393 fmtObj->error = "same \"%n$\" conversion specifier "
7394 "used more than once";
7395 return JIM_ERR;
7396 }
7397 }
7398 /* Try to find a width after the XPG3 specifier */
7399 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7400 descr->width = width;
7401 fmt += skip;
7402 }
7403 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7404 fmtObj->maxPos = descr->pos;
7405 } else {
7406 /* Number was not a XPG3, so it has to be a width */
7407 descr->width = width;
7408 }
7409 }
7410 /* If positioning mode was undetermined yet, fix this */
7411 if (lastPos == -1)
7412 lastPos = descr->pos;
7413 /* Handle CHARSET conversion type ... */
7414 if (*fmt == '[') {
7415 int swapped = 1, beg = i, end, j;
7416 descr->type = '[';
7417 descr->arg = &buffer[i];
7418 ++fmt;
7419 if (*fmt == '^') buffer[i++] = *fmt++;
7420 if (*fmt == ']') buffer[i++] = *fmt++;
7421 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7422 if (*fmt != ']') {
7423 fmtObj->error = "unmatched [ in format string";
7424 return JIM_ERR;
7425 }
7426 end = i;
7427 buffer[i++] = 0;
7428 /* In case a range fence was given "backwards", swap it */
7429 while (swapped) {
7430 swapped = 0;
7431 for (j = beg + 1; j < end-1; ++j) {
7432 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7433 char tmp = buffer[j-1];
7434 buffer[j-1] = buffer[j + 1];
7435 buffer[j + 1] = tmp;
7436 swapped = 1;
7437 }
7438 }
7439 }
7440 } else {
7441 /* Remember any valid modifier if given */
7442 if (strchr("hlL", *fmt) != 0)
7443 descr->modifier = tolower((int)*fmt++);
7444
7445 descr->type = *fmt;
7446 if (strchr("efgcsndoxui", *fmt) == 0) {
7447 fmtObj->error = "bad scan conversion character";
7448 return JIM_ERR;
7449 } else if (*fmt == 'c' && descr->width != 0) {
7450 fmtObj->error = "field width may not be specified in %c "
7451 "conversion";
7452 return JIM_ERR;
7453 } else if (*fmt == 'u' && descr->modifier == 'l') {
7454 fmtObj->error = "unsigned wide not supported";
7455 return JIM_ERR;
7456 }
7457 }
7458 curr++;
7459 }
7460 done:
7461 if (fmtObj->convCount == 0) {
7462 fmtObj->error = "no any conversion specifier given";
7463 return JIM_ERR;
7464 }
7465 return JIM_OK;
7466 }
7467
7468 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7469
7470 #define FormatGetCnvCount(_fo_) \
7471 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7472 #define FormatGetMaxPos(_fo_) \
7473 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7474 #define FormatGetError(_fo_) \
7475 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7476
7477 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7478 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7479 * bitvector implementation in Jim? */
7480
7481 static int JimTestBit(const char *bitvec, char ch)
7482 {
7483 div_t pos = div(ch-1, 8);
7484 return bitvec[pos.quot] & (1 << pos.rem);
7485 }
7486
7487 static void JimSetBit(char *bitvec, char ch)
7488 {
7489 div_t pos = div(ch-1, 8);
7490 bitvec[pos.quot] |= (1 << pos.rem);
7491 }
7492
7493 #if 0 /* currently not used */
7494 static void JimClearBit(char *bitvec, char ch)
7495 {
7496 div_t pos = div(ch-1, 8);
7497 bitvec[pos.quot] &= ~(1 << pos.rem);
7498 }
7499 #endif
7500
7501 /* JimScanAString is used to scan an unspecified string that ends with
7502 * next WS, or a string that is specified via a charset. The charset
7503 * is currently implemented in a way to only allow for usage with
7504 * ASCII. Whenever we will switch to UNICODE, another idea has to
7505 * be born :-/
7506 *
7507 * FIXME: Works only with ASCII */
7508
7509 static Jim_Obj *
7510 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7511 {
7512 size_t i;
7513 Jim_Obj *result;
7514 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7515 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7516
7517 /* First init charset to nothing or all, depending if a specified
7518 * or an unspecified string has to be parsed */
7519 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7520 if (sdescr) {
7521 /* There was a set description given, that means we are parsing
7522 * a specified string. So we have to build a corresponding
7523 * charset reflecting the description */
7524 int notFlag = 0;
7525 /* Should the set be negated at the end? */
7526 if (*sdescr == '^') {
7527 notFlag = 1;
7528 ++sdescr;
7529 }
7530 /* Here '-' is meant literally and not to define a range */
7531 if (*sdescr == '-') {
7532 JimSetBit(charset, '-');
7533 ++sdescr;
7534 }
7535 while (*sdescr) {
7536 if (sdescr[1] == '-' && sdescr[2] != 0) {
7537 /* Handle range definitions */
7538 int i_t;
7539 for (i_t = sdescr[0]; i_t <= sdescr[2]; ++i_t)
7540 JimSetBit(charset, (char)i_t);
7541 sdescr += 3;
7542 } else {
7543 /* Handle verbatim character definitions */
7544 JimSetBit(charset, *sdescr++);
7545 }
7546 }
7547 /* Negate the charset if there was a NOT given */
7548 for (i = 0; notFlag && i < sizeof(charset); ++i)
7549 charset[i] = ~charset[i];
7550 }
7551 /* And after all the mess above, the real work begin ... */
7552 while (str && *str) {
7553 if (!sdescr && isspace((int)*str))
7554 break; /* EOS via WS if unspecified */
7555 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7556 else break; /* EOS via mismatch if specified scanning */
7557 }
7558 *buffer = 0; /* Close the string properly ... */
7559 result = Jim_NewStringObj(interp, anchor, -1);
7560 Jim_Free(anchor); /* ... and free it afer usage */
7561 return result;
7562 }
7563
7564 /* ScanOneEntry will scan one entry out of the string passed as argument.
7565 * It use the sscanf() function for this task. After extracting and
7566 * converting of the value, the count of scanned characters will be
7567 * returned of -1 in case of no conversion tool place and string was
7568 * already scanned thru */
7569
7570 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7571 ScanFmtStringObj *fmtObj, long index_t, Jim_Obj **valObjPtr)
7572 {
7573 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7574 ? sizeof(jim_wide) \
7575 : sizeof(double))
7576 char buffer[MAX_SIZE];
7577 char *value = buffer;
7578 const char *tok;
7579 const ScanFmtPartDescr *descr = &fmtObj->descr[index_t];
7580 size_t sLen = strlen(&str[pos]), scanned = 0;
7581 size_t anchor = pos;
7582 int i;
7583
7584 /* First pessimiticly assume, we will not scan anything :-) */
7585 *valObjPtr = 0;
7586 if (descr->prefix) {
7587 /* There was a prefix given before the conversion, skip it and adjust
7588 * the string-to-be-parsed accordingly */
7589 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7590 /* If prefix require, skip WS */
7591 if (isspace((int)descr->prefix[i]))
7592 while (str[pos] && isspace((int)str[pos])) ++pos;
7593 else if (descr->prefix[i] != str[pos])
7594 break; /* Prefix do not match here, leave the loop */
7595 else
7596 ++pos; /* Prefix matched so far, next round */
7597 }
7598 if (str[pos] == 0)
7599 return -1; /* All of str consumed: EOF condition */
7600 else if (descr->prefix[i] != 0)
7601 return 0; /* Not whole prefix consumed, no conversion possible */
7602 }
7603 /* For all but following conversion, skip leading WS */
7604 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7605 while (isspace((int)str[pos])) ++pos;
7606 /* Determine how much skipped/scanned so far */
7607 scanned = pos - anchor;
7608 if (descr->type == 'n') {
7609 /* Return pseudo conversion means: how much scanned so far? */
7610 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7611 } else if (str[pos] == 0) {
7612 /* Cannot scan anything, as str is totally consumed */
7613 return -1;
7614 } else {
7615 /* Processing of conversions follows ... */
7616 if (descr->width > 0) {
7617 /* Do not try to scan as fas as possible but only the given width.
7618 * To ensure this, we copy the part that should be scanned. */
7619 size_t tLen = descr->width > sLen ? sLen : descr->width;
7620 tok = Jim_StrDupLen(&str[pos], tLen);
7621 } else {
7622 /* As no width was given, simply refer to the original string */
7623 tok = &str[pos];
7624 }
7625 switch (descr->type) {
7626 case 'c':
7627 *valObjPtr = Jim_NewIntObj(interp, *tok);
7628 scanned += 1;
7629 break;
7630 case 'd': case 'o': case 'x': case 'u': case 'i': {
7631 jim_wide jwvalue = 0;
7632 long lvalue = 0;
7633 char *endp; /* Position where the number finished */
7634 int base = descr->type == 'o' ? 8
7635 : descr->type == 'x' ? 16
7636 : descr->type == 'i' ? 0
7637 : 10;
7638
7639 do {
7640 /* Try to scan a number with the given base */
7641 if (descr->modifier == 'l')
7642 {
7643 #ifdef HAVE_LONG_LONG_INT
7644 jwvalue = JimStrtoll(tok, &endp, base),
7645 #else
7646 jwvalue = strtol(tok, &endp, base),
7647 #endif
7648 memcpy(value, &jwvalue, sizeof(jim_wide));
7649 }
7650 else
7651 {
7652 if (descr->type == 'u')
7653 lvalue = strtoul(tok, &endp, base);
7654 else
7655 lvalue = strtol(tok, &endp, base);
7656 memcpy(value, &lvalue, sizeof(lvalue));
7657 }
7658 /* If scanning failed, and base was undetermined, simply
7659 * put it to 10 and try once more. This should catch the
7660 * case where %i begin to parse a number prefix (e.g.
7661 * '0x' but no further digits follows. This will be
7662 * handled as a ZERO followed by a char 'x' by Tcl */
7663 if (endp == tok && base == 0) base = 10;
7664 else break;
7665 } while (1);
7666 if (endp != tok) {
7667 /* There was some number sucessfully scanned! */
7668 if (descr->modifier == 'l')
7669 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7670 else
7671 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7672 /* Adjust the number-of-chars scanned so far */
7673 scanned += endp - tok;
7674 } else {
7675 /* Nothing was scanned. We have to determine if this
7676 * happened due to e.g. prefix mismatch or input str
7677 * exhausted */
7678 scanned = *tok ? 0 : -1;
7679 }
7680 break;
7681 }
7682 case 's': case '[': {
7683 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7684 scanned += Jim_Length(*valObjPtr);
7685 break;
7686 }
7687 case 'e': case 'f': case 'g': {
7688 char *endp;
7689
7690 double dvalue = strtod(tok, &endp);
7691 memcpy(value, &dvalue, sizeof(double));
7692 if (endp != tok) {
7693 /* There was some number sucessfully scanned! */
7694 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7695 /* Adjust the number-of-chars scanned so far */
7696 scanned += endp - tok;
7697 } else {
7698 /* Nothing was scanned. We have to determine if this
7699 * happened due to e.g. prefix mismatch or input str
7700 * exhausted */
7701 scanned = *tok ? 0 : -1;
7702 }
7703 break;
7704 }
7705 }
7706 /* If a substring was allocated (due to pre-defined width) do not
7707 * forget to free it */
7708 if (tok != &str[pos])
7709 Jim_Free((char*)tok);
7710 }
7711 return scanned;
7712 }
7713
7714 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7715 * string and returns all converted (and not ignored) values in a list back
7716 * to the caller. If an error occured, a NULL pointer will be returned */
7717
7718 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7719 Jim_Obj *fmtObjPtr, int flags)
7720 {
7721 size_t i, pos;
7722 int scanned = 1;
7723 const char *str = Jim_GetString(strObjPtr, 0);
7724 Jim_Obj *resultList = 0;
7725 Jim_Obj **resultVec =NULL;
7726 int resultc;
7727 Jim_Obj *emptyStr = 0;
7728 ScanFmtStringObj *fmtObj;
7729
7730 /* If format specification is not an object, convert it! */
7731 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7732 SetScanFmtFromAny(interp, fmtObjPtr);
7733 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7734 /* Check if format specification was valid */
7735 if (fmtObj->error != 0) {
7736 if (flags & JIM_ERRMSG)
7737 Jim_SetResultString(interp, fmtObj->error, -1);
7738 return 0;
7739 }
7740 /* Allocate a new "shared" empty string for all unassigned conversions */
7741 emptyStr = Jim_NewEmptyStringObj(interp);
7742 Jim_IncrRefCount(emptyStr);
7743 /* Create a list and fill it with empty strings up to max specified XPG3 */
7744 resultList = Jim_NewListObj(interp, 0, 0);
7745 if (fmtObj->maxPos > 0) {
7746 for (i = 0; i < fmtObj->maxPos; ++i)
7747 Jim_ListAppendElement(interp, resultList, emptyStr);
7748 JimListGetElements(interp, resultList, &resultc, &resultVec);
7749 }
7750 /* Now handle every partial format description */
7751 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7752 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7753 Jim_Obj *value = 0;
7754 /* Only last type may be "literal" w/o conversion - skip it! */
7755 if (descr->type == 0) continue;
7756 /* As long as any conversion could be done, we will proceed */
7757 if (scanned > 0)
7758 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7759 /* In case our first try results in EOF, we will leave */
7760 if (scanned == -1 && i == 0)
7761 goto eof;
7762 /* Advance next pos-to-be-scanned for the amount scanned already */
7763 pos += scanned;
7764 /* value == 0 means no conversion took place so take empty string */
7765 if (value == 0)
7766 value = Jim_NewEmptyStringObj(interp);
7767 /* If value is a non-assignable one, skip it */
7768 if (descr->pos == -1) {
7769 Jim_FreeNewObj(interp, value);
7770 } else if (descr->pos == 0)
7771 /* Otherwise append it to the result list if no XPG3 was given */
7772 Jim_ListAppendElement(interp, resultList, value);
7773 else if (resultVec[descr->pos-1] == emptyStr) {
7774 /* But due to given XPG3, put the value into the corr. slot */
7775 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7776 Jim_IncrRefCount(value);
7777 resultVec[descr->pos-1] = value;
7778 } else {
7779 /* Otherwise, the slot was already used - free obj and ERROR */
7780 Jim_FreeNewObj(interp, value);
7781 goto err;
7782 }
7783 }
7784 Jim_DecrRefCount(interp, emptyStr);
7785 return resultList;
7786 eof:
7787 Jim_DecrRefCount(interp, emptyStr);
7788 Jim_FreeNewObj(interp, resultList);
7789 return (Jim_Obj*)EOF;
7790 err:
7791 Jim_DecrRefCount(interp, emptyStr);
7792 Jim_FreeNewObj(interp, resultList);
7793 return 0;
7794 }
7795
7796 /* -----------------------------------------------------------------------------
7797 * Pseudo Random Number Generation
7798 * ---------------------------------------------------------------------------*/
7799 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7800 int seedLen);
7801
7802 /* Initialize the sbox with the numbers from 0 to 255 */
7803 static void JimPrngInit(Jim_Interp *interp)
7804 {
7805 int i;
7806 unsigned int seed[256];
7807
7808 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7809 for (i = 0; i < 256; i++)
7810 seed[i] = (rand() ^ time(NULL) ^ clock());
7811 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7812 }
7813
7814 /* Generates N bytes of random data */
7815 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7816 {
7817 Jim_PrngState *prng;
7818 unsigned char *destByte = (unsigned char*) dest;
7819 unsigned int si, sj, x;
7820
7821 /* initialization, only needed the first time */
7822 if (interp->prngState == NULL)
7823 JimPrngInit(interp);
7824 prng = interp->prngState;
7825 /* generates 'len' bytes of pseudo-random numbers */
7826 for (x = 0; x < len; x++) {
7827 prng->i = (prng->i + 1) & 0xff;
7828 si = prng->sbox[prng->i];
7829 prng->j = (prng->j + si) & 0xff;
7830 sj = prng->sbox[prng->j];
7831 prng->sbox[prng->i] = sj;
7832 prng->sbox[prng->j] = si;
7833 *destByte++ = prng->sbox[(si + sj)&0xff];
7834 }
7835 }
7836
7837 /* Re-seed the generator with user-provided bytes */
7838 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7839 int seedLen)
7840 {
7841 int i;
7842 unsigned char buf[256];
7843 Jim_PrngState *prng;
7844
7845 /* initialization, only needed the first time */
7846 if (interp->prngState == NULL)
7847 JimPrngInit(interp);
7848 prng = interp->prngState;
7849
7850 /* Set the sbox[i] with i */
7851 for (i = 0; i < 256; i++)
7852 prng->sbox[i] = i;
7853 /* Now use the seed to perform a random permutation of the sbox */
7854 for (i = 0; i < seedLen; i++) {
7855 unsigned char t;
7856
7857 t = prng->sbox[i&0xFF];
7858 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7859 prng->sbox[seed[i]] = t;
7860 }
7861 prng->i = prng->j = 0;
7862 /* discard the first 256 bytes of stream. */
7863 JimRandomBytes(interp, buf, 256);
7864 }
7865
7866 /* -----------------------------------------------------------------------------
7867 * Dynamic libraries support (WIN32 not supported)
7868 * ---------------------------------------------------------------------------*/
7869
7870 #ifdef JIM_DYNLIB
7871 #ifdef WIN32
7872 #define RTLD_LAZY 0
7873 void * dlopen(const char *path, int mode)
7874 {
7875 JIM_NOTUSED(mode);
7876
7877 return (void *)LoadLibraryA(path);
7878 }
7879 int dlclose(void *handle)
7880 {
7881 FreeLibrary((HANDLE)handle);
7882 return 0;
7883 }
7884 void *dlsym(void *handle, const char *symbol)
7885 {
7886 return GetProcAddress((HMODULE)handle, symbol);
7887 }
7888 static char win32_dlerror_string[121];
7889 const char *dlerror(void)
7890 {
7891 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7892 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7893 return win32_dlerror_string;
7894 }
7895 #endif /* WIN32 */
7896
7897 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7898 {
7899 Jim_Obj *libPathObjPtr;
7900 int prefixc, i;
7901 void *handle;
7902 int (*onload)(Jim_Interp *interp);
7903
7904 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7905 if (libPathObjPtr == NULL) {
7906 prefixc = 0;
7907 libPathObjPtr = NULL;
7908 } else {
7909 Jim_IncrRefCount(libPathObjPtr);
7910 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7911 }
7912
7913 for (i = -1; i < prefixc; i++) {
7914 if (i < 0) {
7915 handle = dlopen(pathName, RTLD_LAZY);
7916 } else {
7917 FILE *fp;
7918 char buf[JIM_PATH_LEN];
7919 const char *prefix;
7920 int prefixlen;
7921 Jim_Obj *prefixObjPtr;
7922
7923 buf[0] = '\0';
7924 if (Jim_ListIndex(interp, libPathObjPtr, i,
7925 &prefixObjPtr, JIM_NONE) != JIM_OK)
7926 continue;
7927 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7928 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7929 continue;
7930 if (*pathName == '/') {
7931 strcpy(buf, pathName);
7932 }
7933 else if (prefixlen && prefix[prefixlen-1] == '/')
7934 sprintf(buf, "%s%s", prefix, pathName);
7935 else
7936 sprintf(buf, "%s/%s", prefix, pathName);
7937 fp = fopen(buf, "r");
7938 if (fp == NULL)
7939 continue;
7940 fclose(fp);
7941 handle = dlopen(buf, RTLD_LAZY);
7942 }
7943 if (handle == NULL) {
7944 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7945 Jim_AppendStrings(interp, Jim_GetResult(interp),
7946 "error loading extension \"", pathName,
7947 "\": ", dlerror(), NULL);
7948 if (i < 0)
7949 continue;
7950 goto err;
7951 }
7952 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7953 Jim_SetResultString(interp,
7954 "No Jim_OnLoad symbol found on extension", -1);
7955 goto err;
7956 }
7957 if (onload(interp) == JIM_ERR) {
7958 dlclose(handle);
7959 goto err;
7960 }
7961 Jim_SetEmptyResult(interp);
7962 if (libPathObjPtr != NULL)
7963 Jim_DecrRefCount(interp, libPathObjPtr);
7964 return JIM_OK;
7965 }
7966 err:
7967 if (libPathObjPtr != NULL)
7968 Jim_DecrRefCount(interp, libPathObjPtr);
7969 return JIM_ERR;
7970 }
7971 #else /* JIM_DYNLIB */
7972 static int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7973 {
7974 JIM_NOTUSED(interp);
7975 JIM_NOTUSED(pathName);
7976
7977 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7978 return JIM_ERR;
7979 }
7980 #endif/* JIM_DYNLIB */
7981
7982 /* -----------------------------------------------------------------------------
7983 * Packages handling
7984 * ---------------------------------------------------------------------------*/
7985
7986 #define JIM_PKG_ANY_VERSION -1
7987
7988 /* Convert a string of the type "1.2" into an integer.
7989 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
7990 * to the integer with value 102 */
7991 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7992 int *intPtr, int flags)
7993 {
7994 char *copy;
7995 jim_wide major, minor;
7996 char *majorStr, *minorStr, *p;
7997
7998 if (v[0] == '\0') {
7999 *intPtr = JIM_PKG_ANY_VERSION;
8000 return JIM_OK;
8001 }
8002
8003 copy = Jim_StrDup(v);
8004 p = strchr(copy, '.');
8005 if (p == NULL) goto badfmt;
8006 *p = '\0';
8007 majorStr = copy;
8008 minorStr = p + 1;
8009
8010 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8011 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8012 goto badfmt;
8013 *intPtr = (int)(major*100 + minor);
8014 Jim_Free(copy);
8015 return JIM_OK;
8016
8017 badfmt:
8018 Jim_Free(copy);
8019 if (flags & JIM_ERRMSG) {
8020 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8021 Jim_AppendStrings(interp, Jim_GetResult(interp),
8022 "invalid package version '", v, "'", NULL);
8023 }
8024 return JIM_ERR;
8025 }
8026
8027 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8028 static int JimPackageMatchVersion(int needed, int actual, int flags)
8029 {
8030 if (needed == JIM_PKG_ANY_VERSION) return 1;
8031 if (flags & JIM_MATCHVER_EXACT) {
8032 return needed == actual;
8033 } else {
8034 return needed/100 == actual/100 && (needed <= actual);
8035 }
8036 }
8037
8038 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8039 int flags)
8040 {
8041 int intVersion;
8042 /* Check if the version format is ok */
8043 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8044 return JIM_ERR;
8045 /* If the package was already provided returns an error. */
8046 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8047 if (flags & JIM_ERRMSG) {
8048 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8049 Jim_AppendStrings(interp, Jim_GetResult(interp),
8050 "package '", name, "' was already provided", NULL);
8051 }
8052 return JIM_ERR;
8053 }
8054 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8055 return JIM_OK;
8056 }
8057
8058 #ifndef JIM_ANSIC
8059
8060 #ifndef WIN32
8061 # include <sys/types.h>
8062 # include <dirent.h>
8063 #else
8064 # include <io.h>
8065 /* Posix dirent.h compatiblity layer for WIN32.
8066 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8067 * Copyright Salvatore Sanfilippo ,2005.
8068 *
8069 * Permission to use, copy, modify, and distribute this software and its
8070 * documentation for any purpose is hereby granted without fee, provided
8071 * that this copyright and permissions notice appear in all copies and
8072 * derivatives.
8073 *
8074 * This software is supplied "as is" without express or implied warranty.
8075 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8076 */
8077
8078 struct dirent {
8079 char *d_name;
8080 };
8081
8082 typedef struct DIR {
8083 long handle; /* -1 for failed rewind */
8084 struct _finddata_t info;
8085 struct dirent result; /* d_name null iff first time */
8086 char *name; /* null-terminated char string */
8087 } DIR;
8088
8089 DIR *opendir(const char *name)
8090 {
8091 DIR *dir = 0;
8092
8093 if (name && name[0]) {
8094 size_t base_length = strlen(name);
8095 const char *all = /* search pattern must end with suitable wildcard */
8096 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8097
8098 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8099 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8100 {
8101 strcat(strcpy(dir->name, name), all);
8102
8103 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8104 dir->result.d_name = 0;
8105 else { /* rollback */
8106 Jim_Free(dir->name);
8107 Jim_Free(dir);
8108 dir = 0;
8109 }
8110 } else { /* rollback */
8111 Jim_Free(dir);
8112 dir = 0;
8113 errno = ENOMEM;
8114 }
8115 } else {
8116 errno = EINVAL;
8117 }
8118 return dir;
8119 }
8120
8121 int closedir(DIR *dir)
8122 {
8123 int result = -1;
8124
8125 if (dir) {
8126 if (dir->handle != -1)
8127 result = _findclose(dir->handle);
8128 Jim_Free(dir->name);
8129 Jim_Free(dir);
8130 }
8131 if (result == -1) /* map all errors to EBADF */
8132 errno = EBADF;
8133 return result;
8134 }
8135
8136 struct dirent *readdir(DIR *dir)
8137 {
8138 struct dirent *result = 0;
8139
8140 if (dir && dir->handle != -1) {
8141 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8142 result = &dir->result;
8143 result->d_name = dir->info.name;
8144 }
8145 } else {
8146 errno = EBADF;
8147 }
8148 return result;
8149 }
8150
8151 #endif /* WIN32 */
8152
8153 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8154 int prefixc, const char *pkgName, int pkgVer, int flags)
8155 {
8156 int bestVer = -1, i;
8157 int pkgNameLen = strlen(pkgName);
8158 char *bestPackage = NULL;
8159 struct dirent *de;
8160
8161 for (i = 0; i < prefixc; i++) {
8162 DIR *dir;
8163 char buf[JIM_PATH_LEN];
8164 int prefixLen;
8165
8166 if (prefixes[i] == NULL) continue;
8167 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8168 buf[JIM_PATH_LEN-1] = '\0';
8169 prefixLen = strlen(buf);
8170 if (prefixLen && buf[prefixLen-1] == '/')
8171 buf[prefixLen-1] = '\0';
8172
8173 if ((dir = opendir(buf)) == NULL) continue;
8174 while ((de = readdir(dir)) != NULL) {
8175 char *fileName = de->d_name;
8176 int fileNameLen = strlen(fileName);
8177
8178 if (strncmp(fileName, "jim-", 4) == 0 &&
8179 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8180 *(fileName + 4+pkgNameLen) == '-' &&
8181 fileNameLen > 4 && /* note that this is not really useful */
8182 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8183 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8184 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8185 {
8186 char ver[6]; /* xx.yy < nulterm> */
8187 char *p = strrchr(fileName, '.');
8188 int verLen, fileVer;
8189
8190 verLen = p - (fileName + 4+pkgNameLen + 1);
8191 if (verLen < 3 || verLen > 5) continue;
8192 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8193 ver[verLen] = '\0';
8194 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8195 != JIM_OK) continue;
8196 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8197 (bestVer == -1 || bestVer < fileVer))
8198 {
8199 bestVer = fileVer;
8200 Jim_Free(bestPackage);
8201 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8202 sprintf(bestPackage, "%s/%s", buf, fileName);
8203 }
8204 }
8205 }
8206 closedir(dir);
8207 }
8208 return bestPackage;
8209 }
8210
8211 #else /* JIM_ANSIC */
8212
8213 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8214 int prefixc, const char *pkgName, int pkgVer, int flags)
8215 {
8216 JIM_NOTUSED(interp);
8217 JIM_NOTUSED(prefixes);
8218 JIM_NOTUSED(prefixc);
8219 JIM_NOTUSED(pkgName);
8220 JIM_NOTUSED(pkgVer);
8221 JIM_NOTUSED(flags);
8222 return NULL;
8223 }
8224
8225 #endif /* JIM_ANSIC */
8226
8227 /* Search for a suitable package under every dir specified by jim_libpath
8228 * and load it if possible. If a suitable package was loaded with success
8229 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8230 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8231 int flags)
8232 {
8233 Jim_Obj *libPathObjPtr;
8234 char **prefixes, *best;
8235 int prefixc, i, retCode = JIM_OK;
8236
8237 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8238 if (libPathObjPtr == NULL) {
8239 prefixc = 0;
8240 libPathObjPtr = NULL;
8241 } else {
8242 Jim_IncrRefCount(libPathObjPtr);
8243 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8244 }
8245
8246 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8247 for (i = 0; i < prefixc; i++) {
8248 Jim_Obj *prefixObjPtr;
8249 if (Jim_ListIndex(interp, libPathObjPtr, i,
8250 &prefixObjPtr, JIM_NONE) != JIM_OK)
8251 {
8252 prefixes[i] = NULL;
8253 continue;
8254 }
8255 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8256 }
8257 /* Scan every directory to find the "best" package. */
8258 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8259 if (best != NULL) {
8260 char *p = strrchr(best, '.');
8261 /* Try to load/source it */
8262 if (p && strcmp(p, ".tcl") == 0) {
8263 retCode = Jim_EvalFile(interp, best);
8264 } else {
8265 retCode = Jim_LoadLibrary(interp, best);
8266 }
8267 } else {
8268 retCode = JIM_ERR;
8269 }
8270 Jim_Free(best);
8271 for (i = 0; i < prefixc; i++)
8272 Jim_Free(prefixes[i]);
8273 Jim_Free(prefixes);
8274 if (libPathObjPtr)
8275 Jim_DecrRefCount(interp, libPathObjPtr);
8276 return retCode;
8277 }
8278
8279 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8280 const char *ver, int flags)
8281 {
8282 Jim_HashEntry *he;
8283 int requiredVer;
8284
8285 /* Start with an empty error string */
8286 Jim_SetResultString(interp, "", 0);
8287
8288 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8289 return NULL;
8290 he = Jim_FindHashEntry(&interp->packages, name);
8291 if (he == NULL) {
8292 /* Try to load the package. */
8293 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8294 he = Jim_FindHashEntry(&interp->packages, name);
8295 if (he == NULL) {
8296 return "?";
8297 }
8298 return he->val;
8299 }
8300 /* No way... return an error. */
8301 if (flags & JIM_ERRMSG) {
8302 int len;
8303 Jim_GetString(Jim_GetResult(interp), &len);
8304 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8305 "Can't find package '", name, "'", NULL);
8306 }
8307 return NULL;
8308 } else {
8309 int actualVer;
8310 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8311 != JIM_OK)
8312 {
8313 return NULL;
8314 }
8315 /* Check if version matches. */
8316 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8317 Jim_AppendStrings(interp, Jim_GetResult(interp),
8318 "Package '", name, "' already loaded, but with version ",
8319 he->val, NULL);
8320 return NULL;
8321 }
8322 return he->val;
8323 }
8324 }
8325
8326 /* -----------------------------------------------------------------------------
8327 * Eval
8328 * ---------------------------------------------------------------------------*/
8329 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8330 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8331
8332 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8333 Jim_Obj *const *argv);
8334
8335 /* Handle calls to the [unknown] command */
8336 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8337 {
8338 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8339 int retCode;
8340
8341 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8342 * done here
8343 */
8344 if (interp->unknown_called) {
8345 return JIM_ERR;
8346 }
8347
8348 /* If the [unknown] command does not exists returns
8349 * just now */
8350 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8351 return JIM_ERR;
8352
8353 /* The object interp->unknown just contains
8354 * the "unknown" string, it is used in order to
8355 * avoid to lookup the unknown command every time
8356 * but instread to cache the result. */
8357 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8358 v = sv;
8359 else
8360 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8361 /* Make a copy of the arguments vector, but shifted on
8362 * the right of one position. The command name of the
8363 * command will be instead the first argument of the
8364 * [unknonw] call. */
8365 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8366 v[0] = interp->unknown;
8367 /* Call it */
8368 interp->unknown_called++;
8369 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8370 interp->unknown_called--;
8371
8372 /* Clean up */
8373 if (v != sv)
8374 Jim_Free(v);
8375 return retCode;
8376 }
8377
8378 /* Eval the object vector 'objv' composed of 'objc' elements.
8379 * Every element is used as single argument.
8380 * Jim_EvalObj() will call this function every time its object
8381 * argument is of "list" type, with no string representation.
8382 *
8383 * This is possible because the string representation of a
8384 * list object generated by the UpdateStringOfList is made
8385 * in a way that ensures that every list element is a different
8386 * command argument. */
8387 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8388 {
8389 int i, retcode;
8390 Jim_Cmd *cmdPtr;
8391
8392 /* Incr refcount of arguments. */
8393 for (i = 0; i < objc; i++)
8394 Jim_IncrRefCount(objv[i]);
8395 /* Command lookup */
8396 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8397 if (cmdPtr == NULL) {
8398 retcode = JimUnknown(interp, objc, objv);
8399 } else {
8400 /* Call it -- Make sure result is an empty object. */
8401 Jim_SetEmptyResult(interp);
8402 if (cmdPtr->cmdProc) {
8403 interp->cmdPrivData = cmdPtr->privData;
8404 retcode = cmdPtr->cmdProc(interp, objc, objv);
8405 if (retcode == JIM_ERR_ADDSTACK) {
8406 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8407 retcode = JIM_ERR;
8408 }
8409 } else {
8410 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8411 if (retcode == JIM_ERR) {
8412 JimAppendStackTrace(interp,
8413 Jim_GetString(objv[0], NULL), "", 1);
8414 }
8415 }
8416 }
8417 /* Decr refcount of arguments and return the retcode */
8418 for (i = 0; i < objc; i++)
8419 Jim_DecrRefCount(interp, objv[i]);
8420 return retcode;
8421 }
8422
8423 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8424 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8425 * The returned object has refcount = 0. */
8426 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8427 int tokens, Jim_Obj **objPtrPtr)
8428 {
8429 int totlen = 0, i, retcode;
8430 Jim_Obj **intv;
8431 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8432 Jim_Obj *objPtr;
8433 char *s;
8434
8435 if (tokens <= JIM_EVAL_SINTV_LEN)
8436 intv = sintv;
8437 else
8438 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8439 tokens);
8440 /* Compute every token forming the argument
8441 * in the intv objects vector. */
8442 for (i = 0; i < tokens; i++) {
8443 switch (token[i].type) {
8444 case JIM_TT_ESC:
8445 case JIM_TT_STR:
8446 intv[i] = token[i].objPtr;
8447 break;
8448 case JIM_TT_VAR:
8449 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8450 if (!intv[i]) {
8451 retcode = JIM_ERR;
8452 goto err;
8453 }
8454 break;
8455 case JIM_TT_DICTSUGAR:
8456 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8457 if (!intv[i]) {
8458 retcode = JIM_ERR;
8459 goto err;
8460 }
8461 break;
8462 case JIM_TT_CMD:
8463 retcode = Jim_EvalObj(interp, token[i].objPtr);
8464 if (retcode != JIM_OK)
8465 goto err;
8466 intv[i] = Jim_GetResult(interp);
8467 break;
8468 default:
8469 Jim_Panic(interp,
8470 "default token type reached "
8471 "in Jim_InterpolateTokens().");
8472 break;
8473 }
8474 Jim_IncrRefCount(intv[i]);
8475 /* Make sure there is a valid
8476 * string rep, and add the string
8477 * length to the total legnth. */
8478 Jim_GetString(intv[i], NULL);
8479 totlen += intv[i]->length;
8480 }
8481 /* Concatenate every token in an unique
8482 * object. */
8483 objPtr = Jim_NewStringObjNoAlloc(interp,
8484 NULL, 0);
8485 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8486 objPtr->length = totlen;
8487 for (i = 0; i < tokens; i++) {
8488 memcpy(s, intv[i]->bytes, intv[i]->length);
8489 s += intv[i]->length;
8490 Jim_DecrRefCount(interp, intv[i]);
8491 }
8492 objPtr->bytes[totlen] = '\0';
8493 /* Free the intv vector if not static. */
8494 if (tokens > JIM_EVAL_SINTV_LEN)
8495 Jim_Free(intv);
8496 *objPtrPtr = objPtr;
8497 return JIM_OK;
8498 err:
8499 i--;
8500 for (; i >= 0; i--)
8501 Jim_DecrRefCount(interp, intv[i]);
8502 if (tokens > JIM_EVAL_SINTV_LEN)
8503 Jim_Free(intv);
8504 return retcode;
8505 }
8506
8507 /* Helper of Jim_EvalObj() to perform argument expansion.
8508 * Basically this function append an argument to 'argv'
8509 * (and increments argc by reference accordingly), performing
8510 * expansion of the list object if 'expand' is non-zero, or
8511 * just adding objPtr to argv if 'expand' is zero. */
8512 static void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8513 int *argcPtr, int expand, Jim_Obj *objPtr)
8514 {
8515 if (!expand) {
8516 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8517 /* refcount of objPtr not incremented because
8518 * we are actually transfering a reference from
8519 * the old 'argv' to the expanded one. */
8520 (*argv)[*argcPtr] = objPtr;
8521 (*argcPtr)++;
8522 } else {
8523 int len, i;
8524
8525 Jim_ListLength(interp, objPtr, &len);
8526 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8527 for (i = 0; i < len; i++) {
8528 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8529 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8530 (*argcPtr)++;
8531 }
8532 /* The original object reference is no longer needed,
8533 * after the expansion it is no longer present on
8534 * the argument vector, but the single elements are
8535 * in its place. */
8536 Jim_DecrRefCount(interp, objPtr);
8537 }
8538 }
8539
8540 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8541 {
8542 int i, j = 0, len;
8543 ScriptObj *script;
8544 ScriptToken *token;
8545 int *cs; /* command structure array */
8546 int retcode = JIM_OK;
8547 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8548
8549 interp->errorFlag = 0;
8550
8551 /* If the object is of type "list" and there is no
8552 * string representation for this object, we can call
8553 * a specialized version of Jim_EvalObj() */
8554 if (scriptObjPtr->typePtr == &listObjType &&
8555 scriptObjPtr->internalRep.listValue.len &&
8556 scriptObjPtr->bytes == NULL) {
8557 Jim_IncrRefCount(scriptObjPtr);
8558 retcode = Jim_EvalObjVector(interp,
8559 scriptObjPtr->internalRep.listValue.len,
8560 scriptObjPtr->internalRep.listValue.ele);
8561 Jim_DecrRefCount(interp, scriptObjPtr);
8562 return retcode;
8563 }
8564
8565 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8566 script = Jim_GetScript(interp, scriptObjPtr);
8567 /* Now we have to make sure the internal repr will not be
8568 * freed on shimmering.
8569 *
8570 * Think for example to this:
8571 *
8572 * set x {llength $x; ... some more code ...}; eval $x
8573 *
8574 * In order to preserve the internal rep, we increment the
8575 * inUse field of the script internal rep structure. */
8576 script->inUse++;
8577
8578 token = script->token;
8579 len = script->len;
8580 cs = script->cmdStruct;
8581 i = 0; /* 'i' is the current token index. */
8582
8583 /* Reset the interpreter result. This is useful to
8584 * return the emtpy result in the case of empty program. */
8585 Jim_SetEmptyResult(interp);
8586
8587 /* Execute every command sequentially, returns on
8588 * error (i.e. if a command does not return JIM_OK) */
8589 while (i < len) {
8590 int expand = 0;
8591 int argc = *cs++; /* Get the number of arguments */
8592 Jim_Cmd *cmd;
8593
8594 /* Set the expand flag if needed. */
8595 if (argc == -1) {
8596 expand++;
8597 argc = *cs++;
8598 }
8599 /* Allocate the arguments vector */
8600 if (argc <= JIM_EVAL_SARGV_LEN)
8601 argv = sargv;
8602 else
8603 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8604 /* Populate the arguments objects. */
8605 for (j = 0; j < argc; j++) {
8606 int tokens = *cs++;
8607
8608 /* tokens is negative if expansion is needed.
8609 * for this argument. */
8610 if (tokens < 0) {
8611 tokens = (-tokens)-1;
8612 i++;
8613 }
8614 if (tokens == 1) {
8615 /* Fast path if the token does not
8616 * need interpolation */
8617 switch (token[i].type) {
8618 case JIM_TT_ESC:
8619 case JIM_TT_STR:
8620 argv[j] = token[i].objPtr;
8621 break;
8622 case JIM_TT_VAR:
8623 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8624 JIM_ERRMSG);
8625 if (!tmpObjPtr) {
8626 retcode = JIM_ERR;
8627 goto err;
8628 }
8629 argv[j] = tmpObjPtr;
8630 break;
8631 case JIM_TT_DICTSUGAR:
8632 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8633 if (!tmpObjPtr) {
8634 retcode = JIM_ERR;
8635 goto err;
8636 }
8637 argv[j] = tmpObjPtr;
8638 break;
8639 case JIM_TT_CMD:
8640 retcode = Jim_EvalObj(interp, token[i].objPtr);
8641 if (retcode != JIM_OK)
8642 goto err;
8643 argv[j] = Jim_GetResult(interp);
8644 break;
8645 default:
8646 Jim_Panic(interp,
8647 "default token type reached "
8648 "in Jim_EvalObj().");
8649 break;
8650 }
8651 Jim_IncrRefCount(argv[j]);
8652 i += 2;
8653 } else {
8654 /* For interpolation we call an helper
8655 * function doing the work for us. */
8656 if ((retcode = Jim_InterpolateTokens(interp,
8657 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8658 {
8659 goto err;
8660 }
8661 argv[j] = tmpObjPtr;
8662 Jim_IncrRefCount(argv[j]);
8663 i += tokens + 1;
8664 }
8665 }
8666 /* Handle {expand} expansion */
8667 if (expand) {
8668 int *ecs = cs - argc;
8669 int eargc = 0;
8670 Jim_Obj **eargv = NULL;
8671
8672 for (j = 0; j < argc; j++) {
8673 Jim_ExpandArgument(interp, &eargv, &eargc,
8674 ecs[j] < 0, argv[j]);
8675 }
8676 if (argv != sargv)
8677 Jim_Free(argv);
8678 argc = eargc;
8679 argv = eargv;
8680 j = argc;
8681 if (argc == 0) {
8682 /* Nothing to do with zero args. */
8683 Jim_Free(eargv);
8684 continue;
8685 }
8686 }
8687 /* Lookup the command to call */
8688 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8689 if (cmd != NULL) {
8690 /* Call it -- Make sure result is an empty object. */
8691 Jim_SetEmptyResult(interp);
8692 if (cmd->cmdProc) {
8693 interp->cmdPrivData = cmd->privData;
8694 retcode = cmd->cmdProc(interp, argc, argv);
8695 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8696 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8697 retcode = JIM_ERR;
8698 }
8699 } else {
8700 retcode = JimCallProcedure(interp, cmd, argc, argv);
8701 if (retcode == JIM_ERR) {
8702 JimAppendStackTrace(interp,
8703 Jim_GetString(argv[0], NULL), script->fileName,
8704 token[i-argc*2].linenr);
8705 }
8706 }
8707 } else {
8708 /* Call [unknown] */
8709 retcode = JimUnknown(interp, argc, argv);
8710 if (retcode == JIM_ERR) {
8711 JimAppendStackTrace(interp,
8712 "", script->fileName,
8713 token[i-argc*2].linenr);
8714 }
8715 }
8716 if (retcode != JIM_OK) {
8717 i -= argc*2; /* point to the command name. */
8718 goto err;
8719 }
8720 /* Decrement the arguments count */
8721 for (j = 0; j < argc; j++) {
8722 Jim_DecrRefCount(interp, argv[j]);
8723 }
8724
8725 if (argv != sargv) {
8726 Jim_Free(argv);
8727 argv = NULL;
8728 }
8729 }
8730 /* Note that we don't have to decrement inUse, because the
8731 * following code transfers our use of the reference again to
8732 * the script object. */
8733 j = 0; /* on normal termination, the argv array is already
8734 Jim_DecrRefCount-ed. */
8735 err:
8736 /* Handle errors. */
8737 if (retcode == JIM_ERR && !interp->errorFlag) {
8738 interp->errorFlag = 1;
8739 JimSetErrorFileName(interp, script->fileName);
8740 JimSetErrorLineNumber(interp, token[i].linenr);
8741 JimResetStackTrace(interp);
8742 }
8743 Jim_FreeIntRep(interp, scriptObjPtr);
8744 scriptObjPtr->typePtr = &scriptObjType;
8745 Jim_SetIntRepPtr(scriptObjPtr, script);
8746 Jim_DecrRefCount(interp, scriptObjPtr);
8747 for (i = 0; i < j; i++) {
8748 Jim_DecrRefCount(interp, argv[i]);
8749 }
8750 if (argv != sargv)
8751 Jim_Free(argv);
8752 return retcode;
8753 }
8754
8755 /* Call a procedure implemented in Tcl.
8756 * It's possible to speed-up a lot this function, currently
8757 * the callframes are not cached, but allocated and
8758 * destroied every time. What is expecially costly is
8759 * to create/destroy the local vars hash table every time.
8760 *
8761 * This can be fixed just implementing callframes caching
8762 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8763 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8764 Jim_Obj *const *argv)
8765 {
8766 int i, retcode;
8767 Jim_CallFrame *callFramePtr;
8768 int num_args;
8769
8770 /* Check arity */
8771 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8772 argc > cmd->arityMax)) {
8773 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8774 Jim_AppendStrings(interp, objPtr,
8775 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8776 (cmd->arityMin > 1) ? " " : "",
8777 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8778 Jim_SetResult(interp, objPtr);
8779 return JIM_ERR;
8780 }
8781 /* Check if there are too nested calls */
8782 if (interp->numLevels == interp->maxNestingDepth) {
8783 Jim_SetResultString(interp,
8784 "Too many nested calls. Infinite recursion?", -1);
8785 return JIM_ERR;
8786 }
8787 /* Create a new callframe */
8788 callFramePtr = JimCreateCallFrame(interp);
8789 callFramePtr->parentCallFrame = interp->framePtr;
8790 callFramePtr->argv = argv;
8791 callFramePtr->argc = argc;
8792 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8793 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8794 callFramePtr->staticVars = cmd->staticVars;
8795 Jim_IncrRefCount(cmd->argListObjPtr);
8796 Jim_IncrRefCount(cmd->bodyObjPtr);
8797 interp->framePtr = callFramePtr;
8798 interp->numLevels ++;
8799
8800 /* Set arguments */
8801 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8802
8803 /* If last argument is 'args', don't set it here */
8804 if (cmd->arityMax == -1) {
8805 num_args--;
8806 }
8807
8808 for (i = 0; i < num_args; i++) {
8809 Jim_Obj *argObjPtr=NULL;
8810 Jim_Obj *nameObjPtr=NULL;
8811 Jim_Obj *valueObjPtr=NULL;
8812
8813 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8814 if (i + 1 >= cmd->arityMin) {
8815 /* The name is the first element of the list */
8816 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8817 }
8818 else {
8819 /* The element arg is the name */
8820 nameObjPtr = argObjPtr;
8821 }
8822
8823 if (i + 1 >= argc) {
8824 /* No more values, so use default */
8825 /* The value is the second element of the list */
8826 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8827 }
8828 else {
8829 valueObjPtr = argv[i + 1];
8830 }
8831 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8832 }
8833 /* Set optional arguments */
8834 if (cmd->arityMax == -1) {
8835 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8836
8837 i++;
8838 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8839 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8840 Jim_SetVariable(interp, objPtr, listObjPtr);
8841 }
8842 /* Eval the body */
8843 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8844
8845 /* Destroy the callframe */
8846 interp->numLevels --;
8847 interp->framePtr = interp->framePtr->parentCallFrame;
8848 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8849 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8850 } else {
8851 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8852 }
8853 /* Handle the JIM_EVAL return code */
8854 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8855 int savedLevel = interp->evalRetcodeLevel;
8856
8857 interp->evalRetcodeLevel = interp->numLevels;
8858 while (retcode == JIM_EVAL) {
8859 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8860 Jim_IncrRefCount(resultScriptObjPtr);
8861 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8862 Jim_DecrRefCount(interp, resultScriptObjPtr);
8863 }
8864 interp->evalRetcodeLevel = savedLevel;
8865 }
8866 /* Handle the JIM_RETURN return code */
8867 if (retcode == JIM_RETURN) {
8868 retcode = interp->returnCode;
8869 interp->returnCode = JIM_OK;
8870 }
8871 return retcode;
8872 }
8873
8874 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8875 {
8876 int retval;
8877 Jim_Obj *scriptObjPtr;
8878
8879 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8880 Jim_IncrRefCount(scriptObjPtr);
8881
8882
8883 if (filename) {
8884 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8885 }
8886
8887 retval = Jim_EvalObj(interp, scriptObjPtr);
8888 Jim_DecrRefCount(interp, scriptObjPtr);
8889 return retval;
8890 }
8891
8892 int Jim_Eval(Jim_Interp *interp, const char *script)
8893 {
8894 return Jim_Eval_Named(interp, script, NULL, 0);
8895 }
8896
8897
8898
8899 /* Execute script in the scope of the global level */
8900 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8901 {
8902 Jim_CallFrame *savedFramePtr;
8903 int retval;
8904
8905 savedFramePtr = interp->framePtr;
8906 interp->framePtr = interp->topFramePtr;
8907 retval = Jim_Eval(interp, script);
8908 interp->framePtr = savedFramePtr;
8909 return retval;
8910 }
8911
8912 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8913 {
8914 Jim_CallFrame *savedFramePtr;
8915 int retval;
8916
8917 savedFramePtr = interp->framePtr;
8918 interp->framePtr = interp->topFramePtr;
8919 retval = Jim_EvalObj(interp, scriptObjPtr);
8920 interp->framePtr = savedFramePtr;
8921 /* Try to report the error (if any) via the bgerror proc */
8922 if (retval != JIM_OK) {
8923 Jim_Obj *objv[2];
8924
8925 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8926 objv[1] = Jim_GetResult(interp);
8927 Jim_IncrRefCount(objv[0]);
8928 Jim_IncrRefCount(objv[1]);
8929 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8930 /* Report the error to stderr. */
8931 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8932 Jim_PrintErrorMessage(interp);
8933 }
8934 Jim_DecrRefCount(interp, objv[0]);
8935 Jim_DecrRefCount(interp, objv[1]);
8936 }
8937 return retval;
8938 }
8939
8940 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8941 {
8942 char *prg = NULL;
8943 FILE *fp;
8944 int nread, totread, maxlen, buflen;
8945 int retval;
8946 Jim_Obj *scriptObjPtr;
8947
8948 if ((fp = fopen(filename, "r")) == NULL) {
8949 const int cwd_len = 2048;
8950 char *cwd = malloc(cwd_len);
8951 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8952 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8953 Jim_AppendStrings(interp, Jim_GetResult(interp),
8954 "Error loading script \"", filename, "\"",
8955 " cwd: ", cwd,
8956 " err: ", strerror(errno), NULL);
8957 free(cwd);
8958 return JIM_ERR;
8959 }
8960 buflen = 1024;
8961 maxlen = totread = 0;
8962 while (1) {
8963 if (maxlen < totread + buflen + 1) {
8964 maxlen = totread + buflen + 1;
8965 prg = Jim_Realloc(prg, maxlen);
8966 }
8967 /* do not use Jim_fread() - this is really a file */
8968 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8969 totread += nread;
8970 }
8971 prg[totread] = '\0';
8972 /* do not use Jim_fclose() - this is really a file */
8973 fclose(fp);
8974
8975 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8976 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8977 Jim_IncrRefCount(scriptObjPtr);
8978 retval = Jim_EvalObj(interp, scriptObjPtr);
8979 Jim_DecrRefCount(interp, scriptObjPtr);
8980 return retval;
8981 }
8982
8983 /* -----------------------------------------------------------------------------
8984 * Subst
8985 * ---------------------------------------------------------------------------*/
8986 static int JimParseSubstStr(struct JimParserCtx *pc)
8987 {
8988 pc->tstart = pc->p;
8989 pc->tline = pc->linenr;
8990 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8991 pc->p++; pc->len--;
8992 }
8993 pc->tend = pc->p-1;
8994 pc->tt = JIM_TT_ESC;
8995 return JIM_OK;
8996 }
8997
8998 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8999 {
9000 int retval;
9001
9002 if (pc->len == 0) {
9003 pc->tstart = pc->tend = pc->p;
9004 pc->tline = pc->linenr;
9005 pc->tt = JIM_TT_EOL;
9006 pc->eof = 1;
9007 return JIM_OK;
9008 }
9009 switch (*pc->p) {
9010 case '[':
9011 retval = JimParseCmd(pc);
9012 if (flags & JIM_SUBST_NOCMD) {
9013 pc->tstart--;
9014 pc->tend++;
9015 pc->tt = (flags & JIM_SUBST_NOESC) ?
9016 JIM_TT_STR : JIM_TT_ESC;
9017 }
9018 return retval;
9019 break;
9020 case '$':
9021 if (JimParseVar(pc) == JIM_ERR) {
9022 pc->tstart = pc->tend = pc->p++; pc->len--;
9023 pc->tline = pc->linenr;
9024 pc->tt = JIM_TT_STR;
9025 } else {
9026 if (flags & JIM_SUBST_NOVAR) {
9027 pc->tstart--;
9028 if (flags & JIM_SUBST_NOESC)
9029 pc->tt = JIM_TT_STR;
9030 else
9031 pc->tt = JIM_TT_ESC;
9032 if (*pc->tstart == '{') {
9033 pc->tstart--;
9034 if (*(pc->tend + 1))
9035 pc->tend++;
9036 }
9037 }
9038 }
9039 break;
9040 default:
9041 retval = JimParseSubstStr(pc);
9042 if (flags & JIM_SUBST_NOESC)
9043 pc->tt = JIM_TT_STR;
9044 return retval;
9045 break;
9046 }
9047 return JIM_OK;
9048 }
9049
9050 /* The subst object type reuses most of the data structures and functions
9051 * of the script object. Script's data structures are a bit more complex
9052 * for what is needed for [subst]itution tasks, but the reuse helps to
9053 * deal with a single data structure at the cost of some more memory
9054 * usage for substitutions. */
9055 static Jim_ObjType substObjType = {
9056 "subst",
9057 FreeScriptInternalRep,
9058 DupScriptInternalRep,
9059 NULL,
9060 JIM_TYPE_REFERENCES,
9061 };
9062
9063 /* This method takes the string representation of an object
9064 * as a Tcl string where to perform [subst]itution, and generates
9065 * the pre-parsed internal representation. */
9066 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9067 {
9068 int scriptTextLen;
9069 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9070 struct JimParserCtx parser;
9071 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9072
9073 script->len = 0;
9074 script->csLen = 0;
9075 script->commands = 0;
9076 script->token = NULL;
9077 script->cmdStruct = NULL;
9078 script->inUse = 1;
9079 script->substFlags = flags;
9080 script->fileName = NULL;
9081
9082 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9083 while (1) {
9084 char *token;
9085 int len, type, linenr;
9086
9087 JimParseSubst(&parser, flags);
9088 if (JimParserEof(&parser)) break;
9089 token = JimParserGetToken(&parser, &len, &type, &linenr);
9090 ScriptObjAddToken(interp, script, token, len, type,
9091 NULL, linenr);
9092 }
9093 /* Free the old internal rep and set the new one. */
9094 Jim_FreeIntRep(interp, objPtr);
9095 Jim_SetIntRepPtr(objPtr, script);
9096 objPtr->typePtr = &scriptObjType;
9097 return JIM_OK;
9098 }
9099
9100 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9101 {
9102 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9103
9104 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9105 SetSubstFromAny(interp, objPtr, flags);
9106 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9107 }
9108
9109 /* Performs commands,variables,blackslashes substitution,
9110 * storing the result object (with refcount 0) into
9111 * resObjPtrPtr. */
9112 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9113 Jim_Obj **resObjPtrPtr, int flags)
9114 {
9115 ScriptObj *script;
9116 ScriptToken *token;
9117 int i, len, retcode = JIM_OK;
9118 Jim_Obj *resObjPtr, *savedResultObjPtr;
9119
9120 script = Jim_GetSubst(interp, substObjPtr, flags);
9121 #ifdef JIM_OPTIMIZATION
9122 /* Fast path for a very common case with array-alike syntax,
9123 * that's: $foo($bar) */
9124 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9125 Jim_Obj *varObjPtr = script->token[0].objPtr;
9126
9127 Jim_IncrRefCount(varObjPtr);
9128 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9129 if (resObjPtr == NULL) {
9130 Jim_DecrRefCount(interp, varObjPtr);
9131 return JIM_ERR;
9132 }
9133 Jim_DecrRefCount(interp, varObjPtr);
9134 *resObjPtrPtr = resObjPtr;
9135 return JIM_OK;
9136 }
9137 #endif
9138
9139 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9140 /* In order to preserve the internal rep, we increment the
9141 * inUse field of the script internal rep structure. */
9142 script->inUse++;
9143
9144 token = script->token;
9145 len = script->len;
9146
9147 /* Save the interp old result, to set it again before
9148 * to return. */
9149 savedResultObjPtr = interp->result;
9150 Jim_IncrRefCount(savedResultObjPtr);
9151
9152 /* Perform the substitution. Starts with an empty object
9153 * and adds every token (performing the appropriate
9154 * var/command/escape substitution). */
9155 resObjPtr = Jim_NewStringObj(interp, "", 0);
9156 for (i = 0; i < len; i++) {
9157 Jim_Obj *objPtr;
9158
9159 switch (token[i].type) {
9160 case JIM_TT_STR:
9161 case JIM_TT_ESC:
9162 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9163 break;
9164 case JIM_TT_VAR:
9165 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9166 if (objPtr == NULL) goto err;
9167 Jim_IncrRefCount(objPtr);
9168 Jim_AppendObj(interp, resObjPtr, objPtr);
9169 Jim_DecrRefCount(interp, objPtr);
9170 break;
9171 case JIM_TT_DICTSUGAR:
9172 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9173 if (!objPtr) {
9174 retcode = JIM_ERR;
9175 goto err;
9176 }
9177 break;
9178 case JIM_TT_CMD:
9179 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9180 goto err;
9181 Jim_AppendObj(interp, resObjPtr, interp->result);
9182 break;
9183 default:
9184 Jim_Panic(interp,
9185 "default token type (%d) reached "
9186 "in Jim_SubstObj().", token[i].type);
9187 break;
9188 }
9189 }
9190 ok:
9191 if (retcode == JIM_OK)
9192 Jim_SetResult(interp, savedResultObjPtr);
9193 Jim_DecrRefCount(interp, savedResultObjPtr);
9194 /* Note that we don't have to decrement inUse, because the
9195 * following code transfers our use of the reference again to
9196 * the script object. */
9197 Jim_FreeIntRep(interp, substObjPtr);
9198 substObjPtr->typePtr = &scriptObjType;
9199 Jim_SetIntRepPtr(substObjPtr, script);
9200 Jim_DecrRefCount(interp, substObjPtr);
9201 *resObjPtrPtr = resObjPtr;
9202 return retcode;
9203 err:
9204 Jim_FreeNewObj(interp, resObjPtr);
9205 retcode = JIM_ERR;
9206 goto ok;
9207 }
9208
9209 /* -----------------------------------------------------------------------------
9210 * API Input/Export functions
9211 * ---------------------------------------------------------------------------*/
9212
9213 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9214 {
9215 Jim_HashEntry *he;
9216
9217 he = Jim_FindHashEntry(&interp->stub, funcname);
9218 if (!he)
9219 return JIM_ERR;
9220 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9221 return JIM_OK;
9222 }
9223
9224 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9225 {
9226 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9227 }
9228
9229 #define JIM_REGISTER_API(name) \
9230 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9231
9232 void JimRegisterCoreApi(Jim_Interp *interp)
9233 {
9234 interp->getApiFuncPtr = Jim_GetApi;
9235 JIM_REGISTER_API(Alloc);
9236 JIM_REGISTER_API(Free);
9237 JIM_REGISTER_API(Eval);
9238 JIM_REGISTER_API(Eval_Named);
9239 JIM_REGISTER_API(EvalGlobal);
9240 JIM_REGISTER_API(EvalFile);
9241 JIM_REGISTER_API(EvalObj);
9242 JIM_REGISTER_API(EvalObjBackground);
9243 JIM_REGISTER_API(EvalObjVector);
9244 JIM_REGISTER_API(InitHashTable);
9245 JIM_REGISTER_API(ExpandHashTable);
9246 JIM_REGISTER_API(AddHashEntry);
9247 JIM_REGISTER_API(ReplaceHashEntry);
9248 JIM_REGISTER_API(DeleteHashEntry);
9249 JIM_REGISTER_API(FreeHashTable);
9250 JIM_REGISTER_API(FindHashEntry);
9251 JIM_REGISTER_API(ResizeHashTable);
9252 JIM_REGISTER_API(GetHashTableIterator);
9253 JIM_REGISTER_API(NextHashEntry);
9254 JIM_REGISTER_API(NewObj);
9255 JIM_REGISTER_API(FreeObj);
9256 JIM_REGISTER_API(InvalidateStringRep);
9257 JIM_REGISTER_API(InitStringRep);
9258 JIM_REGISTER_API(DuplicateObj);
9259 JIM_REGISTER_API(GetString);
9260 JIM_REGISTER_API(Length);
9261 JIM_REGISTER_API(InvalidateStringRep);
9262 JIM_REGISTER_API(NewStringObj);
9263 JIM_REGISTER_API(NewStringObjNoAlloc);
9264 JIM_REGISTER_API(AppendString);
9265 JIM_REGISTER_API(AppendString_sprintf);
9266 JIM_REGISTER_API(AppendObj);
9267 JIM_REGISTER_API(AppendStrings);
9268 JIM_REGISTER_API(StringEqObj);
9269 JIM_REGISTER_API(StringMatchObj);
9270 JIM_REGISTER_API(StringRangeObj);
9271 JIM_REGISTER_API(FormatString);
9272 JIM_REGISTER_API(CompareStringImmediate);
9273 JIM_REGISTER_API(NewReference);
9274 JIM_REGISTER_API(GetReference);
9275 JIM_REGISTER_API(SetFinalizer);
9276 JIM_REGISTER_API(GetFinalizer);
9277 JIM_REGISTER_API(CreateInterp);
9278 JIM_REGISTER_API(FreeInterp);
9279 JIM_REGISTER_API(GetExitCode);
9280 JIM_REGISTER_API(SetStdin);
9281 JIM_REGISTER_API(SetStdout);
9282 JIM_REGISTER_API(SetStderr);
9283 JIM_REGISTER_API(CreateCommand);
9284 JIM_REGISTER_API(CreateProcedure);
9285 JIM_REGISTER_API(DeleteCommand);
9286 JIM_REGISTER_API(RenameCommand);
9287 JIM_REGISTER_API(GetCommand);
9288 JIM_REGISTER_API(SetVariable);
9289 JIM_REGISTER_API(SetVariableStr);
9290 JIM_REGISTER_API(SetGlobalVariableStr);
9291 JIM_REGISTER_API(SetVariableStrWithStr);
9292 JIM_REGISTER_API(SetVariableLink);
9293 JIM_REGISTER_API(GetVariable);
9294 JIM_REGISTER_API(GetCallFrameByLevel);
9295 JIM_REGISTER_API(Collect);
9296 JIM_REGISTER_API(CollectIfNeeded);
9297 JIM_REGISTER_API(GetIndex);
9298 JIM_REGISTER_API(NewListObj);
9299 JIM_REGISTER_API(ListAppendElement);
9300 JIM_REGISTER_API(ListAppendList);
9301 JIM_REGISTER_API(ListLength);
9302 JIM_REGISTER_API(ListIndex);
9303 JIM_REGISTER_API(SetListIndex);
9304 JIM_REGISTER_API(ConcatObj);
9305 JIM_REGISTER_API(NewDictObj);
9306 JIM_REGISTER_API(DictKey);
9307 JIM_REGISTER_API(DictKeysVector);
9308 JIM_REGISTER_API(GetIndex);
9309 JIM_REGISTER_API(GetReturnCode);
9310 JIM_REGISTER_API(EvalExpression);
9311 JIM_REGISTER_API(GetBoolFromExpr);
9312 JIM_REGISTER_API(GetWide);
9313 JIM_REGISTER_API(GetLong);
9314 JIM_REGISTER_API(SetWide);
9315 JIM_REGISTER_API(NewIntObj);
9316 JIM_REGISTER_API(GetDouble);
9317 JIM_REGISTER_API(SetDouble);
9318 JIM_REGISTER_API(NewDoubleObj);
9319 JIM_REGISTER_API(WrongNumArgs);
9320 JIM_REGISTER_API(SetDictKeysVector);
9321 JIM_REGISTER_API(SubstObj);
9322 JIM_REGISTER_API(RegisterApi);
9323 JIM_REGISTER_API(PrintErrorMessage);
9324 JIM_REGISTER_API(InteractivePrompt);
9325 JIM_REGISTER_API(RegisterCoreCommands);
9326 JIM_REGISTER_API(GetSharedString);
9327 JIM_REGISTER_API(ReleaseSharedString);
9328 JIM_REGISTER_API(Panic);
9329 JIM_REGISTER_API(StrDup);
9330 JIM_REGISTER_API(UnsetVariable);
9331 JIM_REGISTER_API(GetVariableStr);
9332 JIM_REGISTER_API(GetGlobalVariable);
9333 JIM_REGISTER_API(GetGlobalVariableStr);
9334 JIM_REGISTER_API(GetAssocData);
9335 JIM_REGISTER_API(SetAssocData);
9336 JIM_REGISTER_API(DeleteAssocData);
9337 JIM_REGISTER_API(GetEnum);
9338 JIM_REGISTER_API(ScriptIsComplete);
9339 JIM_REGISTER_API(PackageRequire);
9340 JIM_REGISTER_API(PackageProvide);
9341 JIM_REGISTER_API(InitStack);
9342 JIM_REGISTER_API(FreeStack);
9343 JIM_REGISTER_API(StackLen);
9344 JIM_REGISTER_API(StackPush);
9345 JIM_REGISTER_API(StackPop);
9346 JIM_REGISTER_API(StackPeek);
9347 JIM_REGISTER_API(FreeStackElements);
9348 JIM_REGISTER_API(fprintf);
9349 JIM_REGISTER_API(vfprintf);
9350 JIM_REGISTER_API(fwrite);
9351 JIM_REGISTER_API(fread);
9352 JIM_REGISTER_API(fflush);
9353 JIM_REGISTER_API(fgets);
9354 JIM_REGISTER_API(GetNvp);
9355 JIM_REGISTER_API(Nvp_name2value);
9356 JIM_REGISTER_API(Nvp_name2value_simple);
9357 JIM_REGISTER_API(Nvp_name2value_obj);
9358 JIM_REGISTER_API(Nvp_name2value_nocase);
9359 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9360
9361 JIM_REGISTER_API(Nvp_value2name);
9362 JIM_REGISTER_API(Nvp_value2name_simple);
9363 JIM_REGISTER_API(Nvp_value2name_obj);
9364
9365 JIM_REGISTER_API(GetOpt_Setup);
9366 JIM_REGISTER_API(GetOpt_Debug);
9367 JIM_REGISTER_API(GetOpt_Obj);
9368 JIM_REGISTER_API(GetOpt_String);
9369 JIM_REGISTER_API(GetOpt_Double);
9370 JIM_REGISTER_API(GetOpt_Wide);
9371 JIM_REGISTER_API(GetOpt_Nvp);
9372 JIM_REGISTER_API(GetOpt_NvpUnknown);
9373 JIM_REGISTER_API(GetOpt_Enum);
9374
9375 JIM_REGISTER_API(Debug_ArgvString);
9376 JIM_REGISTER_API(SetResult_sprintf);
9377 JIM_REGISTER_API(SetResult_NvpUnknown);
9378
9379 }
9380
9381 /* -----------------------------------------------------------------------------
9382 * Core commands utility functions
9383 * ---------------------------------------------------------------------------*/
9384 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9385 const char *msg)
9386 {
9387 int i;
9388 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9389
9390 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9391 for (i = 0; i < argc; i++) {
9392 Jim_AppendObj(interp, objPtr, argv[i]);
9393 if (!(i + 1 == argc && msg[0] == '\0'))
9394 Jim_AppendString(interp, objPtr, " ", 1);
9395 }
9396 Jim_AppendString(interp, objPtr, msg, -1);
9397 Jim_AppendString(interp, objPtr, "\"", 1);
9398 Jim_SetResult(interp, objPtr);
9399 }
9400
9401 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9402 {
9403 Jim_HashTableIterator *htiter;
9404 Jim_HashEntry *he;
9405 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9406 const char *pattern;
9407 int patternLen=0;
9408
9409 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9410 htiter = Jim_GetHashTableIterator(&interp->commands);
9411 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9412 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9413 strlen((const char*)he->key), 0))
9414 continue;
9415 Jim_ListAppendElement(interp, listObjPtr,
9416 Jim_NewStringObj(interp, he->key, -1));
9417 }
9418 Jim_FreeHashTableIterator(htiter);
9419 return listObjPtr;
9420 }
9421
9422 #define JIM_VARLIST_GLOBALS 0
9423 #define JIM_VARLIST_LOCALS 1
9424 #define JIM_VARLIST_VARS 2
9425
9426 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9427 int mode)
9428 {
9429 Jim_HashTableIterator *htiter;
9430 Jim_HashEntry *he;
9431 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9432 const char *pattern;
9433 int patternLen=0;
9434
9435 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9436 if (mode == JIM_VARLIST_GLOBALS) {
9437 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9438 } else {
9439 /* For [info locals], if we are at top level an emtpy list
9440 * is returned. I don't agree, but we aim at compatibility (SS) */
9441 if (mode == JIM_VARLIST_LOCALS &&
9442 interp->framePtr == interp->topFramePtr)
9443 return listObjPtr;
9444 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9445 }
9446 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9447 Jim_Var *varPtr = (Jim_Var*) he->val;
9448 if (mode == JIM_VARLIST_LOCALS) {
9449 if (varPtr->linkFramePtr != NULL)
9450 continue;
9451 }
9452 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9453 strlen((const char*)he->key), 0))
9454 continue;
9455 Jim_ListAppendElement(interp, listObjPtr,
9456 Jim_NewStringObj(interp, he->key, -1));
9457 }
9458 Jim_FreeHashTableIterator(htiter);
9459 return listObjPtr;
9460 }
9461
9462 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9463 Jim_Obj **objPtrPtr)
9464 {
9465 Jim_CallFrame *targetCallFrame;
9466
9467 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9468 != JIM_OK)
9469 return JIM_ERR;
9470 /* No proc call at toplevel callframe */
9471 if (targetCallFrame == interp->topFramePtr) {
9472 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9473 Jim_AppendStrings(interp, Jim_GetResult(interp),
9474 "bad level \"",
9475 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9476 return JIM_ERR;
9477 }
9478 *objPtrPtr = Jim_NewListObj(interp,
9479 targetCallFrame->argv,
9480 targetCallFrame->argc);
9481 return JIM_OK;
9482 }
9483
9484 /* -----------------------------------------------------------------------------
9485 * Core commands
9486 * ---------------------------------------------------------------------------*/
9487
9488 /* fake [puts] -- not the real puts, just for debugging. */
9489 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9490 Jim_Obj *const *argv)
9491 {
9492 const char *str;
9493 int len, nonewline = 0;
9494
9495 if (argc != 2 && argc != 3) {
9496 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9497 return JIM_ERR;
9498 }
9499 if (argc == 3) {
9500 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9501 {
9502 Jim_SetResultString(interp, "The second argument must "
9503 "be -nonewline", -1);
9504 return JIM_OK;
9505 } else {
9506 nonewline = 1;
9507 argv++;
9508 }
9509 }
9510 str = Jim_GetString(argv[1], &len);
9511 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9512 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9513 return JIM_OK;
9514 }
9515
9516 /* Helper for [+] and [*] */
9517 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9518 Jim_Obj *const *argv, int op)
9519 {
9520 jim_wide wideValue, res;
9521 double doubleValue, doubleRes;
9522 int i;
9523
9524 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9525
9526 for (i = 1; i < argc; i++) {
9527 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9528 goto trydouble;
9529 if (op == JIM_EXPROP_ADD)
9530 res += wideValue;
9531 else
9532 res *= wideValue;
9533 }
9534 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9535 return JIM_OK;
9536 trydouble:
9537 doubleRes = (double) res;
9538 for (;i < argc; i++) {
9539 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9540 return JIM_ERR;
9541 if (op == JIM_EXPROP_ADD)
9542 doubleRes += doubleValue;
9543 else
9544 doubleRes *= doubleValue;
9545 }
9546 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9547 return JIM_OK;
9548 }
9549
9550 /* Helper for [-] and [/] */
9551 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9552 Jim_Obj *const *argv, int op)
9553 {
9554 jim_wide wideValue, res = 0;
9555 double doubleValue, doubleRes = 0;
9556 int i = 2;
9557
9558 if (argc < 2) {
9559 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9560 return JIM_ERR;
9561 } else if (argc == 2) {
9562 /* The arity = 2 case is different. For [- x] returns -x,
9563 * while [/ x] returns 1/x. */
9564 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9565 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9566 JIM_OK)
9567 {
9568 return JIM_ERR;
9569 } else {
9570 if (op == JIM_EXPROP_SUB)
9571 doubleRes = -doubleValue;
9572 else
9573 doubleRes = 1.0/doubleValue;
9574 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9575 doubleRes));
9576 return JIM_OK;
9577 }
9578 }
9579 if (op == JIM_EXPROP_SUB) {
9580 res = -wideValue;
9581 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9582 } else {
9583 doubleRes = 1.0/wideValue;
9584 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9585 doubleRes));
9586 }
9587 return JIM_OK;
9588 } else {
9589 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9590 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9591 != JIM_OK) {
9592 return JIM_ERR;
9593 } else {
9594 goto trydouble;
9595 }
9596 }
9597 }
9598 for (i = 2; i < argc; i++) {
9599 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9600 doubleRes = (double) res;
9601 goto trydouble;
9602 }
9603 if (op == JIM_EXPROP_SUB)
9604 res -= wideValue;
9605 else
9606 res /= wideValue;
9607 }
9608 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9609 return JIM_OK;
9610 trydouble:
9611 for (;i < argc; i++) {
9612 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9613 return JIM_ERR;
9614 if (op == JIM_EXPROP_SUB)
9615 doubleRes -= doubleValue;
9616 else
9617 doubleRes /= doubleValue;
9618 }
9619 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9620 return JIM_OK;
9621 }
9622
9623
9624 /* [+] */
9625 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9626 Jim_Obj *const *argv)
9627 {
9628 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9629 }
9630
9631 /* [*] */
9632 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9633 Jim_Obj *const *argv)
9634 {
9635 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9636 }
9637
9638 /* [-] */
9639 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9640 Jim_Obj *const *argv)
9641 {
9642 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9643 }
9644
9645 /* [/] */
9646 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9647 Jim_Obj *const *argv)
9648 {
9649 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9650 }
9651
9652 /* [set] */
9653 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9654 Jim_Obj *const *argv)
9655 {
9656 if (argc != 2 && argc != 3) {
9657 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9658 return JIM_ERR;
9659 }
9660 if (argc == 2) {
9661 Jim_Obj *objPtr;
9662 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9663 if (!objPtr)
9664 return JIM_ERR;
9665 Jim_SetResult(interp, objPtr);
9666 return JIM_OK;
9667 }
9668 /* argc == 3 case. */
9669 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9670 return JIM_ERR;
9671 Jim_SetResult(interp, argv[2]);
9672 return JIM_OK;
9673 }
9674
9675 /* [unset] */
9676 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9677 Jim_Obj *const *argv)
9678 {
9679 int i;
9680
9681 if (argc < 2) {
9682 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9683 return JIM_ERR;
9684 }
9685 for (i = 1; i < argc; i++) {
9686 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9687 return JIM_ERR;
9688 }
9689 return JIM_OK;
9690 }
9691
9692 /* [incr] */
9693 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9694 Jim_Obj *const *argv)
9695 {
9696 jim_wide wideValue, increment = 1;
9697 Jim_Obj *intObjPtr;
9698
9699 if (argc != 2 && argc != 3) {
9700 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9701 return JIM_ERR;
9702 }
9703 if (argc == 3) {
9704 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9705 return JIM_ERR;
9706 }
9707 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9708 if (!intObjPtr) return JIM_ERR;
9709 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9710 return JIM_ERR;
9711 if (Jim_IsShared(intObjPtr)) {
9712 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9713 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9714 Jim_FreeNewObj(interp, intObjPtr);
9715 return JIM_ERR;
9716 }
9717 } else {
9718 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9719 /* The following step is required in order to invalidate the
9720 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9721 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9722 return JIM_ERR;
9723 }
9724 }
9725 Jim_SetResult(interp, intObjPtr);
9726 return JIM_OK;
9727 }
9728
9729 /* [while] */
9730 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9731 Jim_Obj *const *argv)
9732 {
9733 if (argc != 3) {
9734 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9735 return JIM_ERR;
9736 }
9737 /* Try to run a specialized version of while if the expression
9738 * is in one of the following forms:
9739 *
9740 * $a < CONST, $a < $b
9741 * $a <= CONST, $a <= $b
9742 * $a > CONST, $a > $b
9743 * $a >= CONST, $a >= $b
9744 * $a != CONST, $a != $b
9745 * $a == CONST, $a == $b
9746 * $a
9747 * !$a
9748 * CONST
9749 */
9750
9751 #ifdef JIM_OPTIMIZATION
9752 {
9753 ExprByteCode *expr;
9754 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9755 int exprLen, retval;
9756
9757 /* STEP 1 -- Check if there are the conditions to run the specialized
9758 * version of while */
9759
9760 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9761 if (expr->len <= 0 || expr->len > 3) goto noopt;
9762 switch (expr->len) {
9763 case 1:
9764 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9765 expr->opcode[0] != JIM_EXPROP_NUMBER)
9766 goto noopt;
9767 break;
9768 case 2:
9769 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9770 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9771 goto noopt;
9772 break;
9773 case 3:
9774 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9775 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9776 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9777 goto noopt;
9778 switch (expr->opcode[2]) {
9779 case JIM_EXPROP_LT:
9780 case JIM_EXPROP_LTE:
9781 case JIM_EXPROP_GT:
9782 case JIM_EXPROP_GTE:
9783 case JIM_EXPROP_NUMEQ:
9784 case JIM_EXPROP_NUMNE:
9785 /* nothing to do */
9786 break;
9787 default:
9788 goto noopt;
9789 }
9790 break;
9791 default:
9792 Jim_Panic(interp,
9793 "Unexpected default reached in Jim_WhileCoreCommand()");
9794 break;
9795 }
9796
9797 /* STEP 2 -- conditions meet. Initialization. Take different
9798 * branches for different expression lengths. */
9799 exprLen = expr->len;
9800
9801 if (exprLen == 1) {
9802 jim_wide wideValue=0;
9803
9804 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9805 varAObjPtr = expr->obj[0];
9806 Jim_IncrRefCount(varAObjPtr);
9807 } else {
9808 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9809 goto noopt;
9810 }
9811 while (1) {
9812 if (varAObjPtr) {
9813 if (!(objPtr =
9814 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9815 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9816 {
9817 Jim_DecrRefCount(interp, varAObjPtr);
9818 goto noopt;
9819 }
9820 }
9821 if (!wideValue) break;
9822 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9823 switch (retval) {
9824 case JIM_BREAK:
9825 if (varAObjPtr)
9826 Jim_DecrRefCount(interp, varAObjPtr);
9827 goto out;
9828 break;
9829 case JIM_CONTINUE:
9830 continue;
9831 break;
9832 default:
9833 if (varAObjPtr)
9834 Jim_DecrRefCount(interp, varAObjPtr);
9835 return retval;
9836 }
9837 }
9838 }
9839 if (varAObjPtr)
9840 Jim_DecrRefCount(interp, varAObjPtr);
9841 } else if (exprLen == 3) {
9842 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9843 int cmpType = expr->opcode[2];
9844
9845 varAObjPtr = expr->obj[0];
9846 Jim_IncrRefCount(varAObjPtr);
9847 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9848 varBObjPtr = expr->obj[1];
9849 Jim_IncrRefCount(varBObjPtr);
9850 } else {
9851 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9852 goto noopt;
9853 }
9854 while (1) {
9855 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9856 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9857 {
9858 Jim_DecrRefCount(interp, varAObjPtr);
9859 if (varBObjPtr)
9860 Jim_DecrRefCount(interp, varBObjPtr);
9861 goto noopt;
9862 }
9863 if (varBObjPtr) {
9864 if (!(objPtr =
9865 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9866 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9867 {
9868 Jim_DecrRefCount(interp, varAObjPtr);
9869 Jim_DecrRefCount(interp, varBObjPtr);
9870 goto noopt;
9871 }
9872 }
9873 switch (cmpType) {
9874 case JIM_EXPROP_LT:
9875 cmpRes = wideValueA < wideValueB; break;
9876 case JIM_EXPROP_LTE:
9877 cmpRes = wideValueA <= wideValueB; break;
9878 case JIM_EXPROP_GT:
9879 cmpRes = wideValueA > wideValueB; break;
9880 case JIM_EXPROP_GTE:
9881 cmpRes = wideValueA >= wideValueB; break;
9882 case JIM_EXPROP_NUMEQ:
9883 cmpRes = wideValueA == wideValueB; break;
9884 case JIM_EXPROP_NUMNE:
9885 cmpRes = wideValueA != wideValueB; break;
9886 }
9887 if (!cmpRes) break;
9888 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9889 switch (retval) {
9890 case JIM_BREAK:
9891 Jim_DecrRefCount(interp, varAObjPtr);
9892 if (varBObjPtr)
9893 Jim_DecrRefCount(interp, varBObjPtr);
9894 goto out;
9895 break;
9896 case JIM_CONTINUE:
9897 continue;
9898 break;
9899 default:
9900 Jim_DecrRefCount(interp, varAObjPtr);
9901 if (varBObjPtr)
9902 Jim_DecrRefCount(interp, varBObjPtr);
9903 return retval;
9904 }
9905 }
9906 }
9907 Jim_DecrRefCount(interp, varAObjPtr);
9908 if (varBObjPtr)
9909 Jim_DecrRefCount(interp, varBObjPtr);
9910 } else {
9911 /* TODO: case for len == 2 */
9912 goto noopt;
9913 }
9914 Jim_SetEmptyResult(interp);
9915 return JIM_OK;
9916 }
9917 noopt:
9918 #endif
9919
9920 /* The general purpose implementation of while starts here */
9921 while (1) {
9922 int local_boolean, retval;
9923
9924 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9925 &local_boolean)) != JIM_OK)
9926 return retval;
9927 if (!local_boolean) break;
9928 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9929 switch (retval) {
9930 case JIM_BREAK:
9931 goto out;
9932 break;
9933 case JIM_CONTINUE:
9934 continue;
9935 break;
9936 default:
9937 return retval;
9938 }
9939 }
9940 }
9941 out:
9942 Jim_SetEmptyResult(interp);
9943 return JIM_OK;
9944 }
9945
9946 /* [for] */
9947 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9948 Jim_Obj *const *argv)
9949 {
9950 int retval;
9951
9952 if (argc != 5) {
9953 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9954 return JIM_ERR;
9955 }
9956 /* Check if the for is on the form:
9957 * for {set i CONST} {$i < CONST} {incr i}
9958 * for {set i CONST} {$i < $j} {incr i}
9959 * for {set i CONST} {$i <= CONST} {incr i}
9960 * for {set i CONST} {$i <= $j} {incr i}
9961 * XXX: NOTE: if variable traces are implemented, this optimization
9962 * need to be modified to check for the proc epoch at every variable
9963 * update. */
9964 #ifdef JIM_OPTIMIZATION
9965 {
9966 ScriptObj *initScript, *incrScript;
9967 ExprByteCode *expr;
9968 jim_wide start, stop=0, currentVal;
9969 unsigned jim_wide procEpoch = interp->procEpoch;
9970 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9971 int cmpType;
9972 struct Jim_Cmd *cmdPtr;
9973
9974 /* Do it only if there aren't shared arguments */
9975 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9976 goto evalstart;
9977 initScript = Jim_GetScript(interp, argv[1]);
9978 expr = Jim_GetExpression(interp, argv[2]);
9979 incrScript = Jim_GetScript(interp, argv[3]);
9980
9981 /* Ensure proper lengths to start */
9982 if (initScript->len != 6) goto evalstart;
9983 if (incrScript->len != 4) goto evalstart;
9984 if (expr->len != 3) goto evalstart;
9985 /* Ensure proper token types. */
9986 if (initScript->token[2].type != JIM_TT_ESC ||
9987 initScript->token[4].type != JIM_TT_ESC ||
9988 incrScript->token[2].type != JIM_TT_ESC ||
9989 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9990 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9991 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9992 (expr->opcode[2] != JIM_EXPROP_LT &&
9993 expr->opcode[2] != JIM_EXPROP_LTE))
9994 goto evalstart;
9995 cmpType = expr->opcode[2];
9996 /* Initialization command must be [set] */
9997 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9998 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
9999 goto evalstart;
10000 /* Update command must be incr */
10001 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10002 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10003 goto evalstart;
10004 /* set, incr, expression must be about the same variable */
10005 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10006 incrScript->token[2].objPtr, 0))
10007 goto evalstart;
10008 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10009 expr->obj[0], 0))
10010 goto evalstart;
10011 /* Check that the initialization and comparison are valid integers */
10012 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10013 goto evalstart;
10014 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10015 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10016 {
10017 goto evalstart;
10018 }
10019
10020 /* Initialization */
10021 varNamePtr = expr->obj[0];
10022 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10023 stopVarNamePtr = expr->obj[1];
10024 Jim_IncrRefCount(stopVarNamePtr);
10025 }
10026 Jim_IncrRefCount(varNamePtr);
10027
10028 /* --- OPTIMIZED FOR --- */
10029 /* Start to loop */
10030 objPtr = Jim_NewIntObj(interp, start);
10031 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10032 Jim_DecrRefCount(interp, varNamePtr);
10033 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10034 Jim_FreeNewObj(interp, objPtr);
10035 goto evalstart;
10036 }
10037 while (1) {
10038 /* === Check condition === */
10039 /* Common code: */
10040 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10041 if (objPtr == NULL ||
10042 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10043 {
10044 Jim_DecrRefCount(interp, varNamePtr);
10045 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10046 goto testcond;
10047 }
10048 /* Immediate or Variable? get the 'stop' value if the latter. */
10049 if (stopVarNamePtr) {
10050 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10051 if (objPtr == NULL ||
10052 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10053 {
10054 Jim_DecrRefCount(interp, varNamePtr);
10055 Jim_DecrRefCount(interp, stopVarNamePtr);
10056 goto testcond;
10057 }
10058 }
10059 if (cmpType == JIM_EXPROP_LT) {
10060 if (currentVal >= stop) break;
10061 } else {
10062 if (currentVal > stop) break;
10063 }
10064 /* Eval body */
10065 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10066 switch (retval) {
10067 case JIM_BREAK:
10068 if (stopVarNamePtr)
10069 Jim_DecrRefCount(interp, stopVarNamePtr);
10070 Jim_DecrRefCount(interp, varNamePtr);
10071 goto out;
10072 case JIM_CONTINUE:
10073 /* nothing to do */
10074 break;
10075 default:
10076 if (stopVarNamePtr)
10077 Jim_DecrRefCount(interp, stopVarNamePtr);
10078 Jim_DecrRefCount(interp, varNamePtr);
10079 return retval;
10080 }
10081 }
10082 /* If there was a change in procedures/command continue
10083 * with the usual [for] command implementation */
10084 if (procEpoch != interp->procEpoch) {
10085 if (stopVarNamePtr)
10086 Jim_DecrRefCount(interp, stopVarNamePtr);
10087 Jim_DecrRefCount(interp, varNamePtr);
10088 goto evalnext;
10089 }
10090 /* Increment */
10091 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10092 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10093 objPtr->internalRep.wideValue ++;
10094 Jim_InvalidateStringRep(objPtr);
10095 } else {
10096 Jim_Obj *auxObjPtr;
10097
10098 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10099 if (stopVarNamePtr)
10100 Jim_DecrRefCount(interp, stopVarNamePtr);
10101 Jim_DecrRefCount(interp, varNamePtr);
10102 goto evalnext;
10103 }
10104 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10105 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10106 if (stopVarNamePtr)
10107 Jim_DecrRefCount(interp, stopVarNamePtr);
10108 Jim_DecrRefCount(interp, varNamePtr);
10109 Jim_FreeNewObj(interp, auxObjPtr);
10110 goto evalnext;
10111 }
10112 }
10113 }
10114 if (stopVarNamePtr)
10115 Jim_DecrRefCount(interp, stopVarNamePtr);
10116 Jim_DecrRefCount(interp, varNamePtr);
10117 Jim_SetEmptyResult(interp);
10118 return JIM_OK;
10119 }
10120 #endif
10121 evalstart:
10122 /* Eval start */
10123 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10124 return retval;
10125 while (1) {
10126 int local_boolean;
10127 testcond:
10128 /* Test the condition */
10129 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &local_boolean))
10130 != JIM_OK)
10131 return retval;
10132 if (!local_boolean) break;
10133 /* Eval body */
10134 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10135 switch (retval) {
10136 case JIM_BREAK:
10137 goto out;
10138 break;
10139 case JIM_CONTINUE:
10140 /* Nothing to do */
10141 break;
10142 default:
10143 return retval;
10144 }
10145 }
10146 evalnext:
10147 /* Eval next */
10148 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10149 switch (retval) {
10150 case JIM_BREAK:
10151 goto out;
10152 break;
10153 case JIM_CONTINUE:
10154 continue;
10155 break;
10156 default:
10157 return retval;
10158 }
10159 }
10160 }
10161 out:
10162 Jim_SetEmptyResult(interp);
10163 return JIM_OK;
10164 }
10165
10166 /* foreach + lmap implementation. */
10167 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10168 Jim_Obj *const *argv, int doMap)
10169 {
10170 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10171 int nbrOfLoops = 0;
10172 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10173
10174 if (argc < 4 || argc % 2 != 0) {
10175 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10176 return JIM_ERR;
10177 }
10178 if (doMap) {
10179 mapRes = Jim_NewListObj(interp, NULL, 0);
10180 Jim_IncrRefCount(mapRes);
10181 }
10182 emptyStr = Jim_NewEmptyStringObj(interp);
10183 Jim_IncrRefCount(emptyStr);
10184 script = argv[argc-1]; /* Last argument is a script */
10185 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10186 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10187 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10188 /* Initialize iterators and remember max nbr elements each list */
10189 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10190 /* Remember lengths of all lists and calculate how much rounds to loop */
10191 for (i = 0; i < nbrOfLists*2; i += 2) {
10192 div_t cnt;
10193 int count;
10194 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10195 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10196 if (listsEnd[i] == 0) {
10197 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10198 goto err;
10199 }
10200 cnt = div(listsEnd[i + 1], listsEnd[i]);
10201 count = cnt.quot + (cnt.rem ? 1 : 0);
10202 if (count > nbrOfLoops)
10203 nbrOfLoops = count;
10204 }
10205 for (; nbrOfLoops-- > 0;) {
10206 for (i = 0; i < nbrOfLists; ++i) {
10207 int varIdx = 0, var = i * 2;
10208 while (varIdx < listsEnd[var]) {
10209 Jim_Obj *varName, *ele;
10210 int lst = i * 2 + 1;
10211 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10212 != JIM_OK)
10213 goto err;
10214 if (listsIdx[i] < listsEnd[lst]) {
10215 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10216 != JIM_OK)
10217 goto err;
10218 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10219 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10220 goto err;
10221 }
10222 ++listsIdx[i]; /* Remember next iterator of current list */
10223 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10224 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10225 goto err;
10226 }
10227 ++varIdx; /* Next variable */
10228 }
10229 }
10230 switch (result = Jim_EvalObj(interp, script)) {
10231 case JIM_OK:
10232 if (doMap)
10233 Jim_ListAppendElement(interp, mapRes, interp->result);
10234 break;
10235 case JIM_CONTINUE:
10236 break;
10237 case JIM_BREAK:
10238 goto out;
10239 break;
10240 default:
10241 goto err;
10242 }
10243 }
10244 out:
10245 result = JIM_OK;
10246 if (doMap)
10247 Jim_SetResult(interp, mapRes);
10248 else
10249 Jim_SetEmptyResult(interp);
10250 err:
10251 if (doMap)
10252 Jim_DecrRefCount(interp, mapRes);
10253 Jim_DecrRefCount(interp, emptyStr);
10254 Jim_Free(listsIdx);
10255 Jim_Free(listsEnd);
10256 return result;
10257 }
10258
10259 /* [foreach] */
10260 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10261 Jim_Obj *const *argv)
10262 {
10263 return JimForeachMapHelper(interp, argc, argv, 0);
10264 }
10265
10266 /* [lmap] */
10267 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10268 Jim_Obj *const *argv)
10269 {
10270 return JimForeachMapHelper(interp, argc, argv, 1);
10271 }
10272
10273 /* [if] */
10274 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10275 Jim_Obj *const *argv)
10276 {
10277 int local_boolean, retval, current = 1, falsebody = 0;
10278 if (argc >= 3) {
10279 while (1) {
10280 /* Far not enough arguments given! */
10281 if (current >= argc) goto err;
10282 if ((retval = Jim_GetBoolFromExpr(interp,
10283 argv[current++], &local_boolean))
10284 != JIM_OK)
10285 return retval;
10286 /* There lacks something, isn't it? */
10287 if (current >= argc) goto err;
10288 if (Jim_CompareStringImmediate(interp, argv[current],
10289 "then")) current++;
10290 /* Tsk tsk, no then-clause? */
10291 if (current >= argc) goto err;
10292 if (local_boolean)
10293 return Jim_EvalObj(interp, argv[current]);
10294 /* Ok: no else-clause follows */
10295 if (++current >= argc) {
10296 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10297 return JIM_OK;
10298 }
10299 falsebody = current++;
10300 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10301 "else")) {
10302 /* IIICKS - else-clause isn't last cmd? */
10303 if (current != argc-1) goto err;
10304 return Jim_EvalObj(interp, argv[current]);
10305 } else if (Jim_CompareStringImmediate(interp,
10306 argv[falsebody], "elseif"))
10307 /* Ok: elseif follows meaning all the stuff
10308 * again (how boring...) */
10309 continue;
10310 /* OOPS - else-clause is not last cmd?*/
10311 else if (falsebody != argc-1)
10312 goto err;
10313 return Jim_EvalObj(interp, argv[falsebody]);
10314 }
10315 return JIM_OK;
10316 }
10317 err:
10318 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10319 return JIM_ERR;
10320 }
10321
10322 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10323
10324 /* [switch] */
10325 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10326 Jim_Obj *const *argv)
10327 {
10328 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10329 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10330 Jim_Obj *script = 0;
10331 if (argc < 3) goto wrongnumargs;
10332 for (opt = 1; opt < argc; ++opt) {
10333 const char *option = Jim_GetString(argv[opt], 0);
10334 if (*option != '-') break;
10335 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10336 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10337 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10338 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10339 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10340 if ((argc - opt) < 2) goto wrongnumargs;
10341 command = argv[++opt];
10342 } else {
10343 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10344 Jim_AppendStrings(interp, Jim_GetResult(interp),
10345 "bad option \"", option, "\": must be -exact, -glob, "
10346 "-regexp, -command procname or --", 0);
10347 goto err;
10348 }
10349 if ((argc - opt) < 2) goto wrongnumargs;
10350 }
10351 strObj = argv[opt++];
10352 patCount = argc - opt;
10353 if (patCount == 1) {
10354 Jim_Obj **vector;
10355 JimListGetElements(interp, argv[opt], &patCount, &vector);
10356 caseList = vector;
10357 } else
10358 caseList = &argv[opt];
10359 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10360 for (i = 0; script == 0 && i < patCount; i += 2) {
10361 Jim_Obj *patObj = caseList[i];
10362 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10363 || i < (patCount-2)) {
10364 switch (matchOpt) {
10365 case SWITCH_EXACT:
10366 if (Jim_StringEqObj(strObj, patObj, 0))
10367 script = caseList[i + 1];
10368 break;
10369 case SWITCH_GLOB:
10370 if (Jim_StringMatchObj(patObj, strObj, 0))
10371 script = caseList[i + 1];
10372 break;
10373 case SWITCH_RE:
10374 command = Jim_NewStringObj(interp, "regexp", -1);
10375 /* Fall thru intentionally */
10376 case SWITCH_CMD: {
10377 Jim_Obj *parms[] = {command, patObj, strObj};
10378 int rc = Jim_EvalObjVector(interp, 3, parms);
10379 long matching;
10380 /* After the execution of a command we need to
10381 * make sure to reconvert the object into a list
10382 * again. Only for the single-list style [switch]. */
10383 if (argc-opt == 1) {
10384 Jim_Obj **vector;
10385 JimListGetElements(interp, argv[opt], &patCount,
10386 &vector);
10387 caseList = vector;
10388 }
10389 /* command is here already decref'd */
10390 if (rc != JIM_OK) {
10391 retcode = rc;
10392 goto err;
10393 }
10394 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10395 if (rc != JIM_OK) {
10396 retcode = rc;
10397 goto err;
10398 }
10399 if (matching)
10400 script = caseList[i + 1];
10401 break;
10402 }
10403 default:
10404 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10405 Jim_AppendStrings(interp, Jim_GetResult(interp),
10406 "internal error: no such option implemented", 0);
10407 goto err;
10408 }
10409 } else {
10410 script = caseList[i + 1];
10411 }
10412 }
10413 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10414 i += 2)
10415 script = caseList[i + 1];
10416 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10417 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10418 Jim_AppendStrings(interp, Jim_GetResult(interp),
10419 "no body specified for pattern \"",
10420 Jim_GetString(caseList[i-2], 0), "\"", 0);
10421 goto err;
10422 }
10423 retcode = JIM_OK;
10424 Jim_SetEmptyResult(interp);
10425 if (script != 0)
10426 retcode = Jim_EvalObj(interp, script);
10427 return retcode;
10428 wrongnumargs:
10429 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10430 "pattern body ... ?default body? or "
10431 "{pattern body ?pattern body ...?}");
10432 err:
10433 return retcode;
10434 }
10435
10436 /* [list] */
10437 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10438 Jim_Obj *const *argv)
10439 {
10440 Jim_Obj *listObjPtr;
10441
10442 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10443 Jim_SetResult(interp, listObjPtr);
10444 return JIM_OK;
10445 }
10446
10447 /* [lindex] */
10448 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10449 Jim_Obj *const *argv)
10450 {
10451 Jim_Obj *objPtr, *listObjPtr;
10452 int i;
10453 int index_t;
10454
10455 if (argc < 3) {
10456 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10457 return JIM_ERR;
10458 }
10459 objPtr = argv[1];
10460 Jim_IncrRefCount(objPtr);
10461 for (i = 2; i < argc; i++) {
10462 listObjPtr = objPtr;
10463 if (Jim_GetIndex(interp, argv[i], &index_t) != JIM_OK) {
10464 Jim_DecrRefCount(interp, listObjPtr);
10465 return JIM_ERR;
10466 }
10467 if (Jim_ListIndex(interp, listObjPtr, index_t, &objPtr,
10468 JIM_NONE) != JIM_OK) {
10469 /* Returns an empty object if the index
10470 * is out of range. */
10471 Jim_DecrRefCount(interp, listObjPtr);
10472 Jim_SetEmptyResult(interp);
10473 return JIM_OK;
10474 }
10475 Jim_IncrRefCount(objPtr);
10476 Jim_DecrRefCount(interp, listObjPtr);
10477 }
10478 Jim_SetResult(interp, objPtr);
10479 Jim_DecrRefCount(interp, objPtr);
10480 return JIM_OK;
10481 }
10482
10483 /* [llength] */
10484 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10485 Jim_Obj *const *argv)
10486 {
10487 int len;
10488
10489 if (argc != 2) {
10490 Jim_WrongNumArgs(interp, 1, argv, "list");
10491 return JIM_ERR;
10492 }
10493 Jim_ListLength(interp, argv[1], &len);
10494 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10495 return JIM_OK;
10496 }
10497
10498 /* [lappend] */
10499 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10500 Jim_Obj *const *argv)
10501 {
10502 Jim_Obj *listObjPtr;
10503 int shared, i;
10504
10505 if (argc < 2) {
10506 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10507 return JIM_ERR;
10508 }
10509 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10510 if (!listObjPtr) {
10511 /* Create the list if it does not exists */
10512 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10513 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10514 Jim_FreeNewObj(interp, listObjPtr);
10515 return JIM_ERR;
10516 }
10517 }
10518 shared = Jim_IsShared(listObjPtr);
10519 if (shared)
10520 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10521 for (i = 2; i < argc; i++)
10522 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10523 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10524 if (shared)
10525 Jim_FreeNewObj(interp, listObjPtr);
10526 return JIM_ERR;
10527 }
10528 Jim_SetResult(interp, listObjPtr);
10529 return JIM_OK;
10530 }
10531
10532 /* [linsert] */
10533 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10534 Jim_Obj *const *argv)
10535 {
10536 int index_t, len;
10537 Jim_Obj *listPtr;
10538
10539 if (argc < 4) {
10540 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10541 "?element ...?");
10542 return JIM_ERR;
10543 }
10544 listPtr = argv[1];
10545 if (Jim_IsShared(listPtr))
10546 listPtr = Jim_DuplicateObj(interp, listPtr);
10547 if (Jim_GetIndex(interp, argv[2], &index_t) != JIM_OK)
10548 goto err;
10549 Jim_ListLength(interp, listPtr, &len);
10550 if (index_t >= len)
10551 index_t = len;
10552 else if (index_t < 0)
10553 index_t = len + index_t + 1;
10554 Jim_ListInsertElements(interp, listPtr, index_t, argc-3, &argv[3]);
10555 Jim_SetResult(interp, listPtr);
10556 return JIM_OK;
10557 err:
10558 if (listPtr != argv[1]) {
10559 Jim_FreeNewObj(interp, listPtr);
10560 }
10561 return JIM_ERR;
10562 }
10563
10564 /* [lset] */
10565 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10566 Jim_Obj *const *argv)
10567 {
10568 if (argc < 3) {
10569 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10570 return JIM_ERR;
10571 } else if (argc == 3) {
10572 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10573 return JIM_ERR;
10574 Jim_SetResult(interp, argv[2]);
10575 return JIM_OK;
10576 }
10577 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10578 == JIM_ERR) return JIM_ERR;
10579 return JIM_OK;
10580 }
10581
10582 /* [lsort] */
10583 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10584 {
10585 const char *options[] = {
10586 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10587 };
10588 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10589 Jim_Obj *resObj;
10590 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10591 int decreasing = 0;
10592
10593 if (argc < 2) {
10594 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10595 return JIM_ERR;
10596 }
10597 for (i = 1; i < (argc-1); i++) {
10598 int option;
10599
10600 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10601 != JIM_OK)
10602 return JIM_ERR;
10603 switch (option) {
10604 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10605 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10606 case OPT_INCREASING: decreasing = 0; break;
10607 case OPT_DECREASING: decreasing = 1; break;
10608 }
10609 }
10610 if (decreasing) {
10611 switch (lsortType) {
10612 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10613 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10614 }
10615 }
10616 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10617 ListSortElements(interp, resObj, lsortType);
10618 Jim_SetResult(interp, resObj);
10619 return JIM_OK;
10620 }
10621
10622 /* [append] */
10623 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10624 Jim_Obj *const *argv)
10625 {
10626 Jim_Obj *stringObjPtr;
10627 int shared, i;
10628
10629 if (argc < 2) {
10630 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10631 return JIM_ERR;
10632 }
10633 if (argc == 2) {
10634 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10635 if (!stringObjPtr) return JIM_ERR;
10636 } else {
10637 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10638 if (!stringObjPtr) {
10639 /* Create the string if it does not exists */
10640 stringObjPtr = Jim_NewEmptyStringObj(interp);
10641 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10642 != JIM_OK) {
10643 Jim_FreeNewObj(interp, stringObjPtr);
10644 return JIM_ERR;
10645 }
10646 }
10647 }
10648 shared = Jim_IsShared(stringObjPtr);
10649 if (shared)
10650 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10651 for (i = 2; i < argc; i++)
10652 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10653 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10654 if (shared)
10655 Jim_FreeNewObj(interp, stringObjPtr);
10656 return JIM_ERR;
10657 }
10658 Jim_SetResult(interp, stringObjPtr);
10659 return JIM_OK;
10660 }
10661
10662 /* [debug] */
10663 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10664 Jim_Obj *const *argv)
10665 {
10666 const char *options[] = {
10667 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10668 "exprbc",
10669 NULL
10670 };
10671 enum {
10672 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10673 OPT_EXPRLEN, OPT_EXPRBC
10674 };
10675 int option;
10676
10677 if (argc < 2) {
10678 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10679 return JIM_ERR;
10680 }
10681 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10682 JIM_ERRMSG) != JIM_OK)
10683 return JIM_ERR;
10684 if (option == OPT_REFCOUNT) {
10685 if (argc != 3) {
10686 Jim_WrongNumArgs(interp, 2, argv, "object");
10687 return JIM_ERR;
10688 }
10689 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10690 return JIM_OK;
10691 } else if (option == OPT_OBJCOUNT) {
10692 int freeobj = 0, liveobj = 0;
10693 char buf[256];
10694 Jim_Obj *objPtr;
10695
10696 if (argc != 2) {
10697 Jim_WrongNumArgs(interp, 2, argv, "");
10698 return JIM_ERR;
10699 }
10700 /* Count the number of free objects. */
10701 objPtr = interp->freeList;
10702 while (objPtr) {
10703 freeobj++;
10704 objPtr = objPtr->nextObjPtr;
10705 }
10706 /* Count the number of live objects. */
10707 objPtr = interp->liveList;
10708 while (objPtr) {
10709 liveobj++;
10710 objPtr = objPtr->nextObjPtr;
10711 }
10712 /* Set the result string and return. */
10713 sprintf(buf, "free %d used %d", freeobj, liveobj);
10714 Jim_SetResultString(interp, buf, -1);
10715 return JIM_OK;
10716 } else if (option == OPT_OBJECTS) {
10717 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10718 /* Count the number of live objects. */
10719 objPtr = interp->liveList;
10720 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10721 while (objPtr) {
10722 char buf[128];
10723 const char *type = objPtr->typePtr ?
10724 objPtr->typePtr->name : "";
10725 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10726 sprintf(buf, "%p", objPtr);
10727 Jim_ListAppendElement(interp, subListObjPtr,
10728 Jim_NewStringObj(interp, buf, -1));
10729 Jim_ListAppendElement(interp, subListObjPtr,
10730 Jim_NewStringObj(interp, type, -1));
10731 Jim_ListAppendElement(interp, subListObjPtr,
10732 Jim_NewIntObj(interp, objPtr->refCount));
10733 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10734 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10735 objPtr = objPtr->nextObjPtr;
10736 }
10737 Jim_SetResult(interp, listObjPtr);
10738 return JIM_OK;
10739 } else if (option == OPT_INVSTR) {
10740 Jim_Obj *objPtr;
10741
10742 if (argc != 3) {
10743 Jim_WrongNumArgs(interp, 2, argv, "object");
10744 return JIM_ERR;
10745 }
10746 objPtr = argv[2];
10747 if (objPtr->typePtr != NULL)
10748 Jim_InvalidateStringRep(objPtr);
10749 Jim_SetEmptyResult(interp);
10750 return JIM_OK;
10751 } else if (option == OPT_SCRIPTLEN) {
10752 ScriptObj *script;
10753 if (argc != 3) {
10754 Jim_WrongNumArgs(interp, 2, argv, "script");
10755 return JIM_ERR;
10756 }
10757 script = Jim_GetScript(interp, argv[2]);
10758 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10759 return JIM_OK;
10760 } else if (option == OPT_EXPRLEN) {
10761 ExprByteCode *expr;
10762 if (argc != 3) {
10763 Jim_WrongNumArgs(interp, 2, argv, "expression");
10764 return JIM_ERR;
10765 }
10766 expr = Jim_GetExpression(interp, argv[2]);
10767 if (expr == NULL)
10768 return JIM_ERR;
10769 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10770 return JIM_OK;
10771 } else if (option == OPT_EXPRBC) {
10772 Jim_Obj *objPtr;
10773 ExprByteCode *expr;
10774 int i;
10775
10776 if (argc != 3) {
10777 Jim_WrongNumArgs(interp, 2, argv, "expression");
10778 return JIM_ERR;
10779 }
10780 expr = Jim_GetExpression(interp, argv[2]);
10781 if (expr == NULL)
10782 return JIM_ERR;
10783 objPtr = Jim_NewListObj(interp, NULL, 0);
10784 for (i = 0; i < expr->len; i++) {
10785 const char *type;
10786 Jim_ExprOperator *op;
10787
10788 switch (expr->opcode[i]) {
10789 case JIM_EXPROP_NUMBER: type = "number"; break;
10790 case JIM_EXPROP_COMMAND: type = "command"; break;
10791 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10792 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10793 case JIM_EXPROP_SUBST: type = "subst"; break;
10794 case JIM_EXPROP_STRING: type = "string"; break;
10795 default:
10796 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10797 if (op == NULL) {
10798 type = "private";
10799 } else {
10800 type = "operator";
10801 }
10802 break;
10803 }
10804 Jim_ListAppendElement(interp, objPtr,
10805 Jim_NewStringObj(interp, type, -1));
10806 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10807 }
10808 Jim_SetResult(interp, objPtr);
10809 return JIM_OK;
10810 } else {
10811 Jim_SetResultString(interp,
10812 "bad option. Valid options are refcount, "
10813 "objcount, objects, invstr", -1);
10814 return JIM_ERR;
10815 }
10816 return JIM_OK; /* unreached */
10817 }
10818
10819 /* [eval] */
10820 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10821 Jim_Obj *const *argv)
10822 {
10823 if (argc == 2) {
10824 return Jim_EvalObj(interp, argv[1]);
10825 } else if (argc > 2) {
10826 Jim_Obj *objPtr;
10827 int retcode;
10828
10829 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10830 Jim_IncrRefCount(objPtr);
10831 retcode = Jim_EvalObj(interp, objPtr);
10832 Jim_DecrRefCount(interp, objPtr);
10833 return retcode;
10834 } else {
10835 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10836 return JIM_ERR;
10837 }
10838 }
10839
10840 /* [uplevel] */
10841 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10842 Jim_Obj *const *argv)
10843 {
10844 if (argc >= 2) {
10845 int retcode, newLevel, oldLevel;
10846 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10847 Jim_Obj *objPtr;
10848 const char *str;
10849
10850 /* Save the old callframe pointer */
10851 savedCallFrame = interp->framePtr;
10852
10853 /* Lookup the target frame pointer */
10854 str = Jim_GetString(argv[1], NULL);
10855 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10856 {
10857 if (Jim_GetCallFrameByLevel(interp, argv[1],
10858 &targetCallFrame,
10859 &newLevel) != JIM_OK)
10860 return JIM_ERR;
10861 argc--;
10862 argv++;
10863 } else {
10864 if (Jim_GetCallFrameByLevel(interp, NULL,
10865 &targetCallFrame,
10866 &newLevel) != JIM_OK)
10867 return JIM_ERR;
10868 }
10869 if (argc < 2) {
10870 argc++;
10871 argv--;
10872 Jim_WrongNumArgs(interp, 1, argv,
10873 "?level? command ?arg ...?");
10874 return JIM_ERR;
10875 }
10876 /* Eval the code in the target callframe. */
10877 interp->framePtr = targetCallFrame;
10878 oldLevel = interp->numLevels;
10879 interp->numLevels = newLevel;
10880 if (argc == 2) {
10881 retcode = Jim_EvalObj(interp, argv[1]);
10882 } else {
10883 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10884 Jim_IncrRefCount(objPtr);
10885 retcode = Jim_EvalObj(interp, objPtr);
10886 Jim_DecrRefCount(interp, objPtr);
10887 }
10888 interp->numLevels = oldLevel;
10889 interp->framePtr = savedCallFrame;
10890 return retcode;
10891 } else {
10892 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10893 return JIM_ERR;
10894 }
10895 }
10896
10897 /* [expr] */
10898 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10899 Jim_Obj *const *argv)
10900 {
10901 Jim_Obj *exprResultPtr;
10902 int retcode;
10903
10904 if (argc == 2) {
10905 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10906 } else if (argc > 2) {
10907 Jim_Obj *objPtr;
10908
10909 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10910 Jim_IncrRefCount(objPtr);
10911 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10912 Jim_DecrRefCount(interp, objPtr);
10913 } else {
10914 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10915 return JIM_ERR;
10916 }
10917 if (retcode != JIM_OK) return retcode;
10918 Jim_SetResult(interp, exprResultPtr);
10919 Jim_DecrRefCount(interp, exprResultPtr);
10920 return JIM_OK;
10921 }
10922
10923 /* [break] */
10924 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10925 Jim_Obj *const *argv)
10926 {
10927 if (argc != 1) {
10928 Jim_WrongNumArgs(interp, 1, argv, "");
10929 return JIM_ERR;
10930 }
10931 return JIM_BREAK;
10932 }
10933
10934 /* [continue] */
10935 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10936 Jim_Obj *const *argv)
10937 {
10938 if (argc != 1) {
10939 Jim_WrongNumArgs(interp, 1, argv, "");
10940 return JIM_ERR;
10941 }
10942 return JIM_CONTINUE;
10943 }
10944
10945 /* [return] */
10946 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10947 Jim_Obj *const *argv)
10948 {
10949 if (argc == 1) {
10950 return JIM_RETURN;
10951 } else if (argc == 2) {
10952 Jim_SetResult(interp, argv[1]);
10953 interp->returnCode = JIM_OK;
10954 return JIM_RETURN;
10955 } else if (argc == 3 || argc == 4) {
10956 int returnCode;
10957 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10958 return JIM_ERR;
10959 interp->returnCode = returnCode;
10960 if (argc == 4)
10961 Jim_SetResult(interp, argv[3]);
10962 return JIM_RETURN;
10963 } else {
10964 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10965 return JIM_ERR;
10966 }
10967 return JIM_RETURN; /* unreached */
10968 }
10969
10970 /* [tailcall] */
10971 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10972 Jim_Obj *const *argv)
10973 {
10974 Jim_Obj *objPtr;
10975
10976 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10977 Jim_SetResult(interp, objPtr);
10978 return JIM_EVAL;
10979 }
10980
10981 /* [proc] */
10982 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10983 Jim_Obj *const *argv)
10984 {
10985 int argListLen;
10986 int arityMin, arityMax;
10987
10988 if (argc != 4 && argc != 5) {
10989 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10990 return JIM_ERR;
10991 }
10992 Jim_ListLength(interp, argv[2], &argListLen);
10993 arityMin = arityMax = argListLen + 1;
10994
10995 if (argListLen) {
10996 const char *str;
10997 int len;
10998 Jim_Obj *argPtr=NULL;
10999
11000 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11001 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11002 str = Jim_GetString(argPtr, &len);
11003 if (len == 4 && memcmp(str, "args", 4) == 0) {
11004 arityMin--;
11005 arityMax = -1;
11006 }
11007
11008 /* Check for default arguments and reduce arityMin if necessary */
11009 while (arityMin > 1) {
11010 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11011 Jim_ListLength(interp, argPtr, &len);
11012 if (len != 2) {
11013 /* No default argument */
11014 break;
11015 }
11016 arityMin--;
11017 }
11018 }
11019 if (argc == 4) {
11020 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11021 argv[2], NULL, argv[3], arityMin, arityMax);
11022 } else {
11023 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11024 argv[2], argv[3], argv[4], arityMin, arityMax);
11025 }
11026 }
11027
11028 /* [concat] */
11029 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11030 Jim_Obj *const *argv)
11031 {
11032 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11033 return JIM_OK;
11034 }
11035
11036 /* [upvar] */
11037 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11038 Jim_Obj *const *argv)
11039 {
11040 const char *str;
11041 int i;
11042 Jim_CallFrame *targetCallFrame;
11043
11044 /* Lookup the target frame pointer */
11045 str = Jim_GetString(argv[1], NULL);
11046 if (argc > 3 &&
11047 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11048 {
11049 if (Jim_GetCallFrameByLevel(interp, argv[1],
11050 &targetCallFrame, NULL) != JIM_OK)
11051 return JIM_ERR;
11052 argc--;
11053 argv++;
11054 } else {
11055 if (Jim_GetCallFrameByLevel(interp, NULL,
11056 &targetCallFrame, NULL) != JIM_OK)
11057 return JIM_ERR;
11058 }
11059 /* Check for arity */
11060 if (argc < 3 || ((argc-1)%2) != 0) {
11061 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11062 return JIM_ERR;
11063 }
11064 /* Now... for every other/local couple: */
11065 for (i = 1; i < argc; i += 2) {
11066 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11067 targetCallFrame) != JIM_OK) return JIM_ERR;
11068 }
11069 return JIM_OK;
11070 }
11071
11072 /* [global] */
11073 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11074 Jim_Obj *const *argv)
11075 {
11076 int i;
11077
11078 if (argc < 2) {
11079 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11080 return JIM_ERR;
11081 }
11082 /* Link every var to the toplevel having the same name */
11083 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11084 for (i = 1; i < argc; i++) {
11085 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11086 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11087 }
11088 return JIM_OK;
11089 }
11090
11091 /* does the [string map] operation. On error NULL is returned,
11092 * otherwise a new string object with the result, having refcount = 0,
11093 * is returned. */
11094 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11095 Jim_Obj *objPtr, int nocase)
11096 {
11097 int numMaps;
11098 const char **key, *str, *noMatchStart = NULL;
11099 Jim_Obj **value;
11100 int *keyLen, strLen, i;
11101 Jim_Obj *resultObjPtr;
11102
11103 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11104 if (numMaps % 2) {
11105 Jim_SetResultString(interp,
11106 "list must contain an even number of elements", -1);
11107 return NULL;
11108 }
11109 /* Initialization */
11110 numMaps /= 2;
11111 key = Jim_Alloc(sizeof(char*)*numMaps);
11112 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11113 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11114 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11115 for (i = 0; i < numMaps; i++) {
11116 Jim_Obj *eleObjPtr=NULL;
11117
11118 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11119 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11120 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11121 value[i] = eleObjPtr;
11122 }
11123 str = Jim_GetString(objPtr, &strLen);
11124 /* Map it */
11125 while (strLen) {
11126 for (i = 0; i < numMaps; i++) {
11127 if (strLen >= keyLen[i] && keyLen[i]) {
11128 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11129 nocase))
11130 {
11131 if (noMatchStart) {
11132 Jim_AppendString(interp, resultObjPtr,
11133 noMatchStart, str-noMatchStart);
11134 noMatchStart = NULL;
11135 }
11136 Jim_AppendObj(interp, resultObjPtr, value[i]);
11137 str += keyLen[i];
11138 strLen -= keyLen[i];
11139 break;
11140 }
11141 }
11142 }
11143 if (i == numMaps) { /* no match */
11144 if (noMatchStart == NULL)
11145 noMatchStart = str;
11146 str ++;
11147 strLen --;
11148 }
11149 }
11150 if (noMatchStart) {
11151 Jim_AppendString(interp, resultObjPtr,
11152 noMatchStart, str-noMatchStart);
11153 }
11154 Jim_Free((void*)key);
11155 Jim_Free(keyLen);
11156 Jim_Free(value);
11157 return resultObjPtr;
11158 }
11159
11160 /* [string] */
11161 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11162 Jim_Obj *const *argv)
11163 {
11164 int option;
11165 const char *options[] = {
11166 "length", "compare", "match", "equal", "range", "map", "repeat",
11167 "index", "first", "tolower", "toupper", NULL
11168 };
11169 enum {
11170 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11171 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11172 };
11173
11174 if (argc < 2) {
11175 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11176 return JIM_ERR;
11177 }
11178 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11179 JIM_ERRMSG) != JIM_OK)
11180 return JIM_ERR;
11181
11182 if (option == OPT_LENGTH) {
11183 int len;
11184
11185 if (argc != 3) {
11186 Jim_WrongNumArgs(interp, 2, argv, "string");
11187 return JIM_ERR;
11188 }
11189 Jim_GetString(argv[2], &len);
11190 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11191 return JIM_OK;
11192 } else if (option == OPT_COMPARE) {
11193 int nocase = 0;
11194 if ((argc != 4 && argc != 5) ||
11195 (argc == 5 && Jim_CompareStringImmediate(interp,
11196 argv[2], "-nocase") == 0)) {
11197 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11198 return JIM_ERR;
11199 }
11200 if (argc == 5) {
11201 nocase = 1;
11202 argv++;
11203 }
11204 Jim_SetResult(interp, Jim_NewIntObj(interp,
11205 Jim_StringCompareObj(argv[2],
11206 argv[3], nocase)));
11207 return JIM_OK;
11208 } else if (option == OPT_MATCH) {
11209 int nocase = 0;
11210 if ((argc != 4 && argc != 5) ||
11211 (argc == 5 && Jim_CompareStringImmediate(interp,
11212 argv[2], "-nocase") == 0)) {
11213 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11214 "string");
11215 return JIM_ERR;
11216 }
11217 if (argc == 5) {
11218 nocase = 1;
11219 argv++;
11220 }
11221 Jim_SetResult(interp,
11222 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11223 argv[3], nocase)));
11224 return JIM_OK;
11225 } else if (option == OPT_EQUAL) {
11226 if (argc != 4) {
11227 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11228 return JIM_ERR;
11229 }
11230 Jim_SetResult(interp,
11231 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11232 argv[3], 0)));
11233 return JIM_OK;
11234 } else if (option == OPT_RANGE) {
11235 Jim_Obj *objPtr;
11236
11237 if (argc != 5) {
11238 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11239 return JIM_ERR;
11240 }
11241 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11242 if (objPtr == NULL)
11243 return JIM_ERR;
11244 Jim_SetResult(interp, objPtr);
11245 return JIM_OK;
11246 } else if (option == OPT_MAP) {
11247 int nocase = 0;
11248 Jim_Obj *objPtr;
11249
11250 if ((argc != 4 && argc != 5) ||
11251 (argc == 5 && Jim_CompareStringImmediate(interp,
11252 argv[2], "-nocase") == 0)) {
11253 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11254 "string");
11255 return JIM_ERR;
11256 }
11257 if (argc == 5) {
11258 nocase = 1;
11259 argv++;
11260 }
11261 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11262 if (objPtr == NULL)
11263 return JIM_ERR;
11264 Jim_SetResult(interp, objPtr);
11265 return JIM_OK;
11266 } else if (option == OPT_REPEAT) {
11267 Jim_Obj *objPtr;
11268 jim_wide count;
11269
11270 if (argc != 4) {
11271 Jim_WrongNumArgs(interp, 2, argv, "string count");
11272 return JIM_ERR;
11273 }
11274 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11275 return JIM_ERR;
11276 objPtr = Jim_NewStringObj(interp, "", 0);
11277 while (count--) {
11278 Jim_AppendObj(interp, objPtr, argv[2]);
11279 }
11280 Jim_SetResult(interp, objPtr);
11281 return JIM_OK;
11282 } else if (option == OPT_INDEX) {
11283 int index_t, len;
11284 const char *str;
11285
11286 if (argc != 4) {
11287 Jim_WrongNumArgs(interp, 2, argv, "string index");
11288 return JIM_ERR;
11289 }
11290 if (Jim_GetIndex(interp, argv[3], &index_t) != JIM_OK)
11291 return JIM_ERR;
11292 str = Jim_GetString(argv[2], &len);
11293 if (index_t != INT_MIN && index_t != INT_MAX)
11294 index_t = JimRelToAbsIndex(len, index_t);
11295 if (index_t < 0 || index_t >= len) {
11296 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11297 return JIM_OK;
11298 } else {
11299 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index_t, 1));
11300 return JIM_OK;
11301 }
11302 } else if (option == OPT_FIRST) {
11303 int index_t = 0, l1, l2;
11304 const char *s1, *s2;
11305
11306 if (argc != 4 && argc != 5) {
11307 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11308 return JIM_ERR;
11309 }
11310 s1 = Jim_GetString(argv[2], &l1);
11311 s2 = Jim_GetString(argv[3], &l2);
11312 if (argc == 5) {
11313 if (Jim_GetIndex(interp, argv[4], &index_t) != JIM_OK)
11314 return JIM_ERR;
11315 index_t = JimRelToAbsIndex(l2, index_t);
11316 }
11317 Jim_SetResult(interp, Jim_NewIntObj(interp,
11318 JimStringFirst(s1, l1, s2, l2, index_t)));
11319 return JIM_OK;
11320 } else if (option == OPT_TOLOWER) {
11321 if (argc != 3) {
11322 Jim_WrongNumArgs(interp, 2, argv, "string");
11323 return JIM_ERR;
11324 }
11325 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11326 } else if (option == OPT_TOUPPER) {
11327 if (argc != 3) {
11328 Jim_WrongNumArgs(interp, 2, argv, "string");
11329 return JIM_ERR;
11330 }
11331 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11332 }
11333 return JIM_OK;
11334 }
11335
11336 /* [time] */
11337 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11338 Jim_Obj *const *argv)
11339 {
11340 long i, count = 1;
11341 jim_wide start, elapsed;
11342 char buf [256];
11343 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11344
11345 if (argc < 2) {
11346 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11347 return JIM_ERR;
11348 }
11349 if (argc == 3) {
11350 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11351 return JIM_ERR;
11352 }
11353 if (count < 0)
11354 return JIM_OK;
11355 i = count;
11356 start = JimClock();
11357 while (i-- > 0) {
11358 int retval;
11359
11360 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11361 return retval;
11362 }
11363 elapsed = JimClock() - start;
11364 sprintf(buf, fmt, elapsed/count);
11365 Jim_SetResultString(interp, buf, -1);
11366 return JIM_OK;
11367 }
11368
11369 /* [exit] */
11370 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11371 Jim_Obj *const *argv)
11372 {
11373 long exitCode = 0;
11374
11375 if (argc > 2) {
11376 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11377 return JIM_ERR;
11378 }
11379 if (argc == 2) {
11380 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11381 return JIM_ERR;
11382 }
11383 interp->exitCode = exitCode;
11384 return JIM_EXIT;
11385 }
11386
11387 /* [catch] */
11388 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11389 Jim_Obj *const *argv)
11390 {
11391 int exitCode = 0;
11392
11393 if (argc != 2 && argc != 3) {
11394 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11395 return JIM_ERR;
11396 }
11397 exitCode = Jim_EvalObj(interp, argv[1]);
11398 if (argc == 3) {
11399 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11400 != JIM_OK)
11401 return JIM_ERR;
11402 }
11403 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11404 return JIM_OK;
11405 }
11406
11407 /* [ref] */
11408 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11409 Jim_Obj *const *argv)
11410 {
11411 if (argc != 3 && argc != 4) {
11412 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11413 return JIM_ERR;
11414 }
11415 if (argc == 3) {
11416 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11417 } else {
11418 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11419 argv[3]));
11420 }
11421 return JIM_OK;
11422 }
11423
11424 /* [getref] */
11425 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11426 Jim_Obj *const *argv)
11427 {
11428 Jim_Reference *refPtr;
11429
11430 if (argc != 2) {
11431 Jim_WrongNumArgs(interp, 1, argv, "reference");
11432 return JIM_ERR;
11433 }
11434 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11435 return JIM_ERR;
11436 Jim_SetResult(interp, refPtr->objPtr);
11437 return JIM_OK;
11438 }
11439
11440 /* [setref] */
11441 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11442 Jim_Obj *const *argv)
11443 {
11444 Jim_Reference *refPtr;
11445
11446 if (argc != 3) {
11447 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11448 return JIM_ERR;
11449 }
11450 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11451 return JIM_ERR;
11452 Jim_IncrRefCount(argv[2]);
11453 Jim_DecrRefCount(interp, refPtr->objPtr);
11454 refPtr->objPtr = argv[2];
11455 Jim_SetResult(interp, argv[2]);
11456 return JIM_OK;
11457 }
11458
11459 /* [collect] */
11460 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11461 Jim_Obj *const *argv)
11462 {
11463 if (argc != 1) {
11464 Jim_WrongNumArgs(interp, 1, argv, "");
11465 return JIM_ERR;
11466 }
11467 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11468 return JIM_OK;
11469 }
11470
11471 /* [finalize] reference ?newValue? */
11472 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11473 Jim_Obj *const *argv)
11474 {
11475 if (argc != 2 && argc != 3) {
11476 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11477 return JIM_ERR;
11478 }
11479 if (argc == 2) {
11480 Jim_Obj *cmdNamePtr;
11481
11482 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11483 return JIM_ERR;
11484 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11485 Jim_SetResult(interp, cmdNamePtr);
11486 } else {
11487 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11488 return JIM_ERR;
11489 Jim_SetResult(interp, argv[2]);
11490 }
11491 return JIM_OK;
11492 }
11493
11494 /* TODO */
11495 /* [info references] (list of all the references/finalizers) */
11496
11497 /* [rename] */
11498 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11499 Jim_Obj *const *argv)
11500 {
11501 const char *oldName, *newName;
11502
11503 if (argc != 3) {
11504 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11505 return JIM_ERR;
11506 }
11507 oldName = Jim_GetString(argv[1], NULL);
11508 newName = Jim_GetString(argv[2], NULL);
11509 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11510 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11511 Jim_AppendStrings(interp, Jim_GetResult(interp),
11512 "can't rename \"", oldName, "\": ",
11513 "command doesn't exist", NULL);
11514 return JIM_ERR;
11515 }
11516 return JIM_OK;
11517 }
11518
11519 /* [dict] */
11520 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11521 Jim_Obj *const *argv)
11522 {
11523 int option;
11524 const char *options[] = {
11525 "create", "get", "set", "unset", "exists", NULL
11526 };
11527 enum {
11528 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11529 };
11530
11531 if (argc < 2) {
11532 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11533 return JIM_ERR;
11534 }
11535
11536 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11537 JIM_ERRMSG) != JIM_OK)
11538 return JIM_ERR;
11539
11540 if (option == OPT_CREATE) {
11541 Jim_Obj *objPtr;
11542
11543 if (argc % 2) {
11544 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11545 return JIM_ERR;
11546 }
11547 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11548 Jim_SetResult(interp, objPtr);
11549 return JIM_OK;
11550 } else if (option == OPT_GET) {
11551 Jim_Obj *objPtr;
11552
11553 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11554 JIM_ERRMSG) != JIM_OK)
11555 return JIM_ERR;
11556 Jim_SetResult(interp, objPtr);
11557 return JIM_OK;
11558 } else if (option == OPT_SET) {
11559 if (argc < 5) {
11560 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11561 return JIM_ERR;
11562 }
11563 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11564 argv[argc-1]);
11565 } else if (option == OPT_UNSET) {
11566 if (argc < 4) {
11567 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11568 return JIM_ERR;
11569 }
11570 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11571 NULL);
11572 } else if (option == OPT_EXIST) {
11573 Jim_Obj *objPtr;
11574 int exists;
11575
11576 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11577 JIM_ERRMSG) == JIM_OK)
11578 exists = 1;
11579 else
11580 exists = 0;
11581 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11582 return JIM_OK;
11583 } else {
11584 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11585 Jim_AppendStrings(interp, Jim_GetResult(interp),
11586 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11587 " must be create, get, set", NULL);
11588 return JIM_ERR;
11589 }
11590 return JIM_OK;
11591 }
11592
11593 /* [load] */
11594 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11595 Jim_Obj *const *argv)
11596 {
11597 if (argc < 2) {
11598 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11599 return JIM_ERR;
11600 }
11601 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11602 }
11603
11604 /* [subst] */
11605 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11606 Jim_Obj *const *argv)
11607 {
11608 int i, flags = 0;
11609 Jim_Obj *objPtr;
11610
11611 if (argc < 2) {
11612 Jim_WrongNumArgs(interp, 1, argv,
11613 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11614 return JIM_ERR;
11615 }
11616 i = argc-2;
11617 while (i--) {
11618 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11619 "-nobackslashes"))
11620 flags |= JIM_SUBST_NOESC;
11621 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11622 "-novariables"))
11623 flags |= JIM_SUBST_NOVAR;
11624 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11625 "-nocommands"))
11626 flags |= JIM_SUBST_NOCMD;
11627 else {
11628 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11629 Jim_AppendStrings(interp, Jim_GetResult(interp),
11630 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11631 "\": must be -nobackslashes, -nocommands, or "
11632 "-novariables", NULL);
11633 return JIM_ERR;
11634 }
11635 }
11636 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11637 return JIM_ERR;
11638 Jim_SetResult(interp, objPtr);
11639 return JIM_OK;
11640 }
11641
11642 /* [info] */
11643 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11644 Jim_Obj *const *argv)
11645 {
11646 int cmd, result = JIM_OK;
11647 static const char *commands[] = {
11648 "body", "commands", "exists", "globals", "level", "locals",
11649 "vars", "version", "complete", "args", "hostname", NULL
11650 };
11651 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11652 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11653
11654 if (argc < 2) {
11655 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11656 return JIM_ERR;
11657 }
11658 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11659 != JIM_OK) {
11660 return JIM_ERR;
11661 }
11662
11663 if (cmd == INFO_COMMANDS) {
11664 if (argc != 2 && argc != 3) {
11665 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11666 return JIM_ERR;
11667 }
11668 if (argc == 3)
11669 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11670 else
11671 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11672 } else if (cmd == INFO_EXISTS) {
11673 Jim_Obj *exists;
11674 if (argc != 3) {
11675 Jim_WrongNumArgs(interp, 2, argv, "varName");
11676 return JIM_ERR;
11677 }
11678 exists = Jim_GetVariable(interp, argv[2], 0);
11679 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11680 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11681 int mode;
11682 switch (cmd) {
11683 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11684 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11685 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11686 default: mode = 0; /* avoid warning */; break;
11687 }
11688 if (argc != 2 && argc != 3) {
11689 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11690 return JIM_ERR;
11691 }
11692 if (argc == 3)
11693 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11694 else
11695 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11696 } else if (cmd == INFO_LEVEL) {
11697 Jim_Obj *objPtr;
11698 switch (argc) {
11699 case 2:
11700 Jim_SetResult(interp,
11701 Jim_NewIntObj(interp, interp->numLevels));
11702 break;
11703 case 3:
11704 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11705 return JIM_ERR;
11706 Jim_SetResult(interp, objPtr);
11707 break;
11708 default:
11709 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11710 return JIM_ERR;
11711 }
11712 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11713 Jim_Cmd *cmdPtr;
11714
11715 if (argc != 3) {
11716 Jim_WrongNumArgs(interp, 2, argv, "procname");
11717 return JIM_ERR;
11718 }
11719 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11720 return JIM_ERR;
11721 if (cmdPtr->cmdProc != NULL) {
11722 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11723 Jim_AppendStrings(interp, Jim_GetResult(interp),
11724 "command \"", Jim_GetString(argv[2], NULL),
11725 "\" is not a procedure", NULL);
11726 return JIM_ERR;
11727 }
11728 if (cmd == INFO_BODY)
11729 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11730 else
11731 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11732 } else if (cmd == INFO_VERSION) {
11733 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11734 sprintf(buf, "%d.%d",
11735 JIM_VERSION / 100, JIM_VERSION % 100);
11736 Jim_SetResultString(interp, buf, -1);
11737 } else if (cmd == INFO_COMPLETE) {
11738 const char *s;
11739 int len;
11740
11741 if (argc != 3) {
11742 Jim_WrongNumArgs(interp, 2, argv, "script");
11743 return JIM_ERR;
11744 }
11745 s = Jim_GetString(argv[2], &len);
11746 Jim_SetResult(interp,
11747 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11748 } else if (cmd == INFO_HOSTNAME) {
11749 /* Redirect to os.hostname if it exists */
11750 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11751 result = Jim_EvalObjVector(interp, 1, &command);
11752 }
11753 return result;
11754 }
11755
11756 /* [split] */
11757 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11758 Jim_Obj *const *argv)
11759 {
11760 const char *str, *splitChars, *noMatchStart;
11761 int splitLen, strLen, i;
11762 Jim_Obj *resObjPtr;
11763
11764 if (argc != 2 && argc != 3) {
11765 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11766 return JIM_ERR;
11767 }
11768 /* Init */
11769 if (argc == 2) {
11770 splitChars = " \n\t\r";
11771 splitLen = 4;
11772 } else {
11773 splitChars = Jim_GetString(argv[2], &splitLen);
11774 }
11775 str = Jim_GetString(argv[1], &strLen);
11776 if (!strLen) return JIM_OK;
11777 noMatchStart = str;
11778 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11779 /* Split */
11780 if (splitLen) {
11781 while (strLen) {
11782 for (i = 0; i < splitLen; i++) {
11783 if (*str == splitChars[i]) {
11784 Jim_Obj *objPtr;
11785
11786 objPtr = Jim_NewStringObj(interp, noMatchStart,
11787 (str-noMatchStart));
11788 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11789 noMatchStart = str + 1;
11790 break;
11791 }
11792 }
11793 str ++;
11794 strLen --;
11795 }
11796 Jim_ListAppendElement(interp, resObjPtr,
11797 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11798 } else {
11799 /* This handles the special case of splitchars eq {}. This
11800 * is trivial but we want to perform object sharing as Tcl does. */
11801 Jim_Obj *objCache[256];
11802 const unsigned char *u = (unsigned char*) str;
11803 memset(objCache, 0, sizeof(objCache));
11804 for (i = 0; i < strLen; i++) {
11805 int c = u[i];
11806
11807 if (objCache[c] == NULL)
11808 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11809 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11810 }
11811 }
11812 Jim_SetResult(interp, resObjPtr);
11813 return JIM_OK;
11814 }
11815
11816 /* [join] */
11817 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11818 Jim_Obj *const *argv)
11819 {
11820 const char *joinStr;
11821 int joinStrLen, i, listLen;
11822 Jim_Obj *resObjPtr;
11823
11824 if (argc != 2 && argc != 3) {
11825 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11826 return JIM_ERR;
11827 }
11828 /* Init */
11829 if (argc == 2) {
11830 joinStr = " ";
11831 joinStrLen = 1;
11832 } else {
11833 joinStr = Jim_GetString(argv[2], &joinStrLen);
11834 }
11835 Jim_ListLength(interp, argv[1], &listLen);
11836 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11837 /* Split */
11838 for (i = 0; i < listLen; i++) {
11839 Jim_Obj *objPtr=NULL;
11840
11841 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11842 Jim_AppendObj(interp, resObjPtr, objPtr);
11843 if (i + 1 != listLen) {
11844 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11845 }
11846 }
11847 Jim_SetResult(interp, resObjPtr);
11848 return JIM_OK;
11849 }
11850
11851 /* [format] */
11852 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11853 Jim_Obj *const *argv)
11854 {
11855 Jim_Obj *objPtr;
11856
11857 if (argc < 2) {
11858 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11859 return JIM_ERR;
11860 }
11861 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11862 if (objPtr == NULL)
11863 return JIM_ERR;
11864 Jim_SetResult(interp, objPtr);
11865 return JIM_OK;
11866 }
11867
11868 /* [scan] */
11869 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11870 Jim_Obj *const *argv)
11871 {
11872 Jim_Obj *listPtr, **outVec;
11873 int outc, i, count = 0;
11874
11875 if (argc < 3) {
11876 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11877 return JIM_ERR;
11878 }
11879 if (argv[2]->typePtr != &scanFmtStringObjType)
11880 SetScanFmtFromAny(interp, argv[2]);
11881 if (FormatGetError(argv[2]) != 0) {
11882 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11883 return JIM_ERR;
11884 }
11885 if (argc > 3) {
11886 int maxPos = FormatGetMaxPos(argv[2]);
11887 int arg_count = FormatGetCnvCount(argv[2]);
11888 if (maxPos > argc-3) {
11889 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11890 return JIM_ERR;
11891 } else if (arg_count != 0 && arg_count < argc-3) {
11892 Jim_SetResultString(interp, "variable is not assigned by any "
11893 "conversion specifiers", -1);
11894 return JIM_ERR;
11895 } else if (arg_count > argc-3) {
11896 Jim_SetResultString(interp, "different numbers of variable names and "
11897 "field specifiers", -1);
11898 return JIM_ERR;
11899 }
11900 }
11901 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11902 if (listPtr == 0)
11903 return JIM_ERR;
11904 if (argc > 3) {
11905 int len = 0;
11906 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11907 Jim_ListLength(interp, listPtr, &len);
11908 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11909 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11910 return JIM_OK;
11911 }
11912 JimListGetElements(interp, listPtr, &outc, &outVec);
11913 for (i = 0; i < outc; ++i) {
11914 if (Jim_Length(outVec[i]) > 0) {
11915 ++count;
11916 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11917 goto err;
11918 }
11919 }
11920 Jim_FreeNewObj(interp, listPtr);
11921 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11922 } else {
11923 if (listPtr == (Jim_Obj*)EOF) {
11924 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11925 return JIM_OK;
11926 }
11927 Jim_SetResult(interp, listPtr);
11928 }
11929 return JIM_OK;
11930 err:
11931 Jim_FreeNewObj(interp, listPtr);
11932 return JIM_ERR;
11933 }
11934
11935 /* [error] */
11936 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11937 Jim_Obj *const *argv)
11938 {
11939 if (argc != 2) {
11940 Jim_WrongNumArgs(interp, 1, argv, "message");
11941 return JIM_ERR;
11942 }
11943 Jim_SetResult(interp, argv[1]);
11944 return JIM_ERR;
11945 }
11946
11947 /* [lrange] */
11948 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11949 Jim_Obj *const *argv)
11950 {
11951 Jim_Obj *objPtr;
11952
11953 if (argc != 4) {
11954 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11955 return JIM_ERR;
11956 }
11957 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11958 return JIM_ERR;
11959 Jim_SetResult(interp, objPtr);
11960 return JIM_OK;
11961 }
11962
11963 /* [env] */
11964 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11965 Jim_Obj *const *argv)
11966 {
11967 const char *key;
11968 char *val;
11969
11970 if (argc == 1) {
11971
11972 #ifdef NEED_ENVIRON_EXTERN
11973 extern char **environ;
11974 #endif
11975
11976 int i;
11977 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11978
11979 for (i = 0; environ[i]; i++) {
11980 const char *equals = strchr(environ[i], '=');
11981 if (equals) {
11982 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11983 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11984 }
11985 }
11986
11987 Jim_SetResult(interp, listObjPtr);
11988 return JIM_OK;
11989 }
11990
11991 if (argc != 2) {
11992 Jim_WrongNumArgs(interp, 1, argv, "varName");
11993 return JIM_ERR;
11994 }
11995 key = Jim_GetString(argv[1], NULL);
11996 val = getenv(key);
11997 if (val == NULL) {
11998 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11999 Jim_AppendStrings(interp, Jim_GetResult(interp),
12000 "environment variable \"",
12001 key, "\" does not exist", NULL);
12002 return JIM_ERR;
12003 }
12004 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12005 return JIM_OK;
12006 }
12007
12008 /* [source] */
12009 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12010 Jim_Obj *const *argv)
12011 {
12012 int retval;
12013
12014 if (argc != 2) {
12015 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12016 return JIM_ERR;
12017 }
12018 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12019 if (retval == JIM_ERR) {
12020 return JIM_ERR_ADDSTACK;
12021 }
12022 if (retval == JIM_RETURN)
12023 return JIM_OK;
12024 return retval;
12025 }
12026
12027 /* [lreverse] */
12028 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12029 Jim_Obj *const *argv)
12030 {
12031 Jim_Obj *revObjPtr, **ele;
12032 int len;
12033
12034 if (argc != 2) {
12035 Jim_WrongNumArgs(interp, 1, argv, "list");
12036 return JIM_ERR;
12037 }
12038 JimListGetElements(interp, argv[1], &len, &ele);
12039 len--;
12040 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12041 while (len >= 0)
12042 ListAppendElement(revObjPtr, ele[len--]);
12043 Jim_SetResult(interp, revObjPtr);
12044 return JIM_OK;
12045 }
12046
12047 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12048 {
12049 jim_wide len;
12050
12051 if (step == 0) return -1;
12052 if (start == end) return 0;
12053 else if (step > 0 && start > end) return -1;
12054 else if (step < 0 && end > start) return -1;
12055 len = end-start;
12056 if (len < 0) len = -len; /* abs(len) */
12057 if (step < 0) step = -step; /* abs(step) */
12058 len = 1 + ((len-1)/step);
12059 /* We can truncate safely to INT_MAX, the range command
12060 * will always return an error for a such long range
12061 * because Tcl lists can't be so long. */
12062 if (len > INT_MAX) len = INT_MAX;
12063 return (int)((len < 0) ? -1 : len);
12064 }
12065
12066 /* [range] */
12067 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12068 Jim_Obj *const *argv)
12069 {
12070 jim_wide start = 0, end, step = 1;
12071 int len, i;
12072 Jim_Obj *objPtr;
12073
12074 if (argc < 2 || argc > 4) {
12075 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12076 return JIM_ERR;
12077 }
12078 if (argc == 2) {
12079 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12080 return JIM_ERR;
12081 } else {
12082 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12083 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12084 return JIM_ERR;
12085 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12086 return JIM_ERR;
12087 }
12088 if ((len = JimRangeLen(start, end, step)) == -1) {
12089 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12090 return JIM_ERR;
12091 }
12092 objPtr = Jim_NewListObj(interp, NULL, 0);
12093 for (i = 0; i < len; i++)
12094 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12095 Jim_SetResult(interp, objPtr);
12096 return JIM_OK;
12097 }
12098
12099 /* [rand] */
12100 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12101 Jim_Obj *const *argv)
12102 {
12103 jim_wide min = 0, max =0, len, maxMul;
12104
12105 if (argc < 1 || argc > 3) {
12106 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12107 return JIM_ERR;
12108 }
12109 if (argc == 1) {
12110 max = JIM_WIDE_MAX;
12111 } else if (argc == 2) {
12112 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12113 return JIM_ERR;
12114 } else if (argc == 3) {
12115 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12116 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12117 return JIM_ERR;
12118 }
12119 len = max-min;
12120 if (len < 0) {
12121 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12122 return JIM_ERR;
12123 }
12124 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12125 while (1) {
12126 jim_wide r;
12127
12128 JimRandomBytes(interp, &r, sizeof(jim_wide));
12129 if (r < 0 || r >= maxMul) continue;
12130 r = (len == 0) ? 0 : r%len;
12131 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12132 return JIM_OK;
12133 }
12134 }
12135
12136 /* [package] */
12137 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12138 Jim_Obj *const *argv)
12139 {
12140 int option;
12141 const char *options[] = {
12142 "require", "provide", NULL
12143 };
12144 enum {OPT_REQUIRE, OPT_PROVIDE};
12145
12146 if (argc < 2) {
12147 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12148 return JIM_ERR;
12149 }
12150 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12151 JIM_ERRMSG) != JIM_OK)
12152 return JIM_ERR;
12153
12154 if (option == OPT_REQUIRE) {
12155 int exact = 0;
12156 const char *ver;
12157
12158 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12159 exact = 1;
12160 argv++;
12161 argc--;
12162 }
12163 if (argc != 3 && argc != 4) {
12164 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12165 return JIM_ERR;
12166 }
12167 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12168 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12169 JIM_ERRMSG);
12170 if (ver == NULL)
12171 return JIM_ERR_ADDSTACK;
12172 Jim_SetResultString(interp, ver, -1);
12173 } else if (option == OPT_PROVIDE) {
12174 if (argc != 4) {
12175 Jim_WrongNumArgs(interp, 2, argv, "package version");
12176 return JIM_ERR;
12177 }
12178 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12179 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12180 }
12181 return JIM_OK;
12182 }
12183
12184 static struct {
12185 const char *name;
12186 Jim_CmdProc cmdProc;
12187 } Jim_CoreCommandsTable[] = {
12188 {"set", Jim_SetCoreCommand},
12189 {"unset", Jim_UnsetCoreCommand},
12190 {"puts", Jim_PutsCoreCommand},
12191 {"+", Jim_AddCoreCommand},
12192 {"*", Jim_MulCoreCommand},
12193 {"-", Jim_SubCoreCommand},
12194 {"/", Jim_DivCoreCommand},
12195 {"incr", Jim_IncrCoreCommand},
12196 {"while", Jim_WhileCoreCommand},
12197 {"for", Jim_ForCoreCommand},
12198 {"foreach", Jim_ForeachCoreCommand},
12199 {"lmap", Jim_LmapCoreCommand},
12200 {"if", Jim_IfCoreCommand},
12201 {"switch", Jim_SwitchCoreCommand},
12202 {"list", Jim_ListCoreCommand},
12203 {"lindex", Jim_LindexCoreCommand},
12204 {"lset", Jim_LsetCoreCommand},
12205 {"llength", Jim_LlengthCoreCommand},
12206 {"lappend", Jim_LappendCoreCommand},
12207 {"linsert", Jim_LinsertCoreCommand},
12208 {"lsort", Jim_LsortCoreCommand},
12209 {"append", Jim_AppendCoreCommand},
12210 {"debug", Jim_DebugCoreCommand},
12211 {"eval", Jim_EvalCoreCommand},
12212 {"uplevel", Jim_UplevelCoreCommand},
12213 {"expr", Jim_ExprCoreCommand},
12214 {"break", Jim_BreakCoreCommand},
12215 {"continue", Jim_ContinueCoreCommand},
12216 {"proc", Jim_ProcCoreCommand},
12217 {"concat", Jim_ConcatCoreCommand},
12218 {"return", Jim_ReturnCoreCommand},
12219 {"upvar", Jim_UpvarCoreCommand},
12220 {"global", Jim_GlobalCoreCommand},
12221 {"string", Jim_StringCoreCommand},
12222 {"time", Jim_TimeCoreCommand},
12223 {"exit", Jim_ExitCoreCommand},
12224 {"catch", Jim_CatchCoreCommand},
12225 {"ref", Jim_RefCoreCommand},
12226 {"getref", Jim_GetrefCoreCommand},
12227 {"setref", Jim_SetrefCoreCommand},
12228 {"finalize", Jim_FinalizeCoreCommand},
12229 {"collect", Jim_CollectCoreCommand},
12230 {"rename", Jim_RenameCoreCommand},
12231 {"dict", Jim_DictCoreCommand},
12232 {"load", Jim_LoadCoreCommand},
12233 {"subst", Jim_SubstCoreCommand},
12234 {"info", Jim_InfoCoreCommand},
12235 {"split", Jim_SplitCoreCommand},
12236 {"join", Jim_JoinCoreCommand},
12237 {"format", Jim_FormatCoreCommand},
12238 {"scan", Jim_ScanCoreCommand},
12239 {"error", Jim_ErrorCoreCommand},
12240 {"lrange", Jim_LrangeCoreCommand},
12241 {"env", Jim_EnvCoreCommand},
12242 {"source", Jim_SourceCoreCommand},
12243 {"lreverse", Jim_LreverseCoreCommand},
12244 {"range", Jim_RangeCoreCommand},
12245 {"rand", Jim_RandCoreCommand},
12246 {"package", Jim_PackageCoreCommand},
12247 {"tailcall", Jim_TailcallCoreCommand},
12248 {NULL, NULL},
12249 };
12250
12251 /* Some Jim core command is actually a procedure written in Jim itself. */
12252 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12253 {
12254 Jim_Eval(interp, (char*)
12255 "proc lambda {arglist args} {\n"
12256 " set name [ref {} function lambdaFinalizer]\n"
12257 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12258 " return $name\n"
12259 "}\n"
12260 "proc lambdaFinalizer {name val} {\n"
12261 " rename $name {}\n"
12262 "}\n"
12263 );
12264 }
12265
12266 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12267 {
12268 int i = 0;
12269
12270 while (Jim_CoreCommandsTable[i].name != NULL) {
12271 Jim_CreateCommand(interp,
12272 Jim_CoreCommandsTable[i].name,
12273 Jim_CoreCommandsTable[i].cmdProc,
12274 NULL, NULL);
12275 i++;
12276 }
12277 Jim_RegisterCoreProcedures(interp);
12278 }
12279
12280 /* -----------------------------------------------------------------------------
12281 * Interactive prompt
12282 * ---------------------------------------------------------------------------*/
12283 void Jim_PrintErrorMessage(Jim_Interp *interp)
12284 {
12285 int len, i;
12286
12287 if (*interp->errorFileName) {
12288 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12289 interp->errorFileName, interp->errorLine);
12290 }
12291 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12292 Jim_GetString(interp->result, NULL));
12293 Jim_ListLength(interp, interp->stackTrace, &len);
12294 for (i = len-3; i >= 0; i-= 3) {
12295 Jim_Obj *objPtr=NULL;
12296 const char *proc, *file, *line;
12297
12298 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12299 proc = Jim_GetString(objPtr, NULL);
12300 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12301 JIM_NONE);
12302 file = Jim_GetString(objPtr, NULL);
12303 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12304 JIM_NONE);
12305 line = Jim_GetString(objPtr, NULL);
12306 if (*proc) {
12307 Jim_fprintf(interp, interp->cookie_stderr,
12308 "in procedure '%s' ", proc);
12309 }
12310 if (*file) {
12311 Jim_fprintf(interp, interp->cookie_stderr,
12312 "called at file \"%s\", line %s",
12313 file, line);
12314 }
12315 if (*file || *proc) {
12316 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12317 }
12318 }
12319 }
12320
12321 int Jim_InteractivePrompt(Jim_Interp *interp)
12322 {
12323 int retcode = JIM_OK;
12324 Jim_Obj *scriptObjPtr;
12325
12326 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12327 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12328 JIM_VERSION / 100, JIM_VERSION % 100);
12329 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12330 while (1) {
12331 char buf[1024];
12332 const char *result;
12333 const char *retcodestr[] = {
12334 "ok", "error", "return", "break", "continue", "eval", "exit"
12335 };
12336 int reslen;
12337
12338 if (retcode != 0) {
12339 if (retcode >= 2 && retcode <= 6)
12340 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12341 else
12342 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12343 } else
12344 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12345 Jim_fflush(interp, interp->cookie_stdout);
12346 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12347 Jim_IncrRefCount(scriptObjPtr);
12348 while (1) {
12349 const char *str;
12350 char state;
12351 int len;
12352
12353 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12354 Jim_DecrRefCount(interp, scriptObjPtr);
12355 goto out;
12356 }
12357 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12358 str = Jim_GetString(scriptObjPtr, &len);
12359 if (Jim_ScriptIsComplete(str, len, &state))
12360 break;
12361 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12362 Jim_fflush(interp, interp->cookie_stdout);
12363 }
12364 retcode = Jim_EvalObj(interp, scriptObjPtr);
12365 Jim_DecrRefCount(interp, scriptObjPtr);
12366 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12367 if (retcode == JIM_ERR) {
12368 Jim_PrintErrorMessage(interp);
12369 } else if (retcode == JIM_EXIT) {
12370 exit(Jim_GetExitCode(interp));
12371 } else {
12372 if (reslen) {
12373 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12374 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12375 }
12376 }
12377 }
12378 out:
12379 return 0;
12380 }
12381
12382 /* -----------------------------------------------------------------------------
12383 * Jim's idea of STDIO..
12384 * ---------------------------------------------------------------------------*/
12385
12386 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12387 {
12388 int r;
12389
12390 va_list ap;
12391 va_start(ap,fmt);
12392 r = Jim_vfprintf(interp, cookie, fmt,ap);
12393 va_end(ap);
12394 return r;
12395 }
12396
12397 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12398 {
12399 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12400 errno = ENOTSUP;
12401 return -1;
12402 }
12403 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12404 }
12405
12406 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12407 {
12408 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12409 errno = ENOTSUP;
12410 return 0;
12411 }
12412 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12413 }
12414
12415 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12416 {
12417 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12418 errno = ENOTSUP;
12419 return 0;
12420 }
12421 return (*(interp->cb_fread))(ptr, size, n, cookie);
12422 }
12423
12424 int Jim_fflush(Jim_Interp *interp, void *cookie)
12425 {
12426 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12427 /* pretend all is well */
12428 return 0;
12429 }
12430 return (*(interp->cb_fflush))(cookie);
12431 }
12432
12433 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12434 {
12435 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12436 errno = ENOTSUP;
12437 return NULL;
12438 }
12439 return (*(interp->cb_fgets))(s, size, cookie);
12440 }
12441 Jim_Nvp *
12442 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12443 {
12444 while (p->name) {
12445 if (0 == strcmp(name, p->name)) {
12446 break;
12447 }
12448 p++;
12449 }
12450 return ((Jim_Nvp *)(p));
12451 }
12452
12453 Jim_Nvp *
12454 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12455 {
12456 while (p->name) {
12457 if (0 == strcasecmp(name, p->name)) {
12458 break;
12459 }
12460 p++;
12461 }
12462 return ((Jim_Nvp *)(p));
12463 }
12464
12465 int
12466 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12467 const Jim_Nvp *p,
12468 Jim_Obj *o,
12469 Jim_Nvp **result)
12470 {
12471 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12472 }
12473
12474
12475 int
12476 Jim_Nvp_name2value(Jim_Interp *interp,
12477 const Jim_Nvp *_p,
12478 const char *name,
12479 Jim_Nvp **result)
12480 {
12481 const Jim_Nvp *p;
12482
12483 p = Jim_Nvp_name2value_simple(_p, name);
12484
12485 /* result */
12486 if (result) {
12487 *result = (Jim_Nvp *)(p);
12488 }
12489
12490 /* found? */
12491 if (p->name) {
12492 return JIM_OK;
12493 } else {
12494 return JIM_ERR;
12495 }
12496 }
12497
12498 int
12499 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12500 {
12501 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12502 }
12503
12504 int
12505 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12506 {
12507 const Jim_Nvp *p;
12508
12509 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12510
12511 if (puthere) {
12512 *puthere = (Jim_Nvp *)(p);
12513 }
12514 /* found */
12515 if (p->name) {
12516 return JIM_OK;
12517 } else {
12518 return JIM_ERR;
12519 }
12520 }
12521
12522
12523 int
12524 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12525 {
12526 int e;;
12527 jim_wide w;
12528
12529 e = Jim_GetWide(interp, o, &w);
12530 if (e != JIM_OK) {
12531 return e;
12532 }
12533
12534 return Jim_Nvp_value2name(interp, p, w, result);
12535 }
12536
12537 Jim_Nvp *
12538 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12539 {
12540 while (p->name) {
12541 if (value == p->value) {
12542 break;
12543 }
12544 p++;
12545 }
12546 return ((Jim_Nvp *)(p));
12547 }
12548
12549
12550 int
12551 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12552 {
12553 const Jim_Nvp *p;
12554
12555 p = Jim_Nvp_value2name_simple(_p, value);
12556
12557 if (result) {
12558 *result = (Jim_Nvp *)(p);
12559 }
12560
12561 if (p->name) {
12562 return JIM_OK;
12563 } else {
12564 return JIM_ERR;
12565 }
12566 }
12567
12568
12569 int
12570 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12571 {
12572 memset(p, 0, sizeof(*p));
12573 p->interp = interp;
12574 p->argc = argc;
12575 p->argv = argv;
12576
12577 return JIM_OK;
12578 }
12579
12580 void
12581 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12582 {
12583 int x;
12584
12585 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12586 for (x = 0 ; x < p->argc ; x++) {
12587 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12588 "%2d) %s\n",
12589 x,
12590 Jim_GetString(p->argv[x], NULL));
12591 }
12592 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12593 }
12594
12595
12596 int
12597 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12598 {
12599 Jim_Obj *o;
12600
12601 o = NULL; // failure
12602 if (goi->argc) {
12603 // success
12604 o = goi->argv[0];
12605 goi->argc -= 1;
12606 goi->argv += 1;
12607 }
12608 if (puthere) {
12609 *puthere = o;
12610 }
12611 if (o != NULL) {
12612 return JIM_OK;
12613 } else {
12614 return JIM_ERR;
12615 }
12616 }
12617
12618 int
12619 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12620 {
12621 int r;
12622 Jim_Obj *o;
12623 const char *cp;
12624
12625
12626 r = Jim_GetOpt_Obj(goi, &o);
12627 if (r == JIM_OK) {
12628 cp = Jim_GetString(o, len);
12629 if (puthere) {
12630 /* remove const */
12631 *puthere = (char *)(cp);
12632 }
12633 }
12634 return r;
12635 }
12636
12637 int
12638 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12639 {
12640 int r;
12641 Jim_Obj *o;
12642 double _safe;
12643
12644 if (puthere == NULL) {
12645 puthere = &_safe;
12646 }
12647
12648 r = Jim_GetOpt_Obj(goi, &o);
12649 if (r == JIM_OK) {
12650 r = Jim_GetDouble(goi->interp, o, puthere);
12651 if (r != JIM_OK) {
12652 Jim_SetResult_sprintf(goi->interp,
12653 "not a number: %s",
12654 Jim_GetString(o, NULL));
12655 }
12656 }
12657 return r;
12658 }
12659
12660 int
12661 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12662 {
12663 int r;
12664 Jim_Obj *o;
12665 jim_wide _safe;
12666
12667 if (puthere == NULL) {
12668 puthere = &_safe;
12669 }
12670
12671 r = Jim_GetOpt_Obj(goi, &o);
12672 if (r == JIM_OK) {
12673 r = Jim_GetWide(goi->interp, o, puthere);
12674 }
12675 return r;
12676 }
12677
12678 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12679 const Jim_Nvp *nvp,
12680 Jim_Nvp **puthere)
12681 {
12682 Jim_Nvp *_safe;
12683 Jim_Obj *o;
12684 int e;
12685
12686 if (puthere == NULL) {
12687 puthere = &_safe;
12688 }
12689
12690 e = Jim_GetOpt_Obj(goi, &o);
12691 if (e == JIM_OK) {
12692 e = Jim_Nvp_name2value_obj(goi->interp,
12693 nvp,
12694 o,
12695 puthere);
12696 }
12697
12698 return e;
12699 }
12700
12701 void
12702 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12703 const Jim_Nvp *nvptable,
12704 int hadprefix)
12705 {
12706 if (hadprefix) {
12707 Jim_SetResult_NvpUnknown(goi->interp,
12708 goi->argv[-2],
12709 goi->argv[-1],
12710 nvptable);
12711 } else {
12712 Jim_SetResult_NvpUnknown(goi->interp,
12713 NULL,
12714 goi->argv[-1],
12715 nvptable);
12716 }
12717 }
12718
12719
12720 int
12721 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12722 const char * const * lookup,
12723 int *puthere)
12724 {
12725 int _safe;
12726 Jim_Obj *o;
12727 int e;
12728
12729 if (puthere == NULL) {
12730 puthere = &_safe;
12731 }
12732 e = Jim_GetOpt_Obj(goi, &o);
12733 if (e == JIM_OK) {
12734 e = Jim_GetEnum(goi->interp,
12735 o,
12736 lookup,
12737 puthere,
12738 "option",
12739 JIM_ERRMSG);
12740 }
12741 return e;
12742 }
12743
12744
12745
12746 int
12747 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12748 {
12749 va_list ap;
12750 char *buf;
12751
12752 va_start(ap,fmt);
12753 buf = jim_vasprintf(fmt, ap);
12754 va_end(ap);
12755 if (buf) {
12756 Jim_SetResultString(interp, buf, -1);
12757 jim_vasprintf_done(buf);
12758 }
12759 return JIM_OK;
12760 }
12761
12762
12763 void
12764 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12765 Jim_Obj *param_name,
12766 Jim_Obj *param_value,
12767 const Jim_Nvp *nvp)
12768 {
12769 if (param_name) {
12770 Jim_SetResult_sprintf(interp,
12771 "%s: Unknown: %s, try one of: ",
12772 Jim_GetString(param_name, NULL),
12773 Jim_GetString(param_value, NULL));
12774 } else {
12775 Jim_SetResult_sprintf(interp,
12776 "Unknown param: %s, try one of: ",
12777 Jim_GetString(param_value, NULL));
12778 }
12779 while (nvp->name) {
12780 const char *a;
12781 const char *b;
12782
12783 if ((nvp + 1)->name) {
12784 a = nvp->name;
12785 b = ", ";
12786 } else {
12787 a = "or ";
12788 b = nvp->name;
12789 }
12790 Jim_AppendStrings(interp,
12791 Jim_GetResult(interp),
12792 a, b, NULL);
12793 nvp++;
12794 }
12795 }
12796
12797
12798 static Jim_Obj *debug_string_obj;
12799
12800 const char *
12801 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12802 {
12803 int x;
12804
12805 if (debug_string_obj) {
12806 Jim_FreeObj(interp, debug_string_obj);
12807 }
12808
12809 debug_string_obj = Jim_NewEmptyStringObj(interp);
12810 for (x = 0 ; x < argc ; x++) {
12811 Jim_AppendStrings(interp,
12812 debug_string_obj,
12813 Jim_GetString(argv[x], NULL),
12814 " ",
12815 NULL);
12816 }
12817
12818 return Jim_GetString(debug_string_obj, NULL);
12819 }

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)