change all bool parsers to accept any value
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
14 *
15 * The FreeBSD license
16 *
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
19 * are met:
20 *
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
27 *
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 *
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
44 **/
45 #ifdef HAVE_CONFIG_H
46 #include "config.h"
47 #endif
48
49 #define __JIM_CORE__
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
51
52 #ifdef __ECOS
53 #include <pkgconf/jimtcl.h>
54 #include <stdio.h>
55 #include <stdlib.h>
56
57 typedef CYG_ADDRWORD intptr_t;
58
59 #include <string.h>
60 #include <stdarg.h>
61 #include <ctype.h>
62 #include <limits.h>
63 #include <assert.h>
64 #include <errno.h>
65 #include <time.h>
66 #endif
67 #ifndef JIM_ANSIC
68 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
69 #endif /* JIM_ANSIC */
70
71 #include <stdarg.h>
72 #include <limits.h>
73
74 /* Include the platform dependent libraries for
75 * dynamic loading of libraries. */
76 #ifdef JIM_DYNLIB
77 #if defined(_WIN32) || defined(WIN32)
78 #ifndef WIN32
79 #define WIN32 1
80 #endif
81 #ifndef STRICT
82 #define STRICT
83 #endif
84 #define WIN32_LEAN_AND_MEAN
85 #include <windows.h>
86 #if _MSC_VER >= 1000
87 #pragma warning(disable:4146)
88 #endif /* _MSC_VER */
89 #else
90 #include <dlfcn.h>
91 #endif /* WIN32 */
92 #endif /* JIM_DYNLIB */
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType *getJimVariablesHashTableType(void);
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf(const char *fmt, va_list ap)
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf(buf, sizeof(buf), fmt, ap);
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 int result;
137 result = vasprintf(&buf, fmt, ap);
138 if (result < 0) exit(-1);
139 #endif
140 return buf;
141 }
142
143 static void
144 jim_vasprintf_done(void *buf)
145 {
146 #ifndef HAVE_VASPRINTF
147 (void)(buf);
148 #else
149 free(buf);
150 #endif
151 }
152
153
154 /*
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
157 *
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
160 */
161 #ifdef HAVE_LONG_LONG_INT
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
164 {
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
170
171 /*
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
175 */
176 s = nptr;
177 do {
178 c = *s++;
179 } while (isspace(c));
180 if (c == '-') {
181 neg = 1;
182 c = *s++;
183 } else {
184 neg = 0;
185 if (c == '+')
186 c = *s++;
187 }
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
190 c = s[1];
191 s += 2;
192 base = 16;
193 }
194 if (base == 0)
195 base = c == '0' ? 8 : 10;
196
197 /*
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
211 *
212 * Set any if any `digits' consumed; make it negative to indicate
213 * overflow.
214 */
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
217 : LLONG_MAX;
218 cutlim = (int)(cutoff % qbase);
219 cutoff /= qbase;
220 for (acc = 0, any = 0;; c = *s++) {
221 if (!JimIsAscii(c))
222 break;
223 if (isdigit(c))
224 c -= '0';
225 else if (isalpha(c))
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
227 else
228 break;
229 if (c >= base)
230 break;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
232 any = -1;
233 else {
234 any = 1;
235 acc *= qbase;
236 acc += c;
237 }
238 }
239 if (any < 0) {
240 acc = neg ? LLONG_MIN : LLONG_MAX;
241 errno = ERANGE;
242 } else if (neg)
243 acc = -acc;
244 if (endptr != 0)
245 *endptr = (char *)(any ? s - 1 : nptr);
246 return (acc);
247 }
248 #endif
249
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
253 {
254 while (patternLen) {
255 switch (pattern[0]) {
256 case '*':
257 while (pattern[1] == '*') {
258 pattern++;
259 patternLen--;
260 }
261 if (patternLen == 1)
262 return 1; /* match */
263 while (stringLen) {
264 if (JimStringMatch(pattern + 1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
267 string++;
268 stringLen--;
269 }
270 return 0; /* no match */
271 break;
272 case '?':
273 if (stringLen == 0)
274 return 0; /* no match */
275 string++;
276 stringLen--;
277 break;
278 case '[':
279 {
280 int not, match;
281
282 pattern++;
283 patternLen--;
284 not = pattern[0] == '^';
285 if (not) {
286 pattern++;
287 patternLen--;
288 }
289 match = 0;
290 while (1) {
291 if (pattern[0] == '\\') {
292 pattern++;
293 patternLen--;
294 if (pattern[0] == string[0])
295 match = 1;
296 } else if (pattern[0] == ']') {
297 break;
298 } else if (patternLen == 0) {
299 pattern--;
300 patternLen++;
301 break;
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
305 int c = string[0];
306 if (start > end) {
307 int t = start;
308 start = end;
309 end = t;
310 }
311 if (nocase) {
312 start = tolower(start);
313 end = tolower(end);
314 c = tolower(c);
315 }
316 pattern += 2;
317 patternLen -= 2;
318 if (c >= start && c <= end)
319 match = 1;
320 } else {
321 if (!nocase) {
322 if (pattern[0] == string[0])
323 match = 1;
324 } else {
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
326 match = 1;
327 }
328 }
329 pattern++;
330 patternLen--;
331 }
332 if (not)
333 match = !match;
334 if (!match)
335 return 0; /* no match */
336 string++;
337 stringLen--;
338 break;
339 }
340 case '\\':
341 if (patternLen >= 2) {
342 pattern++;
343 patternLen--;
344 }
345 /* fall through */
346 default:
347 if (!nocase) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
350 } else {
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
353 }
354 string++;
355 stringLen--;
356 break;
357 }
358 pattern++;
359 patternLen--;
360 if (stringLen == 0) {
361 while (*pattern == '*') {
362 pattern++;
363 patternLen--;
364 }
365 break;
366 }
367 }
368 if (patternLen == 0 && stringLen == 0)
369 return 1;
370 return 0;
371 }
372
373 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
374 int nocase)
375 {
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
377
378 if (nocase == 0) {
379 while (l1 && l2) {
380 if (*u1 != *u2)
381 return (int)*u1-*u2;
382 u1++; u2++; l1--; l2--;
383 }
384 if (!l1 && !l2) return 0;
385 return l1-l2;
386 } else {
387 while (l1 && l2) {
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
391 }
392 if (!l1 && !l2) return 0;
393 return l1-l2;
394 }
395 }
396
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index < 0) index = 0;
406 s2 += index;
407 for (i = index; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 int Jim_WideToString(char *buf, jim_wide wideValue)
416 {
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
419 }
420
421 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
422 {
423 char *endptr;
424
425 #ifdef HAVE_LONG_LONG_INT
426 *widePtr = JimStrtoll(str, &endptr, base);
427 #else
428 *widePtr = strtol(str, &endptr, base);
429 #endif
430 if ((str[0] == '\0') || (str == endptr))
431 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace((int)*endptr))
435 return JIM_ERR;
436 endptr++;
437 }
438 }
439 return JIM_OK;
440 }
441
442 int Jim_StringToIndex(const char *str, int *intPtr)
443 {
444 char *endptr;
445
446 *intPtr = strtol(str, &endptr, 10);
447 if ((str[0] == '\0') || (str == endptr))
448 return JIM_ERR;
449 if (endptr[0] != '\0') {
450 while (*endptr) {
451 if (!isspace((int)*endptr))
452 return JIM_ERR;
453 endptr++;
454 }
455 }
456 return JIM_OK;
457 }
458
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
465
466 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
467
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
469 {
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
473 }
474
475 int Jim_DoubleToString(char *buf, double doubleValue)
476 {
477 char *s;
478 int len;
479
480 len = sprintf(buf, "%.17g", doubleValue);
481 s = buf;
482 while (*s) {
483 if (*s == '.') return len;
484 s++;
485 }
486 /* Add a final ".0" if it's a number. But not
487 * for NaN or InF */
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
491 s[0] = '.';
492 s[1] = '0';
493 s[2] = '\0';
494 return len + 2;
495 }
496 return len;
497 }
498
499 int Jim_StringToDouble(const char *str, double *doublePtr)
500 {
501 char *endptr;
502
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
505 return JIM_ERR;
506 return JIM_OK;
507 }
508
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
510 {
511 jim_wide i, res = 1;
512 if ((b == 0 && e != 0) || (e < 0)) return 0;
513 for (i = 0; i < e; i++) {res *= b;}
514 return res;
515 }
516
517 /* -----------------------------------------------------------------------------
518 * Special functions
519 * ---------------------------------------------------------------------------*/
520
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
525 {
526 va_list ap;
527
528 va_start(ap, fmt);
529 /*
530 * Send it here first.. Assuming STDIO still works
531 */
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
535 va_end(ap);
536
537 #ifdef HAVE_BACKTRACE
538 {
539 void *array[40];
540 int size, i;
541 char **strings;
542
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
549 }
550 #endif
551
552 /* This may actually crash... we do it last */
553 if (interp && interp->cookie_stderr) {
554 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
556 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
557 }
558 abort();
559 }
560
561 /* -----------------------------------------------------------------------------
562 * Memory allocation
563 * ---------------------------------------------------------------------------*/
564
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
568 #if 0
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
572 #endif
573
574 void *Jim_Alloc(int size)
575 {
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
577 if (size == 0)
578 size = 1;
579 void *p = malloc(size);
580 if (p == NULL)
581 Jim_Panic(NULL,"malloc: Out of memory");
582 return p;
583 }
584
585 void Jim_Free(void *ptr) {
586 free(ptr);
587 }
588
589 void *Jim_Realloc(void *ptr, int size)
590 {
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
592 if (size == 0)
593 size = 1;
594 void *p = realloc(ptr, size);
595 if (p == NULL)
596 Jim_Panic(NULL,"realloc: Out of memory");
597 return p;
598 }
599
600 char *Jim_StrDup(const char *s)
601 {
602 int l = strlen(s);
603 char *copy = Jim_Alloc(l + 1);
604
605 memcpy(copy, s, l + 1);
606 return copy;
607 }
608
609 char *Jim_StrDupLen(const char *s, int l)
610 {
611 char *copy = Jim_Alloc(l + 1);
612
613 memcpy(copy, s, l + 1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
615 return copy;
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
623 {
624 #if (defined WIN32) && !(defined JIM_ANSIC)
625 LARGE_INTEGER t, f;
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
629 #else /* !WIN32 */
630 clock_t clocks = clock();
631
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
633 #endif /* WIN32 */
634 }
635
636 /* -----------------------------------------------------------------------------
637 * Hash Tables
638 * ---------------------------------------------------------------------------*/
639
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
644
645 /* -------------------------- hash functions -------------------------------- */
646
647 /* Thomas Wang's 32 bit Mix Function */
648 unsigned int Jim_IntHashFunction(unsigned int key)
649 {
650 key += ~(key << 15);
651 key ^= (key >> 10);
652 key += (key << 3);
653 key ^= (key >> 6);
654 key += ~(key << 11);
655 key ^= (key >> 16);
656 return key;
657 }
658
659 /* Identity hash function for integer keys */
660 unsigned int Jim_IdentityHashFunction(unsigned int key)
661 {
662 return key;
663 }
664
665 /* Generic hash function (we are using to multiply by 9 and add the byte
666 * as Tcl) */
667 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
668 {
669 unsigned int h = 0;
670 while (len--)
671 h += (h << 3)+*buf++;
672 return h;
673 }
674
675 /* ----------------------------- API implementation ------------------------- */
676 /* reset an hashtable already initialized with ht_init().
677 * NOTE: This function should only called by ht_destroy(). */
678 static void JimResetHashTable(Jim_HashTable *ht)
679 {
680 ht->table = NULL;
681 ht->size = 0;
682 ht->sizemask = 0;
683 ht->used = 0;
684 ht->collisions = 0;
685 }
686
687 /* Initialize the hash table */
688 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
689 void *privDataPtr)
690 {
691 JimResetHashTable(ht);
692 ht->type = type;
693 ht->privdata = privDataPtr;
694 return JIM_OK;
695 }
696
697 /* Resize the table to the minimal size that contains all the elements,
698 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
699 int Jim_ResizeHashTable(Jim_HashTable *ht)
700 {
701 int minimal = ht->used;
702
703 if (minimal < JIM_HT_INITIAL_SIZE)
704 minimal = JIM_HT_INITIAL_SIZE;
705 return Jim_ExpandHashTable(ht, minimal);
706 }
707
708 /* Expand or create the hashtable */
709 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
710 {
711 Jim_HashTable n; /* the new hashtable */
712 unsigned int realsize = JimHashTableNextPower(size), i;
713
714 /* the size is invalid if it is smaller than the number of
715 * elements already inside the hashtable */
716 if (ht->used >= size)
717 return JIM_ERR;
718
719 Jim_InitHashTable(&n, ht->type, ht->privdata);
720 n.size = realsize;
721 n.sizemask = realsize-1;
722 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
723
724 /* Initialize all the pointers to NULL */
725 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
726
727 /* Copy all the elements from the old to the new table:
728 * note that if the old hash table is empty ht->size is zero,
729 * so Jim_ExpandHashTable just creates an hash table. */
730 n.used = ht->used;
731 for (i = 0; i < ht->size && ht->used > 0; i++) {
732 Jim_HashEntry *he, *nextHe;
733
734 if (ht->table[i] == NULL) continue;
735
736 /* For each hash entry on this slot... */
737 he = ht->table[i];
738 while (he) {
739 unsigned int h;
740
741 nextHe = he->next;
742 /* Get the new element index */
743 h = Jim_HashKey(ht, he->key) & n.sizemask;
744 he->next = n.table[h];
745 n.table[h] = he;
746 ht->used--;
747 /* Pass to the next element */
748 he = nextHe;
749 }
750 }
751 assert(ht->used == 0);
752 Jim_Free(ht->table);
753
754 /* Remap the new hashtable in the old */
755 *ht = n;
756 return JIM_OK;
757 }
758
759 /* Add an element to the target hash table */
760 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
761 {
762 int index;
763 Jim_HashEntry *entry;
764
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index = JimInsertHashEntry(ht, key)) == -1)
768 return JIM_ERR;
769
770 /* Allocates the memory and stores key */
771 entry = Jim_Alloc(sizeof(*entry));
772 entry->next = ht->table[index];
773 ht->table[index] = entry;
774
775 /* Set the hash entry fields. */
776 Jim_SetHashKey(ht, entry, key);
777 Jim_SetHashVal(ht, entry, val);
778 ht->used++;
779 return JIM_OK;
780 }
781
782 /* Add an element, discarding the old if the key already exists */
783 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
784 {
785 Jim_HashEntry *entry;
786
787 /* Try to add the element. If the key
788 * does not exists Jim_AddHashEntry will suceed. */
789 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
790 return JIM_OK;
791 /* It already exists, get the entry */
792 entry = Jim_FindHashEntry(ht, key);
793 /* Free the old value and set the new one */
794 Jim_FreeEntryVal(ht, entry);
795 Jim_SetHashVal(ht, entry, val);
796 return JIM_OK;
797 }
798
799 /* Search and remove an element */
800 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
801 {
802 unsigned int h;
803 Jim_HashEntry *he, *prevHe;
804
805 if (ht->size == 0)
806 return JIM_ERR;
807 h = Jim_HashKey(ht, key) & ht->sizemask;
808 he = ht->table[h];
809
810 prevHe = NULL;
811 while (he) {
812 if (Jim_CompareHashKeys(ht, key, he->key)) {
813 /* Unlink the element from the list */
814 if (prevHe)
815 prevHe->next = he->next;
816 else
817 ht->table[h] = he->next;
818 Jim_FreeEntryKey(ht, he);
819 Jim_FreeEntryVal(ht, he);
820 Jim_Free(he);
821 ht->used--;
822 return JIM_OK;
823 }
824 prevHe = he;
825 he = he->next;
826 }
827 return JIM_ERR; /* not found */
828 }
829
830 /* Destroy an entire hash table */
831 int Jim_FreeHashTable(Jim_HashTable *ht)
832 {
833 unsigned int i;
834
835 /* Free all the elements */
836 for (i = 0; i < ht->size && ht->used > 0; i++) {
837 Jim_HashEntry *he, *nextHe;
838
839 if ((he = ht->table[i]) == NULL) continue;
840 while (he) {
841 nextHe = he->next;
842 Jim_FreeEntryKey(ht, he);
843 Jim_FreeEntryVal(ht, he);
844 Jim_Free(he);
845 ht->used--;
846 he = nextHe;
847 }
848 }
849 /* Free the table and the allocated cache structure */
850 Jim_Free(ht->table);
851 /* Re-initialize the table */
852 JimResetHashTable(ht);
853 return JIM_OK; /* never fails */
854 }
855
856 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
857 {
858 Jim_HashEntry *he;
859 unsigned int h;
860
861 if (ht->size == 0) return NULL;
862 h = Jim_HashKey(ht, key) & ht->sizemask;
863 he = ht->table[h];
864 while (he) {
865 if (Jim_CompareHashKeys(ht, key, he->key))
866 return he;
867 he = he->next;
868 }
869 return NULL;
870 }
871
872 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
873 {
874 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
875
876 iter->ht = ht;
877 iter->index = -1;
878 iter->entry = NULL;
879 iter->nextEntry = NULL;
880 return iter;
881 }
882
883 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
884 {
885 while (1) {
886 if (iter->entry == NULL) {
887 iter->index++;
888 if (iter->index >=
889 (signed)iter->ht->size) break;
890 iter->entry = iter->ht->table[iter->index];
891 } else {
892 iter->entry = iter->nextEntry;
893 }
894 if (iter->entry) {
895 /* We need to save the 'next' here, the iterator user
896 * may delete the entry we are returning. */
897 iter->nextEntry = iter->entry->next;
898 return iter->entry;
899 }
900 }
901 return NULL;
902 }
903
904 /* ------------------------- private functions ------------------------------ */
905
906 /* Expand the hash table if needed */
907 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
908 {
909 /* If the hash table is empty expand it to the intial size,
910 * if the table is "full" dobule its size. */
911 if (ht->size == 0)
912 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
913 if (ht->size == ht->used)
914 return Jim_ExpandHashTable(ht, ht->size*2);
915 return JIM_OK;
916 }
917
918 /* Our hash table capability is a power of two */
919 static unsigned int JimHashTableNextPower(unsigned int size)
920 {
921 unsigned int i = JIM_HT_INITIAL_SIZE;
922
923 if (size >= 2147483648U)
924 return 2147483648U;
925 while (1) {
926 if (i >= size)
927 return i;
928 i *= 2;
929 }
930 }
931
932 /* Returns the index of a free slot that can be populated with
933 * an hash entry for the given 'key'.
934 * If the key already exists, -1 is returned. */
935 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
936 {
937 unsigned int h;
938 Jim_HashEntry *he;
939
940 /* Expand the hashtable if needed */
941 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
942 return -1;
943 /* Compute the key hash value */
944 h = Jim_HashKey(ht, key) & ht->sizemask;
945 /* Search if this slot does not already contain the given key */
946 he = ht->table[h];
947 while (he) {
948 if (Jim_CompareHashKeys(ht, key, he->key))
949 return -1;
950 he = he->next;
951 }
952 return h;
953 }
954
955 /* ----------------------- StringCopy Hash Table Type ------------------------*/
956
957 static unsigned int JimStringCopyHTHashFunction(const void *key)
958 {
959 return Jim_GenHashFunction(key, strlen(key));
960 }
961
962 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
963 {
964 int len = strlen(key);
965 char *copy = Jim_Alloc(len + 1);
966 JIM_NOTUSED(privdata);
967
968 memcpy(copy, key, len);
969 copy[len] = '\0';
970 return copy;
971 }
972
973 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
974 {
975 int len = strlen(val);
976 char *copy = Jim_Alloc(len + 1);
977 JIM_NOTUSED(privdata);
978
979 memcpy(copy, val, len);
980 copy[len] = '\0';
981 return copy;
982 }
983
984 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
985 const void *key2)
986 {
987 JIM_NOTUSED(privdata);
988
989 return strcmp(key1, key2) == 0;
990 }
991
992 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
993 {
994 JIM_NOTUSED(privdata);
995
996 Jim_Free((void*)key); /* ATTENTION: const cast */
997 }
998
999 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
1000 {
1001 JIM_NOTUSED(privdata);
1002
1003 Jim_Free((void*)val); /* ATTENTION: const cast */
1004 }
1005
1006 static Jim_HashTableType JimStringCopyHashTableType = {
1007 JimStringCopyHTHashFunction, /* hash function */
1008 JimStringCopyHTKeyDup, /* key dup */
1009 NULL, /* val dup */
1010 JimStringCopyHTKeyCompare, /* key compare */
1011 JimStringCopyHTKeyDestructor, /* key destructor */
1012 NULL /* val destructor */
1013 };
1014
1015 /* This is like StringCopy but does not auto-duplicate the key.
1016 * It's used for intepreter's shared strings. */
1017 static Jim_HashTableType JimSharedStringsHashTableType = {
1018 JimStringCopyHTHashFunction, /* hash function */
1019 NULL, /* key dup */
1020 NULL, /* val dup */
1021 JimStringCopyHTKeyCompare, /* key compare */
1022 JimStringCopyHTKeyDestructor, /* key destructor */
1023 NULL /* val destructor */
1024 };
1025
1026 /* This is like StringCopy but also automatically handle dynamic
1027 * allocated C strings as values. */
1028 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1029 JimStringCopyHTHashFunction, /* hash function */
1030 JimStringCopyHTKeyDup, /* key dup */
1031 JimStringKeyValCopyHTValDup, /* val dup */
1032 JimStringCopyHTKeyCompare, /* key compare */
1033 JimStringCopyHTKeyDestructor, /* key destructor */
1034 JimStringKeyValCopyHTValDestructor, /* val destructor */
1035 };
1036
1037 typedef struct AssocDataValue {
1038 Jim_InterpDeleteProc *delProc;
1039 void *data;
1040 } AssocDataValue;
1041
1042 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1043 {
1044 AssocDataValue *assocPtr = (AssocDataValue *)data;
1045 if (assocPtr->delProc != NULL)
1046 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1047 Jim_Free(data);
1048 }
1049
1050 static Jim_HashTableType JimAssocDataHashTableType = {
1051 JimStringCopyHTHashFunction, /* hash function */
1052 JimStringCopyHTKeyDup, /* key dup */
1053 NULL, /* val dup */
1054 JimStringCopyHTKeyCompare, /* key compare */
1055 JimStringCopyHTKeyDestructor, /* key destructor */
1056 JimAssocDataHashTableValueDestructor /* val destructor */
1057 };
1058
1059 /* -----------------------------------------------------------------------------
1060 * Stack - This is a simple generic stack implementation. It is used for
1061 * example in the 'expr' expression compiler.
1062 * ---------------------------------------------------------------------------*/
1063 void Jim_InitStack(Jim_Stack *stack)
1064 {
1065 stack->len = 0;
1066 stack->maxlen = 0;
1067 stack->vector = NULL;
1068 }
1069
1070 void Jim_FreeStack(Jim_Stack *stack)
1071 {
1072 Jim_Free(stack->vector);
1073 }
1074
1075 int Jim_StackLen(Jim_Stack *stack)
1076 {
1077 return stack->len;
1078 }
1079
1080 void Jim_StackPush(Jim_Stack *stack, void *element) {
1081 int neededLen = stack->len + 1;
1082 if (neededLen > stack->maxlen) {
1083 stack->maxlen = neededLen*2;
1084 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1085 }
1086 stack->vector[stack->len] = element;
1087 stack->len++;
1088 }
1089
1090 void *Jim_StackPop(Jim_Stack *stack)
1091 {
1092 if (stack->len == 0) return NULL;
1093 stack->len--;
1094 return stack->vector[stack->len];
1095 }
1096
1097 void *Jim_StackPeek(Jim_Stack *stack)
1098 {
1099 if (stack->len == 0) return NULL;
1100 return stack->vector[stack->len-1];
1101 }
1102
1103 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1104 {
1105 int i;
1106
1107 for (i = 0; i < stack->len; i++)
1108 freeFunc(stack->vector[i]);
1109 }
1110
1111 /* -----------------------------------------------------------------------------
1112 * Parser
1113 * ---------------------------------------------------------------------------*/
1114
1115 /* Token types */
1116 #define JIM_TT_NONE -1 /* No token returned */
1117 #define JIM_TT_STR 0 /* simple string */
1118 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1119 #define JIM_TT_VAR 2 /* var substitution */
1120 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1121 #define JIM_TT_CMD 4 /* command substitution */
1122 #define JIM_TT_SEP 5 /* word separator */
1123 #define JIM_TT_EOL 6 /* line separator */
1124
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 7
1127 #define JIM_TT_SUBEXPR_END 8
1128 #define JIM_TT_EXPR_NUMBER 9
1129 #define JIM_TT_EXPR_OPERATOR 10
1130
1131 /* Parser states */
1132 #define JIM_PS_DEF 0 /* Default state */
1133 #define JIM_PS_QUOTE 1 /* Inside "" */
1134
1135 /* Parser context structure. The same context is used both to parse
1136 * Tcl scripts and lists. */
1137 struct JimParserCtx {
1138 const char *prg; /* Program text */
1139 const char *p; /* Pointer to the point of the program we are parsing */
1140 int len; /* Left length of 'prg' */
1141 int linenr; /* Current line number */
1142 const char *tstart;
1143 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1144 int tline; /* Line number of the returned token */
1145 int tt; /* Token type */
1146 int eof; /* Non zero if EOF condition is true. */
1147 int state; /* Parser state */
1148 int comment; /* Non zero if the next chars may be a comment. */
1149 };
1150
1151 #define JimParserEof(c) ((c)->eof)
1152 #define JimParserTstart(c) ((c)->tstart)
1153 #define JimParserTend(c) ((c)->tend)
1154 #define JimParserTtype(c) ((c)->tt)
1155 #define JimParserTline(c) ((c)->tline)
1156
1157 static int JimParseScript(struct JimParserCtx *pc);
1158 static int JimParseSep(struct JimParserCtx *pc);
1159 static int JimParseEol(struct JimParserCtx *pc);
1160 static int JimParseCmd(struct JimParserCtx *pc);
1161 static int JimParseVar(struct JimParserCtx *pc);
1162 static int JimParseBrace(struct JimParserCtx *pc);
1163 static int JimParseStr(struct JimParserCtx *pc);
1164 static int JimParseComment(struct JimParserCtx *pc);
1165 static char *JimParserGetToken(struct JimParserCtx *pc,
1166 int *lenPtr, int *typePtr, int *linePtr);
1167
1168 /* Initialize a parser context.
1169 * 'prg' is a pointer to the program text, linenr is the line
1170 * number of the first line contained in the program. */
1171 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1172 int len, int linenr)
1173 {
1174 pc->prg = prg;
1175 pc->p = prg;
1176 pc->len = len;
1177 pc->tstart = NULL;
1178 pc->tend = NULL;
1179 pc->tline = 0;
1180 pc->tt = JIM_TT_NONE;
1181 pc->eof = 0;
1182 pc->state = JIM_PS_DEF;
1183 pc->linenr = linenr;
1184 pc->comment = 1;
1185 }
1186
1187 int JimParseScript(struct JimParserCtx *pc)
1188 {
1189 while (1) { /* the while is used to reiterate with continue if needed */
1190 if (!pc->len) {
1191 pc->tstart = pc->p;
1192 pc->tend = pc->p-1;
1193 pc->tline = pc->linenr;
1194 pc->tt = JIM_TT_EOL;
1195 pc->eof = 1;
1196 return JIM_OK;
1197 }
1198 switch (*(pc->p)) {
1199 case '\\':
1200 if (*(pc->p + 1) == '\n')
1201 return JimParseSep(pc);
1202 else {
1203 pc->comment = 0;
1204 return JimParseStr(pc);
1205 }
1206 break;
1207 case ' ':
1208 case '\t':
1209 case '\r':
1210 if (pc->state == JIM_PS_DEF)
1211 return JimParseSep(pc);
1212 else {
1213 pc->comment = 0;
1214 return JimParseStr(pc);
1215 }
1216 break;
1217 case '\n':
1218 case ';':
1219 pc->comment = 1;
1220 if (pc->state == JIM_PS_DEF)
1221 return JimParseEol(pc);
1222 else
1223 return JimParseStr(pc);
1224 break;
1225 case '[':
1226 pc->comment = 0;
1227 return JimParseCmd(pc);
1228 break;
1229 case '$':
1230 pc->comment = 0;
1231 if (JimParseVar(pc) == JIM_ERR) {
1232 pc->tstart = pc->tend = pc->p++; pc->len--;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_STR;
1235 return JIM_OK;
1236 } else
1237 return JIM_OK;
1238 break;
1239 case '#':
1240 if (pc->comment) {
1241 JimParseComment(pc);
1242 continue;
1243 } else {
1244 return JimParseStr(pc);
1245 }
1246 default:
1247 pc->comment = 0;
1248 return JimParseStr(pc);
1249 break;
1250 }
1251 return JIM_OK;
1252 }
1253 }
1254
1255 int JimParseSep(struct JimParserCtx *pc)
1256 {
1257 pc->tstart = pc->p;
1258 pc->tline = pc->linenr;
1259 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1260 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1261 if (*pc->p == '\\') {
1262 pc->p++; pc->len--;
1263 pc->linenr++;
1264 }
1265 pc->p++; pc->len--;
1266 }
1267 pc->tend = pc->p-1;
1268 pc->tt = JIM_TT_SEP;
1269 return JIM_OK;
1270 }
1271
1272 int JimParseEol(struct JimParserCtx *pc)
1273 {
1274 pc->tstart = pc->p;
1275 pc->tline = pc->linenr;
1276 while (*pc->p == ' ' || *pc->p == '\n' ||
1277 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1278 if (*pc->p == '\n')
1279 pc->linenr++;
1280 pc->p++; pc->len--;
1281 }
1282 pc->tend = pc->p-1;
1283 pc->tt = JIM_TT_EOL;
1284 return JIM_OK;
1285 }
1286
1287 /* Todo. Don't stop if ']' appears inside {} or quoted.
1288 * Also should handle the case of puts [string length "]"] */
1289 int JimParseCmd(struct JimParserCtx *pc)
1290 {
1291 int level = 1;
1292 int blevel = 0;
1293
1294 pc->tstart = ++pc->p; pc->len--;
1295 pc->tline = pc->linenr;
1296 while (1) {
1297 if (pc->len == 0) {
1298 break;
1299 } else if (*pc->p == '[' && blevel == 0) {
1300 level++;
1301 } else if (*pc->p == ']' && blevel == 0) {
1302 level--;
1303 if (!level) break;
1304 } else if (*pc->p == '\\') {
1305 pc->p++; pc->len--;
1306 } else if (*pc->p == '{') {
1307 blevel++;
1308 } else if (*pc->p == '}') {
1309 if (blevel != 0)
1310 blevel--;
1311 } else if (*pc->p == '\n')
1312 pc->linenr++;
1313 pc->p++; pc->len--;
1314 }
1315 pc->tend = pc->p-1;
1316 pc->tt = JIM_TT_CMD;
1317 if (*pc->p == ']') {
1318 pc->p++; pc->len--;
1319 }
1320 return JIM_OK;
1321 }
1322
1323 int JimParseVar(struct JimParserCtx *pc)
1324 {
1325 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1326
1327 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1328 pc->tline = pc->linenr;
1329 if (*pc->p == '{') {
1330 pc->tstart = ++pc->p; pc->len--;
1331 brace = 1;
1332 }
1333 if (brace) {
1334 while (!stop) {
1335 if (*pc->p == '}' || pc->len == 0) {
1336 pc->tend = pc->p-1;
1337 stop = 1;
1338 if (pc->len == 0)
1339 break;
1340 }
1341 else if (*pc->p == '\n')
1342 pc->linenr++;
1343 pc->p++; pc->len--;
1344 }
1345 } else {
1346 /* Include leading colons */
1347 while (*pc->p == ':') {
1348 pc->p++;
1349 pc->len--;
1350 }
1351 while (!stop) {
1352 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1353 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1354 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1355 stop = 1;
1356 else {
1357 pc->p++; pc->len--;
1358 }
1359 }
1360 /* Parse [dict get] syntax sugar. */
1361 if (*pc->p == '(') {
1362 while (*pc->p != ')' && pc->len) {
1363 pc->p++; pc->len--;
1364 if (*pc->p == '\\' && pc->len >= 2) {
1365 pc->p += 2; pc->len -= 2;
1366 }
1367 }
1368 if (*pc->p != '\0') {
1369 pc->p++; pc->len--;
1370 }
1371 ttype = JIM_TT_DICTSUGAR;
1372 }
1373 pc->tend = pc->p-1;
1374 }
1375 /* Check if we parsed just the '$' character.
1376 * That's not a variable so an error is returned
1377 * to tell the state machine to consider this '$' just
1378 * a string. */
1379 if (pc->tstart == pc->p) {
1380 pc->p--; pc->len++;
1381 return JIM_ERR;
1382 }
1383 pc->tt = ttype;
1384 return JIM_OK;
1385 }
1386
1387 int JimParseBrace(struct JimParserCtx *pc)
1388 {
1389 int level = 1;
1390
1391 pc->tstart = ++pc->p; pc->len--;
1392 pc->tline = pc->linenr;
1393 while (1) {
1394 if (*pc->p == '\\' && pc->len >= 2) {
1395 pc->p++; pc->len--;
1396 if (*pc->p == '\n')
1397 pc->linenr++;
1398 } else if (*pc->p == '{') {
1399 level++;
1400 } else if (pc->len == 0 || *pc->p == '}') {
1401 level--;
1402 if (pc->len == 0 || level == 0) {
1403 pc->tend = pc->p-1;
1404 if (pc->len != 0) {
1405 pc->p++; pc->len--;
1406 }
1407 pc->tt = JIM_TT_STR;
1408 return JIM_OK;
1409 }
1410 } else if (*pc->p == '\n') {
1411 pc->linenr++;
1412 }
1413 pc->p++; pc->len--;
1414 }
1415 return JIM_OK; /* unreached */
1416 }
1417
1418 int JimParseStr(struct JimParserCtx *pc)
1419 {
1420 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1421 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1422 if (newword && *pc->p == '{') {
1423 return JimParseBrace(pc);
1424 } else if (newword && *pc->p == '"') {
1425 pc->state = JIM_PS_QUOTE;
1426 pc->p++; pc->len--;
1427 }
1428 pc->tstart = pc->p;
1429 pc->tline = pc->linenr;
1430 while (1) {
1431 if (pc->len == 0) {
1432 pc->tend = pc->p-1;
1433 pc->tt = JIM_TT_ESC;
1434 return JIM_OK;
1435 }
1436 switch (*pc->p) {
1437 case '\\':
1438 if (pc->state == JIM_PS_DEF &&
1439 *(pc->p + 1) == '\n') {
1440 pc->tend = pc->p-1;
1441 pc->tt = JIM_TT_ESC;
1442 return JIM_OK;
1443 }
1444 if (pc->len >= 2) {
1445 pc->p++; pc->len--;
1446 }
1447 break;
1448 case '$':
1449 case '[':
1450 pc->tend = pc->p-1;
1451 pc->tt = JIM_TT_ESC;
1452 return JIM_OK;
1453 case ' ':
1454 case '\t':
1455 case '\n':
1456 case '\r':
1457 case ';':
1458 if (pc->state == JIM_PS_DEF) {
1459 pc->tend = pc->p-1;
1460 pc->tt = JIM_TT_ESC;
1461 return JIM_OK;
1462 } else if (*pc->p == '\n') {
1463 pc->linenr++;
1464 }
1465 break;
1466 case '"':
1467 if (pc->state == JIM_PS_QUOTE) {
1468 pc->tend = pc->p-1;
1469 pc->tt = JIM_TT_ESC;
1470 pc->p++; pc->len--;
1471 pc->state = JIM_PS_DEF;
1472 return JIM_OK;
1473 }
1474 break;
1475 }
1476 pc->p++; pc->len--;
1477 }
1478 return JIM_OK; /* unreached */
1479 }
1480
1481 int JimParseComment(struct JimParserCtx *pc)
1482 {
1483 while (*pc->p) {
1484 if (*pc->p == '\n') {
1485 pc->linenr++;
1486 if (*(pc->p-1) != '\\') {
1487 pc->p++; pc->len--;
1488 return JIM_OK;
1489 }
1490 }
1491 pc->p++; pc->len--;
1492 }
1493 return JIM_OK;
1494 }
1495
1496 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1497 static int xdigitval(int c)
1498 {
1499 if (c >= '0' && c <= '9') return c-'0';
1500 if (c >= 'a' && c <= 'f') return c-'a'+10;
1501 if (c >= 'A' && c <= 'F') return c-'A'+10;
1502 return -1;
1503 }
1504
1505 static int odigitval(int c)
1506 {
1507 if (c >= '0' && c <= '7') return c-'0';
1508 return -1;
1509 }
1510
1511 /* Perform Tcl escape substitution of 's', storing the result
1512 * string into 'dest'. The escaped string is guaranteed to
1513 * be the same length or shorted than the source string.
1514 * Slen is the length of the string at 's', if it's -1 the string
1515 * length will be calculated by the function.
1516 *
1517 * The function returns the length of the resulting string. */
1518 static int JimEscape(char *dest, const char *s, int slen)
1519 {
1520 char *p = dest;
1521 int i, len;
1522
1523 if (slen == -1)
1524 slen = strlen(s);
1525
1526 for (i = 0; i < slen; i++) {
1527 switch (s[i]) {
1528 case '\\':
1529 switch (s[i + 1]) {
1530 case 'a': *p++ = 0x7; i++; break;
1531 case 'b': *p++ = 0x8; i++; break;
1532 case 'f': *p++ = 0xc; i++; break;
1533 case 'n': *p++ = 0xa; i++; break;
1534 case 'r': *p++ = 0xd; i++; break;
1535 case 't': *p++ = 0x9; i++; break;
1536 case 'v': *p++ = 0xb; i++; break;
1537 case '\0': *p++ = '\\'; i++; break;
1538 case '\n': *p++ = ' '; i++; break;
1539 default:
1540 if (s[i + 1] == 'x') {
1541 int val = 0;
1542 int c = xdigitval(s[i + 2]);
1543 if (c == -1) {
1544 *p++ = 'x';
1545 i++;
1546 break;
1547 }
1548 val = c;
1549 c = xdigitval(s[i + 3]);
1550 if (c == -1) {
1551 *p++ = val;
1552 i += 2;
1553 break;
1554 }
1555 val = (val*16) + c;
1556 *p++ = val;
1557 i += 3;
1558 break;
1559 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1560 {
1561 int val = 0;
1562 int c = odigitval(s[i + 1]);
1563 val = c;
1564 c = odigitval(s[i + 2]);
1565 if (c == -1) {
1566 *p++ = val;
1567 i ++;
1568 break;
1569 }
1570 val = (val*8) + c;
1571 c = odigitval(s[i + 3]);
1572 if (c == -1) {
1573 *p++ = val;
1574 i += 2;
1575 break;
1576 }
1577 val = (val*8) + c;
1578 *p++ = val;
1579 i += 3;
1580 } else {
1581 *p++ = s[i + 1];
1582 i++;
1583 }
1584 break;
1585 }
1586 break;
1587 default:
1588 *p++ = s[i];
1589 break;
1590 }
1591 }
1592 len = p-dest;
1593 *p++ = '\0';
1594 return len;
1595 }
1596
1597 /* Returns a dynamically allocated copy of the current token in the
1598 * parser context. The function perform conversion of escapes if
1599 * the token is of type JIM_TT_ESC.
1600 *
1601 * Note that after the conversion, tokens that are grouped with
1602 * braces in the source code, are always recognizable from the
1603 * identical string obtained in a different way from the type.
1604 *
1605 * For exmple the string:
1606 *
1607 * {expand}$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_STR
1610 *
1611 * While the string:
1612 *
1613 * expand$a
1614 *
1615 * will return as first token "expand", of type JIM_TT_ESC
1616 */
1617 char *JimParserGetToken(struct JimParserCtx *pc,
1618 int *lenPtr, int *typePtr, int *linePtr)
1619 {
1620 const char *start, *end;
1621 char *token;
1622 int len;
1623
1624 start = JimParserTstart(pc);
1625 end = JimParserTend(pc);
1626 if (start > end) {
1627 if (lenPtr) *lenPtr = 0;
1628 if (typePtr) *typePtr = JimParserTtype(pc);
1629 if (linePtr) *linePtr = JimParserTline(pc);
1630 token = Jim_Alloc(1);
1631 token[0] = '\0';
1632 return token;
1633 }
1634 len = (end-start) + 1;
1635 token = Jim_Alloc(len + 1);
1636 if (JimParserTtype(pc) != JIM_TT_ESC) {
1637 /* No escape conversion needed? Just copy it. */
1638 memcpy(token, start, len);
1639 token[len] = '\0';
1640 } else {
1641 /* Else convert the escape chars. */
1642 len = JimEscape(token, start, len);
1643 }
1644 if (lenPtr) *lenPtr = len;
1645 if (typePtr) *typePtr = JimParserTtype(pc);
1646 if (linePtr) *linePtr = JimParserTline(pc);
1647 return token;
1648 }
1649
1650 /* The following functin is not really part of the parsing engine of Jim,
1651 * but it somewhat related. Given an string and its length, it tries
1652 * to guess if the script is complete or there are instead " " or { }
1653 * open and not completed. This is useful for interactive shells
1654 * implementation and for [info complete].
1655 *
1656 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1657 * '{' on scripts incomplete missing one or more '}' to be balanced.
1658 * '"' on scripts incomplete missing a '"' char.
1659 *
1660 * If the script is complete, 1 is returned, otherwise 0. */
1661 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1662 {
1663 int level = 0;
1664 int state = ' ';
1665
1666 while (len) {
1667 switch (*s) {
1668 case '\\':
1669 if (len > 1)
1670 s++;
1671 break;
1672 case '"':
1673 if (state == ' ') {
1674 state = '"';
1675 } else if (state == '"') {
1676 state = ' ';
1677 }
1678 break;
1679 case '{':
1680 if (state == '{') {
1681 level++;
1682 } else if (state == ' ') {
1683 state = '{';
1684 level++;
1685 }
1686 break;
1687 case '}':
1688 if (state == '{') {
1689 level--;
1690 if (level == 0)
1691 state = ' ';
1692 }
1693 break;
1694 }
1695 s++;
1696 len--;
1697 }
1698 if (stateCharPtr)
1699 *stateCharPtr = state;
1700 return state == ' ';
1701 }
1702
1703 /* -----------------------------------------------------------------------------
1704 * Tcl Lists parsing
1705 * ---------------------------------------------------------------------------*/
1706 static int JimParseListSep(struct JimParserCtx *pc);
1707 static int JimParseListStr(struct JimParserCtx *pc);
1708
1709 int JimParseList(struct JimParserCtx *pc)
1710 {
1711 if (pc->len == 0) {
1712 pc->tstart = pc->tend = pc->p;
1713 pc->tline = pc->linenr;
1714 pc->tt = JIM_TT_EOL;
1715 pc->eof = 1;
1716 return JIM_OK;
1717 }
1718 switch (*pc->p) {
1719 case ' ':
1720 case '\n':
1721 case '\t':
1722 case '\r':
1723 if (pc->state == JIM_PS_DEF)
1724 return JimParseListSep(pc);
1725 else
1726 return JimParseListStr(pc);
1727 break;
1728 default:
1729 return JimParseListStr(pc);
1730 break;
1731 }
1732 return JIM_OK;
1733 }
1734
1735 int JimParseListSep(struct JimParserCtx *pc)
1736 {
1737 pc->tstart = pc->p;
1738 pc->tline = pc->linenr;
1739 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1740 {
1741 pc->p++; pc->len--;
1742 }
1743 pc->tend = pc->p-1;
1744 pc->tt = JIM_TT_SEP;
1745 return JIM_OK;
1746 }
1747
1748 int JimParseListStr(struct JimParserCtx *pc)
1749 {
1750 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1751 pc->tt == JIM_TT_NONE);
1752 if (newword && *pc->p == '{') {
1753 return JimParseBrace(pc);
1754 } else if (newword && *pc->p == '"') {
1755 pc->state = JIM_PS_QUOTE;
1756 pc->p++; pc->len--;
1757 }
1758 pc->tstart = pc->p;
1759 pc->tline = pc->linenr;
1760 while (1) {
1761 if (pc->len == 0) {
1762 pc->tend = pc->p-1;
1763 pc->tt = JIM_TT_ESC;
1764 return JIM_OK;
1765 }
1766 switch (*pc->p) {
1767 case '\\':
1768 pc->p++; pc->len--;
1769 break;
1770 case ' ':
1771 case '\t':
1772 case '\n':
1773 case '\r':
1774 if (pc->state == JIM_PS_DEF) {
1775 pc->tend = pc->p-1;
1776 pc->tt = JIM_TT_ESC;
1777 return JIM_OK;
1778 } else if (*pc->p == '\n') {
1779 pc->linenr++;
1780 }
1781 break;
1782 case '"':
1783 if (pc->state == JIM_PS_QUOTE) {
1784 pc->tend = pc->p-1;
1785 pc->tt = JIM_TT_ESC;
1786 pc->p++; pc->len--;
1787 pc->state = JIM_PS_DEF;
1788 return JIM_OK;
1789 }
1790 break;
1791 }
1792 pc->p++; pc->len--;
1793 }
1794 return JIM_OK; /* unreached */
1795 }
1796
1797 /* -----------------------------------------------------------------------------
1798 * Jim_Obj related functions
1799 * ---------------------------------------------------------------------------*/
1800
1801 /* Return a new initialized object. */
1802 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1803 {
1804 Jim_Obj *objPtr;
1805
1806 /* -- Check if there are objects in the free list -- */
1807 if (interp->freeList != NULL) {
1808 /* -- Unlink the object from the free list -- */
1809 objPtr = interp->freeList;
1810 interp->freeList = objPtr->nextObjPtr;
1811 } else {
1812 /* -- No ready to use objects: allocate a new one -- */
1813 objPtr = Jim_Alloc(sizeof(*objPtr));
1814 }
1815
1816 /* Object is returned with refCount of 0. Every
1817 * kind of GC implemented should take care to don't try
1818 * to scan objects with refCount == 0. */
1819 objPtr->refCount = 0;
1820 /* All the other fields are left not initialized to save time.
1821 * The caller will probably want set they to the right
1822 * value anyway. */
1823
1824 /* -- Put the object into the live list -- */
1825 objPtr->prevObjPtr = NULL;
1826 objPtr->nextObjPtr = interp->liveList;
1827 if (interp->liveList)
1828 interp->liveList->prevObjPtr = objPtr;
1829 interp->liveList = objPtr;
1830
1831 return objPtr;
1832 }
1833
1834 /* Free an object. Actually objects are never freed, but
1835 * just moved to the free objects list, where they will be
1836 * reused by Jim_NewObj(). */
1837 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1838 {
1839 /* Check if the object was already freed, panic. */
1840 if (objPtr->refCount != 0) {
1841 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1842 objPtr->refCount);
1843 }
1844 /* Free the internal representation */
1845 Jim_FreeIntRep(interp, objPtr);
1846 /* Free the string representation */
1847 if (objPtr->bytes != NULL) {
1848 if (objPtr->bytes != JimEmptyStringRep)
1849 Jim_Free(objPtr->bytes);
1850 }
1851 /* Unlink the object from the live objects list */
1852 if (objPtr->prevObjPtr)
1853 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1854 if (objPtr->nextObjPtr)
1855 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1856 if (interp->liveList == objPtr)
1857 interp->liveList = objPtr->nextObjPtr;
1858 /* Link the object into the free objects list */
1859 objPtr->prevObjPtr = NULL;
1860 objPtr->nextObjPtr = interp->freeList;
1861 if (interp->freeList)
1862 interp->freeList->prevObjPtr = objPtr;
1863 interp->freeList = objPtr;
1864 objPtr->refCount = -1;
1865 }
1866
1867 /* Invalidate the string representation of an object. */
1868 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1869 {
1870 if (objPtr->bytes != NULL) {
1871 if (objPtr->bytes != JimEmptyStringRep)
1872 Jim_Free(objPtr->bytes);
1873 }
1874 objPtr->bytes = NULL;
1875 }
1876
1877 #define Jim_SetStringRep(o, b, l) \
1878 do { (o)->bytes = b; (o)->length = l; } while (0)
1879
1880 /* Set the initial string representation for an object.
1881 * Does not try to free an old one. */
1882 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1883 {
1884 if (length == 0) {
1885 objPtr->bytes = JimEmptyStringRep;
1886 objPtr->length = 0;
1887 } else {
1888 objPtr->bytes = Jim_Alloc(length + 1);
1889 objPtr->length = length;
1890 memcpy(objPtr->bytes, bytes, length);
1891 objPtr->bytes[length] = '\0';
1892 }
1893 }
1894
1895 /* Duplicate an object. The returned object has refcount = 0. */
1896 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1897 {
1898 Jim_Obj *dupPtr;
1899
1900 dupPtr = Jim_NewObj(interp);
1901 if (objPtr->bytes == NULL) {
1902 /* Object does not have a valid string representation. */
1903 dupPtr->bytes = NULL;
1904 } else {
1905 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1906 }
1907 if (objPtr->typePtr != NULL) {
1908 if (objPtr->typePtr->dupIntRepProc == NULL) {
1909 dupPtr->internalRep = objPtr->internalRep;
1910 } else {
1911 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1912 }
1913 dupPtr->typePtr = objPtr->typePtr;
1914 } else {
1915 dupPtr->typePtr = NULL;
1916 }
1917 return dupPtr;
1918 }
1919
1920 /* Return the string representation for objPtr. If the object
1921 * string representation is invalid, calls the method to create
1922 * a new one starting from the internal representation of the object. */
1923 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1924 {
1925 if (objPtr->bytes == NULL) {
1926 /* Invalid string repr. Generate it. */
1927 if (objPtr->typePtr->updateStringProc == NULL) {
1928 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1929 objPtr->typePtr->name);
1930 }
1931 objPtr->typePtr->updateStringProc(objPtr);
1932 }
1933 if (lenPtr)
1934 *lenPtr = objPtr->length;
1935 return objPtr->bytes;
1936 }
1937
1938 /* Just returns the length of the object's string rep */
1939 int Jim_Length(Jim_Obj *objPtr)
1940 {
1941 int len;
1942
1943 Jim_GetString(objPtr, &len);
1944 return len;
1945 }
1946
1947 /* -----------------------------------------------------------------------------
1948 * String Object
1949 * ---------------------------------------------------------------------------*/
1950 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1951 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1952
1953 static Jim_ObjType stringObjType = {
1954 "string",
1955 NULL,
1956 DupStringInternalRep,
1957 NULL,
1958 JIM_TYPE_REFERENCES,
1959 };
1960
1961 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1962 {
1963 JIM_NOTUSED(interp);
1964
1965 /* This is a bit subtle: the only caller of this function
1966 * should be Jim_DuplicateObj(), that will copy the
1967 * string representaion. After the copy, the duplicated
1968 * object will not have more room in teh buffer than
1969 * srcPtr->length bytes. So we just set it to length. */
1970 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1971 }
1972
1973 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1974 {
1975 /* Get a fresh string representation. */
1976 (void) Jim_GetString(objPtr, NULL);
1977 /* Free any other internal representation. */
1978 Jim_FreeIntRep(interp, objPtr);
1979 /* Set it as string, i.e. just set the maxLength field. */
1980 objPtr->typePtr = &stringObjType;
1981 objPtr->internalRep.strValue.maxLength = objPtr->length;
1982 return JIM_OK;
1983 }
1984
1985 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1986 {
1987 Jim_Obj *objPtr = Jim_NewObj(interp);
1988
1989 if (len == -1)
1990 len = strlen(s);
1991 /* Alloc/Set the string rep. */
1992 if (len == 0) {
1993 objPtr->bytes = JimEmptyStringRep;
1994 objPtr->length = 0;
1995 } else {
1996 objPtr->bytes = Jim_Alloc(len + 1);
1997 objPtr->length = len;
1998 memcpy(objPtr->bytes, s, len);
1999 objPtr->bytes[len] = '\0';
2000 }
2001
2002 /* No typePtr field for the vanilla string object. */
2003 objPtr->typePtr = NULL;
2004 return objPtr;
2005 }
2006
2007 /* This version does not try to duplicate the 's' pointer, but
2008 * use it directly. */
2009 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2010 {
2011 Jim_Obj *objPtr = Jim_NewObj(interp);
2012
2013 if (len == -1)
2014 len = strlen(s);
2015 Jim_SetStringRep(objPtr, s, len);
2016 objPtr->typePtr = NULL;
2017 return objPtr;
2018 }
2019
2020 /* Low-level string append. Use it only against objects
2021 * of type "string". */
2022 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2023 {
2024 int needlen;
2025
2026 if (len == -1)
2027 len = strlen(str);
2028 needlen = objPtr->length + len;
2029 if (objPtr->internalRep.strValue.maxLength < needlen ||
2030 objPtr->internalRep.strValue.maxLength == 0) {
2031 if (objPtr->bytes == JimEmptyStringRep) {
2032 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2033 } else {
2034 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2035 }
2036 objPtr->internalRep.strValue.maxLength = needlen*2;
2037 }
2038 memcpy(objPtr->bytes + objPtr->length, str, len);
2039 objPtr->bytes[objPtr->length + len] = '\0';
2040 objPtr->length += len;
2041 }
2042
2043 /* Low-level wrapper to append an object. */
2044 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2045 {
2046 int len;
2047 const char *str;
2048
2049 str = Jim_GetString(appendObjPtr, &len);
2050 StringAppendString(objPtr, str, len);
2051 }
2052
2053 /* Higher level API to append strings to objects. */
2054 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2055 int len)
2056 {
2057 if (Jim_IsShared(objPtr))
2058 Jim_Panic(interp,"Jim_AppendString called with shared object");
2059 if (objPtr->typePtr != &stringObjType)
2060 SetStringFromAny(interp, objPtr);
2061 StringAppendString(objPtr, str, len);
2062 }
2063
2064 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2065 {
2066 char *buf;
2067 va_list ap;
2068
2069 va_start(ap, fmt);
2070 buf = jim_vasprintf(fmt, ap);
2071 va_end(ap);
2072
2073 if (buf) {
2074 Jim_AppendString(interp, objPtr, buf, -1);
2075 jim_vasprintf_done(buf);
2076 }
2077 }
2078
2079
2080 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2081 Jim_Obj *appendObjPtr)
2082 {
2083 int len;
2084 const char *str;
2085
2086 str = Jim_GetString(appendObjPtr, &len);
2087 Jim_AppendString(interp, objPtr, str, len);
2088 }
2089
2090 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2091 {
2092 va_list ap;
2093
2094 if (objPtr->typePtr != &stringObjType)
2095 SetStringFromAny(interp, objPtr);
2096 va_start(ap, objPtr);
2097 while (1) {
2098 char *s = va_arg(ap, char*);
2099
2100 if (s == NULL) break;
2101 Jim_AppendString(interp, objPtr, s, -1);
2102 }
2103 va_end(ap);
2104 }
2105
2106 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2107 {
2108 const char *aStr, *bStr;
2109 int aLen, bLen, i;
2110
2111 if (aObjPtr == bObjPtr) return 1;
2112 aStr = Jim_GetString(aObjPtr, &aLen);
2113 bStr = Jim_GetString(bObjPtr, &bLen);
2114 if (aLen != bLen) return 0;
2115 if (nocase == 0)
2116 return memcmp(aStr, bStr, aLen) == 0;
2117 for (i = 0; i < aLen; i++) {
2118 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2119 return 0;
2120 }
2121 return 1;
2122 }
2123
2124 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2125 int nocase)
2126 {
2127 const char *pattern, *string;
2128 int patternLen, stringLen;
2129
2130 pattern = Jim_GetString(patternObjPtr, &patternLen);
2131 string = Jim_GetString(objPtr, &stringLen);
2132 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2133 }
2134
2135 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2136 Jim_Obj *secondObjPtr, int nocase)
2137 {
2138 const char *s1, *s2;
2139 int l1, l2;
2140
2141 s1 = Jim_GetString(firstObjPtr, &l1);
2142 s2 = Jim_GetString(secondObjPtr, &l2);
2143 return JimStringCompare(s1, l1, s2, l2, nocase);
2144 }
2145
2146 /* Convert a range, as returned by Jim_GetRange(), into
2147 * an absolute index into an object of the specified length.
2148 * This function may return negative values, or values
2149 * bigger or equal to the length of the list if the index
2150 * is out of range. */
2151 static int JimRelToAbsIndex(int len, int index)
2152 {
2153 if (index < 0)
2154 return len + index;
2155 return index;
2156 }
2157
2158 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2159 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2160 * for implementation of commands like [string range] and [lrange].
2161 *
2162 * The resulting range is guaranteed to address valid elements of
2163 * the structure. */
2164 static void JimRelToAbsRange(int len, int first, int last,
2165 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2166 {
2167 int rangeLen;
2168
2169 if (first > last) {
2170 rangeLen = 0;
2171 } else {
2172 rangeLen = last-first + 1;
2173 if (rangeLen) {
2174 if (first < 0) {
2175 rangeLen += first;
2176 first = 0;
2177 }
2178 if (last >= len) {
2179 rangeLen -= (last-(len-1));
2180 last = len-1;
2181 }
2182 }
2183 }
2184 if (rangeLen < 0) rangeLen = 0;
2185
2186 *firstPtr = first;
2187 *lastPtr = last;
2188 *rangeLenPtr = rangeLen;
2189 }
2190
2191 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2192 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2193 {
2194 int first, last;
2195 const char *str;
2196 int len, rangeLen;
2197
2198 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2199 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2200 return NULL;
2201 str = Jim_GetString(strObjPtr, &len);
2202 first = JimRelToAbsIndex(len, first);
2203 last = JimRelToAbsIndex(len, last);
2204 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2205 return Jim_NewStringObj(interp, str + first, rangeLen);
2206 }
2207
2208 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2209 {
2210 char *buf;
2211 int i;
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2214 }
2215
2216 buf = Jim_Alloc(strObjPtr->length + 1);
2217
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = tolower(buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2222 }
2223
2224 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2225 {
2226 char *buf;
2227 int i;
2228 if (strObjPtr->typePtr != &stringObjType) {
2229 SetStringFromAny(interp, strObjPtr);
2230 }
2231
2232 buf = Jim_Alloc(strObjPtr->length + 1);
2233
2234 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2235 for (i = 0; i < strObjPtr->length; i++)
2236 buf[i] = toupper(buf[i]);
2237 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2238 }
2239
2240 /* This is the core of the [format] command.
2241 * TODO: Lots of things work - via a hack
2242 * However, no format item can be >= JIM_MAX_FMT
2243 */
2244 #define JIM_MAX_FMT 2048
2245 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2246 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2247 {
2248 const char *fmt, *_fmt;
2249 int fmtLen;
2250 Jim_Obj *resObjPtr;
2251
2252
2253 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2254 _fmt = fmt;
2255 resObjPtr = Jim_NewStringObj(interp, "", 0);
2256 while (fmtLen) {
2257 const char *p = fmt;
2258 char spec[2], c;
2259 jim_wide wideValue;
2260 double doubleValue;
2261 /* we cheat and use Sprintf()! */
2262 char fmt_str[100];
2263 char *cp;
2264 int width;
2265 int ljust;
2266 int zpad;
2267 int spad;
2268 int altfm;
2269 int forceplus;
2270 int prec;
2271 int inprec;
2272 int haveprec;
2273 int accum;
2274
2275 while (*fmt != '%' && fmtLen) {
2276 fmt++; fmtLen--;
2277 }
2278 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2279 if (fmtLen == 0)
2280 break;
2281 fmt++; fmtLen--; /* skip '%' */
2282 zpad = 0;
2283 spad = 0;
2284 width = -1;
2285 ljust = 0;
2286 altfm = 0;
2287 forceplus = 0;
2288 inprec = 0;
2289 haveprec = 0;
2290 prec = -1; /* not found yet */
2291 next_fmt:
2292 if (fmtLen <= 0) {
2293 break;
2294 }
2295 switch (*fmt) {
2296 /* terminals */
2297 case 'b': /* binary - not all printfs() do this */
2298 case 's': /* string */
2299 case 'i': /* integer */
2300 case 'd': /* decimal */
2301 case 'x': /* hex */
2302 case 'X': /* CAP hex */
2303 case 'c': /* char */
2304 case 'o': /* octal */
2305 case 'u': /* unsigned */
2306 case 'f': /* float */
2307 break;
2308
2309 /* non-terminals */
2310 case '0': /* zero pad */
2311 zpad = 1;
2312 fmt++; fmtLen--;
2313 goto next_fmt;
2314 break;
2315 case '+':
2316 forceplus = 1;
2317 fmt++; fmtLen--;
2318 goto next_fmt;
2319 break;
2320 case ' ': /* sign space */
2321 spad = 1;
2322 fmt++; fmtLen--;
2323 goto next_fmt;
2324 break;
2325 case '-':
2326 ljust = 1;
2327 fmt++; fmtLen--;
2328 goto next_fmt;
2329 break;
2330 case '#':
2331 altfm = 1;
2332 fmt++; fmtLen--;
2333 goto next_fmt;
2334
2335 case '.':
2336 inprec = 1;
2337 fmt++; fmtLen--;
2338 goto next_fmt;
2339 break;
2340 case '1':
2341 case '2':
2342 case '3':
2343 case '4':
2344 case '5':
2345 case '6':
2346 case '7':
2347 case '8':
2348 case '9':
2349 accum = 0;
2350 while (isdigit(*fmt) && (fmtLen > 0)) {
2351 accum = (accum * 10) + (*fmt - '0');
2352 fmt++; fmtLen--;
2353 }
2354 if (inprec) {
2355 haveprec = 1;
2356 prec = accum;
2357 } else {
2358 width = accum;
2359 }
2360 goto next_fmt;
2361 case '*':
2362 /* suck up the next item as an integer */
2363 fmt++; fmtLen--;
2364 objc--;
2365 if (objc <= 0) {
2366 goto not_enough_args;
2367 }
2368 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2369 Jim_FreeNewObj(interp, resObjPtr);
2370 return NULL;
2371 }
2372 if (inprec) {
2373 haveprec = 1;
2374 prec = wideValue;
2375 if (prec < 0) {
2376 /* man 3 printf says */
2377 /* if prec is negative, it is zero */
2378 prec = 0;
2379 }
2380 } else {
2381 width = wideValue;
2382 if (width < 0) {
2383 ljust = 1;
2384 width = -width;
2385 }
2386 }
2387 objv++;
2388 goto next_fmt;
2389 break;
2390 }
2391
2392
2393 if (*fmt != '%') {
2394 if (objc == 0) {
2395 not_enough_args:
2396 Jim_FreeNewObj(interp, resObjPtr);
2397 Jim_SetResultString(interp,
2398 "not enough arguments for all format specifiers", -1);
2399 return NULL;
2400 } else {
2401 objc--;
2402 }
2403 }
2404
2405 /*
2406 * Create the formatter
2407 * cause we cheat and use sprintf()
2408 */
2409 cp = fmt_str;
2410 *cp++ = '%';
2411 if (altfm) {
2412 *cp++ = '#';
2413 }
2414 if (forceplus) {
2415 *cp++ = '+';
2416 } else if (spad) {
2417 /* PLUS overrides */
2418 *cp++ = ' ';
2419 }
2420 if (ljust) {
2421 *cp++ = '-';
2422 }
2423 if (zpad) {
2424 *cp++ = '0';
2425 }
2426 if (width > 0) {
2427 sprintf(cp, "%d", width);
2428 /* skip ahead */
2429 cp = strchr(cp,0);
2430 }
2431 /* did we find a period? */
2432 if (inprec) {
2433 /* then add it */
2434 *cp++ = '.';
2435 /* did something occur after the period? */
2436 if (haveprec) {
2437 sprintf(cp, "%d", prec);
2438 }
2439 cp = strchr(cp,0);
2440 }
2441 *cp = 0;
2442
2443 /* here we do the work */
2444 /* actually - we make sprintf() do it for us */
2445 switch (*fmt) {
2446 case 's':
2447 *cp++ = 's';
2448 *cp = 0;
2449 /* BUG: we do not handled embeded NULLs */
2450 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2451 break;
2452 case 'c':
2453 *cp++ = 'c';
2454 *cp = 0;
2455 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2456 Jim_FreeNewObj(interp, resObjPtr);
2457 return NULL;
2458 }
2459 c = (char) wideValue;
2460 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2461 break;
2462 case 'f':
2463 case 'F':
2464 case 'g':
2465 case 'G':
2466 case 'e':
2467 case 'E':
2468 *cp++ = *fmt;
2469 *cp = 0;
2470 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2471 Jim_FreeNewObj(interp, resObjPtr);
2472 return NULL;
2473 }
2474 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2475 break;
2476 case 'b':
2477 case 'd':
2478 case 'o':
2479 case 'i':
2480 case 'u':
2481 case 'x':
2482 case 'X':
2483 /* jim widevaluse are 64bit */
2484 if (sizeof(jim_wide) == sizeof(long long)) {
2485 *cp++ = 'l';
2486 *cp++ = 'l';
2487 } else {
2488 *cp++ = 'l';
2489 }
2490 *cp++ = *fmt;
2491 *cp = 0;
2492 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2493 Jim_FreeNewObj(interp, resObjPtr);
2494 return NULL;
2495 }
2496 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2497 break;
2498 case '%':
2499 sprintf_buf[0] = '%';
2500 sprintf_buf[1] = 0;
2501 objv--; /* undo the objv++ below */
2502 break;
2503 default:
2504 spec[0] = *fmt; spec[1] = '\0';
2505 Jim_FreeNewObj(interp, resObjPtr);
2506 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2507 Jim_AppendStrings(interp, Jim_GetResult(interp),
2508 "bad field specifier \"", spec, "\"", NULL);
2509 return NULL;
2510 }
2511 /* force terminate */
2512 #if 0
2513 printf("FMT was: %s\n", fmt_str);
2514 printf("RES was: |%s|\n", sprintf_buf);
2515 #endif
2516
2517 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2518 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2519 /* next obj */
2520 objv++;
2521 fmt++;
2522 fmtLen--;
2523 }
2524 return resObjPtr;
2525 }
2526
2527 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2528 int objc, Jim_Obj *const *objv)
2529 {
2530 char *sprintf_buf = malloc(JIM_MAX_FMT);
2531 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2532 free(sprintf_buf);
2533 return t;
2534 }
2535
2536 /* -----------------------------------------------------------------------------
2537 * Compared String Object
2538 * ---------------------------------------------------------------------------*/
2539
2540 /* This is strange object that allows to compare a C literal string
2541 * with a Jim object in very short time if the same comparison is done
2542 * multiple times. For example every time the [if] command is executed,
2543 * Jim has to check if a given argument is "else". This comparions if
2544 * the code has no errors are true most of the times, so we can cache
2545 * inside the object the pointer of the string of the last matching
2546 * comparison. Because most C compilers perform literal sharing,
2547 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2548 * this works pretty well even if comparisons are at different places
2549 * inside the C code. */
2550
2551 static Jim_ObjType comparedStringObjType = {
2552 "compared-string",
2553 NULL,
2554 NULL,
2555 NULL,
2556 JIM_TYPE_REFERENCES,
2557 };
2558
2559 /* The only way this object is exposed to the API is via the following
2560 * function. Returns true if the string and the object string repr.
2561 * are the same, otherwise zero is returned.
2562 *
2563 * Note: this isn't binary safe, but it hardly needs to be.*/
2564 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2565 const char *str)
2566 {
2567 if (objPtr->typePtr == &comparedStringObjType &&
2568 objPtr->internalRep.ptr == str)
2569 return 1;
2570 else {
2571 const char *objStr = Jim_GetString(objPtr, NULL);
2572 if (strcmp(str, objStr) != 0) return 0;
2573 if (objPtr->typePtr != &comparedStringObjType) {
2574 Jim_FreeIntRep(interp, objPtr);
2575 objPtr->typePtr = &comparedStringObjType;
2576 }
2577 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2578 return 1;
2579 }
2580 }
2581
2582 int qsortCompareStringPointers(const void *a, const void *b)
2583 {
2584 char * const *sa = (char * const *)a;
2585 char * const *sb = (char * const *)b;
2586 return strcmp(*sa, *sb);
2587 }
2588
2589 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2590 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2591 {
2592 const char * const *entryPtr = NULL;
2593 char **tablePtrSorted;
2594 int i, count = 0;
2595
2596 *indexPtr = -1;
2597 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2598 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2599 *indexPtr = i;
2600 return JIM_OK;
2601 }
2602 count++; /* If nothing matches, this will reach the len of tablePtr */
2603 }
2604 if (flags & JIM_ERRMSG) {
2605 if (name == NULL)
2606 name = "option";
2607 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2608 Jim_AppendStrings(interp, Jim_GetResult(interp),
2609 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2610 NULL);
2611 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2612 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2613 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2614 for (i = 0; i < count; i++) {
2615 if (i + 1 == count && count > 1)
2616 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2617 Jim_AppendString(interp, Jim_GetResult(interp),
2618 tablePtrSorted[i], -1);
2619 if (i + 1 != count)
2620 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2621 }
2622 Jim_Free(tablePtrSorted);
2623 }
2624 return JIM_ERR;
2625 }
2626
2627 int Jim_GetNvp(Jim_Interp *interp,
2628 Jim_Obj *objPtr,
2629 const Jim_Nvp *nvp_table,
2630 const Jim_Nvp ** result)
2631 {
2632 Jim_Nvp *n;
2633 int e;
2634
2635 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2636 if (e == JIM_ERR) {
2637 return e;
2638 }
2639
2640 /* Success? found? */
2641 if (n->name) {
2642 /* remove const */
2643 *result = (Jim_Nvp *)n;
2644 return JIM_OK;
2645 } else {
2646 return JIM_ERR;
2647 }
2648 }
2649
2650 /* -----------------------------------------------------------------------------
2651 * Source Object
2652 *
2653 * This object is just a string from the language point of view, but
2654 * in the internal representation it contains the filename and line number
2655 * where this given token was read. This information is used by
2656 * Jim_EvalObj() if the object passed happens to be of type "source".
2657 *
2658 * This allows to propagate the information about line numbers and file
2659 * names and give error messages with absolute line numbers.
2660 *
2661 * Note that this object uses shared strings for filenames, and the
2662 * pointer to the filename together with the line number is taken into
2663 * the space for the "inline" internal represenation of the Jim_Object,
2664 * so there is almost memory zero-overhead.
2665 *
2666 * Also the object will be converted to something else if the given
2667 * token it represents in the source file is not something to be
2668 * evaluated (not a script), and will be specialized in some other way,
2669 * so the time overhead is alzo null.
2670 * ---------------------------------------------------------------------------*/
2671
2672 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2673 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2674
2675 static Jim_ObjType sourceObjType = {
2676 "source",
2677 FreeSourceInternalRep,
2678 DupSourceInternalRep,
2679 NULL,
2680 JIM_TYPE_REFERENCES,
2681 };
2682
2683 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2684 {
2685 Jim_ReleaseSharedString(interp,
2686 objPtr->internalRep.sourceValue.fileName);
2687 }
2688
2689 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2690 {
2691 dupPtr->internalRep.sourceValue.fileName =
2692 Jim_GetSharedString(interp,
2693 srcPtr->internalRep.sourceValue.fileName);
2694 dupPtr->internalRep.sourceValue.lineNumber =
2695 dupPtr->internalRep.sourceValue.lineNumber;
2696 dupPtr->typePtr = &sourceObjType;
2697 }
2698
2699 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2700 const char *fileName, int lineNumber)
2701 {
2702 if (Jim_IsShared(objPtr))
2703 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2704 if (objPtr->typePtr != NULL)
2705 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2706 objPtr->internalRep.sourceValue.fileName =
2707 Jim_GetSharedString(interp, fileName);
2708 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2709 objPtr->typePtr = &sourceObjType;
2710 }
2711
2712 /* -----------------------------------------------------------------------------
2713 * Script Object
2714 * ---------------------------------------------------------------------------*/
2715
2716 #define JIM_CMDSTRUCT_EXPAND -1
2717
2718 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2719 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2720 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2721
2722 static Jim_ObjType scriptObjType = {
2723 "script",
2724 FreeScriptInternalRep,
2725 DupScriptInternalRep,
2726 NULL,
2727 JIM_TYPE_REFERENCES,
2728 };
2729
2730 /* The ScriptToken structure represents every token into a scriptObj.
2731 * Every token contains an associated Jim_Obj that can be specialized
2732 * by commands operating on it. */
2733 typedef struct ScriptToken {
2734 int type;
2735 Jim_Obj *objPtr;
2736 int linenr;
2737 } ScriptToken;
2738
2739 /* This is the script object internal representation. An array of
2740 * ScriptToken structures, with an associated command structure array.
2741 * The command structure is a pre-computed representation of the
2742 * command length and arguments structure as a simple liner array
2743 * of integers.
2744 *
2745 * For example the script:
2746 *
2747 * puts hello
2748 * set $i $x$y [foo]BAR
2749 *
2750 * will produce a ScriptObj with the following Tokens:
2751 *
2752 * ESC puts
2753 * SEP
2754 * ESC hello
2755 * EOL
2756 * ESC set
2757 * EOL
2758 * VAR i
2759 * SEP
2760 * VAR x
2761 * VAR y
2762 * SEP
2763 * CMD foo
2764 * ESC BAR
2765 * EOL
2766 *
2767 * This is a description of the tokens, separators, and of lines.
2768 * The command structure instead represents the number of arguments
2769 * of every command, followed by the tokens of which every argument
2770 * is composed. So for the example script, the cmdstruct array will
2771 * contain:
2772 *
2773 * 2 1 1 4 1 1 2 2
2774 *
2775 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2776 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2777 * composed of single tokens (1 1) and the last two of double tokens
2778 * (2 2).
2779 *
2780 * The precomputation of the command structure makes Jim_Eval() faster,
2781 * and simpler because there aren't dynamic lengths / allocations.
2782 *
2783 * -- {expand} handling --
2784 *
2785 * Expand is handled in a special way. When a command
2786 * contains at least an argument with the {expand} prefix,
2787 * the command structure presents a -1 before the integer
2788 * describing the number of arguments. This is used in order
2789 * to send the command exection to a different path in case
2790 * of {expand} and guarantee a fast path for the more common
2791 * case. Also, the integers describing the number of tokens
2792 * are expressed with negative sign, to allow for fast check
2793 * of what's an {expand}-prefixed argument and what not.
2794 *
2795 * For example the command:
2796 *
2797 * list {expand}{1 2}
2798 *
2799 * Will produce the following cmdstruct array:
2800 *
2801 * -1 2 1 -2
2802 *
2803 * -- the substFlags field of the structure --
2804 *
2805 * The scriptObj structure is used to represent both "script" objects
2806 * and "subst" objects. In the second case, the cmdStruct related
2807 * fields are not used at all, but there is an additional field used
2808 * that is 'substFlags': this represents the flags used to turn
2809 * the string into the intenral representation used to perform the
2810 * substitution. If this flags are not what the application requires
2811 * the scriptObj is created again. For example the script:
2812 *
2813 * subst -nocommands $string
2814 * subst -novariables $string
2815 *
2816 * Will recreate the internal representation of the $string object
2817 * two times.
2818 */
2819 typedef struct ScriptObj {
2820 int len; /* Length as number of tokens. */
2821 int commands; /* number of top-level commands in script. */
2822 ScriptToken *token; /* Tokens array. */
2823 int *cmdStruct; /* commands structure */
2824 int csLen; /* length of the cmdStruct array. */
2825 int substFlags; /* flags used for the compilation of "subst" objects */
2826 int inUse; /* Used to share a ScriptObj. Currently
2827 only used by Jim_EvalObj() as protection against
2828 shimmering of the currently evaluated object. */
2829 char *fileName;
2830 } ScriptObj;
2831
2832 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2833 {
2834 int i;
2835 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2836
2837 if (!script)
2838 return;
2839
2840 script->inUse--;
2841 if (script->inUse != 0) return;
2842 for (i = 0; i < script->len; i++) {
2843 if (script->token[i].objPtr != NULL)
2844 Jim_DecrRefCount(interp, script->token[i].objPtr);
2845 }
2846 Jim_Free(script->token);
2847 Jim_Free(script->cmdStruct);
2848 Jim_Free(script->fileName);
2849 Jim_Free(script);
2850 }
2851
2852 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2853 {
2854 JIM_NOTUSED(interp);
2855 JIM_NOTUSED(srcPtr);
2856
2857 /* Just returns an simple string. */
2858 dupPtr->typePtr = NULL;
2859 }
2860
2861 /* Add a new token to the internal repr of a script object */
2862 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2863 char *strtoken, int len, int type, char *filename, int linenr)
2864 {
2865 int prevtype;
2866 struct ScriptToken *token;
2867
2868 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2869 script->token[script->len-1].type;
2870 /* Skip tokens without meaning, like words separators
2871 * following a word separator or an end of command and
2872 * so on. */
2873 if (prevtype == JIM_TT_EOL) {
2874 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2875 Jim_Free(strtoken);
2876 return;
2877 }
2878 } else if (prevtype == JIM_TT_SEP) {
2879 if (type == JIM_TT_SEP) {
2880 Jim_Free(strtoken);
2881 return;
2882 } else if (type == JIM_TT_EOL) {
2883 /* If an EOL is following by a SEP, drop the previous
2884 * separator. */
2885 script->len--;
2886 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2887 }
2888 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2889 type == JIM_TT_ESC && len == 0)
2890 {
2891 /* Don't add empty tokens used in interpolation */
2892 Jim_Free(strtoken);
2893 return;
2894 }
2895 /* Make space for a new istruction */
2896 script->len++;
2897 script->token = Jim_Realloc(script->token,
2898 sizeof(ScriptToken)*script->len);
2899 /* Initialize the new token */
2900 token = script->token + (script->len-1);
2901 token->type = type;
2902 /* Every object is intially as a string, but the
2903 * internal type may be specialized during execution of the
2904 * script. */
2905 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2906 /* To add source info to SEP and EOL tokens is useless because
2907 * they will never by called as arguments of Jim_EvalObj(). */
2908 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2909 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2910 Jim_IncrRefCount(token->objPtr);
2911 token->linenr = linenr;
2912 }
2913
2914 /* Add an integer into the command structure field of the script object. */
2915 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2916 {
2917 script->csLen++;
2918 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2919 sizeof(int)*script->csLen);
2920 script->cmdStruct[script->csLen-1] = val;
2921 }
2922
2923 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2924 * of objPtr. Search nested script objects recursively. */
2925 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2926 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2927 {
2928 int i;
2929
2930 for (i = 0; i < script->len; i++) {
2931 if (script->token[i].objPtr != objPtr &&
2932 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2933 return script->token[i].objPtr;
2934 }
2935 /* Enter recursively on scripts only if the object
2936 * is not the same as the one we are searching for
2937 * shared occurrences. */
2938 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2939 script->token[i].objPtr != objPtr) {
2940 Jim_Obj *foundObjPtr;
2941
2942 ScriptObj *subScript =
2943 script->token[i].objPtr->internalRep.ptr;
2944 /* Don't recursively enter the script we are trying
2945 * to make shared to avoid circular references. */
2946 if (subScript == scriptBarrier) continue;
2947 if (subScript != script) {
2948 foundObjPtr =
2949 ScriptSearchLiteral(interp, subScript,
2950 scriptBarrier, objPtr);
2951 if (foundObjPtr != NULL)
2952 return foundObjPtr;
2953 }
2954 }
2955 }
2956 return NULL;
2957 }
2958
2959 /* Share literals of a script recursively sharing sub-scripts literals. */
2960 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2961 ScriptObj *topLevelScript)
2962 {
2963 int i, j;
2964
2965 return;
2966 /* Try to share with toplevel object. */
2967 if (topLevelScript != NULL) {
2968 for (i = 0; i < script->len; i++) {
2969 Jim_Obj *foundObjPtr;
2970 char *str = script->token[i].objPtr->bytes;
2971
2972 if (script->token[i].objPtr->refCount != 1) continue;
2973 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2974 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2975 foundObjPtr = ScriptSearchLiteral(interp,
2976 topLevelScript,
2977 script, /* barrier */
2978 script->token[i].objPtr);
2979 if (foundObjPtr != NULL) {
2980 Jim_IncrRefCount(foundObjPtr);
2981 Jim_DecrRefCount(interp,
2982 script->token[i].objPtr);
2983 script->token[i].objPtr = foundObjPtr;
2984 }
2985 }
2986 }
2987 /* Try to share locally */
2988 for (i = 0; i < script->len; i++) {
2989 char *str = script->token[i].objPtr->bytes;
2990
2991 if (script->token[i].objPtr->refCount != 1) continue;
2992 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2993 for (j = 0; j < script->len; j++) {
2994 if (script->token[i].objPtr !=
2995 script->token[j].objPtr &&
2996 Jim_StringEqObj(script->token[i].objPtr,
2997 script->token[j].objPtr, 0))
2998 {
2999 Jim_IncrRefCount(script->token[j].objPtr);
3000 Jim_DecrRefCount(interp,
3001 script->token[i].objPtr);
3002 script->token[i].objPtr =
3003 script->token[j].objPtr;
3004 }
3005 }
3006 }
3007 }
3008
3009 /* This method takes the string representation of an object
3010 * as a Tcl script, and generates the pre-parsed internal representation
3011 * of the script. */
3012 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3013 {
3014 int scriptTextLen;
3015 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3016 struct JimParserCtx parser;
3017 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3018 ScriptToken *token;
3019 int args, tokens, start, end, i;
3020 int initialLineNumber;
3021 int propagateSourceInfo = 0;
3022
3023 script->len = 0;
3024 script->csLen = 0;
3025 script->commands = 0;
3026 script->token = NULL;
3027 script->cmdStruct = NULL;
3028 script->inUse = 1;
3029 /* Try to get information about filename / line number */
3030 if (objPtr->typePtr == &sourceObjType) {
3031 script->fileName =
3032 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3033 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3034 propagateSourceInfo = 1;
3035 } else {
3036 script->fileName = Jim_StrDup("");
3037 initialLineNumber = 1;
3038 }
3039
3040 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3041 while (!JimParserEof(&parser)) {
3042 char *token;
3043 int len, type, linenr;
3044
3045 JimParseScript(&parser);
3046 token = JimParserGetToken(&parser, &len, &type, &linenr);
3047 ScriptObjAddToken(interp, script, token, len, type,
3048 propagateSourceInfo ? script->fileName : NULL,
3049 linenr);
3050 }
3051 token = script->token;
3052
3053 /* Compute the command structure array
3054 * (see the ScriptObj struct definition for more info) */
3055 start = 0; /* Current command start token index */
3056 end = -1; /* Current command end token index */
3057 while (1) {
3058 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3059 int interpolation = 0; /* set to 1 if there is at least one
3060 argument of the command obtained via
3061 interpolation of more tokens. */
3062 /* Search for the end of command, while
3063 * count the number of args. */
3064 start = ++end;
3065 if (start >= script->len) break;
3066 args = 1; /* Number of args in current command */
3067 while (token[end].type != JIM_TT_EOL) {
3068 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3069 token[end-1].type == JIM_TT_EOL)
3070 {
3071 if (token[end].type == JIM_TT_STR &&
3072 token[end + 1].type != JIM_TT_SEP &&
3073 token[end + 1].type != JIM_TT_EOL &&
3074 (!strcmp(token[end].objPtr->bytes, "expand") ||
3075 !strcmp(token[end].objPtr->bytes, "*")))
3076 expand++;
3077 }
3078 if (token[end].type == JIM_TT_SEP)
3079 args++;
3080 end++;
3081 }
3082 interpolation = !((end-start + 1) == args*2);
3083 /* Add the 'number of arguments' info into cmdstruct.
3084 * Negative value if there is list expansion involved. */
3085 if (expand)
3086 ScriptObjAddInt(script, -1);
3087 ScriptObjAddInt(script, args);
3088 /* Now add info about the number of tokens. */
3089 tokens = 0; /* Number of tokens in current argument. */
3090 expand = 0;
3091 for (i = start; i <= end; i++) {
3092 if (token[i].type == JIM_TT_SEP ||
3093 token[i].type == JIM_TT_EOL)
3094 {
3095 if (tokens == 1 && expand)
3096 expand = 0;
3097 ScriptObjAddInt(script,
3098 expand ? -tokens : tokens);
3099
3100 expand = 0;
3101 tokens = 0;
3102 continue;
3103 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3104 (!strcmp(token[i].objPtr->bytes, "expand") ||
3105 !strcmp(token[i].objPtr->bytes, "*")))
3106 {
3107 expand++;
3108 }
3109 tokens++;
3110 }
3111 }
3112 /* Perform literal sharing, but only for objects that appear
3113 * to be scripts written as literals inside the source code,
3114 * and not computed at runtime. Literal sharing is a costly
3115 * operation that should be done only against objects that
3116 * are likely to require compilation only the first time, and
3117 * then are executed multiple times. */
3118 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3119 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3120 if (bodyObjPtr->typePtr == &scriptObjType) {
3121 ScriptObj *bodyScript =
3122 bodyObjPtr->internalRep.ptr;
3123 ScriptShareLiterals(interp, script, bodyScript);
3124 }
3125 } else if (propagateSourceInfo) {
3126 ScriptShareLiterals(interp, script, NULL);
3127 }
3128 /* Free the old internal rep and set the new one. */
3129 Jim_FreeIntRep(interp, objPtr);
3130 Jim_SetIntRepPtr(objPtr, script);
3131 objPtr->typePtr = &scriptObjType;
3132 return JIM_OK;
3133 }
3134
3135 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3136 {
3137 if (objPtr->typePtr != &scriptObjType) {
3138 SetScriptFromAny(interp, objPtr);
3139 }
3140 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3141 }
3142
3143 /* -----------------------------------------------------------------------------
3144 * Commands
3145 * ---------------------------------------------------------------------------*/
3146
3147 /* Commands HashTable Type.
3148 *
3149 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3150 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3151 {
3152 Jim_Cmd *cmdPtr = (void*) val;
3153
3154 if (cmdPtr->cmdProc == NULL) {
3155 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3156 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3157 if (cmdPtr->staticVars) {
3158 Jim_FreeHashTable(cmdPtr->staticVars);
3159 Jim_Free(cmdPtr->staticVars);
3160 }
3161 } else if (cmdPtr->delProc != NULL) {
3162 /* If it was a C coded command, call the delProc if any */
3163 cmdPtr->delProc(interp, cmdPtr->privData);
3164 }
3165 Jim_Free(val);
3166 }
3167
3168 static Jim_HashTableType JimCommandsHashTableType = {
3169 JimStringCopyHTHashFunction, /* hash function */
3170 JimStringCopyHTKeyDup, /* key dup */
3171 NULL, /* val dup */
3172 JimStringCopyHTKeyCompare, /* key compare */
3173 JimStringCopyHTKeyDestructor, /* key destructor */
3174 Jim_CommandsHT_ValDestructor /* val destructor */
3175 };
3176
3177 /* ------------------------- Commands related functions --------------------- */
3178
3179 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3180 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3181 {
3182 Jim_HashEntry *he;
3183 Jim_Cmd *cmdPtr;
3184
3185 he = Jim_FindHashEntry(&interp->commands, cmdName);
3186 if (he == NULL) { /* New command to create */
3187 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3188 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3189 } else {
3190 Jim_InterpIncrProcEpoch(interp);
3191 /* Free the arglist/body objects if it was a Tcl procedure */
3192 cmdPtr = he->val;
3193 if (cmdPtr->cmdProc == NULL) {
3194 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3195 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3196 if (cmdPtr->staticVars) {
3197 Jim_FreeHashTable(cmdPtr->staticVars);
3198 Jim_Free(cmdPtr->staticVars);
3199 }
3200 cmdPtr->staticVars = NULL;
3201 } else if (cmdPtr->delProc != NULL) {
3202 /* If it was a C coded command, call the delProc if any */
3203 cmdPtr->delProc(interp, cmdPtr->privData);
3204 }
3205 }
3206
3207 /* Store the new details for this proc */
3208 cmdPtr->delProc = delProc;
3209 cmdPtr->cmdProc = cmdProc;
3210 cmdPtr->privData = privData;
3211
3212 /* There is no need to increment the 'proc epoch' because
3213 * creation of a new procedure can never affect existing
3214 * cached commands. We don't do negative caching. */
3215 return JIM_OK;
3216 }
3217
3218 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3219 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3220 int arityMin, int arityMax)
3221 {
3222 Jim_Cmd *cmdPtr;
3223
3224 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3225 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3226 cmdPtr->argListObjPtr = argListObjPtr;
3227 cmdPtr->bodyObjPtr = bodyObjPtr;
3228 Jim_IncrRefCount(argListObjPtr);
3229 Jim_IncrRefCount(bodyObjPtr);
3230 cmdPtr->arityMin = arityMin;
3231 cmdPtr->arityMax = arityMax;
3232 cmdPtr->staticVars = NULL;
3233
3234 /* Create the statics hash table. */
3235 if (staticsListObjPtr) {
3236 int len, i;
3237
3238 Jim_ListLength(interp, staticsListObjPtr, &len);
3239 if (len != 0) {
3240 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3241 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3242 interp);
3243 for (i = 0; i < len; i++) {
3244 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3245 Jim_Var *varPtr;
3246 int subLen;
3247
3248 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3249 /* Check if it's composed of two elements. */
3250 Jim_ListLength(interp, objPtr, &subLen);
3251 if (subLen == 1 || subLen == 2) {
3252 /* Try to get the variable value from the current
3253 * environment. */
3254 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3255 if (subLen == 1) {
3256 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3257 JIM_NONE);
3258 if (initObjPtr == NULL) {
3259 Jim_SetResult(interp,
3260 Jim_NewEmptyStringObj(interp));
3261 Jim_AppendStrings(interp, Jim_GetResult(interp),
3262 "variable for initialization of static \"",
3263 Jim_GetString(nameObjPtr, NULL),
3264 "\" not found in the local context",
3265 NULL);
3266 goto err;
3267 }
3268 } else {
3269 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3270 }
3271 varPtr = Jim_Alloc(sizeof(*varPtr));
3272 varPtr->objPtr = initObjPtr;
3273 Jim_IncrRefCount(initObjPtr);
3274 varPtr->linkFramePtr = NULL;
3275 if (Jim_AddHashEntry(cmdPtr->staticVars,
3276 Jim_GetString(nameObjPtr, NULL),
3277 varPtr) != JIM_OK)
3278 {
3279 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3280 Jim_AppendStrings(interp, Jim_GetResult(interp),
3281 "static variable name \"",
3282 Jim_GetString(objPtr, NULL), "\"",
3283 " duplicated in statics list", NULL);
3284 Jim_DecrRefCount(interp, initObjPtr);
3285 Jim_Free(varPtr);
3286 goto err;
3287 }
3288 } else {
3289 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3290 Jim_AppendStrings(interp, Jim_GetResult(interp),
3291 "too many fields in static specifier \"",
3292 objPtr, "\"", NULL);
3293 goto err;
3294 }
3295 }
3296 }
3297 }
3298
3299 /* Add the new command */
3300
3301 /* it may already exist, so we try to delete the old one */
3302 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3303 /* There was an old procedure with the same name, this requires
3304 * a 'proc epoch' update. */
3305 Jim_InterpIncrProcEpoch(interp);
3306 }
3307 /* If a procedure with the same name didn't existed there is no need
3308 * to increment the 'proc epoch' because creation of a new procedure
3309 * can never affect existing cached commands. We don't do
3310 * negative caching. */
3311 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3312 return JIM_OK;
3313
3314 err:
3315 Jim_FreeHashTable(cmdPtr->staticVars);
3316 Jim_Free(cmdPtr->staticVars);
3317 Jim_DecrRefCount(interp, argListObjPtr);
3318 Jim_DecrRefCount(interp, bodyObjPtr);
3319 Jim_Free(cmdPtr);
3320 return JIM_ERR;
3321 }
3322
3323 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3324 {
3325 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3326 return JIM_ERR;
3327 Jim_InterpIncrProcEpoch(interp);
3328 return JIM_OK;
3329 }
3330
3331 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3332 const char *newName)
3333 {
3334 Jim_Cmd *cmdPtr;
3335 Jim_HashEntry *he;
3336 Jim_Cmd *copyCmdPtr;
3337
3338 if (newName[0] == '\0') /* Delete! */
3339 return Jim_DeleteCommand(interp, oldName);
3340 /* Rename */
3341 he = Jim_FindHashEntry(&interp->commands, oldName);
3342 if (he == NULL)
3343 return JIM_ERR; /* Invalid command name */
3344 cmdPtr = he->val;
3345 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3346 *copyCmdPtr = *cmdPtr;
3347 /* In order to avoid that a procedure will get arglist/body/statics
3348 * freed by the hash table methods, fake a C-coded command
3349 * setting cmdPtr->cmdProc as not NULL */
3350 cmdPtr->cmdProc = (void*)1;
3351 /* Also make sure delProc is NULL. */
3352 cmdPtr->delProc = NULL;
3353 /* Destroy the old command, and make sure the new is freed
3354 * as well. */
3355 Jim_DeleteHashEntry(&interp->commands, oldName);
3356 Jim_DeleteHashEntry(&interp->commands, newName);
3357 /* Now the new command. We are sure it can't fail because
3358 * the target name was already freed. */
3359 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3360 /* Increment the epoch */
3361 Jim_InterpIncrProcEpoch(interp);
3362 return JIM_OK;
3363 }
3364
3365 /* -----------------------------------------------------------------------------
3366 * Command object
3367 * ---------------------------------------------------------------------------*/
3368
3369 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3370
3371 static Jim_ObjType commandObjType = {
3372 "command",
3373 NULL,
3374 NULL,
3375 NULL,
3376 JIM_TYPE_REFERENCES,
3377 };
3378
3379 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3380 {
3381 Jim_HashEntry *he;
3382 const char *cmdName;
3383
3384 /* Get the string representation */
3385 cmdName = Jim_GetString(objPtr, NULL);
3386 /* Lookup this name into the commands hash table */
3387 he = Jim_FindHashEntry(&interp->commands, cmdName);
3388 if (he == NULL)
3389 return JIM_ERR;
3390
3391 /* Free the old internal repr and set the new one. */
3392 Jim_FreeIntRep(interp, objPtr);
3393 objPtr->typePtr = &commandObjType;
3394 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3395 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3396 return JIM_OK;
3397 }
3398
3399 /* This function returns the command structure for the command name
3400 * stored in objPtr. It tries to specialize the objPtr to contain
3401 * a cached info instead to perform the lookup into the hash table
3402 * every time. The information cached may not be uptodate, in such
3403 * a case the lookup is performed and the cache updated. */
3404 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3405 {
3406 if ((objPtr->typePtr != &commandObjType ||
3407 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3408 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3409 if (flags & JIM_ERRMSG) {
3410 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3411 Jim_AppendStrings(interp, Jim_GetResult(interp),
3412 "invalid command name \"", objPtr->bytes, "\"",
3413 NULL);
3414 }
3415 return NULL;
3416 }
3417 return objPtr->internalRep.cmdValue.cmdPtr;
3418 }
3419
3420 /* -----------------------------------------------------------------------------
3421 * Variables
3422 * ---------------------------------------------------------------------------*/
3423
3424 /* Variables HashTable Type.
3425 *
3426 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3427 static void JimVariablesHTValDestructor(void *interp, void *val)
3428 {
3429 Jim_Var *varPtr = (void*) val;
3430
3431 Jim_DecrRefCount(interp, varPtr->objPtr);
3432 Jim_Free(val);
3433 }
3434
3435 static Jim_HashTableType JimVariablesHashTableType = {
3436 JimStringCopyHTHashFunction, /* hash function */
3437 JimStringCopyHTKeyDup, /* key dup */
3438 NULL, /* val dup */
3439 JimStringCopyHTKeyCompare, /* key compare */
3440 JimStringCopyHTKeyDestructor, /* key destructor */
3441 JimVariablesHTValDestructor /* val destructor */
3442 };
3443
3444 static Jim_HashTableType *getJimVariablesHashTableType(void)
3445 {
3446 return &JimVariablesHashTableType;
3447 }
3448
3449 /* -----------------------------------------------------------------------------
3450 * Variable object
3451 * ---------------------------------------------------------------------------*/
3452
3453 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3454
3455 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3456
3457 static Jim_ObjType variableObjType = {
3458 "variable",
3459 NULL,
3460 NULL,
3461 NULL,
3462 JIM_TYPE_REFERENCES,
3463 };
3464
3465 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3466 * is in the form "varname(key)". */
3467 static int Jim_NameIsDictSugar(const char *str, int len)
3468 {
3469 if (len == -1)
3470 len = strlen(str);
3471 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3472 return 1;
3473 return 0;
3474 }
3475
3476 /* This method should be called only by the variable API.
3477 * It returns JIM_OK on success (variable already exists),
3478 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3479 * a variable name, but syntax glue for [dict] i.e. the last
3480 * character is ')' */
3481 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3482 {
3483 Jim_HashEntry *he;
3484 const char *varName;
3485 int len;
3486
3487 /* Check if the object is already an uptodate variable */
3488 if (objPtr->typePtr == &variableObjType &&
3489 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3490 return JIM_OK; /* nothing to do */
3491 /* Get the string representation */
3492 varName = Jim_GetString(objPtr, &len);
3493 /* Make sure it's not syntax glue to get/set dict. */
3494 if (Jim_NameIsDictSugar(varName, len))
3495 return JIM_DICT_SUGAR;
3496 if (varName[0] == ':' && varName[1] == ':') {
3497 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3498 if (he == NULL) {
3499 return JIM_ERR;
3500 }
3501 }
3502 else {
3503 /* Lookup this name into the variables hash table */
3504 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3505 if (he == NULL) {
3506 /* Try with static vars. */
3507 if (interp->framePtr->staticVars == NULL)
3508 return JIM_ERR;
3509 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3510 return JIM_ERR;
3511 }
3512 }
3513 /* Free the old internal repr and set the new one. */
3514 Jim_FreeIntRep(interp, objPtr);
3515 objPtr->typePtr = &variableObjType;
3516 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3517 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3518 return JIM_OK;
3519 }
3520
3521 /* -------------------- Variables related functions ------------------------- */
3522 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3523 Jim_Obj *valObjPtr);
3524 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3525
3526 /* For now that's dummy. Variables lookup should be optimized
3527 * in many ways, with caching of lookups, and possibly with
3528 * a table of pre-allocated vars in every CallFrame for local vars.
3529 * All the caching should also have an 'epoch' mechanism similar
3530 * to the one used by Tcl for procedures lookup caching. */
3531
3532 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3533 {
3534 const char *name;
3535 Jim_Var *var;
3536 int err;
3537
3538 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3539 /* Check for [dict] syntax sugar. */
3540 if (err == JIM_DICT_SUGAR)
3541 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3542 /* New variable to create */
3543 name = Jim_GetString(nameObjPtr, NULL);
3544
3545 var = Jim_Alloc(sizeof(*var));
3546 var->objPtr = valObjPtr;
3547 Jim_IncrRefCount(valObjPtr);
3548 var->linkFramePtr = NULL;
3549 /* Insert the new variable */
3550 if (name[0] == ':' && name[1] == ':') {
3551 /* Into to the top evel frame */
3552 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3553 }
3554 else {
3555 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3556 }
3557 /* Make the object int rep a variable */
3558 Jim_FreeIntRep(interp, nameObjPtr);
3559 nameObjPtr->typePtr = &variableObjType;
3560 nameObjPtr->internalRep.varValue.callFrameId =
3561 interp->framePtr->id;
3562 nameObjPtr->internalRep.varValue.varPtr = var;
3563 } else {
3564 var = nameObjPtr->internalRep.varValue.varPtr;
3565 if (var->linkFramePtr == NULL) {
3566 Jim_IncrRefCount(valObjPtr);
3567 Jim_DecrRefCount(interp, var->objPtr);
3568 var->objPtr = valObjPtr;
3569 } else { /* Else handle the link */
3570 Jim_CallFrame *savedCallFrame;
3571
3572 savedCallFrame = interp->framePtr;
3573 interp->framePtr = var->linkFramePtr;
3574 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3575 interp->framePtr = savedCallFrame;
3576 if (err != JIM_OK)
3577 return err;
3578 }
3579 }
3580 return JIM_OK;
3581 }
3582
3583 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3584 {
3585 Jim_Obj *nameObjPtr;
3586 int result;
3587
3588 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3589 Jim_IncrRefCount(nameObjPtr);
3590 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3591 Jim_DecrRefCount(interp, nameObjPtr);
3592 return result;
3593 }
3594
3595 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3596 {
3597 Jim_CallFrame *savedFramePtr;
3598 int result;
3599
3600 savedFramePtr = interp->framePtr;
3601 interp->framePtr = interp->topFramePtr;
3602 result = Jim_SetVariableStr(interp, name, objPtr);
3603 interp->framePtr = savedFramePtr;
3604 return result;
3605 }
3606
3607 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3608 {
3609 Jim_Obj *nameObjPtr, *valObjPtr;
3610 int result;
3611
3612 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3613 valObjPtr = Jim_NewStringObj(interp, val, -1);
3614 Jim_IncrRefCount(nameObjPtr);
3615 Jim_IncrRefCount(valObjPtr);
3616 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3617 Jim_DecrRefCount(interp, nameObjPtr);
3618 Jim_DecrRefCount(interp, valObjPtr);
3619 return result;
3620 }
3621
3622 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3623 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3624 {
3625 const char *varName;
3626 int len;
3627
3628 /* Check for cycles. */
3629 if (interp->framePtr == targetCallFrame) {
3630 Jim_Obj *objPtr = targetNameObjPtr;
3631 Jim_Var *varPtr;
3632 /* Cycles are only possible with 'uplevel 0' */
3633 while (1) {
3634 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3635 Jim_SetResultString(interp,
3636 "can't upvar from variable to itself", -1);
3637 return JIM_ERR;
3638 }
3639 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3640 break;
3641 varPtr = objPtr->internalRep.varValue.varPtr;
3642 if (varPtr->linkFramePtr != targetCallFrame) break;
3643 objPtr = varPtr->objPtr;
3644 }
3645 }
3646 varName = Jim_GetString(nameObjPtr, &len);
3647 if (Jim_NameIsDictSugar(varName, len)) {
3648 Jim_SetResultString(interp,
3649 "Dict key syntax invalid as link source", -1);
3650 return JIM_ERR;
3651 }
3652 /* Perform the binding */
3653 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3654 /* We are now sure 'nameObjPtr' type is variableObjType */
3655 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3656 return JIM_OK;
3657 }
3658
3659 /* Return the Jim_Obj pointer associated with a variable name,
3660 * or NULL if the variable was not found in the current context.
3661 * The same optimization discussed in the comment to the
3662 * 'SetVariable' function should apply here. */
3663 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3664 {
3665 int err;
3666
3667 /* All the rest is handled here */
3668 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3669 /* Check for [dict] syntax sugar. */
3670 if (err == JIM_DICT_SUGAR)
3671 return JimDictSugarGet(interp, nameObjPtr);
3672 if (flags & JIM_ERRMSG) {
3673 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3674 Jim_AppendStrings(interp, Jim_GetResult(interp),
3675 "can't read \"", nameObjPtr->bytes,
3676 "\": no such variable", NULL);
3677 }
3678 return NULL;
3679 } else {
3680 Jim_Var *varPtr;
3681 Jim_Obj *objPtr;
3682 Jim_CallFrame *savedCallFrame;
3683
3684 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3685 if (varPtr->linkFramePtr == NULL)
3686 return varPtr->objPtr;
3687 /* The variable is a link? Resolve it. */
3688 savedCallFrame = interp->framePtr;
3689 interp->framePtr = varPtr->linkFramePtr;
3690 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3691 if (objPtr == NULL && flags & JIM_ERRMSG) {
3692 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3693 Jim_AppendStrings(interp, Jim_GetResult(interp),
3694 "can't read \"", nameObjPtr->bytes,
3695 "\": no such variable", NULL);
3696 }
3697 interp->framePtr = savedCallFrame;
3698 return objPtr;
3699 }
3700 }
3701
3702 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3703 int flags)
3704 {
3705 Jim_CallFrame *savedFramePtr;
3706 Jim_Obj *objPtr;
3707
3708 savedFramePtr = interp->framePtr;
3709 interp->framePtr = interp->topFramePtr;
3710 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3711 interp->framePtr = savedFramePtr;
3712
3713 return objPtr;
3714 }
3715
3716 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3717 {
3718 Jim_Obj *nameObjPtr, *varObjPtr;
3719
3720 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3721 Jim_IncrRefCount(nameObjPtr);
3722 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3723 Jim_DecrRefCount(interp, nameObjPtr);
3724 return varObjPtr;
3725 }
3726
3727 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3728 int flags)
3729 {
3730 Jim_CallFrame *savedFramePtr;
3731 Jim_Obj *objPtr;
3732
3733 savedFramePtr = interp->framePtr;
3734 interp->framePtr = interp->topFramePtr;
3735 objPtr = Jim_GetVariableStr(interp, name, flags);
3736 interp->framePtr = savedFramePtr;
3737
3738 return objPtr;
3739 }
3740
3741 /* Unset a variable.
3742 * Note: On success unset invalidates all the variable objects created
3743 * in the current call frame incrementing. */
3744 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3745 {
3746 const char *name;
3747 Jim_Var *varPtr;
3748 int err;
3749
3750 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3751 /* Check for [dict] syntax sugar. */
3752 if (err == JIM_DICT_SUGAR)
3753 return JimDictSugarSet(interp, nameObjPtr, NULL);
3754 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3755 Jim_AppendStrings(interp, Jim_GetResult(interp),
3756 "can't unset \"", nameObjPtr->bytes,
3757 "\": no such variable", NULL);
3758 return JIM_ERR; /* var not found */
3759 }
3760 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3761 /* If it's a link call UnsetVariable recursively */
3762 if (varPtr->linkFramePtr) {
3763 int retval;
3764
3765 Jim_CallFrame *savedCallFrame;
3766
3767 savedCallFrame = interp->framePtr;
3768 interp->framePtr = varPtr->linkFramePtr;
3769 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3770 interp->framePtr = savedCallFrame;
3771 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3772 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3773 Jim_AppendStrings(interp, Jim_GetResult(interp),
3774 "can't unset \"", nameObjPtr->bytes,
3775 "\": no such variable", NULL);
3776 }
3777 return retval;
3778 } else {
3779 name = Jim_GetString(nameObjPtr, NULL);
3780 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3781 != JIM_OK) return JIM_ERR;
3782 /* Change the callframe id, invalidating var lookup caching */
3783 JimChangeCallFrameId(interp, interp->framePtr);
3784 return JIM_OK;
3785 }
3786 }
3787
3788 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3789
3790 /* Given a variable name for [dict] operation syntax sugar,
3791 * this function returns two objects, the first with the name
3792 * of the variable to set, and the second with the rispective key.
3793 * For example "foo(bar)" will return objects with string repr. of
3794 * "foo" and "bar".
3795 *
3796 * The returned objects have refcount = 1. The function can't fail. */
3797 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3798 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3799 {
3800 const char *str, *p;
3801 char *t;
3802 int len, keyLen, nameLen;
3803 Jim_Obj *varObjPtr, *keyObjPtr;
3804
3805 str = Jim_GetString(objPtr, &len);
3806 p = strchr(str, '(');
3807 p++;
3808 keyLen = len-((p-str) + 1);
3809 nameLen = (p-str)-1;
3810 /* Create the objects with the variable name and key. */
3811 t = Jim_Alloc(nameLen + 1);
3812 memcpy(t, str, nameLen);
3813 t[nameLen] = '\0';
3814 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3815
3816 t = Jim_Alloc(keyLen + 1);
3817 memcpy(t, p, keyLen);
3818 t[keyLen] = '\0';
3819 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3820
3821 Jim_IncrRefCount(varObjPtr);
3822 Jim_IncrRefCount(keyObjPtr);
3823 *varPtrPtr = varObjPtr;
3824 *keyPtrPtr = keyObjPtr;
3825 }
3826
3827 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3828 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3829 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3830 Jim_Obj *valObjPtr)
3831 {
3832 Jim_Obj *varObjPtr, *keyObjPtr;
3833 int err = JIM_OK;
3834
3835 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3836 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3837 valObjPtr);
3838 Jim_DecrRefCount(interp, varObjPtr);
3839 Jim_DecrRefCount(interp, keyObjPtr);
3840 return err;
3841 }
3842
3843 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3844 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3845 {
3846 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3847
3848 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3849 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3850 if (!dictObjPtr) {
3851 resObjPtr = NULL;
3852 goto err;
3853 }
3854 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3855 != JIM_OK) {
3856 resObjPtr = NULL;
3857 }
3858 err:
3859 Jim_DecrRefCount(interp, varObjPtr);
3860 Jim_DecrRefCount(interp, keyObjPtr);
3861 return resObjPtr;
3862 }
3863
3864 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3865
3866 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3867 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3868 Jim_Obj *dupPtr);
3869
3870 static Jim_ObjType dictSubstObjType = {
3871 "dict-substitution",
3872 FreeDictSubstInternalRep,
3873 DupDictSubstInternalRep,
3874 NULL,
3875 JIM_TYPE_NONE,
3876 };
3877
3878 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3879 {
3880 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3881 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3882 }
3883
3884 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3885 Jim_Obj *dupPtr)
3886 {
3887 JIM_NOTUSED(interp);
3888
3889 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3890 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3891 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3892 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3893 dupPtr->typePtr = &dictSubstObjType;
3894 }
3895
3896 /* This function is used to expand [dict get] sugar in the form
3897 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3898 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3899 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3900 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3901 * the [dict]ionary contained in variable VARNAME. */
3902 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3903 {
3904 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3905 Jim_Obj *substKeyObjPtr = NULL;
3906
3907 if (objPtr->typePtr != &dictSubstObjType) {
3908 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3909 Jim_FreeIntRep(interp, objPtr);
3910 objPtr->typePtr = &dictSubstObjType;
3911 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3912 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3913 }
3914 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3915 &substKeyObjPtr, JIM_NONE)
3916 != JIM_OK) {
3917 substKeyObjPtr = NULL;
3918 goto err;
3919 }
3920 Jim_IncrRefCount(substKeyObjPtr);
3921 dictObjPtr = Jim_GetVariable(interp,
3922 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3923 if (!dictObjPtr) {
3924 resObjPtr = NULL;
3925 goto err;
3926 }
3927 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3928 != JIM_OK) {
3929 resObjPtr = NULL;
3930 goto err;
3931 }
3932 err:
3933 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3934 return resObjPtr;
3935 }
3936
3937 /* -----------------------------------------------------------------------------
3938 * CallFrame
3939 * ---------------------------------------------------------------------------*/
3940
3941 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3942 {
3943 Jim_CallFrame *cf;
3944 if (interp->freeFramesList) {
3945 cf = interp->freeFramesList;
3946 interp->freeFramesList = cf->nextFramePtr;
3947 } else {
3948 cf = Jim_Alloc(sizeof(*cf));
3949 cf->vars.table = NULL;
3950 }
3951
3952 cf->id = interp->callFrameEpoch++;
3953 cf->parentCallFrame = NULL;
3954 cf->argv = NULL;
3955 cf->argc = 0;
3956 cf->procArgsObjPtr = NULL;
3957 cf->procBodyObjPtr = NULL;
3958 cf->nextFramePtr = NULL;
3959 cf->staticVars = NULL;
3960 if (cf->vars.table == NULL)
3961 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3962 return cf;
3963 }
3964
3965 /* Used to invalidate every caching related to callframe stability. */
3966 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3967 {
3968 cf->id = interp->callFrameEpoch++;
3969 }
3970
3971 #define JIM_FCF_NONE 0 /* no flags */
3972 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3973 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3974 int flags)
3975 {
3976 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3977 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3978 if (!(flags & JIM_FCF_NOHT))
3979 Jim_FreeHashTable(&cf->vars);
3980 else {
3981 int i;
3982 Jim_HashEntry **table = cf->vars.table, *he;
3983
3984 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3985 he = table[i];
3986 while (he != NULL) {
3987 Jim_HashEntry *nextEntry = he->next;
3988 Jim_Var *varPtr = (void*) he->val;
3989
3990 Jim_DecrRefCount(interp, varPtr->objPtr);
3991 Jim_Free(he->val);
3992 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3993 Jim_Free(he);
3994 table[i] = NULL;
3995 he = nextEntry;
3996 }
3997 }
3998 cf->vars.used = 0;
3999 }
4000 cf->nextFramePtr = interp->freeFramesList;
4001 interp->freeFramesList = cf;
4002 }
4003
4004 /* -----------------------------------------------------------------------------
4005 * References
4006 * ---------------------------------------------------------------------------*/
4007
4008 /* References HashTable Type.
4009 *
4010 * Keys are jim_wide integers, dynamically allocated for now but in the
4011 * future it's worth to cache this 8 bytes objects. Values are poitners
4012 * to Jim_References. */
4013 static void JimReferencesHTValDestructor(void *interp, void *val)
4014 {
4015 Jim_Reference *refPtr = (void*) val;
4016
4017 Jim_DecrRefCount(interp, refPtr->objPtr);
4018 if (refPtr->finalizerCmdNamePtr != NULL) {
4019 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4020 }
4021 Jim_Free(val);
4022 }
4023
4024 unsigned int JimReferencesHTHashFunction(const void *key)
4025 {
4026 /* Only the least significant bits are used. */
4027 const jim_wide *widePtr = key;
4028 unsigned int intValue = (unsigned int) *widePtr;
4029 return Jim_IntHashFunction(intValue);
4030 }
4031
4032 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4033 {
4034 /* Only the least significant bits are used. */
4035 const jim_wide *widePtr = key;
4036 unsigned int intValue = (unsigned int) *widePtr;
4037 return intValue; /* identity function. */
4038 }
4039
4040 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4041 {
4042 void *copy = Jim_Alloc(sizeof(jim_wide));
4043 JIM_NOTUSED(privdata);
4044
4045 memcpy(copy, key, sizeof(jim_wide));
4046 return copy;
4047 }
4048
4049 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4050 const void *key2)
4051 {
4052 JIM_NOTUSED(privdata);
4053
4054 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4055 }
4056
4057 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4058 {
4059 JIM_NOTUSED(privdata);
4060
4061 Jim_Free((void*)key);
4062 }
4063
4064 static Jim_HashTableType JimReferencesHashTableType = {
4065 JimReferencesHTHashFunction, /* hash function */
4066 JimReferencesHTKeyDup, /* key dup */
4067 NULL, /* val dup */
4068 JimReferencesHTKeyCompare, /* key compare */
4069 JimReferencesHTKeyDestructor, /* key destructor */
4070 JimReferencesHTValDestructor /* val destructor */
4071 };
4072
4073 /* -----------------------------------------------------------------------------
4074 * Reference object type and References API
4075 * ---------------------------------------------------------------------------*/
4076
4077 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4078
4079 static Jim_ObjType referenceObjType = {
4080 "reference",
4081 NULL,
4082 NULL,
4083 UpdateStringOfReference,
4084 JIM_TYPE_REFERENCES,
4085 };
4086
4087 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4088 {
4089 int len;
4090 char buf[JIM_REFERENCE_SPACE + 1];
4091 Jim_Reference *refPtr;
4092
4093 refPtr = objPtr->internalRep.refValue.refPtr;
4094 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4095 objPtr->bytes = Jim_Alloc(len + 1);
4096 memcpy(objPtr->bytes, buf, len + 1);
4097 objPtr->length = len;
4098 }
4099
4100 /* returns true if 'c' is a valid reference tag character.
4101 * i.e. inside the range [_a-zA-Z0-9] */
4102 static int isrefchar(int c)
4103 {
4104 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4105 (c >= '0' && c <= '9')) return 1;
4106 return 0;
4107 }
4108
4109 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4110 {
4111 jim_wide wideValue;
4112 int i, len;
4113 const char *str, *start, *end;
4114 char refId[21];
4115 Jim_Reference *refPtr;
4116 Jim_HashEntry *he;
4117
4118 /* Get the string representation */
4119 str = Jim_GetString(objPtr, &len);
4120 /* Check if it looks like a reference */
4121 if (len < JIM_REFERENCE_SPACE) goto badformat;
4122 /* Trim spaces */
4123 start = str;
4124 end = str + len-1;
4125 while (*start == ' ') start++;
4126 while (*end == ' ' && end > start) end--;
4127 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4128 /* <reference.<1234567>.%020> */
4129 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4130 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4131 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4132 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4133 if (!isrefchar(start[12 + i])) goto badformat;
4134 }
4135 /* Extract info from the refernece. */
4136 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4137 refId[20] = '\0';
4138 /* Try to convert the ID into a jim_wide */
4139 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4140 /* Check if the reference really exists! */
4141 he = Jim_FindHashEntry(&interp->references, &wideValue);
4142 if (he == NULL) {
4143 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4144 Jim_AppendStrings(interp, Jim_GetResult(interp),
4145 "Invalid reference ID \"", str, "\"", NULL);
4146 return JIM_ERR;
4147 }
4148 refPtr = he->val;
4149 /* Free the old internal repr and set the new one. */
4150 Jim_FreeIntRep(interp, objPtr);
4151 objPtr->typePtr = &referenceObjType;
4152 objPtr->internalRep.refValue.id = wideValue;
4153 objPtr->internalRep.refValue.refPtr = refPtr;
4154 return JIM_OK;
4155
4156 badformat:
4157 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4158 Jim_AppendStrings(interp, Jim_GetResult(interp),
4159 "expected reference but got \"", str, "\"", NULL);
4160 return JIM_ERR;
4161 }
4162
4163 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4164 * as finalizer command (or NULL if there is no finalizer).
4165 * The returned reference object has refcount = 0. */
4166 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4167 Jim_Obj *cmdNamePtr)
4168 {
4169 struct Jim_Reference *refPtr;
4170 jim_wide wideValue = interp->referenceNextId;
4171 Jim_Obj *refObjPtr;
4172 const char *tag;
4173 int tagLen, i;
4174
4175 /* Perform the Garbage Collection if needed. */
4176 Jim_CollectIfNeeded(interp);
4177
4178 refPtr = Jim_Alloc(sizeof(*refPtr));
4179 refPtr->objPtr = objPtr;
4180 Jim_IncrRefCount(objPtr);
4181 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4182 if (cmdNamePtr)
4183 Jim_IncrRefCount(cmdNamePtr);
4184 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4185 refObjPtr = Jim_NewObj(interp);
4186 refObjPtr->typePtr = &referenceObjType;
4187 refObjPtr->bytes = NULL;
4188 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4189 refObjPtr->internalRep.refValue.refPtr = refPtr;
4190 interp->referenceNextId++;
4191 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4192 * that does not pass the 'isrefchar' test is replaced with '_' */
4193 tag = Jim_GetString(tagPtr, &tagLen);
4194 if (tagLen > JIM_REFERENCE_TAGLEN)
4195 tagLen = JIM_REFERENCE_TAGLEN;
4196 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4197 if (i < tagLen)
4198 refPtr->tag[i] = tag[i];
4199 else
4200 refPtr->tag[i] = '_';
4201 }
4202 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4203 return refObjPtr;
4204 }
4205
4206 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4207 {
4208 if (objPtr->typePtr != &referenceObjType &&
4209 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4210 return NULL;
4211 return objPtr->internalRep.refValue.refPtr;
4212 }
4213
4214 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4215 {
4216 Jim_Reference *refPtr;
4217
4218 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4219 return JIM_ERR;
4220 Jim_IncrRefCount(cmdNamePtr);
4221 if (refPtr->finalizerCmdNamePtr)
4222 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4223 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4224 return JIM_OK;
4225 }
4226
4227 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4228 {
4229 Jim_Reference *refPtr;
4230
4231 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4232 return JIM_ERR;
4233 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4234 return JIM_OK;
4235 }
4236
4237 /* -----------------------------------------------------------------------------
4238 * References Garbage Collection
4239 * ---------------------------------------------------------------------------*/
4240
4241 /* This the hash table type for the "MARK" phase of the GC */
4242 static Jim_HashTableType JimRefMarkHashTableType = {
4243 JimReferencesHTHashFunction, /* hash function */
4244 JimReferencesHTKeyDup, /* key dup */
4245 NULL, /* val dup */
4246 JimReferencesHTKeyCompare, /* key compare */
4247 JimReferencesHTKeyDestructor, /* key destructor */
4248 NULL /* val destructor */
4249 };
4250
4251 /* #define JIM_DEBUG_GC 1 */
4252
4253 /* Performs the garbage collection. */
4254 int Jim_Collect(Jim_Interp *interp)
4255 {
4256 Jim_HashTable marks;
4257 Jim_HashTableIterator *htiter;
4258 Jim_HashEntry *he;
4259 Jim_Obj *objPtr;
4260 int collected = 0;
4261
4262 /* Avoid recursive calls */
4263 if (interp->lastCollectId == -1) {
4264 /* Jim_Collect() already running. Return just now. */
4265 return 0;
4266 }
4267 interp->lastCollectId = -1;
4268
4269 /* Mark all the references found into the 'mark' hash table.
4270 * The references are searched in every live object that
4271 * is of a type that can contain references. */
4272 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4273 objPtr = interp->liveList;
4274 while (objPtr) {
4275 if (objPtr->typePtr == NULL ||
4276 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4277 const char *str, *p;
4278 int len;
4279
4280 /* If the object is of type reference, to get the
4281 * Id is simple... */
4282 if (objPtr->typePtr == &referenceObjType) {
4283 Jim_AddHashEntry(&marks,
4284 &objPtr->internalRep.refValue.id, NULL);
4285 #ifdef JIM_DEBUG_GC
4286 Jim_fprintf(interp,interp->cookie_stdout,
4287 "MARK (reference): %d refcount: %d" JIM_NL,
4288 (int) objPtr->internalRep.refValue.id,
4289 objPtr->refCount);
4290 #endif
4291 objPtr = objPtr->nextObjPtr;
4292 continue;
4293 }
4294 /* Get the string repr of the object we want
4295 * to scan for references. */
4296 p = str = Jim_GetString(objPtr, &len);
4297 /* Skip objects too little to contain references. */
4298 if (len < JIM_REFERENCE_SPACE) {
4299 objPtr = objPtr->nextObjPtr;
4300 continue;
4301 }
4302 /* Extract references from the object string repr. */
4303 while (1) {
4304 int i;
4305 jim_wide id;
4306 char buf[21];
4307
4308 if ((p = strstr(p, "<reference.<")) == NULL)
4309 break;
4310 /* Check if it's a valid reference. */
4311 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4312 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4313 for (i = 21; i <= 40; i++)
4314 if (!isdigit((int)p[i]))
4315 break;
4316 /* Get the ID */
4317 memcpy(buf, p + 21, 20);
4318 buf[20] = '\0';
4319 Jim_StringToWide(buf, &id, 10);
4320
4321 /* Ok, a reference for the given ID
4322 * was found. Mark it. */
4323 Jim_AddHashEntry(&marks, &id, NULL);
4324 #ifdef JIM_DEBUG_GC
4325 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4326 #endif
4327 p += JIM_REFERENCE_SPACE;
4328 }
4329 }
4330 objPtr = objPtr->nextObjPtr;
4331 }
4332
4333 /* Run the references hash table to destroy every reference that
4334 * is not referenced outside (not present in the mark HT). */
4335 htiter = Jim_GetHashTableIterator(&interp->references);
4336 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4337 const jim_wide *refId;
4338 Jim_Reference *refPtr;
4339
4340 refId = he->key;
4341 /* Check if in the mark phase we encountered
4342 * this reference. */
4343 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4344 #ifdef JIM_DEBUG_GC
4345 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4346 #endif
4347 collected++;
4348 /* Drop the reference, but call the
4349 * finalizer first if registered. */
4350 refPtr = he->val;
4351 if (refPtr->finalizerCmdNamePtr) {
4352 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4353 Jim_Obj *objv[3], *oldResult;
4354
4355 JimFormatReference(refstr, refPtr, *refId);
4356
4357 objv[0] = refPtr->finalizerCmdNamePtr;
4358 objv[1] = Jim_NewStringObjNoAlloc(interp,
4359 refstr, 32);
4360 objv[2] = refPtr->objPtr;
4361 Jim_IncrRefCount(objv[0]);
4362 Jim_IncrRefCount(objv[1]);
4363 Jim_IncrRefCount(objv[2]);
4364
4365 /* Drop the reference itself */
4366 Jim_DeleteHashEntry(&interp->references, refId);
4367
4368 /* Call the finalizer. Errors ignored. */
4369 oldResult = interp->result;
4370 Jim_IncrRefCount(oldResult);
4371 Jim_EvalObjVector(interp, 3, objv);
4372 Jim_SetResult(interp, oldResult);
4373 Jim_DecrRefCount(interp, oldResult);
4374
4375 Jim_DecrRefCount(interp, objv[0]);
4376 Jim_DecrRefCount(interp, objv[1]);
4377 Jim_DecrRefCount(interp, objv[2]);
4378 } else {
4379 Jim_DeleteHashEntry(&interp->references, refId);
4380 }
4381 }
4382 }
4383 Jim_FreeHashTableIterator(htiter);
4384 Jim_FreeHashTable(&marks);
4385 interp->lastCollectId = interp->referenceNextId;
4386 interp->lastCollectTime = time(NULL);
4387 return collected;
4388 }
4389
4390 #define JIM_COLLECT_ID_PERIOD 5000
4391 #define JIM_COLLECT_TIME_PERIOD 300
4392
4393 void Jim_CollectIfNeeded(Jim_Interp *interp)
4394 {
4395 jim_wide elapsedId;
4396 int elapsedTime;
4397
4398 elapsedId = interp->referenceNextId - interp->lastCollectId;
4399 elapsedTime = time(NULL) - interp->lastCollectTime;
4400
4401
4402 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4403 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4404 Jim_Collect(interp);
4405 }
4406 }
4407
4408 /* -----------------------------------------------------------------------------
4409 * Interpreter related functions
4410 * ---------------------------------------------------------------------------*/
4411
4412 Jim_Interp *Jim_CreateInterp(void)
4413 {
4414 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4415 Jim_Obj *pathPtr;
4416
4417 i->errorLine = 0;
4418 i->errorFileName = Jim_StrDup("");
4419 i->numLevels = 0;
4420 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4421 i->returnCode = JIM_OK;
4422 i->exitCode = 0;
4423 i->procEpoch = 0;
4424 i->callFrameEpoch = 0;
4425 i->liveList = i->freeList = NULL;
4426 i->scriptFileName = Jim_StrDup("");
4427 i->referenceNextId = 0;
4428 i->lastCollectId = 0;
4429 i->lastCollectTime = time(NULL);
4430 i->freeFramesList = NULL;
4431 i->prngState = NULL;
4432 i->evalRetcodeLevel = -1;
4433 i->cookie_stdin = stdin;
4434 i->cookie_stdout = stdout;
4435 i->cookie_stderr = stderr;
4436 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4437 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4438 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4439 i->cb_fflush = ((int (*)(void *))(fflush));
4440 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4441
4442 /* Note that we can create objects only after the
4443 * interpreter liveList and freeList pointers are
4444 * initialized to NULL. */
4445 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4446 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4447 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4448 NULL);
4449 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4450 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4451 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4452 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4453 i->emptyObj = Jim_NewEmptyStringObj(i);
4454 i->result = i->emptyObj;
4455 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4456 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4457 i->unknown_called = 0;
4458 Jim_IncrRefCount(i->emptyObj);
4459 Jim_IncrRefCount(i->result);
4460 Jim_IncrRefCount(i->stackTrace);
4461 Jim_IncrRefCount(i->unknown);
4462
4463 /* Initialize key variables every interpreter should contain */
4464 pathPtr = Jim_NewStringObj(i, "./", -1);
4465 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4466 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4467
4468 /* Export the core API to extensions */
4469 JimRegisterCoreApi(i);
4470 return i;
4471 }
4472
4473 /* This is the only function Jim exports directly without
4474 * to use the STUB system. It is only used by embedders
4475 * in order to get an interpreter with the Jim API pointers
4476 * registered. */
4477 Jim_Interp *ExportedJimCreateInterp(void)
4478 {
4479 return Jim_CreateInterp();
4480 }
4481
4482 void Jim_FreeInterp(Jim_Interp *i)
4483 {
4484 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4485 Jim_Obj *objPtr, *nextObjPtr;
4486
4487 Jim_DecrRefCount(i, i->emptyObj);
4488 Jim_DecrRefCount(i, i->result);
4489 Jim_DecrRefCount(i, i->stackTrace);
4490 Jim_DecrRefCount(i, i->unknown);
4491 Jim_Free((void*)i->errorFileName);
4492 Jim_Free((void*)i->scriptFileName);
4493 Jim_FreeHashTable(&i->commands);
4494 Jim_FreeHashTable(&i->references);
4495 Jim_FreeHashTable(&i->stub);
4496 Jim_FreeHashTable(&i->assocData);
4497 Jim_FreeHashTable(&i->packages);
4498 Jim_Free(i->prngState);
4499 /* Free the call frames list */
4500 while (cf) {
4501 prevcf = cf->parentCallFrame;
4502 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4503 cf = prevcf;
4504 }
4505 /* Check that the live object list is empty, otherwise
4506 * there is a memory leak. */
4507 if (i->liveList != NULL) {
4508 Jim_Obj *objPtr = i->liveList;
4509
4510 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4511 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4512 while (objPtr) {
4513 const char *type = objPtr->typePtr ?
4514 objPtr->typePtr->name : "";
4515 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4516 objPtr, type,
4517 objPtr->bytes ? objPtr->bytes
4518 : "(null)", objPtr->refCount);
4519 if (objPtr->typePtr == &sourceObjType) {
4520 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4521 objPtr->internalRep.sourceValue.fileName,
4522 objPtr->internalRep.sourceValue.lineNumber);
4523 }
4524 objPtr = objPtr->nextObjPtr;
4525 }
4526 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4527 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4528 }
4529 /* Free all the freed objects. */
4530 objPtr = i->freeList;
4531 while (objPtr) {
4532 nextObjPtr = objPtr->nextObjPtr;
4533 Jim_Free(objPtr);
4534 objPtr = nextObjPtr;
4535 }
4536 /* Free cached CallFrame structures */
4537 cf = i->freeFramesList;
4538 while (cf) {
4539 nextcf = cf->nextFramePtr;
4540 if (cf->vars.table != NULL)
4541 Jim_Free(cf->vars.table);
4542 Jim_Free(cf);
4543 cf = nextcf;
4544 }
4545 /* Free the sharedString hash table. Make sure to free it
4546 * after every other Jim_Object was freed. */
4547 Jim_FreeHashTable(&i->sharedStrings);
4548 /* Free the interpreter structure. */
4549 Jim_Free(i);
4550 }
4551
4552 /* Store the call frame relative to the level represented by
4553 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4554 * level is assumed to be '1'.
4555 *
4556 * If a newLevelptr int pointer is specified, the function stores
4557 * the absolute level integer value of the new target callframe into
4558 * *newLevelPtr. (this is used to adjust interp->numLevels
4559 * in the implementation of [uplevel], so that [info level] will
4560 * return a correct information).
4561 *
4562 * This function accepts the 'level' argument in the form
4563 * of the commands [uplevel] and [upvar].
4564 *
4565 * For a function accepting a relative integer as level suitable
4566 * for implementation of [info level ?level?] check the
4567 * GetCallFrameByInteger() function. */
4568 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4569 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4570 {
4571 long level;
4572 const char *str;
4573 Jim_CallFrame *framePtr;
4574
4575 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4576 if (levelObjPtr) {
4577 str = Jim_GetString(levelObjPtr, NULL);
4578 if (str[0] == '#') {
4579 char *endptr;
4580 /* speedup for the toplevel (level #0) */
4581 if (str[1] == '0' && str[2] == '\0') {
4582 if (newLevelPtr) *newLevelPtr = 0;
4583 *framePtrPtr = interp->topFramePtr;
4584 return JIM_OK;
4585 }
4586
4587 level = strtol(str + 1, &endptr, 0);
4588 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4589 goto badlevel;
4590 /* An 'absolute' level is converted into the
4591 * 'number of levels to go back' format. */
4592 level = interp->numLevels - level;
4593 if (level < 0) goto badlevel;
4594 } else {
4595 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4596 goto badlevel;
4597 }
4598 } else {
4599 str = "1"; /* Needed to format the error message. */
4600 level = 1;
4601 }
4602 /* Lookup */
4603 framePtr = interp->framePtr;
4604 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4605 while (level--) {
4606 framePtr = framePtr->parentCallFrame;
4607 if (framePtr == NULL) goto badlevel;
4608 }
4609 *framePtrPtr = framePtr;
4610 return JIM_OK;
4611 badlevel:
4612 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4613 Jim_AppendStrings(interp, Jim_GetResult(interp),
4614 "bad level \"", str, "\"", NULL);
4615 return JIM_ERR;
4616 }
4617
4618 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4619 * as a relative integer like in the [info level ?level?] command. */
4620 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4621 Jim_CallFrame **framePtrPtr)
4622 {
4623 jim_wide level;
4624 jim_wide relLevel; /* level relative to the current one. */
4625 Jim_CallFrame *framePtr;
4626
4627 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4628 goto badlevel;
4629 if (level > 0) {
4630 /* An 'absolute' level is converted into the
4631 * 'number of levels to go back' format. */
4632 relLevel = interp->numLevels - level;
4633 } else {
4634 relLevel = -level;
4635 }
4636 /* Lookup */
4637 framePtr = interp->framePtr;
4638 while (relLevel--) {
4639 framePtr = framePtr->parentCallFrame;
4640 if (framePtr == NULL) goto badlevel;
4641 }
4642 *framePtrPtr = framePtr;
4643 return JIM_OK;
4644 badlevel:
4645 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4646 Jim_AppendStrings(interp, Jim_GetResult(interp),
4647 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4648 return JIM_ERR;
4649 }
4650
4651 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4652 {
4653 Jim_Free((void*)interp->errorFileName);
4654 interp->errorFileName = Jim_StrDup(filename);
4655 }
4656
4657 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4658 {
4659 interp->errorLine = linenr;
4660 }
4661
4662 static void JimResetStackTrace(Jim_Interp *interp)
4663 {
4664 Jim_DecrRefCount(interp, interp->stackTrace);
4665 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4666 Jim_IncrRefCount(interp->stackTrace);
4667 }
4668
4669 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4670 const char *filename, int linenr)
4671 {
4672 /* No need to add this dummy entry to the stack trace */
4673 if (strcmp(procname, "unknown") == 0) {
4674 return;
4675 }
4676
4677 if (Jim_IsShared(interp->stackTrace)) {
4678 interp->stackTrace =
4679 Jim_DuplicateObj(interp, interp->stackTrace);
4680 Jim_IncrRefCount(interp->stackTrace);
4681 }
4682 Jim_ListAppendElement(interp, interp->stackTrace,
4683 Jim_NewStringObj(interp, procname, -1));
4684 Jim_ListAppendElement(interp, interp->stackTrace,
4685 Jim_NewStringObj(interp, filename, -1));
4686 Jim_ListAppendElement(interp, interp->stackTrace,
4687 Jim_NewIntObj(interp, linenr));
4688 }
4689
4690 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4691 {
4692 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4693 assocEntryPtr->delProc = delProc;
4694 assocEntryPtr->data = data;
4695 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4696 }
4697
4698 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4699 {
4700 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4701 if (entryPtr != NULL) {
4702 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4703 return assocEntryPtr->data;
4704 }
4705 return NULL;
4706 }
4707
4708 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4709 {
4710 return Jim_DeleteHashEntry(&interp->assocData, key);
4711 }
4712
4713 int Jim_GetExitCode(Jim_Interp *interp) {
4714 return interp->exitCode;
4715 }
4716
4717 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4718 {
4719 if (fp != NULL) interp->cookie_stdin = fp;
4720 return interp->cookie_stdin;
4721 }
4722
4723 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4724 {
4725 if (fp != NULL) interp->cookie_stdout = fp;
4726 return interp->cookie_stdout;
4727 }
4728
4729 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4730 {
4731 if (fp != NULL) interp->cookie_stderr = fp;
4732 return interp->cookie_stderr;
4733 }
4734
4735 /* -----------------------------------------------------------------------------
4736 * Shared strings.
4737 * Every interpreter has an hash table where to put shared dynamically
4738 * allocate strings that are likely to be used a lot of times.
4739 * For example, in the 'source' object type, there is a pointer to
4740 * the filename associated with that object. Every script has a lot
4741 * of this objects with the identical file name, so it is wise to share
4742 * this info.
4743 *
4744 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4745 * returns the pointer to the shared string. Every time a reference
4746 * to the string is no longer used, the user should call
4747 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4748 * a given string, it is removed from the hash table.
4749 * ---------------------------------------------------------------------------*/
4750 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4751 {
4752 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4753
4754 if (he == NULL) {
4755 char *strCopy = Jim_StrDup(str);
4756
4757 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4758 return strCopy;
4759 } else {
4760 intptr_t refCount = (intptr_t) he->val;
4761
4762 refCount++;
4763 he->val = (void*) refCount;
4764 return he->key;
4765 }
4766 }
4767
4768 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4769 {
4770 intptr_t refCount;
4771 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4772
4773 if (he == NULL)
4774 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4775 "unknown shared string '%s'", str);
4776 refCount = (intptr_t) he->val;
4777 refCount--;
4778 if (refCount == 0) {
4779 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4780 } else {
4781 he->val = (void*) refCount;
4782 }
4783 }
4784
4785 /* -----------------------------------------------------------------------------
4786 * Integer object
4787 * ---------------------------------------------------------------------------*/
4788 #define JIM_INTEGER_SPACE 24
4789
4790 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4791 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4792
4793 static Jim_ObjType intObjType = {
4794 "int",
4795 NULL,
4796 NULL,
4797 UpdateStringOfInt,
4798 JIM_TYPE_NONE,
4799 };
4800
4801 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4802 {
4803 int len;
4804 char buf[JIM_INTEGER_SPACE + 1];
4805
4806 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4807 objPtr->bytes = Jim_Alloc(len + 1);
4808 memcpy(objPtr->bytes, buf, len + 1);
4809 objPtr->length = len;
4810 }
4811
4812 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4813 {
4814 jim_wide wideValue;
4815 const char *str;
4816
4817 /* Get the string representation */
4818 str = Jim_GetString(objPtr, NULL);
4819 /* Try to convert into a jim_wide */
4820 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4821 if (flags & JIM_ERRMSG) {
4822 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4823 Jim_AppendStrings(interp, Jim_GetResult(interp),
4824 "expected integer but got \"", str, "\"", NULL);
4825 }
4826 return JIM_ERR;
4827 }
4828 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4829 errno == ERANGE) {
4830 Jim_SetResultString(interp,
4831 "Integer value too big to be represented", -1);
4832 return JIM_ERR;
4833 }
4834 /* Free the old internal repr and set the new one. */
4835 Jim_FreeIntRep(interp, objPtr);
4836 objPtr->typePtr = &intObjType;
4837 objPtr->internalRep.wideValue = wideValue;
4838 return JIM_OK;
4839 }
4840
4841 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4842 {
4843 if (objPtr->typePtr != &intObjType &&
4844 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4845 return JIM_ERR;
4846 *widePtr = objPtr->internalRep.wideValue;
4847 return JIM_OK;
4848 }
4849
4850 /* Get a wide but does not set an error if the format is bad. */
4851 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4852 jim_wide *widePtr)
4853 {
4854 if (objPtr->typePtr != &intObjType &&
4855 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4856 return JIM_ERR;
4857 *widePtr = objPtr->internalRep.wideValue;
4858 return JIM_OK;
4859 }
4860
4861 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4862 {
4863 jim_wide wideValue;
4864 int retval;
4865
4866 retval = Jim_GetWide(interp, objPtr, &wideValue);
4867 if (retval == JIM_OK) {
4868 *longPtr = (long) wideValue;
4869 return JIM_OK;
4870 }
4871 return JIM_ERR;
4872 }
4873
4874 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4875 {
4876 if (Jim_IsShared(objPtr))
4877 Jim_Panic(interp,"Jim_SetWide called with shared object");
4878 if (objPtr->typePtr != &intObjType) {
4879 Jim_FreeIntRep(interp, objPtr);
4880 objPtr->typePtr = &intObjType;
4881 }
4882 Jim_InvalidateStringRep(objPtr);
4883 objPtr->internalRep.wideValue = wideValue;
4884 }
4885
4886 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4887 {
4888 Jim_Obj *objPtr;
4889
4890 objPtr = Jim_NewObj(interp);
4891 objPtr->typePtr = &intObjType;
4892 objPtr->bytes = NULL;
4893 objPtr->internalRep.wideValue = wideValue;
4894 return objPtr;
4895 }
4896
4897 /* -----------------------------------------------------------------------------
4898 * Double object
4899 * ---------------------------------------------------------------------------*/
4900 #define JIM_DOUBLE_SPACE 30
4901
4902 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4903 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4904
4905 static Jim_ObjType doubleObjType = {
4906 "double",
4907 NULL,
4908 NULL,
4909 UpdateStringOfDouble,
4910 JIM_TYPE_NONE,
4911 };
4912
4913 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4914 {
4915 int len;
4916 char buf[JIM_DOUBLE_SPACE + 1];
4917
4918 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4919 objPtr->bytes = Jim_Alloc(len + 1);
4920 memcpy(objPtr->bytes, buf, len + 1);
4921 objPtr->length = len;
4922 }
4923
4924 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4925 {
4926 double doubleValue;
4927 const char *str;
4928
4929 /* Get the string representation */
4930 str = Jim_GetString(objPtr, NULL);
4931 /* Try to convert into a double */
4932 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4933 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4934 Jim_AppendStrings(interp, Jim_GetResult(interp),
4935 "expected number but got '", str, "'", NULL);
4936 return JIM_ERR;
4937 }
4938 /* Free the old internal repr and set the new one. */
4939 Jim_FreeIntRep(interp, objPtr);
4940 objPtr->typePtr = &doubleObjType;
4941 objPtr->internalRep.doubleValue = doubleValue;
4942 return JIM_OK;
4943 }
4944
4945 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4946 {
4947 if (objPtr->typePtr != &doubleObjType &&
4948 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4949 return JIM_ERR;
4950 *doublePtr = objPtr->internalRep.doubleValue;
4951 return JIM_OK;
4952 }
4953
4954 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4955 {
4956 if (Jim_IsShared(objPtr))
4957 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4958 if (objPtr->typePtr != &doubleObjType) {
4959 Jim_FreeIntRep(interp, objPtr);
4960 objPtr->typePtr = &doubleObjType;
4961 }
4962 Jim_InvalidateStringRep(objPtr);
4963 objPtr->internalRep.doubleValue = doubleValue;
4964 }
4965
4966 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4967 {
4968 Jim_Obj *objPtr;
4969
4970 objPtr = Jim_NewObj(interp);
4971 objPtr->typePtr = &doubleObjType;
4972 objPtr->bytes = NULL;
4973 objPtr->internalRep.doubleValue = doubleValue;
4974 return objPtr;
4975 }
4976
4977 /* -----------------------------------------------------------------------------
4978 * List object
4979 * ---------------------------------------------------------------------------*/
4980 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4981 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4982 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4983 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4984 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4985
4986 /* Note that while the elements of the list may contain references,
4987 * the list object itself can't. This basically means that the
4988 * list object string representation as a whole can't contain references
4989 * that are not presents in the single elements. */
4990 static Jim_ObjType listObjType = {
4991 "list",
4992 FreeListInternalRep,
4993 DupListInternalRep,
4994 UpdateStringOfList,
4995 JIM_TYPE_NONE,
4996 };
4997
4998 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4999 {
5000 int i;
5001
5002 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5003 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5004 }
5005 Jim_Free(objPtr->internalRep.listValue.ele);
5006 }
5007
5008 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5009 {
5010 int i;
5011 JIM_NOTUSED(interp);
5012
5013 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5014 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5015 dupPtr->internalRep.listValue.ele =
5016 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5017 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5018 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5019 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5020 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5021 }
5022 dupPtr->typePtr = &listObjType;
5023 }
5024
5025 /* The following function checks if a given string can be encoded
5026 * into a list element without any kind of quoting, surrounded by braces,
5027 * or using escapes to quote. */
5028 #define JIM_ELESTR_SIMPLE 0
5029 #define JIM_ELESTR_BRACE 1
5030 #define JIM_ELESTR_QUOTE 2
5031 static int ListElementQuotingType(const char *s, int len)
5032 {
5033 int i, level, trySimple = 1;
5034
5035 /* Try with the SIMPLE case */
5036 if (len == 0) return JIM_ELESTR_BRACE;
5037 if (s[0] == '"' || s[0] == '{') {
5038 trySimple = 0;
5039 goto testbrace;
5040 }
5041 for (i = 0; i < len; i++) {
5042 switch (s[i]) {
5043 case ' ':
5044 case '$':
5045 case '"':
5046 case '[':
5047 case ']':
5048 case ';':
5049 case '\\':
5050 case '\r':
5051 case '\n':
5052 case '\t':
5053 case '\f':
5054 case '\v':
5055 trySimple = 0;
5056 case '{':
5057 case '}':
5058 goto testbrace;
5059 }
5060 }
5061 return JIM_ELESTR_SIMPLE;
5062
5063 testbrace:
5064 /* Test if it's possible to do with braces */
5065 if (s[len-1] == '\\' ||
5066 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5067 level = 0;
5068 for (i = 0; i < len; i++) {
5069 switch (s[i]) {
5070 case '{': level++; break;
5071 case '}': level--;
5072 if (level < 0) return JIM_ELESTR_QUOTE;
5073 break;
5074 case '\\':
5075 if (s[i + 1] == '\n')
5076 return JIM_ELESTR_QUOTE;
5077 else
5078 if (s[i + 1] != '\0') i++;
5079 break;
5080 }
5081 }
5082 if (level == 0) {
5083 if (!trySimple) return JIM_ELESTR_BRACE;
5084 for (i = 0; i < len; i++) {
5085 switch (s[i]) {
5086 case ' ':
5087 case '$':
5088 case '"':
5089 case '[':
5090 case ']':
5091 case ';':
5092 case '\\':
5093 case '\r':
5094 case '\n':
5095 case '\t':
5096 case '\f':
5097 case '\v':
5098 return JIM_ELESTR_BRACE;
5099 break;
5100 }
5101 }
5102 return JIM_ELESTR_SIMPLE;
5103 }
5104 return JIM_ELESTR_QUOTE;
5105 }
5106
5107 /* Returns the malloc-ed representation of a string
5108 * using backslash to quote special chars. */
5109 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5110 {
5111 char *q = Jim_Alloc(len*2 + 1), *p;
5112
5113 p = q;
5114 while (*s) {
5115 switch (*s) {
5116 case ' ':
5117 case '$':
5118 case '"':
5119 case '[':
5120 case ']':
5121 case '{':
5122 case '}':
5123 case ';':
5124 case '\\':
5125 *p++ = '\\';
5126 *p++ = *s++;
5127 break;
5128 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5129 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5130 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5131 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5132 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5133 default:
5134 *p++ = *s++;
5135 break;
5136 }
5137 }
5138 *p = '\0';
5139 *qlenPtr = p-q;
5140 return q;
5141 }
5142
5143 void UpdateStringOfList(struct Jim_Obj *objPtr)
5144 {
5145 int i, bufLen, realLength;
5146 const char *strRep;
5147 char *p;
5148 int *quotingType;
5149 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5150
5151 /* (Over) Estimate the space needed. */
5152 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5153 bufLen = 0;
5154 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5155 int len;
5156
5157 strRep = Jim_GetString(ele[i], &len);
5158 quotingType[i] = ListElementQuotingType(strRep, len);
5159 switch (quotingType[i]) {
5160 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5161 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5162 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5163 }
5164 bufLen++; /* elements separator. */
5165 }
5166 bufLen++;
5167
5168 /* Generate the string rep. */
5169 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5170 realLength = 0;
5171 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5172 int len, qlen;
5173 const char *strRep = Jim_GetString(ele[i], &len);
5174 char *q;
5175
5176 switch (quotingType[i]) {
5177 case JIM_ELESTR_SIMPLE:
5178 memcpy(p, strRep, len);
5179 p += len;
5180 realLength += len;
5181 break;
5182 case JIM_ELESTR_BRACE:
5183 *p++ = '{';
5184 memcpy(p, strRep, len);
5185 p += len;
5186 *p++ = '}';
5187 realLength += len + 2;
5188 break;
5189 case JIM_ELESTR_QUOTE:
5190 q = BackslashQuoteString(strRep, len, &qlen);
5191 memcpy(p, q, qlen);
5192 Jim_Free(q);
5193 p += qlen;
5194 realLength += qlen;
5195 break;
5196 }
5197 /* Add a separating space */
5198 if (i + 1 != objPtr->internalRep.listValue.len) {
5199 *p++ = ' ';
5200 realLength ++;
5201 }
5202 }
5203 *p = '\0'; /* nul term. */
5204 objPtr->length = realLength;
5205 Jim_Free(quotingType);
5206 }
5207
5208 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5209 {
5210 struct JimParserCtx parser;
5211 const char *str;
5212 int strLen;
5213
5214 /* Get the string representation */
5215 str = Jim_GetString(objPtr, &strLen);
5216
5217 /* Free the old internal repr just now and initialize the
5218 * new one just now. The string->list conversion can't fail. */
5219 Jim_FreeIntRep(interp, objPtr);
5220 objPtr->typePtr = &listObjType;
5221 objPtr->internalRep.listValue.len = 0;
5222 objPtr->internalRep.listValue.maxLen = 0;
5223 objPtr->internalRep.listValue.ele = NULL;
5224
5225 /* Convert into a list */
5226 JimParserInit(&parser, str, strLen, 1);
5227 while (!JimParserEof(&parser)) {
5228 char *token;
5229 int tokenLen, type;
5230 Jim_Obj *elementPtr;
5231
5232 JimParseList(&parser);
5233 if (JimParserTtype(&parser) != JIM_TT_STR &&
5234 JimParserTtype(&parser) != JIM_TT_ESC)
5235 continue;
5236 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5237 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5238 ListAppendElement(objPtr, elementPtr);
5239 }
5240 return JIM_OK;
5241 }
5242
5243 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5244 int len)
5245 {
5246 Jim_Obj *objPtr;
5247 int i;
5248
5249 objPtr = Jim_NewObj(interp);
5250 objPtr->typePtr = &listObjType;
5251 objPtr->bytes = NULL;
5252 objPtr->internalRep.listValue.ele = NULL;
5253 objPtr->internalRep.listValue.len = 0;
5254 objPtr->internalRep.listValue.maxLen = 0;
5255 for (i = 0; i < len; i++) {
5256 ListAppendElement(objPtr, elements[i]);
5257 }
5258 return objPtr;
5259 }
5260
5261 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5262 * length of the vector. Note that the user of this function should make
5263 * sure that the list object can't shimmer while the vector returned
5264 * is in use, this vector is the one stored inside the internal representation
5265 * of the list object. This function is not exported, extensions should
5266 * always access to the List object elements using Jim_ListIndex(). */
5267 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5268 Jim_Obj ***listVec)
5269 {
5270 Jim_ListLength(interp, listObj, argc);
5271 assert(listObj->typePtr == &listObjType);
5272 *listVec = listObj->internalRep.listValue.ele;
5273 }
5274
5275 /* ListSortElements type values */
5276 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5277 JIM_LSORT_NOCASE_DECR};
5278
5279 /* Sort the internal rep of a list. */
5280 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5281 {
5282 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5283 }
5284
5285 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5286 {
5287 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5288 }
5289
5290 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5291 {
5292 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5293 }
5294
5295 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5296 {
5297 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5298 }
5299
5300 /* Sort a list *in place*. MUST be called with non-shared objects. */
5301 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5302 {
5303 typedef int (qsort_comparator)(const void *, const void *);
5304 int (*fn)(Jim_Obj**, Jim_Obj**);
5305 Jim_Obj **vector;
5306 int len;
5307
5308 if (Jim_IsShared(listObjPtr))
5309 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5310 if (listObjPtr->typePtr != &listObjType)
5311 SetListFromAny(interp, listObjPtr);
5312
5313 vector = listObjPtr->internalRep.listValue.ele;
5314 len = listObjPtr->internalRep.listValue.len;
5315 switch (type) {
5316 case JIM_LSORT_ASCII: fn = ListSortString; break;
5317 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5318 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5319 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5320 default:
5321 fn = NULL; /* avoid warning */
5322 Jim_Panic(interp,"ListSort called with invalid sort type");
5323 }
5324 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5325 Jim_InvalidateStringRep(listObjPtr);
5326 }
5327
5328 /* This is the low-level function to append an element to a list.
5329 * The higher-level Jim_ListAppendElement() performs shared object
5330 * check and invalidate the string repr. This version is used
5331 * in the internals of the List Object and is not exported.
5332 *
5333 * NOTE: this function can be called only against objects
5334 * with internal type of List. */
5335 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5336 {
5337 int requiredLen = listPtr->internalRep.listValue.len + 1;
5338
5339 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5340 int maxLen = requiredLen * 2;
5341
5342 listPtr->internalRep.listValue.ele =
5343 Jim_Realloc(listPtr->internalRep.listValue.ele,
5344 sizeof(Jim_Obj*)*maxLen);
5345 listPtr->internalRep.listValue.maxLen = maxLen;
5346 }
5347 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5348 objPtr;
5349 listPtr->internalRep.listValue.len ++;
5350 Jim_IncrRefCount(objPtr);
5351 }
5352
5353 /* This is the low-level function to insert elements into a list.
5354 * The higher-level Jim_ListInsertElements() performs shared object
5355 * check and invalidate the string repr. This version is used
5356 * in the internals of the List Object and is not exported.
5357 *
5358 * NOTE: this function can be called only against objects
5359 * with internal type of List. */
5360 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5361 Jim_Obj *const *elemVec)
5362 {
5363 int currentLen = listPtr->internalRep.listValue.len;
5364 int requiredLen = currentLen + elemc;
5365 int i;
5366 Jim_Obj **point;
5367
5368 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5369 int maxLen = requiredLen * 2;
5370
5371 listPtr->internalRep.listValue.ele =
5372 Jim_Realloc(listPtr->internalRep.listValue.ele,
5373 sizeof(Jim_Obj*)*maxLen);
5374 listPtr->internalRep.listValue.maxLen = maxLen;
5375 }
5376 point = listPtr->internalRep.listValue.ele + index;
5377 memmove(point + elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5378 for (i = 0; i < elemc; ++i) {
5379 point[i] = elemVec[i];
5380 Jim_IncrRefCount(point[i]);
5381 }
5382 listPtr->internalRep.listValue.len += elemc;
5383 }
5384
5385 /* Appends every element of appendListPtr into listPtr.
5386 * Both have to be of the list type. */
5387 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5388 {
5389 int i, oldLen = listPtr->internalRep.listValue.len;
5390 int appendLen = appendListPtr->internalRep.listValue.len;
5391 int requiredLen = oldLen + appendLen;
5392
5393 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5394 int maxLen = requiredLen * 2;
5395
5396 listPtr->internalRep.listValue.ele =
5397 Jim_Realloc(listPtr->internalRep.listValue.ele,
5398 sizeof(Jim_Obj*)*maxLen);
5399 listPtr->internalRep.listValue.maxLen = maxLen;
5400 }
5401 for (i = 0; i < appendLen; i++) {
5402 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5403 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5404 Jim_IncrRefCount(objPtr);
5405 }
5406 listPtr->internalRep.listValue.len += appendLen;
5407 }
5408
5409 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5410 {
5411 if (Jim_IsShared(listPtr))
5412 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5413 if (listPtr->typePtr != &listObjType)
5414 SetListFromAny(interp, listPtr);
5415 Jim_InvalidateStringRep(listPtr);
5416 ListAppendElement(listPtr, objPtr);
5417 }
5418
5419 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5420 {
5421 if (Jim_IsShared(listPtr))
5422 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5423 if (listPtr->typePtr != &listObjType)
5424 SetListFromAny(interp, listPtr);
5425 Jim_InvalidateStringRep(listPtr);
5426 ListAppendList(listPtr, appendListPtr);
5427 }
5428
5429 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5430 {
5431 if (listPtr->typePtr != &listObjType)
5432 SetListFromAny(interp, listPtr);
5433 *intPtr = listPtr->internalRep.listValue.len;
5434 }
5435
5436 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5437 int objc, Jim_Obj *const *objVec)
5438 {
5439 if (Jim_IsShared(listPtr))
5440 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5441 if (listPtr->typePtr != &listObjType)
5442 SetListFromAny(interp, listPtr);
5443 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5444 index = listPtr->internalRep.listValue.len;
5445 else if (index < 0)
5446 index = 0;
5447 Jim_InvalidateStringRep(listPtr);
5448 ListInsertElements(listPtr, index, objc, objVec);
5449 }
5450
5451 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5452 Jim_Obj **objPtrPtr, int flags)
5453 {
5454 if (listPtr->typePtr != &listObjType)
5455 SetListFromAny(interp, listPtr);
5456 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5457 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5458 if (flags & JIM_ERRMSG) {
5459 Jim_SetResultString(interp,
5460 "list index out of range", -1);
5461 }
5462 return JIM_ERR;
5463 }
5464 if (index < 0)
5465 index = listPtr->internalRep.listValue.len + index;
5466 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5467 return JIM_OK;
5468 }
5469
5470 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5471 Jim_Obj *newObjPtr, int flags)
5472 {
5473 if (listPtr->typePtr != &listObjType)
5474 SetListFromAny(interp, listPtr);
5475 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5476 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5477 if (flags & JIM_ERRMSG) {
5478 Jim_SetResultString(interp,
5479 "list index out of range", -1);
5480 }
5481 return JIM_ERR;
5482 }
5483 if (index < 0)
5484 index = listPtr->internalRep.listValue.len + index;
5485 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5486 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5487 Jim_IncrRefCount(newObjPtr);
5488 return JIM_OK;
5489 }
5490
5491 /* Modify the list stored into the variable named 'varNamePtr'
5492 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5493 * with the new element 'newObjptr'. */
5494 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5495 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5496 {
5497 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5498 int shared, i, index;
5499
5500 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5501 if (objPtr == NULL)
5502 return JIM_ERR;
5503 if ((shared = Jim_IsShared(objPtr)))
5504 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5505 for (i = 0; i < indexc-1; i++) {
5506 listObjPtr = objPtr;
5507 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5508 goto err;
5509 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5510 JIM_ERRMSG) != JIM_OK) {
5511 goto err;
5512 }
5513 if (Jim_IsShared(objPtr)) {
5514 objPtr = Jim_DuplicateObj(interp, objPtr);
5515 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5516 }
5517 Jim_InvalidateStringRep(listObjPtr);
5518 }
5519 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5520 goto err;
5521 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5522 goto err;
5523 Jim_InvalidateStringRep(objPtr);
5524 Jim_InvalidateStringRep(varObjPtr);
5525 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5526 goto err;
5527 Jim_SetResult(interp, varObjPtr);
5528 return JIM_OK;
5529 err:
5530 if (shared) {
5531 Jim_FreeNewObj(interp, varObjPtr);
5532 }
5533 return JIM_ERR;
5534 }
5535
5536 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5537 {
5538 int i;
5539
5540 /* If all the objects in objv are lists without string rep.
5541 * it's possible to return a list as result, that's the
5542 * concatenation of all the lists. */
5543 for (i = 0; i < objc; i++) {
5544 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5545 break;
5546 }
5547 if (i == objc) {
5548 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5549 for (i = 0; i < objc; i++)
5550 Jim_ListAppendList(interp, objPtr, objv[i]);
5551 return objPtr;
5552 } else {
5553 /* Else... we have to glue strings together */
5554 int len = 0, objLen;
5555 char *bytes, *p;
5556
5557 /* Compute the length */
5558 for (i = 0; i < objc; i++) {
5559 Jim_GetString(objv[i], &objLen);
5560 len += objLen;
5561 }
5562 if (objc) len += objc-1;
5563 /* Create the string rep, and a stinrg object holding it. */
5564 p = bytes = Jim_Alloc(len + 1);
5565 for (i = 0; i < objc; i++) {
5566 const char *s = Jim_GetString(objv[i], &objLen);
5567 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5568 {
5569 s++; objLen--; len--;
5570 }
5571 while (objLen && (s[objLen-1] == ' ' ||
5572 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5573 objLen--; len--;
5574 }
5575 memcpy(p, s, objLen);
5576 p += objLen;
5577 if (objLen && i + 1 != objc) {
5578 *p++ = ' ';
5579 } else if (i + 1 != objc) {
5580 /* Drop the space calcuated for this
5581 * element that is instead null. */
5582 len--;
5583 }
5584 }
5585 *p = '\0';
5586 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5587 }
5588 }
5589
5590 /* Returns a list composed of the elements in the specified range.
5591 * first and start are directly accepted as Jim_Objects and
5592 * processed for the end?-index? case. */
5593 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5594 {
5595 int first, last;
5596 int len, rangeLen;
5597
5598 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5599 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5600 return NULL;
5601 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5602 first = JimRelToAbsIndex(len, first);
5603 last = JimRelToAbsIndex(len, last);
5604 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5605 return Jim_NewListObj(interp,
5606 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5607 }
5608
5609 /* -----------------------------------------------------------------------------
5610 * Dict object
5611 * ---------------------------------------------------------------------------*/
5612 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5613 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5614 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5615 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5616
5617 /* Dict HashTable Type.
5618 *
5619 * Keys and Values are Jim objects. */
5620
5621 unsigned int JimObjectHTHashFunction(const void *key)
5622 {
5623 const char *str;
5624 Jim_Obj *objPtr = (Jim_Obj*) key;
5625 int len, h;
5626
5627 str = Jim_GetString(objPtr, &len);
5628 h = Jim_GenHashFunction((unsigned char*)str, len);
5629 return h;
5630 }
5631
5632 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5633 {
5634 JIM_NOTUSED(privdata);
5635
5636 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5637 }
5638
5639 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5640 {
5641 Jim_Obj *objPtr = val;
5642
5643 Jim_DecrRefCount(interp, objPtr);
5644 }
5645
5646 static Jim_HashTableType JimDictHashTableType = {
5647 JimObjectHTHashFunction, /* hash function */
5648 NULL, /* key dup */
5649 NULL, /* val dup */
5650 JimObjectHTKeyCompare, /* key compare */
5651 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5652 JimObjectHTKeyValDestructor, /* key destructor */
5653 JimObjectHTKeyValDestructor /* val destructor */
5654 };
5655
5656 /* Note that while the elements of the dict may contain references,
5657 * the list object itself can't. This basically means that the
5658 * dict object string representation as a whole can't contain references
5659 * that are not presents in the single elements. */
5660 static Jim_ObjType dictObjType = {
5661 "dict",
5662 FreeDictInternalRep,
5663 DupDictInternalRep,
5664 UpdateStringOfDict,
5665 JIM_TYPE_NONE,
5666 };
5667
5668 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5669 {
5670 JIM_NOTUSED(interp);
5671
5672 Jim_FreeHashTable(objPtr->internalRep.ptr);
5673 Jim_Free(objPtr->internalRep.ptr);
5674 }
5675
5676 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5677 {
5678 Jim_HashTable *ht, *dupHt;
5679 Jim_HashTableIterator *htiter;
5680 Jim_HashEntry *he;
5681
5682 /* Create a new hash table */
5683 ht = srcPtr->internalRep.ptr;
5684 dupHt = Jim_Alloc(sizeof(*dupHt));
5685 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5686 if (ht->size != 0)
5687 Jim_ExpandHashTable(dupHt, ht->size);
5688 /* Copy every element from the source to the dup hash table */
5689 htiter = Jim_GetHashTableIterator(ht);
5690 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5691 const Jim_Obj *keyObjPtr = he->key;
5692 Jim_Obj *valObjPtr = he->val;
5693
5694 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5695 Jim_IncrRefCount(valObjPtr);
5696 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5697 }
5698 Jim_FreeHashTableIterator(htiter);
5699
5700 dupPtr->internalRep.ptr = dupHt;
5701 dupPtr->typePtr = &dictObjType;
5702 }
5703
5704 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5705 {
5706 int i, bufLen, realLength;
5707 const char *strRep;
5708 char *p;
5709 int *quotingType, objc;
5710 Jim_HashTable *ht;
5711 Jim_HashTableIterator *htiter;
5712 Jim_HashEntry *he;
5713 Jim_Obj **objv;
5714
5715 /* Trun the hash table into a flat vector of Jim_Objects. */
5716 ht = objPtr->internalRep.ptr;
5717 objc = ht->used*2;
5718 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5719 htiter = Jim_GetHashTableIterator(ht);
5720 i = 0;
5721 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5722 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5723 objv[i++] = he->val;
5724 }
5725 Jim_FreeHashTableIterator(htiter);
5726 /* (Over) Estimate the space needed. */
5727 quotingType = Jim_Alloc(sizeof(int)*objc);
5728 bufLen = 0;
5729 for (i = 0; i < objc; i++) {
5730 int len;
5731
5732 strRep = Jim_GetString(objv[i], &len);
5733 quotingType[i] = ListElementQuotingType(strRep, len);
5734 switch (quotingType[i]) {
5735 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5736 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5737 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5738 }
5739 bufLen++; /* elements separator. */
5740 }
5741 bufLen++;
5742
5743 /* Generate the string rep. */
5744 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5745 realLength = 0;
5746 for (i = 0; i < objc; i++) {
5747 int len, qlen;
5748 const char *strRep = Jim_GetString(objv[i], &len);
5749 char *q;
5750
5751 switch (quotingType[i]) {
5752 case JIM_ELESTR_SIMPLE:
5753 memcpy(p, strRep, len);
5754 p += len;
5755 realLength += len;
5756 break;
5757 case JIM_ELESTR_BRACE:
5758 *p++ = '{';
5759 memcpy(p, strRep, len);
5760 p += len;
5761 *p++ = '}';
5762 realLength += len + 2;
5763 break;
5764 case JIM_ELESTR_QUOTE:
5765 q = BackslashQuoteString(strRep, len, &qlen);
5766 memcpy(p, q, qlen);
5767 Jim_Free(q);
5768 p += qlen;
5769 realLength += qlen;
5770 break;
5771 }
5772 /* Add a separating space */
5773 if (i + 1 != objc) {
5774 *p++ = ' ';
5775 realLength ++;
5776 }
5777 }
5778 *p = '\0'; /* nul term. */
5779 objPtr->length = realLength;
5780 Jim_Free(quotingType);
5781 Jim_Free(objv);
5782 }
5783
5784 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5785 {
5786 struct JimParserCtx parser;
5787 Jim_HashTable *ht;
5788 Jim_Obj *objv[2];
5789 const char *str;
5790 int i, strLen;
5791
5792 /* Get the string representation */
5793 str = Jim_GetString(objPtr, &strLen);
5794
5795 /* Free the old internal repr just now and initialize the
5796 * new one just now. The string->list conversion can't fail. */
5797 Jim_FreeIntRep(interp, objPtr);
5798 ht = Jim_Alloc(sizeof(*ht));
5799 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5800 objPtr->typePtr = &dictObjType;
5801 objPtr->internalRep.ptr = ht;
5802
5803 /* Convert into a dict */
5804 JimParserInit(&parser, str, strLen, 1);
5805 i = 0;
5806 while (!JimParserEof(&parser)) {
5807 char *token;
5808 int tokenLen, type;
5809
5810 JimParseList(&parser);
5811 if (JimParserTtype(&parser) != JIM_TT_STR &&
5812 JimParserTtype(&parser) != JIM_TT_ESC)
5813 continue;
5814 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5815 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5816 if (i == 2) {
5817 i = 0;
5818 Jim_IncrRefCount(objv[0]);
5819 Jim_IncrRefCount(objv[1]);
5820 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5821 Jim_HashEntry *he;
5822 he = Jim_FindHashEntry(ht, objv[0]);
5823 Jim_DecrRefCount(interp, objv[0]);
5824 /* ATTENTION: const cast */
5825 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5826 he->val = objv[1];
5827 }
5828 }
5829 }
5830 if (i) {
5831 Jim_FreeNewObj(interp, objv[0]);
5832 objPtr->typePtr = NULL;
5833 Jim_FreeHashTable(ht);
5834 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5835 return JIM_ERR;
5836 }
5837 return JIM_OK;
5838 }
5839
5840 /* Dict object API */
5841
5842 /* Add an element to a dict. objPtr must be of the "dict" type.
5843 * The higer-level exported function is Jim_DictAddElement().
5844 * If an element with the specified key already exists, the value
5845 * associated is replaced with the new one.
5846 *
5847 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5848 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5849 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5850 {
5851 Jim_HashTable *ht = objPtr->internalRep.ptr;
5852
5853 if (valueObjPtr == NULL) { /* unset */
5854 Jim_DeleteHashEntry(ht, keyObjPtr);
5855 return;
5856 }
5857 Jim_IncrRefCount(keyObjPtr);
5858 Jim_IncrRefCount(valueObjPtr);
5859 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5860 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5861 Jim_DecrRefCount(interp, keyObjPtr);
5862 /* ATTENTION: const cast */
5863 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5864 he->val = valueObjPtr;
5865 }
5866 }
5867
5868 /* Add an element, higher-level interface for DictAddElement().
5869 * If valueObjPtr == NULL, the key is removed if it exists. */
5870 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5871 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5872 {
5873 if (Jim_IsShared(objPtr))
5874 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5875 if (objPtr->typePtr != &dictObjType) {
5876 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5877 return JIM_ERR;
5878 }
5879 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5880 Jim_InvalidateStringRep(objPtr);
5881 return JIM_OK;
5882 }
5883
5884 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5885 {
5886 Jim_Obj *objPtr;
5887 int i;
5888
5889 if (len % 2)
5890 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5891
5892 objPtr = Jim_NewObj(interp);
5893 objPtr->typePtr = &dictObjType;
5894 objPtr->bytes = NULL;
5895 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5896 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5897 for (i = 0; i < len; i += 2)
5898 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5899 return objPtr;
5900 }
5901
5902 /* Return the value associated to the specified dict key */
5903 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5904 Jim_Obj **objPtrPtr, int flags)
5905 {
5906 Jim_HashEntry *he;
5907 Jim_HashTable *ht;
5908
5909 if (dictPtr->typePtr != &dictObjType) {
5910 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5911 return JIM_ERR;
5912 }
5913 ht = dictPtr->internalRep.ptr;
5914 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5915 if (flags & JIM_ERRMSG) {
5916 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5917 Jim_AppendStrings(interp, Jim_GetResult(interp),
5918 "key \"", Jim_GetString(keyPtr, NULL),
5919 "\" not found in dictionary", NULL);
5920 }
5921 return JIM_ERR;
5922 }
5923 *objPtrPtr = he->val;
5924 return JIM_OK;
5925 }
5926
5927 /* Return the value associated to the specified dict keys */
5928 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5929 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5930 {
5931 Jim_Obj *objPtr = NULL;
5932 int i;
5933
5934 if (keyc == 0) {
5935 *objPtrPtr = dictPtr;
5936 return JIM_OK;
5937 }
5938
5939 for (i = 0; i < keyc; i++) {
5940 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5941 != JIM_OK)
5942 return JIM_ERR;
5943 dictPtr = objPtr;
5944 }
5945 *objPtrPtr = objPtr;
5946 return JIM_OK;
5947 }
5948
5949 /* Modify the dict stored into the variable named 'varNamePtr'
5950 * setting the element specified by the 'keyc' keys objects in 'keyv',
5951 * with the new value of the element 'newObjPtr'.
5952 *
5953 * If newObjPtr == NULL the operation is to remove the given key
5954 * from the dictionary. */
5955 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5956 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5957 {
5958 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5959 int shared, i;
5960
5961 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5962 if (objPtr == NULL) {
5963 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5964 return JIM_ERR;
5965 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5966 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5967 Jim_FreeNewObj(interp, varObjPtr);
5968 return JIM_ERR;
5969 }
5970 }
5971 if ((shared = Jim_IsShared(objPtr)))
5972 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5973 for (i = 0; i < keyc-1; i++) {
5974 dictObjPtr = objPtr;
5975
5976 /* Check if it's a valid dictionary */
5977 if (dictObjPtr->typePtr != &dictObjType) {
5978 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5979 goto err;
5980 }
5981 /* Check if the given key exists. */
5982 Jim_InvalidateStringRep(dictObjPtr);
5983 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5984 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5985 {
5986 /* This key exists at the current level.
5987 * Make sure it's not shared!. */
5988 if (Jim_IsShared(objPtr)) {
5989 objPtr = Jim_DuplicateObj(interp, objPtr);
5990 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5991 }
5992 } else {
5993 /* Key not found. If it's an [unset] operation
5994 * this is an error. Only the last key may not
5995 * exist. */
5996 if (newObjPtr == NULL)
5997 goto err;
5998 /* Otherwise set an empty dictionary
5999 * as key's value. */
6000 objPtr = Jim_NewDictObj(interp, NULL, 0);
6001 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6002 }
6003 }
6004 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6005 != JIM_OK)
6006 goto err;
6007 Jim_InvalidateStringRep(objPtr);
6008 Jim_InvalidateStringRep(varObjPtr);
6009 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6010 goto err;
6011 Jim_SetResult(interp, varObjPtr);
6012 return JIM_OK;
6013 err:
6014 if (shared) {
6015 Jim_FreeNewObj(interp, varObjPtr);
6016 }
6017 return JIM_ERR;
6018 }
6019
6020 /* -----------------------------------------------------------------------------
6021 * Index object
6022 * ---------------------------------------------------------------------------*/
6023 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6024 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6025
6026 static Jim_ObjType indexObjType = {
6027 "index",
6028 NULL,
6029 NULL,
6030 UpdateStringOfIndex,
6031 JIM_TYPE_NONE,
6032 };
6033
6034 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6035 {
6036 int len;
6037 char buf[JIM_INTEGER_SPACE + 1];
6038
6039 if (objPtr->internalRep.indexValue >= 0)
6040 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6041 else if (objPtr->internalRep.indexValue == -1)
6042 len = sprintf(buf, "end");
6043 else {
6044 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6045 }
6046 objPtr->bytes = Jim_Alloc(len + 1);
6047 memcpy(objPtr->bytes, buf, len + 1);
6048 objPtr->length = len;
6049 }
6050
6051 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6052 {
6053 int index, end = 0;
6054 const char *str;
6055
6056 /* Get the string representation */
6057 str = Jim_GetString(objPtr, NULL);
6058 /* Try to convert into an index */
6059 if (!strcmp(str, "end")) {
6060 index = 0;
6061 end = 1;
6062 } else {
6063 if (!strncmp(str, "end-", 4)) {
6064 str += 4;
6065 end = 1;
6066 }
6067 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6068 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6069 Jim_AppendStrings(interp, Jim_GetResult(interp),
6070 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6071 "must be integer or end?-integer?", NULL);
6072 return JIM_ERR;
6073 }
6074 }
6075 if (end) {
6076 if (index < 0)
6077 index = INT_MAX;
6078 else
6079 index = -(index + 1);
6080 } else if (!end && index < 0)
6081 index = -INT_MAX;
6082 /* Free the old internal repr and set the new one. */
6083 Jim_FreeIntRep(interp, objPtr);
6084 objPtr->typePtr = &indexObjType;
6085 objPtr->internalRep.indexValue = index;
6086 return JIM_OK;
6087 }
6088
6089 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6090 {
6091 /* Avoid shimmering if the object is an integer. */
6092 if (objPtr->typePtr == &intObjType) {
6093 jim_wide val = objPtr->internalRep.wideValue;
6094 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6095 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6096 return JIM_OK;
6097 }
6098 }
6099 if (objPtr->typePtr != &indexObjType &&
6100 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6101 return JIM_ERR;
6102 *indexPtr = objPtr->internalRep.indexValue;
6103 return JIM_OK;
6104 }
6105
6106 /* -----------------------------------------------------------------------------
6107 * Return Code Object.
6108 * ---------------------------------------------------------------------------*/
6109
6110 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6111
6112 static Jim_ObjType returnCodeObjType = {
6113 "return-code",
6114 NULL,
6115 NULL,
6116 NULL,
6117 JIM_TYPE_NONE,
6118 };
6119
6120 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6121 {
6122 const char *str;
6123 int strLen, returnCode;
6124 jim_wide wideValue;
6125
6126 /* Get the string representation */
6127 str = Jim_GetString(objPtr, &strLen);
6128 /* Try to convert into an integer */
6129 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6130 returnCode = (int) wideValue;
6131 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6132 returnCode = JIM_OK;
6133 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6134 returnCode = JIM_ERR;
6135 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6136 returnCode = JIM_RETURN;
6137 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6138 returnCode = JIM_BREAK;
6139 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6140 returnCode = JIM_CONTINUE;
6141 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6142 returnCode = JIM_EVAL;
6143 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6144 returnCode = JIM_EXIT;
6145 else {
6146 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6147 Jim_AppendStrings(interp, Jim_GetResult(interp),
6148 "expected return code but got '", str, "'",
6149 NULL);
6150 return JIM_ERR;
6151 }
6152 /* Free the old internal repr and set the new one. */
6153 Jim_FreeIntRep(interp, objPtr);
6154 objPtr->typePtr = &returnCodeObjType;
6155 objPtr->internalRep.returnCode = returnCode;
6156 return JIM_OK;
6157 }
6158
6159 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6160 {
6161 if (objPtr->typePtr != &returnCodeObjType &&
6162 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6163 return JIM_ERR;
6164 *intPtr = objPtr->internalRep.returnCode;
6165 return JIM_OK;
6166 }
6167
6168 /* -----------------------------------------------------------------------------
6169 * Expression Parsing
6170 * ---------------------------------------------------------------------------*/
6171 static int JimParseExprOperator(struct JimParserCtx *pc);
6172 static int JimParseExprNumber(struct JimParserCtx *pc);
6173 static int JimParseExprIrrational(struct JimParserCtx *pc);
6174
6175 /* Exrp's Stack machine operators opcodes. */
6176
6177 /* Binary operators (numbers) */
6178 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6179 #define JIM_EXPROP_MUL 0
6180 #define JIM_EXPROP_DIV 1
6181 #define JIM_EXPROP_MOD 2
6182 #define JIM_EXPROP_SUB 3
6183 #define JIM_EXPROP_ADD 4
6184 #define JIM_EXPROP_LSHIFT 5
6185 #define JIM_EXPROP_RSHIFT 6
6186 #define JIM_EXPROP_ROTL 7
6187 #define JIM_EXPROP_ROTR 8
6188 #define JIM_EXPROP_LT 9
6189 #define JIM_EXPROP_GT 10
6190 #define JIM_EXPROP_LTE 11
6191 #define JIM_EXPROP_GTE 12
6192 #define JIM_EXPROP_NUMEQ 13
6193 #define JIM_EXPROP_NUMNE 14
6194 #define JIM_EXPROP_BITAND 15
6195 #define JIM_EXPROP_BITXOR 16
6196 #define JIM_EXPROP_BITOR 17
6197 #define JIM_EXPROP_LOGICAND 18
6198 #define JIM_EXPROP_LOGICOR 19
6199 #define JIM_EXPROP_LOGICAND_LEFT 20
6200 #define JIM_EXPROP_LOGICOR_LEFT 21
6201 #define JIM_EXPROP_POW 22
6202 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6203
6204 /* Binary operators (strings) */
6205 #define JIM_EXPROP_STREQ 23
6206 #define JIM_EXPROP_STRNE 24
6207
6208 /* Unary operators (numbers) */
6209 #define JIM_EXPROP_NOT 25
6210 #define JIM_EXPROP_BITNOT 26
6211 #define JIM_EXPROP_UNARYMINUS 27
6212 #define JIM_EXPROP_UNARYPLUS 28
6213 #define JIM_EXPROP_LOGICAND_RIGHT 29
6214 #define JIM_EXPROP_LOGICOR_RIGHT 30
6215
6216 /* Ternary operators */
6217 #define JIM_EXPROP_TERNARY 31
6218
6219 /* Operands */
6220 #define JIM_EXPROP_NUMBER 32
6221 #define JIM_EXPROP_COMMAND 33
6222 #define JIM_EXPROP_VARIABLE 34
6223 #define JIM_EXPROP_DICTSUGAR 35
6224 #define JIM_EXPROP_SUBST 36
6225 #define JIM_EXPROP_STRING 37
6226
6227 /* Operators table */
6228 typedef struct Jim_ExprOperator {
6229 const char *name;
6230 int precedence;
6231 int arity;
6232 int opcode;
6233 } Jim_ExprOperator;
6234
6235 /* name - precedence - arity - opcode */
6236 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6237 {"!", 300, 1, JIM_EXPROP_NOT},
6238 {"~", 300, 1, JIM_EXPROP_BITNOT},
6239 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6240 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6241
6242 {"**", 250, 2, JIM_EXPROP_POW},
6243
6244 {"*", 200, 2, JIM_EXPROP_MUL},
6245 {"/", 200, 2, JIM_EXPROP_DIV},
6246 {"%", 200, 2, JIM_EXPROP_MOD},
6247
6248 {"-", 100, 2, JIM_EXPROP_SUB},
6249 {"+", 100, 2, JIM_EXPROP_ADD},
6250
6251 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6252 {">>>", 90, 3, JIM_EXPROP_ROTR},
6253 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6254 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6255
6256 {"<", 80, 2, JIM_EXPROP_LT},
6257 {">", 80, 2, JIM_EXPROP_GT},
6258 {"<=", 80, 2, JIM_EXPROP_LTE},
6259 {">=", 80, 2, JIM_EXPROP_GTE},
6260
6261 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6262 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6263
6264 {"eq", 60, 2, JIM_EXPROP_STREQ},
6265 {"ne", 60, 2, JIM_EXPROP_STRNE},
6266
6267 {"&", 50, 2, JIM_EXPROP_BITAND},
6268 {"^", 49, 2, JIM_EXPROP_BITXOR},
6269 {"|", 48, 2, JIM_EXPROP_BITOR},
6270
6271 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6272 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6273
6274 {"?", 5, 3, JIM_EXPROP_TERNARY},
6275 /* private operators */
6276 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6277 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6278 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6279 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6280 };
6281
6282 #define JIM_EXPR_OPERATORS_NUM \
6283 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6284
6285 int JimParseExpression(struct JimParserCtx *pc)
6286 {
6287 /* Discard spaces and quoted newline */
6288 while (*(pc->p) == ' ' ||
6289 *(pc->p) == '\t' ||
6290 *(pc->p) == '\r' ||
6291 *(pc->p) == '\n' ||
6292 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6293 pc->p++; pc->len--;
6294 }
6295
6296 if (pc->len == 0) {
6297 pc->tstart = pc->tend = pc->p;
6298 pc->tline = pc->linenr;
6299 pc->tt = JIM_TT_EOL;
6300 pc->eof = 1;
6301 return JIM_OK;
6302 }
6303 switch (*(pc->p)) {
6304 case '(':
6305 pc->tstart = pc->tend = pc->p;
6306 pc->tline = pc->linenr;
6307 pc->tt = JIM_TT_SUBEXPR_START;
6308 pc->p++; pc->len--;
6309 break;
6310 case ')':
6311 pc->tstart = pc->tend = pc->p;
6312 pc->tline = pc->linenr;
6313 pc->tt = JIM_TT_SUBEXPR_END;
6314 pc->p++; pc->len--;
6315 break;
6316 case '[':
6317 return JimParseCmd(pc);
6318 break;
6319 case '$':
6320 if (JimParseVar(pc) == JIM_ERR)
6321 return JimParseExprOperator(pc);
6322 else
6323 return JIM_OK;
6324 break;
6325 case '-':
6326 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6327 isdigit((int)*(pc->p + 1)))
6328 return JimParseExprNumber(pc);
6329 else
6330 return JimParseExprOperator(pc);
6331 break;
6332 case '0': case '1': case '2': case '3': case '4':
6333 case '5': case '6': case '7': case '8': case '9': case '.':
6334 return JimParseExprNumber(pc);
6335 break;
6336 case '"':
6337 case '{':
6338 /* Here it's possible to reuse the List String parsing. */
6339 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6340 return JimParseListStr(pc);
6341 break;
6342 case 'N': case 'I':
6343 case 'n': case 'i':
6344 if (JimParseExprIrrational(pc) == JIM_ERR)
6345 return JimParseExprOperator(pc);
6346 break;
6347 default:
6348 return JimParseExprOperator(pc);
6349 break;
6350 }
6351 return JIM_OK;
6352 }
6353
6354 int JimParseExprNumber(struct JimParserCtx *pc)
6355 {
6356 int allowdot = 1;
6357 int allowhex = 0;
6358
6359 pc->tstart = pc->p;
6360 pc->tline = pc->linenr;
6361 if (*pc->p == '-') {
6362 pc->p++; pc->len--;
6363 }
6364 while (isdigit((int)*pc->p)
6365 || (allowhex && isxdigit((int)*pc->p))
6366 || (allowdot && *pc->p == '.')
6367 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6368 (*pc->p == 'x' || *pc->p == 'X'))
6369 )
6370 {
6371 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6372 allowhex = 1;
6373 allowdot = 0;
6374 }
6375 if (*pc->p == '.')
6376 allowdot = 0;
6377 pc->p++; pc->len--;
6378 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6379 pc->p += 2; pc->len -= 2;
6380 }
6381 }
6382 pc->tend = pc->p-1;
6383 pc->tt = JIM_TT_EXPR_NUMBER;
6384 return JIM_OK;
6385 }
6386
6387 int JimParseExprIrrational(struct JimParserCtx *pc)
6388 {
6389 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6390 const char **token;
6391 for (token = Tokens; *token != NULL; token++) {
6392 int len = strlen(*token);
6393 if (strncmp(*token, pc->p, len) == 0) {
6394 pc->tstart = pc->p;
6395 pc->tend = pc->p + len - 1;
6396 pc->p += len; pc->len -= len;
6397 pc->tline = pc->linenr;
6398 pc->tt = JIM_TT_EXPR_NUMBER;
6399 return JIM_OK;
6400 }
6401 }
6402 return JIM_ERR;
6403 }
6404
6405 int JimParseExprOperator(struct JimParserCtx *pc)
6406 {
6407 int i;
6408 int bestIdx = -1, bestLen = 0;
6409
6410 /* Try to get the longest match. */
6411 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6412 const char *opname;
6413 int oplen;
6414
6415 opname = Jim_ExprOperators[i].name;
6416 if (opname == NULL) continue;
6417 oplen = strlen(opname);
6418
6419 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6420 bestIdx = i;
6421 bestLen = oplen;
6422 }
6423 }
6424 if (bestIdx == -1) return JIM_ERR;
6425 pc->tstart = pc->p;
6426 pc->tend = pc->p + bestLen - 1;
6427 pc->p += bestLen; pc->len -= bestLen;
6428 pc->tline = pc->linenr;
6429 pc->tt = JIM_TT_EXPR_OPERATOR;
6430 return JIM_OK;
6431 }
6432
6433 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6434 {
6435 int i;
6436 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6437 if (Jim_ExprOperators[i].name &&
6438 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6439 return &Jim_ExprOperators[i];
6440 return NULL;
6441 }
6442
6443 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6444 {
6445 int i;
6446 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6447 if (Jim_ExprOperators[i].opcode == opcode)
6448 return &Jim_ExprOperators[i];
6449 return NULL;
6450 }
6451
6452 /* -----------------------------------------------------------------------------
6453 * Expression Object
6454 * ---------------------------------------------------------------------------*/
6455 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6456 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6457 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6458
6459 static Jim_ObjType exprObjType = {
6460 "expression",
6461 FreeExprInternalRep,
6462 DupExprInternalRep,
6463 NULL,
6464 JIM_TYPE_REFERENCES,
6465 };
6466
6467 /* Expr bytecode structure */
6468 typedef struct ExprByteCode {
6469 int *opcode; /* Integer array of opcodes. */
6470 Jim_Obj **obj; /* Array of associated Jim Objects. */
6471 int len; /* Bytecode length */
6472 int inUse; /* Used for sharing. */
6473 } ExprByteCode;
6474
6475 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6476 {
6477 int i;
6478 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6479
6480 expr->inUse--;
6481 if (expr->inUse != 0) return;
6482 for (i = 0; i < expr->len; i++)
6483 Jim_DecrRefCount(interp, expr->obj[i]);
6484 Jim_Free(expr->opcode);
6485 Jim_Free(expr->obj);
6486 Jim_Free(expr);
6487 }
6488
6489 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6490 {
6491 JIM_NOTUSED(interp);
6492 JIM_NOTUSED(srcPtr);
6493
6494 /* Just returns an simple string. */
6495 dupPtr->typePtr = NULL;
6496 }
6497
6498 /* Add a new instruction to an expression bytecode structure. */
6499 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6500 int opcode, char *str, int len)
6501 {
6502 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6503 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6504 expr->opcode[expr->len] = opcode;
6505 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6506 Jim_IncrRefCount(expr->obj[expr->len]);
6507 expr->len++;
6508 }
6509
6510 /* Check if an expr program looks correct. */
6511 static int ExprCheckCorrectness(ExprByteCode *expr)
6512 {
6513 int i;
6514 int stacklen = 0;
6515
6516 /* Try to check if there are stack underflows,
6517 * and make sure at the end of the program there is
6518 * a single result on the stack. */
6519 for (i = 0; i < expr->len; i++) {
6520 switch (expr->opcode[i]) {
6521 case JIM_EXPROP_NUMBER:
6522 case JIM_EXPROP_STRING:
6523 case JIM_EXPROP_SUBST:
6524 case JIM_EXPROP_VARIABLE:
6525 case JIM_EXPROP_DICTSUGAR:
6526 case JIM_EXPROP_COMMAND:
6527 stacklen++;
6528 break;
6529 case JIM_EXPROP_NOT:
6530 case JIM_EXPROP_BITNOT:
6531 case JIM_EXPROP_UNARYMINUS:
6532 case JIM_EXPROP_UNARYPLUS:
6533 /* Unary operations */
6534 if (stacklen < 1) return JIM_ERR;
6535 break;
6536 case JIM_EXPROP_ADD:
6537 case JIM_EXPROP_SUB:
6538 case JIM_EXPROP_MUL:
6539 case JIM_EXPROP_DIV:
6540 case JIM_EXPROP_MOD:
6541 case JIM_EXPROP_LT:
6542 case JIM_EXPROP_GT:
6543 case JIM_EXPROP_LTE:
6544 case JIM_EXPROP_GTE:
6545 case JIM_EXPROP_ROTL:
6546 case JIM_EXPROP_ROTR:
6547 case JIM_EXPROP_LSHIFT:
6548 case JIM_EXPROP_RSHIFT:
6549 case JIM_EXPROP_NUMEQ:
6550 case JIM_EXPROP_NUMNE:
6551 case JIM_EXPROP_STREQ:
6552 case JIM_EXPROP_STRNE:
6553 case JIM_EXPROP_BITAND:
6554 case JIM_EXPROP_BITXOR:
6555 case JIM_EXPROP_BITOR:
6556 case JIM_EXPROP_LOGICAND:
6557 case JIM_EXPROP_LOGICOR:
6558 case JIM_EXPROP_POW:
6559 /* binary operations */
6560 if (stacklen < 2) return JIM_ERR;
6561 stacklen--;
6562 break;
6563 default:
6564 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6565 break;
6566 }
6567 }
6568 if (stacklen != 1) return JIM_ERR;
6569 return JIM_OK;
6570 }
6571
6572 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6573 ScriptObj *topLevelScript)
6574 {
6575 int i;
6576
6577 return;
6578 for (i = 0; i < expr->len; i++) {
6579 Jim_Obj *foundObjPtr;
6580
6581 if (expr->obj[i] == NULL) continue;
6582 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6583 NULL, expr->obj[i]);
6584 if (foundObjPtr != NULL) {
6585 Jim_IncrRefCount(foundObjPtr);
6586 Jim_DecrRefCount(interp, expr->obj[i]);
6587 expr->obj[i] = foundObjPtr;
6588 }
6589 }
6590 }
6591
6592 /* This procedure converts every occurrence of || and && opereators
6593 * in lazy unary versions.
6594 *
6595 * a b || is converted into:
6596 *
6597 * a <offset> |L b |R
6598 *
6599 * a b && is converted into:
6600 *
6601 * a <offset> &L b &R
6602 *
6603 * "|L" checks if 'a' is true:
6604 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6605 * the opcode just after |R.
6606 * 2) if it is false does nothing.
6607 * "|R" checks if 'b' is true:
6608 * 1) if it is true pushes 1, otherwise pushes 0.
6609 *
6610 * "&L" checks if 'a' is true:
6611 * 1) if it is true does nothing.
6612 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6613 * the opcode just after &R
6614 * "&R" checks if 'a' is true:
6615 * if it is true pushes 1, otherwise pushes 0.
6616 */
6617 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6618 {
6619 while (1) {
6620 int index = -1, leftindex, arity, i, offset;
6621 Jim_ExprOperator *op;
6622
6623 /* Search for || or && */
6624 for (i = 0; i < expr->len; i++) {
6625 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6626 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6627 index = i;
6628 break;
6629 }
6630 }
6631 if (index == -1) return;
6632 /* Search for the end of the first operator */
6633 leftindex = index-1;
6634 arity = 1;
6635 while (arity) {
6636 switch (expr->opcode[leftindex]) {
6637 case JIM_EXPROP_NUMBER:
6638 case JIM_EXPROP_COMMAND:
6639 case JIM_EXPROP_VARIABLE:
6640 case JIM_EXPROP_DICTSUGAR:
6641 case JIM_EXPROP_SUBST:
6642 case JIM_EXPROP_STRING:
6643 break;
6644 default:
6645 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6646 if (op == NULL) {
6647 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6648 }
6649 arity += op->arity;
6650 break;
6651 }
6652 arity--;
6653 leftindex--;
6654 }
6655 leftindex++;
6656 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6657 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6658 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6659 sizeof(int)*(expr->len-leftindex));
6660 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6661 sizeof(Jim_Obj*)*(expr->len-leftindex));
6662 expr->len += 2;
6663 index += 2;
6664 offset = (index-leftindex)-1;
6665 Jim_DecrRefCount(interp, expr->obj[index]);
6666 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6667 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6668 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6669 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6670 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6671 } else {
6672 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6673 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6674 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6675 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6676 }
6677 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6678 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6679 Jim_IncrRefCount(expr->obj[index]);
6680 Jim_IncrRefCount(expr->obj[leftindex]);
6681 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6682 }
6683 }
6684
6685 /* This method takes the string representation of an expression
6686 * and generates a program for the Expr's stack-based VM. */
6687 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6688 {
6689 int exprTextLen;
6690 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6691 struct JimParserCtx parser;
6692 int i, shareLiterals;
6693 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6694 Jim_Stack stack;
6695 Jim_ExprOperator *op;
6696
6697 /* Perform literal sharing with the current procedure
6698 * running only if this expression appears to be not generated
6699 * at runtime. */
6700 shareLiterals = objPtr->typePtr == &sourceObjType;
6701
6702 expr->opcode = NULL;
6703 expr->obj = NULL;
6704 expr->len = 0;
6705 expr->inUse = 1;
6706
6707 Jim_InitStack(&stack);
6708 JimParserInit(&parser, exprText, exprTextLen, 1);
6709 while (!JimParserEof(&parser)) {
6710 char *token;
6711 int len, type;
6712
6713 if (JimParseExpression(&parser) != JIM_OK) {
6714 Jim_SetResultString(interp, "Syntax error in expression", -1);
6715 goto err;
6716 }
6717 token = JimParserGetToken(&parser, &len, &type, NULL);
6718 if (type == JIM_TT_EOL) {
6719 Jim_Free(token);
6720 break;
6721 }
6722 switch (type) {
6723 case JIM_TT_STR:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6725 break;
6726 case JIM_TT_ESC:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6728 break;
6729 case JIM_TT_VAR:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6731 break;
6732 case JIM_TT_DICTSUGAR:
6733 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6734 break;
6735 case JIM_TT_CMD:
6736 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6737 break;
6738 case JIM_TT_EXPR_NUMBER:
6739 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6740 break;
6741 case JIM_TT_EXPR_OPERATOR:
6742 op = JimExprOperatorInfo(token);
6743 while (1) {
6744 Jim_ExprOperator *stackTopOp;
6745
6746 if (Jim_StackPeek(&stack) != NULL) {
6747 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6748 } else {
6749 stackTopOp = NULL;
6750 }
6751 if (Jim_StackLen(&stack) && op->arity != 1 &&
6752 stackTopOp && stackTopOp->precedence >= op->precedence)
6753 {
6754 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6755 Jim_StackPeek(&stack), -1);
6756 Jim_StackPop(&stack);
6757 } else {
6758 break;
6759 }
6760 }
6761 Jim_StackPush(&stack, token);
6762 break;
6763 case JIM_TT_SUBEXPR_START:
6764 Jim_StackPush(&stack, Jim_StrDup("("));
6765 Jim_Free(token);
6766 break;
6767 case JIM_TT_SUBEXPR_END:
6768 {
6769 int found = 0;
6770 while (Jim_StackLen(&stack)) {
6771 char *opstr = Jim_StackPop(&stack);
6772 if (!strcmp(opstr, "(")) {
6773 Jim_Free(opstr);
6774 found = 1;
6775 break;
6776 }
6777 op = JimExprOperatorInfo(opstr);
6778 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6779 }
6780 if (!found) {
6781 Jim_SetResultString(interp,
6782 "Unexpected close parenthesis", -1);
6783 goto err;
6784 }
6785 }
6786 Jim_Free(token);
6787 break;
6788 default:
6789 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6790 break;
6791 }
6792 }
6793 while (Jim_StackLen(&stack)) {
6794 char *opstr = Jim_StackPop(&stack);
6795 op = JimExprOperatorInfo(opstr);
6796 if (op == NULL && !strcmp(opstr, "(")) {
6797 Jim_Free(opstr);
6798 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6799 goto err;
6800 }
6801 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6802 }
6803 /* Check program correctness. */
6804 if (ExprCheckCorrectness(expr) != JIM_OK) {
6805 Jim_SetResultString(interp, "Invalid expression", -1);
6806 goto err;
6807 }
6808
6809 /* Free the stack used for the compilation. */
6810 Jim_FreeStackElements(&stack, Jim_Free);
6811 Jim_FreeStack(&stack);
6812
6813 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6814 ExprMakeLazy(interp, expr);
6815
6816 /* Perform literal sharing */
6817 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6818 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6819 if (bodyObjPtr->typePtr == &scriptObjType) {
6820 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6821 ExprShareLiterals(interp, expr, bodyScript);
6822 }
6823 }
6824
6825 /* Free the old internal rep and set the new one. */
6826 Jim_FreeIntRep(interp, objPtr);
6827 Jim_SetIntRepPtr(objPtr, expr);
6828 objPtr->typePtr = &exprObjType;
6829 return JIM_OK;
6830
6831 err: /* we jump here on syntax/compile errors. */
6832 Jim_FreeStackElements(&stack, Jim_Free);
6833 Jim_FreeStack(&stack);
6834 Jim_Free(expr->opcode);
6835 for (i = 0; i < expr->len; i++) {
6836 Jim_DecrRefCount(interp,expr->obj[i]);
6837 }
6838 Jim_Free(expr->obj);
6839 Jim_Free(expr);
6840 return JIM_ERR;
6841 }
6842
6843 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6844 {
6845 if (objPtr->typePtr != &exprObjType) {
6846 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6847 return NULL;
6848 }
6849 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6850 }
6851
6852 /* -----------------------------------------------------------------------------
6853 * Expressions evaluation.
6854 * Jim uses a specialized stack-based virtual machine for expressions,
6855 * that takes advantage of the fact that expr's operators
6856 * can't be redefined.
6857 *
6858 * Jim_EvalExpression() uses the bytecode compiled by
6859 * SetExprFromAny() method of the "expression" object.
6860 *
6861 * On success a Tcl Object containing the result of the evaluation
6862 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6863 * returned.
6864 * On error the function returns a retcode != to JIM_OK and set a suitable
6865 * error on the interp.
6866 * ---------------------------------------------------------------------------*/
6867 #define JIM_EE_STATICSTACK_LEN 10
6868
6869 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6870 Jim_Obj **exprResultPtrPtr)
6871 {
6872 ExprByteCode *expr;
6873 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6874 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6875
6876 Jim_IncrRefCount(exprObjPtr);
6877 expr = Jim_GetExpression(interp, exprObjPtr);
6878 if (!expr) {
6879 Jim_DecrRefCount(interp, exprObjPtr);
6880 return JIM_ERR; /* error in expression. */
6881 }
6882 /* In order to avoid that the internal repr gets freed due to
6883 * shimmering of the exprObjPtr's object, we make the internal rep
6884 * shared. */
6885 expr->inUse++;
6886
6887 /* The stack-based expr VM itself */
6888
6889 /* Stack allocation. Expr programs have the feature that
6890 * a program of length N can't require a stack longer than
6891 * N. */
6892 if (expr->len > JIM_EE_STATICSTACK_LEN)
6893 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6894 else
6895 stack = staticStack;
6896
6897 /* Execute every istruction */
6898 for (i = 0; i < expr->len; i++) {
6899 Jim_Obj *A, *B, *objPtr;
6900 jim_wide wA, wB, wC;
6901 double dA, dB, dC;
6902 const char *sA, *sB;
6903 int Alen, Blen, retcode;
6904 int opcode = expr->opcode[i];
6905
6906 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6907 stack[stacklen++] = expr->obj[i];
6908 Jim_IncrRefCount(expr->obj[i]);
6909 } else if (opcode == JIM_EXPROP_VARIABLE) {
6910 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6911 if (objPtr == NULL) {
6912 error = 1;
6913 goto err;
6914 }
6915 stack[stacklen++] = objPtr;
6916 Jim_IncrRefCount(objPtr);
6917 } else if (opcode == JIM_EXPROP_SUBST) {
6918 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6919 &objPtr, JIM_NONE)) != JIM_OK)
6920 {
6921 error = 1;
6922 errRetCode = retcode;
6923 goto err;
6924 }
6925 stack[stacklen++] = objPtr;
6926 Jim_IncrRefCount(objPtr);
6927 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6928 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6929 if (objPtr == NULL) {
6930 error = 1;
6931 goto err;
6932 }
6933 stack[stacklen++] = objPtr;
6934 Jim_IncrRefCount(objPtr);
6935 } else if (opcode == JIM_EXPROP_COMMAND) {
6936 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6937 error = 1;
6938 errRetCode = retcode;
6939 goto err;
6940 }
6941 stack[stacklen++] = interp->result;
6942 Jim_IncrRefCount(interp->result);
6943 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6944 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6945 {
6946 /* Note that there isn't to increment the
6947 * refcount of objects. the references are moved
6948 * from stack to A and B. */
6949 B = stack[--stacklen];
6950 A = stack[--stacklen];
6951
6952 /* --- Integer --- */
6953 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6954 (B->typePtr == &doubleObjType && !B->bytes) ||
6955 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6956 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6957 goto trydouble;
6958 }
6959 Jim_DecrRefCount(interp, A);
6960 Jim_DecrRefCount(interp, B);
6961 switch (expr->opcode[i]) {
6962 case JIM_EXPROP_ADD: wC = wA + wB; break;
6963 case JIM_EXPROP_SUB: wC = wA-wB; break;
6964 case JIM_EXPROP_MUL: wC = wA*wB; break;
6965 case JIM_EXPROP_LT: wC = wA < wB; break;
6966 case JIM_EXPROP_GT: wC = wA > wB; break;
6967 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6968 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6969 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6970 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6971 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6972 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6973 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6974 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6975 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6976 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6977 case JIM_EXPROP_LOGICAND_LEFT:
6978 if (wA == 0) {
6979 i += (int)wB;
6980 wC = 0;
6981 } else {
6982 continue;
6983 }
6984 break;
6985 case JIM_EXPROP_LOGICOR_LEFT:
6986 if (wA != 0) {
6987 i += (int)wB;
6988 wC = 1;
6989 } else {
6990 continue;
6991 }
6992 break;
6993 case JIM_EXPROP_DIV:
6994 if (wB == 0) goto divbyzero;
6995 wC = wA/wB;
6996 break;
6997 case JIM_EXPROP_MOD:
6998 if (wB == 0) goto divbyzero;
6999 wC = wA%wB;
7000 break;
7001 case JIM_EXPROP_ROTL: {
7002 /* uint32_t would be better. But not everyone has inttypes.h?*/
7003 unsigned long uA = (unsigned long)wA;
7004 #ifdef _MSC_VER
7005 wC = _rotl(uA,(unsigned long)wB);
7006 #else
7007 const unsigned int S = sizeof(unsigned long) * 8;
7008 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7009 #endif
7010 break;
7011 }
7012 case JIM_EXPROP_ROTR: {
7013 unsigned long uA = (unsigned long)wA;
7014 #ifdef _MSC_VER
7015 wC = _rotr(uA,(unsigned long)wB);
7016 #else
7017 const unsigned int S = sizeof(unsigned long) * 8;
7018 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7019 #endif
7020 break;
7021 }
7022
7023 default:
7024 wC = 0; /* avoid gcc warning */
7025 break;
7026 }
7027 stack[stacklen] = Jim_NewIntObj(interp, wC);
7028 Jim_IncrRefCount(stack[stacklen]);
7029 stacklen++;
7030 continue;
7031 trydouble:
7032 /* --- Double --- */
7033 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7034 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7035
7036 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7037 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7038 opcode = JIM_EXPROP_STRNE;
7039 goto retry_as_string;
7040 }
7041 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7042 opcode = JIM_EXPROP_STREQ;
7043 goto retry_as_string;
7044 }
7045 Jim_DecrRefCount(interp, A);
7046 Jim_DecrRefCount(interp, B);
7047 error = 1;
7048 goto err;
7049 }
7050 Jim_DecrRefCount(interp, A);
7051 Jim_DecrRefCount(interp, B);
7052 switch (expr->opcode[i]) {
7053 case JIM_EXPROP_ROTL:
7054 case JIM_EXPROP_ROTR:
7055 case JIM_EXPROP_LSHIFT:
7056 case JIM_EXPROP_RSHIFT:
7057 case JIM_EXPROP_BITAND:
7058 case JIM_EXPROP_BITXOR:
7059 case JIM_EXPROP_BITOR:
7060 case JIM_EXPROP_MOD:
7061 case JIM_EXPROP_POW:
7062 Jim_SetResultString(interp,
7063 "Got floating-point value where integer was expected", -1);
7064 error = 1;
7065 goto err;
7066 break;
7067 case JIM_EXPROP_ADD: dC = dA + dB; break;
7068 case JIM_EXPROP_SUB: dC = dA-dB; break;
7069 case JIM_EXPROP_MUL: dC = dA*dB; break;
7070 case JIM_EXPROP_LT: dC = dA < dB; break;
7071 case JIM_EXPROP_GT: dC = dA > dB; break;
7072 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7073 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7074 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7075 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7076 case JIM_EXPROP_LOGICAND_LEFT:
7077 if (dA == 0) {
7078 i += (int)dB;
7079 dC = 0;
7080 } else {
7081 continue;
7082 }
7083 break;
7084 case JIM_EXPROP_LOGICOR_LEFT:
7085 if (dA != 0) {
7086 i += (int)dB;
7087 dC = 1;
7088 } else {
7089 continue;
7090 }
7091 break;
7092 case JIM_EXPROP_DIV:
7093 if (dB == 0) goto divbyzero;
7094 dC = dA/dB;
7095 break;
7096 default:
7097 dC = 0; /* avoid gcc warning */
7098 break;
7099 }
7100 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7101 Jim_IncrRefCount(stack[stacklen]);
7102 stacklen++;
7103 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7104 B = stack[--stacklen];
7105 A = stack[--stacklen];
7106 retry_as_string:
7107 sA = Jim_GetString(A, &Alen);
7108 sB = Jim_GetString(B, &Blen);
7109 switch (opcode) {
7110 case JIM_EXPROP_STREQ:
7111 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7112 wC = 1;
7113 else
7114 wC = 0;
7115 break;
7116 case JIM_EXPROP_STRNE:
7117 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7118 wC = 1;
7119 else
7120 wC = 0;
7121 break;
7122 default:
7123 wC = 0; /* avoid gcc warning */
7124 break;
7125 }
7126 Jim_DecrRefCount(interp, A);
7127 Jim_DecrRefCount(interp, B);
7128 stack[stacklen] = Jim_NewIntObj(interp, wC);
7129 Jim_IncrRefCount(stack[stacklen]);
7130 stacklen++;
7131 } else if (opcode == JIM_EXPROP_NOT ||
7132 opcode == JIM_EXPROP_BITNOT ||
7133 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7134 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7135 /* Note that there isn't to increment the
7136 * refcount of objects. the references are moved
7137 * from stack to A and B. */
7138 A = stack[--stacklen];
7139
7140 /* --- Integer --- */
7141 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7142 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7143 goto trydouble_unary;
7144 }
7145 Jim_DecrRefCount(interp, A);
7146 switch (expr->opcode[i]) {
7147 case JIM_EXPROP_NOT: wC = !wA; break;
7148 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7149 case JIM_EXPROP_LOGICAND_RIGHT:
7150 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7151 default:
7152 wC = 0; /* avoid gcc warning */
7153 break;
7154 }
7155 stack[stacklen] = Jim_NewIntObj(interp, wC);
7156 Jim_IncrRefCount(stack[stacklen]);
7157 stacklen++;
7158 continue;
7159 trydouble_unary:
7160 /* --- Double --- */
7161 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7162 Jim_DecrRefCount(interp, A);
7163 error = 1;
7164 goto err;
7165 }
7166 Jim_DecrRefCount(interp, A);
7167 switch (expr->opcode[i]) {
7168 case JIM_EXPROP_NOT: dC = !dA; break;
7169 case JIM_EXPROP_LOGICAND_RIGHT:
7170 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7171 case JIM_EXPROP_BITNOT:
7172 Jim_SetResultString(interp,
7173 "Got floating-point value where integer was expected", -1);
7174 error = 1;
7175 goto err;
7176 break;
7177 default:
7178 dC = 0; /* avoid gcc warning */
7179 break;
7180 }
7181 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7182 Jim_IncrRefCount(stack[stacklen]);
7183 stacklen++;
7184 } else {
7185 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7186 }
7187 }
7188 err:
7189 /* There is no need to decerement the inUse field because
7190 * this reference is transfered back into the exprObjPtr. */
7191 Jim_FreeIntRep(interp, exprObjPtr);
7192 exprObjPtr->typePtr = &exprObjType;
7193 Jim_SetIntRepPtr(exprObjPtr, expr);
7194 Jim_DecrRefCount(interp, exprObjPtr);
7195 if (!error) {
7196 *exprResultPtrPtr = stack[0];
7197 Jim_IncrRefCount(stack[0]);
7198 errRetCode = JIM_OK;
7199 }
7200 for (i = 0; i < stacklen; i++) {
7201 Jim_DecrRefCount(interp, stack[i]);
7202 }
7203 if (stack != staticStack)
7204 Jim_Free(stack);
7205 return errRetCode;
7206 divbyzero:
7207 error = 1;
7208 Jim_SetResultString(interp, "Division by zero", -1);
7209 goto err;
7210 }
7211
7212 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7213 {
7214 int retcode;
7215 jim_wide wideValue;
7216 double doubleValue;
7217 Jim_Obj *exprResultPtr;
7218
7219 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7220 if (retcode != JIM_OK)
7221 return retcode;
7222 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7223 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7224 {
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 return JIM_ERR;
7227 } else {
7228 Jim_DecrRefCount(interp, exprResultPtr);
7229 *boolPtr = doubleValue != 0;
7230 return JIM_OK;
7231 }
7232 }
7233 Jim_DecrRefCount(interp, exprResultPtr);
7234 *boolPtr = wideValue != 0;
7235 return JIM_OK;
7236 }
7237
7238 /* -----------------------------------------------------------------------------
7239 * ScanFormat String Object
7240 * ---------------------------------------------------------------------------*/
7241
7242 /* This Jim_Obj will held a parsed representation of a format string passed to
7243 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7244 * to be parsed in its entirely first and then, if correct, can be used for
7245 * scanning. To avoid endless re-parsing, the parsed representation will be
7246 * stored in an internal representation and re-used for performance reason. */
7247
7248 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7249 * scanformat string. This part will later be used to extract information
7250 * out from the string to be parsed by Jim_ScanString */
7251
7252 typedef struct ScanFmtPartDescr {
7253 char type; /* Type of conversion (e.g. c, d, f) */
7254 char modifier; /* Modify type (e.g. l - long, h - short */
7255 size_t width; /* Maximal width of input to be converted */
7256 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7257 char *arg; /* Specification of a CHARSET conversion */
7258 char *prefix; /* Prefix to be scanned literally before conversion */
7259 } ScanFmtPartDescr;
7260
7261 /* The ScanFmtStringObj will held the internal representation of a scanformat
7262 * string parsed and separated in part descriptions. Furthermore it contains
7263 * the original string representation of the scanformat string to allow for
7264 * fast update of the Jim_Obj's string representation part.
7265 *
7266 * As add-on the internal object representation add some scratch pad area
7267 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7268 * memory for purpose of string scanning.
7269 *
7270 * The error member points to a static allocated string in case of a mal-
7271 * formed scanformat string or it contains '0' (NULL) in case of a valid
7272 * parse representation.
7273 *
7274 * The whole memory of the internal representation is allocated as a single
7275 * area of memory that will be internally separated. So freeing and duplicating
7276 * of such an object is cheap */
7277
7278 typedef struct ScanFmtStringObj {
7279 jim_wide size; /* Size of internal repr in bytes */
7280 char *stringRep; /* Original string representation */
7281 size_t count; /* Number of ScanFmtPartDescr contained */
7282 size_t convCount; /* Number of conversions that will assign */
7283 size_t maxPos; /* Max position index if XPG3 is used */
7284 const char *error; /* Ptr to error text (NULL if no error */
7285 char *scratch; /* Some scratch pad used by Jim_ScanString */
7286 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7287 } ScanFmtStringObj;
7288
7289
7290 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7291 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7292 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7293
7294 static Jim_ObjType scanFmtStringObjType = {
7295 "scanformatstring",
7296 FreeScanFmtInternalRep,
7297 DupScanFmtInternalRep,
7298 UpdateStringOfScanFmt,
7299 JIM_TYPE_NONE,
7300 };
7301
7302 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7303 {
7304 JIM_NOTUSED(interp);
7305 Jim_Free((char*)objPtr->internalRep.ptr);
7306 objPtr->internalRep.ptr = 0;
7307 }
7308
7309 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7310 {
7311 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7312 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7313
7314 JIM_NOTUSED(interp);
7315 memcpy(newVec, srcPtr->internalRep.ptr, size);
7316 dupPtr->internalRep.ptr = newVec;
7317 dupPtr->typePtr = &scanFmtStringObjType;
7318 }
7319
7320 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7321 {
7322 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7323
7324 objPtr->bytes = Jim_StrDup(bytes);
7325 objPtr->length = strlen(bytes);
7326 }
7327
7328 /* SetScanFmtFromAny will parse a given string and create the internal
7329 * representation of the format specification. In case of an error
7330 * the error data member of the internal representation will be set
7331 * to an descriptive error text and the function will be left with
7332 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7333 * specification */
7334
7335 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7336 {
7337 ScanFmtStringObj *fmtObj;
7338 char *buffer;
7339 int maxCount, i, approxSize, lastPos = -1;
7340 const char *fmt = objPtr->bytes;
7341 int maxFmtLen = objPtr->length;
7342 const char *fmtEnd = fmt + maxFmtLen;
7343 int curr;
7344
7345 Jim_FreeIntRep(interp, objPtr);
7346 /* Count how many conversions could take place maximally */
7347 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7348 if (fmt[i] == '%')
7349 ++maxCount;
7350 /* Calculate an approximation of the memory necessary */
7351 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7352 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7353 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7354 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7355 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7356 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7357 + 1; /* safety byte */
7358 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7359 memset(fmtObj, 0, approxSize);
7360 fmtObj->size = approxSize;
7361 fmtObj->maxPos = 0;
7362 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7363 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7364 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7365 buffer = fmtObj->stringRep + maxFmtLen + 1;
7366 objPtr->internalRep.ptr = fmtObj;
7367 objPtr->typePtr = &scanFmtStringObjType;
7368 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7369 int width = 0, skip;
7370 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7371 fmtObj->count++;
7372 descr->width = 0; /* Assume width unspecified */
7373 /* Overread and store any "literal" prefix */
7374 if (*fmt != '%' || fmt[1] == '%') {
7375 descr->type = 0;
7376 descr->prefix = &buffer[i];
7377 for (; fmt < fmtEnd; ++fmt) {
7378 if (*fmt == '%') {
7379 if (fmt[1] != '%') break;
7380 ++fmt;
7381 }
7382 buffer[i++] = *fmt;
7383 }
7384 buffer[i++] = 0;
7385 }
7386 /* Skip the conversion introducing '%' sign */
7387 ++fmt;
7388 /* End reached due to non-conversion literal only? */
7389 if (fmt >= fmtEnd)
7390 goto done;
7391 descr->pos = 0; /* Assume "natural" positioning */
7392 if (*fmt == '*') {
7393 descr->pos = -1; /* Okay, conversion will not be assigned */
7394 ++fmt;
7395 } else
7396 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7397 /* Check if next token is a number (could be width or pos */
7398 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7399 fmt += skip;
7400 /* Was the number a XPG3 position specifier? */
7401 if (descr->pos != -1 && *fmt == '$') {
7402 int prev;
7403 ++fmt;
7404 descr->pos = width;
7405 width = 0;
7406 /* Look if "natural" postioning and XPG3 one was mixed */
7407 if ((lastPos == 0 && descr->pos > 0)
7408 || (lastPos > 0 && descr->pos == 0)) {
7409 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7410 return JIM_ERR;
7411 }
7412 /* Look if this position was already used */
7413 for (prev = 0; prev < curr; ++prev) {
7414 if (fmtObj->descr[prev].pos == -1) continue;
7415 if (fmtObj->descr[prev].pos == descr->pos) {
7416 fmtObj->error = "same \"%n$\" conversion specifier "
7417 "used more than once";
7418 return JIM_ERR;
7419 }
7420 }
7421 /* Try to find a width after the XPG3 specifier */
7422 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7423 descr->width = width;
7424 fmt += skip;
7425 }
7426 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7427 fmtObj->maxPos = descr->pos;
7428 } else {
7429 /* Number was not a XPG3, so it has to be a width */
7430 descr->width = width;
7431 }
7432 }
7433 /* If positioning mode was undetermined yet, fix this */
7434 if (lastPos == -1)
7435 lastPos = descr->pos;
7436 /* Handle CHARSET conversion type ... */
7437 if (*fmt == '[') {
7438 int swapped = 1, beg = i, end, j;
7439 descr->type = '[';
7440 descr->arg = &buffer[i];
7441 ++fmt;
7442 if (*fmt == '^') buffer[i++] = *fmt++;
7443 if (*fmt == ']') buffer[i++] = *fmt++;
7444 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7445 if (*fmt != ']') {
7446 fmtObj->error = "unmatched [ in format string";
7447 return JIM_ERR;
7448 }
7449 end = i;
7450 buffer[i++] = 0;
7451 /* In case a range fence was given "backwards", swap it */
7452 while (swapped) {
7453 swapped = 0;
7454 for (j = beg + 1; j < end-1; ++j) {
7455 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7456 char tmp = buffer[j-1];
7457 buffer[j-1] = buffer[j + 1];
7458 buffer[j + 1] = tmp;
7459 swapped = 1;
7460 }
7461 }
7462 }
7463 } else {
7464 /* Remember any valid modifier if given */
7465 if (strchr("hlL", *fmt) != 0)
7466 descr->modifier = tolower((int)*fmt++);
7467
7468 descr->type = *fmt;
7469 if (strchr("efgcsndoxui", *fmt) == 0) {
7470 fmtObj->error = "bad scan conversion character";
7471 return JIM_ERR;
7472 } else if (*fmt == 'c' && descr->width != 0) {
7473 fmtObj->error = "field width may not be specified in %c "
7474 "conversion";
7475 return JIM_ERR;
7476 } else if (*fmt == 'u' && descr->modifier == 'l') {
7477 fmtObj->error = "unsigned wide not supported";
7478 return JIM_ERR;
7479 }
7480 }
7481 curr++;
7482 }
7483 done:
7484 if (fmtObj->convCount == 0) {
7485 fmtObj->error = "no any conversion specifier given";
7486 return JIM_ERR;
7487 }
7488 return JIM_OK;
7489 }
7490
7491 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7492
7493 #define FormatGetCnvCount(_fo_) \
7494 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7495 #define FormatGetMaxPos(_fo_) \
7496 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7497 #define FormatGetError(_fo_) \
7498 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7499
7500 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7501 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7502 * bitvector implementation in Jim? */
7503
7504 static int JimTestBit(const char *bitvec, char ch)
7505 {
7506 div_t pos = div(ch-1, 8);
7507 return bitvec[pos.quot] & (1 << pos.rem);
7508 }
7509
7510 static void JimSetBit(char *bitvec, char ch)
7511 {
7512 div_t pos = div(ch-1, 8);
7513 bitvec[pos.quot] |= (1 << pos.rem);
7514 }
7515
7516 #if 0 /* currently not used */
7517 static void JimClearBit(char *bitvec, char ch)
7518 {
7519 div_t pos = div(ch-1, 8);
7520 bitvec[pos.quot] &= ~(1 << pos.rem);
7521 }
7522 #endif
7523
7524 /* JimScanAString is used to scan an unspecified string that ends with
7525 * next WS, or a string that is specified via a charset. The charset
7526 * is currently implemented in a way to only allow for usage with
7527 * ASCII. Whenever we will switch to UNICODE, another idea has to
7528 * be born :-/
7529 *
7530 * FIXME: Works only with ASCII */
7531
7532 static Jim_Obj *
7533 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7534 {
7535 size_t i;
7536 Jim_Obj *result;
7537 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7538 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7539
7540 /* First init charset to nothing or all, depending if a specified
7541 * or an unspecified string has to be parsed */
7542 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7543 if (sdescr) {
7544 /* There was a set description given, that means we are parsing
7545 * a specified string. So we have to build a corresponding
7546 * charset reflecting the description */
7547 int notFlag = 0;
7548 /* Should the set be negated at the end? */
7549 if (*sdescr == '^') {
7550 notFlag = 1;
7551 ++sdescr;
7552 }
7553 /* Here '-' is meant literally and not to define a range */
7554 if (*sdescr == '-') {
7555 JimSetBit(charset, '-');
7556 ++sdescr;
7557 }
7558 while (*sdescr) {
7559 if (sdescr[1] == '-' && sdescr[2] != 0) {
7560 /* Handle range definitions */
7561 int i;
7562 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7563 JimSetBit(charset, (char)i);
7564 sdescr += 3;
7565 } else {
7566 /* Handle verbatim character definitions */
7567 JimSetBit(charset, *sdescr++);
7568 }
7569 }
7570 /* Negate the charset if there was a NOT given */
7571 for (i = 0; notFlag && i < sizeof(charset); ++i)
7572 charset[i] = ~charset[i];
7573 }
7574 /* And after all the mess above, the real work begin ... */
7575 while (str && *str) {
7576 if (!sdescr && isspace((int)*str))
7577 break; /* EOS via WS if unspecified */
7578 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7579 else break; /* EOS via mismatch if specified scanning */
7580 }
7581 *buffer = 0; /* Close the string properly ... */
7582 result = Jim_NewStringObj(interp, anchor, -1);
7583 Jim_Free(anchor); /* ... and free it afer usage */
7584 return result;
7585 }
7586
7587 /* ScanOneEntry will scan one entry out of the string passed as argument.
7588 * It use the sscanf() function for this task. After extracting and
7589 * converting of the value, the count of scanned characters will be
7590 * returned of -1 in case of no conversion tool place and string was
7591 * already scanned thru */
7592
7593 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7594 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7595 {
7596 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7597 ? sizeof(jim_wide) \
7598 : sizeof(double))
7599 char buffer[MAX_SIZE];
7600 char *value = buffer;
7601 const char *tok;
7602 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7603 size_t sLen = strlen(&str[pos]), scanned = 0;
7604 size_t anchor = pos;
7605 int i;
7606
7607 /* First pessimiticly assume, we will not scan anything :-) */
7608 *valObjPtr = 0;
7609 if (descr->prefix) {
7610 /* There was a prefix given before the conversion, skip it and adjust
7611 * the string-to-be-parsed accordingly */
7612 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7613 /* If prefix require, skip WS */
7614 if (isspace((int)descr->prefix[i]))
7615 while (str[pos] && isspace((int)str[pos])) ++pos;
7616 else if (descr->prefix[i] != str[pos])
7617 break; /* Prefix do not match here, leave the loop */
7618 else
7619 ++pos; /* Prefix matched so far, next round */
7620 }
7621 if (str[pos] == 0)
7622 return -1; /* All of str consumed: EOF condition */
7623 else if (descr->prefix[i] != 0)
7624 return 0; /* Not whole prefix consumed, no conversion possible */
7625 }
7626 /* For all but following conversion, skip leading WS */
7627 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7628 while (isspace((int)str[pos])) ++pos;
7629 /* Determine how much skipped/scanned so far */
7630 scanned = pos - anchor;
7631 if (descr->type == 'n') {
7632 /* Return pseudo conversion means: how much scanned so far? */
7633 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7634 } else if (str[pos] == 0) {
7635 /* Cannot scan anything, as str is totally consumed */
7636 return -1;
7637 } else {
7638 /* Processing of conversions follows ... */
7639 if (descr->width > 0) {
7640 /* Do not try to scan as fas as possible but only the given width.
7641 * To ensure this, we copy the part that should be scanned. */
7642 size_t tLen = descr->width > sLen ? sLen : descr->width;
7643 tok = Jim_StrDupLen(&str[pos], tLen);
7644 } else {
7645 /* As no width was given, simply refer to the original string */
7646 tok = &str[pos];
7647 }
7648 switch (descr->type) {
7649 case 'c':
7650 *valObjPtr = Jim_NewIntObj(interp, *tok);
7651 scanned += 1;
7652 break;
7653 case 'd': case 'o': case 'x': case 'u': case 'i': {
7654 jim_wide jwvalue = 0;
7655 long lvalue = 0;
7656 char *endp; /* Position where the number finished */
7657 int base = descr->type == 'o' ? 8
7658 : descr->type == 'x' ? 16
7659 : descr->type == 'i' ? 0
7660 : 10;
7661
7662 do {
7663 /* Try to scan a number with the given base */
7664 if (descr->modifier == 'l')
7665 {
7666 #ifdef HAVE_LONG_LONG_INT
7667 jwvalue = JimStrtoll(tok, &endp, base),
7668 #else
7669 jwvalue = strtol(tok, &endp, base),
7670 #endif
7671 memcpy(value, &jwvalue, sizeof(jim_wide));
7672 }
7673 else
7674 {
7675 if (descr->type == 'u')
7676 lvalue = strtoul(tok, &endp, base);
7677 else
7678 lvalue = strtol(tok, &endp, base);
7679 memcpy(value, &lvalue, sizeof(lvalue));
7680 }
7681 /* If scanning failed, and base was undetermined, simply
7682 * put it to 10 and try once more. This should catch the
7683 * case where %i begin to parse a number prefix (e.g.
7684 * '0x' but no further digits follows. This will be
7685 * handled as a ZERO followed by a char 'x' by Tcl */
7686 if (endp == tok && base == 0) base = 10;
7687 else break;
7688 } while (1);
7689 if (endp != tok) {
7690 /* There was some number sucessfully scanned! */
7691 if (descr->modifier == 'l')
7692 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7693 else
7694 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7695 /* Adjust the number-of-chars scanned so far */
7696 scanned += endp - tok;
7697 } else {
7698 /* Nothing was scanned. We have to determine if this
7699 * happened due to e.g. prefix mismatch or input str
7700 * exhausted */
7701 scanned = *tok ? 0 : -1;
7702 }
7703 break;
7704 }
7705 case 's': case '[': {
7706 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7707 scanned += Jim_Length(*valObjPtr);
7708 break;
7709 }
7710 case 'e': case 'f': case 'g': {
7711 char *endp;
7712
7713 double dvalue = strtod(tok, &endp);
7714 memcpy(value, &dvalue, sizeof(double));
7715 if (endp != tok) {
7716 /* There was some number sucessfully scanned! */
7717 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7718 /* Adjust the number-of-chars scanned so far */
7719 scanned += endp - tok;
7720 } else {
7721 /* Nothing was scanned. We have to determine if this
7722 * happened due to e.g. prefix mismatch or input str
7723 * exhausted */
7724 scanned = *tok ? 0 : -1;
7725 }
7726 break;
7727 }
7728 }
7729 /* If a substring was allocated (due to pre-defined width) do not
7730 * forget to free it */
7731 if (tok != &str[pos])
7732 Jim_Free((char*)tok);
7733 }
7734 return scanned;
7735 }
7736
7737 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7738 * string and returns all converted (and not ignored) values in a list back
7739 * to the caller. If an error occured, a NULL pointer will be returned */
7740
7741 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7742 Jim_Obj *fmtObjPtr, int flags)
7743 {
7744 size_t i, pos;
7745 int scanned = 1;
7746 const char *str = Jim_GetString(strObjPtr, 0);
7747 Jim_Obj *resultList = 0;
7748 Jim_Obj **resultVec =NULL;
7749 int resultc;
7750 Jim_Obj *emptyStr = 0;
7751 ScanFmtStringObj *fmtObj;
7752
7753 /* If format specification is not an object, convert it! */
7754 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7755 SetScanFmtFromAny(interp, fmtObjPtr);
7756 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7757 /* Check if format specification was valid */
7758 if (fmtObj->error != 0) {
7759 if (flags & JIM_ERRMSG)
7760 Jim_SetResultString(interp, fmtObj->error, -1);
7761 return 0;
7762 }
7763 /* Allocate a new "shared" empty string for all unassigned conversions */
7764 emptyStr = Jim_NewEmptyStringObj(interp);
7765 Jim_IncrRefCount(emptyStr);
7766 /* Create a list and fill it with empty strings up to max specified XPG3 */
7767 resultList = Jim_NewListObj(interp, 0, 0);
7768 if (fmtObj->maxPos > 0) {
7769 for (i = 0; i < fmtObj->maxPos; ++i)
7770 Jim_ListAppendElement(interp, resultList, emptyStr);
7771 JimListGetElements(interp, resultList, &resultc, &resultVec);
7772 }
7773 /* Now handle every partial format description */
7774 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7775 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7776 Jim_Obj *value = 0;
7777 /* Only last type may be "literal" w/o conversion - skip it! */
7778 if (descr->type == 0) continue;
7779 /* As long as any conversion could be done, we will proceed */
7780 if (scanned > 0)
7781 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7782 /* In case our first try results in EOF, we will leave */
7783 if (scanned == -1 && i == 0)
7784 goto eof;
7785 /* Advance next pos-to-be-scanned for the amount scanned already */
7786 pos += scanned;
7787 /* value == 0 means no conversion took place so take empty string */
7788 if (value == 0)
7789 value = Jim_NewEmptyStringObj(interp);
7790 /* If value is a non-assignable one, skip it */
7791 if (descr->pos == -1) {
7792 Jim_FreeNewObj(interp, value);
7793 } else if (descr->pos == 0)
7794 /* Otherwise append it to the result list if no XPG3 was given */
7795 Jim_ListAppendElement(interp, resultList, value);
7796 else if (resultVec[descr->pos-1] == emptyStr) {
7797 /* But due to given XPG3, put the value into the corr. slot */
7798 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7799 Jim_IncrRefCount(value);
7800 resultVec[descr->pos-1] = value;
7801 } else {
7802 /* Otherwise, the slot was already used - free obj and ERROR */
7803 Jim_FreeNewObj(interp, value);
7804 goto err;
7805 }
7806 }
7807 Jim_DecrRefCount(interp, emptyStr);
7808 return resultList;
7809 eof:
7810 Jim_DecrRefCount(interp, emptyStr);
7811 Jim_FreeNewObj(interp, resultList);
7812 return (Jim_Obj*)EOF;
7813 err:
7814 Jim_DecrRefCount(interp, emptyStr);
7815 Jim_FreeNewObj(interp, resultList);
7816 return 0;
7817 }
7818
7819 /* -----------------------------------------------------------------------------
7820 * Pseudo Random Number Generation
7821 * ---------------------------------------------------------------------------*/
7822 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7823 int seedLen);
7824
7825 /* Initialize the sbox with the numbers from 0 to 255 */
7826 static void JimPrngInit(Jim_Interp *interp)
7827 {
7828 int i;
7829 unsigned int seed[256];
7830
7831 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7832 for (i = 0; i < 256; i++)
7833 seed[i] = (rand() ^ time(NULL) ^ clock());
7834 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7835 }
7836
7837 /* Generates N bytes of random data */
7838 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7839 {
7840 Jim_PrngState *prng;
7841 unsigned char *destByte = (unsigned char*) dest;
7842 unsigned int si, sj, x;
7843
7844 /* initialization, only needed the first time */
7845 if (interp->prngState == NULL)
7846 JimPrngInit(interp);
7847 prng = interp->prngState;
7848 /* generates 'len' bytes of pseudo-random numbers */
7849 for (x = 0; x < len; x++) {
7850 prng->i = (prng->i + 1) & 0xff;
7851 si = prng->sbox[prng->i];
7852 prng->j = (prng->j + si) & 0xff;
7853 sj = prng->sbox[prng->j];
7854 prng->sbox[prng->i] = sj;
7855 prng->sbox[prng->j] = si;
7856 *destByte++ = prng->sbox[(si + sj)&0xff];
7857 }
7858 }
7859
7860 /* Re-seed the generator with user-provided bytes */
7861 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7862 int seedLen)
7863 {
7864 int i;
7865 unsigned char buf[256];
7866 Jim_PrngState *prng;
7867
7868 /* initialization, only needed the first time */
7869 if (interp->prngState == NULL)
7870 JimPrngInit(interp);
7871 prng = interp->prngState;
7872
7873 /* Set the sbox[i] with i */
7874 for (i = 0; i < 256; i++)
7875 prng->sbox[i] = i;
7876 /* Now use the seed to perform a random permutation of the sbox */
7877 for (i = 0; i < seedLen; i++) {
7878 unsigned char t;
7879
7880 t = prng->sbox[i&0xFF];
7881 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7882 prng->sbox[seed[i]] = t;
7883 }
7884 prng->i = prng->j = 0;
7885 /* discard the first 256 bytes of stream. */
7886 JimRandomBytes(interp, buf, 256);
7887 }
7888
7889 /* -----------------------------------------------------------------------------
7890 * Dynamic libraries support (WIN32 not supported)
7891 * ---------------------------------------------------------------------------*/
7892
7893 #ifdef JIM_DYNLIB
7894 #ifdef WIN32
7895 #define RTLD_LAZY 0
7896 void * dlopen(const char *path, int mode)
7897 {
7898 JIM_NOTUSED(mode);
7899
7900 return (void *)LoadLibraryA(path);
7901 }
7902 int dlclose(void *handle)
7903 {
7904 FreeLibrary((HANDLE)handle);
7905 return 0;
7906 }
7907 void *dlsym(void *handle, const char *symbol)
7908 {
7909 return GetProcAddress((HMODULE)handle, symbol);
7910 }
7911 static char win32_dlerror_string[121];
7912 const char *dlerror(void)
7913 {
7914 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7915 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7916 return win32_dlerror_string;
7917 }
7918 #endif /* WIN32 */
7919
7920 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7921 {
7922 Jim_Obj *libPathObjPtr;
7923 int prefixc, i;
7924 void *handle;
7925 int (*onload)(Jim_Interp *interp);
7926
7927 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7928 if (libPathObjPtr == NULL) {
7929 prefixc = 0;
7930 libPathObjPtr = NULL;
7931 } else {
7932 Jim_IncrRefCount(libPathObjPtr);
7933 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7934 }
7935
7936 for (i = -1; i < prefixc; i++) {
7937 if (i < 0) {
7938 handle = dlopen(pathName, RTLD_LAZY);
7939 } else {
7940 FILE *fp;
7941 char buf[JIM_PATH_LEN];
7942 const char *prefix;
7943 int prefixlen;
7944 Jim_Obj *prefixObjPtr;
7945
7946 buf[0] = '\0';
7947 if (Jim_ListIndex(interp, libPathObjPtr, i,
7948 &prefixObjPtr, JIM_NONE) != JIM_OK)
7949 continue;
7950 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7951 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7952 continue;
7953 if (*pathName == '/') {
7954 strcpy(buf, pathName);
7955 }
7956 else if (prefixlen && prefix[prefixlen-1] == '/')
7957 sprintf(buf, "%s%s", prefix, pathName);
7958 else
7959 sprintf(buf, "%s/%s", prefix, pathName);
7960 fp = fopen(buf, "r");
7961 if (fp == NULL)
7962 continue;
7963 fclose(fp);
7964 handle = dlopen(buf, RTLD_LAZY);
7965 }
7966 if (handle == NULL) {
7967 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7968 Jim_AppendStrings(interp, Jim_GetResult(interp),
7969 "error loading extension \"", pathName,
7970 "\": ", dlerror(), NULL);
7971 if (i < 0)
7972 continue;
7973 goto err;
7974 }
7975 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7976 Jim_SetResultString(interp,
7977 "No Jim_OnLoad symbol found on extension", -1);
7978 goto err;
7979 }
7980 if (onload(interp) == JIM_ERR) {
7981 dlclose(handle);
7982 goto err;
7983 }
7984 Jim_SetEmptyResult(interp);
7985 if (libPathObjPtr != NULL)
7986 Jim_DecrRefCount(interp, libPathObjPtr);
7987 return JIM_OK;
7988 }
7989 err:
7990 if (libPathObjPtr != NULL)
7991 Jim_DecrRefCount(interp, libPathObjPtr);
7992 return JIM_ERR;
7993 }
7994 #else /* JIM_DYNLIB */
7995 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7996 {
7997 JIM_NOTUSED(interp);
7998 JIM_NOTUSED(pathName);
7999
8000 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
8001 return JIM_ERR;
8002 }
8003 #endif/* JIM_DYNLIB */
8004
8005 /* -----------------------------------------------------------------------------
8006 * Packages handling
8007 * ---------------------------------------------------------------------------*/
8008
8009 #define JIM_PKG_ANY_VERSION -1
8010
8011 /* Convert a string of the type "1.2" into an integer.
8012 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8013 * to the integer with value 102 */
8014 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8015 int *intPtr, int flags)
8016 {
8017 char *copy;
8018 jim_wide major, minor;
8019 char *majorStr, *minorStr, *p;
8020
8021 if (v[0] == '\0') {
8022 *intPtr = JIM_PKG_ANY_VERSION;
8023 return JIM_OK;
8024 }
8025
8026 copy = Jim_StrDup(v);
8027 p = strchr(copy, '.');
8028 if (p == NULL) goto badfmt;
8029 *p = '\0';
8030 majorStr = copy;
8031 minorStr = p + 1;
8032
8033 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8034 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8035 goto badfmt;
8036 *intPtr = (int)(major*100 + minor);
8037 Jim_Free(copy);
8038 return JIM_OK;
8039
8040 badfmt:
8041 Jim_Free(copy);
8042 if (flags & JIM_ERRMSG) {
8043 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8044 Jim_AppendStrings(interp, Jim_GetResult(interp),
8045 "invalid package version '", v, "'", NULL);
8046 }
8047 return JIM_ERR;
8048 }
8049
8050 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8051 static int JimPackageMatchVersion(int needed, int actual, int flags)
8052 {
8053 if (needed == JIM_PKG_ANY_VERSION) return 1;
8054 if (flags & JIM_MATCHVER_EXACT) {
8055 return needed == actual;
8056 } else {
8057 return needed/100 == actual/100 && (needed <= actual);
8058 }
8059 }
8060
8061 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8062 int flags)
8063 {
8064 int intVersion;
8065 /* Check if the version format is ok */
8066 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8067 return JIM_ERR;
8068 /* If the package was already provided returns an error. */
8069 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8070 if (flags & JIM_ERRMSG) {
8071 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8072 Jim_AppendStrings(interp, Jim_GetResult(interp),
8073 "package '", name, "' was already provided", NULL);
8074 }
8075 return JIM_ERR;
8076 }
8077 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8078 return JIM_OK;
8079 }
8080
8081 #ifndef JIM_ANSIC
8082
8083 #ifndef WIN32
8084 # include <sys/types.h>
8085 # include <dirent.h>
8086 #else
8087 # include <io.h>
8088 /* Posix dirent.h compatiblity layer for WIN32.
8089 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8090 * Copyright Salvatore Sanfilippo ,2005.
8091 *
8092 * Permission to use, copy, modify, and distribute this software and its
8093 * documentation for any purpose is hereby granted without fee, provided
8094 * that this copyright and permissions notice appear in all copies and
8095 * derivatives.
8096 *
8097 * This software is supplied "as is" without express or implied warranty.
8098 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8099 */
8100
8101 struct dirent {
8102 char *d_name;
8103 };
8104
8105 typedef struct DIR {
8106 long handle; /* -1 for failed rewind */
8107 struct _finddata_t info;
8108 struct dirent result; /* d_name null iff first time */
8109 char *name; /* null-terminated char string */
8110 } DIR;
8111
8112 DIR *opendir(const char *name)
8113 {
8114 DIR *dir = 0;
8115
8116 if (name && name[0]) {
8117 size_t base_length = strlen(name);
8118 const char *all = /* search pattern must end with suitable wildcard */
8119 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8120
8121 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8122 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8123 {
8124 strcat(strcpy(dir->name, name), all);
8125
8126 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8127 dir->result.d_name = 0;
8128 else { /* rollback */
8129 Jim_Free(dir->name);
8130 Jim_Free(dir);
8131 dir = 0;
8132 }
8133 } else { /* rollback */
8134 Jim_Free(dir);
8135 dir = 0;
8136 errno = ENOMEM;
8137 }
8138 } else {
8139 errno = EINVAL;
8140 }
8141 return dir;
8142 }
8143
8144 int closedir(DIR *dir)
8145 {
8146 int result = -1;
8147
8148 if (dir) {
8149 if (dir->handle != -1)
8150 result = _findclose(dir->handle);
8151 Jim_Free(dir->name);
8152 Jim_Free(dir);
8153 }
8154 if (result == -1) /* map all errors to EBADF */
8155 errno = EBADF;
8156 return result;
8157 }
8158
8159 struct dirent *readdir(DIR *dir)
8160 {
8161 struct dirent *result = 0;
8162
8163 if (dir && dir->handle != -1) {
8164 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8165 result = &dir->result;
8166 result->d_name = dir->info.name;
8167 }
8168 } else {
8169 errno = EBADF;
8170 }
8171 return result;
8172 }
8173
8174 #endif /* WIN32 */
8175
8176 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8177 int prefixc, const char *pkgName, int pkgVer, int flags)
8178 {
8179 int bestVer = -1, i;
8180 int pkgNameLen = strlen(pkgName);
8181 char *bestPackage = NULL;
8182 struct dirent *de;
8183
8184 for (i = 0; i < prefixc; i++) {
8185 DIR *dir;
8186 char buf[JIM_PATH_LEN];
8187 int prefixLen;
8188
8189 if (prefixes[i] == NULL) continue;
8190 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8191 buf[JIM_PATH_LEN-1] = '\0';
8192 prefixLen = strlen(buf);
8193 if (prefixLen && buf[prefixLen-1] == '/')
8194 buf[prefixLen-1] = '\0';
8195
8196 if ((dir = opendir(buf)) == NULL) continue;
8197 while ((de = readdir(dir)) != NULL) {
8198 char *fileName = de->d_name;
8199 int fileNameLen = strlen(fileName);
8200
8201 if (strncmp(fileName, "jim-", 4) == 0 &&
8202 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8203 *(fileName + 4+pkgNameLen) == '-' &&
8204 fileNameLen > 4 && /* note that this is not really useful */
8205 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8206 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8207 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8208 {
8209 char ver[6]; /* xx.yy < nulterm> */
8210 char *p = strrchr(fileName, '.');
8211 int verLen, fileVer;
8212
8213 verLen = p - (fileName + 4+pkgNameLen + 1);
8214 if (verLen < 3 || verLen > 5) continue;
8215 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8216 ver[verLen] = '\0';
8217 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8218 != JIM_OK) continue;
8219 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8220 (bestVer == -1 || bestVer < fileVer))
8221 {
8222 bestVer = fileVer;
8223 Jim_Free(bestPackage);
8224 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8225 sprintf(bestPackage, "%s/%s", buf, fileName);
8226 }
8227 }
8228 }
8229 closedir(dir);
8230 }
8231 return bestPackage;
8232 }
8233
8234 #else /* JIM_ANSIC */
8235
8236 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8237 int prefixc, const char *pkgName, int pkgVer, int flags)
8238 {
8239 JIM_NOTUSED(interp);
8240 JIM_NOTUSED(prefixes);
8241 JIM_NOTUSED(prefixc);
8242 JIM_NOTUSED(pkgName);
8243 JIM_NOTUSED(pkgVer);
8244 JIM_NOTUSED(flags);
8245 return NULL;
8246 }
8247
8248 #endif /* JIM_ANSIC */
8249
8250 /* Search for a suitable package under every dir specified by jim_libpath
8251 * and load it if possible. If a suitable package was loaded with success
8252 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8253 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8254 int flags)
8255 {
8256 Jim_Obj *libPathObjPtr;
8257 char **prefixes, *best;
8258 int prefixc, i, retCode = JIM_OK;
8259
8260 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8261 if (libPathObjPtr == NULL) {
8262 prefixc = 0;
8263 libPathObjPtr = NULL;
8264 } else {
8265 Jim_IncrRefCount(libPathObjPtr);
8266 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8267 }
8268
8269 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8270 for (i = 0; i < prefixc; i++) {
8271 Jim_Obj *prefixObjPtr;
8272 if (Jim_ListIndex(interp, libPathObjPtr, i,
8273 &prefixObjPtr, JIM_NONE) != JIM_OK)
8274 {
8275 prefixes[i] = NULL;
8276 continue;
8277 }
8278 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8279 }
8280 /* Scan every directory to find the "best" package. */
8281 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8282 if (best != NULL) {
8283 char *p = strrchr(best, '.');
8284 /* Try to load/source it */
8285 if (p && strcmp(p, ".tcl") == 0) {
8286 retCode = Jim_EvalFile(interp, best);
8287 } else {
8288 retCode = Jim_LoadLibrary(interp, best);
8289 }
8290 } else {
8291 retCode = JIM_ERR;
8292 }
8293 Jim_Free(best);
8294 for (i = 0; i < prefixc; i++)
8295 Jim_Free(prefixes[i]);
8296 Jim_Free(prefixes);
8297 if (libPathObjPtr)
8298 Jim_DecrRefCount(interp, libPathObjPtr);
8299 return retCode;
8300 }
8301
8302 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8303 const char *ver, int flags)
8304 {
8305 Jim_HashEntry *he;
8306 int requiredVer;
8307
8308 /* Start with an empty error string */
8309 Jim_SetResultString(interp, "", 0);
8310
8311 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8312 return NULL;
8313 he = Jim_FindHashEntry(&interp->packages, name);
8314 if (he == NULL) {
8315 /* Try to load the package. */
8316 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8317 he = Jim_FindHashEntry(&interp->packages, name);
8318 if (he == NULL) {
8319 return "?";
8320 }
8321 return he->val;
8322 }
8323 /* No way... return an error. */
8324 if (flags & JIM_ERRMSG) {
8325 int len;
8326 Jim_GetString(Jim_GetResult(interp), &len);
8327 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8328 "Can't find package '", name, "'", NULL);
8329 }
8330 return NULL;
8331 } else {
8332 int actualVer;
8333 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8334 != JIM_OK)
8335 {
8336 return NULL;
8337 }
8338 /* Check if version matches. */
8339 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8340 Jim_AppendStrings(interp, Jim_GetResult(interp),
8341 "Package '", name, "' already loaded, but with version ",
8342 he->val, NULL);
8343 return NULL;
8344 }
8345 return he->val;
8346 }
8347 }
8348
8349 /* -----------------------------------------------------------------------------
8350 * Eval
8351 * ---------------------------------------------------------------------------*/
8352 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8353 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8354
8355 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8356 Jim_Obj *const *argv);
8357
8358 /* Handle calls to the [unknown] command */
8359 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8360 {
8361 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8362 int retCode;
8363
8364 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8365 * done here
8366 */
8367 if (interp->unknown_called) {
8368 return JIM_ERR;
8369 }
8370
8371 /* If the [unknown] command does not exists returns
8372 * just now */
8373 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8374 return JIM_ERR;
8375
8376 /* The object interp->unknown just contains
8377 * the "unknown" string, it is used in order to
8378 * avoid to lookup the unknown command every time
8379 * but instread to cache the result. */
8380 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8381 v = sv;
8382 else
8383 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8384 /* Make a copy of the arguments vector, but shifted on
8385 * the right of one position. The command name of the
8386 * command will be instead the first argument of the
8387 * [unknonw] call. */
8388 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8389 v[0] = interp->unknown;
8390 /* Call it */
8391 interp->unknown_called++;
8392 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8393 interp->unknown_called--;
8394
8395 /* Clean up */
8396 if (v != sv)
8397 Jim_Free(v);
8398 return retCode;
8399 }
8400
8401 /* Eval the object vector 'objv' composed of 'objc' elements.
8402 * Every element is used as single argument.
8403 * Jim_EvalObj() will call this function every time its object
8404 * argument is of "list" type, with no string representation.
8405 *
8406 * This is possible because the string representation of a
8407 * list object generated by the UpdateStringOfList is made
8408 * in a way that ensures that every list element is a different
8409 * command argument. */
8410 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8411 {
8412 int i, retcode;
8413 Jim_Cmd *cmdPtr;
8414
8415 /* Incr refcount of arguments. */
8416 for (i = 0; i < objc; i++)
8417 Jim_IncrRefCount(objv[i]);
8418 /* Command lookup */
8419 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8420 if (cmdPtr == NULL) {
8421 retcode = JimUnknown(interp, objc, objv);
8422 } else {
8423 /* Call it -- Make sure result is an empty object. */
8424 Jim_SetEmptyResult(interp);
8425 if (cmdPtr->cmdProc) {
8426 interp->cmdPrivData = cmdPtr->privData;
8427 retcode = cmdPtr->cmdProc(interp, objc, objv);
8428 if (retcode == JIM_ERR_ADDSTACK) {
8429 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8430 retcode = JIM_ERR;
8431 }
8432 } else {
8433 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8434 if (retcode == JIM_ERR) {
8435 JimAppendStackTrace(interp,
8436 Jim_GetString(objv[0], NULL), "", 1);
8437 }
8438 }
8439 }
8440 /* Decr refcount of arguments and return the retcode */
8441 for (i = 0; i < objc; i++)
8442 Jim_DecrRefCount(interp, objv[i]);
8443 return retcode;
8444 }
8445
8446 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8447 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8448 * The returned object has refcount = 0. */
8449 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8450 int tokens, Jim_Obj **objPtrPtr)
8451 {
8452 int totlen = 0, i, retcode;
8453 Jim_Obj **intv;
8454 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8455 Jim_Obj *objPtr;
8456 char *s;
8457
8458 if (tokens <= JIM_EVAL_SINTV_LEN)
8459 intv = sintv;
8460 else
8461 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8462 tokens);
8463 /* Compute every token forming the argument
8464 * in the intv objects vector. */
8465 for (i = 0; i < tokens; i++) {
8466 switch (token[i].type) {
8467 case JIM_TT_ESC:
8468 case JIM_TT_STR:
8469 intv[i] = token[i].objPtr;
8470 break;
8471 case JIM_TT_VAR:
8472 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8473 if (!intv[i]) {
8474 retcode = JIM_ERR;
8475 goto err;
8476 }
8477 break;
8478 case JIM_TT_DICTSUGAR:
8479 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8480 if (!intv[i]) {
8481 retcode = JIM_ERR;
8482 goto err;
8483 }
8484 break;
8485 case JIM_TT_CMD:
8486 retcode = Jim_EvalObj(interp, token[i].objPtr);
8487 if (retcode != JIM_OK)
8488 goto err;
8489 intv[i] = Jim_GetResult(interp);
8490 break;
8491 default:
8492 Jim_Panic(interp,
8493 "default token type reached "
8494 "in Jim_InterpolateTokens().");
8495 break;
8496 }
8497 Jim_IncrRefCount(intv[i]);
8498 /* Make sure there is a valid
8499 * string rep, and add the string
8500 * length to the total legnth. */
8501 Jim_GetString(intv[i], NULL);
8502 totlen += intv[i]->length;
8503 }
8504 /* Concatenate every token in an unique
8505 * object. */
8506 objPtr = Jim_NewStringObjNoAlloc(interp,
8507 NULL, 0);
8508 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8509 objPtr->length = totlen;
8510 for (i = 0; i < tokens; i++) {
8511 memcpy(s, intv[i]->bytes, intv[i]->length);
8512 s += intv[i]->length;
8513 Jim_DecrRefCount(interp, intv[i]);
8514 }
8515 objPtr->bytes[totlen] = '\0';
8516 /* Free the intv vector if not static. */
8517 if (tokens > JIM_EVAL_SINTV_LEN)
8518 Jim_Free(intv);
8519 *objPtrPtr = objPtr;
8520 return JIM_OK;
8521 err:
8522 i--;
8523 for (; i >= 0; i--)
8524 Jim_DecrRefCount(interp, intv[i]);
8525 if (tokens > JIM_EVAL_SINTV_LEN)
8526 Jim_Free(intv);
8527 return retcode;
8528 }
8529
8530 /* Helper of Jim_EvalObj() to perform argument expansion.
8531 * Basically this function append an argument to 'argv'
8532 * (and increments argc by reference accordingly), performing
8533 * expansion of the list object if 'expand' is non-zero, or
8534 * just adding objPtr to argv if 'expand' is zero. */
8535 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8536 int *argcPtr, int expand, Jim_Obj *objPtr)
8537 {
8538 if (!expand) {
8539 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8540 /* refcount of objPtr not incremented because
8541 * we are actually transfering a reference from
8542 * the old 'argv' to the expanded one. */
8543 (*argv)[*argcPtr] = objPtr;
8544 (*argcPtr)++;
8545 } else {
8546 int len, i;
8547
8548 Jim_ListLength(interp, objPtr, &len);
8549 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8550 for (i = 0; i < len; i++) {
8551 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8552 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8553 (*argcPtr)++;
8554 }
8555 /* The original object reference is no longer needed,
8556 * after the expansion it is no longer present on
8557 * the argument vector, but the single elements are
8558 * in its place. */
8559 Jim_DecrRefCount(interp, objPtr);
8560 }
8561 }
8562
8563 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8564 {
8565 int i, j = 0, len;
8566 ScriptObj *script;
8567 ScriptToken *token;
8568 int *cs; /* command structure array */
8569 int retcode = JIM_OK;
8570 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8571
8572 interp->errorFlag = 0;
8573
8574 /* If the object is of type "list" and there is no
8575 * string representation for this object, we can call
8576 * a specialized version of Jim_EvalObj() */
8577 if (scriptObjPtr->typePtr == &listObjType &&
8578 scriptObjPtr->internalRep.listValue.len &&
8579 scriptObjPtr->bytes == NULL) {
8580 Jim_IncrRefCount(scriptObjPtr);
8581 retcode = Jim_EvalObjVector(interp,
8582 scriptObjPtr->internalRep.listValue.len,
8583 scriptObjPtr->internalRep.listValue.ele);
8584 Jim_DecrRefCount(interp, scriptObjPtr);
8585 return retcode;
8586 }
8587
8588 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8589 script = Jim_GetScript(interp, scriptObjPtr);
8590 /* Now we have to make sure the internal repr will not be
8591 * freed on shimmering.
8592 *
8593 * Think for example to this:
8594 *
8595 * set x {llength $x; ... some more code ...}; eval $x
8596 *
8597 * In order to preserve the internal rep, we increment the
8598 * inUse field of the script internal rep structure. */
8599 script->inUse++;
8600
8601 token = script->token;
8602 len = script->len;
8603 cs = script->cmdStruct;
8604 i = 0; /* 'i' is the current token index. */
8605
8606 /* Reset the interpreter result. This is useful to
8607 * return the emtpy result in the case of empty program. */
8608 Jim_SetEmptyResult(interp);
8609
8610 /* Execute every command sequentially, returns on
8611 * error (i.e. if a command does not return JIM_OK) */
8612 while (i < len) {
8613 int expand = 0;
8614 int argc = *cs++; /* Get the number of arguments */
8615 Jim_Cmd *cmd;
8616
8617 /* Set the expand flag if needed. */
8618 if (argc == -1) {
8619 expand++;
8620 argc = *cs++;
8621 }
8622 /* Allocate the arguments vector */
8623 if (argc <= JIM_EVAL_SARGV_LEN)
8624 argv = sargv;
8625 else
8626 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8627 /* Populate the arguments objects. */
8628 for (j = 0; j < argc; j++) {
8629 int tokens = *cs++;
8630
8631 /* tokens is negative if expansion is needed.
8632 * for this argument. */
8633 if (tokens < 0) {
8634 tokens = (-tokens)-1;
8635 i++;
8636 }
8637 if (tokens == 1) {
8638 /* Fast path if the token does not
8639 * need interpolation */
8640 switch (token[i].type) {
8641 case JIM_TT_ESC:
8642 case JIM_TT_STR:
8643 argv[j] = token[i].objPtr;
8644 break;
8645 case JIM_TT_VAR:
8646 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8647 JIM_ERRMSG);
8648 if (!tmpObjPtr) {
8649 retcode = JIM_ERR;
8650 goto err;
8651 }
8652 argv[j] = tmpObjPtr;
8653 break;
8654 case JIM_TT_DICTSUGAR:
8655 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8656 if (!tmpObjPtr) {
8657 retcode = JIM_ERR;
8658 goto err;
8659 }
8660 argv[j] = tmpObjPtr;
8661 break;
8662 case JIM_TT_CMD:
8663 retcode = Jim_EvalObj(interp, token[i].objPtr);
8664 if (retcode != JIM_OK)
8665 goto err;
8666 argv[j] = Jim_GetResult(interp);
8667 break;
8668 default:
8669 Jim_Panic(interp,
8670 "default token type reached "
8671 "in Jim_EvalObj().");
8672 break;
8673 }
8674 Jim_IncrRefCount(argv[j]);
8675 i += 2;
8676 } else {
8677 /* For interpolation we call an helper
8678 * function doing the work for us. */
8679 if ((retcode = Jim_InterpolateTokens(interp,
8680 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8681 {
8682 goto err;
8683 }
8684 argv[j] = tmpObjPtr;
8685 Jim_IncrRefCount(argv[j]);
8686 i += tokens + 1;
8687 }
8688 }
8689 /* Handle {expand} expansion */
8690 if (expand) {
8691 int *ecs = cs - argc;
8692 int eargc = 0;
8693 Jim_Obj **eargv = NULL;
8694
8695 for (j = 0; j < argc; j++) {
8696 Jim_ExpandArgument(interp, &eargv, &eargc,
8697 ecs[j] < 0, argv[j]);
8698 }
8699 if (argv != sargv)
8700 Jim_Free(argv);
8701 argc = eargc;
8702 argv = eargv;
8703 j = argc;
8704 if (argc == 0) {
8705 /* Nothing to do with zero args. */
8706 Jim_Free(eargv);
8707 continue;
8708 }
8709 }
8710 /* Lookup the command to call */
8711 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8712 if (cmd != NULL) {
8713 /* Call it -- Make sure result is an empty object. */
8714 Jim_SetEmptyResult(interp);
8715 if (cmd->cmdProc) {
8716 interp->cmdPrivData = cmd->privData;
8717 retcode = cmd->cmdProc(interp, argc, argv);
8718 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8719 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8720 retcode = JIM_ERR;
8721 }
8722 } else {
8723 retcode = JimCallProcedure(interp, cmd, argc, argv);
8724 if (retcode == JIM_ERR) {
8725 JimAppendStackTrace(interp,
8726 Jim_GetString(argv[0], NULL), script->fileName,
8727 token[i-argc*2].linenr);
8728 }
8729 }
8730 } else {
8731 /* Call [unknown] */
8732 retcode = JimUnknown(interp, argc, argv);
8733 if (retcode == JIM_ERR) {
8734 JimAppendStackTrace(interp,
8735 "", script->fileName,
8736 token[i-argc*2].linenr);
8737 }
8738 }
8739 if (retcode != JIM_OK) {
8740 i -= argc*2; /* point to the command name. */
8741 goto err;
8742 }
8743 /* Decrement the arguments count */
8744 for (j = 0; j < argc; j++) {
8745 Jim_DecrRefCount(interp, argv[j]);
8746 }
8747
8748 if (argv != sargv) {
8749 Jim_Free(argv);
8750 argv = NULL;
8751 }
8752 }
8753 /* Note that we don't have to decrement inUse, because the
8754 * following code transfers our use of the reference again to
8755 * the script object. */
8756 j = 0; /* on normal termination, the argv array is already
8757 Jim_DecrRefCount-ed. */
8758 err:
8759 /* Handle errors. */
8760 if (retcode == JIM_ERR && !interp->errorFlag) {
8761 interp->errorFlag = 1;
8762 JimSetErrorFileName(interp, script->fileName);
8763 JimSetErrorLineNumber(interp, token[i].linenr);
8764 JimResetStackTrace(interp);
8765 }
8766 Jim_FreeIntRep(interp, scriptObjPtr);
8767 scriptObjPtr->typePtr = &scriptObjType;
8768 Jim_SetIntRepPtr(scriptObjPtr, script);
8769 Jim_DecrRefCount(interp, scriptObjPtr);
8770 for (i = 0; i < j; i++) {
8771 Jim_DecrRefCount(interp, argv[i]);
8772 }
8773 if (argv != sargv)
8774 Jim_Free(argv);
8775 return retcode;
8776 }
8777
8778 /* Call a procedure implemented in Tcl.
8779 * It's possible to speed-up a lot this function, currently
8780 * the callframes are not cached, but allocated and
8781 * destroied every time. What is expecially costly is
8782 * to create/destroy the local vars hash table every time.
8783 *
8784 * This can be fixed just implementing callframes caching
8785 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8786 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8787 Jim_Obj *const *argv)
8788 {
8789 int i, retcode;
8790 Jim_CallFrame *callFramePtr;
8791 int num_args;
8792
8793 /* Check arity */
8794 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8795 argc > cmd->arityMax)) {
8796 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8797 Jim_AppendStrings(interp, objPtr,
8798 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8799 (cmd->arityMin > 1) ? " " : "",
8800 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8801 Jim_SetResult(interp, objPtr);
8802 return JIM_ERR;
8803 }
8804 /* Check if there are too nested calls */
8805 if (interp->numLevels == interp->maxNestingDepth) {
8806 Jim_SetResultString(interp,
8807 "Too many nested calls. Infinite recursion?", -1);
8808 return JIM_ERR;
8809 }
8810 /* Create a new callframe */
8811 callFramePtr = JimCreateCallFrame(interp);
8812 callFramePtr->parentCallFrame = interp->framePtr;
8813 callFramePtr->argv = argv;
8814 callFramePtr->argc = argc;
8815 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8816 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8817 callFramePtr->staticVars = cmd->staticVars;
8818 Jim_IncrRefCount(cmd->argListObjPtr);
8819 Jim_IncrRefCount(cmd->bodyObjPtr);
8820 interp->framePtr = callFramePtr;
8821 interp->numLevels ++;
8822
8823 /* Set arguments */
8824 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8825
8826 /* If last argument is 'args', don't set it here */
8827 if (cmd->arityMax == -1) {
8828 num_args--;
8829 }
8830
8831 for (i = 0; i < num_args; i++) {
8832 Jim_Obj *argObjPtr=NULL;
8833 Jim_Obj *nameObjPtr=NULL;
8834 Jim_Obj *valueObjPtr=NULL;
8835
8836 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8837 if (i + 1 >= cmd->arityMin) {
8838 /* The name is the first element of the list */
8839 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8840 }
8841 else {
8842 /* The element arg is the name */
8843 nameObjPtr = argObjPtr;
8844 }
8845
8846 if (i + 1 >= argc) {
8847 /* No more values, so use default */
8848 /* The value is the second element of the list */
8849 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8850 }
8851 else {
8852 valueObjPtr = argv[i + 1];
8853 }
8854 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8855 }
8856 /* Set optional arguments */
8857 if (cmd->arityMax == -1) {
8858 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8859
8860 i++;
8861 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8862 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8863 Jim_SetVariable(interp, objPtr, listObjPtr);
8864 }
8865 /* Eval the body */
8866 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8867
8868 /* Destroy the callframe */
8869 interp->numLevels --;
8870 interp->framePtr = interp->framePtr->parentCallFrame;
8871 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8872 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8873 } else {
8874 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8875 }
8876 /* Handle the JIM_EVAL return code */
8877 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8878 int savedLevel = interp->evalRetcodeLevel;
8879
8880 interp->evalRetcodeLevel = interp->numLevels;
8881 while (retcode == JIM_EVAL) {
8882 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8883 Jim_IncrRefCount(resultScriptObjPtr);
8884 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8885 Jim_DecrRefCount(interp, resultScriptObjPtr);
8886 }
8887 interp->evalRetcodeLevel = savedLevel;
8888 }
8889 /* Handle the JIM_RETURN return code */
8890 if (retcode == JIM_RETURN) {
8891 retcode = interp->returnCode;
8892 interp->returnCode = JIM_OK;
8893 }
8894 return retcode;
8895 }
8896
8897 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8898 {
8899 int retval;
8900 Jim_Obj *scriptObjPtr;
8901
8902 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8903 Jim_IncrRefCount(scriptObjPtr);
8904
8905
8906 if (filename) {
8907 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8908 }
8909
8910 retval = Jim_EvalObj(interp, scriptObjPtr);
8911 Jim_DecrRefCount(interp, scriptObjPtr);
8912 return retval;
8913 }
8914
8915 int Jim_Eval(Jim_Interp *interp, const char *script)
8916 {
8917 return Jim_Eval_Named(interp, script, NULL, 0);
8918 }
8919
8920
8921
8922 /* Execute script in the scope of the global level */
8923 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8924 {
8925 Jim_CallFrame *savedFramePtr;
8926 int retval;
8927
8928 savedFramePtr = interp->framePtr;
8929 interp->framePtr = interp->topFramePtr;
8930 retval = Jim_Eval(interp, script);
8931 interp->framePtr = savedFramePtr;
8932 return retval;
8933 }
8934
8935 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8936 {
8937 Jim_CallFrame *savedFramePtr;
8938 int retval;
8939
8940 savedFramePtr = interp->framePtr;
8941 interp->framePtr = interp->topFramePtr;
8942 retval = Jim_EvalObj(interp, scriptObjPtr);
8943 interp->framePtr = savedFramePtr;
8944 /* Try to report the error (if any) via the bgerror proc */
8945 if (retval != JIM_OK) {
8946 Jim_Obj *objv[2];
8947
8948 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8949 objv[1] = Jim_GetResult(interp);
8950 Jim_IncrRefCount(objv[0]);
8951 Jim_IncrRefCount(objv[1]);
8952 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8953 /* Report the error to stderr. */
8954 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8955 Jim_PrintErrorMessage(interp);
8956 }
8957 Jim_DecrRefCount(interp, objv[0]);
8958 Jim_DecrRefCount(interp, objv[1]);
8959 }
8960 return retval;
8961 }
8962
8963 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8964 {
8965 char *prg = NULL;
8966 FILE *fp;
8967 int nread, totread, maxlen, buflen;
8968 int retval;
8969 Jim_Obj *scriptObjPtr;
8970
8971 if ((fp = fopen(filename, "r")) == NULL) {
8972 const int cwd_len = 2048;
8973 char *cwd = malloc(cwd_len);
8974 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8975 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8976 Jim_AppendStrings(interp, Jim_GetResult(interp),
8977 "Error loading script \"", filename, "\"",
8978 " cwd: ", cwd,
8979 " err: ", strerror(errno), NULL);
8980 free(cwd);
8981 return JIM_ERR;
8982 }
8983 buflen = 1024;
8984 maxlen = totread = 0;
8985 while (1) {
8986 if (maxlen < totread + buflen + 1) {
8987 maxlen = totread + buflen + 1;
8988 prg = Jim_Realloc(prg, maxlen);
8989 }
8990 /* do not use Jim_fread() - this is really a file */
8991 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8992 totread += nread;
8993 }
8994 prg[totread] = '\0';
8995 /* do not use Jim_fclose() - this is really a file */
8996 fclose(fp);
8997
8998 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8999 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
9000 Jim_IncrRefCount(scriptObjPtr);
9001 retval = Jim_EvalObj(interp, scriptObjPtr);
9002 Jim_DecrRefCount(interp, scriptObjPtr);
9003 return retval;
9004 }
9005
9006 /* -----------------------------------------------------------------------------
9007 * Subst
9008 * ---------------------------------------------------------------------------*/
9009 static int JimParseSubstStr(struct JimParserCtx *pc)
9010 {
9011 pc->tstart = pc->p;
9012 pc->tline = pc->linenr;
9013 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9014 pc->p++; pc->len--;
9015 }
9016 pc->tend = pc->p-1;
9017 pc->tt = JIM_TT_ESC;
9018 return JIM_OK;
9019 }
9020
9021 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9022 {
9023 int retval;
9024
9025 if (pc->len == 0) {
9026 pc->tstart = pc->tend = pc->p;
9027 pc->tline = pc->linenr;
9028 pc->tt = JIM_TT_EOL;
9029 pc->eof = 1;
9030 return JIM_OK;
9031 }
9032 switch (*pc->p) {
9033 case '[':
9034 retval = JimParseCmd(pc);
9035 if (flags & JIM_SUBST_NOCMD) {
9036 pc->tstart--;
9037 pc->tend++;
9038 pc->tt = (flags & JIM_SUBST_NOESC) ?
9039 JIM_TT_STR : JIM_TT_ESC;
9040 }
9041 return retval;
9042 break;
9043 case '$':
9044 if (JimParseVar(pc) == JIM_ERR) {
9045 pc->tstart = pc->tend = pc->p++; pc->len--;
9046 pc->tline = pc->linenr;
9047 pc->tt = JIM_TT_STR;
9048 } else {
9049 if (flags & JIM_SUBST_NOVAR) {
9050 pc->tstart--;
9051 if (flags & JIM_SUBST_NOESC)
9052 pc->tt = JIM_TT_STR;
9053 else
9054 pc->tt = JIM_TT_ESC;
9055 if (*pc->tstart == '{') {
9056 pc->tstart--;
9057 if (*(pc->tend + 1))
9058 pc->tend++;
9059 }
9060 }
9061 }
9062 break;
9063 default:
9064 retval = JimParseSubstStr(pc);
9065 if (flags & JIM_SUBST_NOESC)
9066 pc->tt = JIM_TT_STR;
9067 return retval;
9068 break;
9069 }
9070 return JIM_OK;
9071 }
9072
9073 /* The subst object type reuses most of the data structures and functions
9074 * of the script object. Script's data structures are a bit more complex
9075 * for what is needed for [subst]itution tasks, but the reuse helps to
9076 * deal with a single data structure at the cost of some more memory
9077 * usage for substitutions. */
9078 static Jim_ObjType substObjType = {
9079 "subst",
9080 FreeScriptInternalRep,
9081 DupScriptInternalRep,
9082 NULL,
9083 JIM_TYPE_REFERENCES,
9084 };
9085
9086 /* This method takes the string representation of an object
9087 * as a Tcl string where to perform [subst]itution, and generates
9088 * the pre-parsed internal representation. */
9089 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9090 {
9091 int scriptTextLen;
9092 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9093 struct JimParserCtx parser;
9094 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9095
9096 script->len = 0;
9097 script->csLen = 0;
9098 script->commands = 0;
9099 script->token = NULL;
9100 script->cmdStruct = NULL;
9101 script->inUse = 1;
9102 script->substFlags = flags;
9103 script->fileName = NULL;
9104
9105 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9106 while (1) {
9107 char *token;
9108 int len, type, linenr;
9109
9110 JimParseSubst(&parser, flags);
9111 if (JimParserEof(&parser)) break;
9112 token = JimParserGetToken(&parser, &len, &type, &linenr);
9113 ScriptObjAddToken(interp, script, token, len, type,
9114 NULL, linenr);
9115 }
9116 /* Free the old internal rep and set the new one. */
9117 Jim_FreeIntRep(interp, objPtr);
9118 Jim_SetIntRepPtr(objPtr, script);
9119 objPtr->typePtr = &scriptObjType;
9120 return JIM_OK;
9121 }
9122
9123 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9124 {
9125 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9126
9127 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9128 SetSubstFromAny(interp, objPtr, flags);
9129 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9130 }
9131
9132 /* Performs commands,variables,blackslashes substitution,
9133 * storing the result object (with refcount 0) into
9134 * resObjPtrPtr. */
9135 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9136 Jim_Obj **resObjPtrPtr, int flags)
9137 {
9138 ScriptObj *script;
9139 ScriptToken *token;
9140 int i, len, retcode = JIM_OK;
9141 Jim_Obj *resObjPtr, *savedResultObjPtr;
9142
9143 script = Jim_GetSubst(interp, substObjPtr, flags);
9144 #ifdef JIM_OPTIMIZATION
9145 /* Fast path for a very common case with array-alike syntax,
9146 * that's: $foo($bar) */
9147 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9148 Jim_Obj *varObjPtr = script->token[0].objPtr;
9149
9150 Jim_IncrRefCount(varObjPtr);
9151 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9152 if (resObjPtr == NULL) {
9153 Jim_DecrRefCount(interp, varObjPtr);
9154 return JIM_ERR;
9155 }
9156 Jim_DecrRefCount(interp, varObjPtr);
9157 *resObjPtrPtr = resObjPtr;
9158 return JIM_OK;
9159 }
9160 #endif
9161
9162 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9163 /* In order to preserve the internal rep, we increment the
9164 * inUse field of the script internal rep structure. */
9165 script->inUse++;
9166
9167 token = script->token;
9168 len = script->len;
9169
9170 /* Save the interp old result, to set it again before
9171 * to return. */
9172 savedResultObjPtr = interp->result;
9173 Jim_IncrRefCount(savedResultObjPtr);
9174
9175 /* Perform the substitution. Starts with an empty object
9176 * and adds every token (performing the appropriate
9177 * var/command/escape substitution). */
9178 resObjPtr = Jim_NewStringObj(interp, "", 0);
9179 for (i = 0; i < len; i++) {
9180 Jim_Obj *objPtr;
9181
9182 switch (token[i].type) {
9183 case JIM_TT_STR:
9184 case JIM_TT_ESC:
9185 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9186 break;
9187 case JIM_TT_VAR:
9188 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9189 if (objPtr == NULL) goto err;
9190 Jim_IncrRefCount(objPtr);
9191 Jim_AppendObj(interp, resObjPtr, objPtr);
9192 Jim_DecrRefCount(interp, objPtr);
9193 break;
9194 case JIM_TT_DICTSUGAR:
9195 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9196 if (!objPtr) {
9197 retcode = JIM_ERR;
9198 goto err;
9199 }
9200 break;
9201 case JIM_TT_CMD:
9202 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9203 goto err;
9204 Jim_AppendObj(interp, resObjPtr, interp->result);
9205 break;
9206 default:
9207 Jim_Panic(interp,
9208 "default token type (%d) reached "
9209 "in Jim_SubstObj().", token[i].type);
9210 break;
9211 }
9212 }
9213 ok:
9214 if (retcode == JIM_OK)
9215 Jim_SetResult(interp, savedResultObjPtr);
9216 Jim_DecrRefCount(interp, savedResultObjPtr);
9217 /* Note that we don't have to decrement inUse, because the
9218 * following code transfers our use of the reference again to
9219 * the script object. */
9220 Jim_FreeIntRep(interp, substObjPtr);
9221 substObjPtr->typePtr = &scriptObjType;
9222 Jim_SetIntRepPtr(substObjPtr, script);
9223 Jim_DecrRefCount(interp, substObjPtr);
9224 *resObjPtrPtr = resObjPtr;
9225 return retcode;
9226 err:
9227 Jim_FreeNewObj(interp, resObjPtr);
9228 retcode = JIM_ERR;
9229 goto ok;
9230 }
9231
9232 /* -----------------------------------------------------------------------------
9233 * API Input/Export functions
9234 * ---------------------------------------------------------------------------*/
9235
9236 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9237 {
9238 Jim_HashEntry *he;
9239
9240 he = Jim_FindHashEntry(&interp->stub, funcname);
9241 if (!he)
9242 return JIM_ERR;
9243 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9244 return JIM_OK;
9245 }
9246
9247 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9248 {
9249 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9250 }
9251
9252 #define JIM_REGISTER_API(name) \
9253 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9254
9255 void JimRegisterCoreApi(Jim_Interp *interp)
9256 {
9257 interp->getApiFuncPtr = Jim_GetApi;
9258 JIM_REGISTER_API(Alloc);
9259 JIM_REGISTER_API(Free);
9260 JIM_REGISTER_API(Eval);
9261 JIM_REGISTER_API(Eval_Named);
9262 JIM_REGISTER_API(EvalGlobal);
9263 JIM_REGISTER_API(EvalFile);
9264 JIM_REGISTER_API(EvalObj);
9265 JIM_REGISTER_API(EvalObjBackground);
9266 JIM_REGISTER_API(EvalObjVector);
9267 JIM_REGISTER_API(InitHashTable);
9268 JIM_REGISTER_API(ExpandHashTable);
9269 JIM_REGISTER_API(AddHashEntry);
9270 JIM_REGISTER_API(ReplaceHashEntry);
9271 JIM_REGISTER_API(DeleteHashEntry);
9272 JIM_REGISTER_API(FreeHashTable);
9273 JIM_REGISTER_API(FindHashEntry);
9274 JIM_REGISTER_API(ResizeHashTable);
9275 JIM_REGISTER_API(GetHashTableIterator);
9276 JIM_REGISTER_API(NextHashEntry);
9277 JIM_REGISTER_API(NewObj);
9278 JIM_REGISTER_API(FreeObj);
9279 JIM_REGISTER_API(InvalidateStringRep);
9280 JIM_REGISTER_API(InitStringRep);
9281 JIM_REGISTER_API(DuplicateObj);
9282 JIM_REGISTER_API(GetString);
9283 JIM_REGISTER_API(Length);
9284 JIM_REGISTER_API(InvalidateStringRep);
9285 JIM_REGISTER_API(NewStringObj);
9286 JIM_REGISTER_API(NewStringObjNoAlloc);
9287 JIM_REGISTER_API(AppendString);
9288 JIM_REGISTER_API(AppendString_sprintf);
9289 JIM_REGISTER_API(AppendObj);
9290 JIM_REGISTER_API(AppendStrings);
9291 JIM_REGISTER_API(StringEqObj);
9292 JIM_REGISTER_API(StringMatchObj);
9293 JIM_REGISTER_API(StringRangeObj);
9294 JIM_REGISTER_API(FormatString);
9295 JIM_REGISTER_API(CompareStringImmediate);
9296 JIM_REGISTER_API(NewReference);
9297 JIM_REGISTER_API(GetReference);
9298 JIM_REGISTER_API(SetFinalizer);
9299 JIM_REGISTER_API(GetFinalizer);
9300 JIM_REGISTER_API(CreateInterp);
9301 JIM_REGISTER_API(FreeInterp);
9302 JIM_REGISTER_API(GetExitCode);
9303 JIM_REGISTER_API(SetStdin);
9304 JIM_REGISTER_API(SetStdout);
9305 JIM_REGISTER_API(SetStderr);
9306 JIM_REGISTER_API(CreateCommand);
9307 JIM_REGISTER_API(CreateProcedure);
9308 JIM_REGISTER_API(DeleteCommand);
9309 JIM_REGISTER_API(RenameCommand);
9310 JIM_REGISTER_API(GetCommand);
9311 JIM_REGISTER_API(SetVariable);
9312 JIM_REGISTER_API(SetVariableStr);
9313 JIM_REGISTER_API(SetGlobalVariableStr);
9314 JIM_REGISTER_API(SetVariableStrWithStr);
9315 JIM_REGISTER_API(SetVariableLink);
9316 JIM_REGISTER_API(GetVariable);
9317 JIM_REGISTER_API(GetCallFrameByLevel);
9318 JIM_REGISTER_API(Collect);
9319 JIM_REGISTER_API(CollectIfNeeded);
9320 JIM_REGISTER_API(GetIndex);
9321 JIM_REGISTER_API(NewListObj);
9322 JIM_REGISTER_API(ListAppendElement);
9323 JIM_REGISTER_API(ListAppendList);
9324 JIM_REGISTER_API(ListLength);
9325 JIM_REGISTER_API(ListIndex);
9326 JIM_REGISTER_API(SetListIndex);
9327 JIM_REGISTER_API(ConcatObj);
9328 JIM_REGISTER_API(NewDictObj);
9329 JIM_REGISTER_API(DictKey);
9330 JIM_REGISTER_API(DictKeysVector);
9331 JIM_REGISTER_API(GetIndex);
9332 JIM_REGISTER_API(GetReturnCode);
9333 JIM_REGISTER_API(EvalExpression);
9334 JIM_REGISTER_API(GetBoolFromExpr);
9335 JIM_REGISTER_API(GetWide);
9336 JIM_REGISTER_API(GetLong);
9337 JIM_REGISTER_API(SetWide);
9338 JIM_REGISTER_API(NewIntObj);
9339 JIM_REGISTER_API(GetDouble);
9340 JIM_REGISTER_API(SetDouble);
9341 JIM_REGISTER_API(NewDoubleObj);
9342 JIM_REGISTER_API(WrongNumArgs);
9343 JIM_REGISTER_API(SetDictKeysVector);
9344 JIM_REGISTER_API(SubstObj);
9345 JIM_REGISTER_API(RegisterApi);
9346 JIM_REGISTER_API(PrintErrorMessage);
9347 JIM_REGISTER_API(InteractivePrompt);
9348 JIM_REGISTER_API(RegisterCoreCommands);
9349 JIM_REGISTER_API(GetSharedString);
9350 JIM_REGISTER_API(ReleaseSharedString);
9351 JIM_REGISTER_API(Panic);
9352 JIM_REGISTER_API(StrDup);
9353 JIM_REGISTER_API(UnsetVariable);
9354 JIM_REGISTER_API(GetVariableStr);
9355 JIM_REGISTER_API(GetGlobalVariable);
9356 JIM_REGISTER_API(GetGlobalVariableStr);
9357 JIM_REGISTER_API(GetAssocData);
9358 JIM_REGISTER_API(SetAssocData);
9359 JIM_REGISTER_API(DeleteAssocData);
9360 JIM_REGISTER_API(GetEnum);
9361 JIM_REGISTER_API(ScriptIsComplete);
9362 JIM_REGISTER_API(PackageRequire);
9363 JIM_REGISTER_API(PackageProvide);
9364 JIM_REGISTER_API(InitStack);
9365 JIM_REGISTER_API(FreeStack);
9366 JIM_REGISTER_API(StackLen);
9367 JIM_REGISTER_API(StackPush);
9368 JIM_REGISTER_API(StackPop);
9369 JIM_REGISTER_API(StackPeek);
9370 JIM_REGISTER_API(FreeStackElements);
9371 JIM_REGISTER_API(fprintf);
9372 JIM_REGISTER_API(vfprintf);
9373 JIM_REGISTER_API(fwrite);
9374 JIM_REGISTER_API(fread);
9375 JIM_REGISTER_API(fflush);
9376 JIM_REGISTER_API(fgets);
9377 JIM_REGISTER_API(GetNvp);
9378 JIM_REGISTER_API(Nvp_name2value);
9379 JIM_REGISTER_API(Nvp_name2value_simple);
9380 JIM_REGISTER_API(Nvp_name2value_obj);
9381 JIM_REGISTER_API(Nvp_name2value_nocase);
9382 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9383
9384 JIM_REGISTER_API(Nvp_value2name);
9385 JIM_REGISTER_API(Nvp_value2name_simple);
9386 JIM_REGISTER_API(Nvp_value2name_obj);
9387
9388 JIM_REGISTER_API(GetOpt_Setup);
9389 JIM_REGISTER_API(GetOpt_Debug);
9390 JIM_REGISTER_API(GetOpt_Obj);
9391 JIM_REGISTER_API(GetOpt_String);
9392 JIM_REGISTER_API(GetOpt_Double);
9393 JIM_REGISTER_API(GetOpt_Wide);
9394 JIM_REGISTER_API(GetOpt_Nvp);
9395 JIM_REGISTER_API(GetOpt_NvpUnknown);
9396 JIM_REGISTER_API(GetOpt_Enum);
9397
9398 JIM_REGISTER_API(Debug_ArgvString);
9399 JIM_REGISTER_API(SetResult_sprintf);
9400 JIM_REGISTER_API(SetResult_NvpUnknown);
9401
9402 }
9403
9404 /* -----------------------------------------------------------------------------
9405 * Core commands utility functions
9406 * ---------------------------------------------------------------------------*/
9407 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9408 const char *msg)
9409 {
9410 int i;
9411 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9412
9413 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9414 for (i = 0; i < argc; i++) {
9415 Jim_AppendObj(interp, objPtr, argv[i]);
9416 if (!(i + 1 == argc && msg[0] == '\0'))
9417 Jim_AppendString(interp, objPtr, " ", 1);
9418 }
9419 Jim_AppendString(interp, objPtr, msg, -1);
9420 Jim_AppendString(interp, objPtr, "\"", 1);
9421 Jim_SetResult(interp, objPtr);
9422 }
9423
9424 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9425 {
9426 Jim_HashTableIterator *htiter;
9427 Jim_HashEntry *he;
9428 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9429 const char *pattern;
9430 int patternLen=0;
9431
9432 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9433 htiter = Jim_GetHashTableIterator(&interp->commands);
9434 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9435 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9436 strlen((const char*)he->key), 0))
9437 continue;
9438 Jim_ListAppendElement(interp, listObjPtr,
9439 Jim_NewStringObj(interp, he->key, -1));
9440 }
9441 Jim_FreeHashTableIterator(htiter);
9442 return listObjPtr;
9443 }
9444
9445 #define JIM_VARLIST_GLOBALS 0
9446 #define JIM_VARLIST_LOCALS 1
9447 #define JIM_VARLIST_VARS 2
9448
9449 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9450 int mode)
9451 {
9452 Jim_HashTableIterator *htiter;
9453 Jim_HashEntry *he;
9454 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9455 const char *pattern;
9456 int patternLen=0;
9457
9458 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9459 if (mode == JIM_VARLIST_GLOBALS) {
9460 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9461 } else {
9462 /* For [info locals], if we are at top level an emtpy list
9463 * is returned. I don't agree, but we aim at compatibility (SS) */
9464 if (mode == JIM_VARLIST_LOCALS &&
9465 interp->framePtr == interp->topFramePtr)
9466 return listObjPtr;
9467 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9468 }
9469 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9470 Jim_Var *varPtr = (Jim_Var*) he->val;
9471 if (mode == JIM_VARLIST_LOCALS) {
9472 if (varPtr->linkFramePtr != NULL)
9473 continue;
9474 }
9475 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9476 strlen((const char*)he->key), 0))
9477 continue;
9478 Jim_ListAppendElement(interp, listObjPtr,
9479 Jim_NewStringObj(interp, he->key, -1));
9480 }
9481 Jim_FreeHashTableIterator(htiter);
9482 return listObjPtr;
9483 }
9484
9485 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9486 Jim_Obj **objPtrPtr)
9487 {
9488 Jim_CallFrame *targetCallFrame;
9489
9490 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9491 != JIM_OK)
9492 return JIM_ERR;
9493 /* No proc call at toplevel callframe */
9494 if (targetCallFrame == interp->topFramePtr) {
9495 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9496 Jim_AppendStrings(interp, Jim_GetResult(interp),
9497 "bad level \"",
9498 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9499 return JIM_ERR;
9500 }
9501 *objPtrPtr = Jim_NewListObj(interp,
9502 targetCallFrame->argv,
9503 targetCallFrame->argc);
9504 return JIM_OK;
9505 }
9506
9507 /* -----------------------------------------------------------------------------
9508 * Core commands
9509 * ---------------------------------------------------------------------------*/
9510
9511 /* fake [puts] -- not the real puts, just for debugging. */
9512 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9513 Jim_Obj *const *argv)
9514 {
9515 const char *str;
9516 int len, nonewline = 0;
9517
9518 if (argc != 2 && argc != 3) {
9519 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9520 return JIM_ERR;
9521 }
9522 if (argc == 3) {
9523 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9524 {
9525 Jim_SetResultString(interp, "The second argument must "
9526 "be -nonewline", -1);
9527 return JIM_OK;
9528 } else {
9529 nonewline = 1;
9530 argv++;
9531 }
9532 }
9533 str = Jim_GetString(argv[1], &len);
9534 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9535 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9536 return JIM_OK;
9537 }
9538
9539 /* Helper for [+] and [*] */
9540 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9541 Jim_Obj *const *argv, int op)
9542 {
9543 jim_wide wideValue, res;
9544 double doubleValue, doubleRes;
9545 int i;
9546
9547 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9548
9549 for (i = 1; i < argc; i++) {
9550 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9551 goto trydouble;
9552 if (op == JIM_EXPROP_ADD)
9553 res += wideValue;
9554 else
9555 res *= wideValue;
9556 }
9557 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9558 return JIM_OK;
9559 trydouble:
9560 doubleRes = (double) res;
9561 for (;i < argc; i++) {
9562 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9563 return JIM_ERR;
9564 if (op == JIM_EXPROP_ADD)
9565 doubleRes += doubleValue;
9566 else
9567 doubleRes *= doubleValue;
9568 }
9569 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9570 return JIM_OK;
9571 }
9572
9573 /* Helper for [-] and [/] */
9574 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9575 Jim_Obj *const *argv, int op)
9576 {
9577 jim_wide wideValue, res = 0;
9578 double doubleValue, doubleRes = 0;
9579 int i = 2;
9580
9581 if (argc < 2) {
9582 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9583 return JIM_ERR;
9584 } else if (argc == 2) {
9585 /* The arity = 2 case is different. For [- x] returns -x,
9586 * while [/ x] returns 1/x. */
9587 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9588 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9589 JIM_OK)
9590 {
9591 return JIM_ERR;
9592 } else {
9593 if (op == JIM_EXPROP_SUB)
9594 doubleRes = -doubleValue;
9595 else
9596 doubleRes = 1.0/doubleValue;
9597 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9598 doubleRes));
9599 return JIM_OK;
9600 }
9601 }
9602 if (op == JIM_EXPROP_SUB) {
9603 res = -wideValue;
9604 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9605 } else {
9606 doubleRes = 1.0/wideValue;
9607 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9608 doubleRes));
9609 }
9610 return JIM_OK;
9611 } else {
9612 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9613 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9614 != JIM_OK) {
9615 return JIM_ERR;
9616 } else {
9617 goto trydouble;
9618 }
9619 }
9620 }
9621 for (i = 2; i < argc; i++) {
9622 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9623 doubleRes = (double) res;
9624 goto trydouble;
9625 }
9626 if (op == JIM_EXPROP_SUB)
9627 res -= wideValue;
9628 else
9629 res /= wideValue;
9630 }
9631 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9632 return JIM_OK;
9633 trydouble:
9634 for (;i < argc; i++) {
9635 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9636 return JIM_ERR;
9637 if (op == JIM_EXPROP_SUB)
9638 doubleRes -= doubleValue;
9639 else
9640 doubleRes /= doubleValue;
9641 }
9642 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9643 return JIM_OK;
9644 }
9645
9646
9647 /* [+] */
9648 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9649 Jim_Obj *const *argv)
9650 {
9651 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9652 }
9653
9654 /* [*] */
9655 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9656 Jim_Obj *const *argv)
9657 {
9658 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9659 }
9660
9661 /* [-] */
9662 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9663 Jim_Obj *const *argv)
9664 {
9665 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9666 }
9667
9668 /* [/] */
9669 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9670 Jim_Obj *const *argv)
9671 {
9672 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9673 }
9674
9675 /* [set] */
9676 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9677 Jim_Obj *const *argv)
9678 {
9679 if (argc != 2 && argc != 3) {
9680 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9681 return JIM_ERR;
9682 }
9683 if (argc == 2) {
9684 Jim_Obj *objPtr;
9685 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9686 if (!objPtr)
9687 return JIM_ERR;
9688 Jim_SetResult(interp, objPtr);
9689 return JIM_OK;
9690 }
9691 /* argc == 3 case. */
9692 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9693 return JIM_ERR;
9694 Jim_SetResult(interp, argv[2]);
9695 return JIM_OK;
9696 }
9697
9698 /* [unset] */
9699 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9700 Jim_Obj *const *argv)
9701 {
9702 int i;
9703
9704 if (argc < 2) {
9705 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9706 return JIM_ERR;
9707 }
9708 for (i = 1; i < argc; i++) {
9709 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9710 return JIM_ERR;
9711 }
9712 return JIM_OK;
9713 }
9714
9715 /* [incr] */
9716 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9717 Jim_Obj *const *argv)
9718 {
9719 jim_wide wideValue, increment = 1;
9720 Jim_Obj *intObjPtr;
9721
9722 if (argc != 2 && argc != 3) {
9723 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9724 return JIM_ERR;
9725 }
9726 if (argc == 3) {
9727 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9728 return JIM_ERR;
9729 }
9730 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9731 if (!intObjPtr) return JIM_ERR;
9732 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9733 return JIM_ERR;
9734 if (Jim_IsShared(intObjPtr)) {
9735 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9736 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9737 Jim_FreeNewObj(interp, intObjPtr);
9738 return JIM_ERR;
9739 }
9740 } else {
9741 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9742 /* The following step is required in order to invalidate the
9743 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9744 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9745 return JIM_ERR;
9746 }
9747 }
9748 Jim_SetResult(interp, intObjPtr);
9749 return JIM_OK;
9750 }
9751
9752 /* [while] */
9753 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9754 Jim_Obj *const *argv)
9755 {
9756 if (argc != 3) {
9757 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9758 return JIM_ERR;
9759 }
9760 /* Try to run a specialized version of while if the expression
9761 * is in one of the following forms:
9762 *
9763 * $a < CONST, $a < $b
9764 * $a <= CONST, $a <= $b
9765 * $a > CONST, $a > $b
9766 * $a >= CONST, $a >= $b
9767 * $a != CONST, $a != $b
9768 * $a == CONST, $a == $b
9769 * $a
9770 * !$a
9771 * CONST
9772 */
9773
9774 #ifdef JIM_OPTIMIZATION
9775 {
9776 ExprByteCode *expr;
9777 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9778 int exprLen, retval;
9779
9780 /* STEP 1 -- Check if there are the conditions to run the specialized
9781 * version of while */
9782
9783 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9784 if (expr->len <= 0 || expr->len > 3) goto noopt;
9785 switch (expr->len) {
9786 case 1:
9787 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9788 expr->opcode[0] != JIM_EXPROP_NUMBER)
9789 goto noopt;
9790 break;
9791 case 2:
9792 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9793 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9794 goto noopt;
9795 break;
9796 case 3:
9797 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9798 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9799 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9800 goto noopt;
9801 switch (expr->opcode[2]) {
9802 case JIM_EXPROP_LT:
9803 case JIM_EXPROP_LTE:
9804 case JIM_EXPROP_GT:
9805 case JIM_EXPROP_GTE:
9806 case JIM_EXPROP_NUMEQ:
9807 case JIM_EXPROP_NUMNE:
9808 /* nothing to do */
9809 break;
9810 default:
9811 goto noopt;
9812 }
9813 break;
9814 default:
9815 Jim_Panic(interp,
9816 "Unexpected default reached in Jim_WhileCoreCommand()");
9817 break;
9818 }
9819
9820 /* STEP 2 -- conditions meet. Initialization. Take different
9821 * branches for different expression lengths. */
9822 exprLen = expr->len;
9823
9824 if (exprLen == 1) {
9825 jim_wide wideValue=0;
9826
9827 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9828 varAObjPtr = expr->obj[0];
9829 Jim_IncrRefCount(varAObjPtr);
9830 } else {
9831 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9832 goto noopt;
9833 }
9834 while (1) {
9835 if (varAObjPtr) {
9836 if (!(objPtr =
9837 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9838 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9839 {
9840 Jim_DecrRefCount(interp, varAObjPtr);
9841 goto noopt;
9842 }
9843 }
9844 if (!wideValue) break;
9845 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9846 switch (retval) {
9847 case JIM_BREAK:
9848 if (varAObjPtr)
9849 Jim_DecrRefCount(interp, varAObjPtr);
9850 goto out;
9851 break;
9852 case JIM_CONTINUE:
9853 continue;
9854 break;
9855 default:
9856 if (varAObjPtr)
9857 Jim_DecrRefCount(interp, varAObjPtr);
9858 return retval;
9859 }
9860 }
9861 }
9862 if (varAObjPtr)
9863 Jim_DecrRefCount(interp, varAObjPtr);
9864 } else if (exprLen == 3) {
9865 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9866 int cmpType = expr->opcode[2];
9867
9868 varAObjPtr = expr->obj[0];
9869 Jim_IncrRefCount(varAObjPtr);
9870 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9871 varBObjPtr = expr->obj[1];
9872 Jim_IncrRefCount(varBObjPtr);
9873 } else {
9874 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9875 goto noopt;
9876 }
9877 while (1) {
9878 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9879 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9880 {
9881 Jim_DecrRefCount(interp, varAObjPtr);
9882 if (varBObjPtr)
9883 Jim_DecrRefCount(interp, varBObjPtr);
9884 goto noopt;
9885 }
9886 if (varBObjPtr) {
9887 if (!(objPtr =
9888 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9889 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9890 {
9891 Jim_DecrRefCount(interp, varAObjPtr);
9892 if (varBObjPtr)
9893 Jim_DecrRefCount(interp, varBObjPtr);
9894 goto noopt;
9895 }
9896 }
9897 switch (cmpType) {
9898 case JIM_EXPROP_LT:
9899 cmpRes = wideValueA < wideValueB; break;
9900 case JIM_EXPROP_LTE:
9901 cmpRes = wideValueA <= wideValueB; break;
9902 case JIM_EXPROP_GT:
9903 cmpRes = wideValueA > wideValueB; break;
9904 case JIM_EXPROP_GTE:
9905 cmpRes = wideValueA >= wideValueB; break;
9906 case JIM_EXPROP_NUMEQ:
9907 cmpRes = wideValueA == wideValueB; break;
9908 case JIM_EXPROP_NUMNE:
9909 cmpRes = wideValueA != wideValueB; break;
9910 }
9911 if (!cmpRes) break;
9912 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9913 switch (retval) {
9914 case JIM_BREAK:
9915 Jim_DecrRefCount(interp, varAObjPtr);
9916 if (varBObjPtr)
9917 Jim_DecrRefCount(interp, varBObjPtr);
9918 goto out;
9919 break;
9920 case JIM_CONTINUE:
9921 continue;
9922 break;
9923 default:
9924 Jim_DecrRefCount(interp, varAObjPtr);
9925 if (varBObjPtr)
9926 Jim_DecrRefCount(interp, varBObjPtr);
9927 return retval;
9928 }
9929 }
9930 }
9931 Jim_DecrRefCount(interp, varAObjPtr);
9932 if (varBObjPtr)
9933 Jim_DecrRefCount(interp, varBObjPtr);
9934 } else {
9935 /* TODO: case for len == 2 */
9936 goto noopt;
9937 }
9938 Jim_SetEmptyResult(interp);
9939 return JIM_OK;
9940 }
9941 noopt:
9942 #endif
9943
9944 /* The general purpose implementation of while starts here */
9945 while (1) {
9946 int boolean, retval;
9947
9948 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9949 &boolean)) != JIM_OK)
9950 return retval;
9951 if (!boolean) break;
9952 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9953 switch (retval) {
9954 case JIM_BREAK:
9955 goto out;
9956 break;
9957 case JIM_CONTINUE:
9958 continue;
9959 break;
9960 default:
9961 return retval;
9962 }
9963 }
9964 }
9965 out:
9966 Jim_SetEmptyResult(interp);
9967 return JIM_OK;
9968 }
9969
9970 /* [for] */
9971 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9972 Jim_Obj *const *argv)
9973 {
9974 int retval;
9975
9976 if (argc != 5) {
9977 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9978 return JIM_ERR;
9979 }
9980 /* Check if the for is on the form:
9981 * for {set i CONST} {$i < CONST} {incr i}
9982 * for {set i CONST} {$i < $j} {incr i}
9983 * for {set i CONST} {$i <= CONST} {incr i}
9984 * for {set i CONST} {$i <= $j} {incr i}
9985 * XXX: NOTE: if variable traces are implemented, this optimization
9986 * need to be modified to check for the proc epoch at every variable
9987 * update. */
9988 #ifdef JIM_OPTIMIZATION
9989 {
9990 ScriptObj *initScript, *incrScript;
9991 ExprByteCode *expr;
9992 jim_wide start, stop=0, currentVal;
9993 unsigned jim_wide procEpoch = interp->procEpoch;
9994 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9995 int cmpType;
9996 struct Jim_Cmd *cmdPtr;
9997
9998 /* Do it only if there aren't shared arguments */
9999 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
10000 goto evalstart;
10001 initScript = Jim_GetScript(interp, argv[1]);
10002 expr = Jim_GetExpression(interp, argv[2]);
10003 incrScript = Jim_GetScript(interp, argv[3]);
10004
10005 /* Ensure proper lengths to start */
10006 if (initScript->len != 6) goto evalstart;
10007 if (incrScript->len != 4) goto evalstart;
10008 if (expr->len != 3) goto evalstart;
10009 /* Ensure proper token types. */
10010 if (initScript->token[2].type != JIM_TT_ESC ||
10011 initScript->token[4].type != JIM_TT_ESC ||
10012 incrScript->token[2].type != JIM_TT_ESC ||
10013 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10014 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10015 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10016 (expr->opcode[2] != JIM_EXPROP_LT &&
10017 expr->opcode[2] != JIM_EXPROP_LTE))
10018 goto evalstart;
10019 cmpType = expr->opcode[2];
10020 /* Initialization command must be [set] */
10021 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10022 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10023 goto evalstart;
10024 /* Update command must be incr */
10025 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10026 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10027 goto evalstart;
10028 /* set, incr, expression must be about the same variable */
10029 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10030 incrScript->token[2].objPtr, 0))
10031 goto evalstart;
10032 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10033 expr->obj[0], 0))
10034 goto evalstart;
10035 /* Check that the initialization and comparison are valid integers */
10036 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10037 goto evalstart;
10038 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10039 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10040 {
10041 goto evalstart;
10042 }
10043
10044 /* Initialization */
10045 varNamePtr = expr->obj[0];
10046 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10047 stopVarNamePtr = expr->obj[1];
10048 Jim_IncrRefCount(stopVarNamePtr);
10049 }
10050 Jim_IncrRefCount(varNamePtr);
10051
10052 /* --- OPTIMIZED FOR --- */
10053 /* Start to loop */
10054 objPtr = Jim_NewIntObj(interp, start);
10055 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10056 Jim_DecrRefCount(interp, varNamePtr);
10057 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10058 Jim_FreeNewObj(interp, objPtr);
10059 goto evalstart;
10060 }
10061 while (1) {
10062 /* === Check condition === */
10063 /* Common code: */
10064 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10065 if (objPtr == NULL ||
10066 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10067 {
10068 Jim_DecrRefCount(interp, varNamePtr);
10069 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10070 goto testcond;
10071 }
10072 /* Immediate or Variable? get the 'stop' value if the latter. */
10073 if (stopVarNamePtr) {
10074 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10075 if (objPtr == NULL ||
10076 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10077 {
10078 Jim_DecrRefCount(interp, varNamePtr);
10079 Jim_DecrRefCount(interp, stopVarNamePtr);
10080 goto testcond;
10081 }
10082 }
10083 if (cmpType == JIM_EXPROP_LT) {
10084 if (currentVal >= stop) break;
10085 } else {
10086 if (currentVal > stop) break;
10087 }
10088 /* Eval body */
10089 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10090 switch (retval) {
10091 case JIM_BREAK:
10092 if (stopVarNamePtr)
10093 Jim_DecrRefCount(interp, stopVarNamePtr);
10094 Jim_DecrRefCount(interp, varNamePtr);
10095 goto out;
10096 case JIM_CONTINUE:
10097 /* nothing to do */
10098 break;
10099 default:
10100 if (stopVarNamePtr)
10101 Jim_DecrRefCount(interp, stopVarNamePtr);
10102 Jim_DecrRefCount(interp, varNamePtr);
10103 return retval;
10104 }
10105 }
10106 /* If there was a change in procedures/command continue
10107 * with the usual [for] command implementation */
10108 if (procEpoch != interp->procEpoch) {
10109 if (stopVarNamePtr)
10110 Jim_DecrRefCount(interp, stopVarNamePtr);
10111 Jim_DecrRefCount(interp, varNamePtr);
10112 goto evalnext;
10113 }
10114 /* Increment */
10115 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10116 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10117 objPtr->internalRep.wideValue ++;
10118 Jim_InvalidateStringRep(objPtr);
10119 } else {
10120 Jim_Obj *auxObjPtr;
10121
10122 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10123 if (stopVarNamePtr)
10124 Jim_DecrRefCount(interp, stopVarNamePtr);
10125 Jim_DecrRefCount(interp, varNamePtr);
10126 goto evalnext;
10127 }
10128 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10129 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10130 if (stopVarNamePtr)
10131 Jim_DecrRefCount(interp, stopVarNamePtr);
10132 Jim_DecrRefCount(interp, varNamePtr);
10133 Jim_FreeNewObj(interp, auxObjPtr);
10134 goto evalnext;
10135 }
10136 }
10137 }
10138 if (stopVarNamePtr)
10139 Jim_DecrRefCount(interp, stopVarNamePtr);
10140 Jim_DecrRefCount(interp, varNamePtr);
10141 Jim_SetEmptyResult(interp);
10142 return JIM_OK;
10143 }
10144 #endif
10145 evalstart:
10146 /* Eval start */
10147 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10148 return retval;
10149 while (1) {
10150 int boolean;
10151 testcond:
10152 /* Test the condition */
10153 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10154 != JIM_OK)
10155 return retval;
10156 if (!boolean) break;
10157 /* Eval body */
10158 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10159 switch (retval) {
10160 case JIM_BREAK:
10161 goto out;
10162 break;
10163 case JIM_CONTINUE:
10164 /* Nothing to do */
10165 break;
10166 default:
10167 return retval;
10168 }
10169 }
10170 evalnext:
10171 /* Eval next */
10172 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10173 switch (retval) {
10174 case JIM_BREAK:
10175 goto out;
10176 break;
10177 case JIM_CONTINUE:
10178 continue;
10179 break;
10180 default:
10181 return retval;
10182 }
10183 }
10184 }
10185 out:
10186 Jim_SetEmptyResult(interp);
10187 return JIM_OK;
10188 }
10189
10190 /* foreach + lmap implementation. */
10191 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10192 Jim_Obj *const *argv, int doMap)
10193 {
10194 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10195 int nbrOfLoops = 0;
10196 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10197
10198 if (argc < 4 || argc % 2 != 0) {
10199 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10200 return JIM_ERR;
10201 }
10202 if (doMap) {
10203 mapRes = Jim_NewListObj(interp, NULL, 0);
10204 Jim_IncrRefCount(mapRes);
10205 }
10206 emptyStr = Jim_NewEmptyStringObj(interp);
10207 Jim_IncrRefCount(emptyStr);
10208 script = argv[argc-1]; /* Last argument is a script */
10209 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10210 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10211 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10212 /* Initialize iterators and remember max nbr elements each list */
10213 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10214 /* Remember lengths of all lists and calculate how much rounds to loop */
10215 for (i = 0; i < nbrOfLists*2; i += 2) {
10216 div_t cnt;
10217 int count;
10218 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10219 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10220 if (listsEnd[i] == 0) {
10221 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10222 goto err;
10223 }
10224 cnt = div(listsEnd[i + 1], listsEnd[i]);
10225 count = cnt.quot + (cnt.rem ? 1 : 0);
10226 if (count > nbrOfLoops)
10227 nbrOfLoops = count;
10228 }
10229 for (; nbrOfLoops-- > 0;) {
10230 for (i = 0; i < nbrOfLists; ++i) {
10231 int varIdx = 0, var = i * 2;
10232 while (varIdx < listsEnd[var]) {
10233 Jim_Obj *varName, *ele;
10234 int lst = i * 2 + 1;
10235 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10236 != JIM_OK)
10237 goto err;
10238 if (listsIdx[i] < listsEnd[lst]) {
10239 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10240 != JIM_OK)
10241 goto err;
10242 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10243 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10244 goto err;
10245 }
10246 ++listsIdx[i]; /* Remember next iterator of current list */
10247 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10248 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10249 goto err;
10250 }
10251 ++varIdx; /* Next variable */
10252 }
10253 }
10254 switch (result = Jim_EvalObj(interp, script)) {
10255 case JIM_OK:
10256 if (doMap)
10257 Jim_ListAppendElement(interp, mapRes, interp->result);
10258 break;
10259 case JIM_CONTINUE:
10260 break;
10261 case JIM_BREAK:
10262 goto out;
10263 break;
10264 default:
10265 goto err;
10266 }
10267 }
10268 out:
10269 result = JIM_OK;
10270 if (doMap)
10271 Jim_SetResult(interp, mapRes);
10272 else
10273 Jim_SetEmptyResult(interp);
10274 err:
10275 if (doMap)
10276 Jim_DecrRefCount(interp, mapRes);
10277 Jim_DecrRefCount(interp, emptyStr);
10278 Jim_Free(listsIdx);
10279 Jim_Free(listsEnd);
10280 return result;
10281 }
10282
10283 /* [foreach] */
10284 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10285 Jim_Obj *const *argv)
10286 {
10287 return JimForeachMapHelper(interp, argc, argv, 0);
10288 }
10289
10290 /* [lmap] */
10291 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10292 Jim_Obj *const *argv)
10293 {
10294 return JimForeachMapHelper(interp, argc, argv, 1);
10295 }
10296
10297 /* [if] */
10298 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10299 Jim_Obj *const *argv)
10300 {
10301 int boolean, retval, current = 1, falsebody = 0;
10302 if (argc >= 3) {
10303 while (1) {
10304 /* Far not enough arguments given! */
10305 if (current >= argc) goto err;
10306 if ((retval = Jim_GetBoolFromExpr(interp,
10307 argv[current++], &boolean))
10308 != JIM_OK)
10309 return retval;
10310 /* There lacks something, isn't it? */
10311 if (current >= argc) goto err;
10312 if (Jim_CompareStringImmediate(interp, argv[current],
10313 "then")) current++;
10314 /* Tsk tsk, no then-clause? */
10315 if (current >= argc) goto err;
10316 if (boolean)
10317 return Jim_EvalObj(interp, argv[current]);
10318 /* Ok: no else-clause follows */
10319 if (++current >= argc) {
10320 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10321 return JIM_OK;
10322 }
10323 falsebody = current++;
10324 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10325 "else")) {
10326 /* IIICKS - else-clause isn't last cmd? */
10327 if (current != argc-1) goto err;
10328 return Jim_EvalObj(interp, argv[current]);
10329 } else if (Jim_CompareStringImmediate(interp,
10330 argv[falsebody], "elseif"))
10331 /* Ok: elseif follows meaning all the stuff
10332 * again (how boring...) */
10333 continue;
10334 /* OOPS - else-clause is not last cmd?*/
10335 else if (falsebody != argc-1)
10336 goto err;
10337 return Jim_EvalObj(interp, argv[falsebody]);
10338 }
10339 return JIM_OK;
10340 }
10341 err:
10342 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10343 return JIM_ERR;
10344 }
10345
10346 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10347
10348 /* [switch] */
10349 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10350 Jim_Obj *const *argv)
10351 {
10352 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10353 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10354 Jim_Obj *script = 0;
10355 if (argc < 3) goto wrongnumargs;
10356 for (opt = 1; opt < argc; ++opt) {
10357 const char *option = Jim_GetString(argv[opt], 0);
10358 if (*option != '-') break;
10359 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10360 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10361 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10362 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10363 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10364 if ((argc - opt) < 2) goto wrongnumargs;
10365 command = argv[++opt];
10366 } else {
10367 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10368 Jim_AppendStrings(interp, Jim_GetResult(interp),
10369 "bad option \"", option, "\": must be -exact, -glob, "
10370 "-regexp, -command procname or --", 0);
10371 goto err;
10372 }
10373 if ((argc - opt) < 2) goto wrongnumargs;
10374 }
10375 strObj = argv[opt++];
10376 patCount = argc - opt;
10377 if (patCount == 1) {
10378 Jim_Obj **vector;
10379 JimListGetElements(interp, argv[opt], &patCount, &vector);
10380 caseList = vector;
10381 } else
10382 caseList = &argv[opt];
10383 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10384 for (i = 0; script == 0 && i < patCount; i += 2) {
10385 Jim_Obj *patObj = caseList[i];
10386 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10387 || i < (patCount-2)) {
10388 switch (matchOpt) {
10389 case SWITCH_EXACT:
10390 if (Jim_StringEqObj(strObj, patObj, 0))
10391 script = caseList[i + 1];
10392 break;
10393 case SWITCH_GLOB:
10394 if (Jim_StringMatchObj(patObj, strObj, 0))
10395 script = caseList[i + 1];
10396 break;
10397 case SWITCH_RE:
10398 command = Jim_NewStringObj(interp, "regexp", -1);
10399 /* Fall thru intentionally */
10400 case SWITCH_CMD: {
10401 Jim_Obj *parms[] = {command, patObj, strObj};
10402 int rc = Jim_EvalObjVector(interp, 3, parms);
10403 long matching;
10404 /* After the execution of a command we need to
10405 * make sure to reconvert the object into a list
10406 * again. Only for the single-list style [switch]. */
10407 if (argc-opt == 1) {
10408 Jim_Obj **vector;
10409 JimListGetElements(interp, argv[opt], &patCount,
10410 &vector);
10411 caseList = vector;
10412 }
10413 /* command is here already decref'd */
10414 if (rc != JIM_OK) {
10415 retcode = rc;
10416 goto err;
10417 }
10418 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10419 if (rc != JIM_OK) {
10420 retcode = rc;
10421 goto err;
10422 }
10423 if (matching)
10424 script = caseList[i + 1];
10425 break;
10426 }
10427 default:
10428 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10429 Jim_AppendStrings(interp, Jim_GetResult(interp),
10430 "internal error: no such option implemented", 0);
10431 goto err;
10432 }
10433 } else {
10434 script = caseList[i + 1];
10435 }
10436 }
10437 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10438 i += 2)
10439 script = caseList[i + 1];
10440 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10441 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10442 Jim_AppendStrings(interp, Jim_GetResult(interp),
10443 "no body specified for pattern \"",
10444 Jim_GetString(caseList[i-2], 0), "\"", 0);
10445 goto err;
10446 }
10447 retcode = JIM_OK;
10448 Jim_SetEmptyResult(interp);
10449 if (script != 0)
10450 retcode = Jim_EvalObj(interp, script);
10451 return retcode;
10452 wrongnumargs:
10453 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10454 "pattern body ... ?default body? or "
10455 "{pattern body ?pattern body ...?}");
10456 err:
10457 return retcode;
10458 }
10459
10460 /* [list] */
10461 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10462 Jim_Obj *const *argv)
10463 {
10464 Jim_Obj *listObjPtr;
10465
10466 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10467 Jim_SetResult(interp, listObjPtr);
10468 return JIM_OK;
10469 }
10470
10471 /* [lindex] */
10472 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10473 Jim_Obj *const *argv)
10474 {
10475 Jim_Obj *objPtr, *listObjPtr;
10476 int i;
10477 int index;
10478
10479 if (argc < 3) {
10480 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10481 return JIM_ERR;
10482 }
10483 objPtr = argv[1];
10484 Jim_IncrRefCount(objPtr);
10485 for (i = 2; i < argc; i++) {
10486 listObjPtr = objPtr;
10487 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10488 Jim_DecrRefCount(interp, listObjPtr);
10489 return JIM_ERR;
10490 }
10491 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10492 JIM_NONE) != JIM_OK) {
10493 /* Returns an empty object if the index
10494 * is out of range. */
10495 Jim_DecrRefCount(interp, listObjPtr);
10496 Jim_SetEmptyResult(interp);
10497 return JIM_OK;
10498 }
10499 Jim_IncrRefCount(objPtr);
10500 Jim_DecrRefCount(interp, listObjPtr);
10501 }
10502 Jim_SetResult(interp, objPtr);
10503 Jim_DecrRefCount(interp, objPtr);
10504 return JIM_OK;
10505 }
10506
10507 /* [llength] */
10508 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10509 Jim_Obj *const *argv)
10510 {
10511 int len;
10512
10513 if (argc != 2) {
10514 Jim_WrongNumArgs(interp, 1, argv, "list");
10515 return JIM_ERR;
10516 }
10517 Jim_ListLength(interp, argv[1], &len);
10518 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10519 return JIM_OK;
10520 }
10521
10522 /* [lappend] */
10523 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10524 Jim_Obj *const *argv)
10525 {
10526 Jim_Obj *listObjPtr;
10527 int shared, i;
10528
10529 if (argc < 2) {
10530 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10531 return JIM_ERR;
10532 }
10533 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10534 if (!listObjPtr) {
10535 /* Create the list if it does not exists */
10536 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10537 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10538 Jim_FreeNewObj(interp, listObjPtr);
10539 return JIM_ERR;
10540 }
10541 }
10542 shared = Jim_IsShared(listObjPtr);
10543 if (shared)
10544 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10545 for (i = 2; i < argc; i++)
10546 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10547 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10548 if (shared)
10549 Jim_FreeNewObj(interp, listObjPtr);
10550 return JIM_ERR;
10551 }
10552 Jim_SetResult(interp, listObjPtr);
10553 return JIM_OK;
10554 }
10555
10556 /* [linsert] */
10557 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10558 Jim_Obj *const *argv)
10559 {
10560 int index, len;
10561 Jim_Obj *listPtr;
10562
10563 if (argc < 4) {
10564 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10565 "?element ...?");
10566 return JIM_ERR;
10567 }
10568 listPtr = argv[1];
10569 if (Jim_IsShared(listPtr))
10570 listPtr = Jim_DuplicateObj(interp, listPtr);
10571 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10572 goto err;
10573 Jim_ListLength(interp, listPtr, &len);
10574 if (index >= len)
10575 index = len;
10576 else if (index < 0)
10577 index = len + index + 1;
10578 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10579 Jim_SetResult(interp, listPtr);
10580 return JIM_OK;
10581 err:
10582 if (listPtr != argv[1]) {
10583 Jim_FreeNewObj(interp, listPtr);
10584 }
10585 return JIM_ERR;
10586 }
10587
10588 /* [lset] */
10589 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10590 Jim_Obj *const *argv)
10591 {
10592 if (argc < 3) {
10593 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10594 return JIM_ERR;
10595 } else if (argc == 3) {
10596 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10597 return JIM_ERR;
10598 Jim_SetResult(interp, argv[2]);
10599 return JIM_OK;
10600 }
10601 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10602 == JIM_ERR) return JIM_ERR;
10603 return JIM_OK;
10604 }
10605
10606 /* [lsort] */
10607 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10608 {
10609 const char *options[] = {
10610 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10611 };
10612 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10613 Jim_Obj *resObj;
10614 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10615 int decreasing = 0;
10616
10617 if (argc < 2) {
10618 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10619 return JIM_ERR;
10620 }
10621 for (i = 1; i < (argc-1); i++) {
10622 int option;
10623
10624 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10625 != JIM_OK)
10626 return JIM_ERR;
10627 switch (option) {
10628 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10629 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10630 case OPT_INCREASING: decreasing = 0; break;
10631 case OPT_DECREASING: decreasing = 1; break;
10632 }
10633 }
10634 if (decreasing) {
10635 switch (lsortType) {
10636 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10637 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10638 }
10639 }
10640 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10641 ListSortElements(interp, resObj, lsortType);
10642 Jim_SetResult(interp, resObj);
10643 return JIM_OK;
10644 }
10645
10646 /* [append] */
10647 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10648 Jim_Obj *const *argv)
10649 {
10650 Jim_Obj *stringObjPtr;
10651 int shared, i;
10652
10653 if (argc < 2) {
10654 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10655 return JIM_ERR;
10656 }
10657 if (argc == 2) {
10658 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10659 if (!stringObjPtr) return JIM_ERR;
10660 } else {
10661 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10662 if (!stringObjPtr) {
10663 /* Create the string if it does not exists */
10664 stringObjPtr = Jim_NewEmptyStringObj(interp);
10665 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10666 != JIM_OK) {
10667 Jim_FreeNewObj(interp, stringObjPtr);
10668 return JIM_ERR;
10669 }
10670 }
10671 }
10672 shared = Jim_IsShared(stringObjPtr);
10673 if (shared)
10674 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10675 for (i = 2; i < argc; i++)
10676 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10677 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10678 if (shared)
10679 Jim_FreeNewObj(interp, stringObjPtr);
10680 return JIM_ERR;
10681 }
10682 Jim_SetResult(interp, stringObjPtr);
10683 return JIM_OK;
10684 }
10685
10686 /* [debug] */
10687 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10688 Jim_Obj *const *argv)
10689 {
10690 const char *options[] = {
10691 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10692 "exprbc",
10693 NULL
10694 };
10695 enum {
10696 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10697 OPT_EXPRLEN, OPT_EXPRBC
10698 };
10699 int option;
10700
10701 if (argc < 2) {
10702 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10703 return JIM_ERR;
10704 }
10705 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10706 JIM_ERRMSG) != JIM_OK)
10707 return JIM_ERR;
10708 if (option == OPT_REFCOUNT) {
10709 if (argc != 3) {
10710 Jim_WrongNumArgs(interp, 2, argv, "object");
10711 return JIM_ERR;
10712 }
10713 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10714 return JIM_OK;
10715 } else if (option == OPT_OBJCOUNT) {
10716 int freeobj = 0, liveobj = 0;
10717 char buf[256];
10718 Jim_Obj *objPtr;
10719
10720 if (argc != 2) {
10721 Jim_WrongNumArgs(interp, 2, argv, "");
10722 return JIM_ERR;
10723 }
10724 /* Count the number of free objects. */
10725 objPtr = interp->freeList;
10726 while (objPtr) {
10727 freeobj++;
10728 objPtr = objPtr->nextObjPtr;
10729 }
10730 /* Count the number of live objects. */
10731 objPtr = interp->liveList;
10732 while (objPtr) {
10733 liveobj++;
10734 objPtr = objPtr->nextObjPtr;
10735 }
10736 /* Set the result string and return. */
10737 sprintf(buf, "free %d used %d", freeobj, liveobj);
10738 Jim_SetResultString(interp, buf, -1);
10739 return JIM_OK;
10740 } else if (option == OPT_OBJECTS) {
10741 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10742 /* Count the number of live objects. */
10743 objPtr = interp->liveList;
10744 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10745 while (objPtr) {
10746 char buf[128];
10747 const char *type = objPtr->typePtr ?
10748 objPtr->typePtr->name : "";
10749 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10750 sprintf(buf, "%p", objPtr);
10751 Jim_ListAppendElement(interp, subListObjPtr,
10752 Jim_NewStringObj(interp, buf, -1));
10753 Jim_ListAppendElement(interp, subListObjPtr,
10754 Jim_NewStringObj(interp, type, -1));
10755 Jim_ListAppendElement(interp, subListObjPtr,
10756 Jim_NewIntObj(interp, objPtr->refCount));
10757 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10758 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10759 objPtr = objPtr->nextObjPtr;
10760 }
10761 Jim_SetResult(interp, listObjPtr);
10762 return JIM_OK;
10763 } else if (option == OPT_INVSTR) {
10764 Jim_Obj *objPtr;
10765
10766 if (argc != 3) {
10767 Jim_WrongNumArgs(interp, 2, argv, "object");
10768 return JIM_ERR;
10769 }
10770 objPtr = argv[2];
10771 if (objPtr->typePtr != NULL)
10772 Jim_InvalidateStringRep(objPtr);
10773 Jim_SetEmptyResult(interp);
10774 return JIM_OK;
10775 } else if (option == OPT_SCRIPTLEN) {
10776 ScriptObj *script;
10777 if (argc != 3) {
10778 Jim_WrongNumArgs(interp, 2, argv, "script");
10779 return JIM_ERR;
10780 }
10781 script = Jim_GetScript(interp, argv[2]);
10782 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10783 return JIM_OK;
10784 } else if (option == OPT_EXPRLEN) {
10785 ExprByteCode *expr;
10786 if (argc != 3) {
10787 Jim_WrongNumArgs(interp, 2, argv, "expression");
10788 return JIM_ERR;
10789 }
10790 expr = Jim_GetExpression(interp, argv[2]);
10791 if (expr == NULL)
10792 return JIM_ERR;
10793 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10794 return JIM_OK;
10795 } else if (option == OPT_EXPRBC) {
10796 Jim_Obj *objPtr;
10797 ExprByteCode *expr;
10798 int i;
10799
10800 if (argc != 3) {
10801 Jim_WrongNumArgs(interp, 2, argv, "expression");
10802 return JIM_ERR;
10803 }
10804 expr = Jim_GetExpression(interp, argv[2]);
10805 if (expr == NULL)
10806 return JIM_ERR;
10807 objPtr = Jim_NewListObj(interp, NULL, 0);
10808 for (i = 0; i < expr->len; i++) {
10809 const char *type;
10810 Jim_ExprOperator *op;
10811
10812 switch (expr->opcode[i]) {
10813 case JIM_EXPROP_NUMBER: type = "number"; break;
10814 case JIM_EXPROP_COMMAND: type = "command"; break;
10815 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10816 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10817 case JIM_EXPROP_SUBST: type = "subst"; break;
10818 case JIM_EXPROP_STRING: type = "string"; break;
10819 default:
10820 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10821 if (op == NULL) {
10822 type = "private";
10823 } else {
10824 type = "operator";
10825 }
10826 break;
10827 }
10828 Jim_ListAppendElement(interp, objPtr,
10829 Jim_NewStringObj(interp, type, -1));
10830 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10831 }
10832 Jim_SetResult(interp, objPtr);
10833 return JIM_OK;
10834 } else {
10835 Jim_SetResultString(interp,
10836 "bad option. Valid options are refcount, "
10837 "objcount, objects, invstr", -1);
10838 return JIM_ERR;
10839 }
10840 return JIM_OK; /* unreached */
10841 }
10842
10843 /* [eval] */
10844 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10845 Jim_Obj *const *argv)
10846 {
10847 if (argc == 2) {
10848 return Jim_EvalObj(interp, argv[1]);
10849 } else if (argc > 2) {
10850 Jim_Obj *objPtr;
10851 int retcode;
10852
10853 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10854 Jim_IncrRefCount(objPtr);
10855 retcode = Jim_EvalObj(interp, objPtr);
10856 Jim_DecrRefCount(interp, objPtr);
10857 return retcode;
10858 } else {
10859 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10860 return JIM_ERR;
10861 }
10862 }
10863
10864 /* [uplevel] */
10865 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10866 Jim_Obj *const *argv)
10867 {
10868 if (argc >= 2) {
10869 int retcode, newLevel, oldLevel;
10870 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10871 Jim_Obj *objPtr;
10872 const char *str;
10873
10874 /* Save the old callframe pointer */
10875 savedCallFrame = interp->framePtr;
10876
10877 /* Lookup the target frame pointer */
10878 str = Jim_GetString(argv[1], NULL);
10879 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10880 {
10881 if (Jim_GetCallFrameByLevel(interp, argv[1],
10882 &targetCallFrame,
10883 &newLevel) != JIM_OK)
10884 return JIM_ERR;
10885 argc--;
10886 argv++;
10887 } else {
10888 if (Jim_GetCallFrameByLevel(interp, NULL,
10889 &targetCallFrame,
10890 &newLevel) != JIM_OK)
10891 return JIM_ERR;
10892 }
10893 if (argc < 2) {
10894 argc++;
10895 argv--;
10896 Jim_WrongNumArgs(interp, 1, argv,
10897 "?level? command ?arg ...?");
10898 return JIM_ERR;
10899 }
10900 /* Eval the code in the target callframe. */
10901 interp->framePtr = targetCallFrame;
10902 oldLevel = interp->numLevels;
10903 interp->numLevels = newLevel;
10904 if (argc == 2) {
10905 retcode = Jim_EvalObj(interp, argv[1]);
10906 } else {
10907 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10908 Jim_IncrRefCount(objPtr);
10909 retcode = Jim_EvalObj(interp, objPtr);
10910 Jim_DecrRefCount(interp, objPtr);
10911 }
10912 interp->numLevels = oldLevel;
10913 interp->framePtr = savedCallFrame;
10914 return retcode;
10915 } else {
10916 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10917 return JIM_ERR;
10918 }
10919 }
10920
10921 /* [expr] */
10922 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10923 Jim_Obj *const *argv)
10924 {
10925 Jim_Obj *exprResultPtr;
10926 int retcode;
10927
10928 if (argc == 2) {
10929 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10930 } else if (argc > 2) {
10931 Jim_Obj *objPtr;
10932
10933 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10934 Jim_IncrRefCount(objPtr);
10935 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10936 Jim_DecrRefCount(interp, objPtr);
10937 } else {
10938 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10939 return JIM_ERR;
10940 }
10941 if (retcode != JIM_OK) return retcode;
10942 Jim_SetResult(interp, exprResultPtr);
10943 Jim_DecrRefCount(interp, exprResultPtr);
10944 return JIM_OK;
10945 }
10946
10947 /* [break] */
10948 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10949 Jim_Obj *const *argv)
10950 {
10951 if (argc != 1) {
10952 Jim_WrongNumArgs(interp, 1, argv, "");
10953 return JIM_ERR;
10954 }
10955 return JIM_BREAK;
10956 }
10957
10958 /* [continue] */
10959 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10960 Jim_Obj *const *argv)
10961 {
10962 if (argc != 1) {
10963 Jim_WrongNumArgs(interp, 1, argv, "");
10964 return JIM_ERR;
10965 }
10966 return JIM_CONTINUE;
10967 }
10968
10969 /* [return] */
10970 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10971 Jim_Obj *const *argv)
10972 {
10973 if (argc == 1) {
10974 return JIM_RETURN;
10975 } else if (argc == 2) {
10976 Jim_SetResult(interp, argv[1]);
10977 interp->returnCode = JIM_OK;
10978 return JIM_RETURN;
10979 } else if (argc == 3 || argc == 4) {
10980 int returnCode;
10981 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10982 return JIM_ERR;
10983 interp->returnCode = returnCode;
10984 if (argc == 4)
10985 Jim_SetResult(interp, argv[3]);
10986 return JIM_RETURN;
10987 } else {
10988 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10989 return JIM_ERR;
10990 }
10991 return JIM_RETURN; /* unreached */
10992 }
10993
10994 /* [tailcall] */
10995 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10996 Jim_Obj *const *argv)
10997 {
10998 Jim_Obj *objPtr;
10999
11000 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
11001 Jim_SetResult(interp, objPtr);
11002 return JIM_EVAL;
11003 }
11004
11005 /* [proc] */
11006 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11007 Jim_Obj *const *argv)
11008 {
11009 int argListLen;
11010 int arityMin, arityMax;
11011
11012 if (argc != 4 && argc != 5) {
11013 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11014 return JIM_ERR;
11015 }
11016 Jim_ListLength(interp, argv[2], &argListLen);
11017 arityMin = arityMax = argListLen + 1;
11018
11019 if (argListLen) {
11020 const char *str;
11021 int len;
11022 Jim_Obj *argPtr=NULL;
11023
11024 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11025 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11026 str = Jim_GetString(argPtr, &len);
11027 if (len == 4 && memcmp(str, "args", 4) == 0) {
11028 arityMin--;
11029 arityMax = -1;
11030 }
11031
11032 /* Check for default arguments and reduce arityMin if necessary */
11033 while (arityMin > 1) {
11034 int len;
11035 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11036 Jim_ListLength(interp, argPtr, &len);
11037 if (len != 2) {
11038 /* No default argument */
11039 break;
11040 }
11041 arityMin--;
11042 }
11043 }
11044 if (argc == 4) {
11045 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11046 argv[2], NULL, argv[3], arityMin, arityMax);
11047 } else {
11048 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11049 argv[2], argv[3], argv[4], arityMin, arityMax);
11050 }
11051 }
11052
11053 /* [concat] */
11054 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11055 Jim_Obj *const *argv)
11056 {
11057 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11058 return JIM_OK;
11059 }
11060
11061 /* [upvar] */
11062 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11063 Jim_Obj *const *argv)
11064 {
11065 const char *str;
11066 int i;
11067 Jim_CallFrame *targetCallFrame;
11068
11069 /* Lookup the target frame pointer */
11070 str = Jim_GetString(argv[1], NULL);
11071 if (argc > 3 &&
11072 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11073 {
11074 if (Jim_GetCallFrameByLevel(interp, argv[1],
11075 &targetCallFrame, NULL) != JIM_OK)
11076 return JIM_ERR;
11077 argc--;
11078 argv++;
11079 } else {
11080 if (Jim_GetCallFrameByLevel(interp, NULL,
11081 &targetCallFrame, NULL) != JIM_OK)
11082 return JIM_ERR;
11083 }
11084 /* Check for arity */
11085 if (argc < 3 || ((argc-1)%2) != 0) {
11086 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11087 return JIM_ERR;
11088 }
11089 /* Now... for every other/local couple: */
11090 for (i = 1; i < argc; i += 2) {
11091 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11092 targetCallFrame) != JIM_OK) return JIM_ERR;
11093 }
11094 return JIM_OK;
11095 }
11096
11097 /* [global] */
11098 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11099 Jim_Obj *const *argv)
11100 {
11101 int i;
11102
11103 if (argc < 2) {
11104 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11105 return JIM_ERR;
11106 }
11107 /* Link every var to the toplevel having the same name */
11108 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11109 for (i = 1; i < argc; i++) {
11110 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11111 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11112 }
11113 return JIM_OK;
11114 }
11115
11116 /* does the [string map] operation. On error NULL is returned,
11117 * otherwise a new string object with the result, having refcount = 0,
11118 * is returned. */
11119 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11120 Jim_Obj *objPtr, int nocase)
11121 {
11122 int numMaps;
11123 const char **key, *str, *noMatchStart = NULL;
11124 Jim_Obj **value;
11125 int *keyLen, strLen, i;
11126 Jim_Obj *resultObjPtr;
11127
11128 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11129 if (numMaps % 2) {
11130 Jim_SetResultString(interp,
11131 "list must contain an even number of elements", -1);
11132 return NULL;
11133 }
11134 /* Initialization */
11135 numMaps /= 2;
11136 key = Jim_Alloc(sizeof(char*)*numMaps);
11137 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11138 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11139 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11140 for (i = 0; i < numMaps; i++) {
11141 Jim_Obj *eleObjPtr=NULL;
11142
11143 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11144 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11145 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11146 value[i] = eleObjPtr;
11147 }
11148 str = Jim_GetString(objPtr, &strLen);
11149 /* Map it */
11150 while (strLen) {
11151 for (i = 0; i < numMaps; i++) {
11152 if (strLen >= keyLen[i] && keyLen[i]) {
11153 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11154 nocase))
11155 {
11156 if (noMatchStart) {
11157 Jim_AppendString(interp, resultObjPtr,
11158 noMatchStart, str-noMatchStart);
11159 noMatchStart = NULL;
11160 }
11161 Jim_AppendObj(interp, resultObjPtr, value[i]);
11162 str += keyLen[i];
11163 strLen -= keyLen[i];
11164 break;
11165 }
11166 }
11167 }
11168 if (i == numMaps) { /* no match */
11169 if (noMatchStart == NULL)
11170 noMatchStart = str;
11171 str ++;
11172 strLen --;
11173 }
11174 }
11175 if (noMatchStart) {
11176 Jim_AppendString(interp, resultObjPtr,
11177 noMatchStart, str-noMatchStart);
11178 }
11179 Jim_Free((void*)key);
11180 Jim_Free(keyLen);
11181 Jim_Free(value);
11182 return resultObjPtr;
11183 }
11184
11185 /* [string] */
11186 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11187 Jim_Obj *const *argv)
11188 {
11189 int option;
11190 const char *options[] = {
11191 "length", "compare", "match", "equal", "range", "map", "repeat",
11192 "index", "first", "tolower", "toupper", NULL
11193 };
11194 enum {
11195 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11196 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11197 };
11198
11199 if (argc < 2) {
11200 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11201 return JIM_ERR;
11202 }
11203 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11204 JIM_ERRMSG) != JIM_OK)
11205 return JIM_ERR;
11206
11207 if (option == OPT_LENGTH) {
11208 int len;
11209
11210 if (argc != 3) {
11211 Jim_WrongNumArgs(interp, 2, argv, "string");
11212 return JIM_ERR;
11213 }
11214 Jim_GetString(argv[2], &len);
11215 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11216 return JIM_OK;
11217 } else if (option == OPT_COMPARE) {
11218 int nocase = 0;
11219 if ((argc != 4 && argc != 5) ||
11220 (argc == 5 && Jim_CompareStringImmediate(interp,
11221 argv[2], "-nocase") == 0)) {
11222 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11223 return JIM_ERR;
11224 }
11225 if (argc == 5) {
11226 nocase = 1;
11227 argv++;
11228 }
11229 Jim_SetResult(interp, Jim_NewIntObj(interp,
11230 Jim_StringCompareObj(argv[2],
11231 argv[3], nocase)));
11232 return JIM_OK;
11233 } else if (option == OPT_MATCH) {
11234 int nocase = 0;
11235 if ((argc != 4 && argc != 5) ||
11236 (argc == 5 && Jim_CompareStringImmediate(interp,
11237 argv[2], "-nocase") == 0)) {
11238 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11239 "string");
11240 return JIM_ERR;
11241 }
11242 if (argc == 5) {
11243 nocase = 1;
11244 argv++;
11245 }
11246 Jim_SetResult(interp,
11247 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11248 argv[3], nocase)));
11249 return JIM_OK;
11250 } else if (option == OPT_EQUAL) {
11251 if (argc != 4) {
11252 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11253 return JIM_ERR;
11254 }
11255 Jim_SetResult(interp,
11256 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11257 argv[3], 0)));
11258 return JIM_OK;
11259 } else if (option == OPT_RANGE) {
11260 Jim_Obj *objPtr;
11261
11262 if (argc != 5) {
11263 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11264 return JIM_ERR;
11265 }
11266 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11267 if (objPtr == NULL)
11268 return JIM_ERR;
11269 Jim_SetResult(interp, objPtr);
11270 return JIM_OK;
11271 } else if (option == OPT_MAP) {
11272 int nocase = 0;
11273 Jim_Obj *objPtr;
11274
11275 if ((argc != 4 && argc != 5) ||
11276 (argc == 5 && Jim_CompareStringImmediate(interp,
11277 argv[2], "-nocase") == 0)) {
11278 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11279 "string");
11280 return JIM_ERR;
11281 }
11282 if (argc == 5) {
11283 nocase = 1;
11284 argv++;
11285 }
11286 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11287 if (objPtr == NULL)
11288 return JIM_ERR;
11289 Jim_SetResult(interp, objPtr);
11290 return JIM_OK;
11291 } else if (option == OPT_REPEAT) {
11292 Jim_Obj *objPtr;
11293 jim_wide count;
11294
11295 if (argc != 4) {
11296 Jim_WrongNumArgs(interp, 2, argv, "string count");
11297 return JIM_ERR;
11298 }
11299 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11300 return JIM_ERR;
11301 objPtr = Jim_NewStringObj(interp, "", 0);
11302 while (count--) {
11303 Jim_AppendObj(interp, objPtr, argv[2]);
11304 }
11305 Jim_SetResult(interp, objPtr);
11306 return JIM_OK;
11307 } else if (option == OPT_INDEX) {
11308 int index, len;
11309 const char *str;
11310
11311 if (argc != 4) {
11312 Jim_WrongNumArgs(interp, 2, argv, "string index");
11313 return JIM_ERR;
11314 }
11315 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11316 return JIM_ERR;
11317 str = Jim_GetString(argv[2], &len);
11318 if (index != INT_MIN && index != INT_MAX)
11319 index = JimRelToAbsIndex(len, index);
11320 if (index < 0 || index >= len) {
11321 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11322 return JIM_OK;
11323 } else {
11324 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11325 return JIM_OK;
11326 }
11327 } else if (option == OPT_FIRST) {
11328 int index = 0, l1, l2;
11329 const char *s1, *s2;
11330
11331 if (argc != 4 && argc != 5) {
11332 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11333 return JIM_ERR;
11334 }
11335 s1 = Jim_GetString(argv[2], &l1);
11336 s2 = Jim_GetString(argv[3], &l2);
11337 if (argc == 5) {
11338 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11339 return JIM_ERR;
11340 index = JimRelToAbsIndex(l2, index);
11341 }
11342 Jim_SetResult(interp, Jim_NewIntObj(interp,
11343 JimStringFirst(s1, l1, s2, l2, index)));
11344 return JIM_OK;
11345 } else if (option == OPT_TOLOWER) {
11346 if (argc != 3) {
11347 Jim_WrongNumArgs(interp, 2, argv, "string");
11348 return JIM_ERR;
11349 }
11350 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11351 } else if (option == OPT_TOUPPER) {
11352 if (argc != 3) {
11353 Jim_WrongNumArgs(interp, 2, argv, "string");
11354 return JIM_ERR;
11355 }
11356 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11357 }
11358 return JIM_OK;
11359 }
11360
11361 /* [time] */
11362 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11363 Jim_Obj *const *argv)
11364 {
11365 long i, count = 1;
11366 jim_wide start, elapsed;
11367 char buf [256];
11368 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11369
11370 if (argc < 2) {
11371 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11372 return JIM_ERR;
11373 }
11374 if (argc == 3) {
11375 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11376 return JIM_ERR;
11377 }
11378 if (count < 0)
11379 return JIM_OK;
11380 i = count;
11381 start = JimClock();
11382 while (i-- > 0) {
11383 int retval;
11384
11385 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11386 return retval;
11387 }
11388 elapsed = JimClock() - start;
11389 sprintf(buf, fmt, elapsed/count);
11390 Jim_SetResultString(interp, buf, -1);
11391 return JIM_OK;
11392 }
11393
11394 /* [exit] */
11395 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11396 Jim_Obj *const *argv)
11397 {
11398 long exitCode = 0;
11399
11400 if (argc > 2) {
11401 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11402 return JIM_ERR;
11403 }
11404 if (argc == 2) {
11405 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11406 return JIM_ERR;
11407 }
11408 interp->exitCode = exitCode;
11409 return JIM_EXIT;
11410 }
11411
11412 /* [catch] */
11413 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11414 Jim_Obj *const *argv)
11415 {
11416 int exitCode = 0;
11417
11418 if (argc != 2 && argc != 3) {
11419 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11420 return JIM_ERR;
11421 }
11422 exitCode = Jim_EvalObj(interp, argv[1]);
11423 if (argc == 3) {
11424 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11425 != JIM_OK)
11426 return JIM_ERR;
11427 }
11428 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11429 return JIM_OK;
11430 }
11431
11432 /* [ref] */
11433 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11434 Jim_Obj *const *argv)
11435 {
11436 if (argc != 3 && argc != 4) {
11437 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11438 return JIM_ERR;
11439 }
11440 if (argc == 3) {
11441 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11442 } else {
11443 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11444 argv[3]));
11445 }
11446 return JIM_OK;
11447 }
11448
11449 /* [getref] */
11450 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11451 Jim_Obj *const *argv)
11452 {
11453 Jim_Reference *refPtr;
11454
11455 if (argc != 2) {
11456 Jim_WrongNumArgs(interp, 1, argv, "reference");
11457 return JIM_ERR;
11458 }
11459 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11460 return JIM_ERR;
11461 Jim_SetResult(interp, refPtr->objPtr);
11462 return JIM_OK;
11463 }
11464
11465 /* [setref] */
11466 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11467 Jim_Obj *const *argv)
11468 {
11469 Jim_Reference *refPtr;
11470
11471 if (argc != 3) {
11472 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11473 return JIM_ERR;
11474 }
11475 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11476 return JIM_ERR;
11477 Jim_IncrRefCount(argv[2]);
11478 Jim_DecrRefCount(interp, refPtr->objPtr);
11479 refPtr->objPtr = argv[2];
11480 Jim_SetResult(interp, argv[2]);
11481 return JIM_OK;
11482 }
11483
11484 /* [collect] */
11485 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11486 Jim_Obj *const *argv)
11487 {
11488 if (argc != 1) {
11489 Jim_WrongNumArgs(interp, 1, argv, "");
11490 return JIM_ERR;
11491 }
11492 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11493 return JIM_OK;
11494 }
11495
11496 /* [finalize] reference ?newValue? */
11497 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11498 Jim_Obj *const *argv)
11499 {
11500 if (argc != 2 && argc != 3) {
11501 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11502 return JIM_ERR;
11503 }
11504 if (argc == 2) {
11505 Jim_Obj *cmdNamePtr;
11506
11507 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11508 return JIM_ERR;
11509 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11510 Jim_SetResult(interp, cmdNamePtr);
11511 } else {
11512 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11513 return JIM_ERR;
11514 Jim_SetResult(interp, argv[2]);
11515 }
11516 return JIM_OK;
11517 }
11518
11519 /* TODO */
11520 /* [info references] (list of all the references/finalizers) */
11521
11522 /* [rename] */
11523 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11524 Jim_Obj *const *argv)
11525 {
11526 const char *oldName, *newName;
11527
11528 if (argc != 3) {
11529 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11530 return JIM_ERR;
11531 }
11532 oldName = Jim_GetString(argv[1], NULL);
11533 newName = Jim_GetString(argv[2], NULL);
11534 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11535 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11536 Jim_AppendStrings(interp, Jim_GetResult(interp),
11537 "can't rename \"", oldName, "\": ",
11538 "command doesn't exist", NULL);
11539 return JIM_ERR;
11540 }
11541 return JIM_OK;
11542 }
11543
11544 /* [dict] */
11545 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11546 Jim_Obj *const *argv)
11547 {
11548 int option;
11549 const char *options[] = {
11550 "create", "get", "set", "unset", "exists", NULL
11551 };
11552 enum {
11553 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11554 };
11555
11556 if (argc < 2) {
11557 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11558 return JIM_ERR;
11559 }
11560
11561 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11562 JIM_ERRMSG) != JIM_OK)
11563 return JIM_ERR;
11564
11565 if (option == OPT_CREATE) {
11566 Jim_Obj *objPtr;
11567
11568 if (argc % 2) {
11569 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11570 return JIM_ERR;
11571 }
11572 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11573 Jim_SetResult(interp, objPtr);
11574 return JIM_OK;
11575 } else if (option == OPT_GET) {
11576 Jim_Obj *objPtr;
11577
11578 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11579 JIM_ERRMSG) != JIM_OK)
11580 return JIM_ERR;
11581 Jim_SetResult(interp, objPtr);
11582 return JIM_OK;
11583 } else if (option == OPT_SET) {
11584 if (argc < 5) {
11585 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11586 return JIM_ERR;
11587 }
11588 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11589 argv[argc-1]);
11590 } else if (option == OPT_UNSET) {
11591 if (argc < 4) {
11592 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11593 return JIM_ERR;
11594 }
11595 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11596 NULL);
11597 } else if (option == OPT_EXIST) {
11598 Jim_Obj *objPtr;
11599 int exists;
11600
11601 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11602 JIM_ERRMSG) == JIM_OK)
11603 exists = 1;
11604 else
11605 exists = 0;
11606 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11607 return JIM_OK;
11608 } else {
11609 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11610 Jim_AppendStrings(interp, Jim_GetResult(interp),
11611 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11612 " must be create, get, set", NULL);
11613 return JIM_ERR;
11614 }
11615 return JIM_OK;
11616 }
11617
11618 /* [load] */
11619 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11620 Jim_Obj *const *argv)
11621 {
11622 if (argc < 2) {
11623 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11624 return JIM_ERR;
11625 }
11626 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11627 }
11628
11629 /* [subst] */
11630 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11631 Jim_Obj *const *argv)
11632 {
11633 int i, flags = 0;
11634 Jim_Obj *objPtr;
11635
11636 if (argc < 2) {
11637 Jim_WrongNumArgs(interp, 1, argv,
11638 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11639 return JIM_ERR;
11640 }
11641 i = argc-2;
11642 while (i--) {
11643 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11644 "-nobackslashes"))
11645 flags |= JIM_SUBST_NOESC;
11646 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11647 "-novariables"))
11648 flags |= JIM_SUBST_NOVAR;
11649 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11650 "-nocommands"))
11651 flags |= JIM_SUBST_NOCMD;
11652 else {
11653 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11654 Jim_AppendStrings(interp, Jim_GetResult(interp),
11655 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11656 "\": must be -nobackslashes, -nocommands, or "
11657 "-novariables", NULL);
11658 return JIM_ERR;
11659 }
11660 }
11661 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11662 return JIM_ERR;
11663 Jim_SetResult(interp, objPtr);
11664 return JIM_OK;
11665 }
11666
11667 /* [info] */
11668 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11669 Jim_Obj *const *argv)
11670 {
11671 int cmd, result = JIM_OK;
11672 static const char *commands[] = {
11673 "body", "commands", "exists", "globals", "level", "locals",
11674 "vars", "version", "complete", "args", "hostname", NULL
11675 };
11676 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11677 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11678
11679 if (argc < 2) {
11680 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11681 return JIM_ERR;
11682 }
11683 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11684 != JIM_OK) {
11685 return JIM_ERR;
11686 }
11687
11688 if (cmd == INFO_COMMANDS) {
11689 if (argc != 2 && argc != 3) {
11690 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11691 return JIM_ERR;
11692 }
11693 if (argc == 3)
11694 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11695 else
11696 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11697 } else if (cmd == INFO_EXISTS) {
11698 Jim_Obj *exists;
11699 if (argc != 3) {
11700 Jim_WrongNumArgs(interp, 2, argv, "varName");
11701 return JIM_ERR;
11702 }
11703 exists = Jim_GetVariable(interp, argv[2], 0);
11704 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11705 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11706 int mode;
11707 switch (cmd) {
11708 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11709 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11710 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11711 default: mode = 0; /* avoid warning */; break;
11712 }
11713 if (argc != 2 && argc != 3) {
11714 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11715 return JIM_ERR;
11716 }
11717 if (argc == 3)
11718 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11719 else
11720 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11721 } else if (cmd == INFO_LEVEL) {
11722 Jim_Obj *objPtr;
11723 switch (argc) {
11724 case 2:
11725 Jim_SetResult(interp,
11726 Jim_NewIntObj(interp, interp->numLevels));
11727 break;
11728 case 3:
11729 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11730 return JIM_ERR;
11731 Jim_SetResult(interp, objPtr);
11732 break;
11733 default:
11734 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11735 return JIM_ERR;
11736 }
11737 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11738 Jim_Cmd *cmdPtr;
11739
11740 if (argc != 3) {
11741 Jim_WrongNumArgs(interp, 2, argv, "procname");
11742 return JIM_ERR;
11743 }
11744 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11745 return JIM_ERR;
11746 if (cmdPtr->cmdProc != NULL) {
11747 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11748 Jim_AppendStrings(interp, Jim_GetResult(interp),
11749 "command \"", Jim_GetString(argv[2], NULL),
11750 "\" is not a procedure", NULL);
11751 return JIM_ERR;
11752 }
11753 if (cmd == INFO_BODY)
11754 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11755 else
11756 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11757 } else if (cmd == INFO_VERSION) {
11758 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11759 sprintf(buf, "%d.%d",
11760 JIM_VERSION / 100, JIM_VERSION % 100);
11761 Jim_SetResultString(interp, buf, -1);
11762 } else if (cmd == INFO_COMPLETE) {
11763 const char *s;
11764 int len;
11765
11766 if (argc != 3) {
11767 Jim_WrongNumArgs(interp, 2, argv, "script");
11768 return JIM_ERR;
11769 }
11770 s = Jim_GetString(argv[2], &len);
11771 Jim_SetResult(interp,
11772 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11773 } else if (cmd == INFO_HOSTNAME) {
11774 /* Redirect to os.hostname if it exists */
11775 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11776 result = Jim_EvalObjVector(interp, 1, &command);
11777 }
11778 return result;
11779 }
11780
11781 /* [split] */
11782 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11783 Jim_Obj *const *argv)
11784 {
11785 const char *str, *splitChars, *noMatchStart;
11786 int splitLen, strLen, i;
11787 Jim_Obj *resObjPtr;
11788
11789 if (argc != 2 && argc != 3) {
11790 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11791 return JIM_ERR;
11792 }
11793 /* Init */
11794 if (argc == 2) {
11795 splitChars = " \n\t\r";
11796 splitLen = 4;
11797 } else {
11798 splitChars = Jim_GetString(argv[2], &splitLen);
11799 }
11800 str = Jim_GetString(argv[1], &strLen);
11801 if (!strLen) return JIM_OK;
11802 noMatchStart = str;
11803 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11804 /* Split */
11805 if (splitLen) {
11806 while (strLen) {
11807 for (i = 0; i < splitLen; i++) {
11808 if (*str == splitChars[i]) {
11809 Jim_Obj *objPtr;
11810
11811 objPtr = Jim_NewStringObj(interp, noMatchStart,
11812 (str-noMatchStart));
11813 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11814 noMatchStart = str + 1;
11815 break;
11816 }
11817 }
11818 str ++;
11819 strLen --;
11820 }
11821 Jim_ListAppendElement(interp, resObjPtr,
11822 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11823 } else {
11824 /* This handles the special case of splitchars eq {}. This
11825 * is trivial but we want to perform object sharing as Tcl does. */
11826 Jim_Obj *objCache[256];
11827 const unsigned char *u = (unsigned char*) str;
11828 memset(objCache, 0, sizeof(objCache));
11829 for (i = 0; i < strLen; i++) {
11830 int c = u[i];
11831
11832 if (objCache[c] == NULL)
11833 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11834 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11835 }
11836 }
11837 Jim_SetResult(interp, resObjPtr);
11838 return JIM_OK;
11839 }
11840
11841 /* [join] */
11842 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11843 Jim_Obj *const *argv)
11844 {
11845 const char *joinStr;
11846 int joinStrLen, i, listLen;
11847 Jim_Obj *resObjPtr;
11848
11849 if (argc != 2 && argc != 3) {
11850 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11851 return JIM_ERR;
11852 }
11853 /* Init */
11854 if (argc == 2) {
11855 joinStr = " ";
11856 joinStrLen = 1;
11857 } else {
11858 joinStr = Jim_GetString(argv[2], &joinStrLen);
11859 }
11860 Jim_ListLength(interp, argv[1], &listLen);
11861 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11862 /* Split */
11863 for (i = 0; i < listLen; i++) {
11864 Jim_Obj *objPtr=NULL;
11865
11866 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11867 Jim_AppendObj(interp, resObjPtr, objPtr);
11868 if (i + 1 != listLen) {
11869 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11870 }
11871 }
11872 Jim_SetResult(interp, resObjPtr);
11873 return JIM_OK;
11874 }
11875
11876 /* [format] */
11877 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11878 Jim_Obj *const *argv)
11879 {
11880 Jim_Obj *objPtr;
11881
11882 if (argc < 2) {
11883 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11884 return JIM_ERR;
11885 }
11886 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11887 if (objPtr == NULL)
11888 return JIM_ERR;
11889 Jim_SetResult(interp, objPtr);
11890 return JIM_OK;
11891 }
11892
11893 /* [scan] */
11894 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11895 Jim_Obj *const *argv)
11896 {
11897 Jim_Obj *listPtr, **outVec;
11898 int outc, i, count = 0;
11899
11900 if (argc < 3) {
11901 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11902 return JIM_ERR;
11903 }
11904 if (argv[2]->typePtr != &scanFmtStringObjType)
11905 SetScanFmtFromAny(interp, argv[2]);
11906 if (FormatGetError(argv[2]) != 0) {
11907 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11908 return JIM_ERR;
11909 }
11910 if (argc > 3) {
11911 int maxPos = FormatGetMaxPos(argv[2]);
11912 int count = FormatGetCnvCount(argv[2]);
11913 if (maxPos > argc-3) {
11914 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11915 return JIM_ERR;
11916 } else if (count != 0 && count < argc-3) {
11917 Jim_SetResultString(interp, "variable is not assigned by any "
11918 "conversion specifiers", -1);
11919 return JIM_ERR;
11920 } else if (count > argc-3) {
11921 Jim_SetResultString(interp, "different numbers of variable names and "
11922 "field specifiers", -1);
11923 return JIM_ERR;
11924 }
11925 }
11926 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11927 if (listPtr == 0)
11928 return JIM_ERR;
11929 if (argc > 3) {
11930 int len = 0;
11931 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11932 Jim_ListLength(interp, listPtr, &len);
11933 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11934 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11935 return JIM_OK;
11936 }
11937 JimListGetElements(interp, listPtr, &outc, &outVec);
11938 for (i = 0; i < outc; ++i) {
11939 if (Jim_Length(outVec[i]) > 0) {
11940 ++count;
11941 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11942 goto err;
11943 }
11944 }
11945 Jim_FreeNewObj(interp, listPtr);
11946 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11947 } else {
11948 if (listPtr == (Jim_Obj*)EOF) {
11949 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11950 return JIM_OK;
11951 }
11952 Jim_SetResult(interp, listPtr);
11953 }
11954 return JIM_OK;
11955 err:
11956 Jim_FreeNewObj(interp, listPtr);
11957 return JIM_ERR;
11958 }
11959
11960 /* [error] */
11961 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11962 Jim_Obj *const *argv)
11963 {
11964 if (argc != 2) {
11965 Jim_WrongNumArgs(interp, 1, argv, "message");
11966 return JIM_ERR;
11967 }
11968 Jim_SetResult(interp, argv[1]);
11969 return JIM_ERR;
11970 }
11971
11972 /* [lrange] */
11973 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11974 Jim_Obj *const *argv)
11975 {
11976 Jim_Obj *objPtr;
11977
11978 if (argc != 4) {
11979 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11980 return JIM_ERR;
11981 }
11982 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11983 return JIM_ERR;
11984 Jim_SetResult(interp, objPtr);
11985 return JIM_OK;
11986 }
11987
11988 /* [env] */
11989 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11990 Jim_Obj *const *argv)
11991 {
11992 const char *key;
11993 char *val;
11994
11995 if (argc == 1) {
11996
11997 #ifdef NEED_ENVIRON_EXTERN
11998 extern char **environ;
11999 #endif
12000
12001 int i;
12002 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12003
12004 for (i = 0; environ[i]; i++) {
12005 const char *equals = strchr(environ[i], '=');
12006 if (equals) {
12007 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
12008 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12009 }
12010 }
12011
12012 Jim_SetResult(interp, listObjPtr);
12013 return JIM_OK;
12014 }
12015
12016 if (argc != 2) {
12017 Jim_WrongNumArgs(interp, 1, argv, "varName");
12018 return JIM_ERR;
12019 }
12020 key = Jim_GetString(argv[1], NULL);
12021 val = getenv(key);
12022 if (val == NULL) {
12023 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12024 Jim_AppendStrings(interp, Jim_GetResult(interp),
12025 "environment variable \"",
12026 key, "\" does not exist", NULL);
12027 return JIM_ERR;
12028 }
12029 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12030 return JIM_OK;
12031 }
12032
12033 /* [source] */
12034 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12035 Jim_Obj *const *argv)
12036 {
12037 int retval;
12038
12039 if (argc != 2) {
12040 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12041 return JIM_ERR;
12042 }
12043 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12044 if (retval == JIM_ERR) {
12045 return JIM_ERR_ADDSTACK;
12046 }
12047 if (retval == JIM_RETURN)
12048 return JIM_OK;
12049 return retval;
12050 }
12051
12052 /* [lreverse] */
12053 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12054 Jim_Obj *const *argv)
12055 {
12056 Jim_Obj *revObjPtr, **ele;
12057 int len;
12058
12059 if (argc != 2) {
12060 Jim_WrongNumArgs(interp, 1, argv, "list");
12061 return JIM_ERR;
12062 }
12063 JimListGetElements(interp, argv[1], &len, &ele);
12064 len--;
12065 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12066 while (len >= 0)
12067 ListAppendElement(revObjPtr, ele[len--]);
12068 Jim_SetResult(interp, revObjPtr);
12069 return JIM_OK;
12070 }
12071
12072 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12073 {
12074 jim_wide len;
12075
12076 if (step == 0) return -1;
12077 if (start == end) return 0;
12078 else if (step > 0 && start > end) return -1;
12079 else if (step < 0 && end > start) return -1;
12080 len = end-start;
12081 if (len < 0) len = -len; /* abs(len) */
12082 if (step < 0) step = -step; /* abs(step) */
12083 len = 1 + ((len-1)/step);
12084 /* We can truncate safely to INT_MAX, the range command
12085 * will always return an error for a such long range
12086 * because Tcl lists can't be so long. */
12087 if (len > INT_MAX) len = INT_MAX;
12088 return (int)((len < 0) ? -1 : len);
12089 }
12090
12091 /* [range] */
12092 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12093 Jim_Obj *const *argv)
12094 {
12095 jim_wide start = 0, end, step = 1;
12096 int len, i;
12097 Jim_Obj *objPtr;
12098
12099 if (argc < 2 || argc > 4) {
12100 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12101 return JIM_ERR;
12102 }
12103 if (argc == 2) {
12104 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12105 return JIM_ERR;
12106 } else {
12107 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12108 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12109 return JIM_ERR;
12110 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12111 return JIM_ERR;
12112 }
12113 if ((len = JimRangeLen(start, end, step)) == -1) {
12114 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12115 return JIM_ERR;
12116 }
12117 objPtr = Jim_NewListObj(interp, NULL, 0);
12118 for (i = 0; i < len; i++)
12119 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12120 Jim_SetResult(interp, objPtr);
12121 return JIM_OK;
12122 }
12123
12124 /* [rand] */
12125 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12126 Jim_Obj *const *argv)
12127 {
12128 jim_wide min = 0, max =0, len, maxMul;
12129
12130 if (argc < 1 || argc > 3) {
12131 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12132 return JIM_ERR;
12133 }
12134 if (argc == 1) {
12135 max = JIM_WIDE_MAX;
12136 } else if (argc == 2) {
12137 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12138 return JIM_ERR;
12139 } else if (argc == 3) {
12140 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12141 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12142 return JIM_ERR;
12143 }
12144 len = max-min;
12145 if (len < 0) {
12146 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12147 return JIM_ERR;
12148 }
12149 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12150 while (1) {
12151 jim_wide r;
12152
12153 JimRandomBytes(interp, &r, sizeof(jim_wide));
12154 if (r < 0 || r >= maxMul) continue;
12155 r = (len == 0) ? 0 : r%len;
12156 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12157 return JIM_OK;
12158 }
12159 }
12160
12161 /* [package] */
12162 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12163 Jim_Obj *const *argv)
12164 {
12165 int option;
12166 const char *options[] = {
12167 "require", "provide", NULL
12168 };
12169 enum {OPT_REQUIRE, OPT_PROVIDE};
12170
12171 if (argc < 2) {
12172 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12173 return JIM_ERR;
12174 }
12175 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12176 JIM_ERRMSG) != JIM_OK)
12177 return JIM_ERR;
12178
12179 if (option == OPT_REQUIRE) {
12180 int exact = 0;
12181 const char *ver;
12182
12183 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12184 exact = 1;
12185 argv++;
12186 argc--;
12187 }
12188 if (argc != 3 && argc != 4) {
12189 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12190 return JIM_ERR;
12191 }
12192 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12193 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12194 JIM_ERRMSG);
12195 if (ver == NULL)
12196 return JIM_ERR_ADDSTACK;
12197 Jim_SetResultString(interp, ver, -1);
12198 } else if (option == OPT_PROVIDE) {
12199 if (argc != 4) {
12200 Jim_WrongNumArgs(interp, 2, argv, "package version");
12201 return JIM_ERR;
12202 }
12203 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12204 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12205 }
12206 return JIM_OK;
12207 }
12208
12209 static struct {
12210 const char *name;
12211 Jim_CmdProc cmdProc;
12212 } Jim_CoreCommandsTable[] = {
12213 {"set", Jim_SetCoreCommand},
12214 {"unset", Jim_UnsetCoreCommand},
12215 {"puts", Jim_PutsCoreCommand},
12216 {"+", Jim_AddCoreCommand},
12217 {"*", Jim_MulCoreCommand},
12218 {"-", Jim_SubCoreCommand},
12219 {"/", Jim_DivCoreCommand},
12220 {"incr", Jim_IncrCoreCommand},
12221 {"while", Jim_WhileCoreCommand},
12222 {"for", Jim_ForCoreCommand},
12223 {"foreach", Jim_ForeachCoreCommand},
12224 {"lmap", Jim_LmapCoreCommand},
12225 {"if", Jim_IfCoreCommand},
12226 {"switch", Jim_SwitchCoreCommand},
12227 {"list", Jim_ListCoreCommand},
12228 {"lindex", Jim_LindexCoreCommand},
12229 {"lset", Jim_LsetCoreCommand},
12230 {"llength", Jim_LlengthCoreCommand},
12231 {"lappend", Jim_LappendCoreCommand},
12232 {"linsert", Jim_LinsertCoreCommand},
12233 {"lsort", Jim_LsortCoreCommand},
12234 {"append", Jim_AppendCoreCommand},
12235 {"debug", Jim_DebugCoreCommand},
12236 {"eval", Jim_EvalCoreCommand},
12237 {"uplevel", Jim_UplevelCoreCommand},
12238 {"expr", Jim_ExprCoreCommand},
12239 {"break", Jim_BreakCoreCommand},
12240 {"continue", Jim_ContinueCoreCommand},
12241 {"proc", Jim_ProcCoreCommand},
12242 {"concat", Jim_ConcatCoreCommand},
12243 {"return", Jim_ReturnCoreCommand},
12244 {"upvar", Jim_UpvarCoreCommand},
12245 {"global", Jim_GlobalCoreCommand},
12246 {"string", Jim_StringCoreCommand},
12247 {"time", Jim_TimeCoreCommand},
12248 {"exit", Jim_ExitCoreCommand},
12249 {"catch", Jim_CatchCoreCommand},
12250 {"ref", Jim_RefCoreCommand},
12251 {"getref", Jim_GetrefCoreCommand},
12252 {"setref", Jim_SetrefCoreCommand},
12253 {"finalize", Jim_FinalizeCoreCommand},
12254 {"collect", Jim_CollectCoreCommand},
12255 {"rename", Jim_RenameCoreCommand},
12256 {"dict", Jim_DictCoreCommand},
12257 {"load", Jim_LoadCoreCommand},
12258 {"subst", Jim_SubstCoreCommand},
12259 {"info", Jim_InfoCoreCommand},
12260 {"split", Jim_SplitCoreCommand},
12261 {"join", Jim_JoinCoreCommand},
12262 {"format", Jim_FormatCoreCommand},
12263 {"scan", Jim_ScanCoreCommand},
12264 {"error", Jim_ErrorCoreCommand},
12265 {"lrange", Jim_LrangeCoreCommand},
12266 {"env", Jim_EnvCoreCommand},
12267 {"source", Jim_SourceCoreCommand},
12268 {"lreverse", Jim_LreverseCoreCommand},
12269 {"range", Jim_RangeCoreCommand},
12270 {"rand", Jim_RandCoreCommand},
12271 {"package", Jim_PackageCoreCommand},
12272 {"tailcall", Jim_TailcallCoreCommand},
12273 {NULL, NULL},
12274 };
12275
12276 /* Some Jim core command is actually a procedure written in Jim itself. */
12277 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12278 {
12279 Jim_Eval(interp, (char*)
12280 "proc lambda {arglist args} {\n"
12281 " set name [ref {} function lambdaFinalizer]\n"
12282 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12283 " return $name\n"
12284 "}\n"
12285 "proc lambdaFinalizer {name val} {\n"
12286 " rename $name {}\n"
12287 "}\n"
12288 );
12289 }
12290
12291 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12292 {
12293 int i = 0;
12294
12295 while (Jim_CoreCommandsTable[i].name != NULL) {
12296 Jim_CreateCommand(interp,
12297 Jim_CoreCommandsTable[i].name,
12298 Jim_CoreCommandsTable[i].cmdProc,
12299 NULL, NULL);
12300 i++;
12301 }
12302 Jim_RegisterCoreProcedures(interp);
12303 }
12304
12305 /* -----------------------------------------------------------------------------
12306 * Interactive prompt
12307 * ---------------------------------------------------------------------------*/
12308 void Jim_PrintErrorMessage(Jim_Interp *interp)
12309 {
12310 int len, i;
12311
12312 if (*interp->errorFileName) {
12313 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12314 interp->errorFileName, interp->errorLine);
12315 }
12316 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12317 Jim_GetString(interp->result, NULL));
12318 Jim_ListLength(interp, interp->stackTrace, &len);
12319 for (i = len-3; i >= 0; i-= 3) {
12320 Jim_Obj *objPtr=NULL;
12321 const char *proc, *file, *line;
12322
12323 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12324 proc = Jim_GetString(objPtr, NULL);
12325 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12326 JIM_NONE);
12327 file = Jim_GetString(objPtr, NULL);
12328 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12329 JIM_NONE);
12330 line = Jim_GetString(objPtr, NULL);
12331 if (*proc) {
12332 Jim_fprintf(interp, interp->cookie_stderr,
12333 "in procedure '%s' ", proc);
12334 }
12335 if (*file) {
12336 Jim_fprintf(interp, interp->cookie_stderr,
12337 "called at file \"%s\", line %s",
12338 file, line);
12339 }
12340 if (*file || *proc) {
12341 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12342 }
12343 }
12344 }
12345
12346 int Jim_InteractivePrompt(Jim_Interp *interp)
12347 {
12348 int retcode = JIM_OK;
12349 Jim_Obj *scriptObjPtr;
12350
12351 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12352 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12353 JIM_VERSION / 100, JIM_VERSION % 100);
12354 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12355 while (1) {
12356 char buf[1024];
12357 const char *result;
12358 const char *retcodestr[] = {
12359 "ok", "error", "return", "break", "continue", "eval", "exit"
12360 };
12361 int reslen;
12362
12363 if (retcode != 0) {
12364 if (retcode >= 2 && retcode <= 6)
12365 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12366 else
12367 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12368 } else
12369 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12370 Jim_fflush(interp, interp->cookie_stdout);
12371 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12372 Jim_IncrRefCount(scriptObjPtr);
12373 while (1) {
12374 const char *str;
12375 char state;
12376 int len;
12377
12378 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12379 Jim_DecrRefCount(interp, scriptObjPtr);
12380 goto out;
12381 }
12382 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12383 str = Jim_GetString(scriptObjPtr, &len);
12384 if (Jim_ScriptIsComplete(str, len, &state))
12385 break;
12386 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12387 Jim_fflush(interp, interp->cookie_stdout);
12388 }
12389 retcode = Jim_EvalObj(interp, scriptObjPtr);
12390 Jim_DecrRefCount(interp, scriptObjPtr);
12391 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12392 if (retcode == JIM_ERR) {
12393 Jim_PrintErrorMessage(interp);
12394 } else if (retcode == JIM_EXIT) {
12395 exit(Jim_GetExitCode(interp));
12396 } else {
12397 if (reslen) {
12398 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12399 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12400 }
12401 }
12402 }
12403 out:
12404 return 0;
12405 }
12406
12407 /* -----------------------------------------------------------------------------
12408 * Jim's idea of STDIO..
12409 * ---------------------------------------------------------------------------*/
12410
12411 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12412 {
12413 int r;
12414
12415 va_list ap;
12416 va_start(ap,fmt);
12417 r = Jim_vfprintf(interp, cookie, fmt,ap);
12418 va_end(ap);
12419 return r;
12420 }
12421
12422 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12423 {
12424 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12425 errno = ENOTSUP;
12426 return -1;
12427 }
12428 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12429 }
12430
12431 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12432 {
12433 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12434 errno = ENOTSUP;
12435 return 0;
12436 }
12437 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12438 }
12439
12440 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12441 {
12442 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12443 errno = ENOTSUP;
12444 return 0;
12445 }
12446 return (*(interp->cb_fread))(ptr, size, n, cookie);
12447 }
12448
12449 int Jim_fflush(Jim_Interp *interp, void *cookie)
12450 {
12451 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12452 /* pretend all is well */
12453 return 0;
12454 }
12455 return (*(interp->cb_fflush))(cookie);
12456 }
12457
12458 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12459 {
12460 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12461 errno = ENOTSUP;
12462 return NULL;
12463 }
12464 return (*(interp->cb_fgets))(s, size, cookie);
12465 }
12466 Jim_Nvp *
12467 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12468 {
12469 while (p->name) {
12470 if (0 == strcmp(name, p->name)) {
12471 break;
12472 }
12473 p++;
12474 }
12475 return ((Jim_Nvp *)(p));
12476 }
12477
12478 Jim_Nvp *
12479 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12480 {
12481 while (p->name) {
12482 if (0 == strcasecmp(name, p->name)) {
12483 break;
12484 }
12485 p++;
12486 }
12487 return ((Jim_Nvp *)(p));
12488 }
12489
12490 int
12491 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12492 const Jim_Nvp *p,
12493 Jim_Obj *o,
12494 Jim_Nvp **result)
12495 {
12496 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12497 }
12498
12499
12500 int
12501 Jim_Nvp_name2value(Jim_Interp *interp,
12502 const Jim_Nvp *_p,
12503 const char *name,
12504 Jim_Nvp **result)
12505 {
12506 const Jim_Nvp *p;
12507
12508 p = Jim_Nvp_name2value_simple(_p, name);
12509
12510 /* result */
12511 if (result) {
12512 *result = (Jim_Nvp *)(p);
12513 }
12514
12515 /* found? */
12516 if (p->name) {
12517 return JIM_OK;
12518 } else {
12519 return JIM_ERR;
12520 }
12521 }
12522
12523 int
12524 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12525 {
12526 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12527 }
12528
12529 int
12530 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12531 {
12532 const Jim_Nvp *p;
12533
12534 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12535
12536 if (puthere) {
12537 *puthere = (Jim_Nvp *)(p);
12538 }
12539 /* found */
12540 if (p->name) {
12541 return JIM_OK;
12542 } else {
12543 return JIM_ERR;
12544 }
12545 }
12546
12547
12548 int
12549 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12550 {
12551 int e;;
12552 jim_wide w;
12553
12554 e = Jim_GetWide(interp, o, &w);
12555 if (e != JIM_OK) {
12556 return e;
12557 }
12558
12559 return Jim_Nvp_value2name(interp, p, w, result);
12560 }
12561
12562 Jim_Nvp *
12563 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12564 {
12565 while (p->name) {
12566 if (value == p->value) {
12567 break;
12568 }
12569 p++;
12570 }
12571 return ((Jim_Nvp *)(p));
12572 }
12573
12574
12575 int
12576 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12577 {
12578 const Jim_Nvp *p;
12579
12580 p = Jim_Nvp_value2name_simple(_p, value);
12581
12582 if (result) {
12583 *result = (Jim_Nvp *)(p);
12584 }
12585
12586 if (p->name) {
12587 return JIM_OK;
12588 } else {
12589 return JIM_ERR;
12590 }
12591 }
12592
12593
12594 int
12595 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12596 {
12597 memset(p, 0, sizeof(*p));
12598 p->interp = interp;
12599 p->argc = argc;
12600 p->argv = argv;
12601
12602 return JIM_OK;
12603 }
12604
12605 void
12606 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12607 {
12608 int x;
12609
12610 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12611 for (x = 0 ; x < p->argc ; x++) {
12612 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12613 "%2d) %s\n",
12614 x,
12615 Jim_GetString(p->argv[x], NULL));
12616 }
12617 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12618 }
12619
12620
12621 int
12622 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12623 {
12624 Jim_Obj *o;
12625
12626 o = NULL; // failure
12627 if (goi->argc) {
12628 // success
12629 o = goi->argv[0];
12630 goi->argc -= 1;
12631 goi->argv += 1;
12632 }
12633 if (puthere) {
12634 *puthere = o;
12635 }
12636 if (o != NULL) {
12637 return JIM_OK;
12638 } else {
12639 return JIM_ERR;
12640 }
12641 }
12642
12643 int
12644 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12645 {
12646 int r;
12647 Jim_Obj *o;
12648 const char *cp;
12649
12650
12651 r = Jim_GetOpt_Obj(goi, &o);
12652 if (r == JIM_OK) {
12653 cp = Jim_GetString(o, len);
12654 if (puthere) {
12655 /* remove const */
12656 *puthere = (char *)(cp);
12657 }
12658 }
12659 return r;
12660 }
12661
12662 int
12663 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12664 {
12665 int r;
12666 Jim_Obj *o;
12667 double _safe;
12668
12669 if (puthere == NULL) {
12670 puthere = &_safe;
12671 }
12672
12673 r = Jim_GetOpt_Obj(goi, &o);
12674 if (r == JIM_OK) {
12675 r = Jim_GetDouble(goi->interp, o, puthere);
12676 if (r != JIM_OK) {
12677 Jim_SetResult_sprintf(goi->interp,
12678 "not a number: %s",
12679 Jim_GetString(o, NULL));
12680 }
12681 }
12682 return r;
12683 }
12684
12685 int
12686 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12687 {
12688 int r;
12689 Jim_Obj *o;
12690 jim_wide _safe;
12691
12692 if (puthere == NULL) {
12693 puthere = &_safe;
12694 }
12695
12696 r = Jim_GetOpt_Obj(goi, &o);
12697 if (r == JIM_OK) {
12698 r = Jim_GetWide(goi->interp, o, puthere);
12699 }
12700 return r;
12701 }
12702
12703 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12704 const Jim_Nvp *nvp,
12705 Jim_Nvp **puthere)
12706 {
12707 Jim_Nvp *_safe;
12708 Jim_Obj *o;
12709 int e;
12710
12711 if (puthere == NULL) {
12712 puthere = &_safe;
12713 }
12714
12715 e = Jim_GetOpt_Obj(goi, &o);
12716 if (e == JIM_OK) {
12717 e = Jim_Nvp_name2value_obj(goi->interp,
12718 nvp,
12719 o,
12720 puthere);
12721 }
12722
12723 return e;
12724 }
12725
12726 void
12727 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12728 const Jim_Nvp *nvptable,
12729 int hadprefix)
12730 {
12731 if (hadprefix) {
12732 Jim_SetResult_NvpUnknown(goi->interp,
12733 goi->argv[-2],
12734 goi->argv[-1],
12735 nvptable);
12736 } else {
12737 Jim_SetResult_NvpUnknown(goi->interp,
12738 NULL,
12739 goi->argv[-1],
12740 nvptable);
12741 }
12742 }
12743
12744
12745 int
12746 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12747 const char * const * lookup,
12748 int *puthere)
12749 {
12750 int _safe;
12751 Jim_Obj *o;
12752 int e;
12753
12754 if (puthere == NULL) {
12755 puthere = &_safe;
12756 }
12757 e = Jim_GetOpt_Obj(goi, &o);
12758 if (e == JIM_OK) {
12759 e = Jim_GetEnum(goi->interp,
12760 o,
12761 lookup,
12762 puthere,
12763 "option",
12764 JIM_ERRMSG);
12765 }
12766 return e;
12767 }
12768
12769
12770
12771 int
12772 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12773 {
12774 va_list ap;
12775 char *buf;
12776
12777 va_start(ap,fmt);
12778 buf = jim_vasprintf(fmt, ap);
12779 va_end(ap);
12780 if (buf) {
12781 Jim_SetResultString(interp, buf, -1);
12782 jim_vasprintf_done(buf);
12783 }
12784 return JIM_OK;
12785 }
12786
12787
12788 void
12789 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12790 Jim_Obj *param_name,
12791 Jim_Obj *param_value,
12792 const Jim_Nvp *nvp)
12793 {
12794 if (param_name) {
12795 Jim_SetResult_sprintf(interp,
12796 "%s: Unknown: %s, try one of: ",
12797 Jim_GetString(param_name, NULL),
12798 Jim_GetString(param_value, NULL));
12799 } else {
12800 Jim_SetResult_sprintf(interp,
12801 "Unknown param: %s, try one of: ",
12802 Jim_GetString(param_value, NULL));
12803 }
12804 while (nvp->name) {
12805 const char *a;
12806 const char *b;
12807
12808 if ((nvp + 1)->name) {
12809 a = nvp->name;
12810 b = ", ";
12811 } else {
12812 a = "or ";
12813 b = nvp->name;
12814 }
12815 Jim_AppendStrings(interp,
12816 Jim_GetResult(interp),
12817 a, b, NULL);
12818 nvp++;
12819 }
12820 }
12821
12822
12823 static Jim_Obj *debug_string_obj;
12824
12825 const char *
12826 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12827 {
12828 int x;
12829
12830 if (debug_string_obj) {
12831 Jim_FreeObj(interp, debug_string_obj);
12832 }
12833
12834 debug_string_obj = Jim_NewEmptyStringObj(interp);
12835 for (x = 0 ; x < argc ; x++) {
12836 Jim_AppendStrings(interp,
12837 debug_string_obj,
12838 Jim_GetString(argv[x], NULL),
12839 " ",
12840 NULL);
12841 }
12842
12843 return Jim_GetString(debug_string_obj, NULL);
12844 }

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)