a1a3675c498a6541fe235d3cf610b6b3c13abec5
[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 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 *
12 * The FreeBSD license
13 *
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
16 * are met:
17 *
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 *
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
41 **/
42 #ifdef HAVE_CONFIG_H
43 #include "config.h"
44 #endif
45
46 #define __JIM_CORE__
47 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
48
49 #ifdef __ECOS
50 #include <pkgconf/jimtcl.h>
51 #include <stdio.h>
52 #include <stdlib.h>
53 #include <string.h>
54 #include <stdarg.h>
55 #include <ctype.h>
56 #include <limits.h>
57 #include <assert.h>
58 #include <errno.h>
59 #include <time.h>
60 #endif
61 #ifndef JIM_ANSIC
62 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
63 #endif /* JIM_ANSIC */
64
65 #include <stdarg.h>
66 #include <limits.h>
67
68 /* Include the platform dependent libraries for
69 * dynamic loading of libraries. */
70 #ifdef JIM_DYNLIB
71 #if defined(_WIN32) || defined(WIN32)
72 #ifndef WIN32
73 #define WIN32 1
74 #endif
75 #ifndef STRICT
76 #define STRICT
77 #endif
78 #define WIN32_LEAN_AND_MEAN
79 #include <windows.h>
80 #if _MSC_VER >= 1000
81 #pragma warning(disable:4146)
82 #endif /* _MSC_VER */
83 #else
84 #include <dlfcn.h>
85 #endif /* WIN32 */
86 #endif /* JIM_DYNLIB */
87
88 #ifdef __ECOS
89 #include <cyg/jimtcl/jim.h>
90 #else
91 #include "jim.h"
92 #endif
93
94 #ifdef HAVE_BACKTRACE
95 #include <execinfo.h>
96 #endif
97
98 /* -----------------------------------------------------------------------------
99 * Global variables
100 * ---------------------------------------------------------------------------*/
101
102 /* A shared empty string for the objects string representation.
103 * Jim_InvalidateStringRep knows about it and don't try to free. */
104 static char *JimEmptyStringRep = (char*) "";
105
106 /* -----------------------------------------------------------------------------
107 * Required prototypes of not exported functions
108 * ---------------------------------------------------------------------------*/
109 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
110 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
111 static void JimRegisterCoreApi(Jim_Interp *interp);
112
113 static Jim_HashTableType *getJimVariablesHashTableType(void);
114
115 /* -----------------------------------------------------------------------------
116 * Utility functions
117 * ---------------------------------------------------------------------------*/
118
119 static char *
120 jim_vasprintf(const char *fmt, va_list ap )
121 {
122 #ifndef HAVE_VASPRINTF
123 /* yucky way */
124 static char buf[2048];
125 vsnprintf(buf, sizeof(buf), fmt, ap );
126 /* garentee termination */
127 buf[sizeof(buf)-1] = 0;
128 #else
129 char *buf;
130 int result;
131 result = vasprintf(&buf, fmt, ap );
132 if (result < 0) exit(-1);
133 #endif
134 return buf;
135 }
136
137 static void
138 jim_vasprintf_done(void *buf )
139 {
140 #ifndef HAVE_VASPRINTF
141 (void)(buf);
142 #else
143 free(buf);
144 #endif
145 }
146
147
148 /*
149 * Convert a string to a jim_wide INTEGER.
150 * This function originates from BSD.
151 *
152 * Ignores `locale' stuff. Assumes that the upper and lower case
153 * alphabets and digits are each contiguous.
154 */
155 #ifdef HAVE_LONG_LONG_INT
156 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
157 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
158 {
159 register const char *s;
160 register unsigned jim_wide acc;
161 register unsigned char c;
162 register unsigned jim_wide qbase, cutoff;
163 register int neg, any, cutlim;
164
165 /*
166 * Skip white space and pick up leading +/- sign if any.
167 * If base is 0, allow 0x for hex and 0 for octal, else
168 * assume decimal; if base is already 16, allow 0x.
169 */
170 s = nptr;
171 do {
172 c = *s++;
173 } while (isspace(c));
174 if (c == '-') {
175 neg = 1;
176 c = *s++;
177 } else {
178 neg = 0;
179 if (c == '+')
180 c = *s++;
181 }
182 if ((base == 0 || base == 16) &&
183 c == '0' && (*s == 'x' || *s == 'X')) {
184 c = s[1];
185 s += 2;
186 base = 16;
187 }
188 if (base == 0)
189 base = c == '0' ? 8 : 10;
190
191 /*
192 * Compute the cutoff value between legal numbers and illegal
193 * numbers. That is the largest legal value, divided by the
194 * base. An input number that is greater than this value, if
195 * followed by a legal input character, is too big. One that
196 * is equal to this value may be valid or not; the limit
197 * between valid and invalid numbers is then based on the last
198 * digit. For instance, if the range for quads is
199 * [-9223372036854775808..9223372036854775807] and the input base
200 * is 10, cutoff will be set to 922337203685477580 and cutlim to
201 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
202 * accumulated a value > 922337203685477580, or equal but the
203 * next digit is > 7 (or 8), the number is too big, and we will
204 * return a range error.
205 *
206 * Set any if any `digits' consumed; make it negative to indicate
207 * overflow.
208 */
209 qbase = (unsigned)base;
210 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
211 : LLONG_MAX;
212 cutlim = (int)(cutoff % qbase);
213 cutoff /= qbase;
214 for (acc = 0, any = 0;; c = *s++) {
215 if (!JimIsAscii(c))
216 break;
217 if (isdigit(c))
218 c -= '0';
219 else if (isalpha(c))
220 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
221 else
222 break;
223 if (c >= base)
224 break;
225 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
226 any = -1;
227 else {
228 any = 1;
229 acc *= qbase;
230 acc += c;
231 }
232 }
233 if (any < 0) {
234 acc = neg ? LLONG_MIN : LLONG_MAX;
235 errno = ERANGE;
236 } else if (neg)
237 acc = -acc;
238 if (endptr != 0)
239 *endptr = (char *)(any ? s - 1 : nptr);
240 return (acc);
241 }
242 #endif
243
244 /* Glob-style pattern matching. */
245 static int JimStringMatch(const char *pattern, int patternLen,
246 const char *string, int stringLen, int nocase)
247 {
248 while (patternLen) {
249 switch (pattern[0]) {
250 case '*':
251 while (pattern[1] == '*') {
252 pattern++;
253 patternLen--;
254 }
255 if (patternLen == 1)
256 return 1; /* match */
257 while (stringLen) {
258 if (JimStringMatch(pattern + 1, patternLen-1,
259 string, stringLen, nocase))
260 return 1; /* match */
261 string++;
262 stringLen--;
263 }
264 return 0; /* no match */
265 break;
266 case '?':
267 if (stringLen == 0)
268 return 0; /* no match */
269 string++;
270 stringLen--;
271 break;
272 case '[':
273 {
274 int not, match;
275
276 pattern++;
277 patternLen--;
278 not = pattern[0] == '^';
279 if (not) {
280 pattern++;
281 patternLen--;
282 }
283 match = 0;
284 while (1) {
285 if (pattern[0] == '\\') {
286 pattern++;
287 patternLen--;
288 if (pattern[0] == string[0])
289 match = 1;
290 } else if (pattern[0] == ']') {
291 break;
292 } else if (patternLen == 0) {
293 pattern--;
294 patternLen++;
295 break;
296 } else if (pattern[1] == '-' && patternLen >= 3) {
297 int start = pattern[0];
298 int end = pattern[2];
299 int c = string[0];
300 if (start > end) {
301 int t = start;
302 start = end;
303 end = t;
304 }
305 if (nocase) {
306 start = tolower(start);
307 end = tolower(end);
308 c = tolower(c);
309 }
310 pattern += 2;
311 patternLen -= 2;
312 if (c >= start && c <= end)
313 match = 1;
314 } else {
315 if (!nocase) {
316 if (pattern[0] == string[0])
317 match = 1;
318 } else {
319 if (tolower((int)pattern[0]) == tolower((int)string[0]))
320 match = 1;
321 }
322 }
323 pattern++;
324 patternLen--;
325 }
326 if (not)
327 match = !match;
328 if (!match)
329 return 0; /* no match */
330 string++;
331 stringLen--;
332 break;
333 }
334 case '\\':
335 if (patternLen >= 2) {
336 pattern++;
337 patternLen--;
338 }
339 /* fall through */
340 default:
341 if (!nocase) {
342 if (pattern[0] != string[0])
343 return 0; /* no match */
344 } else {
345 if (tolower((int)pattern[0]) != tolower((int)string[0]))
346 return 0; /* no match */
347 }
348 string++;
349 stringLen--;
350 break;
351 }
352 pattern++;
353 patternLen--;
354 if (stringLen == 0) {
355 while (*pattern == '*') {
356 pattern++;
357 patternLen--;
358 }
359 break;
360 }
361 }
362 if (patternLen == 0 && stringLen == 0)
363 return 1;
364 return 0;
365 }
366
367 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
368 int nocase)
369 {
370 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
371
372 if (nocase == 0) {
373 while (l1 && l2) {
374 if (*u1 != *u2)
375 return (int)*u1-*u2;
376 u1++; u2++; l1--; l2--;
377 }
378 if (!l1 && !l2) return 0;
379 return l1-l2;
380 } else {
381 while (l1 && l2) {
382 if (tolower((int)*u1) != tolower((int)*u2))
383 return tolower((int)*u1)-tolower((int)*u2);
384 u1++; u2++; l1--; l2--;
385 }
386 if (!l1 && !l2) return 0;
387 return l1-l2;
388 }
389 }
390
391 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
392 * The index of the first occurrence of s1 in s2 is returned.
393 * If s1 is not found inside s2, -1 is returned. */
394 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
395 {
396 int i;
397
398 if (!l1 || !l2 || l1 > l2) return -1;
399 if (index < 0) index = 0;
400 s2 += index;
401 for (i = index; i <= l2-l1; i++) {
402 if (memcmp(s2, s1, l1) == 0)
403 return i;
404 s2++;
405 }
406 return -1;
407 }
408
409 int Jim_WideToString(char *buf, jim_wide wideValue)
410 {
411 const char *fmt = "%" JIM_WIDE_MODIFIER;
412 return sprintf(buf, fmt, wideValue);
413 }
414
415 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
416 {
417 char *endptr;
418
419 #ifdef HAVE_LONG_LONG_INT
420 *widePtr = JimStrtoll(str, &endptr, base);
421 #else
422 *widePtr = strtol(str, &endptr, base);
423 #endif
424 if ((str[0] == '\0') || (str == endptr) )
425 return JIM_ERR;
426 if (endptr[0] != '\0') {
427 while (*endptr) {
428 if (!isspace((int)*endptr))
429 return JIM_ERR;
430 endptr++;
431 }
432 }
433 return JIM_OK;
434 }
435
436 int Jim_StringToIndex(const char *str, int *intPtr)
437 {
438 char *endptr;
439
440 *intPtr = strtol(str, &endptr, 10);
441 if ((str[0] == '\0') || (str == endptr) )
442 return JIM_ERR;
443 if (endptr[0] != '\0') {
444 while (*endptr) {
445 if (!isspace((int)*endptr))
446 return JIM_ERR;
447 endptr++;
448 }
449 }
450 return JIM_OK;
451 }
452
453 /* The string representation of references has two features in order
454 * to make the GC faster. The first is that every reference starts
455 * with a non common character '~', in order to make the string matching
456 * fater. The second is that the reference string rep his 32 characters
457 * in length, this allows to avoid to check every object with a string
458 * repr < 32, and usually there are many of this objects. */
459
460 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
461
462 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
463 {
464 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
465 sprintf(buf, fmt, refPtr->tag, id);
466 return JIM_REFERENCE_SPACE;
467 }
468
469 int Jim_DoubleToString(char *buf, double doubleValue)
470 {
471 char *s;
472 int len;
473
474 len = sprintf(buf, "%.17g", doubleValue);
475 s = buf;
476 while (*s) {
477 if (*s == '.') return len;
478 s++;
479 }
480 /* Add a final ".0" if it's a number. But not
481 * for NaN or InF */
482 if (isdigit((int)buf[0])
483 || ((buf[0] == '-' || buf[0] == '+')
484 && isdigit((int)buf[1]))) {
485 s[0] = '.';
486 s[1] = '0';
487 s[2] = '\0';
488 return len + 2;
489 }
490 return len;
491 }
492
493 int Jim_StringToDouble(const char *str, double *doublePtr)
494 {
495 char *endptr;
496
497 *doublePtr = strtod(str, &endptr);
498 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
499 return JIM_ERR;
500 return JIM_OK;
501 }
502
503 static jim_wide JimPowWide(jim_wide b, jim_wide e)
504 {
505 jim_wide i, res = 1;
506 if ((b == 0 && e != 0) || (e < 0)) return 0;
507 for (i = 0; i < e; i++) {res *= b;}
508 return res;
509 }
510
511 /* -----------------------------------------------------------------------------
512 * Special functions
513 * ---------------------------------------------------------------------------*/
514
515 /* Note that 'interp' may be NULL if not available in the
516 * context of the panic. It's only useful to get the error
517 * file descriptor, it will default to stderr otherwise. */
518 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
519 {
520 va_list ap;
521
522 va_start(ap, fmt);
523 /*
524 * Send it here first.. Assuming STDIO still works
525 */
526 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
527 vfprintf(stderr, fmt, ap);
528 fprintf(stderr, JIM_NL JIM_NL);
529 va_end(ap);
530
531 #ifdef HAVE_BACKTRACE
532 {
533 void *array[40];
534 int size, i;
535 char **strings;
536
537 size = backtrace(array, 40);
538 strings = backtrace_symbols(array, size);
539 for (i = 0; i < size; i++)
540 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
541 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
542 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
543 }
544 #endif
545
546 /* This may actually crash... we do it last */
547 if (interp && interp->cookie_stderr ){
548 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
549 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap );
550 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL );
551 }
552 abort();
553 }
554
555 /* -----------------------------------------------------------------------------
556 * Memory allocation
557 * ---------------------------------------------------------------------------*/
558
559 /* Macro used for memory debugging.
560 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
561 * and similary for Jim_Realloc and Jim_Free */
562 #if 0
563 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
564 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
565 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
566 #endif
567
568 void *Jim_Alloc(int size)
569 {
570 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
571 if (size == 0)
572 size = 1;
573 void *p = malloc(size);
574 if (p == NULL)
575 Jim_Panic(NULL,"malloc: Out of memory");
576 return p;
577 }
578
579 void Jim_Free(void *ptr) {
580 free(ptr);
581 }
582
583 void *Jim_Realloc(void *ptr, int size)
584 {
585 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
586 if (size == 0)
587 size = 1;
588 void *p = realloc(ptr, size);
589 if (p == NULL)
590 Jim_Panic(NULL,"realloc: Out of memory");
591 return p;
592 }
593
594 char *Jim_StrDup(const char *s)
595 {
596 int l = strlen(s);
597 char *copy = Jim_Alloc(l + 1);
598
599 memcpy(copy, s, l + 1);
600 return copy;
601 }
602
603 char *Jim_StrDupLen(const char *s, int l)
604 {
605 char *copy = Jim_Alloc(l + 1);
606
607 memcpy(copy, s, l + 1);
608 copy[l] = 0; /* Just to be sure, original could be substring */
609 return copy;
610 }
611
612 /* -----------------------------------------------------------------------------
613 * Time related functions
614 * ---------------------------------------------------------------------------*/
615 /* Returns microseconds of CPU used since start. */
616 static jim_wide JimClock(void)
617 {
618 #if (defined WIN32) && !(defined JIM_ANSIC)
619 LARGE_INTEGER t, f;
620 QueryPerformanceFrequency(&f);
621 QueryPerformanceCounter(&t);
622 return (long)((t.QuadPart * 1000000) / f.QuadPart);
623 #else /* !WIN32 */
624 clock_t clocks = clock();
625
626 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
627 #endif /* WIN32 */
628 }
629
630 /* -----------------------------------------------------------------------------
631 * Hash Tables
632 * ---------------------------------------------------------------------------*/
633
634 /* -------------------------- private prototypes ---------------------------- */
635 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
636 static unsigned int JimHashTableNextPower(unsigned int size);
637 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
638
639 /* -------------------------- hash functions -------------------------------- */
640
641 /* Thomas Wang's 32 bit Mix Function */
642 unsigned int Jim_IntHashFunction(unsigned int key)
643 {
644 key += ~(key << 15);
645 key ^= (key >> 10);
646 key += (key << 3);
647 key ^= (key >> 6);
648 key += ~(key << 11);
649 key ^= (key >> 16);
650 return key;
651 }
652
653 /* Identity hash function for integer keys */
654 unsigned int Jim_IdentityHashFunction(unsigned int key)
655 {
656 return key;
657 }
658
659 /* Generic hash function (we are using to multiply by 9 and add the byte
660 * as Tcl) */
661 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
662 {
663 unsigned int h = 0;
664 while (len--)
665 h += (h << 3)+*buf++;
666 return h;
667 }
668
669 /* ----------------------------- API implementation ------------------------- */
670 /* reset an hashtable already initialized with ht_init().
671 * NOTE: This function should only called by ht_destroy(). */
672 static void JimResetHashTable(Jim_HashTable *ht)
673 {
674 ht->table = NULL;
675 ht->size = 0;
676 ht->sizemask = 0;
677 ht->used = 0;
678 ht->collisions = 0;
679 }
680
681 /* Initialize the hash table */
682 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
683 void *privDataPtr)
684 {
685 JimResetHashTable(ht);
686 ht->type = type;
687 ht->privdata = privDataPtr;
688 return JIM_OK;
689 }
690
691 /* Resize the table to the minimal size that contains all the elements,
692 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
693 int Jim_ResizeHashTable(Jim_HashTable *ht)
694 {
695 int minimal = ht->used;
696
697 if (minimal < JIM_HT_INITIAL_SIZE)
698 minimal = JIM_HT_INITIAL_SIZE;
699 return Jim_ExpandHashTable(ht, minimal);
700 }
701
702 /* Expand or create the hashtable */
703 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
704 {
705 Jim_HashTable n; /* the new hashtable */
706 unsigned int realsize = JimHashTableNextPower(size), i;
707
708 /* the size is invalid if it is smaller than the number of
709 * elements already inside the hashtable */
710 if (ht->used >= size)
711 return JIM_ERR;
712
713 Jim_InitHashTable(&n, ht->type, ht->privdata);
714 n.size = realsize;
715 n.sizemask = realsize-1;
716 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
717
718 /* Initialize all the pointers to NULL */
719 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
720
721 /* Copy all the elements from the old to the new table:
722 * note that if the old hash table is empty ht->size is zero,
723 * so Jim_ExpandHashTable just creates an hash table. */
724 n.used = ht->used;
725 for (i = 0; i < ht->size && ht->used > 0; i++) {
726 Jim_HashEntry *he, *nextHe;
727
728 if (ht->table[i] == NULL) continue;
729
730 /* For each hash entry on this slot... */
731 he = ht->table[i];
732 while (he) {
733 unsigned int h;
734
735 nextHe = he->next;
736 /* Get the new element index */
737 h = Jim_HashKey(ht, he->key) & n.sizemask;
738 he->next = n.table[h];
739 n.table[h] = he;
740 ht->used--;
741 /* Pass to the next element */
742 he = nextHe;
743 }
744 }
745 assert(ht->used == 0);
746 Jim_Free(ht->table);
747
748 /* Remap the new hashtable in the old */
749 *ht = n;
750 return JIM_OK;
751 }
752
753 /* Add an element to the target hash table */
754 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
755 {
756 int index;
757 Jim_HashEntry *entry;
758
759 /* Get the index of the new element, or -1 if
760 * the element already exists. */
761 if ((index = JimInsertHashEntry(ht, key)) == -1)
762 return JIM_ERR;
763
764 /* Allocates the memory and stores key */
765 entry = Jim_Alloc(sizeof(*entry));
766 entry->next = ht->table[index];
767 ht->table[index] = entry;
768
769 /* Set the hash entry fields. */
770 Jim_SetHashKey(ht, entry, key);
771 Jim_SetHashVal(ht, entry, val);
772 ht->used++;
773 return JIM_OK;
774 }
775
776 /* Add an element, discarding the old if the key already exists */
777 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
778 {
779 Jim_HashEntry *entry;
780
781 /* Try to add the element. If the key
782 * does not exists Jim_AddHashEntry will suceed. */
783 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
784 return JIM_OK;
785 /* It already exists, get the entry */
786 entry = Jim_FindHashEntry(ht, key);
787 /* Free the old value and set the new one */
788 Jim_FreeEntryVal(ht, entry);
789 Jim_SetHashVal(ht, entry, val);
790 return JIM_OK;
791 }
792
793 /* Search and remove an element */
794 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
795 {
796 unsigned int h;
797 Jim_HashEntry *he, *prevHe;
798
799 if (ht->size == 0)
800 return JIM_ERR;
801 h = Jim_HashKey(ht, key) & ht->sizemask;
802 he = ht->table[h];
803
804 prevHe = NULL;
805 while (he) {
806 if (Jim_CompareHashKeys(ht, key, he->key)) {
807 /* Unlink the element from the list */
808 if (prevHe)
809 prevHe->next = he->next;
810 else
811 ht->table[h] = he->next;
812 Jim_FreeEntryKey(ht, he);
813 Jim_FreeEntryVal(ht, he);
814 Jim_Free(he);
815 ht->used--;
816 return JIM_OK;
817 }
818 prevHe = he;
819 he = he->next;
820 }
821 return JIM_ERR; /* not found */
822 }
823
824 /* Destroy an entire hash table */
825 int Jim_FreeHashTable(Jim_HashTable *ht)
826 {
827 unsigned int i;
828
829 /* Free all the elements */
830 for (i = 0; i < ht->size && ht->used > 0; i++) {
831 Jim_HashEntry *he, *nextHe;
832
833 if ((he = ht->table[i]) == NULL) continue;
834 while (he) {
835 nextHe = he->next;
836 Jim_FreeEntryKey(ht, he);
837 Jim_FreeEntryVal(ht, he);
838 Jim_Free(he);
839 ht->used--;
840 he = nextHe;
841 }
842 }
843 /* Free the table and the allocated cache structure */
844 Jim_Free(ht->table);
845 /* Re-initialize the table */
846 JimResetHashTable(ht);
847 return JIM_OK; /* never fails */
848 }
849
850 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
851 {
852 Jim_HashEntry *he;
853 unsigned int h;
854
855 if (ht->size == 0) return NULL;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
858 while (he) {
859 if (Jim_CompareHashKeys(ht, key, he->key))
860 return he;
861 he = he->next;
862 }
863 return NULL;
864 }
865
866 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
867 {
868 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
869
870 iter->ht = ht;
871 iter->index = -1;
872 iter->entry = NULL;
873 iter->nextEntry = NULL;
874 return iter;
875 }
876
877 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
878 {
879 while (1) {
880 if (iter->entry == NULL) {
881 iter->index++;
882 if (iter->index >=
883 (signed)iter->ht->size) break;
884 iter->entry = iter->ht->table[iter->index];
885 } else {
886 iter->entry = iter->nextEntry;
887 }
888 if (iter->entry) {
889 /* We need to save the 'next' here, the iterator user
890 * may delete the entry we are returning. */
891 iter->nextEntry = iter->entry->next;
892 return iter->entry;
893 }
894 }
895 return NULL;
896 }
897
898 /* ------------------------- private functions ------------------------------ */
899
900 /* Expand the hash table if needed */
901 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
902 {
903 /* If the hash table is empty expand it to the intial size,
904 * if the table is "full" dobule its size. */
905 if (ht->size == 0)
906 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
907 if (ht->size == ht->used)
908 return Jim_ExpandHashTable(ht, ht->size*2);
909 return JIM_OK;
910 }
911
912 /* Our hash table capability is a power of two */
913 static unsigned int JimHashTableNextPower(unsigned int size)
914 {
915 unsigned int i = JIM_HT_INITIAL_SIZE;
916
917 if (size >= 2147483648U)
918 return 2147483648U;
919 while (1) {
920 if (i >= size)
921 return i;
922 i *= 2;
923 }
924 }
925
926 /* Returns the index of a free slot that can be populated with
927 * an hash entry for the given 'key'.
928 * If the key already exists, -1 is returned. */
929 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
930 {
931 unsigned int h;
932 Jim_HashEntry *he;
933
934 /* Expand the hashtable if needed */
935 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
936 return -1;
937 /* Compute the key hash value */
938 h = Jim_HashKey(ht, key) & ht->sizemask;
939 /* Search if this slot does not already contain the given key */
940 he = ht->table[h];
941 while (he) {
942 if (Jim_CompareHashKeys(ht, key, he->key))
943 return -1;
944 he = he->next;
945 }
946 return h;
947 }
948
949 /* ----------------------- StringCopy Hash Table Type ------------------------*/
950
951 static unsigned int JimStringCopyHTHashFunction(const void *key)
952 {
953 return Jim_GenHashFunction(key, strlen(key));
954 }
955
956 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
957 {
958 int len = strlen(key);
959 char *copy = Jim_Alloc(len + 1);
960 JIM_NOTUSED(privdata);
961
962 memcpy(copy, key, len);
963 copy[len] = '\0';
964 return copy;
965 }
966
967 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
968 {
969 int len = strlen(val);
970 char *copy = Jim_Alloc(len + 1);
971 JIM_NOTUSED(privdata);
972
973 memcpy(copy, val, len);
974 copy[len] = '\0';
975 return copy;
976 }
977
978 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
979 const void *key2)
980 {
981 JIM_NOTUSED(privdata);
982
983 return strcmp(key1, key2) == 0;
984 }
985
986 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
987 {
988 JIM_NOTUSED(privdata);
989
990 Jim_Free((void*)key); /* ATTENTION: const cast */
991 }
992
993 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
994 {
995 JIM_NOTUSED(privdata);
996
997 Jim_Free((void*)val); /* ATTENTION: const cast */
998 }
999
1000 static Jim_HashTableType JimStringCopyHashTableType = {
1001 JimStringCopyHTHashFunction, /* hash function */
1002 JimStringCopyHTKeyDup, /* key dup */
1003 NULL, /* val dup */
1004 JimStringCopyHTKeyCompare, /* key compare */
1005 JimStringCopyHTKeyDestructor, /* key destructor */
1006 NULL /* val destructor */
1007 };
1008
1009 /* This is like StringCopy but does not auto-duplicate the key.
1010 * It's used for intepreter's shared strings. */
1011 static Jim_HashTableType JimSharedStringsHashTableType = {
1012 JimStringCopyHTHashFunction, /* hash function */
1013 NULL, /* key dup */
1014 NULL, /* val dup */
1015 JimStringCopyHTKeyCompare, /* key compare */
1016 JimStringCopyHTKeyDestructor, /* key destructor */
1017 NULL /* val destructor */
1018 };
1019
1020 /* This is like StringCopy but also automatically handle dynamic
1021 * allocated C strings as values. */
1022 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1023 JimStringCopyHTHashFunction, /* hash function */
1024 JimStringCopyHTKeyDup, /* key dup */
1025 JimStringKeyValCopyHTValDup, /* val dup */
1026 JimStringCopyHTKeyCompare, /* key compare */
1027 JimStringCopyHTKeyDestructor, /* key destructor */
1028 JimStringKeyValCopyHTValDestructor, /* val destructor */
1029 };
1030
1031 typedef struct AssocDataValue {
1032 Jim_InterpDeleteProc *delProc;
1033 void *data;
1034 } AssocDataValue;
1035
1036 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1037 {
1038 AssocDataValue *assocPtr = (AssocDataValue *)data;
1039 if (assocPtr->delProc != NULL)
1040 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1041 Jim_Free(data);
1042 }
1043
1044 static Jim_HashTableType JimAssocDataHashTableType = {
1045 JimStringCopyHTHashFunction, /* hash function */
1046 JimStringCopyHTKeyDup, /* key dup */
1047 NULL, /* val dup */
1048 JimStringCopyHTKeyCompare, /* key compare */
1049 JimStringCopyHTKeyDestructor, /* key destructor */
1050 JimAssocDataHashTableValueDestructor /* val destructor */
1051 };
1052
1053 /* -----------------------------------------------------------------------------
1054 * Stack - This is a simple generic stack implementation. It is used for
1055 * example in the 'expr' expression compiler.
1056 * ---------------------------------------------------------------------------*/
1057 void Jim_InitStack(Jim_Stack *stack)
1058 {
1059 stack->len = 0;
1060 stack->maxlen = 0;
1061 stack->vector = NULL;
1062 }
1063
1064 void Jim_FreeStack(Jim_Stack *stack)
1065 {
1066 Jim_Free(stack->vector);
1067 }
1068
1069 int Jim_StackLen(Jim_Stack *stack)
1070 {
1071 return stack->len;
1072 }
1073
1074 void Jim_StackPush(Jim_Stack *stack, void *element) {
1075 int neededLen = stack->len + 1;
1076 if (neededLen > stack->maxlen) {
1077 stack->maxlen = neededLen*2;
1078 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1079 }
1080 stack->vector[stack->len] = element;
1081 stack->len++;
1082 }
1083
1084 void *Jim_StackPop(Jim_Stack *stack)
1085 {
1086 if (stack->len == 0) return NULL;
1087 stack->len--;
1088 return stack->vector[stack->len];
1089 }
1090
1091 void *Jim_StackPeek(Jim_Stack *stack)
1092 {
1093 if (stack->len == 0) return NULL;
1094 return stack->vector[stack->len-1];
1095 }
1096
1097 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1098 {
1099 int i;
1100
1101 for (i = 0; i < stack->len; i++)
1102 freeFunc(stack->vector[i]);
1103 }
1104
1105 /* -----------------------------------------------------------------------------
1106 * Parser
1107 * ---------------------------------------------------------------------------*/
1108
1109 /* Token types */
1110 #define JIM_TT_NONE -1 /* No token returned */
1111 #define JIM_TT_STR 0 /* simple string */
1112 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1113 #define JIM_TT_VAR 2 /* var substitution */
1114 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1115 #define JIM_TT_CMD 4 /* command substitution */
1116 #define JIM_TT_SEP 5 /* word separator */
1117 #define JIM_TT_EOL 6 /* line separator */
1118
1119 /* Additional token types needed for expressions */
1120 #define JIM_TT_SUBEXPR_START 7
1121 #define JIM_TT_SUBEXPR_END 8
1122 #define JIM_TT_EXPR_NUMBER 9
1123 #define JIM_TT_EXPR_OPERATOR 10
1124
1125 /* Parser states */
1126 #define JIM_PS_DEF 0 /* Default state */
1127 #define JIM_PS_QUOTE 1 /* Inside "" */
1128
1129 /* Parser context structure. The same context is used both to parse
1130 * Tcl scripts and lists. */
1131 struct JimParserCtx {
1132 const char *prg; /* Program text */
1133 const char *p; /* Pointer to the point of the program we are parsing */
1134 int len; /* Left length of 'prg' */
1135 int linenr; /* Current line number */
1136 const char *tstart;
1137 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1138 int tline; /* Line number of the returned token */
1139 int tt; /* Token type */
1140 int eof; /* Non zero if EOF condition is true. */
1141 int state; /* Parser state */
1142 int comment; /* Non zero if the next chars may be a comment. */
1143 };
1144
1145 #define JimParserEof(c) ((c)->eof)
1146 #define JimParserTstart(c) ((c)->tstart)
1147 #define JimParserTend(c) ((c)->tend)
1148 #define JimParserTtype(c) ((c)->tt)
1149 #define JimParserTline(c) ((c)->tline)
1150
1151 static int JimParseScript(struct JimParserCtx *pc);
1152 static int JimParseSep(struct JimParserCtx *pc);
1153 static int JimParseEol(struct JimParserCtx *pc);
1154 static int JimParseCmd(struct JimParserCtx *pc);
1155 static int JimParseVar(struct JimParserCtx *pc);
1156 static int JimParseBrace(struct JimParserCtx *pc);
1157 static int JimParseStr(struct JimParserCtx *pc);
1158 static int JimParseComment(struct JimParserCtx *pc);
1159 static char *JimParserGetToken(struct JimParserCtx *pc,
1160 int *lenPtr, int *typePtr, int *linePtr);
1161
1162 /* Initialize a parser context.
1163 * 'prg' is a pointer to the program text, linenr is the line
1164 * number of the first line contained in the program. */
1165 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1166 int len, int linenr)
1167 {
1168 pc->prg = prg;
1169 pc->p = prg;
1170 pc->len = len;
1171 pc->tstart = NULL;
1172 pc->tend = NULL;
1173 pc->tline = 0;
1174 pc->tt = JIM_TT_NONE;
1175 pc->eof = 0;
1176 pc->state = JIM_PS_DEF;
1177 pc->linenr = linenr;
1178 pc->comment = 1;
1179 }
1180
1181 int JimParseScript(struct JimParserCtx *pc)
1182 {
1183 while (1) { /* the while is used to reiterate with continue if needed */
1184 if (!pc->len) {
1185 pc->tstart = pc->p;
1186 pc->tend = pc->p-1;
1187 pc->tline = pc->linenr;
1188 pc->tt = JIM_TT_EOL;
1189 pc->eof = 1;
1190 return JIM_OK;
1191 }
1192 switch (*(pc->p)) {
1193 case '\\':
1194 if (*(pc->p + 1) == '\n')
1195 return JimParseSep(pc);
1196 else {
1197 pc->comment = 0;
1198 return JimParseStr(pc);
1199 }
1200 break;
1201 case ' ':
1202 case '\t':
1203 case '\r':
1204 if (pc->state == JIM_PS_DEF)
1205 return JimParseSep(pc);
1206 else {
1207 pc->comment = 0;
1208 return JimParseStr(pc);
1209 }
1210 break;
1211 case '\n':
1212 case ';':
1213 pc->comment = 1;
1214 if (pc->state == JIM_PS_DEF)
1215 return JimParseEol(pc);
1216 else
1217 return JimParseStr(pc);
1218 break;
1219 case '[':
1220 pc->comment = 0;
1221 return JimParseCmd(pc);
1222 break;
1223 case '$':
1224 pc->comment = 0;
1225 if (JimParseVar(pc) == JIM_ERR) {
1226 pc->tstart = pc->tend = pc->p++; pc->len--;
1227 pc->tline = pc->linenr;
1228 pc->tt = JIM_TT_STR;
1229 return JIM_OK;
1230 } else
1231 return JIM_OK;
1232 break;
1233 case '#':
1234 if (pc->comment) {
1235 JimParseComment(pc);
1236 continue;
1237 } else {
1238 return JimParseStr(pc);
1239 }
1240 default:
1241 pc->comment = 0;
1242 return JimParseStr(pc);
1243 break;
1244 }
1245 return JIM_OK;
1246 }
1247 }
1248
1249 int JimParseSep(struct JimParserCtx *pc)
1250 {
1251 pc->tstart = pc->p;
1252 pc->tline = pc->linenr;
1253 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1254 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1255 if (*pc->p == '\\') {
1256 pc->p++; pc->len--;
1257 pc->linenr++;
1258 }
1259 pc->p++; pc->len--;
1260 }
1261 pc->tend = pc->p-1;
1262 pc->tt = JIM_TT_SEP;
1263 return JIM_OK;
1264 }
1265
1266 int JimParseEol(struct JimParserCtx *pc)
1267 {
1268 pc->tstart = pc->p;
1269 pc->tline = pc->linenr;
1270 while (*pc->p == ' ' || *pc->p == '\n' ||
1271 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1272 if (*pc->p == '\n')
1273 pc->linenr++;
1274 pc->p++; pc->len--;
1275 }
1276 pc->tend = pc->p-1;
1277 pc->tt = JIM_TT_EOL;
1278 return JIM_OK;
1279 }
1280
1281 /* Todo. Don't stop if ']' appears inside {} or quoted.
1282 * Also should handle the case of puts [string length "]"] */
1283 int JimParseCmd(struct JimParserCtx *pc)
1284 {
1285 int level = 1;
1286 int blevel = 0;
1287
1288 pc->tstart = ++pc->p; pc->len--;
1289 pc->tline = pc->linenr;
1290 while (1) {
1291 if (pc->len == 0) {
1292 break;
1293 } else if (*pc->p == '[' && blevel == 0) {
1294 level++;
1295 } else if (*pc->p == ']' && blevel == 0) {
1296 level--;
1297 if (!level) break;
1298 } else if (*pc->p == '\\') {
1299 pc->p++; pc->len--;
1300 } else if (*pc->p == '{') {
1301 blevel++;
1302 } else if (*pc->p == '}') {
1303 if (blevel != 0)
1304 blevel--;
1305 } else if (*pc->p == '\n')
1306 pc->linenr++;
1307 pc->p++; pc->len--;
1308 }
1309 pc->tend = pc->p-1;
1310 pc->tt = JIM_TT_CMD;
1311 if (*pc->p == ']') {
1312 pc->p++; pc->len--;
1313 }
1314 return JIM_OK;
1315 }
1316
1317 int JimParseVar(struct JimParserCtx *pc)
1318 {
1319 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1320
1321 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1322 pc->tline = pc->linenr;
1323 if (*pc->p == '{') {
1324 pc->tstart = ++pc->p; pc->len--;
1325 brace = 1;
1326 }
1327 if (brace) {
1328 while (!stop) {
1329 if (*pc->p == '}' || pc->len == 0) {
1330 pc->tend = pc->p-1;
1331 stop = 1;
1332 if (pc->len == 0)
1333 break;
1334 }
1335 else if (*pc->p == '\n')
1336 pc->linenr++;
1337 pc->p++; pc->len--;
1338 }
1339 } else {
1340 /* Include leading colons */
1341 while (*pc->p == ':') {
1342 pc->p++;
1343 pc->len--;
1344 }
1345 while (!stop) {
1346 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1347 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1348 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1349 stop = 1;
1350 else {
1351 pc->p++; pc->len--;
1352 }
1353 }
1354 /* Parse [dict get] syntax sugar. */
1355 if (*pc->p == '(') {
1356 while (*pc->p != ')' && pc->len) {
1357 pc->p++; pc->len--;
1358 if (*pc->p == '\\' && pc->len >= 2) {
1359 pc->p += 2; pc->len -= 2;
1360 }
1361 }
1362 if (*pc->p != '\0') {
1363 pc->p++; pc->len--;
1364 }
1365 ttype = JIM_TT_DICTSUGAR;
1366 }
1367 pc->tend = pc->p-1;
1368 }
1369 /* Check if we parsed just the '$' character.
1370 * That's not a variable so an error is returned
1371 * to tell the state machine to consider this '$' just
1372 * a string. */
1373 if (pc->tstart == pc->p) {
1374 pc->p--; pc->len++;
1375 return JIM_ERR;
1376 }
1377 pc->tt = ttype;
1378 return JIM_OK;
1379 }
1380
1381 int JimParseBrace(struct JimParserCtx *pc)
1382 {
1383 int level = 1;
1384
1385 pc->tstart = ++pc->p; pc->len--;
1386 pc->tline = pc->linenr;
1387 while (1) {
1388 if (*pc->p == '\\' && pc->len >= 2) {
1389 pc->p++; pc->len--;
1390 if (*pc->p == '\n')
1391 pc->linenr++;
1392 } else if (*pc->p == '{') {
1393 level++;
1394 } else if (pc->len == 0 || *pc->p == '}') {
1395 level--;
1396 if (pc->len == 0 || level == 0) {
1397 pc->tend = pc->p-1;
1398 if (pc->len != 0) {
1399 pc->p++; pc->len--;
1400 }
1401 pc->tt = JIM_TT_STR;
1402 return JIM_OK;
1403 }
1404 } else if (*pc->p == '\n') {
1405 pc->linenr++;
1406 }
1407 pc->p++; pc->len--;
1408 }
1409 return JIM_OK; /* unreached */
1410 }
1411
1412 int JimParseStr(struct JimParserCtx *pc)
1413 {
1414 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1415 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1416 if (newword && *pc->p == '{') {
1417 return JimParseBrace(pc);
1418 } else if (newword && *pc->p == '"') {
1419 pc->state = JIM_PS_QUOTE;
1420 pc->p++; pc->len--;
1421 }
1422 pc->tstart = pc->p;
1423 pc->tline = pc->linenr;
1424 while (1) {
1425 if (pc->len == 0) {
1426 pc->tend = pc->p-1;
1427 pc->tt = JIM_TT_ESC;
1428 return JIM_OK;
1429 }
1430 switch (*pc->p) {
1431 case '\\':
1432 if (pc->state == JIM_PS_DEF &&
1433 *(pc->p + 1) == '\n') {
1434 pc->tend = pc->p-1;
1435 pc->tt = JIM_TT_ESC;
1436 return JIM_OK;
1437 }
1438 if (pc->len >= 2) {
1439 pc->p++; pc->len--;
1440 }
1441 break;
1442 case '$':
1443 case '[':
1444 pc->tend = pc->p-1;
1445 pc->tt = JIM_TT_ESC;
1446 return JIM_OK;
1447 case ' ':
1448 case '\t':
1449 case '\n':
1450 case '\r':
1451 case ';':
1452 if (pc->state == JIM_PS_DEF) {
1453 pc->tend = pc->p-1;
1454 pc->tt = JIM_TT_ESC;
1455 return JIM_OK;
1456 } else if (*pc->p == '\n') {
1457 pc->linenr++;
1458 }
1459 break;
1460 case '"':
1461 if (pc->state == JIM_PS_QUOTE) {
1462 pc->tend = pc->p-1;
1463 pc->tt = JIM_TT_ESC;
1464 pc->p++; pc->len--;
1465 pc->state = JIM_PS_DEF;
1466 return JIM_OK;
1467 }
1468 break;
1469 }
1470 pc->p++; pc->len--;
1471 }
1472 return JIM_OK; /* unreached */
1473 }
1474
1475 int JimParseComment(struct JimParserCtx *pc)
1476 {
1477 while (*pc->p) {
1478 if (*pc->p == '\n') {
1479 pc->linenr++;
1480 if (*(pc->p-1) != '\\') {
1481 pc->p++; pc->len--;
1482 return JIM_OK;
1483 }
1484 }
1485 pc->p++; pc->len--;
1486 }
1487 return JIM_OK;
1488 }
1489
1490 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1491 static int xdigitval(int c)
1492 {
1493 if (c >= '0' && c <= '9') return c-'0';
1494 if (c >= 'a' && c <= 'f') return c-'a'+10;
1495 if (c >= 'A' && c <= 'F') return c-'A'+10;
1496 return -1;
1497 }
1498
1499 static int odigitval(int c)
1500 {
1501 if (c >= '0' && c <= '7') return c-'0';
1502 return -1;
1503 }
1504
1505 /* Perform Tcl escape substitution of 's', storing the result
1506 * string into 'dest'. The escaped string is guaranteed to
1507 * be the same length or shorted than the source string.
1508 * Slen is the length of the string at 's', if it's -1 the string
1509 * length will be calculated by the function.
1510 *
1511 * The function returns the length of the resulting string. */
1512 static int JimEscape(char *dest, const char *s, int slen)
1513 {
1514 char *p = dest;
1515 int i, len;
1516
1517 if (slen == -1)
1518 slen = strlen(s);
1519
1520 for (i = 0; i < slen; i++) {
1521 switch (s[i]) {
1522 case '\\':
1523 switch (s[i + 1]) {
1524 case 'a': *p++ = 0x7; i++; break;
1525 case 'b': *p++ = 0x8; i++; break;
1526 case 'f': *p++ = 0xc; i++; break;
1527 case 'n': *p++ = 0xa; i++; break;
1528 case 'r': *p++ = 0xd; i++; break;
1529 case 't': *p++ = 0x9; i++; break;
1530 case 'v': *p++ = 0xb; i++; break;
1531 case '\0': *p++ = '\\'; i++; break;
1532 case '\n': *p++ = ' '; i++; break;
1533 default:
1534 if (s[i + 1] == 'x') {
1535 int val = 0;
1536 int c = xdigitval(s[i + 2]);
1537 if (c == -1) {
1538 *p++ = 'x';
1539 i++;
1540 break;
1541 }
1542 val = c;
1543 c = xdigitval(s[i + 3]);
1544 if (c == -1) {
1545 *p++ = val;
1546 i += 2;
1547 break;
1548 }
1549 val = (val*16) + c;
1550 *p++ = val;
1551 i += 3;
1552 break;
1553 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1554 {
1555 int val = 0;
1556 int c = odigitval(s[i + 1]);
1557 val = c;
1558 c = odigitval(s[i + 2]);
1559 if (c == -1) {
1560 *p++ = val;
1561 i ++;
1562 break;
1563 }
1564 val = (val*8) + c;
1565 c = odigitval(s[i + 3]);
1566 if (c == -1) {
1567 *p++ = val;
1568 i += 2;
1569 break;
1570 }
1571 val = (val*8) + c;
1572 *p++ = val;
1573 i += 3;
1574 } else {
1575 *p++ = s[i + 1];
1576 i++;
1577 }
1578 break;
1579 }
1580 break;
1581 default:
1582 *p++ = s[i];
1583 break;
1584 }
1585 }
1586 len = p-dest;
1587 *p++ = '\0';
1588 return len;
1589 }
1590
1591 /* Returns a dynamically allocated copy of the current token in the
1592 * parser context. The function perform conversion of escapes if
1593 * the token is of type JIM_TT_ESC.
1594 *
1595 * Note that after the conversion, tokens that are grouped with
1596 * braces in the source code, are always recognizable from the
1597 * identical string obtained in a different way from the type.
1598 *
1599 * For exmple the string:
1600 *
1601 * {expand}$a
1602 *
1603 * will return as first token "expand", of type JIM_TT_STR
1604 *
1605 * While the string:
1606 *
1607 * expand$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_ESC
1610 */
1611 char *JimParserGetToken(struct JimParserCtx *pc,
1612 int *lenPtr, int *typePtr, int *linePtr)
1613 {
1614 const char *start, *end;
1615 char *token;
1616 int len;
1617
1618 start = JimParserTstart(pc);
1619 end = JimParserTend(pc);
1620 if (start > end) {
1621 if (lenPtr) *lenPtr = 0;
1622 if (typePtr) *typePtr = JimParserTtype(pc);
1623 if (linePtr) *linePtr = JimParserTline(pc);
1624 token = Jim_Alloc(1);
1625 token[0] = '\0';
1626 return token;
1627 }
1628 len = (end-start) + 1;
1629 token = Jim_Alloc(len + 1);
1630 if (JimParserTtype(pc) != JIM_TT_ESC) {
1631 /* No escape conversion needed? Just copy it. */
1632 memcpy(token, start, len);
1633 token[len] = '\0';
1634 } else {
1635 /* Else convert the escape chars. */
1636 len = JimEscape(token, start, len);
1637 }
1638 if (lenPtr) *lenPtr = len;
1639 if (typePtr) *typePtr = JimParserTtype(pc);
1640 if (linePtr) *linePtr = JimParserTline(pc);
1641 return token;
1642 }
1643
1644 /* The following functin is not really part of the parsing engine of Jim,
1645 * but it somewhat related. Given an string and its length, it tries
1646 * to guess if the script is complete or there are instead " " or { }
1647 * open and not completed. This is useful for interactive shells
1648 * implementation and for [info complete].
1649 *
1650 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1651 * '{' on scripts incomplete missing one or more '}' to be balanced.
1652 * '"' on scripts incomplete missing a '"' char.
1653 *
1654 * If the script is complete, 1 is returned, otherwise 0. */
1655 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1656 {
1657 int level = 0;
1658 int state = ' ';
1659
1660 while (len) {
1661 switch (*s) {
1662 case '\\':
1663 if (len > 1)
1664 s++;
1665 break;
1666 case '"':
1667 if (state == ' ') {
1668 state = '"';
1669 } else if (state == '"') {
1670 state = ' ';
1671 }
1672 break;
1673 case '{':
1674 if (state == '{') {
1675 level++;
1676 } else if (state == ' ') {
1677 state = '{';
1678 level++;
1679 }
1680 break;
1681 case '}':
1682 if (state == '{') {
1683 level--;
1684 if (level == 0)
1685 state = ' ';
1686 }
1687 break;
1688 }
1689 s++;
1690 len--;
1691 }
1692 if (stateCharPtr)
1693 *stateCharPtr = state;
1694 return state == ' ';
1695 }
1696
1697 /* -----------------------------------------------------------------------------
1698 * Tcl Lists parsing
1699 * ---------------------------------------------------------------------------*/
1700 static int JimParseListSep(struct JimParserCtx *pc);
1701 static int JimParseListStr(struct JimParserCtx *pc);
1702
1703 int JimParseList(struct JimParserCtx *pc)
1704 {
1705 if (pc->len == 0) {
1706 pc->tstart = pc->tend = pc->p;
1707 pc->tline = pc->linenr;
1708 pc->tt = JIM_TT_EOL;
1709 pc->eof = 1;
1710 return JIM_OK;
1711 }
1712 switch (*pc->p) {
1713 case ' ':
1714 case '\n':
1715 case '\t':
1716 case '\r':
1717 if (pc->state == JIM_PS_DEF)
1718 return JimParseListSep(pc);
1719 else
1720 return JimParseListStr(pc);
1721 break;
1722 default:
1723 return JimParseListStr(pc);
1724 break;
1725 }
1726 return JIM_OK;
1727 }
1728
1729 int JimParseListSep(struct JimParserCtx *pc)
1730 {
1731 pc->tstart = pc->p;
1732 pc->tline = pc->linenr;
1733 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1734 {
1735 pc->p++; pc->len--;
1736 }
1737 pc->tend = pc->p-1;
1738 pc->tt = JIM_TT_SEP;
1739 return JIM_OK;
1740 }
1741
1742 int JimParseListStr(struct JimParserCtx *pc)
1743 {
1744 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1745 pc->tt == JIM_TT_NONE);
1746 if (newword && *pc->p == '{') {
1747 return JimParseBrace(pc);
1748 } else if (newword && *pc->p == '"') {
1749 pc->state = JIM_PS_QUOTE;
1750 pc->p++; pc->len--;
1751 }
1752 pc->tstart = pc->p;
1753 pc->tline = pc->linenr;
1754 while (1) {
1755 if (pc->len == 0) {
1756 pc->tend = pc->p-1;
1757 pc->tt = JIM_TT_ESC;
1758 return JIM_OK;
1759 }
1760 switch (*pc->p) {
1761 case '\\':
1762 pc->p++; pc->len--;
1763 break;
1764 case ' ':
1765 case '\t':
1766 case '\n':
1767 case '\r':
1768 if (pc->state == JIM_PS_DEF) {
1769 pc->tend = pc->p-1;
1770 pc->tt = JIM_TT_ESC;
1771 return JIM_OK;
1772 } else if (*pc->p == '\n') {
1773 pc->linenr++;
1774 }
1775 break;
1776 case '"':
1777 if (pc->state == JIM_PS_QUOTE) {
1778 pc->tend = pc->p-1;
1779 pc->tt = JIM_TT_ESC;
1780 pc->p++; pc->len--;
1781 pc->state = JIM_PS_DEF;
1782 return JIM_OK;
1783 }
1784 break;
1785 }
1786 pc->p++; pc->len--;
1787 }
1788 return JIM_OK; /* unreached */
1789 }
1790
1791 /* -----------------------------------------------------------------------------
1792 * Jim_Obj related functions
1793 * ---------------------------------------------------------------------------*/
1794
1795 /* Return a new initialized object. */
1796 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1797 {
1798 Jim_Obj *objPtr;
1799
1800 /* -- Check if there are objects in the free list -- */
1801 if (interp->freeList != NULL) {
1802 /* -- Unlink the object from the free list -- */
1803 objPtr = interp->freeList;
1804 interp->freeList = objPtr->nextObjPtr;
1805 } else {
1806 /* -- No ready to use objects: allocate a new one -- */
1807 objPtr = Jim_Alloc(sizeof(*objPtr));
1808 }
1809
1810 /* Object is returned with refCount of 0. Every
1811 * kind of GC implemented should take care to don't try
1812 * to scan objects with refCount == 0. */
1813 objPtr->refCount = 0;
1814 /* All the other fields are left not initialized to save time.
1815 * The caller will probably want set they to the right
1816 * value anyway. */
1817
1818 /* -- Put the object into the live list -- */
1819 objPtr->prevObjPtr = NULL;
1820 objPtr->nextObjPtr = interp->liveList;
1821 if (interp->liveList)
1822 interp->liveList->prevObjPtr = objPtr;
1823 interp->liveList = objPtr;
1824
1825 return objPtr;
1826 }
1827
1828 /* Free an object. Actually objects are never freed, but
1829 * just moved to the free objects list, where they will be
1830 * reused by Jim_NewObj(). */
1831 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1832 {
1833 /* Check if the object was already freed, panic. */
1834 if (objPtr->refCount != 0) {
1835 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1836 objPtr->refCount);
1837 }
1838 /* Free the internal representation */
1839 Jim_FreeIntRep(interp, objPtr);
1840 /* Free the string representation */
1841 if (objPtr->bytes != NULL) {
1842 if (objPtr->bytes != JimEmptyStringRep)
1843 Jim_Free(objPtr->bytes);
1844 }
1845 /* Unlink the object from the live objects list */
1846 if (objPtr->prevObjPtr)
1847 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1848 if (objPtr->nextObjPtr)
1849 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1850 if (interp->liveList == objPtr)
1851 interp->liveList = objPtr->nextObjPtr;
1852 /* Link the object into the free objects list */
1853 objPtr->prevObjPtr = NULL;
1854 objPtr->nextObjPtr = interp->freeList;
1855 if (interp->freeList)
1856 interp->freeList->prevObjPtr = objPtr;
1857 interp->freeList = objPtr;
1858 objPtr->refCount = -1;
1859 }
1860
1861 /* Invalidate the string representation of an object. */
1862 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1863 {
1864 if (objPtr->bytes != NULL) {
1865 if (objPtr->bytes != JimEmptyStringRep)
1866 Jim_Free(objPtr->bytes);
1867 }
1868 objPtr->bytes = NULL;
1869 }
1870
1871 #define Jim_SetStringRep(o, b, l) \
1872 do { (o)->bytes = b; (o)->length = l; } while (0)
1873
1874 /* Set the initial string representation for an object.
1875 * Does not try to free an old one. */
1876 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1877 {
1878 if (length == 0) {
1879 objPtr->bytes = JimEmptyStringRep;
1880 objPtr->length = 0;
1881 } else {
1882 objPtr->bytes = Jim_Alloc(length + 1);
1883 objPtr->length = length;
1884 memcpy(objPtr->bytes, bytes, length);
1885 objPtr->bytes[length] = '\0';
1886 }
1887 }
1888
1889 /* Duplicate an object. The returned object has refcount = 0. */
1890 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1891 {
1892 Jim_Obj *dupPtr;
1893
1894 dupPtr = Jim_NewObj(interp);
1895 if (objPtr->bytes == NULL) {
1896 /* Object does not have a valid string representation. */
1897 dupPtr->bytes = NULL;
1898 } else {
1899 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1900 }
1901 if (objPtr->typePtr != NULL) {
1902 if (objPtr->typePtr->dupIntRepProc == NULL) {
1903 dupPtr->internalRep = objPtr->internalRep;
1904 } else {
1905 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1906 }
1907 dupPtr->typePtr = objPtr->typePtr;
1908 } else {
1909 dupPtr->typePtr = NULL;
1910 }
1911 return dupPtr;
1912 }
1913
1914 /* Return the string representation for objPtr. If the object
1915 * string representation is invalid, calls the method to create
1916 * a new one starting from the internal representation of the object. */
1917 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1918 {
1919 if (objPtr->bytes == NULL) {
1920 /* Invalid string repr. Generate it. */
1921 if (objPtr->typePtr->updateStringProc == NULL) {
1922 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1923 objPtr->typePtr->name);
1924 }
1925 objPtr->typePtr->updateStringProc(objPtr);
1926 }
1927 if (lenPtr)
1928 *lenPtr = objPtr->length;
1929 return objPtr->bytes;
1930 }
1931
1932 /* Just returns the length of the object's string rep */
1933 int Jim_Length(Jim_Obj *objPtr)
1934 {
1935 int len;
1936
1937 Jim_GetString(objPtr, &len);
1938 return len;
1939 }
1940
1941 /* -----------------------------------------------------------------------------
1942 * String Object
1943 * ---------------------------------------------------------------------------*/
1944 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1945 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1946
1947 static Jim_ObjType stringObjType = {
1948 "string",
1949 NULL,
1950 DupStringInternalRep,
1951 NULL,
1952 JIM_TYPE_REFERENCES,
1953 };
1954
1955 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1956 {
1957 JIM_NOTUSED(interp);
1958
1959 /* This is a bit subtle: the only caller of this function
1960 * should be Jim_DuplicateObj(), that will copy the
1961 * string representaion. After the copy, the duplicated
1962 * object will not have more room in teh buffer than
1963 * srcPtr->length bytes. So we just set it to length. */
1964 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1965 }
1966
1967 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1968 {
1969 /* Get a fresh string representation. */
1970 (void) Jim_GetString(objPtr, NULL);
1971 /* Free any other internal representation. */
1972 Jim_FreeIntRep(interp, objPtr);
1973 /* Set it as string, i.e. just set the maxLength field. */
1974 objPtr->typePtr = &stringObjType;
1975 objPtr->internalRep.strValue.maxLength = objPtr->length;
1976 return JIM_OK;
1977 }
1978
1979 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1980 {
1981 Jim_Obj *objPtr = Jim_NewObj(interp);
1982
1983 if (len == -1)
1984 len = strlen(s);
1985 /* Alloc/Set the string rep. */
1986 if (len == 0) {
1987 objPtr->bytes = JimEmptyStringRep;
1988 objPtr->length = 0;
1989 } else {
1990 objPtr->bytes = Jim_Alloc(len + 1);
1991 objPtr->length = len;
1992 memcpy(objPtr->bytes, s, len);
1993 objPtr->bytes[len] = '\0';
1994 }
1995
1996 /* No typePtr field for the vanilla string object. */
1997 objPtr->typePtr = NULL;
1998 return objPtr;
1999 }
2000
2001 /* This version does not try to duplicate the 's' pointer, but
2002 * use it directly. */
2003 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2004 {
2005 Jim_Obj *objPtr = Jim_NewObj(interp);
2006
2007 if (len == -1)
2008 len = strlen(s);
2009 Jim_SetStringRep(objPtr, s, len);
2010 objPtr->typePtr = NULL;
2011 return objPtr;
2012 }
2013
2014 /* Low-level string append. Use it only against objects
2015 * of type "string". */
2016 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2017 {
2018 int needlen;
2019
2020 if (len == -1)
2021 len = strlen(str);
2022 needlen = objPtr->length + len;
2023 if (objPtr->internalRep.strValue.maxLength < needlen ||
2024 objPtr->internalRep.strValue.maxLength == 0) {
2025 if (objPtr->bytes == JimEmptyStringRep) {
2026 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2027 } else {
2028 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2029 }
2030 objPtr->internalRep.strValue.maxLength = needlen*2;
2031 }
2032 memcpy(objPtr->bytes + objPtr->length, str, len);
2033 objPtr->bytes[objPtr->length + len] = '\0';
2034 objPtr->length += len;
2035 }
2036
2037 /* Low-level wrapper to append an object. */
2038 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2039 {
2040 int len;
2041 const char *str;
2042
2043 str = Jim_GetString(appendObjPtr, &len);
2044 StringAppendString(objPtr, str, len);
2045 }
2046
2047 /* Higher level API to append strings to objects. */
2048 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2049 int len)
2050 {
2051 if (Jim_IsShared(objPtr))
2052 Jim_Panic(interp,"Jim_AppendString called with shared object");
2053 if (objPtr->typePtr != &stringObjType)
2054 SetStringFromAny(interp, objPtr);
2055 StringAppendString(objPtr, str, len);
2056 }
2057
2058 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2059 {
2060 char *buf;
2061 va_list ap;
2062
2063 va_start(ap, fmt );
2064 buf = jim_vasprintf(fmt, ap );
2065 va_end(ap);
2066
2067 if (buf ){
2068 Jim_AppendString(interp, objPtr, buf, -1 );
2069 jim_vasprintf_done(buf);
2070 }
2071 }
2072
2073
2074 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2075 Jim_Obj *appendObjPtr)
2076 {
2077 int len;
2078 const char *str;
2079
2080 str = Jim_GetString(appendObjPtr, &len);
2081 Jim_AppendString(interp, objPtr, str, len);
2082 }
2083
2084 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2085 {
2086 va_list ap;
2087
2088 if (objPtr->typePtr != &stringObjType)
2089 SetStringFromAny(interp, objPtr);
2090 va_start(ap, objPtr);
2091 while (1) {
2092 char *s = va_arg(ap, char*);
2093
2094 if (s == NULL) break;
2095 Jim_AppendString(interp, objPtr, s, -1);
2096 }
2097 va_end(ap);
2098 }
2099
2100 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2101 {
2102 const char *aStr, *bStr;
2103 int aLen, bLen, i;
2104
2105 if (aObjPtr == bObjPtr) return 1;
2106 aStr = Jim_GetString(aObjPtr, &aLen);
2107 bStr = Jim_GetString(bObjPtr, &bLen);
2108 if (aLen != bLen) return 0;
2109 if (nocase == 0)
2110 return memcmp(aStr, bStr, aLen) == 0;
2111 for (i = 0; i < aLen; i++) {
2112 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2113 return 0;
2114 }
2115 return 1;
2116 }
2117
2118 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2119 int nocase)
2120 {
2121 const char *pattern, *string;
2122 int patternLen, stringLen;
2123
2124 pattern = Jim_GetString(patternObjPtr, &patternLen);
2125 string = Jim_GetString(objPtr, &stringLen);
2126 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2127 }
2128
2129 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2130 Jim_Obj *secondObjPtr, int nocase)
2131 {
2132 const char *s1, *s2;
2133 int l1, l2;
2134
2135 s1 = Jim_GetString(firstObjPtr, &l1);
2136 s2 = Jim_GetString(secondObjPtr, &l2);
2137 return JimStringCompare(s1, l1, s2, l2, nocase);
2138 }
2139
2140 /* Convert a range, as returned by Jim_GetRange(), into
2141 * an absolute index into an object of the specified length.
2142 * This function may return negative values, or values
2143 * bigger or equal to the length of the list if the index
2144 * is out of range. */
2145 static int JimRelToAbsIndex(int len, int index)
2146 {
2147 if (index < 0)
2148 return len + index;
2149 return index;
2150 }
2151
2152 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2153 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2154 * for implementation of commands like [string range] and [lrange].
2155 *
2156 * The resulting range is guaranteed to address valid elements of
2157 * the structure. */
2158 static void JimRelToAbsRange(int len, int first, int last,
2159 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2160 {
2161 int rangeLen;
2162
2163 if (first > last) {
2164 rangeLen = 0;
2165 } else {
2166 rangeLen = last-first + 1;
2167 if (rangeLen) {
2168 if (first < 0) {
2169 rangeLen += first;
2170 first = 0;
2171 }
2172 if (last >= len) {
2173 rangeLen -= (last-(len-1));
2174 last = len-1;
2175 }
2176 }
2177 }
2178 if (rangeLen < 0) rangeLen = 0;
2179
2180 *firstPtr = first;
2181 *lastPtr = last;
2182 *rangeLenPtr = rangeLen;
2183 }
2184
2185 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2186 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2187 {
2188 int first, last;
2189 const char *str;
2190 int len, rangeLen;
2191
2192 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2193 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2194 return NULL;
2195 str = Jim_GetString(strObjPtr, &len);
2196 first = JimRelToAbsIndex(len, first);
2197 last = JimRelToAbsIndex(len, last);
2198 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2199 return Jim_NewStringObj(interp, str + first, rangeLen);
2200 }
2201
2202 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2203 {
2204 char *buf;
2205 int i;
2206 if (strObjPtr->typePtr != &stringObjType) {
2207 SetStringFromAny(interp, strObjPtr);
2208 }
2209
2210 buf = Jim_Alloc(strObjPtr->length + 1);
2211
2212 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2213 for (i = 0; i < strObjPtr->length; i++)
2214 buf[i] = tolower(buf[i]);
2215 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2216 }
2217
2218 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2219 {
2220 char *buf;
2221 int i;
2222 if (strObjPtr->typePtr != &stringObjType) {
2223 SetStringFromAny(interp, strObjPtr);
2224 }
2225
2226 buf = Jim_Alloc(strObjPtr->length + 1);
2227
2228 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2229 for (i = 0; i < strObjPtr->length; i++)
2230 buf[i] = toupper(buf[i]);
2231 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2232 }
2233
2234 /* This is the core of the [format] command.
2235 * TODO: Lots of things work - via a hack
2236 * However, no format item can be >= JIM_MAX_FMT
2237 */
2238 #define JIM_MAX_FMT 2048
2239 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2240 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2241 {
2242 const char *fmt, *_fmt;
2243 int fmtLen;
2244 Jim_Obj *resObjPtr;
2245
2246
2247 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2248 _fmt = fmt;
2249 resObjPtr = Jim_NewStringObj(interp, "", 0);
2250 while (fmtLen) {
2251 const char *p = fmt;
2252 char spec[2], c;
2253 jim_wide wideValue;
2254 double doubleValue;
2255 /* we cheat and use Sprintf()! */
2256 char fmt_str[100];
2257 char *cp;
2258 int width;
2259 int ljust;
2260 int zpad;
2261 int spad;
2262 int altfm;
2263 int forceplus;
2264 int prec;
2265 int inprec;
2266 int haveprec;
2267 int accum;
2268
2269 while (*fmt != '%' && fmtLen) {
2270 fmt++; fmtLen--;
2271 }
2272 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2273 if (fmtLen == 0)
2274 break;
2275 fmt++; fmtLen--; /* skip '%' */
2276 zpad = 0;
2277 spad = 0;
2278 width = -1;
2279 ljust = 0;
2280 altfm = 0;
2281 forceplus = 0;
2282 inprec = 0;
2283 haveprec = 0;
2284 prec = -1; /* not found yet */
2285 next_fmt:
2286 if (fmtLen <= 0 ){
2287 break;
2288 }
2289 switch (*fmt ){
2290 /* terminals */
2291 case 'b': /* binary - not all printfs() do this */
2292 case 's': /* string */
2293 case 'i': /* integer */
2294 case 'd': /* decimal */
2295 case 'x': /* hex */
2296 case 'X': /* CAP hex */
2297 case 'c': /* char */
2298 case 'o': /* octal */
2299 case 'u': /* unsigned */
2300 case 'f': /* float */
2301 break;
2302
2303 /* non-terminals */
2304 case '0': /* zero pad */
2305 zpad = 1;
2306 fmt++; fmtLen--;
2307 goto next_fmt;
2308 break;
2309 case '+':
2310 forceplus = 1;
2311 fmt++; fmtLen--;
2312 goto next_fmt;
2313 break;
2314 case ' ': /* sign space */
2315 spad = 1;
2316 fmt++; fmtLen--;
2317 goto next_fmt;
2318 break;
2319 case '-':
2320 ljust = 1;
2321 fmt++; fmtLen--;
2322 goto next_fmt;
2323 break;
2324 case '#':
2325 altfm = 1;
2326 fmt++; fmtLen--;
2327 goto next_fmt;
2328
2329 case '.':
2330 inprec = 1;
2331 fmt++; fmtLen--;
2332 goto next_fmt;
2333 break;
2334 case '1':
2335 case '2':
2336 case '3':
2337 case '4':
2338 case '5':
2339 case '6':
2340 case '7':
2341 case '8':
2342 case '9':
2343 accum = 0;
2344 while (isdigit(*fmt) && (fmtLen > 0) ){
2345 accum = (accum * 10) + (*fmt - '0');
2346 fmt++; fmtLen--;
2347 }
2348 if (inprec ){
2349 haveprec = 1;
2350 prec = accum;
2351 } else {
2352 width = accum;
2353 }
2354 goto next_fmt;
2355 case '*':
2356 /* suck up the next item as an integer */
2357 fmt++; fmtLen--;
2358 objc--;
2359 if (objc <= 0 ){
2360 goto not_enough_args;
2361 }
2362 if (Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2363 Jim_FreeNewObj(interp, resObjPtr );
2364 return NULL;
2365 }
2366 if (inprec ){
2367 haveprec = 1;
2368 prec = wideValue;
2369 if (prec < 0 ){
2370 /* man 3 printf says */
2371 /* if prec is negative, it is zero */
2372 prec = 0;
2373 }
2374 } else {
2375 width = wideValue;
2376 if (width < 0 ){
2377 ljust = 1;
2378 width = -width;
2379 }
2380 }
2381 objv++;
2382 goto next_fmt;
2383 break;
2384 }
2385
2386
2387 if (*fmt != '%') {
2388 if (objc == 0) {
2389 not_enough_args:
2390 Jim_FreeNewObj(interp, resObjPtr);
2391 Jim_SetResultString(interp,
2392 "not enough arguments for all format specifiers", -1);
2393 return NULL;
2394 } else {
2395 objc--;
2396 }
2397 }
2398
2399 /*
2400 * Create the formatter
2401 * cause we cheat and use sprintf()
2402 */
2403 cp = fmt_str;
2404 *cp++ = '%';
2405 if (altfm ){
2406 *cp++ = '#';
2407 }
2408 if (forceplus ){
2409 *cp++ = '+';
2410 } else if (spad ){
2411 /* PLUS overrides */
2412 *cp++ = ' ';
2413 }
2414 if (ljust ){
2415 *cp++ = '-';
2416 }
2417 if (zpad ){
2418 *cp++ = '0';
2419 }
2420 if (width > 0 ){
2421 sprintf(cp, "%d", width );
2422 /* skip ahead */
2423 cp = strchr(cp,0);
2424 }
2425 /* did we find a period? */
2426 if (inprec ){
2427 /* then add it */
2428 *cp++ = '.';
2429 /* did something occur after the period? */
2430 if (haveprec ){
2431 sprintf(cp, "%d", prec );
2432 }
2433 cp = strchr(cp,0);
2434 }
2435 *cp = 0;
2436
2437 /* here we do the work */
2438 /* actually - we make sprintf() do it for us */
2439 switch (*fmt) {
2440 case 's':
2441 *cp++ = 's';
2442 *cp = 0;
2443 /* BUG: we do not handled embeded NULLs */
2444 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL ));
2445 break;
2446 case 'c':
2447 *cp++ = 'c';
2448 *cp = 0;
2449 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2450 Jim_FreeNewObj(interp, resObjPtr);
2451 return NULL;
2452 }
2453 c = (char) wideValue;
2454 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2455 break;
2456 case 'f':
2457 case 'F':
2458 case 'g':
2459 case 'G':
2460 case 'e':
2461 case 'E':
2462 *cp++ = *fmt;
2463 *cp = 0;
2464 if (Jim_GetDouble(interp, objv[0], &doubleValue ) == JIM_ERR ){
2465 Jim_FreeNewObj(interp, resObjPtr );
2466 return NULL;
2467 }
2468 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2469 break;
2470 case 'b':
2471 case 'd':
2472 case 'o':
2473 case 'i':
2474 case 'u':
2475 case 'x':
2476 case 'X':
2477 /* jim widevaluse are 64bit */
2478 if (sizeof(jim_wide) == sizeof(long long) ){
2479 *cp++ = 'l';
2480 *cp++ = 'l';
2481 } else {
2482 *cp++ = 'l';
2483 }
2484 *cp++ = *fmt;
2485 *cp = 0;
2486 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2487 Jim_FreeNewObj(interp, resObjPtr);
2488 return NULL;
2489 }
2490 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2491 break;
2492 case '%':
2493 sprintf_buf[0] = '%';
2494 sprintf_buf[1] = 0;
2495 objv--; /* undo the objv++ below */
2496 break;
2497 default:
2498 spec[0] = *fmt; spec[1] = '\0';
2499 Jim_FreeNewObj(interp, resObjPtr);
2500 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2501 Jim_AppendStrings(interp, Jim_GetResult(interp),
2502 "bad field specifier \"", spec, "\"", NULL);
2503 return NULL;
2504 }
2505 /* force terminate */
2506 #if 0
2507 printf("FMT was: %s\n", fmt_str );
2508 printf("RES was: |%s|\n", sprintf_buf );
2509 #endif
2510
2511 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2512 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2513 /* next obj */
2514 objv++;
2515 fmt++;
2516 fmtLen--;
2517 }
2518 return resObjPtr;
2519 }
2520
2521 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2522 int objc, Jim_Obj *const *objv)
2523 {
2524 char *sprintf_buf = malloc(JIM_MAX_FMT);
2525 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2526 free(sprintf_buf);
2527 return t;
2528 }
2529
2530 /* -----------------------------------------------------------------------------
2531 * Compared String Object
2532 * ---------------------------------------------------------------------------*/
2533
2534 /* This is strange object that allows to compare a C literal string
2535 * with a Jim object in very short time if the same comparison is done
2536 * multiple times. For example every time the [if] command is executed,
2537 * Jim has to check if a given argument is "else". This comparions if
2538 * the code has no errors are true most of the times, so we can cache
2539 * inside the object the pointer of the string of the last matching
2540 * comparison. Because most C compilers perform literal sharing,
2541 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2542 * this works pretty well even if comparisons are at different places
2543 * inside the C code. */
2544
2545 static Jim_ObjType comparedStringObjType = {
2546 "compared-string",
2547 NULL,
2548 NULL,
2549 NULL,
2550 JIM_TYPE_REFERENCES,
2551 };
2552
2553 /* The only way this object is exposed to the API is via the following
2554 * function. Returns true if the string and the object string repr.
2555 * are the same, otherwise zero is returned.
2556 *
2557 * Note: this isn't binary safe, but it hardly needs to be.*/
2558 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2559 const char *str)
2560 {
2561 if (objPtr->typePtr == &comparedStringObjType &&
2562 objPtr->internalRep.ptr == str)
2563 return 1;
2564 else {
2565 const char *objStr = Jim_GetString(objPtr, NULL);
2566 if (strcmp(str, objStr) != 0) return 0;
2567 if (objPtr->typePtr != &comparedStringObjType) {
2568 Jim_FreeIntRep(interp, objPtr);
2569 objPtr->typePtr = &comparedStringObjType;
2570 }
2571 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2572 return 1;
2573 }
2574 }
2575
2576 int qsortCompareStringPointers(const void *a, const void *b)
2577 {
2578 char * const *sa = (char * const *)a;
2579 char * const *sb = (char * const *)b;
2580 return strcmp(*sa, *sb);
2581 }
2582
2583 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2584 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2585 {
2586 const char * const *entryPtr = NULL;
2587 char **tablePtrSorted;
2588 int i, count = 0;
2589
2590 *indexPtr = -1;
2591 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2592 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2593 *indexPtr = i;
2594 return JIM_OK;
2595 }
2596 count++; /* If nothing matches, this will reach the len of tablePtr */
2597 }
2598 if (flags & JIM_ERRMSG) {
2599 if (name == NULL)
2600 name = "option";
2601 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2602 Jim_AppendStrings(interp, Jim_GetResult(interp),
2603 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2604 NULL);
2605 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2606 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2607 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2608 for (i = 0; i < count; i++) {
2609 if (i + 1 == count && count > 1)
2610 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2611 Jim_AppendString(interp, Jim_GetResult(interp),
2612 tablePtrSorted[i], -1);
2613 if (i + 1 != count)
2614 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2615 }
2616 Jim_Free(tablePtrSorted);
2617 }
2618 return JIM_ERR;
2619 }
2620
2621 int Jim_GetNvp(Jim_Interp *interp,
2622 Jim_Obj *objPtr,
2623 const Jim_Nvp *nvp_table,
2624 const Jim_Nvp ** result)
2625 {
2626 Jim_Nvp *n;
2627 int e;
2628
2629 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n );
2630 if (e == JIM_ERR ){
2631 return e;
2632 }
2633
2634 /* Success? found? */
2635 if (n->name ){
2636 /* remove const */
2637 *result = (Jim_Nvp *)n;
2638 return JIM_OK;
2639 } else {
2640 return JIM_ERR;
2641 }
2642 }
2643
2644 /* -----------------------------------------------------------------------------
2645 * Source Object
2646 *
2647 * This object is just a string from the language point of view, but
2648 * in the internal representation it contains the filename and line number
2649 * where this given token was read. This information is used by
2650 * Jim_EvalObj() if the object passed happens to be of type "source".
2651 *
2652 * This allows to propagate the information about line numbers and file
2653 * names and give error messages with absolute line numbers.
2654 *
2655 * Note that this object uses shared strings for filenames, and the
2656 * pointer to the filename together with the line number is taken into
2657 * the space for the "inline" internal represenation of the Jim_Object,
2658 * so there is almost memory zero-overhead.
2659 *
2660 * Also the object will be converted to something else if the given
2661 * token it represents in the source file is not something to be
2662 * evaluated (not a script), and will be specialized in some other way,
2663 * so the time overhead is alzo null.
2664 * ---------------------------------------------------------------------------*/
2665
2666 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2667 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2668
2669 static Jim_ObjType sourceObjType = {
2670 "source",
2671 FreeSourceInternalRep,
2672 DupSourceInternalRep,
2673 NULL,
2674 JIM_TYPE_REFERENCES,
2675 };
2676
2677 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2678 {
2679 Jim_ReleaseSharedString(interp,
2680 objPtr->internalRep.sourceValue.fileName);
2681 }
2682
2683 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2684 {
2685 dupPtr->internalRep.sourceValue.fileName =
2686 Jim_GetSharedString(interp,
2687 srcPtr->internalRep.sourceValue.fileName);
2688 dupPtr->internalRep.sourceValue.lineNumber =
2689 dupPtr->internalRep.sourceValue.lineNumber;
2690 dupPtr->typePtr = &sourceObjType;
2691 }
2692
2693 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2694 const char *fileName, int lineNumber)
2695 {
2696 if (Jim_IsShared(objPtr))
2697 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2698 if (objPtr->typePtr != NULL)
2699 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2700 objPtr->internalRep.sourceValue.fileName =
2701 Jim_GetSharedString(interp, fileName);
2702 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2703 objPtr->typePtr = &sourceObjType;
2704 }
2705
2706 /* -----------------------------------------------------------------------------
2707 * Script Object
2708 * ---------------------------------------------------------------------------*/
2709
2710 #define JIM_CMDSTRUCT_EXPAND -1
2711
2712 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2713 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2714 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2715
2716 static Jim_ObjType scriptObjType = {
2717 "script",
2718 FreeScriptInternalRep,
2719 DupScriptInternalRep,
2720 NULL,
2721 JIM_TYPE_REFERENCES,
2722 };
2723
2724 /* The ScriptToken structure represents every token into a scriptObj.
2725 * Every token contains an associated Jim_Obj that can be specialized
2726 * by commands operating on it. */
2727 typedef struct ScriptToken {
2728 int type;
2729 Jim_Obj *objPtr;
2730 int linenr;
2731 } ScriptToken;
2732
2733 /* This is the script object internal representation. An array of
2734 * ScriptToken structures, with an associated command structure array.
2735 * The command structure is a pre-computed representation of the
2736 * command length and arguments structure as a simple liner array
2737 * of integers.
2738 *
2739 * For example the script:
2740 *
2741 * puts hello
2742 * set $i $x$y [foo]BAR
2743 *
2744 * will produce a ScriptObj with the following Tokens:
2745 *
2746 * ESC puts
2747 * SEP
2748 * ESC hello
2749 * EOL
2750 * ESC set
2751 * EOL
2752 * VAR i
2753 * SEP
2754 * VAR x
2755 * VAR y
2756 * SEP
2757 * CMD foo
2758 * ESC BAR
2759 * EOL
2760 *
2761 * This is a description of the tokens, separators, and of lines.
2762 * The command structure instead represents the number of arguments
2763 * of every command, followed by the tokens of which every argument
2764 * is composed. So for the example script, the cmdstruct array will
2765 * contain:
2766 *
2767 * 2 1 1 4 1 1 2 2
2768 *
2769 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2770 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2771 * composed of single tokens (1 1) and the last two of double tokens
2772 * (2 2).
2773 *
2774 * The precomputation of the command structure makes Jim_Eval() faster,
2775 * and simpler because there aren't dynamic lengths / allocations.
2776 *
2777 * -- {expand} handling --
2778 *
2779 * Expand is handled in a special way. When a command
2780 * contains at least an argument with the {expand} prefix,
2781 * the command structure presents a -1 before the integer
2782 * describing the number of arguments. This is used in order
2783 * to send the command exection to a different path in case
2784 * of {expand} and guarantee a fast path for the more common
2785 * case. Also, the integers describing the number of tokens
2786 * are expressed with negative sign, to allow for fast check
2787 * of what's an {expand}-prefixed argument and what not.
2788 *
2789 * For example the command:
2790 *
2791 * list {expand}{1 2}
2792 *
2793 * Will produce the following cmdstruct array:
2794 *
2795 * -1 2 1 -2
2796 *
2797 * -- the substFlags field of the structure --
2798 *
2799 * The scriptObj structure is used to represent both "script" objects
2800 * and "subst" objects. In the second case, the cmdStruct related
2801 * fields are not used at all, but there is an additional field used
2802 * that is 'substFlags': this represents the flags used to turn
2803 * the string into the intenral representation used to perform the
2804 * substitution. If this flags are not what the application requires
2805 * the scriptObj is created again. For example the script:
2806 *
2807 * subst -nocommands $string
2808 * subst -novariables $string
2809 *
2810 * Will recreate the internal representation of the $string object
2811 * two times.
2812 */
2813 typedef struct ScriptObj {
2814 int len; /* Length as number of tokens. */
2815 int commands; /* number of top-level commands in script. */
2816 ScriptToken *token; /* Tokens array. */
2817 int *cmdStruct; /* commands structure */
2818 int csLen; /* length of the cmdStruct array. */
2819 int substFlags; /* flags used for the compilation of "subst" objects */
2820 int inUse; /* Used to share a ScriptObj. Currently
2821 only used by Jim_EvalObj() as protection against
2822 shimmering of the currently evaluated object. */
2823 char *fileName;
2824 } ScriptObj;
2825
2826 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2827 {
2828 int i;
2829 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2830
2831 script->inUse--;
2832 if (script->inUse != 0) return;
2833 for (i = 0; i < script->len; i++) {
2834 if (script->token[i].objPtr != NULL)
2835 Jim_DecrRefCount(interp, script->token[i].objPtr);
2836 }
2837 Jim_Free(script->token);
2838 Jim_Free(script->cmdStruct);
2839 Jim_Free(script->fileName);
2840 Jim_Free(script);
2841 }
2842
2843 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2844 {
2845 JIM_NOTUSED(interp);
2846 JIM_NOTUSED(srcPtr);
2847
2848 /* Just returns an simple string. */
2849 dupPtr->typePtr = NULL;
2850 }
2851
2852 /* Add a new token to the internal repr of a script object */
2853 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2854 char *strtoken, int len, int type, char *filename, int linenr)
2855 {
2856 int prevtype;
2857 struct ScriptToken *token;
2858
2859 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2860 script->token[script->len-1].type;
2861 /* Skip tokens without meaning, like words separators
2862 * following a word separator or an end of command and
2863 * so on. */
2864 if (prevtype == JIM_TT_EOL) {
2865 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2866 Jim_Free(strtoken);
2867 return;
2868 }
2869 } else if (prevtype == JIM_TT_SEP) {
2870 if (type == JIM_TT_SEP) {
2871 Jim_Free(strtoken);
2872 return;
2873 } else if (type == JIM_TT_EOL) {
2874 /* If an EOL is following by a SEP, drop the previous
2875 * separator. */
2876 script->len--;
2877 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2878 }
2879 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2880 type == JIM_TT_ESC && len == 0)
2881 {
2882 /* Don't add empty tokens used in interpolation */
2883 Jim_Free(strtoken);
2884 return;
2885 }
2886 /* Make space for a new istruction */
2887 script->len++;
2888 script->token = Jim_Realloc(script->token,
2889 sizeof(ScriptToken)*script->len);
2890 /* Initialize the new token */
2891 token = script->token + (script->len-1);
2892 token->type = type;
2893 /* Every object is intially as a string, but the
2894 * internal type may be specialized during execution of the
2895 * script. */
2896 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2897 /* To add source info to SEP and EOL tokens is useless because
2898 * they will never by called as arguments of Jim_EvalObj(). */
2899 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2900 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2901 Jim_IncrRefCount(token->objPtr);
2902 token->linenr = linenr;
2903 }
2904
2905 /* Add an integer into the command structure field of the script object. */
2906 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2907 {
2908 script->csLen++;
2909 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2910 sizeof(int)*script->csLen);
2911 script->cmdStruct[script->csLen-1] = val;
2912 }
2913
2914 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2915 * of objPtr. Search nested script objects recursively. */
2916 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2917 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2918 {
2919 int i;
2920
2921 for (i = 0; i < script->len; i++) {
2922 if (script->token[i].objPtr != objPtr &&
2923 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2924 return script->token[i].objPtr;
2925 }
2926 /* Enter recursively on scripts only if the object
2927 * is not the same as the one we are searching for
2928 * shared occurrences. */
2929 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2930 script->token[i].objPtr != objPtr) {
2931 Jim_Obj *foundObjPtr;
2932
2933 ScriptObj *subScript =
2934 script->token[i].objPtr->internalRep.ptr;
2935 /* Don't recursively enter the script we are trying
2936 * to make shared to avoid circular references. */
2937 if (subScript == scriptBarrier) continue;
2938 if (subScript != script) {
2939 foundObjPtr =
2940 ScriptSearchLiteral(interp, subScript,
2941 scriptBarrier, objPtr);
2942 if (foundObjPtr != NULL)
2943 return foundObjPtr;
2944 }
2945 }
2946 }
2947 return NULL;
2948 }
2949
2950 /* Share literals of a script recursively sharing sub-scripts literals. */
2951 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2952 ScriptObj *topLevelScript)
2953 {
2954 int i, j;
2955
2956 return;
2957 /* Try to share with toplevel object. */
2958 if (topLevelScript != NULL) {
2959 for (i = 0; i < script->len; i++) {
2960 Jim_Obj *foundObjPtr;
2961 char *str = script->token[i].objPtr->bytes;
2962
2963 if (script->token[i].objPtr->refCount != 1) continue;
2964 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2965 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2966 foundObjPtr = ScriptSearchLiteral(interp,
2967 topLevelScript,
2968 script, /* barrier */
2969 script->token[i].objPtr);
2970 if (foundObjPtr != NULL) {
2971 Jim_IncrRefCount(foundObjPtr);
2972 Jim_DecrRefCount(interp,
2973 script->token[i].objPtr);
2974 script->token[i].objPtr = foundObjPtr;
2975 }
2976 }
2977 }
2978 /* Try to share locally */
2979 for (i = 0; i < script->len; i++) {
2980 char *str = script->token[i].objPtr->bytes;
2981
2982 if (script->token[i].objPtr->refCount != 1) continue;
2983 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2984 for (j = 0; j < script->len; j++) {
2985 if (script->token[i].objPtr !=
2986 script->token[j].objPtr &&
2987 Jim_StringEqObj(script->token[i].objPtr,
2988 script->token[j].objPtr, 0))
2989 {
2990 Jim_IncrRefCount(script->token[j].objPtr);
2991 Jim_DecrRefCount(interp,
2992 script->token[i].objPtr);
2993 script->token[i].objPtr =
2994 script->token[j].objPtr;
2995 }
2996 }
2997 }
2998 }
2999
3000 /* This method takes the string representation of an object
3001 * as a Tcl script, and generates the pre-parsed internal representation
3002 * of the script. */
3003 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3004 {
3005 int scriptTextLen;
3006 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3007 struct JimParserCtx parser;
3008 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3009 ScriptToken *token;
3010 int args, tokens, start, end, i;
3011 int initialLineNumber;
3012 int propagateSourceInfo = 0;
3013
3014 script->len = 0;
3015 script->csLen = 0;
3016 script->commands = 0;
3017 script->token = NULL;
3018 script->cmdStruct = NULL;
3019 script->inUse = 1;
3020 /* Try to get information about filename / line number */
3021 if (objPtr->typePtr == &sourceObjType) {
3022 script->fileName =
3023 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3024 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3025 propagateSourceInfo = 1;
3026 } else {
3027 script->fileName = Jim_StrDup("");
3028 initialLineNumber = 1;
3029 }
3030
3031 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3032 while (!JimParserEof(&parser)) {
3033 char *token;
3034 int len, type, linenr;
3035
3036 JimParseScript(&parser);
3037 token = JimParserGetToken(&parser, &len, &type, &linenr);
3038 ScriptObjAddToken(interp, script, token, len, type,
3039 propagateSourceInfo ? script->fileName : NULL,
3040 linenr);
3041 }
3042 token = script->token;
3043
3044 /* Compute the command structure array
3045 * (see the ScriptObj struct definition for more info) */
3046 start = 0; /* Current command start token index */
3047 end = -1; /* Current command end token index */
3048 while (1) {
3049 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3050 int interpolation = 0; /* set to 1 if there is at least one
3051 argument of the command obtained via
3052 interpolation of more tokens. */
3053 /* Search for the end of command, while
3054 * count the number of args. */
3055 start = ++end;
3056 if (start >= script->len) break;
3057 args = 1; /* Number of args in current command */
3058 while (token[end].type != JIM_TT_EOL) {
3059 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3060 token[end-1].type == JIM_TT_EOL)
3061 {
3062 if (token[end].type == JIM_TT_STR &&
3063 token[end + 1].type != JIM_TT_SEP &&
3064 token[end + 1].type != JIM_TT_EOL &&
3065 (!strcmp(token[end].objPtr->bytes, "expand") ||
3066 !strcmp(token[end].objPtr->bytes, "*")))
3067 expand++;
3068 }
3069 if (token[end].type == JIM_TT_SEP)
3070 args++;
3071 end++;
3072 }
3073 interpolation = !((end-start + 1) == args*2);
3074 /* Add the 'number of arguments' info into cmdstruct.
3075 * Negative value if there is list expansion involved. */
3076 if (expand)
3077 ScriptObjAddInt(script, -1);
3078 ScriptObjAddInt(script, args);
3079 /* Now add info about the number of tokens. */
3080 tokens = 0; /* Number of tokens in current argument. */
3081 expand = 0;
3082 for (i = start; i <= end; i++) {
3083 if (token[i].type == JIM_TT_SEP ||
3084 token[i].type == JIM_TT_EOL)
3085 {
3086 if (tokens == 1 && expand)
3087 expand = 0;
3088 ScriptObjAddInt(script,
3089 expand ? -tokens : tokens);
3090
3091 expand = 0;
3092 tokens = 0;
3093 continue;
3094 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3095 (!strcmp(token[i].objPtr->bytes, "expand") ||
3096 !strcmp(token[i].objPtr->bytes, "*")))
3097 {
3098 expand++;
3099 }
3100 tokens++;
3101 }
3102 }
3103 /* Perform literal sharing, but only for objects that appear
3104 * to be scripts written as literals inside the source code,
3105 * and not computed at runtime. Literal sharing is a costly
3106 * operation that should be done only against objects that
3107 * are likely to require compilation only the first time, and
3108 * then are executed multiple times. */
3109 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3110 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3111 if (bodyObjPtr->typePtr == &scriptObjType) {
3112 ScriptObj *bodyScript =
3113 bodyObjPtr->internalRep.ptr;
3114 ScriptShareLiterals(interp, script, bodyScript);
3115 }
3116 } else if (propagateSourceInfo) {
3117 ScriptShareLiterals(interp, script, NULL);
3118 }
3119 /* Free the old internal rep and set the new one. */
3120 Jim_FreeIntRep(interp, objPtr);
3121 Jim_SetIntRepPtr(objPtr, script);
3122 objPtr->typePtr = &scriptObjType;
3123 return JIM_OK;
3124 }
3125
3126 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3127 {
3128 if (objPtr->typePtr != &scriptObjType) {
3129 SetScriptFromAny(interp, objPtr);
3130 }
3131 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3132 }
3133
3134 /* -----------------------------------------------------------------------------
3135 * Commands
3136 * ---------------------------------------------------------------------------*/
3137
3138 /* Commands HashTable Type.
3139 *
3140 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3141 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3142 {
3143 Jim_Cmd *cmdPtr = (void*) val;
3144
3145 if (cmdPtr->cmdProc == NULL) {
3146 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3147 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3148 if (cmdPtr->staticVars) {
3149 Jim_FreeHashTable(cmdPtr->staticVars);
3150 Jim_Free(cmdPtr->staticVars);
3151 }
3152 } else if (cmdPtr->delProc != NULL) {
3153 /* If it was a C coded command, call the delProc if any */
3154 cmdPtr->delProc(interp, cmdPtr->privData);
3155 }
3156 Jim_Free(val);
3157 }
3158
3159 static Jim_HashTableType JimCommandsHashTableType = {
3160 JimStringCopyHTHashFunction, /* hash function */
3161 JimStringCopyHTKeyDup, /* key dup */
3162 NULL, /* val dup */
3163 JimStringCopyHTKeyCompare, /* key compare */
3164 JimStringCopyHTKeyDestructor, /* key destructor */
3165 Jim_CommandsHT_ValDestructor /* val destructor */
3166 };
3167
3168 /* ------------------------- Commands related functions --------------------- */
3169
3170 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3171 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3172 {
3173 Jim_HashEntry *he;
3174 Jim_Cmd *cmdPtr;
3175
3176 he = Jim_FindHashEntry(&interp->commands, cmdName);
3177 if (he == NULL) { /* New command to create */
3178 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3179 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3180 } else {
3181 Jim_InterpIncrProcEpoch(interp);
3182 /* Free the arglist/body objects if it was a Tcl procedure */
3183 cmdPtr = he->val;
3184 if (cmdPtr->cmdProc == NULL) {
3185 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3186 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3187 if (cmdPtr->staticVars) {
3188 Jim_FreeHashTable(cmdPtr->staticVars);
3189 Jim_Free(cmdPtr->staticVars);
3190 }
3191 cmdPtr->staticVars = NULL;
3192 } else if (cmdPtr->delProc != NULL) {
3193 /* If it was a C coded command, call the delProc if any */
3194 cmdPtr->delProc(interp, cmdPtr->privData);
3195 }
3196 }
3197
3198 /* Store the new details for this proc */
3199 cmdPtr->delProc = delProc;
3200 cmdPtr->cmdProc = cmdProc;
3201 cmdPtr->privData = privData;
3202
3203 /* There is no need to increment the 'proc epoch' because
3204 * creation of a new procedure can never affect existing
3205 * cached commands. We don't do negative caching. */
3206 return JIM_OK;
3207 }
3208
3209 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3210 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3211 int arityMin, int arityMax)
3212 {
3213 Jim_Cmd *cmdPtr;
3214
3215 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3216 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3217 cmdPtr->argListObjPtr = argListObjPtr;
3218 cmdPtr->bodyObjPtr = bodyObjPtr;
3219 Jim_IncrRefCount(argListObjPtr);
3220 Jim_IncrRefCount(bodyObjPtr);
3221 cmdPtr->arityMin = arityMin;
3222 cmdPtr->arityMax = arityMax;
3223 cmdPtr->staticVars = NULL;
3224
3225 /* Create the statics hash table. */
3226 if (staticsListObjPtr) {
3227 int len, i;
3228
3229 Jim_ListLength(interp, staticsListObjPtr, &len);
3230 if (len != 0) {
3231 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3232 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3233 interp);
3234 for (i = 0; i < len; i++) {
3235 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3236 Jim_Var *varPtr;
3237 int subLen;
3238
3239 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3240 /* Check if it's composed of two elements. */
3241 Jim_ListLength(interp, objPtr, &subLen);
3242 if (subLen == 1 || subLen == 2) {
3243 /* Try to get the variable value from the current
3244 * environment. */
3245 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3246 if (subLen == 1) {
3247 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3248 JIM_NONE);
3249 if (initObjPtr == NULL) {
3250 Jim_SetResult(interp,
3251 Jim_NewEmptyStringObj(interp));
3252 Jim_AppendStrings(interp, Jim_GetResult(interp),
3253 "variable for initialization of static \"",
3254 Jim_GetString(nameObjPtr, NULL),
3255 "\" not found in the local context",
3256 NULL);
3257 goto err;
3258 }
3259 } else {
3260 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3261 }
3262 varPtr = Jim_Alloc(sizeof(*varPtr));
3263 varPtr->objPtr = initObjPtr;
3264 Jim_IncrRefCount(initObjPtr);
3265 varPtr->linkFramePtr = NULL;
3266 if (Jim_AddHashEntry(cmdPtr->staticVars,
3267 Jim_GetString(nameObjPtr, NULL),
3268 varPtr) != JIM_OK)
3269 {
3270 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3271 Jim_AppendStrings(interp, Jim_GetResult(interp),
3272 "static variable name \"",
3273 Jim_GetString(objPtr, NULL), "\"",
3274 " duplicated in statics list", NULL);
3275 Jim_DecrRefCount(interp, initObjPtr);
3276 Jim_Free(varPtr);
3277 goto err;
3278 }
3279 } else {
3280 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3281 Jim_AppendStrings(interp, Jim_GetResult(interp),
3282 "too many fields in static specifier \"",
3283 objPtr, "\"", NULL);
3284 goto err;
3285 }
3286 }
3287 }
3288 }
3289
3290 /* Add the new command */
3291
3292 /* it may already exist, so we try to delete the old one */
3293 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3294 /* There was an old procedure with the same name, this requires
3295 * a 'proc epoch' update. */
3296 Jim_InterpIncrProcEpoch(interp);
3297 }
3298 /* If a procedure with the same name didn't existed there is no need
3299 * to increment the 'proc epoch' because creation of a new procedure
3300 * can never affect existing cached commands. We don't do
3301 * negative caching. */
3302 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3303 return JIM_OK;
3304
3305 err:
3306 Jim_FreeHashTable(cmdPtr->staticVars);
3307 Jim_Free(cmdPtr->staticVars);
3308 Jim_DecrRefCount(interp, argListObjPtr);
3309 Jim_DecrRefCount(interp, bodyObjPtr);
3310 Jim_Free(cmdPtr);
3311 return JIM_ERR;
3312 }
3313
3314 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3315 {
3316 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3317 return JIM_ERR;
3318 Jim_InterpIncrProcEpoch(interp);
3319 return JIM_OK;
3320 }
3321
3322 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3323 const char *newName)
3324 {
3325 Jim_Cmd *cmdPtr;
3326 Jim_HashEntry *he;
3327 Jim_Cmd *copyCmdPtr;
3328
3329 if (newName[0] == '\0') /* Delete! */
3330 return Jim_DeleteCommand(interp, oldName);
3331 /* Rename */
3332 he = Jim_FindHashEntry(&interp->commands, oldName);
3333 if (he == NULL)
3334 return JIM_ERR; /* Invalid command name */
3335 cmdPtr = he->val;
3336 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3337 *copyCmdPtr = *cmdPtr;
3338 /* In order to avoid that a procedure will get arglist/body/statics
3339 * freed by the hash table methods, fake a C-coded command
3340 * setting cmdPtr->cmdProc as not NULL */
3341 cmdPtr->cmdProc = (void*)1;
3342 /* Also make sure delProc is NULL. */
3343 cmdPtr->delProc = NULL;
3344 /* Destroy the old command, and make sure the new is freed
3345 * as well. */
3346 Jim_DeleteHashEntry(&interp->commands, oldName);
3347 Jim_DeleteHashEntry(&interp->commands, newName);
3348 /* Now the new command. We are sure it can't fail because
3349 * the target name was already freed. */
3350 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3351 /* Increment the epoch */
3352 Jim_InterpIncrProcEpoch(interp);
3353 return JIM_OK;
3354 }
3355
3356 /* -----------------------------------------------------------------------------
3357 * Command object
3358 * ---------------------------------------------------------------------------*/
3359
3360 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3361
3362 static Jim_ObjType commandObjType = {
3363 "command",
3364 NULL,
3365 NULL,
3366 NULL,
3367 JIM_TYPE_REFERENCES,
3368 };
3369
3370 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3371 {
3372 Jim_HashEntry *he;
3373 const char *cmdName;
3374
3375 /* Get the string representation */
3376 cmdName = Jim_GetString(objPtr, NULL);
3377 /* Lookup this name into the commands hash table */
3378 he = Jim_FindHashEntry(&interp->commands, cmdName);
3379 if (he == NULL)
3380 return JIM_ERR;
3381
3382 /* Free the old internal repr and set the new one. */
3383 Jim_FreeIntRep(interp, objPtr);
3384 objPtr->typePtr = &commandObjType;
3385 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3386 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3387 return JIM_OK;
3388 }
3389
3390 /* This function returns the command structure for the command name
3391 * stored in objPtr. It tries to specialize the objPtr to contain
3392 * a cached info instead to perform the lookup into the hash table
3393 * every time. The information cached may not be uptodate, in such
3394 * a case the lookup is performed and the cache updated. */
3395 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3396 {
3397 if ((objPtr->typePtr != &commandObjType ||
3398 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3399 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3400 if (flags & JIM_ERRMSG) {
3401 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3402 Jim_AppendStrings(interp, Jim_GetResult(interp),
3403 "invalid command name \"", objPtr->bytes, "\"",
3404 NULL);
3405 }
3406 return NULL;
3407 }
3408 return objPtr->internalRep.cmdValue.cmdPtr;
3409 }
3410
3411 /* -----------------------------------------------------------------------------
3412 * Variables
3413 * ---------------------------------------------------------------------------*/
3414
3415 /* Variables HashTable Type.
3416 *
3417 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3418 static void JimVariablesHTValDestructor(void *interp, void *val)
3419 {
3420 Jim_Var *varPtr = (void*) val;
3421
3422 Jim_DecrRefCount(interp, varPtr->objPtr);
3423 Jim_Free(val);
3424 }
3425
3426 static Jim_HashTableType JimVariablesHashTableType = {
3427 JimStringCopyHTHashFunction, /* hash function */
3428 JimStringCopyHTKeyDup, /* key dup */
3429 NULL, /* val dup */
3430 JimStringCopyHTKeyCompare, /* key compare */
3431 JimStringCopyHTKeyDestructor, /* key destructor */
3432 JimVariablesHTValDestructor /* val destructor */
3433 };
3434
3435 static Jim_HashTableType *getJimVariablesHashTableType(void)
3436 {
3437 return &JimVariablesHashTableType;
3438 }
3439
3440 /* -----------------------------------------------------------------------------
3441 * Variable object
3442 * ---------------------------------------------------------------------------*/
3443
3444 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3445
3446 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3447
3448 static Jim_ObjType variableObjType = {
3449 "variable",
3450 NULL,
3451 NULL,
3452 NULL,
3453 JIM_TYPE_REFERENCES,
3454 };
3455
3456 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3457 * is in the form "varname(key)". */
3458 static int Jim_NameIsDictSugar(const char *str, int len)
3459 {
3460 if (len == -1)
3461 len = strlen(str);
3462 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3463 return 1;
3464 return 0;
3465 }
3466
3467 /* This method should be called only by the variable API.
3468 * It returns JIM_OK on success (variable already exists),
3469 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3470 * a variable name, but syntax glue for [dict] i.e. the last
3471 * character is ')' */
3472 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3473 {
3474 Jim_HashEntry *he;
3475 const char *varName;
3476 int len;
3477
3478 /* Check if the object is already an uptodate variable */
3479 if (objPtr->typePtr == &variableObjType &&
3480 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3481 return JIM_OK; /* nothing to do */
3482 /* Get the string representation */
3483 varName = Jim_GetString(objPtr, &len);
3484 /* Make sure it's not syntax glue to get/set dict. */
3485 if (Jim_NameIsDictSugar(varName, len))
3486 return JIM_DICT_SUGAR;
3487 if (varName[0] == ':' && varName[1] == ':') {
3488 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3489 if (he == NULL) {
3490 return JIM_ERR;
3491 }
3492 }
3493 else {
3494 /* Lookup this name into the variables hash table */
3495 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3496 if (he == NULL) {
3497 /* Try with static vars. */
3498 if (interp->framePtr->staticVars == NULL)
3499 return JIM_ERR;
3500 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3501 return JIM_ERR;
3502 }
3503 }
3504 /* Free the old internal repr and set the new one. */
3505 Jim_FreeIntRep(interp, objPtr);
3506 objPtr->typePtr = &variableObjType;
3507 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3508 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3509 return JIM_OK;
3510 }
3511
3512 /* -------------------- Variables related functions ------------------------- */
3513 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3514 Jim_Obj *valObjPtr);
3515 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3516
3517 /* For now that's dummy. Variables lookup should be optimized
3518 * in many ways, with caching of lookups, and possibly with
3519 * a table of pre-allocated vars in every CallFrame for local vars.
3520 * All the caching should also have an 'epoch' mechanism similar
3521 * to the one used by Tcl for procedures lookup caching. */
3522
3523 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3524 {
3525 const char *name;
3526 Jim_Var *var;
3527 int err;
3528
3529 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3530 /* Check for [dict] syntax sugar. */
3531 if (err == JIM_DICT_SUGAR)
3532 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3533 /* New variable to create */
3534 name = Jim_GetString(nameObjPtr, NULL);
3535
3536 var = Jim_Alloc(sizeof(*var));
3537 var->objPtr = valObjPtr;
3538 Jim_IncrRefCount(valObjPtr);
3539 var->linkFramePtr = NULL;
3540 /* Insert the new variable */
3541 if (name[0] == ':' && name[1] == ':') {
3542 /* Into to the top evel frame */
3543 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3544 }
3545 else {
3546 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3547 }
3548 /* Make the object int rep a variable */
3549 Jim_FreeIntRep(interp, nameObjPtr);
3550 nameObjPtr->typePtr = &variableObjType;
3551 nameObjPtr->internalRep.varValue.callFrameId =
3552 interp->framePtr->id;
3553 nameObjPtr->internalRep.varValue.varPtr = var;
3554 } else {
3555 var = nameObjPtr->internalRep.varValue.varPtr;
3556 if (var->linkFramePtr == NULL) {
3557 Jim_IncrRefCount(valObjPtr);
3558 Jim_DecrRefCount(interp, var->objPtr);
3559 var->objPtr = valObjPtr;
3560 } else { /* Else handle the link */
3561 Jim_CallFrame *savedCallFrame;
3562
3563 savedCallFrame = interp->framePtr;
3564 interp->framePtr = var->linkFramePtr;
3565 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3566 interp->framePtr = savedCallFrame;
3567 if (err != JIM_OK)
3568 return err;
3569 }
3570 }
3571 return JIM_OK;
3572 }
3573
3574 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3575 {
3576 Jim_Obj *nameObjPtr;
3577 int result;
3578
3579 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3580 Jim_IncrRefCount(nameObjPtr);
3581 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3582 Jim_DecrRefCount(interp, nameObjPtr);
3583 return result;
3584 }
3585
3586 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3587 {
3588 Jim_CallFrame *savedFramePtr;
3589 int result;
3590
3591 savedFramePtr = interp->framePtr;
3592 interp->framePtr = interp->topFramePtr;
3593 result = Jim_SetVariableStr(interp, name, objPtr);
3594 interp->framePtr = savedFramePtr;
3595 return result;
3596 }
3597
3598 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3599 {
3600 Jim_Obj *nameObjPtr, *valObjPtr;
3601 int result;
3602
3603 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3604 valObjPtr = Jim_NewStringObj(interp, val, -1);
3605 Jim_IncrRefCount(nameObjPtr);
3606 Jim_IncrRefCount(valObjPtr);
3607 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3608 Jim_DecrRefCount(interp, nameObjPtr);
3609 Jim_DecrRefCount(interp, valObjPtr);
3610 return result;
3611 }
3612
3613 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3614 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3615 {
3616 const char *varName;
3617 int len;
3618
3619 /* Check for cycles. */
3620 if (interp->framePtr == targetCallFrame) {
3621 Jim_Obj *objPtr = targetNameObjPtr;
3622 Jim_Var *varPtr;
3623 /* Cycles are only possible with 'uplevel 0' */
3624 while (1) {
3625 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3626 Jim_SetResultString(interp,
3627 "can't upvar from variable to itself", -1);
3628 return JIM_ERR;
3629 }
3630 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3631 break;
3632 varPtr = objPtr->internalRep.varValue.varPtr;
3633 if (varPtr->linkFramePtr != targetCallFrame) break;
3634 objPtr = varPtr->objPtr;
3635 }
3636 }
3637 varName = Jim_GetString(nameObjPtr, &len);
3638 if (Jim_NameIsDictSugar(varName, len)) {
3639 Jim_SetResultString(interp,
3640 "Dict key syntax invalid as link source", -1);
3641 return JIM_ERR;
3642 }
3643 /* Perform the binding */
3644 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3645 /* We are now sure 'nameObjPtr' type is variableObjType */
3646 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3647 return JIM_OK;
3648 }
3649
3650 /* Return the Jim_Obj pointer associated with a variable name,
3651 * or NULL if the variable was not found in the current context.
3652 * The same optimization discussed in the comment to the
3653 * 'SetVariable' function should apply here. */
3654 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3655 {
3656 int err;
3657
3658 /* All the rest is handled here */
3659 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3660 /* Check for [dict] syntax sugar. */
3661 if (err == JIM_DICT_SUGAR)
3662 return JimDictSugarGet(interp, nameObjPtr);
3663 if (flags & JIM_ERRMSG) {
3664 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3665 Jim_AppendStrings(interp, Jim_GetResult(interp),
3666 "can't read \"", nameObjPtr->bytes,
3667 "\": no such variable", NULL);
3668 }
3669 return NULL;
3670 } else {
3671 Jim_Var *varPtr;
3672 Jim_Obj *objPtr;
3673 Jim_CallFrame *savedCallFrame;
3674
3675 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3676 if (varPtr->linkFramePtr == NULL)
3677 return varPtr->objPtr;
3678 /* The variable is a link? Resolve it. */
3679 savedCallFrame = interp->framePtr;
3680 interp->framePtr = varPtr->linkFramePtr;
3681 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3682 if (objPtr == NULL && flags & JIM_ERRMSG) {
3683 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3684 Jim_AppendStrings(interp, Jim_GetResult(interp),
3685 "can't read \"", nameObjPtr->bytes,
3686 "\": no such variable", NULL);
3687 }
3688 interp->framePtr = savedCallFrame;
3689 return objPtr;
3690 }
3691 }
3692
3693 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3694 int flags)
3695 {
3696 Jim_CallFrame *savedFramePtr;
3697 Jim_Obj *objPtr;
3698
3699 savedFramePtr = interp->framePtr;
3700 interp->framePtr = interp->topFramePtr;
3701 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3702 interp->framePtr = savedFramePtr;
3703
3704 return objPtr;
3705 }
3706
3707 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3708 {
3709 Jim_Obj *nameObjPtr, *varObjPtr;
3710
3711 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3712 Jim_IncrRefCount(nameObjPtr);
3713 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3714 Jim_DecrRefCount(interp, nameObjPtr);
3715 return varObjPtr;
3716 }
3717
3718 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3719 int flags)
3720 {
3721 Jim_CallFrame *savedFramePtr;
3722 Jim_Obj *objPtr;
3723
3724 savedFramePtr = interp->framePtr;
3725 interp->framePtr = interp->topFramePtr;
3726 objPtr = Jim_GetVariableStr(interp, name, flags);
3727 interp->framePtr = savedFramePtr;
3728
3729 return objPtr;
3730 }
3731
3732 /* Unset a variable.
3733 * Note: On success unset invalidates all the variable objects created
3734 * in the current call frame incrementing. */
3735 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3736 {
3737 const char *name;
3738 Jim_Var *varPtr;
3739 int err;
3740
3741 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3742 /* Check for [dict] syntax sugar. */
3743 if (err == JIM_DICT_SUGAR)
3744 return JimDictSugarSet(interp, nameObjPtr, NULL);
3745 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3746 Jim_AppendStrings(interp, Jim_GetResult(interp),
3747 "can't unset \"", nameObjPtr->bytes,
3748 "\": no such variable", NULL);
3749 return JIM_ERR; /* var not found */
3750 }
3751 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3752 /* If it's a link call UnsetVariable recursively */
3753 if (varPtr->linkFramePtr) {
3754 int retval;
3755
3756 Jim_CallFrame *savedCallFrame;
3757
3758 savedCallFrame = interp->framePtr;
3759 interp->framePtr = varPtr->linkFramePtr;
3760 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3761 interp->framePtr = savedCallFrame;
3762 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3763 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3764 Jim_AppendStrings(interp, Jim_GetResult(interp),
3765 "can't unset \"", nameObjPtr->bytes,
3766 "\": no such variable", NULL);
3767 }
3768 return retval;
3769 } else {
3770 name = Jim_GetString(nameObjPtr, NULL);
3771 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3772 != JIM_OK) return JIM_ERR;
3773 /* Change the callframe id, invalidating var lookup caching */
3774 JimChangeCallFrameId(interp, interp->framePtr);
3775 return JIM_OK;
3776 }
3777 }
3778
3779 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3780
3781 /* Given a variable name for [dict] operation syntax sugar,
3782 * this function returns two objects, the first with the name
3783 * of the variable to set, and the second with the rispective key.
3784 * For example "foo(bar)" will return objects with string repr. of
3785 * "foo" and "bar".
3786 *
3787 * The returned objects have refcount = 1. The function can't fail. */
3788 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3789 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3790 {
3791 const char *str, *p;
3792 char *t;
3793 int len, keyLen, nameLen;
3794 Jim_Obj *varObjPtr, *keyObjPtr;
3795
3796 str = Jim_GetString(objPtr, &len);
3797 p = strchr(str, '(');
3798 p++;
3799 keyLen = len-((p-str) + 1);
3800 nameLen = (p-str)-1;
3801 /* Create the objects with the variable name and key. */
3802 t = Jim_Alloc(nameLen + 1);
3803 memcpy(t, str, nameLen);
3804 t[nameLen] = '\0';
3805 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3806
3807 t = Jim_Alloc(keyLen + 1);
3808 memcpy(t, p, keyLen);
3809 t[keyLen] = '\0';
3810 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3811
3812 Jim_IncrRefCount(varObjPtr);
3813 Jim_IncrRefCount(keyObjPtr);
3814 *varPtrPtr = varObjPtr;
3815 *keyPtrPtr = keyObjPtr;
3816 }
3817
3818 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3819 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3820 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3821 Jim_Obj *valObjPtr)
3822 {
3823 Jim_Obj *varObjPtr, *keyObjPtr;
3824 int err = JIM_OK;
3825
3826 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3827 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3828 valObjPtr);
3829 Jim_DecrRefCount(interp, varObjPtr);
3830 Jim_DecrRefCount(interp, keyObjPtr);
3831 return err;
3832 }
3833
3834 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3835 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3836 {
3837 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3838
3839 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3840 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3841 if (!dictObjPtr) {
3842 resObjPtr = NULL;
3843 goto err;
3844 }
3845 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3846 != JIM_OK) {
3847 resObjPtr = NULL;
3848 }
3849 err:
3850 Jim_DecrRefCount(interp, varObjPtr);
3851 Jim_DecrRefCount(interp, keyObjPtr);
3852 return resObjPtr;
3853 }
3854
3855 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3856
3857 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3858 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3859 Jim_Obj *dupPtr);
3860
3861 static Jim_ObjType dictSubstObjType = {
3862 "dict-substitution",
3863 FreeDictSubstInternalRep,
3864 DupDictSubstInternalRep,
3865 NULL,
3866 JIM_TYPE_NONE,
3867 };
3868
3869 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3870 {
3871 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3872 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3873 }
3874
3875 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3876 Jim_Obj *dupPtr)
3877 {
3878 JIM_NOTUSED(interp);
3879
3880 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3881 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3882 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3883 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3884 dupPtr->typePtr = &dictSubstObjType;
3885 }
3886
3887 /* This function is used to expand [dict get] sugar in the form
3888 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3889 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3890 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3891 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3892 * the [dict]ionary contained in variable VARNAME. */
3893 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3894 {
3895 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3896 Jim_Obj *substKeyObjPtr = NULL;
3897
3898 if (objPtr->typePtr != &dictSubstObjType) {
3899 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3900 Jim_FreeIntRep(interp, objPtr);
3901 objPtr->typePtr = &dictSubstObjType;
3902 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3903 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3904 }
3905 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3906 &substKeyObjPtr, JIM_NONE)
3907 != JIM_OK) {
3908 substKeyObjPtr = NULL;
3909 goto err;
3910 }
3911 Jim_IncrRefCount(substKeyObjPtr);
3912 dictObjPtr = Jim_GetVariable(interp,
3913 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3914 if (!dictObjPtr) {
3915 resObjPtr = NULL;
3916 goto err;
3917 }
3918 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3919 != JIM_OK) {
3920 resObjPtr = NULL;
3921 goto err;
3922 }
3923 err:
3924 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3925 return resObjPtr;
3926 }
3927
3928 /* -----------------------------------------------------------------------------
3929 * CallFrame
3930 * ---------------------------------------------------------------------------*/
3931
3932 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3933 {
3934 Jim_CallFrame *cf;
3935 if (interp->freeFramesList) {
3936 cf = interp->freeFramesList;
3937 interp->freeFramesList = cf->nextFramePtr;
3938 } else {
3939 cf = Jim_Alloc(sizeof(*cf));
3940 cf->vars.table = NULL;
3941 }
3942
3943 cf->id = interp->callFrameEpoch++;
3944 cf->parentCallFrame = NULL;
3945 cf->argv = NULL;
3946 cf->argc = 0;
3947 cf->procArgsObjPtr = NULL;
3948 cf->procBodyObjPtr = NULL;
3949 cf->nextFramePtr = NULL;
3950 cf->staticVars = NULL;
3951 if (cf->vars.table == NULL)
3952 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3953 return cf;
3954 }
3955
3956 /* Used to invalidate every caching related to callframe stability. */
3957 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3958 {
3959 cf->id = interp->callFrameEpoch++;
3960 }
3961
3962 #define JIM_FCF_NONE 0 /* no flags */
3963 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3964 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3965 int flags)
3966 {
3967 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3968 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3969 if (!(flags & JIM_FCF_NOHT))
3970 Jim_FreeHashTable(&cf->vars);
3971 else {
3972 int i;
3973 Jim_HashEntry **table = cf->vars.table, *he;
3974
3975 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3976 he = table[i];
3977 while (he != NULL) {
3978 Jim_HashEntry *nextEntry = he->next;
3979 Jim_Var *varPtr = (void*) he->val;
3980
3981 Jim_DecrRefCount(interp, varPtr->objPtr);
3982 Jim_Free(he->val);
3983 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3984 Jim_Free(he);
3985 table[i] = NULL;
3986 he = nextEntry;
3987 }
3988 }
3989 cf->vars.used = 0;
3990 }
3991 cf->nextFramePtr = interp->freeFramesList;
3992 interp->freeFramesList = cf;
3993 }
3994
3995 /* -----------------------------------------------------------------------------
3996 * References
3997 * ---------------------------------------------------------------------------*/
3998
3999 /* References HashTable Type.
4000 *
4001 * Keys are jim_wide integers, dynamically allocated for now but in the
4002 * future it's worth to cache this 8 bytes objects. Values are poitners
4003 * to Jim_References. */
4004 static void JimReferencesHTValDestructor(void *interp, void *val)
4005 {
4006 Jim_Reference *refPtr = (void*) val;
4007
4008 Jim_DecrRefCount(interp, refPtr->objPtr);
4009 if (refPtr->finalizerCmdNamePtr != NULL) {
4010 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4011 }
4012 Jim_Free(val);
4013 }
4014
4015 unsigned int JimReferencesHTHashFunction(const void *key)
4016 {
4017 /* Only the least significant bits are used. */
4018 const jim_wide *widePtr = key;
4019 unsigned int intValue = (unsigned int) *widePtr;
4020 return Jim_IntHashFunction(intValue);
4021 }
4022
4023 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4024 {
4025 /* Only the least significant bits are used. */
4026 const jim_wide *widePtr = key;
4027 unsigned int intValue = (unsigned int) *widePtr;
4028 return intValue; /* identity function. */
4029 }
4030
4031 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4032 {
4033 void *copy = Jim_Alloc(sizeof(jim_wide));
4034 JIM_NOTUSED(privdata);
4035
4036 memcpy(copy, key, sizeof(jim_wide));
4037 return copy;
4038 }
4039
4040 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4041 const void *key2)
4042 {
4043 JIM_NOTUSED(privdata);
4044
4045 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4046 }
4047
4048 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4049 {
4050 JIM_NOTUSED(privdata);
4051
4052 Jim_Free((void*)key);
4053 }
4054
4055 static Jim_HashTableType JimReferencesHashTableType = {
4056 JimReferencesHTHashFunction, /* hash function */
4057 JimReferencesHTKeyDup, /* key dup */
4058 NULL, /* val dup */
4059 JimReferencesHTKeyCompare, /* key compare */
4060 JimReferencesHTKeyDestructor, /* key destructor */
4061 JimReferencesHTValDestructor /* val destructor */
4062 };
4063
4064 /* -----------------------------------------------------------------------------
4065 * Reference object type and References API
4066 * ---------------------------------------------------------------------------*/
4067
4068 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4069
4070 static Jim_ObjType referenceObjType = {
4071 "reference",
4072 NULL,
4073 NULL,
4074 UpdateStringOfReference,
4075 JIM_TYPE_REFERENCES,
4076 };
4077
4078 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4079 {
4080 int len;
4081 char buf[JIM_REFERENCE_SPACE + 1];
4082 Jim_Reference *refPtr;
4083
4084 refPtr = objPtr->internalRep.refValue.refPtr;
4085 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4086 objPtr->bytes = Jim_Alloc(len + 1);
4087 memcpy(objPtr->bytes, buf, len + 1);
4088 objPtr->length = len;
4089 }
4090
4091 /* returns true if 'c' is a valid reference tag character.
4092 * i.e. inside the range [_a-zA-Z0-9] */
4093 static int isrefchar(int c)
4094 {
4095 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4096 (c >= '0' && c <= '9')) return 1;
4097 return 0;
4098 }
4099
4100 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4101 {
4102 jim_wide wideValue;
4103 int i, len;
4104 const char *str, *start, *end;
4105 char refId[21];
4106 Jim_Reference *refPtr;
4107 Jim_HashEntry *he;
4108
4109 /* Get the string representation */
4110 str = Jim_GetString(objPtr, &len);
4111 /* Check if it looks like a reference */
4112 if (len < JIM_REFERENCE_SPACE) goto badformat;
4113 /* Trim spaces */
4114 start = str;
4115 end = str + len-1;
4116 while (*start == ' ') start++;
4117 while (*end == ' ' && end > start) end--;
4118 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4119 /* <reference.<1234567>.%020> */
4120 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4121 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4122 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4123 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4124 if (!isrefchar(start[12 + i])) goto badformat;
4125 }
4126 /* Extract info from the refernece. */
4127 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4128 refId[20] = '\0';
4129 /* Try to convert the ID into a jim_wide */
4130 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4131 /* Check if the reference really exists! */
4132 he = Jim_FindHashEntry(&interp->references, &wideValue);
4133 if (he == NULL) {
4134 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4135 Jim_AppendStrings(interp, Jim_GetResult(interp),
4136 "Invalid reference ID \"", str, "\"", NULL);
4137 return JIM_ERR;
4138 }
4139 refPtr = he->val;
4140 /* Free the old internal repr and set the new one. */
4141 Jim_FreeIntRep(interp, objPtr);
4142 objPtr->typePtr = &referenceObjType;
4143 objPtr->internalRep.refValue.id = wideValue;
4144 objPtr->internalRep.refValue.refPtr = refPtr;
4145 return JIM_OK;
4146
4147 badformat:
4148 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4149 Jim_AppendStrings(interp, Jim_GetResult(interp),
4150 "expected reference but got \"", str, "\"", NULL);
4151 return JIM_ERR;
4152 }
4153
4154 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4155 * as finalizer command (or NULL if there is no finalizer).
4156 * The returned reference object has refcount = 0. */
4157 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4158 Jim_Obj *cmdNamePtr)
4159 {
4160 struct Jim_Reference *refPtr;
4161 jim_wide wideValue = interp->referenceNextId;
4162 Jim_Obj *refObjPtr;
4163 const char *tag;
4164 int tagLen, i;
4165
4166 /* Perform the Garbage Collection if needed. */
4167 Jim_CollectIfNeeded(interp);
4168
4169 refPtr = Jim_Alloc(sizeof(*refPtr));
4170 refPtr->objPtr = objPtr;
4171 Jim_IncrRefCount(objPtr);
4172 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4173 if (cmdNamePtr)
4174 Jim_IncrRefCount(cmdNamePtr);
4175 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4176 refObjPtr = Jim_NewObj(interp);
4177 refObjPtr->typePtr = &referenceObjType;
4178 refObjPtr->bytes = NULL;
4179 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4180 refObjPtr->internalRep.refValue.refPtr = refPtr;
4181 interp->referenceNextId++;
4182 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4183 * that does not pass the 'isrefchar' test is replaced with '_' */
4184 tag = Jim_GetString(tagPtr, &tagLen);
4185 if (tagLen > JIM_REFERENCE_TAGLEN)
4186 tagLen = JIM_REFERENCE_TAGLEN;
4187 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4188 if (i < tagLen)
4189 refPtr->tag[i] = tag[i];
4190 else
4191 refPtr->tag[i] = '_';
4192 }
4193 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4194 return refObjPtr;
4195 }
4196
4197 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4198 {
4199 if (objPtr->typePtr != &referenceObjType &&
4200 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4201 return NULL;
4202 return objPtr->internalRep.refValue.refPtr;
4203 }
4204
4205 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4206 {
4207 Jim_Reference *refPtr;
4208
4209 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4210 return JIM_ERR;
4211 Jim_IncrRefCount(cmdNamePtr);
4212 if (refPtr->finalizerCmdNamePtr)
4213 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4214 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4215 return JIM_OK;
4216 }
4217
4218 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4219 {
4220 Jim_Reference *refPtr;
4221
4222 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4223 return JIM_ERR;
4224 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4225 return JIM_OK;
4226 }
4227
4228 /* -----------------------------------------------------------------------------
4229 * References Garbage Collection
4230 * ---------------------------------------------------------------------------*/
4231
4232 /* This the hash table type for the "MARK" phase of the GC */
4233 static Jim_HashTableType JimRefMarkHashTableType = {
4234 JimReferencesHTHashFunction, /* hash function */
4235 JimReferencesHTKeyDup, /* key dup */
4236 NULL, /* val dup */
4237 JimReferencesHTKeyCompare, /* key compare */
4238 JimReferencesHTKeyDestructor, /* key destructor */
4239 NULL /* val destructor */
4240 };
4241
4242 /* #define JIM_DEBUG_GC 1 */
4243
4244 /* Performs the garbage collection. */
4245 int Jim_Collect(Jim_Interp *interp)
4246 {
4247 Jim_HashTable marks;
4248 Jim_HashTableIterator *htiter;
4249 Jim_HashEntry *he;
4250 Jim_Obj *objPtr;
4251 int collected = 0;
4252
4253 /* Avoid recursive calls */
4254 if (interp->lastCollectId == -1) {
4255 /* Jim_Collect() already running. Return just now. */
4256 return 0;
4257 }
4258 interp->lastCollectId = -1;
4259
4260 /* Mark all the references found into the 'mark' hash table.
4261 * The references are searched in every live object that
4262 * is of a type that can contain references. */
4263 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4264 objPtr = interp->liveList;
4265 while (objPtr) {
4266 if (objPtr->typePtr == NULL ||
4267 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4268 const char *str, *p;
4269 int len;
4270
4271 /* If the object is of type reference, to get the
4272 * Id is simple... */
4273 if (objPtr->typePtr == &referenceObjType) {
4274 Jim_AddHashEntry(&marks,
4275 &objPtr->internalRep.refValue.id, NULL);
4276 #ifdef JIM_DEBUG_GC
4277 Jim_fprintf(interp,interp->cookie_stdout,
4278 "MARK (reference): %d refcount: %d" JIM_NL,
4279 (int) objPtr->internalRep.refValue.id,
4280 objPtr->refCount);
4281 #endif
4282 objPtr = objPtr->nextObjPtr;
4283 continue;
4284 }
4285 /* Get the string repr of the object we want
4286 * to scan for references. */
4287 p = str = Jim_GetString(objPtr, &len);
4288 /* Skip objects too little to contain references. */
4289 if (len < JIM_REFERENCE_SPACE) {
4290 objPtr = objPtr->nextObjPtr;
4291 continue;
4292 }
4293 /* Extract references from the object string repr. */
4294 while (1) {
4295 int i;
4296 jim_wide id;
4297 char buf[21];
4298
4299 if ((p = strstr(p, "<reference.<")) == NULL)
4300 break;
4301 /* Check if it's a valid reference. */
4302 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4303 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4304 for (i = 21; i <= 40; i++)
4305 if (!isdigit((int)p[i]))
4306 break;
4307 /* Get the ID */
4308 memcpy(buf, p + 21, 20);
4309 buf[20] = '\0';
4310 Jim_StringToWide(buf, &id, 10);
4311
4312 /* Ok, a reference for the given ID
4313 * was found. Mark it. */
4314 Jim_AddHashEntry(&marks, &id, NULL);
4315 #ifdef JIM_DEBUG_GC
4316 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4317 #endif
4318 p += JIM_REFERENCE_SPACE;
4319 }
4320 }
4321 objPtr = objPtr->nextObjPtr;
4322 }
4323
4324 /* Run the references hash table to destroy every reference that
4325 * is not referenced outside (not present in the mark HT). */
4326 htiter = Jim_GetHashTableIterator(&interp->references);
4327 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4328 const jim_wide *refId;
4329 Jim_Reference *refPtr;
4330
4331 refId = he->key;
4332 /* Check if in the mark phase we encountered
4333 * this reference. */
4334 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4335 #ifdef JIM_DEBUG_GC
4336 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4337 #endif
4338 collected++;
4339 /* Drop the reference, but call the
4340 * finalizer first if registered. */
4341 refPtr = he->val;
4342 if (refPtr->finalizerCmdNamePtr) {
4343 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4344 Jim_Obj *objv[3], *oldResult;
4345
4346 JimFormatReference(refstr, refPtr, *refId);
4347
4348 objv[0] = refPtr->finalizerCmdNamePtr;
4349 objv[1] = Jim_NewStringObjNoAlloc(interp,
4350 refstr, 32);
4351 objv[2] = refPtr->objPtr;
4352 Jim_IncrRefCount(objv[0]);
4353 Jim_IncrRefCount(objv[1]);
4354 Jim_IncrRefCount(objv[2]);
4355
4356 /* Drop the reference itself */
4357 Jim_DeleteHashEntry(&interp->references, refId);
4358
4359 /* Call the finalizer. Errors ignored. */
4360 oldResult = interp->result;
4361 Jim_IncrRefCount(oldResult);
4362 Jim_EvalObjVector(interp, 3, objv);
4363 Jim_SetResult(interp, oldResult);
4364 Jim_DecrRefCount(interp, oldResult);
4365
4366 Jim_DecrRefCount(interp, objv[0]);
4367 Jim_DecrRefCount(interp, objv[1]);
4368 Jim_DecrRefCount(interp, objv[2]);
4369 } else {
4370 Jim_DeleteHashEntry(&interp->references, refId);
4371 }
4372 }
4373 }
4374 Jim_FreeHashTableIterator(htiter);
4375 Jim_FreeHashTable(&marks);
4376 interp->lastCollectId = interp->referenceNextId;
4377 interp->lastCollectTime = time(NULL);
4378 return collected;
4379 }
4380
4381 #define JIM_COLLECT_ID_PERIOD 5000
4382 #define JIM_COLLECT_TIME_PERIOD 300
4383
4384 void Jim_CollectIfNeeded(Jim_Interp *interp)
4385 {
4386 jim_wide elapsedId;
4387 int elapsedTime;
4388
4389 elapsedId = interp->referenceNextId - interp->lastCollectId;
4390 elapsedTime = time(NULL) - interp->lastCollectTime;
4391
4392
4393 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4394 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4395 Jim_Collect(interp);
4396 }
4397 }
4398
4399 /* -----------------------------------------------------------------------------
4400 * Interpreter related functions
4401 * ---------------------------------------------------------------------------*/
4402
4403 Jim_Interp *Jim_CreateInterp(void)
4404 {
4405 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4406 Jim_Obj *pathPtr;
4407
4408 i->errorLine = 0;
4409 i->errorFileName = Jim_StrDup("");
4410 i->numLevels = 0;
4411 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4412 i->returnCode = JIM_OK;
4413 i->exitCode = 0;
4414 i->procEpoch = 0;
4415 i->callFrameEpoch = 0;
4416 i->liveList = i->freeList = NULL;
4417 i->scriptFileName = Jim_StrDup("");
4418 i->referenceNextId = 0;
4419 i->lastCollectId = 0;
4420 i->lastCollectTime = time(NULL);
4421 i->freeFramesList = NULL;
4422 i->prngState = NULL;
4423 i->evalRetcodeLevel = -1;
4424 i->cookie_stdin = stdin;
4425 i->cookie_stdout = stdout;
4426 i->cookie_stderr = stderr;
4427 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4428 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4429 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list ))(vfprintf));
4430 i->cb_fflush = ((int (*)(void *))(fflush));
4431 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4432
4433 /* Note that we can create objects only after the
4434 * interpreter liveList and freeList pointers are
4435 * initialized to NULL. */
4436 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4437 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4438 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4439 NULL);
4440 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4441 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4442 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4443 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4444 i->emptyObj = Jim_NewEmptyStringObj(i);
4445 i->result = i->emptyObj;
4446 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4447 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4448 i->unknown_called = 0;
4449 Jim_IncrRefCount(i->emptyObj);
4450 Jim_IncrRefCount(i->result);
4451 Jim_IncrRefCount(i->stackTrace);
4452 Jim_IncrRefCount(i->unknown);
4453
4454 /* Initialize key variables every interpreter should contain */
4455 pathPtr = Jim_NewStringObj(i, "./", -1);
4456 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4457 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4458
4459 /* Export the core API to extensions */
4460 JimRegisterCoreApi(i);
4461 return i;
4462 }
4463
4464 /* This is the only function Jim exports directly without
4465 * to use the STUB system. It is only used by embedders
4466 * in order to get an interpreter with the Jim API pointers
4467 * registered. */
4468 Jim_Interp *ExportedJimCreateInterp(void)
4469 {
4470 return Jim_CreateInterp();
4471 }
4472
4473 void Jim_FreeInterp(Jim_Interp *i)
4474 {
4475 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4476 Jim_Obj *objPtr, *nextObjPtr;
4477
4478 Jim_DecrRefCount(i, i->emptyObj);
4479 Jim_DecrRefCount(i, i->result);
4480 Jim_DecrRefCount(i, i->stackTrace);
4481 Jim_DecrRefCount(i, i->unknown);
4482 Jim_Free((void*)i->errorFileName);
4483 Jim_Free((void*)i->scriptFileName);
4484 Jim_FreeHashTable(&i->commands);
4485 Jim_FreeHashTable(&i->references);
4486 Jim_FreeHashTable(&i->stub);
4487 Jim_FreeHashTable(&i->assocData);
4488 Jim_FreeHashTable(&i->packages);
4489 Jim_Free(i->prngState);
4490 /* Free the call frames list */
4491 while (cf) {
4492 prevcf = cf->parentCallFrame;
4493 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4494 cf = prevcf;
4495 }
4496 /* Check that the live object list is empty, otherwise
4497 * there is a memory leak. */
4498 if (i->liveList != NULL) {
4499 Jim_Obj *objPtr = i->liveList;
4500
4501 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4502 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4503 while (objPtr) {
4504 const char *type = objPtr->typePtr ?
4505 objPtr->typePtr->name : "";
4506 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4507 objPtr, type,
4508 objPtr->bytes ? objPtr->bytes
4509 : "(null)", objPtr->refCount);
4510 if (objPtr->typePtr == &sourceObjType) {
4511 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4512 objPtr->internalRep.sourceValue.fileName,
4513 objPtr->internalRep.sourceValue.lineNumber);
4514 }
4515 objPtr = objPtr->nextObjPtr;
4516 }
4517 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4518 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4519 }
4520 /* Free all the freed objects. */
4521 objPtr = i->freeList;
4522 while (objPtr) {
4523 nextObjPtr = objPtr->nextObjPtr;
4524 Jim_Free(objPtr);
4525 objPtr = nextObjPtr;
4526 }
4527 /* Free cached CallFrame structures */
4528 cf = i->freeFramesList;
4529 while (cf) {
4530 nextcf = cf->nextFramePtr;
4531 if (cf->vars.table != NULL)
4532 Jim_Free(cf->vars.table);
4533 Jim_Free(cf);
4534 cf = nextcf;
4535 }
4536 /* Free the sharedString hash table. Make sure to free it
4537 * after every other Jim_Object was freed. */
4538 Jim_FreeHashTable(&i->sharedStrings);
4539 /* Free the interpreter structure. */
4540 Jim_Free(i);
4541 }
4542
4543 /* Store the call frame relative to the level represented by
4544 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4545 * level is assumed to be '1'.
4546 *
4547 * If a newLevelptr int pointer is specified, the function stores
4548 * the absolute level integer value of the new target callframe into
4549 * *newLevelPtr. (this is used to adjust interp->numLevels
4550 * in the implementation of [uplevel], so that [info level] will
4551 * return a correct information).
4552 *
4553 * This function accepts the 'level' argument in the form
4554 * of the commands [uplevel] and [upvar].
4555 *
4556 * For a function accepting a relative integer as level suitable
4557 * for implementation of [info level ?level?] check the
4558 * GetCallFrameByInteger() function. */
4559 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4560 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4561 {
4562 long level;
4563 const char *str;
4564 Jim_CallFrame *framePtr;
4565
4566 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4567 if (levelObjPtr) {
4568 str = Jim_GetString(levelObjPtr, NULL);
4569 if (str[0] == '#') {
4570 char *endptr;
4571 /* speedup for the toplevel (level #0) */
4572 if (str[1] == '0' && str[2] == '\0') {
4573 if (newLevelPtr) *newLevelPtr = 0;
4574 *framePtrPtr = interp->topFramePtr;
4575 return JIM_OK;
4576 }
4577
4578 level = strtol(str + 1, &endptr, 0);
4579 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4580 goto badlevel;
4581 /* An 'absolute' level is converted into the
4582 * 'number of levels to go back' format. */
4583 level = interp->numLevels - level;
4584 if (level < 0) goto badlevel;
4585 } else {
4586 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4587 goto badlevel;
4588 }
4589 } else {
4590 str = "1"; /* Needed to format the error message. */
4591 level = 1;
4592 }
4593 /* Lookup */
4594 framePtr = interp->framePtr;
4595 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4596 while (level--) {
4597 framePtr = framePtr->parentCallFrame;
4598 if (framePtr == NULL) goto badlevel;
4599 }
4600 *framePtrPtr = framePtr;
4601 return JIM_OK;
4602 badlevel:
4603 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4604 Jim_AppendStrings(interp, Jim_GetResult(interp),
4605 "bad level \"", str, "\"", NULL);
4606 return JIM_ERR;
4607 }
4608
4609 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4610 * as a relative integer like in the [info level ?level?] command. */
4611 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4612 Jim_CallFrame **framePtrPtr)
4613 {
4614 jim_wide level;
4615 jim_wide relLevel; /* level relative to the current one. */
4616 Jim_CallFrame *framePtr;
4617
4618 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4619 goto badlevel;
4620 if (level > 0) {
4621 /* An 'absolute' level is converted into the
4622 * 'number of levels to go back' format. */
4623 relLevel = interp->numLevels - level;
4624 } else {
4625 relLevel = -level;
4626 }
4627 /* Lookup */
4628 framePtr = interp->framePtr;
4629 while (relLevel--) {
4630 framePtr = framePtr->parentCallFrame;
4631 if (framePtr == NULL) goto badlevel;
4632 }
4633 *framePtrPtr = framePtr;
4634 return JIM_OK;
4635 badlevel:
4636 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4637 Jim_AppendStrings(interp, Jim_GetResult(interp),
4638 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4639 return JIM_ERR;
4640 }
4641
4642 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4643 {
4644 Jim_Free((void*)interp->errorFileName);
4645 interp->errorFileName = Jim_StrDup(filename);
4646 }
4647
4648 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4649 {
4650 interp->errorLine = linenr;
4651 }
4652
4653 static void JimResetStackTrace(Jim_Interp *interp)
4654 {
4655 Jim_DecrRefCount(interp, interp->stackTrace);
4656 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4657 Jim_IncrRefCount(interp->stackTrace);
4658 }
4659
4660 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4661 const char *filename, int linenr)
4662 {
4663 /* No need to add this dummy entry to the stack trace */
4664 if (strcmp(procname, "unknown") == 0) {
4665 return;
4666 }
4667
4668 if (Jim_IsShared(interp->stackTrace)) {
4669 interp->stackTrace =
4670 Jim_DuplicateObj(interp, interp->stackTrace);
4671 Jim_IncrRefCount(interp->stackTrace);
4672 }
4673 Jim_ListAppendElement(interp, interp->stackTrace,
4674 Jim_NewStringObj(interp, procname, -1));
4675 Jim_ListAppendElement(interp, interp->stackTrace,
4676 Jim_NewStringObj(interp, filename, -1));
4677 Jim_ListAppendElement(interp, interp->stackTrace,
4678 Jim_NewIntObj(interp, linenr));
4679 }
4680
4681 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4682 {
4683 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4684 assocEntryPtr->delProc = delProc;
4685 assocEntryPtr->data = data;
4686 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4687 }
4688
4689 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4690 {
4691 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4692 if (entryPtr != NULL) {
4693 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4694 return assocEntryPtr->data;
4695 }
4696 return NULL;
4697 }
4698
4699 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4700 {
4701 return Jim_DeleteHashEntry(&interp->assocData, key);
4702 }
4703
4704 int Jim_GetExitCode(Jim_Interp *interp) {
4705 return interp->exitCode;
4706 }
4707
4708 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4709 {
4710 if (fp != NULL) interp->cookie_stdin = fp;
4711 return interp->cookie_stdin;
4712 }
4713
4714 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4715 {
4716 if (fp != NULL) interp->cookie_stdout = fp;
4717 return interp->cookie_stdout;
4718 }
4719
4720 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4721 {
4722 if (fp != NULL) interp->cookie_stderr = fp;
4723 return interp->cookie_stderr;
4724 }
4725
4726 /* -----------------------------------------------------------------------------
4727 * Shared strings.
4728 * Every interpreter has an hash table where to put shared dynamically
4729 * allocate strings that are likely to be used a lot of times.
4730 * For example, in the 'source' object type, there is a pointer to
4731 * the filename associated with that object. Every script has a lot
4732 * of this objects with the identical file name, so it is wise to share
4733 * this info.
4734 *
4735 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4736 * returns the pointer to the shared string. Every time a reference
4737 * to the string is no longer used, the user should call
4738 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4739 * a given string, it is removed from the hash table.
4740 * ---------------------------------------------------------------------------*/
4741 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4742 {
4743 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4744
4745 if (he == NULL) {
4746 char *strCopy = Jim_StrDup(str);
4747
4748 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4749 return strCopy;
4750 } else {
4751 long refCount = (long) he->val;
4752
4753 refCount++;
4754 he->val = (void*) refCount;
4755 return he->key;
4756 }
4757 }
4758
4759 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4760 {
4761 long refCount;
4762 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4763
4764 if (he == NULL)
4765 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4766 "unknown shared string '%s'", str);
4767 refCount = (long) he->val;
4768 refCount--;
4769 if (refCount == 0) {
4770 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4771 } else {
4772 he->val = (void*) refCount;
4773 }
4774 }
4775
4776 /* -----------------------------------------------------------------------------
4777 * Integer object
4778 * ---------------------------------------------------------------------------*/
4779 #define JIM_INTEGER_SPACE 24
4780
4781 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4782 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4783
4784 static Jim_ObjType intObjType = {
4785 "int",
4786 NULL,
4787 NULL,
4788 UpdateStringOfInt,
4789 JIM_TYPE_NONE,
4790 };
4791
4792 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4793 {
4794 int len;
4795 char buf[JIM_INTEGER_SPACE + 1];
4796
4797 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4798 objPtr->bytes = Jim_Alloc(len + 1);
4799 memcpy(objPtr->bytes, buf, len + 1);
4800 objPtr->length = len;
4801 }
4802
4803 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4804 {
4805 jim_wide wideValue;
4806 const char *str;
4807
4808 /* Get the string representation */
4809 str = Jim_GetString(objPtr, NULL);
4810 /* Try to convert into a jim_wide */
4811 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4812 if (flags & JIM_ERRMSG) {
4813 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4814 Jim_AppendStrings(interp, Jim_GetResult(interp),
4815 "expected integer but got \"", str, "\"", NULL);
4816 }
4817 return JIM_ERR;
4818 }
4819 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4820 errno == ERANGE) {
4821 Jim_SetResultString(interp,
4822 "Integer value too big to be represented", -1);
4823 return JIM_ERR;
4824 }
4825 /* Free the old internal repr and set the new one. */
4826 Jim_FreeIntRep(interp, objPtr);
4827 objPtr->typePtr = &intObjType;
4828 objPtr->internalRep.wideValue = wideValue;
4829 return JIM_OK;
4830 }
4831
4832 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4833 {
4834 if (objPtr->typePtr != &intObjType &&
4835 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4836 return JIM_ERR;
4837 *widePtr = objPtr->internalRep.wideValue;
4838 return JIM_OK;
4839 }
4840
4841 /* Get a wide but does not set an error if the format is bad. */
4842 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4843 jim_wide *widePtr)
4844 {
4845 if (objPtr->typePtr != &intObjType &&
4846 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4847 return JIM_ERR;
4848 *widePtr = objPtr->internalRep.wideValue;
4849 return JIM_OK;
4850 }
4851
4852 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4853 {
4854 jim_wide wideValue;
4855 int retval;
4856
4857 retval = Jim_GetWide(interp, objPtr, &wideValue);
4858 if (retval == JIM_OK) {
4859 *longPtr = (long) wideValue;
4860 return JIM_OK;
4861 }
4862 return JIM_ERR;
4863 }
4864
4865 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4866 {
4867 if (Jim_IsShared(objPtr))
4868 Jim_Panic(interp,"Jim_SetWide called with shared object");
4869 if (objPtr->typePtr != &intObjType) {
4870 Jim_FreeIntRep(interp, objPtr);
4871 objPtr->typePtr = &intObjType;
4872 }
4873 Jim_InvalidateStringRep(objPtr);
4874 objPtr->internalRep.wideValue = wideValue;
4875 }
4876
4877 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4878 {
4879 Jim_Obj *objPtr;
4880
4881 objPtr = Jim_NewObj(interp);
4882 objPtr->typePtr = &intObjType;
4883 objPtr->bytes = NULL;
4884 objPtr->internalRep.wideValue = wideValue;
4885 return objPtr;
4886 }
4887
4888 /* -----------------------------------------------------------------------------
4889 * Double object
4890 * ---------------------------------------------------------------------------*/
4891 #define JIM_DOUBLE_SPACE 30
4892
4893 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4894 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4895
4896 static Jim_ObjType doubleObjType = {
4897 "double",
4898 NULL,
4899 NULL,
4900 UpdateStringOfDouble,
4901 JIM_TYPE_NONE,
4902 };
4903
4904 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4905 {
4906 int len;
4907 char buf[JIM_DOUBLE_SPACE + 1];
4908
4909 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4910 objPtr->bytes = Jim_Alloc(len + 1);
4911 memcpy(objPtr->bytes, buf, len + 1);
4912 objPtr->length = len;
4913 }
4914
4915 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4916 {
4917 double doubleValue;
4918 const char *str;
4919
4920 /* Get the string representation */
4921 str = Jim_GetString(objPtr, NULL);
4922 /* Try to convert into a double */
4923 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4924 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4925 Jim_AppendStrings(interp, Jim_GetResult(interp),
4926 "expected number but got '", str, "'", NULL);
4927 return JIM_ERR;
4928 }
4929 /* Free the old internal repr and set the new one. */
4930 Jim_FreeIntRep(interp, objPtr);
4931 objPtr->typePtr = &doubleObjType;
4932 objPtr->internalRep.doubleValue = doubleValue;
4933 return JIM_OK;
4934 }
4935
4936 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4937 {
4938 if (objPtr->typePtr != &doubleObjType &&
4939 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4940 return JIM_ERR;
4941 *doublePtr = objPtr->internalRep.doubleValue;
4942 return JIM_OK;
4943 }
4944
4945 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4946 {
4947 if (Jim_IsShared(objPtr))
4948 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4949 if (objPtr->typePtr != &doubleObjType) {
4950 Jim_FreeIntRep(interp, objPtr);
4951 objPtr->typePtr = &doubleObjType;
4952 }
4953 Jim_InvalidateStringRep(objPtr);
4954 objPtr->internalRep.doubleValue = doubleValue;
4955 }
4956
4957 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4958 {
4959 Jim_Obj *objPtr;
4960
4961 objPtr = Jim_NewObj(interp);
4962 objPtr->typePtr = &doubleObjType;
4963 objPtr->bytes = NULL;
4964 objPtr->internalRep.doubleValue = doubleValue;
4965 return objPtr;
4966 }
4967
4968 /* -----------------------------------------------------------------------------
4969 * List object
4970 * ---------------------------------------------------------------------------*/
4971 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4972 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4973 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4974 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4975 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4976
4977 /* Note that while the elements of the list may contain references,
4978 * the list object itself can't. This basically means that the
4979 * list object string representation as a whole can't contain references
4980 * that are not presents in the single elements. */
4981 static Jim_ObjType listObjType = {
4982 "list",
4983 FreeListInternalRep,
4984 DupListInternalRep,
4985 UpdateStringOfList,
4986 JIM_TYPE_NONE,
4987 };
4988
4989 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4990 {
4991 int i;
4992
4993 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4994 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4995 }
4996 Jim_Free(objPtr->internalRep.listValue.ele);
4997 }
4998
4999 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5000 {
5001 int i;
5002 JIM_NOTUSED(interp);
5003
5004 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5005 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5006 dupPtr->internalRep.listValue.ele =
5007 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5008 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5009 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5010 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5011 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5012 }
5013 dupPtr->typePtr = &listObjType;
5014 }
5015
5016 /* The following function checks if a given string can be encoded
5017 * into a list element without any kind of quoting, surrounded by braces,
5018 * or using escapes to quote. */
5019 #define JIM_ELESTR_SIMPLE 0
5020 #define JIM_ELESTR_BRACE 1
5021 #define JIM_ELESTR_QUOTE 2
5022 static int ListElementQuotingType(const char *s, int len)
5023 {
5024 int i, level, trySimple = 1;
5025
5026 /* Try with the SIMPLE case */
5027 if (len == 0) return JIM_ELESTR_BRACE;
5028 if (s[0] == '"' || s[0] == '{') {
5029 trySimple = 0;
5030 goto testbrace;
5031 }
5032 for (i = 0; i < len; i++) {
5033 switch (s[i]) {
5034 case ' ':
5035 case '$':
5036 case '"':
5037 case '[':
5038 case ']':
5039 case ';':
5040 case '\\':
5041 case '\r':
5042 case '\n':
5043 case '\t':
5044 case '\f':
5045 case '\v':
5046 trySimple = 0;
5047 case '{':
5048 case '}':
5049 goto testbrace;
5050 }
5051 }
5052 return JIM_ELESTR_SIMPLE;
5053
5054 testbrace:
5055 /* Test if it's possible to do with braces */
5056 if (s[len-1] == '\\' ||
5057 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5058 level = 0;
5059 for (i = 0; i < len; i++) {
5060 switch (s[i]) {
5061 case '{': level++; break;
5062 case '}': level--;
5063 if (level < 0) return JIM_ELESTR_QUOTE;
5064 break;
5065 case '\\':
5066 if (s[i + 1] == '\n')
5067 return JIM_ELESTR_QUOTE;
5068 else
5069 if (s[i + 1] != '\0') i++;
5070 break;
5071 }
5072 }
5073 if (level == 0) {
5074 if (!trySimple) return JIM_ELESTR_BRACE;
5075 for (i = 0; i < len; i++) {
5076 switch (s[i]) {
5077 case ' ':
5078 case '$':
5079 case '"':
5080 case '[':
5081 case ']':
5082 case ';':
5083 case '\\':
5084 case '\r':
5085 case '\n':
5086 case '\t':
5087 case '\f':
5088 case '\v':
5089 return JIM_ELESTR_BRACE;
5090 break;
5091 }
5092 }
5093 return JIM_ELESTR_SIMPLE;
5094 }
5095 return JIM_ELESTR_QUOTE;
5096 }
5097
5098 /* Returns the malloc-ed representation of a string
5099 * using backslash to quote special chars. */
5100 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5101 {
5102 char *q = Jim_Alloc(len*2 + 1), *p;
5103
5104 p = q;
5105 while (*s) {
5106 switch (*s) {
5107 case ' ':
5108 case '$':
5109 case '"':
5110 case '[':
5111 case ']':
5112 case '{':
5113 case '}':
5114 case ';':
5115 case '\\':
5116 *p++ = '\\';
5117 *p++ = *s++;
5118 break;
5119 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5120 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5121 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5122 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5123 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5124 default:
5125 *p++ = *s++;
5126 break;
5127 }
5128 }
5129 *p = '\0';
5130 *qlenPtr = p-q;
5131 return q;
5132 }
5133
5134 void UpdateStringOfList(struct Jim_Obj *objPtr)
5135 {
5136 int i, bufLen, realLength;
5137 const char *strRep;
5138 char *p;
5139 int *quotingType;
5140 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5141
5142 /* (Over) Estimate the space needed. */
5143 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5144 bufLen = 0;
5145 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5146 int len;
5147
5148 strRep = Jim_GetString(ele[i], &len);
5149 quotingType[i] = ListElementQuotingType(strRep, len);
5150 switch (quotingType[i]) {
5151 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5152 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5153 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5154 }
5155 bufLen++; /* elements separator. */
5156 }
5157 bufLen++;
5158
5159 /* Generate the string rep. */
5160 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5161 realLength = 0;
5162 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5163 int len, qlen;
5164 const char *strRep = Jim_GetString(ele[i], &len);
5165 char *q;
5166
5167 switch (quotingType[i]) {
5168 case JIM_ELESTR_SIMPLE:
5169 memcpy(p, strRep, len);
5170 p += len;
5171 realLength += len;
5172 break;
5173 case JIM_ELESTR_BRACE:
5174 *p++ = '{';
5175 memcpy(p, strRep, len);
5176 p += len;
5177 *p++ = '}';
5178 realLength += len + 2;
5179 break;
5180 case JIM_ELESTR_QUOTE:
5181 q = BackslashQuoteString(strRep, len, &qlen);
5182 memcpy(p, q, qlen);
5183 Jim_Free(q);
5184 p += qlen;
5185 realLength += qlen;
5186 break;
5187 }
5188 /* Add a separating space */
5189 if (i + 1 != objPtr->internalRep.listValue.len) {
5190 *p++ = ' ';
5191 realLength ++;
5192 }
5193 }
5194 *p = '\0'; /* nul term. */
5195 objPtr->length = realLength;
5196 Jim_Free(quotingType);
5197 }
5198
5199 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5200 {
5201 struct JimParserCtx parser;
5202 const char *str;
5203 int strLen;
5204
5205 /* Get the string representation */
5206 str = Jim_GetString(objPtr, &strLen);
5207
5208 /* Free the old internal repr just now and initialize the
5209 * new one just now. The string->list conversion can't fail. */
5210 Jim_FreeIntRep(interp, objPtr);
5211 objPtr->typePtr = &listObjType;
5212 objPtr->internalRep.listValue.len = 0;
5213 objPtr->internalRep.listValue.maxLen = 0;
5214 objPtr->internalRep.listValue.ele = NULL;
5215
5216 /* Convert into a list */
5217 JimParserInit(&parser, str, strLen, 1);
5218 while (!JimParserEof(&parser)) {
5219 char *token;
5220 int tokenLen, type;
5221 Jim_Obj *elementPtr;
5222
5223 JimParseList(&parser);
5224 if (JimParserTtype(&parser) != JIM_TT_STR &&
5225 JimParserTtype(&parser) != JIM_TT_ESC)
5226 continue;
5227 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5228 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5229 ListAppendElement(objPtr, elementPtr);
5230 }
5231 return JIM_OK;
5232 }
5233
5234 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5235 int len)
5236 {
5237 Jim_Obj *objPtr;
5238 int i;
5239
5240 objPtr = Jim_NewObj(interp);
5241 objPtr->typePtr = &listObjType;
5242 objPtr->bytes = NULL;
5243 objPtr->internalRep.listValue.ele = NULL;
5244 objPtr->internalRep.listValue.len = 0;
5245 objPtr->internalRep.listValue.maxLen = 0;
5246 for (i = 0; i < len; i++) {
5247 ListAppendElement(objPtr, elements[i]);
5248 }
5249 return objPtr;
5250 }
5251
5252 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5253 * length of the vector. Note that the user of this function should make
5254 * sure that the list object can't shimmer while the vector returned
5255 * is in use, this vector is the one stored inside the internal representation
5256 * of the list object. This function is not exported, extensions should
5257 * always access to the List object elements using Jim_ListIndex(). */
5258 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5259 Jim_Obj ***listVec)
5260 {
5261 Jim_ListLength(interp, listObj, argc);
5262 assert(listObj->typePtr == &listObjType);
5263 *listVec = listObj->internalRep.listValue.ele;
5264 }
5265
5266 /* ListSortElements type values */
5267 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5268 JIM_LSORT_NOCASE_DECR};
5269
5270 /* Sort the internal rep of a list. */
5271 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5272 {
5273 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5274 }
5275
5276 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5277 {
5278 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5279 }
5280
5281 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5282 {
5283 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5284 }
5285
5286 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5287 {
5288 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5289 }
5290
5291 /* Sort a list *in place*. MUST be called with non-shared objects. */
5292 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5293 {
5294 typedef int (qsort_comparator)(const void *, const void *);
5295 int (*fn)(Jim_Obj**, Jim_Obj**);
5296 Jim_Obj **vector;
5297 int len;
5298
5299 if (Jim_IsShared(listObjPtr))
5300 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5301 if (listObjPtr->typePtr != &listObjType)
5302 SetListFromAny(interp, listObjPtr);
5303
5304 vector = listObjPtr->internalRep.listValue.ele;
5305 len = listObjPtr->internalRep.listValue.len;
5306 switch (type) {
5307 case JIM_LSORT_ASCII: fn = ListSortString; break;
5308 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5309 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5310 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5311 default:
5312 fn = NULL; /* avoid warning */
5313 Jim_Panic(interp,"ListSort called with invalid sort type");
5314 }
5315 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5316 Jim_InvalidateStringRep(listObjPtr);
5317 }
5318
5319 /* This is the low-level function to append an element to a list.
5320 * The higher-level Jim_ListAppendElement() performs shared object
5321 * check and invalidate the string repr. This version is used
5322 * in the internals of the List Object and is not exported.
5323 *
5324 * NOTE: this function can be called only against objects
5325 * with internal type of List. */
5326 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5327 {
5328 int requiredLen = listPtr->internalRep.listValue.len + 1;
5329
5330 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5331 int maxLen = requiredLen * 2;
5332
5333 listPtr->internalRep.listValue.ele =
5334 Jim_Realloc(listPtr->internalRep.listValue.ele,
5335 sizeof(Jim_Obj*)*maxLen);
5336 listPtr->internalRep.listValue.maxLen = maxLen;
5337 }
5338 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5339 objPtr;
5340 listPtr->internalRep.listValue.len ++;
5341 Jim_IncrRefCount(objPtr);
5342 }
5343
5344 /* This is the low-level function to insert elements into a list.
5345 * The higher-level Jim_ListInsertElements() performs shared object
5346 * check and invalidate the string repr. This version is used
5347 * in the internals of the List Object and is not exported.
5348 *
5349 * NOTE: this function can be called only against objects
5350 * with internal type of List. */
5351 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5352 Jim_Obj *const *elemVec)
5353 {
5354 int currentLen = listPtr->internalRep.listValue.len;
5355 int requiredLen = currentLen + elemc;
5356 int i;
5357 Jim_Obj **point;
5358
5359 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5360 int maxLen = requiredLen * 2;
5361
5362 listPtr->internalRep.listValue.ele =
5363 Jim_Realloc(listPtr->internalRep.listValue.ele,
5364 sizeof(Jim_Obj*)*maxLen);
5365 listPtr->internalRep.listValue.maxLen = maxLen;
5366 }
5367 point = listPtr->internalRep.listValue.ele + index;
5368 memmove(point + elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5369 for (i = 0; i < elemc; ++i) {
5370 point[i] = elemVec[i];
5371 Jim_IncrRefCount(point[i]);
5372 }
5373 listPtr->internalRep.listValue.len += elemc;
5374 }
5375
5376 /* Appends every element of appendListPtr into listPtr.
5377 * Both have to be of the list type. */
5378 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5379 {
5380 int i, oldLen = listPtr->internalRep.listValue.len;
5381 int appendLen = appendListPtr->internalRep.listValue.len;
5382 int requiredLen = oldLen + appendLen;
5383
5384 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5385 int maxLen = requiredLen * 2;
5386
5387 listPtr->internalRep.listValue.ele =
5388 Jim_Realloc(listPtr->internalRep.listValue.ele,
5389 sizeof(Jim_Obj*)*maxLen);
5390 listPtr->internalRep.listValue.maxLen = maxLen;
5391 }
5392 for (i = 0; i < appendLen; i++) {
5393 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5394 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5395 Jim_IncrRefCount(objPtr);
5396 }
5397 listPtr->internalRep.listValue.len += appendLen;
5398 }
5399
5400 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5401 {
5402 if (Jim_IsShared(listPtr))
5403 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5404 if (listPtr->typePtr != &listObjType)
5405 SetListFromAny(interp, listPtr);
5406 Jim_InvalidateStringRep(listPtr);
5407 ListAppendElement(listPtr, objPtr);
5408 }
5409
5410 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5411 {
5412 if (Jim_IsShared(listPtr))
5413 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5414 if (listPtr->typePtr != &listObjType)
5415 SetListFromAny(interp, listPtr);
5416 Jim_InvalidateStringRep(listPtr);
5417 ListAppendList(listPtr, appendListPtr);
5418 }
5419
5420 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5421 {
5422 if (listPtr->typePtr != &listObjType)
5423 SetListFromAny(interp, listPtr);
5424 *intPtr = listPtr->internalRep.listValue.len;
5425 }
5426
5427 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5428 int objc, Jim_Obj *const *objVec)
5429 {
5430 if (Jim_IsShared(listPtr))
5431 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5432 if (listPtr->typePtr != &listObjType)
5433 SetListFromAny(interp, listPtr);
5434 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5435 index = listPtr->internalRep.listValue.len;
5436 else if (index < 0 )
5437 index = 0;
5438 Jim_InvalidateStringRep(listPtr);
5439 ListInsertElements(listPtr, index, objc, objVec);
5440 }
5441
5442 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5443 Jim_Obj **objPtrPtr, int flags)
5444 {
5445 if (listPtr->typePtr != &listObjType)
5446 SetListFromAny(interp, listPtr);
5447 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5448 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5449 if (flags & JIM_ERRMSG) {
5450 Jim_SetResultString(interp,
5451 "list index out of range", -1);
5452 }
5453 return JIM_ERR;
5454 }
5455 if (index < 0)
5456 index = listPtr->internalRep.listValue.len + index;
5457 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5458 return JIM_OK;
5459 }
5460
5461 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5462 Jim_Obj *newObjPtr, int flags)
5463 {
5464 if (listPtr->typePtr != &listObjType)
5465 SetListFromAny(interp, listPtr);
5466 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5467 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5468 if (flags & JIM_ERRMSG) {
5469 Jim_SetResultString(interp,
5470 "list index out of range", -1);
5471 }
5472 return JIM_ERR;
5473 }
5474 if (index < 0)
5475 index = listPtr->internalRep.listValue.len + index;
5476 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5477 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5478 Jim_IncrRefCount(newObjPtr);
5479 return JIM_OK;
5480 }
5481
5482 /* Modify the list stored into the variable named 'varNamePtr'
5483 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5484 * with the new element 'newObjptr'. */
5485 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5486 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5487 {
5488 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5489 int shared, i, index;
5490
5491 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5492 if (objPtr == NULL)
5493 return JIM_ERR;
5494 if ((shared = Jim_IsShared(objPtr)))
5495 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5496 for (i = 0; i < indexc-1; i++) {
5497 listObjPtr = objPtr;
5498 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5499 goto err;
5500 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5501 JIM_ERRMSG) != JIM_OK) {
5502 goto err;
5503 }
5504 if (Jim_IsShared(objPtr)) {
5505 objPtr = Jim_DuplicateObj(interp, objPtr);
5506 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5507 }
5508 Jim_InvalidateStringRep(listObjPtr);
5509 }
5510 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5511 goto err;
5512 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5513 goto err;
5514 Jim_InvalidateStringRep(objPtr);
5515 Jim_InvalidateStringRep(varObjPtr);
5516 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5517 goto err;
5518 Jim_SetResult(interp, varObjPtr);
5519 return JIM_OK;
5520 err:
5521 if (shared) {
5522 Jim_FreeNewObj(interp, varObjPtr);
5523 }
5524 return JIM_ERR;
5525 }
5526
5527 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5528 {
5529 int i;
5530
5531 /* If all the objects in objv are lists without string rep.
5532 * it's possible to return a list as result, that's the
5533 * concatenation of all the lists. */
5534 for (i = 0; i < objc; i++) {
5535 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5536 break;
5537 }
5538 if (i == objc) {
5539 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5540 for (i = 0; i < objc; i++)
5541 Jim_ListAppendList(interp, objPtr, objv[i]);
5542 return objPtr;
5543 } else {
5544 /* Else... we have to glue strings together */
5545 int len = 0, objLen;
5546 char *bytes, *p;
5547
5548 /* Compute the length */
5549 for (i = 0; i < objc; i++) {
5550 Jim_GetString(objv[i], &objLen);
5551 len += objLen;
5552 }
5553 if (objc) len += objc-1;
5554 /* Create the string rep, and a stinrg object holding it. */
5555 p = bytes = Jim_Alloc(len + 1);
5556 for (i = 0; i < objc; i++) {
5557 const char *s = Jim_GetString(objv[i], &objLen);
5558 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5559 {
5560 s++; objLen--; len--;
5561 }
5562 while (objLen && (s[objLen-1] == ' ' ||
5563 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5564 objLen--; len--;
5565 }
5566 memcpy(p, s, objLen);
5567 p += objLen;
5568 if (objLen && i + 1 != objc) {
5569 *p++ = ' ';
5570 } else if (i + 1 != objc) {
5571 /* Drop the space calcuated for this
5572 * element that is instead null. */
5573 len--;
5574 }
5575 }
5576 *p = '\0';
5577 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5578 }
5579 }
5580
5581 /* Returns a list composed of the elements in the specified range.
5582 * first and start are directly accepted as Jim_Objects and
5583 * processed for the end?-index? case. */
5584 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5585 {
5586 int first, last;
5587 int len, rangeLen;
5588
5589 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5590 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5591 return NULL;
5592 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5593 first = JimRelToAbsIndex(len, first);
5594 last = JimRelToAbsIndex(len, last);
5595 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5596 return Jim_NewListObj(interp,
5597 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5598 }
5599
5600 /* -----------------------------------------------------------------------------
5601 * Dict object
5602 * ---------------------------------------------------------------------------*/
5603 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5604 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5605 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5606 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5607
5608 /* Dict HashTable Type.
5609 *
5610 * Keys and Values are Jim objects. */
5611
5612 unsigned int JimObjectHTHashFunction(const void *key)
5613 {
5614 const char *str;
5615 Jim_Obj *objPtr = (Jim_Obj*) key;
5616 int len, h;
5617
5618 str = Jim_GetString(objPtr, &len);
5619 h = Jim_GenHashFunction((unsigned char*)str, len);
5620 return h;
5621 }
5622
5623 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5624 {
5625 JIM_NOTUSED(privdata);
5626
5627 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5628 }
5629
5630 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5631 {
5632 Jim_Obj *objPtr = val;
5633
5634 Jim_DecrRefCount(interp, objPtr);
5635 }
5636
5637 static Jim_HashTableType JimDictHashTableType = {
5638 JimObjectHTHashFunction, /* hash function */
5639 NULL, /* key dup */
5640 NULL, /* val dup */
5641 JimObjectHTKeyCompare, /* key compare */
5642 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5643 JimObjectHTKeyValDestructor, /* key destructor */
5644 JimObjectHTKeyValDestructor /* val destructor */
5645 };
5646
5647 /* Note that while the elements of the dict may contain references,
5648 * the list object itself can't. This basically means that the
5649 * dict object string representation as a whole can't contain references
5650 * that are not presents in the single elements. */
5651 static Jim_ObjType dictObjType = {
5652 "dict",
5653 FreeDictInternalRep,
5654 DupDictInternalRep,
5655 UpdateStringOfDict,
5656 JIM_TYPE_NONE,
5657 };
5658
5659 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5660 {
5661 JIM_NOTUSED(interp);
5662
5663 Jim_FreeHashTable(objPtr->internalRep.ptr);
5664 Jim_Free(objPtr->internalRep.ptr);
5665 }
5666
5667 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5668 {
5669 Jim_HashTable *ht, *dupHt;
5670 Jim_HashTableIterator *htiter;
5671 Jim_HashEntry *he;
5672
5673 /* Create a new hash table */
5674 ht = srcPtr->internalRep.ptr;
5675 dupHt = Jim_Alloc(sizeof(*dupHt));
5676 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5677 if (ht->size != 0)
5678 Jim_ExpandHashTable(dupHt, ht->size);
5679 /* Copy every element from the source to the dup hash table */
5680 htiter = Jim_GetHashTableIterator(ht);
5681 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5682 const Jim_Obj *keyObjPtr = he->key;
5683 Jim_Obj *valObjPtr = he->val;
5684
5685 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5686 Jim_IncrRefCount(valObjPtr);
5687 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5688 }
5689 Jim_FreeHashTableIterator(htiter);
5690
5691 dupPtr->internalRep.ptr = dupHt;
5692 dupPtr->typePtr = &dictObjType;
5693 }
5694
5695 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5696 {
5697 int i, bufLen, realLength;
5698 const char *strRep;
5699 char *p;
5700 int *quotingType, objc;
5701 Jim_HashTable *ht;
5702 Jim_HashTableIterator *htiter;
5703 Jim_HashEntry *he;
5704 Jim_Obj **objv;
5705
5706 /* Trun the hash table into a flat vector of Jim_Objects. */
5707 ht = objPtr->internalRep.ptr;
5708 objc = ht->used*2;
5709 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5710 htiter = Jim_GetHashTableIterator(ht);
5711 i = 0;
5712 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5713 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5714 objv[i++] = he->val;
5715 }
5716 Jim_FreeHashTableIterator(htiter);
5717 /* (Over) Estimate the space needed. */
5718 quotingType = Jim_Alloc(sizeof(int)*objc);
5719 bufLen = 0;
5720 for (i = 0; i < objc; i++) {
5721 int len;
5722
5723 strRep = Jim_GetString(objv[i], &len);
5724 quotingType[i] = ListElementQuotingType(strRep, len);
5725 switch (quotingType[i]) {
5726 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5727 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5728 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5729 }
5730 bufLen++; /* elements separator. */
5731 }
5732 bufLen++;
5733
5734 /* Generate the string rep. */
5735 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5736 realLength = 0;
5737 for (i = 0; i < objc; i++) {
5738 int len, qlen;
5739 const char *strRep = Jim_GetString(objv[i], &len);
5740 char *q;
5741
5742 switch (quotingType[i]) {
5743 case JIM_ELESTR_SIMPLE:
5744 memcpy(p, strRep, len);
5745 p += len;
5746 realLength += len;
5747 break;
5748 case JIM_ELESTR_BRACE:
5749 *p++ = '{';
5750 memcpy(p, strRep, len);
5751 p += len;
5752 *p++ = '}';
5753 realLength += len + 2;
5754 break;
5755 case JIM_ELESTR_QUOTE:
5756 q = BackslashQuoteString(strRep, len, &qlen);
5757 memcpy(p, q, qlen);
5758 Jim_Free(q);
5759 p += qlen;
5760 realLength += qlen;
5761 break;
5762 }
5763 /* Add a separating space */
5764 if (i + 1 != objc) {
5765 *p++ = ' ';
5766 realLength ++;
5767 }
5768 }
5769 *p = '\0'; /* nul term. */
5770 objPtr->length = realLength;
5771 Jim_Free(quotingType);
5772 Jim_Free(objv);
5773 }
5774
5775 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5776 {
5777 struct JimParserCtx parser;
5778 Jim_HashTable *ht;
5779 Jim_Obj *objv[2];
5780 const char *str;
5781 int i, strLen;
5782
5783 /* Get the string representation */
5784 str = Jim_GetString(objPtr, &strLen);
5785
5786 /* Free the old internal repr just now and initialize the
5787 * new one just now. The string->list conversion can't fail. */
5788 Jim_FreeIntRep(interp, objPtr);
5789 ht = Jim_Alloc(sizeof(*ht));
5790 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5791 objPtr->typePtr = &dictObjType;
5792 objPtr->internalRep.ptr = ht;
5793
5794 /* Convert into a dict */
5795 JimParserInit(&parser, str, strLen, 1);
5796 i = 0;
5797 while (!JimParserEof(&parser)) {
5798 char *token;
5799 int tokenLen, type;
5800
5801 JimParseList(&parser);
5802 if (JimParserTtype(&parser) != JIM_TT_STR &&
5803 JimParserTtype(&parser) != JIM_TT_ESC)
5804 continue;
5805 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5806 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5807 if (i == 2) {
5808 i = 0;
5809 Jim_IncrRefCount(objv[0]);
5810 Jim_IncrRefCount(objv[1]);
5811 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5812 Jim_HashEntry *he;
5813 he = Jim_FindHashEntry(ht, objv[0]);
5814 Jim_DecrRefCount(interp, objv[0]);
5815 /* ATTENTION: const cast */
5816 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5817 he->val = objv[1];
5818 }
5819 }
5820 }
5821 if (i) {
5822 Jim_FreeNewObj(interp, objv[0]);
5823 objPtr->typePtr = NULL;
5824 Jim_FreeHashTable(ht);
5825 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5826 return JIM_ERR;
5827 }
5828 return JIM_OK;
5829 }
5830
5831 /* Dict object API */
5832
5833 /* Add an element to a dict. objPtr must be of the "dict" type.
5834 * The higer-level exported function is Jim_DictAddElement().
5835 * If an element with the specified key already exists, the value
5836 * associated is replaced with the new one.
5837 *
5838 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5839 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5840 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5841 {
5842 Jim_HashTable *ht = objPtr->internalRep.ptr;
5843
5844 if (valueObjPtr == NULL) { /* unset */
5845 Jim_DeleteHashEntry(ht, keyObjPtr);
5846 return;
5847 }
5848 Jim_IncrRefCount(keyObjPtr);
5849 Jim_IncrRefCount(valueObjPtr);
5850 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5851 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5852 Jim_DecrRefCount(interp, keyObjPtr);
5853 /* ATTENTION: const cast */
5854 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5855 he->val = valueObjPtr;
5856 }
5857 }
5858
5859 /* Add an element, higher-level interface for DictAddElement().
5860 * If valueObjPtr == NULL, the key is removed if it exists. */
5861 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5862 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5863 {
5864 if (Jim_IsShared(objPtr))
5865 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5866 if (objPtr->typePtr != &dictObjType) {
5867 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5868 return JIM_ERR;
5869 }
5870 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5871 Jim_InvalidateStringRep(objPtr);
5872 return JIM_OK;
5873 }
5874
5875 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5876 {
5877 Jim_Obj *objPtr;
5878 int i;
5879
5880 if (len % 2)
5881 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5882
5883 objPtr = Jim_NewObj(interp);
5884 objPtr->typePtr = &dictObjType;
5885 objPtr->bytes = NULL;
5886 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5887 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5888 for (i = 0; i < len; i += 2)
5889 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5890 return objPtr;
5891 }
5892
5893 /* Return the value associated to the specified dict key */
5894 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5895 Jim_Obj **objPtrPtr, int flags)
5896 {
5897 Jim_HashEntry *he;
5898 Jim_HashTable *ht;
5899
5900 if (dictPtr->typePtr != &dictObjType) {
5901 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5902 return JIM_ERR;
5903 }
5904 ht = dictPtr->internalRep.ptr;
5905 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5906 if (flags & JIM_ERRMSG) {
5907 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5908 Jim_AppendStrings(interp, Jim_GetResult(interp),
5909 "key \"", Jim_GetString(keyPtr, NULL),
5910 "\" not found in dictionary", NULL);
5911 }
5912 return JIM_ERR;
5913 }
5914 *objPtrPtr = he->val;
5915 return JIM_OK;
5916 }
5917
5918 /* Return the value associated to the specified dict keys */
5919 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5920 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5921 {
5922 Jim_Obj *objPtr = NULL;
5923 int i;
5924
5925 if (keyc == 0) {
5926 *objPtrPtr = dictPtr;
5927 return JIM_OK;
5928 }
5929
5930 for (i = 0; i < keyc; i++) {
5931 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5932 != JIM_OK)
5933 return JIM_ERR;
5934 dictPtr = objPtr;
5935 }
5936 *objPtrPtr = objPtr;
5937 return JIM_OK;
5938 }
5939
5940 /* Modify the dict stored into the variable named 'varNamePtr'
5941 * setting the element specified by the 'keyc' keys objects in 'keyv',
5942 * with the new value of the element 'newObjPtr'.
5943 *
5944 * If newObjPtr == NULL the operation is to remove the given key
5945 * from the dictionary. */
5946 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5947 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5948 {
5949 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5950 int shared, i;
5951
5952 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5953 if (objPtr == NULL) {
5954 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5955 return JIM_ERR;
5956 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5957 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5958 Jim_FreeNewObj(interp, varObjPtr);
5959 return JIM_ERR;
5960 }
5961 }
5962 if ((shared = Jim_IsShared(objPtr)))
5963 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5964 for (i = 0; i < keyc-1; i++) {
5965 dictObjPtr = objPtr;
5966
5967 /* Check if it's a valid dictionary */
5968 if (dictObjPtr->typePtr != &dictObjType) {
5969 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5970 goto err;
5971 }
5972 /* Check if the given key exists. */
5973 Jim_InvalidateStringRep(dictObjPtr);
5974 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5975 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5976 {
5977 /* This key exists at the current level.
5978 * Make sure it's not shared!. */
5979 if (Jim_IsShared(objPtr)) {
5980 objPtr = Jim_DuplicateObj(interp, objPtr);
5981 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5982 }
5983 } else {
5984 /* Key not found. If it's an [unset] operation
5985 * this is an error. Only the last key may not
5986 * exist. */
5987 if (newObjPtr == NULL)
5988 goto err;
5989 /* Otherwise set an empty dictionary
5990 * as key's value. */
5991 objPtr = Jim_NewDictObj(interp, NULL, 0);
5992 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5993 }
5994 }
5995 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5996 != JIM_OK)
5997 goto err;
5998 Jim_InvalidateStringRep(objPtr);
5999 Jim_InvalidateStringRep(varObjPtr);
6000 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6001 goto err;
6002 Jim_SetResult(interp, varObjPtr);
6003 return JIM_OK;
6004 err:
6005 if (shared) {
6006 Jim_FreeNewObj(interp, varObjPtr);
6007 }
6008 return JIM_ERR;
6009 }
6010
6011 /* -----------------------------------------------------------------------------
6012 * Index object
6013 * ---------------------------------------------------------------------------*/
6014 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6015 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6016
6017 static Jim_ObjType indexObjType = {
6018 "index",
6019 NULL,
6020 NULL,
6021 UpdateStringOfIndex,
6022 JIM_TYPE_NONE,
6023 };
6024
6025 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6026 {
6027 int len;
6028 char buf[JIM_INTEGER_SPACE + 1];
6029
6030 if (objPtr->internalRep.indexValue >= 0)
6031 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6032 else if (objPtr->internalRep.indexValue == -1)
6033 len = sprintf(buf, "end");
6034 else {
6035 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6036 }
6037 objPtr->bytes = Jim_Alloc(len + 1);
6038 memcpy(objPtr->bytes, buf, len + 1);
6039 objPtr->length = len;
6040 }
6041
6042 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6043 {
6044 int index, end = 0;
6045 const char *str;
6046
6047 /* Get the string representation */
6048 str = Jim_GetString(objPtr, NULL);
6049 /* Try to convert into an index */
6050 if (!strcmp(str, "end")) {
6051 index = 0;
6052 end = 1;
6053 } else {
6054 if (!strncmp(str, "end-", 4)) {
6055 str += 4;
6056 end = 1;
6057 }
6058 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6059 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6060 Jim_AppendStrings(interp, Jim_GetResult(interp),
6061 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6062 "must be integer or end?-integer?", NULL);
6063 return JIM_ERR;
6064 }
6065 }
6066 if (end) {
6067 if (index < 0)
6068 index = INT_MAX;
6069 else
6070 index = -(index + 1);
6071 } else if (!end && index < 0)
6072 index = -INT_MAX;
6073 /* Free the old internal repr and set the new one. */
6074 Jim_FreeIntRep(interp, objPtr);
6075 objPtr->typePtr = &indexObjType;
6076 objPtr->internalRep.indexValue = index;
6077 return JIM_OK;
6078 }
6079
6080 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6081 {
6082 /* Avoid shimmering if the object is an integer. */
6083 if (objPtr->typePtr == &intObjType) {
6084 jim_wide val = objPtr->internalRep.wideValue;
6085 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6086 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6087 return JIM_OK;
6088 }
6089 }
6090 if (objPtr->typePtr != &indexObjType &&
6091 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6092 return JIM_ERR;
6093 *indexPtr = objPtr->internalRep.indexValue;
6094 return JIM_OK;
6095 }
6096
6097 /* -----------------------------------------------------------------------------
6098 * Return Code Object.
6099 * ---------------------------------------------------------------------------*/
6100
6101 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6102
6103 static Jim_ObjType returnCodeObjType = {
6104 "return-code",
6105 NULL,
6106 NULL,
6107 NULL,
6108 JIM_TYPE_NONE,
6109 };
6110
6111 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6112 {
6113 const char *str;
6114 int strLen, returnCode;
6115 jim_wide wideValue;
6116
6117 /* Get the string representation */
6118 str = Jim_GetString(objPtr, &strLen);
6119 /* Try to convert into an integer */
6120 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6121 returnCode = (int) wideValue;
6122 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6123 returnCode = JIM_OK;
6124 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6125 returnCode = JIM_ERR;
6126 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6127 returnCode = JIM_RETURN;
6128 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6129 returnCode = JIM_BREAK;
6130 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6131 returnCode = JIM_CONTINUE;
6132 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6133 returnCode = JIM_EVAL;
6134 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6135 returnCode = JIM_EXIT;
6136 else {
6137 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6138 Jim_AppendStrings(interp, Jim_GetResult(interp),
6139 "expected return code but got '", str, "'",
6140 NULL);
6141 return JIM_ERR;
6142 }
6143 /* Free the old internal repr and set the new one. */
6144 Jim_FreeIntRep(interp, objPtr);
6145 objPtr->typePtr = &returnCodeObjType;
6146 objPtr->internalRep.returnCode = returnCode;
6147 return JIM_OK;
6148 }
6149
6150 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6151 {
6152 if (objPtr->typePtr != &returnCodeObjType &&
6153 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6154 return JIM_ERR;
6155 *intPtr = objPtr->internalRep.returnCode;
6156 return JIM_OK;
6157 }
6158
6159 /* -----------------------------------------------------------------------------
6160 * Expression Parsing
6161 * ---------------------------------------------------------------------------*/
6162 static int JimParseExprOperator(struct JimParserCtx *pc);
6163 static int JimParseExprNumber(struct JimParserCtx *pc);
6164 static int JimParseExprIrrational(struct JimParserCtx *pc);
6165
6166 /* Exrp's Stack machine operators opcodes. */
6167
6168 /* Binary operators (numbers) */
6169 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6170 #define JIM_EXPROP_MUL 0
6171 #define JIM_EXPROP_DIV 1
6172 #define JIM_EXPROP_MOD 2
6173 #define JIM_EXPROP_SUB 3
6174 #define JIM_EXPROP_ADD 4
6175 #define JIM_EXPROP_LSHIFT 5
6176 #define JIM_EXPROP_RSHIFT 6
6177 #define JIM_EXPROP_ROTL 7
6178 #define JIM_EXPROP_ROTR 8
6179 #define JIM_EXPROP_LT 9
6180 #define JIM_EXPROP_GT 10
6181 #define JIM_EXPROP_LTE 11
6182 #define JIM_EXPROP_GTE 12
6183 #define JIM_EXPROP_NUMEQ 13
6184 #define JIM_EXPROP_NUMNE 14
6185 #define JIM_EXPROP_BITAND 15
6186 #define JIM_EXPROP_BITXOR 16
6187 #define JIM_EXPROP_BITOR 17
6188 #define JIM_EXPROP_LOGICAND 18
6189 #define JIM_EXPROP_LOGICOR 19
6190 #define JIM_EXPROP_LOGICAND_LEFT 20
6191 #define JIM_EXPROP_LOGICOR_LEFT 21
6192 #define JIM_EXPROP_POW 22
6193 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6194
6195 /* Binary operators (strings) */
6196 #define JIM_EXPROP_STREQ 23
6197 #define JIM_EXPROP_STRNE 24
6198
6199 /* Unary operators (numbers) */
6200 #define JIM_EXPROP_NOT 25
6201 #define JIM_EXPROP_BITNOT 26
6202 #define JIM_EXPROP_UNARYMINUS 27
6203 #define JIM_EXPROP_UNARYPLUS 28
6204 #define JIM_EXPROP_LOGICAND_RIGHT 29
6205 #define JIM_EXPROP_LOGICOR_RIGHT 30
6206
6207 /* Ternary operators */
6208 #define JIM_EXPROP_TERNARY 31
6209
6210 /* Operands */
6211 #define JIM_EXPROP_NUMBER 32
6212 #define JIM_EXPROP_COMMAND 33
6213 #define JIM_EXPROP_VARIABLE 34
6214 #define JIM_EXPROP_DICTSUGAR 35
6215 #define JIM_EXPROP_SUBST 36
6216 #define JIM_EXPROP_STRING 37
6217
6218 /* Operators table */
6219 typedef struct Jim_ExprOperator {
6220 const char *name;
6221 int precedence;
6222 int arity;
6223 int opcode;
6224 } Jim_ExprOperator;
6225
6226 /* name - precedence - arity - opcode */
6227 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6228 {"!", 300, 1, JIM_EXPROP_NOT},
6229 {"~", 300, 1, JIM_EXPROP_BITNOT},
6230 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6231 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6232
6233 {"**", 250, 2, JIM_EXPROP_POW},
6234
6235 {"*", 200, 2, JIM_EXPROP_MUL},
6236 {"/", 200, 2, JIM_EXPROP_DIV},
6237 {"%", 200, 2, JIM_EXPROP_MOD},
6238
6239 {"-", 100, 2, JIM_EXPROP_SUB},
6240 {"+", 100, 2, JIM_EXPROP_ADD},
6241
6242 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6243 {">>>", 90, 3, JIM_EXPROP_ROTR},
6244 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6245 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6246
6247 {"<", 80, 2, JIM_EXPROP_LT},
6248 {">", 80, 2, JIM_EXPROP_GT},
6249 {"<=", 80, 2, JIM_EXPROP_LTE},
6250 {">=", 80, 2, JIM_EXPROP_GTE},
6251
6252 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6253 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6254
6255 {"eq", 60, 2, JIM_EXPROP_STREQ},
6256 {"ne", 60, 2, JIM_EXPROP_STRNE},
6257
6258 {"&", 50, 2, JIM_EXPROP_BITAND},
6259 {"^", 49, 2, JIM_EXPROP_BITXOR},
6260 {"|", 48, 2, JIM_EXPROP_BITOR},
6261
6262 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6263 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6264
6265 {"?", 5, 3, JIM_EXPROP_TERNARY},
6266 /* private operators */
6267 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6268 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6269 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6270 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6271 };
6272
6273 #define JIM_EXPR_OPERATORS_NUM \
6274 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6275
6276 int JimParseExpression(struct JimParserCtx *pc)
6277 {
6278 /* Discard spaces and quoted newline */
6279 while (*(pc->p) == ' ' ||
6280 *(pc->p) == '\t' ||
6281 *(pc->p) == '\r' ||
6282 *(pc->p) == '\n' ||
6283 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6284 pc->p++; pc->len--;
6285 }
6286
6287 if (pc->len == 0) {
6288 pc->tstart = pc->tend = pc->p;
6289 pc->tline = pc->linenr;
6290 pc->tt = JIM_TT_EOL;
6291 pc->eof = 1;
6292 return JIM_OK;
6293 }
6294 switch (*(pc->p)) {
6295 case '(':
6296 pc->tstart = pc->tend = pc->p;
6297 pc->tline = pc->linenr;
6298 pc->tt = JIM_TT_SUBEXPR_START;
6299 pc->p++; pc->len--;
6300 break;
6301 case ')':
6302 pc->tstart = pc->tend = pc->p;
6303 pc->tline = pc->linenr;
6304 pc->tt = JIM_TT_SUBEXPR_END;
6305 pc->p++; pc->len--;
6306 break;
6307 case '[':
6308 return JimParseCmd(pc);
6309 break;
6310 case '$':
6311 if (JimParseVar(pc) == JIM_ERR)
6312 return JimParseExprOperator(pc);
6313 else
6314 return JIM_OK;
6315 break;
6316 case '-':
6317 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6318 isdigit((int)*(pc->p + 1)))
6319 return JimParseExprNumber(pc);
6320 else
6321 return JimParseExprOperator(pc);
6322 break;
6323 case '0': case '1': case '2': case '3': case '4':
6324 case '5': case '6': case '7': case '8': case '9': case '.':
6325 return JimParseExprNumber(pc);
6326 break;
6327 case '"':
6328 case '{':
6329 /* Here it's possible to reuse the List String parsing. */
6330 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6331 return JimParseListStr(pc);
6332 break;
6333 case 'N': case 'I':
6334 case 'n': case 'i':
6335 if (JimParseExprIrrational(pc) == JIM_ERR)
6336 return JimParseExprOperator(pc);
6337 break;
6338 default:
6339 return JimParseExprOperator(pc);
6340 break;
6341 }
6342 return JIM_OK;
6343 }
6344
6345 int JimParseExprNumber(struct JimParserCtx *pc)
6346 {
6347 int allowdot = 1;
6348 int allowhex = 0;
6349
6350 pc->tstart = pc->p;
6351 pc->tline = pc->linenr;
6352 if (*pc->p == '-') {
6353 pc->p++; pc->len--;
6354 }
6355 while (isdigit((int)*pc->p)
6356 || (allowhex && isxdigit((int)*pc->p) )
6357 || (allowdot && *pc->p == '.')
6358 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6359 (*pc->p == 'x' || *pc->p == 'X'))
6360 )
6361 {
6362 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6363 allowhex = 1;
6364 allowdot = 0;
6365 }
6366 if (*pc->p == '.')
6367 allowdot = 0;
6368 pc->p++; pc->len--;
6369 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6370 pc->p += 2; pc->len -= 2;
6371 }
6372 }
6373 pc->tend = pc->p-1;
6374 pc->tt = JIM_TT_EXPR_NUMBER;
6375 return JIM_OK;
6376 }
6377
6378 int JimParseExprIrrational(struct JimParserCtx *pc)
6379 {
6380 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6381 const char **token;
6382 for (token = Tokens; *token != NULL; token++) {
6383 int len = strlen(*token);
6384 if (strncmp(*token, pc->p, len) == 0) {
6385 pc->tstart = pc->p;
6386 pc->tend = pc->p + len - 1;
6387 pc->p += len; pc->len -= len;
6388 pc->tline = pc->linenr;
6389 pc->tt = JIM_TT_EXPR_NUMBER;
6390 return JIM_OK;
6391 }
6392 }
6393 return JIM_ERR;
6394 }
6395
6396 int JimParseExprOperator(struct JimParserCtx *pc)
6397 {
6398 int i;
6399 int bestIdx = -1, bestLen = 0;
6400
6401 /* Try to get the longest match. */
6402 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6403 const char *opname;
6404 int oplen;
6405
6406 opname = Jim_ExprOperators[i].name;
6407 if (opname == NULL) continue;
6408 oplen = strlen(opname);
6409
6410 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6411 bestIdx = i;
6412 bestLen = oplen;
6413 }
6414 }
6415 if (bestIdx == -1) return JIM_ERR;
6416 pc->tstart = pc->p;
6417 pc->tend = pc->p + bestLen - 1;
6418 pc->p += bestLen; pc->len -= bestLen;
6419 pc->tline = pc->linenr;
6420 pc->tt = JIM_TT_EXPR_OPERATOR;
6421 return JIM_OK;
6422 }
6423
6424 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6425 {
6426 int i;
6427 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6428 if (Jim_ExprOperators[i].name &&
6429 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6430 return &Jim_ExprOperators[i];
6431 return NULL;
6432 }
6433
6434 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6435 {
6436 int i;
6437 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6438 if (Jim_ExprOperators[i].opcode == opcode)
6439 return &Jim_ExprOperators[i];
6440 return NULL;
6441 }
6442
6443 /* -----------------------------------------------------------------------------
6444 * Expression Object
6445 * ---------------------------------------------------------------------------*/
6446 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6447 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6448 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6449
6450 static Jim_ObjType exprObjType = {
6451 "expression",
6452 FreeExprInternalRep,
6453 DupExprInternalRep,
6454 NULL,
6455 JIM_TYPE_REFERENCES,
6456 };
6457
6458 /* Expr bytecode structure */
6459 typedef struct ExprByteCode {
6460 int *opcode; /* Integer array of opcodes. */
6461 Jim_Obj **obj; /* Array of associated Jim Objects. */
6462 int len; /* Bytecode length */
6463 int inUse; /* Used for sharing. */
6464 } ExprByteCode;
6465
6466 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6467 {
6468 int i;
6469 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6470
6471 expr->inUse--;
6472 if (expr->inUse != 0) return;
6473 for (i = 0; i < expr->len; i++)
6474 Jim_DecrRefCount(interp, expr->obj[i]);
6475 Jim_Free(expr->opcode);
6476 Jim_Free(expr->obj);
6477 Jim_Free(expr);
6478 }
6479
6480 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6481 {
6482 JIM_NOTUSED(interp);
6483 JIM_NOTUSED(srcPtr);
6484
6485 /* Just returns an simple string. */
6486 dupPtr->typePtr = NULL;
6487 }
6488
6489 /* Add a new instruction to an expression bytecode structure. */
6490 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6491 int opcode, char *str, int len)
6492 {
6493 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6494 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6495 expr->opcode[expr->len] = opcode;
6496 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6497 Jim_IncrRefCount(expr->obj[expr->len]);
6498 expr->len++;
6499 }
6500
6501 /* Check if an expr program looks correct. */
6502 static int ExprCheckCorrectness(ExprByteCode *expr)
6503 {
6504 int i;
6505 int stacklen = 0;
6506
6507 /* Try to check if there are stack underflows,
6508 * and make sure at the end of the program there is
6509 * a single result on the stack. */
6510 for (i = 0; i < expr->len; i++) {
6511 switch (expr->opcode[i]) {
6512 case JIM_EXPROP_NUMBER:
6513 case JIM_EXPROP_STRING:
6514 case JIM_EXPROP_SUBST:
6515 case JIM_EXPROP_VARIABLE:
6516 case JIM_EXPROP_DICTSUGAR:
6517 case JIM_EXPROP_COMMAND:
6518 stacklen++;
6519 break;
6520 case JIM_EXPROP_NOT:
6521 case JIM_EXPROP_BITNOT:
6522 case JIM_EXPROP_UNARYMINUS:
6523 case JIM_EXPROP_UNARYPLUS:
6524 /* Unary operations */
6525 if (stacklen < 1) return JIM_ERR;
6526 break;
6527 case JIM_EXPROP_ADD:
6528 case JIM_EXPROP_SUB:
6529 case JIM_EXPROP_MUL:
6530 case JIM_EXPROP_DIV:
6531 case JIM_EXPROP_MOD:
6532 case JIM_EXPROP_LT:
6533 case JIM_EXPROP_GT:
6534 case JIM_EXPROP_LTE:
6535 case JIM_EXPROP_GTE:
6536 case JIM_EXPROP_ROTL:
6537 case JIM_EXPROP_ROTR:
6538 case JIM_EXPROP_LSHIFT:
6539 case JIM_EXPROP_RSHIFT:
6540 case JIM_EXPROP_NUMEQ:
6541 case JIM_EXPROP_NUMNE:
6542 case JIM_EXPROP_STREQ:
6543 case JIM_EXPROP_STRNE:
6544 case JIM_EXPROP_BITAND:
6545 case JIM_EXPROP_BITXOR:
6546 case JIM_EXPROP_BITOR:
6547 case JIM_EXPROP_LOGICAND:
6548 case JIM_EXPROP_LOGICOR:
6549 case JIM_EXPROP_POW:
6550 /* binary operations */
6551 if (stacklen < 2) return JIM_ERR;
6552 stacklen--;
6553 break;
6554 default:
6555 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6556 break;
6557 }
6558 }
6559 if (stacklen != 1) return JIM_ERR;
6560 return JIM_OK;
6561 }
6562
6563 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6564 ScriptObj *topLevelScript)
6565 {
6566 int i;
6567
6568 return;
6569 for (i = 0; i < expr->len; i++) {
6570 Jim_Obj *foundObjPtr;
6571
6572 if (expr->obj[i] == NULL) continue;
6573 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6574 NULL, expr->obj[i]);
6575 if (foundObjPtr != NULL) {
6576 Jim_IncrRefCount(foundObjPtr);
6577 Jim_DecrRefCount(interp, expr->obj[i]);
6578 expr->obj[i] = foundObjPtr;
6579 }
6580 }
6581 }
6582
6583 /* This procedure converts every occurrence of || and && opereators
6584 * in lazy unary versions.
6585 *
6586 * a b || is converted into:
6587 *
6588 * a <offset> |L b |R
6589 *
6590 * a b && is converted into:
6591 *
6592 * a <offset> &L b &R
6593 *
6594 * "|L" checks if 'a' is true:
6595 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6596 * the opcode just after |R.
6597 * 2) if it is false does nothing.
6598 * "|R" checks if 'b' is true:
6599 * 1) if it is true pushes 1, otherwise pushes 0.
6600 *
6601 * "&L" checks if 'a' is true:
6602 * 1) if it is true does nothing.
6603 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6604 * the opcode just after &R
6605 * "&R" checks if 'a' is true:
6606 * if it is true pushes 1, otherwise pushes 0.
6607 */
6608 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6609 {
6610 while (1) {
6611 int index = -1, leftindex, arity, i, offset;
6612 Jim_ExprOperator *op;
6613
6614 /* Search for || or && */
6615 for (i = 0; i < expr->len; i++) {
6616 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6617 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6618 index = i;
6619 break;
6620 }
6621 }
6622 if (index == -1) return;
6623 /* Search for the end of the first operator */
6624 leftindex = index-1;
6625 arity = 1;
6626 while (arity) {
6627 switch (expr->opcode[leftindex]) {
6628 case JIM_EXPROP_NUMBER:
6629 case JIM_EXPROP_COMMAND:
6630 case JIM_EXPROP_VARIABLE:
6631 case JIM_EXPROP_DICTSUGAR:
6632 case JIM_EXPROP_SUBST:
6633 case JIM_EXPROP_STRING:
6634 break;
6635 default:
6636 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6637 if (op == NULL) {
6638 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6639 }
6640 arity += op->arity;
6641 break;
6642 }
6643 arity--;
6644 leftindex--;
6645 }
6646 leftindex++;
6647 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6648 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6649 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6650 sizeof(int)*(expr->len-leftindex));
6651 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6652 sizeof(Jim_Obj*)*(expr->len-leftindex));
6653 expr->len += 2;
6654 index += 2;
6655 offset = (index-leftindex)-1;
6656 Jim_DecrRefCount(interp, expr->obj[index]);
6657 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6658 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6659 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6660 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6661 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6662 } else {
6663 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6664 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6665 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6666 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6667 }
6668 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6669 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6670 Jim_IncrRefCount(expr->obj[index]);
6671 Jim_IncrRefCount(expr->obj[leftindex]);
6672 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6673 }
6674 }
6675
6676 /* This method takes the string representation of an expression
6677 * and generates a program for the Expr's stack-based VM. */
6678 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6679 {
6680 int exprTextLen;
6681 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6682 struct JimParserCtx parser;
6683 int i, shareLiterals;
6684 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6685 Jim_Stack stack;
6686 Jim_ExprOperator *op;
6687
6688 /* Perform literal sharing with the current procedure
6689 * running only if this expression appears to be not generated
6690 * at runtime. */
6691 shareLiterals = objPtr->typePtr == &sourceObjType;
6692
6693 expr->opcode = NULL;
6694 expr->obj = NULL;
6695 expr->len = 0;
6696 expr->inUse = 1;
6697
6698 Jim_InitStack(&stack);
6699 JimParserInit(&parser, exprText, exprTextLen, 1);
6700 while (!JimParserEof(&parser)) {
6701 char *token;
6702 int len, type;
6703
6704 if (JimParseExpression(&parser) != JIM_OK) {
6705 Jim_SetResultString(interp, "Syntax error in expression", -1);
6706 goto err;
6707 }
6708 token = JimParserGetToken(&parser, &len, &type, NULL);
6709 if (type == JIM_TT_EOL) {
6710 Jim_Free(token);
6711 break;
6712 }
6713 switch (type) {
6714 case JIM_TT_STR:
6715 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6716 break;
6717 case JIM_TT_ESC:
6718 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6719 break;
6720 case JIM_TT_VAR:
6721 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6722 break;
6723 case JIM_TT_DICTSUGAR:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6725 break;
6726 case JIM_TT_CMD:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6728 break;
6729 case JIM_TT_EXPR_NUMBER:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6731 break;
6732 case JIM_TT_EXPR_OPERATOR:
6733 op = JimExprOperatorInfo(token);
6734 while (1) {
6735 Jim_ExprOperator *stackTopOp;
6736
6737 if (Jim_StackPeek(&stack) != NULL) {
6738 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6739 } else {
6740 stackTopOp = NULL;
6741 }
6742 if (Jim_StackLen(&stack) && op->arity != 1 &&
6743 stackTopOp && stackTopOp->precedence >= op->precedence)
6744 {
6745 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6746 Jim_StackPeek(&stack), -1);
6747 Jim_StackPop(&stack);
6748 } else {
6749 break;
6750 }
6751 }
6752 Jim_StackPush(&stack, token);
6753 break;
6754 case JIM_TT_SUBEXPR_START:
6755 Jim_StackPush(&stack, Jim_StrDup("("));
6756 Jim_Free(token);
6757 break;
6758 case JIM_TT_SUBEXPR_END:
6759 {
6760 int found = 0;
6761 while (Jim_StackLen(&stack)) {
6762 char *opstr = Jim_StackPop(&stack);
6763 if (!strcmp(opstr, "(")) {
6764 Jim_Free(opstr);
6765 found = 1;
6766 break;
6767 }
6768 op = JimExprOperatorInfo(opstr);
6769 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6770 }
6771 if (!found) {
6772 Jim_SetResultString(interp,
6773 "Unexpected close parenthesis", -1);
6774 goto err;
6775 }
6776 }
6777 Jim_Free(token);
6778 break;
6779 default:
6780 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6781 break;
6782 }
6783 }
6784 while (Jim_StackLen(&stack)) {
6785 char *opstr = Jim_StackPop(&stack);
6786 op = JimExprOperatorInfo(opstr);
6787 if (op == NULL && !strcmp(opstr, "(")) {
6788 Jim_Free(opstr);
6789 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6790 goto err;
6791 }
6792 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6793 }
6794 /* Check program correctness. */
6795 if (ExprCheckCorrectness(expr) != JIM_OK) {
6796 Jim_SetResultString(interp, "Invalid expression", -1);
6797 goto err;
6798 }
6799
6800 /* Free the stack used for the compilation. */
6801 Jim_FreeStackElements(&stack, Jim_Free);
6802 Jim_FreeStack(&stack);
6803
6804 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6805 ExprMakeLazy(interp, expr);
6806
6807 /* Perform literal sharing */
6808 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6809 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6810 if (bodyObjPtr->typePtr == &scriptObjType) {
6811 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6812 ExprShareLiterals(interp, expr, bodyScript);
6813 }
6814 }
6815
6816 /* Free the old internal rep and set the new one. */
6817 Jim_FreeIntRep(interp, objPtr);
6818 Jim_SetIntRepPtr(objPtr, expr);
6819 objPtr->typePtr = &exprObjType;
6820 return JIM_OK;
6821
6822 err: /* we jump here on syntax/compile errors. */
6823 Jim_FreeStackElements(&stack, Jim_Free);
6824 Jim_FreeStack(&stack);
6825 Jim_Free(expr->opcode);
6826 for (i = 0; i < expr->len; i++) {
6827 Jim_DecrRefCount(interp,expr->obj[i]);
6828 }
6829 Jim_Free(expr->obj);
6830 Jim_Free(expr);
6831 return JIM_ERR;
6832 }
6833
6834 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6835 {
6836 if (objPtr->typePtr != &exprObjType) {
6837 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6838 return NULL;
6839 }
6840 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6841 }
6842
6843 /* -----------------------------------------------------------------------------
6844 * Expressions evaluation.
6845 * Jim uses a specialized stack-based virtual machine for expressions,
6846 * that takes advantage of the fact that expr's operators
6847 * can't be redefined.
6848 *
6849 * Jim_EvalExpression() uses the bytecode compiled by
6850 * SetExprFromAny() method of the "expression" object.
6851 *
6852 * On success a Tcl Object containing the result of the evaluation
6853 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6854 * returned.
6855 * On error the function returns a retcode != to JIM_OK and set a suitable
6856 * error on the interp.
6857 * ---------------------------------------------------------------------------*/
6858 #define JIM_EE_STATICSTACK_LEN 10
6859
6860 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6861 Jim_Obj **exprResultPtrPtr)
6862 {
6863 ExprByteCode *expr;
6864 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6865 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6866
6867 Jim_IncrRefCount(exprObjPtr);
6868 expr = Jim_GetExpression(interp, exprObjPtr);
6869 if (!expr) {
6870 Jim_DecrRefCount(interp, exprObjPtr);
6871 return JIM_ERR; /* error in expression. */
6872 }
6873 /* In order to avoid that the internal repr gets freed due to
6874 * shimmering of the exprObjPtr's object, we make the internal rep
6875 * shared. */
6876 expr->inUse++;
6877
6878 /* The stack-based expr VM itself */
6879
6880 /* Stack allocation. Expr programs have the feature that
6881 * a program of length N can't require a stack longer than
6882 * N. */
6883 if (expr->len > JIM_EE_STATICSTACK_LEN)
6884 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6885 else
6886 stack = staticStack;
6887
6888 /* Execute every istruction */
6889 for (i = 0; i < expr->len; i++) {
6890 Jim_Obj *A, *B, *objPtr;
6891 jim_wide wA, wB, wC;
6892 double dA, dB, dC;
6893 const char *sA, *sB;
6894 int Alen, Blen, retcode;
6895 int opcode = expr->opcode[i];
6896
6897 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6898 stack[stacklen++] = expr->obj[i];
6899 Jim_IncrRefCount(expr->obj[i]);
6900 } else if (opcode == JIM_EXPROP_VARIABLE) {
6901 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6902 if (objPtr == NULL) {
6903 error = 1;
6904 goto err;
6905 }
6906 stack[stacklen++] = objPtr;
6907 Jim_IncrRefCount(objPtr);
6908 } else if (opcode == JIM_EXPROP_SUBST) {
6909 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6910 &objPtr, JIM_NONE)) != JIM_OK)
6911 {
6912 error = 1;
6913 errRetCode = retcode;
6914 goto err;
6915 }
6916 stack[stacklen++] = objPtr;
6917 Jim_IncrRefCount(objPtr);
6918 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6919 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6920 if (objPtr == NULL) {
6921 error = 1;
6922 goto err;
6923 }
6924 stack[stacklen++] = objPtr;
6925 Jim_IncrRefCount(objPtr);
6926 } else if (opcode == JIM_EXPROP_COMMAND) {
6927 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6928 error = 1;
6929 errRetCode = retcode;
6930 goto err;
6931 }
6932 stack[stacklen++] = interp->result;
6933 Jim_IncrRefCount(interp->result);
6934 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6935 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6936 {
6937 /* Note that there isn't to increment the
6938 * refcount of objects. the references are moved
6939 * from stack to A and B. */
6940 B = stack[--stacklen];
6941 A = stack[--stacklen];
6942
6943 /* --- Integer --- */
6944 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6945 (B->typePtr == &doubleObjType && !B->bytes) ||
6946 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6947 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6948 goto trydouble;
6949 }
6950 Jim_DecrRefCount(interp, A);
6951 Jim_DecrRefCount(interp, B);
6952 switch (expr->opcode[i]) {
6953 case JIM_EXPROP_ADD: wC = wA + wB; break;
6954 case JIM_EXPROP_SUB: wC = wA-wB; break;
6955 case JIM_EXPROP_MUL: wC = wA*wB; break;
6956 case JIM_EXPROP_LT: wC = wA < wB; break;
6957 case JIM_EXPROP_GT: wC = wA > wB; break;
6958 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6959 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6960 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6961 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6962 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6963 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6964 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6965 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6966 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6967 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6968 case JIM_EXPROP_LOGICAND_LEFT:
6969 if (wA == 0) {
6970 i += (int)wB;
6971 wC = 0;
6972 } else {
6973 continue;
6974 }
6975 break;
6976 case JIM_EXPROP_LOGICOR_LEFT:
6977 if (wA != 0) {
6978 i += (int)wB;
6979 wC = 1;
6980 } else {
6981 continue;
6982 }
6983 break;
6984 case JIM_EXPROP_DIV:
6985 if (wB == 0) goto divbyzero;
6986 wC = wA/wB;
6987 break;
6988 case JIM_EXPROP_MOD:
6989 if (wB == 0) goto divbyzero;
6990 wC = wA%wB;
6991 break;
6992 case JIM_EXPROP_ROTL: {
6993 /* uint32_t would be better. But not everyone has inttypes.h?*/
6994 unsigned long uA = (unsigned long)wA;
6995 #ifdef _MSC_VER
6996 wC = _rotl(uA,(unsigned long)wB);
6997 #else
6998 const unsigned int S = sizeof(unsigned long) * 8;
6999 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7000 #endif
7001 break;
7002 }
7003 case JIM_EXPROP_ROTR: {
7004 unsigned long uA = (unsigned long)wA;
7005 #ifdef _MSC_VER
7006 wC = _rotr(uA,(unsigned long)wB);
7007 #else
7008 const unsigned int S = sizeof(unsigned long) * 8;
7009 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7010 #endif
7011 break;
7012 }
7013
7014 default:
7015 wC = 0; /* avoid gcc warning */
7016 break;
7017 }
7018 stack[stacklen] = Jim_NewIntObj(interp, wC);
7019 Jim_IncrRefCount(stack[stacklen]);
7020 stacklen++;
7021 continue;
7022 trydouble:
7023 /* --- Double --- */
7024 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7025 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7026
7027 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7028 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7029 opcode = JIM_EXPROP_STRNE;
7030 goto retry_as_string;
7031 }
7032 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7033 opcode = JIM_EXPROP_STREQ;
7034 goto retry_as_string;
7035 }
7036 Jim_DecrRefCount(interp, A);
7037 Jim_DecrRefCount(interp, B);
7038 error = 1;
7039 goto err;
7040 }
7041 Jim_DecrRefCount(interp, A);
7042 Jim_DecrRefCount(interp, B);
7043 switch (expr->opcode[i]) {
7044 case JIM_EXPROP_ROTL:
7045 case JIM_EXPROP_ROTR:
7046 case JIM_EXPROP_LSHIFT:
7047 case JIM_EXPROP_RSHIFT:
7048 case JIM_EXPROP_BITAND:
7049 case JIM_EXPROP_BITXOR:
7050 case JIM_EXPROP_BITOR:
7051 case JIM_EXPROP_MOD:
7052 case JIM_EXPROP_POW:
7053 Jim_SetResultString(interp,
7054 "Got floating-point value where integer was expected", -1);
7055 error = 1;
7056 goto err;
7057 break;
7058 case JIM_EXPROP_ADD: dC = dA + dB; break;
7059 case JIM_EXPROP_SUB: dC = dA-dB; break;
7060 case JIM_EXPROP_MUL: dC = dA*dB; break;
7061 case JIM_EXPROP_LT: dC = dA < dB; break;
7062 case JIM_EXPROP_GT: dC = dA > dB; break;
7063 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7064 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7065 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7066 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7067 case JIM_EXPROP_LOGICAND_LEFT:
7068 if (dA == 0) {
7069 i += (int)dB;
7070 dC = 0;
7071 } else {
7072 continue;
7073 }
7074 break;
7075 case JIM_EXPROP_LOGICOR_LEFT:
7076 if (dA != 0) {
7077 i += (int)dB;
7078 dC = 1;
7079 } else {
7080 continue;
7081 }
7082 break;
7083 case JIM_EXPROP_DIV:
7084 if (dB == 0) goto divbyzero;
7085 dC = dA/dB;
7086 break;
7087 default:
7088 dC = 0; /* avoid gcc warning */
7089 break;
7090 }
7091 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7092 Jim_IncrRefCount(stack[stacklen]);
7093 stacklen++;
7094 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7095 B = stack[--stacklen];
7096 A = stack[--stacklen];
7097 retry_as_string:
7098 sA = Jim_GetString(A, &Alen);
7099 sB = Jim_GetString(B, &Blen);
7100 switch (opcode) {
7101 case JIM_EXPROP_STREQ:
7102 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7103 wC = 1;
7104 else
7105 wC = 0;
7106 break;
7107 case JIM_EXPROP_STRNE:
7108 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7109 wC = 1;
7110 else
7111 wC = 0;
7112 break;
7113 default:
7114 wC = 0; /* avoid gcc warning */
7115 break;
7116 }
7117 Jim_DecrRefCount(interp, A);
7118 Jim_DecrRefCount(interp, B);
7119 stack[stacklen] = Jim_NewIntObj(interp, wC);
7120 Jim_IncrRefCount(stack[stacklen]);
7121 stacklen++;
7122 } else if (opcode == JIM_EXPROP_NOT ||
7123 opcode == JIM_EXPROP_BITNOT ||
7124 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7125 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7126 /* Note that there isn't to increment the
7127 * refcount of objects. the references are moved
7128 * from stack to A and B. */
7129 A = stack[--stacklen];
7130
7131 /* --- Integer --- */
7132 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7133 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7134 goto trydouble_unary;
7135 }
7136 Jim_DecrRefCount(interp, A);
7137 switch (expr->opcode[i]) {
7138 case JIM_EXPROP_NOT: wC = !wA; break;
7139 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7140 case JIM_EXPROP_LOGICAND_RIGHT:
7141 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7142 default:
7143 wC = 0; /* avoid gcc warning */
7144 break;
7145 }
7146 stack[stacklen] = Jim_NewIntObj(interp, wC);
7147 Jim_IncrRefCount(stack[stacklen]);
7148 stacklen++;
7149 continue;
7150 trydouble_unary:
7151 /* --- Double --- */
7152 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7153 Jim_DecrRefCount(interp, A);
7154 error = 1;
7155 goto err;
7156 }
7157 Jim_DecrRefCount(interp, A);
7158 switch (expr->opcode[i]) {
7159 case JIM_EXPROP_NOT: dC = !dA; break;
7160 case JIM_EXPROP_LOGICAND_RIGHT:
7161 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7162 case JIM_EXPROP_BITNOT:
7163 Jim_SetResultString(interp,
7164 "Got floating-point value where integer was expected", -1);
7165 error = 1;
7166 goto err;
7167 break;
7168 default:
7169 dC = 0; /* avoid gcc warning */
7170 break;
7171 }
7172 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7173 Jim_IncrRefCount(stack[stacklen]);
7174 stacklen++;
7175 } else {
7176 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7177 }
7178 }
7179 err:
7180 /* There is no need to decerement the inUse field because
7181 * this reference is transfered back into the exprObjPtr. */
7182 Jim_FreeIntRep(interp, exprObjPtr);
7183 exprObjPtr->typePtr = &exprObjType;
7184 Jim_SetIntRepPtr(exprObjPtr, expr);
7185 Jim_DecrRefCount(interp, exprObjPtr);
7186 if (!error) {
7187 *exprResultPtrPtr = stack[0];
7188 Jim_IncrRefCount(stack[0]);
7189 errRetCode = JIM_OK;
7190 }
7191 for (i = 0; i < stacklen; i++) {
7192 Jim_DecrRefCount(interp, stack[i]);
7193 }
7194 if (stack != staticStack)
7195 Jim_Free(stack);
7196 return errRetCode;
7197 divbyzero:
7198 error = 1;
7199 Jim_SetResultString(interp, "Division by zero", -1);
7200 goto err;
7201 }
7202
7203 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7204 {
7205 int retcode;
7206 jim_wide wideValue;
7207 double doubleValue;
7208 Jim_Obj *exprResultPtr;
7209
7210 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7211 if (retcode != JIM_OK)
7212 return retcode;
7213 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7214 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7215 {
7216 Jim_DecrRefCount(interp, exprResultPtr);
7217 return JIM_ERR;
7218 } else {
7219 Jim_DecrRefCount(interp, exprResultPtr);
7220 *boolPtr = doubleValue != 0;
7221 return JIM_OK;
7222 }
7223 }
7224 Jim_DecrRefCount(interp, exprResultPtr);
7225 *boolPtr = wideValue != 0;
7226 return JIM_OK;
7227 }
7228
7229 /* -----------------------------------------------------------------------------
7230 * ScanFormat String Object
7231 * ---------------------------------------------------------------------------*/
7232
7233 /* This Jim_Obj will held a parsed representation of a format string passed to
7234 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7235 * to be parsed in its entirely first and then, if correct, can be used for
7236 * scanning. To avoid endless re-parsing, the parsed representation will be
7237 * stored in an internal representation and re-used for performance reason. */
7238
7239 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7240 * scanformat string. This part will later be used to extract information
7241 * out from the string to be parsed by Jim_ScanString */
7242
7243 typedef struct ScanFmtPartDescr {
7244 char type; /* Type of conversion (e.g. c, d, f) */
7245 char modifier; /* Modify type (e.g. l - long, h - short */
7246 size_t width; /* Maximal width of input to be converted */
7247 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7248 char *arg; /* Specification of a CHARSET conversion */
7249 char *prefix; /* Prefix to be scanned literally before conversion */
7250 } ScanFmtPartDescr;
7251
7252 /* The ScanFmtStringObj will held the internal representation of a scanformat
7253 * string parsed and separated in part descriptions. Furthermore it contains
7254 * the original string representation of the scanformat string to allow for
7255 * fast update of the Jim_Obj's string representation part.
7256 *
7257 * As add-on the internal object representation add some scratch pad area
7258 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7259 * memory for purpose of string scanning.
7260 *
7261 * The error member points to a static allocated string in case of a mal-
7262 * formed scanformat string or it contains '0' (NULL) in case of a valid
7263 * parse representation.
7264 *
7265 * The whole memory of the internal representation is allocated as a single
7266 * area of memory that will be internally separated. So freeing and duplicating
7267 * of such an object is cheap */
7268
7269 typedef struct ScanFmtStringObj {
7270 jim_wide size; /* Size of internal repr in bytes */
7271 char *stringRep; /* Original string representation */
7272 size_t count; /* Number of ScanFmtPartDescr contained */
7273 size_t convCount; /* Number of conversions that will assign */
7274 size_t maxPos; /* Max position index if XPG3 is used */
7275 const char *error; /* Ptr to error text (NULL if no error */
7276 char *scratch; /* Some scratch pad used by Jim_ScanString */
7277 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7278 } ScanFmtStringObj;
7279
7280
7281 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7282 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7283 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7284
7285 static Jim_ObjType scanFmtStringObjType = {
7286 "scanformatstring",
7287 FreeScanFmtInternalRep,
7288 DupScanFmtInternalRep,
7289 UpdateStringOfScanFmt,
7290 JIM_TYPE_NONE,
7291 };
7292
7293 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7294 {
7295 JIM_NOTUSED(interp);
7296 Jim_Free((char*)objPtr->internalRep.ptr);
7297 objPtr->internalRep.ptr = 0;
7298 }
7299
7300 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7301 {
7302 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7303 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7304
7305 JIM_NOTUSED(interp);
7306 memcpy(newVec, srcPtr->internalRep.ptr, size);
7307 dupPtr->internalRep.ptr = newVec;
7308 dupPtr->typePtr = &scanFmtStringObjType;
7309 }
7310
7311 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7312 {
7313 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7314
7315 objPtr->bytes = Jim_StrDup(bytes);
7316 objPtr->length = strlen(bytes);
7317 }
7318
7319 /* SetScanFmtFromAny will parse a given string and create the internal
7320 * representation of the format specification. In case of an error
7321 * the error data member of the internal representation will be set
7322 * to an descriptive error text and the function will be left with
7323 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7324 * specification */
7325
7326 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7327 {
7328 ScanFmtStringObj *fmtObj;
7329 char *buffer;
7330 int maxCount, i, approxSize, lastPos = -1;
7331 const char *fmt = objPtr->bytes;
7332 int maxFmtLen = objPtr->length;
7333 const char *fmtEnd = fmt + maxFmtLen;
7334 int curr;
7335
7336 Jim_FreeIntRep(interp, objPtr);
7337 /* Count how many conversions could take place maximally */
7338 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7339 if (fmt[i] == '%')
7340 ++maxCount;
7341 /* Calculate an approximation of the memory necessary */
7342 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7343 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7344 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7345 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7346 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7347 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7348 + 1; /* safety byte */
7349 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7350 memset(fmtObj, 0, approxSize);
7351 fmtObj->size = approxSize;
7352 fmtObj->maxPos = 0;
7353 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7354 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7355 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7356 buffer = fmtObj->stringRep + maxFmtLen + 1;
7357 objPtr->internalRep.ptr = fmtObj;
7358 objPtr->typePtr = &scanFmtStringObjType;
7359 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7360 int width = 0, skip;
7361 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7362 fmtObj->count++;
7363 descr->width = 0; /* Assume width unspecified */
7364 /* Overread and store any "literal" prefix */
7365 if (*fmt != '%' || fmt[1] == '%') {
7366 descr->type = 0;
7367 descr->prefix = &buffer[i];
7368 for (; fmt < fmtEnd; ++fmt) {
7369 if (*fmt == '%') {
7370 if (fmt[1] != '%') break;
7371 ++fmt;
7372 }
7373 buffer[i++] = *fmt;
7374 }
7375 buffer[i++] = 0;
7376 }
7377 /* Skip the conversion introducing '%' sign */
7378 ++fmt;
7379 /* End reached due to non-conversion literal only? */
7380 if (fmt >= fmtEnd)
7381 goto done;
7382 descr->pos = 0; /* Assume "natural" positioning */
7383 if (*fmt == '*') {
7384 descr->pos = -1; /* Okay, conversion will not be assigned */
7385 ++fmt;
7386 } else
7387 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7388 /* Check if next token is a number (could be width or pos */
7389 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7390 fmt += skip;
7391 /* Was the number a XPG3 position specifier? */
7392 if (descr->pos != -1 && *fmt == '$') {
7393 int prev;
7394 ++fmt;
7395 descr->pos = width;
7396 width = 0;
7397 /* Look if "natural" postioning and XPG3 one was mixed */
7398 if ((lastPos == 0 && descr->pos > 0)
7399 || (lastPos > 0 && descr->pos == 0)) {
7400 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7401 return JIM_ERR;
7402 }
7403 /* Look if this position was already used */
7404 for (prev = 0; prev < curr; ++prev) {
7405 if (fmtObj->descr[prev].pos == -1) continue;
7406 if (fmtObj->descr[prev].pos == descr->pos) {
7407 fmtObj->error = "same \"%n$\" conversion specifier "
7408 "used more than once";
7409 return JIM_ERR;
7410 }
7411 }
7412 /* Try to find a width after the XPG3 specifier */
7413 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7414 descr->width = width;
7415 fmt += skip;
7416 }
7417 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7418 fmtObj->maxPos = descr->pos;
7419 } else {
7420 /* Number was not a XPG3, so it has to be a width */
7421 descr->width = width;
7422 }
7423 }
7424 /* If positioning mode was undetermined yet, fix this */
7425 if (lastPos == -1)
7426 lastPos = descr->pos;
7427 /* Handle CHARSET conversion type ... */
7428 if (*fmt == '[') {
7429 int swapped = 1, beg = i, end, j;
7430 descr->type = '[';
7431 descr->arg = &buffer[i];
7432 ++fmt;
7433 if (*fmt == '^') buffer[i++] = *fmt++;
7434 if (*fmt == ']') buffer[i++] = *fmt++;
7435 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7436 if (*fmt != ']') {
7437 fmtObj->error = "unmatched [ in format string";
7438 return JIM_ERR;
7439 }
7440 end = i;
7441 buffer[i++] = 0;
7442 /* In case a range fence was given "backwards", swap it */
7443 while (swapped) {
7444 swapped = 0;
7445 for (j = beg + 1; j < end-1; ++j) {
7446 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7447 char tmp = buffer[j-1];
7448 buffer[j-1] = buffer[j + 1];
7449 buffer[j + 1] = tmp;
7450 swapped = 1;
7451 }
7452 }
7453 }
7454 } else {
7455 /* Remember any valid modifier if given */
7456 if (strchr("hlL", *fmt) != 0)
7457 descr->modifier = tolower((int)*fmt++);
7458
7459 descr->type = *fmt;
7460 if (strchr("efgcsndoxui", *fmt) == 0) {
7461 fmtObj->error = "bad scan conversion character";
7462 return JIM_ERR;
7463 } else if (*fmt == 'c' && descr->width != 0) {
7464 fmtObj->error = "field width may not be specified in %c "
7465 "conversion";
7466 return JIM_ERR;
7467 } else if (*fmt == 'u' && descr->modifier == 'l') {
7468 fmtObj->error = "unsigned wide not supported";
7469 return JIM_ERR;
7470 }
7471 }
7472 curr++;
7473 }
7474 done:
7475 if (fmtObj->convCount == 0) {
7476 fmtObj->error = "no any conversion specifier given";
7477 return JIM_ERR;
7478 }
7479 return JIM_OK;
7480 }
7481
7482 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7483
7484 #define FormatGetCnvCount(_fo_) \
7485 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7486 #define FormatGetMaxPos(_fo_) \
7487 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7488 #define FormatGetError(_fo_) \
7489 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7490
7491 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7492 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7493 * bitvector implementation in Jim? */
7494
7495 static int JimTestBit(const char *bitvec, char ch)
7496 {
7497 div_t pos = div(ch-1, 8);
7498 return bitvec[pos.quot] & (1 << pos.rem);
7499 }
7500
7501 static void JimSetBit(char *bitvec, char ch)
7502 {
7503 div_t pos = div(ch-1, 8);
7504 bitvec[pos.quot] |= (1 << pos.rem);
7505 }
7506
7507 #if 0 /* currently not used */
7508 static void JimClearBit(char *bitvec, char ch)
7509 {
7510 div_t pos = div(ch-1, 8);
7511 bitvec[pos.quot] &= ~(1 << pos.rem);
7512 }
7513 #endif
7514
7515 /* JimScanAString is used to scan an unspecified string that ends with
7516 * next WS, or a string that is specified via a charset. The charset
7517 * is currently implemented in a way to only allow for usage with
7518 * ASCII. Whenever we will switch to UNICODE, another idea has to
7519 * be born :-/
7520 *
7521 * FIXME: Works only with ASCII */
7522
7523 static Jim_Obj *
7524 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7525 {
7526 size_t i;
7527 Jim_Obj *result;
7528 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7529 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7530
7531 /* First init charset to nothing or all, depending if a specified
7532 * or an unspecified string has to be parsed */
7533 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7534 if (sdescr) {
7535 /* There was a set description given, that means we are parsing
7536 * a specified string. So we have to build a corresponding
7537 * charset reflecting the description */
7538 int notFlag = 0;
7539 /* Should the set be negated at the end? */
7540 if (*sdescr == '^') {
7541 notFlag = 1;
7542 ++sdescr;
7543 }
7544 /* Here '-' is meant literally and not to define a range */
7545 if (*sdescr == '-') {
7546 JimSetBit(charset, '-');
7547 ++sdescr;
7548 }
7549 while (*sdescr) {
7550 if (sdescr[1] == '-' && sdescr[2] != 0) {
7551 /* Handle range definitions */
7552 int i;
7553 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7554 JimSetBit(charset, (char)i);
7555 sdescr += 3;
7556 } else {
7557 /* Handle verbatim character definitions */
7558 JimSetBit(charset, *sdescr++);
7559 }
7560 }
7561 /* Negate the charset if there was a NOT given */
7562 for (i = 0; notFlag && i < sizeof(charset); ++i)
7563 charset[i] = ~charset[i];
7564 }
7565 /* And after all the mess above, the real work begin ... */
7566 while (str && *str) {
7567 if (!sdescr && isspace((int)*str))
7568 break; /* EOS via WS if unspecified */
7569 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7570 else break; /* EOS via mismatch if specified scanning */
7571 }
7572 *buffer = 0; /* Close the string properly ... */
7573 result = Jim_NewStringObj(interp, anchor, -1);
7574 Jim_Free(anchor); /* ... and free it afer usage */
7575 return result;
7576 }
7577
7578 /* ScanOneEntry will scan one entry out of the string passed as argument.
7579 * It use the sscanf() function for this task. After extracting and
7580 * converting of the value, the count of scanned characters will be
7581 * returned of -1 in case of no conversion tool place and string was
7582 * already scanned thru */
7583
7584 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7585 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7586 {
7587 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7588 ? sizeof(jim_wide) \
7589 : sizeof(double))
7590 char buffer[MAX_SIZE];
7591 char *value = buffer;
7592 const char *tok;
7593 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7594 size_t sLen = strlen(&str[pos]), scanned = 0;
7595 size_t anchor = pos;
7596 int i;
7597
7598 /* First pessimiticly assume, we will not scan anything :-) */
7599 *valObjPtr = 0;
7600 if (descr->prefix) {
7601 /* There was a prefix given before the conversion, skip it and adjust
7602 * the string-to-be-parsed accordingly */
7603 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7604 /* If prefix require, skip WS */
7605 if (isspace((int)descr->prefix[i]))
7606 while (str[pos] && isspace((int)str[pos])) ++pos;
7607 else if (descr->prefix[i] != str[pos])
7608 break; /* Prefix do not match here, leave the loop */
7609 else
7610 ++pos; /* Prefix matched so far, next round */
7611 }
7612 if (str[pos] == 0)
7613 return -1; /* All of str consumed: EOF condition */
7614 else if (descr->prefix[i] != 0)
7615 return 0; /* Not whole prefix consumed, no conversion possible */
7616 }
7617 /* For all but following conversion, skip leading WS */
7618 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7619 while (isspace((int)str[pos])) ++pos;
7620 /* Determine how much skipped/scanned so far */
7621 scanned = pos - anchor;
7622 if (descr->type == 'n') {
7623 /* Return pseudo conversion means: how much scanned so far? */
7624 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7625 } else if (str[pos] == 0) {
7626 /* Cannot scan anything, as str is totally consumed */
7627 return -1;
7628 } else {
7629 /* Processing of conversions follows ... */
7630 if (descr->width > 0) {
7631 /* Do not try to scan as fas as possible but only the given width.
7632 * To ensure this, we copy the part that should be scanned. */
7633 size_t tLen = descr->width > sLen ? sLen : descr->width;
7634 tok = Jim_StrDupLen(&str[pos], tLen);
7635 } else {
7636 /* As no width was given, simply refer to the original string */
7637 tok = &str[pos];
7638 }
7639 switch (descr->type) {
7640 case 'c':
7641 *valObjPtr = Jim_NewIntObj(interp, *tok);
7642 scanned += 1;
7643 break;
7644 case 'd': case 'o': case 'x': case 'u': case 'i': {
7645 jim_wide jwvalue = 0;
7646 long lvalue = 0;
7647 char *endp; /* Position where the number finished */
7648 int base = descr->type == 'o' ? 8
7649 : descr->type == 'x' ? 16
7650 : descr->type == 'i' ? 0
7651 : 10;
7652
7653 do {
7654 /* Try to scan a number with the given base */
7655 if (descr->modifier == 'l')
7656 {
7657 #ifdef HAVE_LONG_LONG_INT
7658 jwvalue = JimStrtoll(tok, &endp, base),
7659 #else
7660 jwvalue = strtol(tok, &endp, base),
7661 #endif
7662 memcpy(value, &jwvalue, sizeof(jim_wide));
7663 }
7664 else
7665 {
7666 if (descr->type == 'u')
7667 lvalue = strtoul(tok, &endp, base);
7668 else
7669 lvalue = strtol(tok, &endp, base);
7670 memcpy(value, &lvalue, sizeof(lvalue));
7671 }
7672 /* If scanning failed, and base was undetermined, simply
7673 * put it to 10 and try once more. This should catch the
7674 * case where %i begin to parse a number prefix (e.g.
7675 * '0x' but no further digits follows. This will be
7676 * handled as a ZERO followed by a char 'x' by Tcl */
7677 if (endp == tok && base == 0) base = 10;
7678 else break;
7679 } while (1);
7680 if (endp != tok) {
7681 /* There was some number sucessfully scanned! */
7682 if (descr->modifier == 'l')
7683 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7684 else
7685 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7686 /* Adjust the number-of-chars scanned so far */
7687 scanned += endp - tok;
7688 } else {
7689 /* Nothing was scanned. We have to determine if this
7690 * happened due to e.g. prefix mismatch or input str
7691 * exhausted */
7692 scanned = *tok ? 0 : -1;
7693 }
7694 break;
7695 }
7696 case 's': case '[': {
7697 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7698 scanned += Jim_Length(*valObjPtr);
7699 break;
7700 }
7701 case 'e': case 'f': case 'g': {
7702 char *endp;
7703
7704 double dvalue = strtod(tok, &endp);
7705 memcpy(value, &dvalue, sizeof(double));
7706 if (endp != tok) {
7707 /* There was some number sucessfully scanned! */
7708 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7709 /* Adjust the number-of-chars scanned so far */
7710 scanned += endp - tok;
7711 } else {
7712 /* Nothing was scanned. We have to determine if this
7713 * happened due to e.g. prefix mismatch or input str
7714 * exhausted */
7715 scanned = *tok ? 0 : -1;
7716 }
7717 break;
7718 }
7719 }
7720 /* If a substring was allocated (due to pre-defined width) do not
7721 * forget to free it */
7722 if (tok != &str[pos])
7723 Jim_Free((char*)tok);
7724 }
7725 return scanned;
7726 }
7727
7728 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7729 * string and returns all converted (and not ignored) values in a list back
7730 * to the caller. If an error occured, a NULL pointer will be returned */
7731
7732 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7733 Jim_Obj *fmtObjPtr, int flags)
7734 {
7735 size_t i, pos;
7736 int scanned = 1;
7737 const char *str = Jim_GetString(strObjPtr, 0);
7738 Jim_Obj *resultList = 0;
7739 Jim_Obj **resultVec;
7740 int resultc;
7741 Jim_Obj *emptyStr = 0;
7742 ScanFmtStringObj *fmtObj;
7743
7744 /* If format specification is not an object, convert it! */
7745 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7746 SetScanFmtFromAny(interp, fmtObjPtr);
7747 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7748 /* Check if format specification was valid */
7749 if (fmtObj->error != 0) {
7750 if (flags & JIM_ERRMSG)
7751 Jim_SetResultString(interp, fmtObj->error, -1);
7752 return 0;
7753 }
7754 /* Allocate a new "shared" empty string for all unassigned conversions */
7755 emptyStr = Jim_NewEmptyStringObj(interp);
7756 Jim_IncrRefCount(emptyStr);
7757 /* Create a list and fill it with empty strings up to max specified XPG3 */
7758 resultList = Jim_NewListObj(interp, 0, 0);
7759 if (fmtObj->maxPos > 0) {
7760 for (i = 0; i < fmtObj->maxPos; ++i)
7761 Jim_ListAppendElement(interp, resultList, emptyStr);
7762 JimListGetElements(interp, resultList, &resultc, &resultVec);
7763 }
7764 /* Now handle every partial format description */
7765 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7766 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7767 Jim_Obj *value = 0;
7768 /* Only last type may be "literal" w/o conversion - skip it! */
7769 if (descr->type == 0) continue;
7770 /* As long as any conversion could be done, we will proceed */
7771 if (scanned > 0)
7772 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7773 /* In case our first try results in EOF, we will leave */
7774 if (scanned == -1 && i == 0)
7775 goto eof;
7776 /* Advance next pos-to-be-scanned for the amount scanned already */
7777 pos += scanned;
7778 /* value == 0 means no conversion took place so take empty string */
7779 if (value == 0)
7780 value = Jim_NewEmptyStringObj(interp);
7781 /* If value is a non-assignable one, skip it */
7782 if (descr->pos == -1) {
7783 Jim_FreeNewObj(interp, value);
7784 } else if (descr->pos == 0)
7785 /* Otherwise append it to the result list if no XPG3 was given */
7786 Jim_ListAppendElement(interp, resultList, value);
7787 else if (resultVec[descr->pos-1] == emptyStr) {
7788 /* But due to given XPG3, put the value into the corr. slot */
7789 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7790 Jim_IncrRefCount(value);
7791 resultVec[descr->pos-1] = value;
7792 } else {
7793 /* Otherwise, the slot was already used - free obj and ERROR */
7794 Jim_FreeNewObj(interp, value);
7795 goto err;
7796 }
7797 }
7798 Jim_DecrRefCount(interp, emptyStr);
7799 return resultList;
7800 eof:
7801 Jim_DecrRefCount(interp, emptyStr);
7802 Jim_FreeNewObj(interp, resultList);
7803 return (Jim_Obj*)EOF;
7804 err:
7805 Jim_DecrRefCount(interp, emptyStr);
7806 Jim_FreeNewObj(interp, resultList);
7807 return 0;
7808 }
7809
7810 /* -----------------------------------------------------------------------------
7811 * Pseudo Random Number Generation
7812 * ---------------------------------------------------------------------------*/
7813 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7814 int seedLen);
7815
7816 /* Initialize the sbox with the numbers from 0 to 255 */
7817 static void JimPrngInit(Jim_Interp *interp)
7818 {
7819 int i;
7820 unsigned int seed[256];
7821
7822 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7823 for (i = 0; i < 256; i++)
7824 seed[i] = (rand() ^ time(NULL) ^ clock());
7825 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7826 }
7827
7828 /* Generates N bytes of random data */
7829 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7830 {
7831 Jim_PrngState *prng;
7832 unsigned char *destByte = (unsigned char*) dest;
7833 unsigned int si, sj, x;
7834
7835 /* initialization, only needed the first time */
7836 if (interp->prngState == NULL)
7837 JimPrngInit(interp);
7838 prng = interp->prngState;
7839 /* generates 'len' bytes of pseudo-random numbers */
7840 for (x = 0; x < len; x++) {
7841 prng->i = (prng->i + 1) & 0xff;
7842 si = prng->sbox[prng->i];
7843 prng->j = (prng->j + si) & 0xff;
7844 sj = prng->sbox[prng->j];
7845 prng->sbox[prng->i] = sj;
7846 prng->sbox[prng->j] = si;
7847 *destByte++ = prng->sbox[(si + sj)&0xff];
7848 }
7849 }
7850
7851 /* Re-seed the generator with user-provided bytes */
7852 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7853 int seedLen)
7854 {
7855 int i;
7856 unsigned char buf[256];
7857 Jim_PrngState *prng;
7858
7859 /* initialization, only needed the first time */
7860 if (interp->prngState == NULL)
7861 JimPrngInit(interp);
7862 prng = interp->prngState;
7863
7864 /* Set the sbox[i] with i */
7865 for (i = 0; i < 256; i++)
7866 prng->sbox[i] = i;
7867 /* Now use the seed to perform a random permutation of the sbox */
7868 for (i = 0; i < seedLen; i++) {
7869 unsigned char t;
7870
7871 t = prng->sbox[i&0xFF];
7872 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7873 prng->sbox[seed[i]] = t;
7874 }
7875 prng->i = prng->j = 0;
7876 /* discard the first 256 bytes of stream. */
7877 JimRandomBytes(interp, buf, 256);
7878 }
7879
7880 /* -----------------------------------------------------------------------------
7881 * Dynamic libraries support (WIN32 not supported)
7882 * ---------------------------------------------------------------------------*/
7883
7884 #ifdef JIM_DYNLIB
7885 #ifdef WIN32
7886 #define RTLD_LAZY 0
7887 void * dlopen(const char *path, int mode)
7888 {
7889 JIM_NOTUSED(mode);
7890
7891 return (void *)LoadLibraryA(path);
7892 }
7893 int dlclose(void *handle)
7894 {
7895 FreeLibrary((HANDLE)handle);
7896 return 0;
7897 }
7898 void *dlsym(void *handle, const char *symbol)
7899 {
7900 return GetProcAddress((HMODULE)handle, symbol);
7901 }
7902 static char win32_dlerror_string[121];
7903 const char *dlerror(void)
7904 {
7905 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7906 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7907 return win32_dlerror_string;
7908 }
7909 #endif /* WIN32 */
7910
7911 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7912 {
7913 Jim_Obj *libPathObjPtr;
7914 int prefixc, i;
7915 void *handle;
7916 int (*onload)(Jim_Interp *interp);
7917
7918 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7919 if (libPathObjPtr == NULL) {
7920 prefixc = 0;
7921 libPathObjPtr = NULL;
7922 } else {
7923 Jim_IncrRefCount(libPathObjPtr);
7924 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7925 }
7926
7927 for (i = -1; i < prefixc; i++) {
7928 if (i < 0) {
7929 handle = dlopen(pathName, RTLD_LAZY);
7930 } else {
7931 FILE *fp;
7932 char buf[JIM_PATH_LEN];
7933 const char *prefix;
7934 int prefixlen;
7935 Jim_Obj *prefixObjPtr;
7936
7937 buf[0] = '\0';
7938 if (Jim_ListIndex(interp, libPathObjPtr, i,
7939 &prefixObjPtr, JIM_NONE) != JIM_OK)
7940 continue;
7941 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7942 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7943 continue;
7944 if (*pathName == '/') {
7945 strcpy(buf, pathName);
7946 }
7947 else if (prefixlen && prefix[prefixlen-1] == '/')
7948 sprintf(buf, "%s%s", prefix, pathName);
7949 else
7950 sprintf(buf, "%s/%s", prefix, pathName);
7951 fp = fopen(buf, "r");
7952 if (fp == NULL)
7953 continue;
7954 fclose(fp);
7955 handle = dlopen(buf, RTLD_LAZY);
7956 }
7957 if (handle == NULL) {
7958 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7959 Jim_AppendStrings(interp, Jim_GetResult(interp),
7960 "error loading extension \"", pathName,
7961 "\": ", dlerror(), NULL);
7962 if (i < 0)
7963 continue;
7964 goto err;
7965 }
7966 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7967 Jim_SetResultString(interp,
7968 "No Jim_OnLoad symbol found on extension", -1);
7969 goto err;
7970 }
7971 if (onload(interp) == JIM_ERR) {
7972 dlclose(handle);
7973 goto err;
7974 }
7975 Jim_SetEmptyResult(interp);
7976 if (libPathObjPtr != NULL)
7977 Jim_DecrRefCount(interp, libPathObjPtr);
7978 return JIM_OK;
7979 }
7980 err:
7981 if (libPathObjPtr != NULL)
7982 Jim_DecrRefCount(interp, libPathObjPtr);
7983 return JIM_ERR;
7984 }
7985 #else /* JIM_DYNLIB */
7986 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7987 {
7988 JIM_NOTUSED(interp);
7989 JIM_NOTUSED(pathName);
7990
7991 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7992 return JIM_ERR;
7993 }
7994 #endif/* JIM_DYNLIB */
7995
7996 /* -----------------------------------------------------------------------------
7997 * Packages handling
7998 * ---------------------------------------------------------------------------*/
7999
8000 #define JIM_PKG_ANY_VERSION -1
8001
8002 /* Convert a string of the type "1.2" into an integer.
8003 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8004 * to the integer with value 102 */
8005 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8006 int *intPtr, int flags)
8007 {
8008 char *copy;
8009 jim_wide major, minor;
8010 char *majorStr, *minorStr, *p;
8011
8012 if (v[0] == '\0') {
8013 *intPtr = JIM_PKG_ANY_VERSION;
8014 return JIM_OK;
8015 }
8016
8017 copy = Jim_StrDup(v);
8018 p = strchr(copy, '.');
8019 if (p == NULL) goto badfmt;
8020 *p = '\0';
8021 majorStr = copy;
8022 minorStr = p + 1;
8023
8024 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8025 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8026 goto badfmt;
8027 *intPtr = (int)(major*100 + minor);
8028 Jim_Free(copy);
8029 return JIM_OK;
8030
8031 badfmt:
8032 Jim_Free(copy);
8033 if (flags & JIM_ERRMSG) {
8034 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8035 Jim_AppendStrings(interp, Jim_GetResult(interp),
8036 "invalid package version '", v, "'", NULL);
8037 }
8038 return JIM_ERR;
8039 }
8040
8041 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8042 static int JimPackageMatchVersion(int needed, int actual, int flags)
8043 {
8044 if (needed == JIM_PKG_ANY_VERSION) return 1;
8045 if (flags & JIM_MATCHVER_EXACT) {
8046 return needed == actual;
8047 } else {
8048 return needed/100 == actual/100 && (needed <= actual);
8049 }
8050 }
8051
8052 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8053 int flags)
8054 {
8055 int intVersion;
8056 /* Check if the version format is ok */
8057 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8058 return JIM_ERR;
8059 /* If the package was already provided returns an error. */
8060 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8061 if (flags & JIM_ERRMSG) {
8062 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8063 Jim_AppendStrings(interp, Jim_GetResult(interp),
8064 "package '", name, "' was already provided", NULL);
8065 }
8066 return JIM_ERR;
8067 }
8068 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8069 return JIM_OK;
8070 }
8071
8072 #ifndef JIM_ANSIC
8073
8074 #ifndef WIN32
8075 # include <sys/types.h>
8076 # include <dirent.h>
8077 #else
8078 # include <io.h>
8079 /* Posix dirent.h compatiblity layer for WIN32.
8080 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8081 * Copyright Salvatore Sanfilippo ,2005.
8082 *
8083 * Permission to use, copy, modify, and distribute this software and its
8084 * documentation for any purpose is hereby granted without fee, provided
8085 * that this copyright and permissions notice appear in all copies and
8086 * derivatives.
8087 *
8088 * This software is supplied "as is" without express or implied warranty.
8089 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8090 */
8091
8092 struct dirent {
8093 char *d_name;
8094 };
8095
8096 typedef struct DIR {
8097 long handle; /* -1 for failed rewind */
8098 struct _finddata_t info;
8099 struct dirent result; /* d_name null iff first time */
8100 char *name; /* null-terminated char string */
8101 } DIR;
8102
8103 DIR *opendir(const char *name)
8104 {
8105 DIR *dir = 0;
8106
8107 if (name && name[0]) {
8108 size_t base_length = strlen(name);
8109 const char *all = /* search pattern must end with suitable wildcard */
8110 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8111
8112 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8113 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8114 {
8115 strcat(strcpy(dir->name, name), all);
8116
8117 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8118 dir->result.d_name = 0;
8119 else { /* rollback */
8120 Jim_Free(dir->name);
8121 Jim_Free(dir);
8122 dir = 0;
8123 }
8124 } else { /* rollback */
8125 Jim_Free(dir);
8126 dir = 0;
8127 errno = ENOMEM;
8128 }
8129 } else {
8130 errno = EINVAL;
8131 }
8132 return dir;
8133 }
8134
8135 int closedir(DIR *dir)
8136 {
8137 int result = -1;
8138
8139 if (dir) {
8140 if (dir->handle != -1)
8141 result = _findclose(dir->handle);
8142 Jim_Free(dir->name);
8143 Jim_Free(dir);
8144 }
8145 if (result == -1) /* map all errors to EBADF */
8146 errno = EBADF;
8147 return result;
8148 }
8149
8150 struct dirent *readdir(DIR *dir)
8151 {
8152 struct dirent *result = 0;
8153
8154 if (dir && dir->handle != -1) {
8155 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8156 result = &dir->result;
8157 result->d_name = dir->info.name;
8158 }
8159 } else {
8160 errno = EBADF;
8161 }
8162 return result;
8163 }
8164
8165 #endif /* WIN32 */
8166
8167 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8168 int prefixc, const char *pkgName, int pkgVer, int flags)
8169 {
8170 int bestVer = -1, i;
8171 int pkgNameLen = strlen(pkgName);
8172 char *bestPackage = NULL;
8173 struct dirent *de;
8174
8175 for (i = 0; i < prefixc; i++) {
8176 DIR *dir;
8177 char buf[JIM_PATH_LEN];
8178 int prefixLen;
8179
8180 if (prefixes[i] == NULL) continue;
8181 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8182 buf[JIM_PATH_LEN-1] = '\0';
8183 prefixLen = strlen(buf);
8184 if (prefixLen && buf[prefixLen-1] == '/')
8185 buf[prefixLen-1] = '\0';
8186
8187 if ((dir = opendir(buf)) == NULL) continue;
8188 while ((de = readdir(dir)) != NULL) {
8189 char *fileName = de->d_name;
8190 int fileNameLen = strlen(fileName);
8191
8192 if (strncmp(fileName, "jim-", 4) == 0 &&
8193 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8194 *(fileName + 4+pkgNameLen) == '-' &&
8195 fileNameLen > 4 && /* note that this is not really useful */
8196 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8197 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8198 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8199 {
8200 char ver[6]; /* xx.yy < nulterm> */
8201 char *p = strrchr(fileName, '.');
8202 int verLen, fileVer;
8203
8204 verLen = p - (fileName + 4+pkgNameLen + 1);
8205 if (verLen < 3 || verLen > 5) continue;
8206 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8207 ver[verLen] = '\0';
8208 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8209 != JIM_OK) continue;
8210 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8211 (bestVer == -1 || bestVer < fileVer))
8212 {
8213 bestVer = fileVer;
8214 Jim_Free(bestPackage);
8215 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8216 sprintf(bestPackage, "%s/%s", buf, fileName);
8217 }
8218 }
8219 }
8220 closedir(dir);
8221 }
8222 return bestPackage;
8223 }
8224
8225 #else /* JIM_ANSIC */
8226
8227 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8228 int prefixc, const char *pkgName, int pkgVer, int flags)
8229 {
8230 JIM_NOTUSED(interp);
8231 JIM_NOTUSED(prefixes);
8232 JIM_NOTUSED(prefixc);
8233 JIM_NOTUSED(pkgName);
8234 JIM_NOTUSED(pkgVer);
8235 JIM_NOTUSED(flags);
8236 return NULL;
8237 }
8238
8239 #endif /* JIM_ANSIC */
8240
8241 /* Search for a suitable package under every dir specified by jim_libpath
8242 * and load it if possible. If a suitable package was loaded with success
8243 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8244 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8245 int flags)
8246 {
8247 Jim_Obj *libPathObjPtr;
8248 char **prefixes, *best;
8249 int prefixc, i, retCode = JIM_OK;
8250
8251 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8252 if (libPathObjPtr == NULL) {
8253 prefixc = 0;
8254 libPathObjPtr = NULL;
8255 } else {
8256 Jim_IncrRefCount(libPathObjPtr);
8257 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8258 }
8259
8260 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8261 for (i = 0; i < prefixc; i++) {
8262 Jim_Obj *prefixObjPtr;
8263 if (Jim_ListIndex(interp, libPathObjPtr, i,
8264 &prefixObjPtr, JIM_NONE) != JIM_OK)
8265 {
8266 prefixes[i] = NULL;
8267 continue;
8268 }
8269 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8270 }
8271 /* Scan every directory to find the "best" package. */
8272 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8273 if (best != NULL) {
8274 char *p = strrchr(best, '.');
8275 /* Try to load/source it */
8276 if (p && strcmp(p, ".tcl") == 0) {
8277 retCode = Jim_EvalFile(interp, best);
8278 } else {
8279 retCode = Jim_LoadLibrary(interp, best);
8280 }
8281 } else {
8282 retCode = JIM_ERR;
8283 }
8284 Jim_Free(best);
8285 for (i = 0; i < prefixc; i++)
8286 Jim_Free(prefixes[i]);
8287 Jim_Free(prefixes);
8288 if (libPathObjPtr)
8289 Jim_DecrRefCount(interp, libPathObjPtr);
8290 return retCode;
8291 }
8292
8293 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8294 const char *ver, int flags)
8295 {
8296 Jim_HashEntry *he;
8297 int requiredVer;
8298
8299 /* Start with an empty error string */
8300 Jim_SetResultString(interp, "", 0);
8301
8302 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8303 return NULL;
8304 he = Jim_FindHashEntry(&interp->packages, name);
8305 if (he == NULL) {
8306 /* Try to load the package. */
8307 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8308 he = Jim_FindHashEntry(&interp->packages, name);
8309 if (he == NULL) {
8310 return "?";
8311 }
8312 return he->val;
8313 }
8314 /* No way... return an error. */
8315 if (flags & JIM_ERRMSG) {
8316 int len;
8317 Jim_GetString(Jim_GetResult(interp), &len);
8318 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8319 "Can't find package '", name, "'", NULL);
8320 }
8321 return NULL;
8322 } else {
8323 int actualVer;
8324 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8325 != JIM_OK)
8326 {
8327 return NULL;
8328 }
8329 /* Check if version matches. */
8330 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8331 Jim_AppendStrings(interp, Jim_GetResult(interp),
8332 "Package '", name, "' already loaded, but with version ",
8333 he->val, NULL);
8334 return NULL;
8335 }
8336 return he->val;
8337 }
8338 }
8339
8340 /* -----------------------------------------------------------------------------
8341 * Eval
8342 * ---------------------------------------------------------------------------*/
8343 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8344 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8345
8346 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8347 Jim_Obj *const *argv);
8348
8349 /* Handle calls to the [unknown] command */
8350 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8351 {
8352 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8353 int retCode;
8354
8355 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8356 * done here
8357 */
8358 if (interp->unknown_called) {
8359 return JIM_ERR;
8360 }
8361
8362 /* If the [unknown] command does not exists returns
8363 * just now */
8364 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8365 return JIM_ERR;
8366
8367 /* The object interp->unknown just contains
8368 * the "unknown" string, it is used in order to
8369 * avoid to lookup the unknown command every time
8370 * but instread to cache the result. */
8371 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8372 v = sv;
8373 else
8374 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8375 /* Make a copy of the arguments vector, but shifted on
8376 * the right of one position. The command name of the
8377 * command will be instead the first argument of the
8378 * [unknonw] call. */
8379 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8380 v[0] = interp->unknown;
8381 /* Call it */
8382 interp->unknown_called++;
8383 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8384 interp->unknown_called--;
8385
8386 /* Clean up */
8387 if (v != sv)
8388 Jim_Free(v);
8389 return retCode;
8390 }
8391
8392 /* Eval the object vector 'objv' composed of 'objc' elements.
8393 * Every element is used as single argument.
8394 * Jim_EvalObj() will call this function every time its object
8395 * argument is of "list" type, with no string representation.
8396 *
8397 * This is possible because the string representation of a
8398 * list object generated by the UpdateStringOfList is made
8399 * in a way that ensures that every list element is a different
8400 * command argument. */
8401 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8402 {
8403 int i, retcode;
8404 Jim_Cmd *cmdPtr;
8405
8406 /* Incr refcount of arguments. */
8407 for (i = 0; i < objc; i++)
8408 Jim_IncrRefCount(objv[i]);
8409 /* Command lookup */
8410 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8411 if (cmdPtr == NULL) {
8412 retcode = JimUnknown(interp, objc, objv);
8413 } else {
8414 /* Call it -- Make sure result is an empty object. */
8415 Jim_SetEmptyResult(interp);
8416 if (cmdPtr->cmdProc) {
8417 interp->cmdPrivData = cmdPtr->privData;
8418 retcode = cmdPtr->cmdProc(interp, objc, objv);
8419 if (retcode == JIM_ERR_ADDSTACK) {
8420 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8421 retcode = JIM_ERR;
8422 }
8423 } else {
8424 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8425 if (retcode == JIM_ERR) {
8426 JimAppendStackTrace(interp,
8427 Jim_GetString(objv[0], NULL), "", 1);
8428 }
8429 }
8430 }
8431 /* Decr refcount of arguments and return the retcode */
8432 for (i = 0; i < objc; i++)
8433 Jim_DecrRefCount(interp, objv[i]);
8434 return retcode;
8435 }
8436
8437 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8438 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8439 * The returned object has refcount = 0. */
8440 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8441 int tokens, Jim_Obj **objPtrPtr)
8442 {
8443 int totlen = 0, i, retcode;
8444 Jim_Obj **intv;
8445 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8446 Jim_Obj *objPtr;
8447 char *s;
8448
8449 if (tokens <= JIM_EVAL_SINTV_LEN)
8450 intv = sintv;
8451 else
8452 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8453 tokens);
8454 /* Compute every token forming the argument
8455 * in the intv objects vector. */
8456 for (i = 0; i < tokens; i++) {
8457 switch (token[i].type) {
8458 case JIM_TT_ESC:
8459 case JIM_TT_STR:
8460 intv[i] = token[i].objPtr;
8461 break;
8462 case JIM_TT_VAR:
8463 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8464 if (!intv[i]) {
8465 retcode = JIM_ERR;
8466 goto err;
8467 }
8468 break;
8469 case JIM_TT_DICTSUGAR:
8470 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8471 if (!intv[i]) {
8472 retcode = JIM_ERR;
8473 goto err;
8474 }
8475 break;
8476 case JIM_TT_CMD:
8477 retcode = Jim_EvalObj(interp, token[i].objPtr);
8478 if (retcode != JIM_OK)
8479 goto err;
8480 intv[i] = Jim_GetResult(interp);
8481 break;
8482 default:
8483 Jim_Panic(interp,
8484 "default token type reached "
8485 "in Jim_InterpolateTokens().");
8486 break;
8487 }
8488 Jim_IncrRefCount(intv[i]);
8489 /* Make sure there is a valid
8490 * string rep, and add the string
8491 * length to the total legnth. */
8492 Jim_GetString(intv[i], NULL);
8493 totlen += intv[i]->length;
8494 }
8495 /* Concatenate every token in an unique
8496 * object. */
8497 objPtr = Jim_NewStringObjNoAlloc(interp,
8498 NULL, 0);
8499 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8500 objPtr->length = totlen;
8501 for (i = 0; i < tokens; i++) {
8502 memcpy(s, intv[i]->bytes, intv[i]->length);
8503 s += intv[i]->length;
8504 Jim_DecrRefCount(interp, intv[i]);
8505 }
8506 objPtr->bytes[totlen] = '\0';
8507 /* Free the intv vector if not static. */
8508 if (tokens > JIM_EVAL_SINTV_LEN)
8509 Jim_Free(intv);
8510 *objPtrPtr = objPtr;
8511 return JIM_OK;
8512 err:
8513 i--;
8514 for (; i >= 0; i--)
8515 Jim_DecrRefCount(interp, intv[i]);
8516 if (tokens > JIM_EVAL_SINTV_LEN)
8517 Jim_Free(intv);
8518 return retcode;
8519 }
8520
8521 /* Helper of Jim_EvalObj() to perform argument expansion.
8522 * Basically this function append an argument to 'argv'
8523 * (and increments argc by reference accordingly), performing
8524 * expansion of the list object if 'expand' is non-zero, or
8525 * just adding objPtr to argv if 'expand' is zero. */
8526 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8527 int *argcPtr, int expand, Jim_Obj *objPtr)
8528 {
8529 if (!expand) {
8530 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8531 /* refcount of objPtr not incremented because
8532 * we are actually transfering a reference from
8533 * the old 'argv' to the expanded one. */
8534 (*argv)[*argcPtr] = objPtr;
8535 (*argcPtr)++;
8536 } else {
8537 int len, i;
8538
8539 Jim_ListLength(interp, objPtr, &len);
8540 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8541 for (i = 0; i < len; i++) {
8542 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8543 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8544 (*argcPtr)++;
8545 }
8546 /* The original object reference is no longer needed,
8547 * after the expansion it is no longer present on
8548 * the argument vector, but the single elements are
8549 * in its place. */
8550 Jim_DecrRefCount(interp, objPtr);
8551 }
8552 }
8553
8554 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8555 {
8556 int i, j = 0, len;
8557 ScriptObj *script;
8558 ScriptToken *token;
8559 int *cs; /* command structure array */
8560 int retcode = JIM_OK;
8561 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8562
8563 interp->errorFlag = 0;
8564
8565 /* If the object is of type "list" and there is no
8566 * string representation for this object, we can call
8567 * a specialized version of Jim_EvalObj() */
8568 if (scriptObjPtr->typePtr == &listObjType &&
8569 scriptObjPtr->internalRep.listValue.len &&
8570 scriptObjPtr->bytes == NULL) {
8571 Jim_IncrRefCount(scriptObjPtr);
8572 retcode = Jim_EvalObjVector(interp,
8573 scriptObjPtr->internalRep.listValue.len,
8574 scriptObjPtr->internalRep.listValue.ele);
8575 Jim_DecrRefCount(interp, scriptObjPtr);
8576 return retcode;
8577 }
8578
8579 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8580 script = Jim_GetScript(interp, scriptObjPtr);
8581 /* Now we have to make sure the internal repr will not be
8582 * freed on shimmering.
8583 *
8584 * Think for example to this:
8585 *
8586 * set x {llength $x; ... some more code ...}; eval $x
8587 *
8588 * In order to preserve the internal rep, we increment the
8589 * inUse field of the script internal rep structure. */
8590 script->inUse++;
8591
8592 token = script->token;
8593 len = script->len;
8594 cs = script->cmdStruct;
8595 i = 0; /* 'i' is the current token index. */
8596
8597 /* Reset the interpreter result. This is useful to
8598 * return the emtpy result in the case of empty program. */
8599 Jim_SetEmptyResult(interp);
8600
8601 /* Execute every command sequentially, returns on
8602 * error (i.e. if a command does not return JIM_OK) */
8603 while (i < len) {
8604 int expand = 0;
8605 int argc = *cs++; /* Get the number of arguments */
8606 Jim_Cmd *cmd;
8607
8608 /* Set the expand flag if needed. */
8609 if (argc == -1) {
8610 expand++;
8611 argc = *cs++;
8612 }
8613 /* Allocate the arguments vector */
8614 if (argc <= JIM_EVAL_SARGV_LEN)
8615 argv = sargv;
8616 else
8617 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8618 /* Populate the arguments objects. */
8619 for (j = 0; j < argc; j++) {
8620 int tokens = *cs++;
8621
8622 /* tokens is negative if expansion is needed.
8623 * for this argument. */
8624 if (tokens < 0) {
8625 tokens = (-tokens)-1;
8626 i++;
8627 }
8628 if (tokens == 1) {
8629 /* Fast path if the token does not
8630 * need interpolation */
8631 switch (token[i].type) {
8632 case JIM_TT_ESC:
8633 case JIM_TT_STR:
8634 argv[j] = token[i].objPtr;
8635 break;
8636 case JIM_TT_VAR:
8637 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8638 JIM_ERRMSG);
8639 if (!tmpObjPtr) {
8640 retcode = JIM_ERR;
8641 goto err;
8642 }
8643 argv[j] = tmpObjPtr;
8644 break;
8645 case JIM_TT_DICTSUGAR:
8646 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8647 if (!tmpObjPtr) {
8648 retcode = JIM_ERR;
8649 goto err;
8650 }
8651 argv[j] = tmpObjPtr;
8652 break;
8653 case JIM_TT_CMD:
8654 retcode = Jim_EvalObj(interp, token[i].objPtr);
8655 if (retcode != JIM_OK)
8656 goto err;
8657 argv[j] = Jim_GetResult(interp);
8658 break;
8659 default:
8660 Jim_Panic(interp,
8661 "default token type reached "
8662 "in Jim_EvalObj().");
8663 break;
8664 }
8665 Jim_IncrRefCount(argv[j]);
8666 i += 2;
8667 } else {
8668 /* For interpolation we call an helper
8669 * function doing the work for us. */
8670 if ((retcode = Jim_InterpolateTokens(interp,
8671 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8672 {
8673 goto err;
8674 }
8675 argv[j] = tmpObjPtr;
8676 Jim_IncrRefCount(argv[j]);
8677 i += tokens + 1;
8678 }
8679 }
8680 /* Handle {expand} expansion */
8681 if (expand) {
8682 int *ecs = cs - argc;
8683 int eargc = 0;
8684 Jim_Obj **eargv = NULL;
8685
8686 for (j = 0; j < argc; j++) {
8687 Jim_ExpandArgument(interp, &eargv, &eargc,
8688 ecs[j] < 0, argv[j]);
8689 }
8690 if (argv != sargv)
8691 Jim_Free(argv);
8692 argc = eargc;
8693 argv = eargv;
8694 j = argc;
8695 if (argc == 0) {
8696 /* Nothing to do with zero args. */
8697 Jim_Free(eargv);
8698 continue;
8699 }
8700 }
8701 /* Lookup the command to call */
8702 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8703 if (cmd != NULL) {
8704 /* Call it -- Make sure result is an empty object. */
8705 Jim_SetEmptyResult(interp);
8706 if (cmd->cmdProc) {
8707 interp->cmdPrivData = cmd->privData;
8708 retcode = cmd->cmdProc(interp, argc, argv);
8709 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8710 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8711 retcode = JIM_ERR;
8712 }
8713 } else {
8714 retcode = JimCallProcedure(interp, cmd, argc, argv);
8715 if (retcode == JIM_ERR) {
8716 JimAppendStackTrace(interp,
8717 Jim_GetString(argv[0], NULL), script->fileName,
8718 token[i-argc*2].linenr);
8719 }
8720 }
8721 } else {
8722 /* Call [unknown] */
8723 retcode = JimUnknown(interp, argc, argv);
8724 if (retcode == JIM_ERR) {
8725 JimAppendStackTrace(interp,
8726 "", script->fileName,
8727 token[i-argc*2].linenr);
8728 }
8729 }
8730 if (retcode != JIM_OK) {
8731 i -= argc*2; /* point to the command name. */
8732 goto err;
8733 }
8734 /* Decrement the arguments count */
8735 for (j = 0; j < argc; j++) {
8736 Jim_DecrRefCount(interp, argv[j]);
8737 }
8738
8739 if (argv != sargv) {
8740 Jim_Free(argv);
8741 argv = NULL;
8742 }
8743 }
8744 /* Note that we don't have to decrement inUse, because the
8745 * following code transfers our use of the reference again to
8746 * the script object. */
8747 j = 0; /* on normal termination, the argv array is already
8748 Jim_DecrRefCount-ed. */
8749 err:
8750 /* Handle errors. */
8751 if (retcode == JIM_ERR && !interp->errorFlag) {
8752 interp->errorFlag = 1;
8753 JimSetErrorFileName(interp, script->fileName);
8754 JimSetErrorLineNumber(interp, token[i].linenr);
8755 JimResetStackTrace(interp);
8756 }
8757 Jim_FreeIntRep(interp, scriptObjPtr);
8758 scriptObjPtr->typePtr = &scriptObjType;
8759 Jim_SetIntRepPtr(scriptObjPtr, script);
8760 Jim_DecrRefCount(interp, scriptObjPtr);
8761 for (i = 0; i < j; i++) {
8762 Jim_DecrRefCount(interp, argv[i]);
8763 }
8764 if (argv != sargv)
8765 Jim_Free(argv);
8766 return retcode;
8767 }
8768
8769 /* Call a procedure implemented in Tcl.
8770 * It's possible to speed-up a lot this function, currently
8771 * the callframes are not cached, but allocated and
8772 * destroied every time. What is expecially costly is
8773 * to create/destroy the local vars hash table every time.
8774 *
8775 * This can be fixed just implementing callframes caching
8776 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8777 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8778 Jim_Obj *const *argv)
8779 {
8780 int i, retcode;
8781 Jim_CallFrame *callFramePtr;
8782 int num_args;
8783
8784 /* Check arity */
8785 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8786 argc > cmd->arityMax)) {
8787 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8788 Jim_AppendStrings(interp, objPtr,
8789 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8790 (cmd->arityMin > 1) ? " " : "",
8791 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8792 Jim_SetResult(interp, objPtr);
8793 return JIM_ERR;
8794 }
8795 /* Check if there are too nested calls */
8796 if (interp->numLevels == interp->maxNestingDepth) {
8797 Jim_SetResultString(interp,
8798 "Too many nested calls. Infinite recursion?", -1);
8799 return JIM_ERR;
8800 }
8801 /* Create a new callframe */
8802 callFramePtr = JimCreateCallFrame(interp);
8803 callFramePtr->parentCallFrame = interp->framePtr;
8804 callFramePtr->argv = argv;
8805 callFramePtr->argc = argc;
8806 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8807 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8808 callFramePtr->staticVars = cmd->staticVars;
8809 Jim_IncrRefCount(cmd->argListObjPtr);
8810 Jim_IncrRefCount(cmd->bodyObjPtr);
8811 interp->framePtr = callFramePtr;
8812 interp->numLevels ++;
8813
8814 /* Set arguments */
8815 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8816
8817 /* If last argument is 'args', don't set it here */
8818 if (cmd->arityMax == -1) {
8819 num_args--;
8820 }
8821
8822 for (i = 0; i < num_args; i++) {
8823 Jim_Obj *argObjPtr;
8824 Jim_Obj *nameObjPtr;
8825 Jim_Obj *valueObjPtr;
8826
8827 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8828 if (i + 1 >= cmd->arityMin) {
8829 /* The name is the first element of the list */
8830 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8831 }
8832 else {
8833 /* The element arg is the name */
8834 nameObjPtr = argObjPtr;
8835 }
8836
8837 if (i + 1 >= argc) {
8838 /* No more values, so use default */
8839 /* The value is the second element of the list */
8840 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8841 }
8842 else {
8843 valueObjPtr = argv[i + 1];
8844 }
8845 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8846 }
8847 /* Set optional arguments */
8848 if (cmd->arityMax == -1) {
8849 Jim_Obj *listObjPtr, *objPtr;
8850
8851 i++;
8852 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8853 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8854 Jim_SetVariable(interp, objPtr, listObjPtr);
8855 }
8856 /* Eval the body */
8857 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8858
8859 /* Destroy the callframe */
8860 interp->numLevels --;
8861 interp->framePtr = interp->framePtr->parentCallFrame;
8862 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8863 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8864 } else {
8865 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8866 }
8867 /* Handle the JIM_EVAL return code */
8868 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8869 int savedLevel = interp->evalRetcodeLevel;
8870
8871 interp->evalRetcodeLevel = interp->numLevels;
8872 while (retcode == JIM_EVAL) {
8873 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8874 Jim_IncrRefCount(resultScriptObjPtr);
8875 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8876 Jim_DecrRefCount(interp, resultScriptObjPtr);
8877 }
8878 interp->evalRetcodeLevel = savedLevel;
8879 }
8880 /* Handle the JIM_RETURN return code */
8881 if (retcode == JIM_RETURN) {
8882 retcode = interp->returnCode;
8883 interp->returnCode = JIM_OK;
8884 }
8885 return retcode;
8886 }
8887
8888 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8889 {
8890 int retval;
8891 Jim_Obj *scriptObjPtr;
8892
8893 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8894 Jim_IncrRefCount(scriptObjPtr);
8895
8896
8897 if (filename ){
8898 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno );
8899 }
8900
8901 retval = Jim_EvalObj(interp, scriptObjPtr);
8902 Jim_DecrRefCount(interp, scriptObjPtr);
8903 return retval;
8904 }
8905
8906 int Jim_Eval(Jim_Interp *interp, const char *script)
8907 {
8908 return Jim_Eval_Named(interp, script, NULL, 0 );
8909 }
8910
8911
8912
8913 /* Execute script in the scope of the global level */
8914 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8915 {
8916 Jim_CallFrame *savedFramePtr;
8917 int retval;
8918
8919 savedFramePtr = interp->framePtr;
8920 interp->framePtr = interp->topFramePtr;
8921 retval = Jim_Eval(interp, script);
8922 interp->framePtr = savedFramePtr;
8923 return retval;
8924 }
8925
8926 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8927 {
8928 Jim_CallFrame *savedFramePtr;
8929 int retval;
8930
8931 savedFramePtr = interp->framePtr;
8932 interp->framePtr = interp->topFramePtr;
8933 retval = Jim_EvalObj(interp, scriptObjPtr);
8934 interp->framePtr = savedFramePtr;
8935 /* Try to report the error (if any) via the bgerror proc */
8936 if (retval != JIM_OK) {
8937 Jim_Obj *objv[2];
8938
8939 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8940 objv[1] = Jim_GetResult(interp);
8941 Jim_IncrRefCount(objv[0]);
8942 Jim_IncrRefCount(objv[1]);
8943 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8944 /* Report the error to stderr. */
8945 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8946 Jim_PrintErrorMessage(interp);
8947 }
8948 Jim_DecrRefCount(interp, objv[0]);
8949 Jim_DecrRefCount(interp, objv[1]);
8950 }
8951 return retval;
8952 }
8953
8954 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8955 {
8956 char *prg = NULL;
8957 FILE *fp;
8958 int nread, totread, maxlen, buflen;
8959 int retval;
8960 Jim_Obj *scriptObjPtr;
8961
8962 if ((fp = fopen(filename, "r")) == NULL) {
8963 const int cwd_len = 2048;
8964 char *cwd = malloc(cwd_len);
8965 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8966 if (!getcwd(cwd, cwd_len )) strcpy(cwd, "unknown");
8967 Jim_AppendStrings(interp, Jim_GetResult(interp),
8968 "Error loading script \"", filename, "\"",
8969 " cwd: ", cwd,
8970 " err: ", strerror(errno), NULL);
8971 free(cwd);
8972 return JIM_ERR;
8973 }
8974 buflen = 1024;
8975 maxlen = totread = 0;
8976 while (1) {
8977 if (maxlen < totread + buflen + 1) {
8978 maxlen = totread + buflen + 1;
8979 prg = Jim_Realloc(prg, maxlen);
8980 }
8981 /* do not use Jim_fread() - this is really a file */
8982 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8983 totread += nread;
8984 }
8985 prg[totread] = '\0';
8986 /* do not use Jim_fclose() - this is really a file */
8987 fclose(fp);
8988
8989 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8990 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8991 Jim_IncrRefCount(scriptObjPtr);
8992 retval = Jim_EvalObj(interp, scriptObjPtr);
8993 Jim_DecrRefCount(interp, scriptObjPtr);
8994 return retval;
8995 }
8996
8997 /* -----------------------------------------------------------------------------
8998 * Subst
8999 * ---------------------------------------------------------------------------*/
9000 static int JimParseSubstStr(struct JimParserCtx *pc)
9001 {
9002 pc->tstart = pc->p;
9003 pc->tline = pc->linenr;
9004 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9005 pc->p++; pc->len--;
9006 }
9007 pc->tend = pc->p-1;
9008 pc->tt = JIM_TT_ESC;
9009 return JIM_OK;
9010 }
9011
9012 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9013 {
9014 int retval;
9015
9016 if (pc->len == 0) {
9017 pc->tstart = pc->tend = pc->p;
9018 pc->tline = pc->linenr;
9019 pc->tt = JIM_TT_EOL;
9020 pc->eof = 1;
9021 return JIM_OK;
9022 }
9023 switch (*pc->p) {
9024 case '[':
9025 retval = JimParseCmd(pc);
9026 if (flags & JIM_SUBST_NOCMD) {
9027 pc->tstart--;
9028 pc->tend++;
9029 pc->tt = (flags & JIM_SUBST_NOESC) ?
9030 JIM_TT_STR : JIM_TT_ESC;
9031 }
9032 return retval;
9033 break;
9034 case '$':
9035 if (JimParseVar(pc) == JIM_ERR) {
9036 pc->tstart = pc->tend = pc->p++; pc->len--;
9037 pc->tline = pc->linenr;
9038 pc->tt = JIM_TT_STR;
9039 } else {
9040 if (flags & JIM_SUBST_NOVAR) {
9041 pc->tstart--;
9042 if (flags & JIM_SUBST_NOESC)
9043 pc->tt = JIM_TT_STR;
9044 else
9045 pc->tt = JIM_TT_ESC;
9046 if (*pc->tstart == '{') {
9047 pc->tstart--;
9048 if (*(pc->tend + 1))
9049 pc->tend++;
9050 }
9051 }
9052 }
9053 break;
9054 default:
9055 retval = JimParseSubstStr(pc);
9056 if (flags & JIM_SUBST_NOESC)
9057 pc->tt = JIM_TT_STR;
9058 return retval;
9059 break;
9060 }
9061 return JIM_OK;
9062 }
9063
9064 /* The subst object type reuses most of the data structures and functions
9065 * of the script object. Script's data structures are a bit more complex
9066 * for what is needed for [subst]itution tasks, but the reuse helps to
9067 * deal with a single data structure at the cost of some more memory
9068 * usage for substitutions. */
9069 static Jim_ObjType substObjType = {
9070 "subst",
9071 FreeScriptInternalRep,
9072 DupScriptInternalRep,
9073 NULL,
9074 JIM_TYPE_REFERENCES,
9075 };
9076
9077 /* This method takes the string representation of an object
9078 * as a Tcl string where to perform [subst]itution, and generates
9079 * the pre-parsed internal representation. */
9080 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9081 {
9082 int scriptTextLen;
9083 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9084 struct JimParserCtx parser;
9085 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9086
9087 script->len = 0;
9088 script->csLen = 0;
9089 script->commands = 0;
9090 script->token = NULL;
9091 script->cmdStruct = NULL;
9092 script->inUse = 1;
9093 script->substFlags = flags;
9094 script->fileName = NULL;
9095
9096 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9097 while (1) {
9098 char *token;
9099 int len, type, linenr;
9100
9101 JimParseSubst(&parser, flags);
9102 if (JimParserEof(&parser)) break;
9103 token = JimParserGetToken(&parser, &len, &type, &linenr);
9104 ScriptObjAddToken(interp, script, token, len, type,
9105 NULL, linenr);
9106 }
9107 /* Free the old internal rep and set the new one. */
9108 Jim_FreeIntRep(interp, objPtr);
9109 Jim_SetIntRepPtr(objPtr, script);
9110 objPtr->typePtr = &scriptObjType;
9111 return JIM_OK;
9112 }
9113
9114 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9115 {
9116 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9117
9118 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9119 SetSubstFromAny(interp, objPtr, flags);
9120 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9121 }
9122
9123 /* Performs commands,variables,blackslashes substitution,
9124 * storing the result object (with refcount 0) into
9125 * resObjPtrPtr. */
9126 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9127 Jim_Obj **resObjPtrPtr, int flags)
9128 {
9129 ScriptObj *script;
9130 ScriptToken *token;
9131 int i, len, retcode = JIM_OK;
9132 Jim_Obj *resObjPtr, *savedResultObjPtr;
9133
9134 script = Jim_GetSubst(interp, substObjPtr, flags);
9135 #ifdef JIM_OPTIMIZATION
9136 /* Fast path for a very common case with array-alike syntax,
9137 * that's: $foo($bar) */
9138 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9139 Jim_Obj *varObjPtr = script->token[0].objPtr;
9140
9141 Jim_IncrRefCount(varObjPtr);
9142 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9143 if (resObjPtr == NULL) {
9144 Jim_DecrRefCount(interp, varObjPtr);
9145 return JIM_ERR;
9146 }
9147 Jim_DecrRefCount(interp, varObjPtr);
9148 *resObjPtrPtr = resObjPtr;
9149 return JIM_OK;
9150 }
9151 #endif
9152
9153 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9154 /* In order to preserve the internal rep, we increment the
9155 * inUse field of the script internal rep structure. */
9156 script->inUse++;
9157
9158 token = script->token;
9159 len = script->len;
9160
9161 /* Save the interp old result, to set it again before
9162 * to return. */
9163 savedResultObjPtr = interp->result;
9164 Jim_IncrRefCount(savedResultObjPtr);
9165
9166 /* Perform the substitution. Starts with an empty object
9167 * and adds every token (performing the appropriate
9168 * var/command/escape substitution). */
9169 resObjPtr = Jim_NewStringObj(interp, "", 0);
9170 for (i = 0; i < len; i++) {
9171 Jim_Obj *objPtr;
9172
9173 switch (token[i].type) {
9174 case JIM_TT_STR:
9175 case JIM_TT_ESC:
9176 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9177 break;
9178 case JIM_TT_VAR:
9179 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9180 if (objPtr == NULL) goto err;
9181 Jim_IncrRefCount(objPtr);
9182 Jim_AppendObj(interp, resObjPtr, objPtr);
9183 Jim_DecrRefCount(interp, objPtr);
9184 break;
9185 case JIM_TT_DICTSUGAR:
9186 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9187 if (!objPtr) {
9188 retcode = JIM_ERR;
9189 goto err;
9190 }
9191 break;
9192 case JIM_TT_CMD:
9193 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9194 goto err;
9195 Jim_AppendObj(interp, resObjPtr, interp->result);
9196 break;
9197 default:
9198 Jim_Panic(interp,
9199 "default token type (%d) reached "
9200 "in Jim_SubstObj().", token[i].type);
9201 break;
9202 }
9203 }
9204 ok:
9205 if (retcode == JIM_OK)
9206 Jim_SetResult(interp, savedResultObjPtr);
9207 Jim_DecrRefCount(interp, savedResultObjPtr);
9208 /* Note that we don't have to decrement inUse, because the
9209 * following code transfers our use of the reference again to
9210 * the script object. */
9211 Jim_FreeIntRep(interp, substObjPtr);
9212 substObjPtr->typePtr = &scriptObjType;
9213 Jim_SetIntRepPtr(substObjPtr, script);
9214 Jim_DecrRefCount(interp, substObjPtr);
9215 *resObjPtrPtr = resObjPtr;
9216 return retcode;
9217 err:
9218 Jim_FreeNewObj(interp, resObjPtr);
9219 retcode = JIM_ERR;
9220 goto ok;
9221 }
9222
9223 /* -----------------------------------------------------------------------------
9224 * API Input/Export functions
9225 * ---------------------------------------------------------------------------*/
9226
9227 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9228 {
9229 Jim_HashEntry *he;
9230
9231 he = Jim_FindHashEntry(&interp->stub, funcname);
9232 if (!he)
9233 return JIM_ERR;
9234 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9235 return JIM_OK;
9236 }
9237
9238 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9239 {
9240 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9241 }
9242
9243 #define JIM_REGISTER_API(name) \
9244 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9245
9246 void JimRegisterCoreApi(Jim_Interp *interp)
9247 {
9248 interp->getApiFuncPtr = Jim_GetApi;
9249 JIM_REGISTER_API(Alloc);
9250 JIM_REGISTER_API(Free);
9251 JIM_REGISTER_API(Eval);
9252 JIM_REGISTER_API(Eval_Named);
9253 JIM_REGISTER_API(EvalGlobal);
9254 JIM_REGISTER_API(EvalFile);
9255 JIM_REGISTER_API(EvalObj);
9256 JIM_REGISTER_API(EvalObjBackground);
9257 JIM_REGISTER_API(EvalObjVector);
9258 JIM_REGISTER_API(InitHashTable);
9259 JIM_REGISTER_API(ExpandHashTable);
9260 JIM_REGISTER_API(AddHashEntry);
9261 JIM_REGISTER_API(ReplaceHashEntry);
9262 JIM_REGISTER_API(DeleteHashEntry);
9263 JIM_REGISTER_API(FreeHashTable);
9264 JIM_REGISTER_API(FindHashEntry);
9265 JIM_REGISTER_API(ResizeHashTable);
9266 JIM_REGISTER_API(GetHashTableIterator);
9267 JIM_REGISTER_API(NextHashEntry);
9268 JIM_REGISTER_API(NewObj);
9269 JIM_REGISTER_API(FreeObj);
9270 JIM_REGISTER_API(InvalidateStringRep);
9271 JIM_REGISTER_API(InitStringRep);
9272 JIM_REGISTER_API(DuplicateObj);
9273 JIM_REGISTER_API(GetString);
9274 JIM_REGISTER_API(Length);
9275 JIM_REGISTER_API(InvalidateStringRep);
9276 JIM_REGISTER_API(NewStringObj);
9277 JIM_REGISTER_API(NewStringObjNoAlloc);
9278 JIM_REGISTER_API(AppendString);
9279 JIM_REGISTER_API(AppendString_sprintf);
9280 JIM_REGISTER_API(AppendObj);
9281 JIM_REGISTER_API(AppendStrings);
9282 JIM_REGISTER_API(StringEqObj);
9283 JIM_REGISTER_API(StringMatchObj);
9284 JIM_REGISTER_API(StringRangeObj);
9285 JIM_REGISTER_API(FormatString);
9286 JIM_REGISTER_API(CompareStringImmediate);
9287 JIM_REGISTER_API(NewReference);
9288 JIM_REGISTER_API(GetReference);
9289 JIM_REGISTER_API(SetFinalizer);
9290 JIM_REGISTER_API(GetFinalizer);
9291 JIM_REGISTER_API(CreateInterp);
9292 JIM_REGISTER_API(FreeInterp);
9293 JIM_REGISTER_API(GetExitCode);
9294 JIM_REGISTER_API(SetStdin);
9295 JIM_REGISTER_API(SetStdout);
9296 JIM_REGISTER_API(SetStderr);
9297 JIM_REGISTER_API(CreateCommand);
9298 JIM_REGISTER_API(CreateProcedure);
9299 JIM_REGISTER_API(DeleteCommand);
9300 JIM_REGISTER_API(RenameCommand);
9301 JIM_REGISTER_API(GetCommand);
9302 JIM_REGISTER_API(SetVariable);
9303 JIM_REGISTER_API(SetVariableStr);
9304 JIM_REGISTER_API(SetGlobalVariableStr);
9305 JIM_REGISTER_API(SetVariableStrWithStr);
9306 JIM_REGISTER_API(SetVariableLink);
9307 JIM_REGISTER_API(GetVariable);
9308 JIM_REGISTER_API(GetCallFrameByLevel);
9309 JIM_REGISTER_API(Collect);
9310 JIM_REGISTER_API(CollectIfNeeded);
9311 JIM_REGISTER_API(GetIndex);
9312 JIM_REGISTER_API(NewListObj);
9313 JIM_REGISTER_API(ListAppendElement);
9314 JIM_REGISTER_API(ListAppendList);
9315 JIM_REGISTER_API(ListLength);
9316 JIM_REGISTER_API(ListIndex);
9317 JIM_REGISTER_API(SetListIndex);
9318 JIM_REGISTER_API(ConcatObj);
9319 JIM_REGISTER_API(NewDictObj);
9320 JIM_REGISTER_API(DictKey);
9321 JIM_REGISTER_API(DictKeysVector);
9322 JIM_REGISTER_API(GetIndex);
9323 JIM_REGISTER_API(GetReturnCode);
9324 JIM_REGISTER_API(EvalExpression);
9325 JIM_REGISTER_API(GetBoolFromExpr);
9326 JIM_REGISTER_API(GetWide);
9327 JIM_REGISTER_API(GetLong);
9328 JIM_REGISTER_API(SetWide);
9329 JIM_REGISTER_API(NewIntObj);
9330 JIM_REGISTER_API(GetDouble);
9331 JIM_REGISTER_API(SetDouble);
9332 JIM_REGISTER_API(NewDoubleObj);
9333 JIM_REGISTER_API(WrongNumArgs);
9334 JIM_REGISTER_API(SetDictKeysVector);
9335 JIM_REGISTER_API(SubstObj);
9336 JIM_REGISTER_API(RegisterApi);
9337 JIM_REGISTER_API(PrintErrorMessage);
9338 JIM_REGISTER_API(InteractivePrompt);
9339 JIM_REGISTER_API(RegisterCoreCommands);
9340 JIM_REGISTER_API(GetSharedString);
9341 JIM_REGISTER_API(ReleaseSharedString);
9342 JIM_REGISTER_API(Panic);
9343 JIM_REGISTER_API(StrDup);
9344 JIM_REGISTER_API(UnsetVariable);
9345 JIM_REGISTER_API(GetVariableStr);
9346 JIM_REGISTER_API(GetGlobalVariable);
9347 JIM_REGISTER_API(GetGlobalVariableStr);
9348 JIM_REGISTER_API(GetAssocData);
9349 JIM_REGISTER_API(SetAssocData);
9350 JIM_REGISTER_API(DeleteAssocData);
9351 JIM_REGISTER_API(GetEnum);
9352 JIM_REGISTER_API(ScriptIsComplete);
9353 JIM_REGISTER_API(PackageRequire);
9354 JIM_REGISTER_API(PackageProvide);
9355 JIM_REGISTER_API(InitStack);
9356 JIM_REGISTER_API(FreeStack);
9357 JIM_REGISTER_API(StackLen);
9358 JIM_REGISTER_API(StackPush);
9359 JIM_REGISTER_API(StackPop);
9360 JIM_REGISTER_API(StackPeek);
9361 JIM_REGISTER_API(FreeStackElements);
9362 JIM_REGISTER_API(fprintf );
9363 JIM_REGISTER_API(vfprintf );
9364 JIM_REGISTER_API(fwrite );
9365 JIM_REGISTER_API(fread );
9366 JIM_REGISTER_API(fflush );
9367 JIM_REGISTER_API(fgets );
9368 JIM_REGISTER_API(GetNvp);
9369 JIM_REGISTER_API(Nvp_name2value);
9370 JIM_REGISTER_API(Nvp_name2value_simple);
9371 JIM_REGISTER_API(Nvp_name2value_obj);
9372 JIM_REGISTER_API(Nvp_name2value_nocase);
9373 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9374
9375 JIM_REGISTER_API(Nvp_value2name);
9376 JIM_REGISTER_API(Nvp_value2name_simple);
9377 JIM_REGISTER_API(Nvp_value2name_obj);
9378
9379 JIM_REGISTER_API(GetOpt_Setup);
9380 JIM_REGISTER_API(GetOpt_Debug);
9381 JIM_REGISTER_API(GetOpt_Obj);
9382 JIM_REGISTER_API(GetOpt_String);
9383 JIM_REGISTER_API(GetOpt_Double);
9384 JIM_REGISTER_API(GetOpt_Wide);
9385 JIM_REGISTER_API(GetOpt_Nvp);
9386 JIM_REGISTER_API(GetOpt_NvpUnknown);
9387 JIM_REGISTER_API(GetOpt_Enum);
9388
9389 JIM_REGISTER_API(Debug_ArgvString);
9390 JIM_REGISTER_API(SetResult_sprintf);
9391 JIM_REGISTER_API(SetResult_NvpUnknown);
9392
9393 }
9394
9395 /* -----------------------------------------------------------------------------
9396 * Core commands utility functions
9397 * ---------------------------------------------------------------------------*/
9398 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9399 const char *msg)
9400 {
9401 int i;
9402 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9403
9404 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9405 for (i = 0; i < argc; i++) {
9406 Jim_AppendObj(interp, objPtr, argv[i]);
9407 if (!(i + 1 == argc && msg[0] == '\0'))
9408 Jim_AppendString(interp, objPtr, " ", 1);
9409 }
9410 Jim_AppendString(interp, objPtr, msg, -1);
9411 Jim_AppendString(interp, objPtr, "\"", 1);
9412 Jim_SetResult(interp, objPtr);
9413 }
9414
9415 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9416 {
9417 Jim_HashTableIterator *htiter;
9418 Jim_HashEntry *he;
9419 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9420 const char *pattern;
9421 int patternLen;
9422
9423 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9424 htiter = Jim_GetHashTableIterator(&interp->commands);
9425 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9426 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9427 strlen((const char*)he->key), 0))
9428 continue;
9429 Jim_ListAppendElement(interp, listObjPtr,
9430 Jim_NewStringObj(interp, he->key, -1));
9431 }
9432 Jim_FreeHashTableIterator(htiter);
9433 return listObjPtr;
9434 }
9435
9436 #define JIM_VARLIST_GLOBALS 0
9437 #define JIM_VARLIST_LOCALS 1
9438 #define JIM_VARLIST_VARS 2
9439
9440 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9441 int mode)
9442 {
9443 Jim_HashTableIterator *htiter;
9444 Jim_HashEntry *he;
9445 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9446 const char *pattern;
9447 int patternLen;
9448
9449 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9450 if (mode == JIM_VARLIST_GLOBALS) {
9451 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9452 } else {
9453 /* For [info locals], if we are at top level an emtpy list
9454 * is returned. I don't agree, but we aim at compatibility (SS) */
9455 if (mode == JIM_VARLIST_LOCALS &&
9456 interp->framePtr == interp->topFramePtr)
9457 return listObjPtr;
9458 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9459 }
9460 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9461 Jim_Var *varPtr = (Jim_Var*) he->val;
9462 if (mode == JIM_VARLIST_LOCALS) {
9463 if (varPtr->linkFramePtr != NULL)
9464 continue;
9465 }
9466 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9467 strlen((const char*)he->key), 0))
9468 continue;
9469 Jim_ListAppendElement(interp, listObjPtr,
9470 Jim_NewStringObj(interp, he->key, -1));
9471 }
9472 Jim_FreeHashTableIterator(htiter);
9473 return listObjPtr;
9474 }
9475
9476 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9477 Jim_Obj **objPtrPtr)
9478 {
9479 Jim_CallFrame *targetCallFrame;
9480
9481 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9482 != JIM_OK)
9483 return JIM_ERR;
9484 /* No proc call at toplevel callframe */
9485 if (targetCallFrame == interp->topFramePtr) {
9486 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9487 Jim_AppendStrings(interp, Jim_GetResult(interp),
9488 "bad level \"",
9489 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9490 return JIM_ERR;
9491 }
9492 *objPtrPtr = Jim_NewListObj(interp,
9493 targetCallFrame->argv,
9494 targetCallFrame->argc);
9495 return JIM_OK;
9496 }
9497
9498 /* -----------------------------------------------------------------------------
9499 * Core commands
9500 * ---------------------------------------------------------------------------*/
9501
9502 /* fake [puts] -- not the real puts, just for debugging. */
9503 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9504 Jim_Obj *const *argv)
9505 {
9506 const char *str;
9507 int len, nonewline = 0;
9508
9509 if (argc != 2 && argc != 3) {
9510 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9511 return JIM_ERR;
9512 }
9513 if (argc == 3) {
9514 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9515 {
9516 Jim_SetResultString(interp, "The second argument must "
9517 "be -nonewline", -1);
9518 return JIM_OK;
9519 } else {
9520 nonewline = 1;
9521 argv++;
9522 }
9523 }
9524 str = Jim_GetString(argv[1], &len);
9525 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9526 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9527 return JIM_OK;
9528 }
9529
9530 /* Helper for [+] and [*] */
9531 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9532 Jim_Obj *const *argv, int op)
9533 {
9534 jim_wide wideValue, res;
9535 double doubleValue, doubleRes;
9536 int i;
9537
9538 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9539
9540 for (i = 1; i < argc; i++) {
9541 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9542 goto trydouble;
9543 if (op == JIM_EXPROP_ADD)
9544 res += wideValue;
9545 else
9546 res *= wideValue;
9547 }
9548 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9549 return JIM_OK;
9550 trydouble:
9551 doubleRes = (double) res;
9552 for (;i < argc; i++) {
9553 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9554 return JIM_ERR;
9555 if (op == JIM_EXPROP_ADD)
9556 doubleRes += doubleValue;
9557 else
9558 doubleRes *= doubleValue;
9559 }
9560 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9561 return JIM_OK;
9562 }
9563
9564 /* Helper for [-] and [/] */
9565 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9566 Jim_Obj *const *argv, int op)
9567 {
9568 jim_wide wideValue, res = 0;
9569 double doubleValue, doubleRes = 0;
9570 int i = 2;
9571
9572 if (argc < 2) {
9573 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9574 return JIM_ERR;
9575 } else if (argc == 2) {
9576 /* The arity = 2 case is different. For [- x] returns -x,
9577 * while [/ x] returns 1/x. */
9578 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9579 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9580 JIM_OK)
9581 {
9582 return JIM_ERR;
9583 } else {
9584 if (op == JIM_EXPROP_SUB)
9585 doubleRes = -doubleValue;
9586 else
9587 doubleRes = 1.0/doubleValue;
9588 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9589 doubleRes));
9590 return JIM_OK;
9591 }
9592 }
9593 if (op == JIM_EXPROP_SUB) {
9594 res = -wideValue;
9595 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9596 } else {
9597 doubleRes = 1.0/wideValue;
9598 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9599 doubleRes));
9600 }
9601 return JIM_OK;
9602 } else {
9603 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9604 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9605 != JIM_OK) {
9606 return JIM_ERR;
9607 } else {
9608 goto trydouble;
9609 }
9610 }
9611 }
9612 for (i = 2; i < argc; i++) {
9613 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9614 doubleRes = (double) res;
9615 goto trydouble;
9616 }
9617 if (op == JIM_EXPROP_SUB)
9618 res -= wideValue;
9619 else
9620 res /= wideValue;
9621 }
9622 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9623 return JIM_OK;
9624 trydouble:
9625 for (;i < argc; i++) {
9626 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9627 return JIM_ERR;
9628 if (op == JIM_EXPROP_SUB)
9629 doubleRes -= doubleValue;
9630 else
9631 doubleRes /= doubleValue;
9632 }
9633 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9634 return JIM_OK;
9635 }
9636
9637
9638 /* [+] */
9639 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9640 Jim_Obj *const *argv)
9641 {
9642 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9643 }
9644
9645 /* [*] */
9646 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9647 Jim_Obj *const *argv)
9648 {
9649 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9650 }
9651
9652 /* [-] */
9653 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9654 Jim_Obj *const *argv)
9655 {
9656 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9657 }
9658
9659 /* [/] */
9660 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9661 Jim_Obj *const *argv)
9662 {
9663 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9664 }
9665
9666 /* [set] */
9667 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9668 Jim_Obj *const *argv)
9669 {
9670 if (argc != 2 && argc != 3) {
9671 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9672 return JIM_ERR;
9673 }
9674 if (argc == 2) {
9675 Jim_Obj *objPtr;
9676 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9677 if (!objPtr)
9678 return JIM_ERR;
9679 Jim_SetResult(interp, objPtr);
9680 return JIM_OK;
9681 }
9682 /* argc == 3 case. */
9683 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9684 return JIM_ERR;
9685 Jim_SetResult(interp, argv[2]);
9686 return JIM_OK;
9687 }
9688
9689 /* [unset] */
9690 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9691 Jim_Obj *const *argv)
9692 {
9693 int i;
9694
9695 if (argc < 2) {
9696 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9697 return JIM_ERR;
9698 }
9699 for (i = 1; i < argc; i++) {
9700 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9701 return JIM_ERR;
9702 }
9703 return JIM_OK;
9704 }
9705
9706 /* [incr] */
9707 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9708 Jim_Obj *const *argv)
9709 {
9710 jim_wide wideValue, increment = 1;
9711 Jim_Obj *intObjPtr;
9712
9713 if (argc != 2 && argc != 3) {
9714 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9715 return JIM_ERR;
9716 }
9717 if (argc == 3) {
9718 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9719 return JIM_ERR;
9720 }
9721 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9722 if (!intObjPtr) return JIM_ERR;
9723 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9724 return JIM_ERR;
9725 if (Jim_IsShared(intObjPtr)) {
9726 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9727 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9728 Jim_FreeNewObj(interp, intObjPtr);
9729 return JIM_ERR;
9730 }
9731 } else {
9732 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9733 /* The following step is required in order to invalidate the
9734 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9735 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9736 return JIM_ERR;
9737 }
9738 }
9739 Jim_SetResult(interp, intObjPtr);
9740 return JIM_OK;
9741 }
9742
9743 /* [while] */
9744 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9745 Jim_Obj *const *argv)
9746 {
9747 if (argc != 3) {
9748 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9749 return JIM_ERR;
9750 }
9751 /* Try to run a specialized version of while if the expression
9752 * is in one of the following forms:
9753 *
9754 * $a < CONST, $a < $b
9755 * $a <= CONST, $a <= $b
9756 * $a > CONST, $a > $b
9757 * $a >= CONST, $a >= $b
9758 * $a != CONST, $a != $b
9759 * $a == CONST, $a == $b
9760 * $a
9761 * !$a
9762 * CONST
9763 */
9764
9765 #ifdef JIM_OPTIMIZATION
9766 {
9767 ExprByteCode *expr;
9768 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9769 int exprLen, retval;
9770
9771 /* STEP 1 -- Check if there are the conditions to run the specialized
9772 * version of while */
9773
9774 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9775 if (expr->len <= 0 || expr->len > 3) goto noopt;
9776 switch (expr->len) {
9777 case 1:
9778 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9779 expr->opcode[0] != JIM_EXPROP_NUMBER)
9780 goto noopt;
9781 break;
9782 case 2:
9783 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9784 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9785 goto noopt;
9786 break;
9787 case 3:
9788 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9789 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9790 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9791 goto noopt;
9792 switch (expr->opcode[2]) {
9793 case JIM_EXPROP_LT:
9794 case JIM_EXPROP_LTE:
9795 case JIM_EXPROP_GT:
9796 case JIM_EXPROP_GTE:
9797 case JIM_EXPROP_NUMEQ:
9798 case JIM_EXPROP_NUMNE:
9799 /* nothing to do */
9800 break;
9801 default:
9802 goto noopt;
9803 }
9804 break;
9805 default:
9806 Jim_Panic(interp,
9807 "Unexpected default reached in Jim_WhileCoreCommand()");
9808 break;
9809 }
9810
9811 /* STEP 2 -- conditions meet. Initialization. Take different
9812 * branches for different expression lengths. */
9813 exprLen = expr->len;
9814
9815 if (exprLen == 1) {
9816 jim_wide wideValue;
9817
9818 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9819 varAObjPtr = expr->obj[0];
9820 Jim_IncrRefCount(varAObjPtr);
9821 } else {
9822 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9823 goto noopt;
9824 }
9825 while (1) {
9826 if (varAObjPtr) {
9827 if (!(objPtr =
9828 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9829 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9830 {
9831 Jim_DecrRefCount(interp, varAObjPtr);
9832 goto noopt;
9833 }
9834 }
9835 if (!wideValue) break;
9836 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9837 switch (retval) {
9838 case JIM_BREAK:
9839 if (varAObjPtr)
9840 Jim_DecrRefCount(interp, varAObjPtr);
9841 goto out;
9842 break;
9843 case JIM_CONTINUE:
9844 continue;
9845 break;
9846 default:
9847 if (varAObjPtr)
9848 Jim_DecrRefCount(interp, varAObjPtr);
9849 return retval;
9850 }
9851 }
9852 }
9853 if (varAObjPtr)
9854 Jim_DecrRefCount(interp, varAObjPtr);
9855 } else if (exprLen == 3) {
9856 jim_wide wideValueA, wideValueB, cmpRes = 0;
9857 int cmpType = expr->opcode[2];
9858
9859 varAObjPtr = expr->obj[0];
9860 Jim_IncrRefCount(varAObjPtr);
9861 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9862 varBObjPtr = expr->obj[1];
9863 Jim_IncrRefCount(varBObjPtr);
9864 } else {
9865 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9866 goto noopt;
9867 }
9868 while (1) {
9869 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9870 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9871 {
9872 Jim_DecrRefCount(interp, varAObjPtr);
9873 if (varBObjPtr)
9874 Jim_DecrRefCount(interp, varBObjPtr);
9875 goto noopt;
9876 }
9877 if (varBObjPtr) {
9878 if (!(objPtr =
9879 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9880 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9881 {
9882 Jim_DecrRefCount(interp, varAObjPtr);
9883 if (varBObjPtr)
9884 Jim_DecrRefCount(interp, varBObjPtr);
9885 goto noopt;
9886 }
9887 }
9888 switch (cmpType) {
9889 case JIM_EXPROP_LT:
9890 cmpRes = wideValueA < wideValueB; break;
9891 case JIM_EXPROP_LTE:
9892 cmpRes = wideValueA <= wideValueB; break;
9893 case JIM_EXPROP_GT:
9894 cmpRes = wideValueA > wideValueB; break;
9895 case JIM_EXPROP_GTE:
9896 cmpRes = wideValueA >= wideValueB; break;
9897 case JIM_EXPROP_NUMEQ:
9898 cmpRes = wideValueA == wideValueB; break;
9899 case JIM_EXPROP_NUMNE:
9900 cmpRes = wideValueA != wideValueB; break;
9901 }
9902 if (!cmpRes) break;
9903 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9904 switch (retval) {
9905 case JIM_BREAK:
9906 Jim_DecrRefCount(interp, varAObjPtr);
9907 if (varBObjPtr)
9908 Jim_DecrRefCount(interp, varBObjPtr);
9909 goto out;
9910 break;
9911 case JIM_CONTINUE:
9912 continue;
9913 break;
9914 default:
9915 Jim_DecrRefCount(interp, varAObjPtr);
9916 if (varBObjPtr)
9917 Jim_DecrRefCount(interp, varBObjPtr);
9918 return retval;
9919 }
9920 }
9921 }
9922 Jim_DecrRefCount(interp, varAObjPtr);
9923 if (varBObjPtr)
9924 Jim_DecrRefCount(interp, varBObjPtr);
9925 } else {
9926 /* TODO: case for len == 2 */
9927 goto noopt;
9928 }
9929 Jim_SetEmptyResult(interp);
9930 return JIM_OK;
9931 }
9932 noopt:
9933 #endif
9934
9935 /* The general purpose implementation of while starts here */
9936 while (1) {
9937 int boolean, retval;
9938
9939 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9940 &boolean)) != JIM_OK)
9941 return retval;
9942 if (!boolean) break;
9943 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9944 switch (retval) {
9945 case JIM_BREAK:
9946 goto out;
9947 break;
9948 case JIM_CONTINUE:
9949 continue;
9950 break;
9951 default:
9952 return retval;
9953 }
9954 }
9955 }
9956 out:
9957 Jim_SetEmptyResult(interp);
9958 return JIM_OK;
9959 }
9960
9961 /* [for] */
9962 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9963 Jim_Obj *const *argv)
9964 {
9965 int retval;
9966
9967 if (argc != 5) {
9968 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9969 return JIM_ERR;
9970 }
9971 /* Check if the for is on the form:
9972 * for {set i CONST} {$i < CONST} {incr i}
9973 * for {set i CONST} {$i < $j} {incr i}
9974 * for {set i CONST} {$i <= CONST} {incr i}
9975 * for {set i CONST} {$i <= $j} {incr i}
9976 * XXX: NOTE: if variable traces are implemented, this optimization
9977 * need to be modified to check for the proc epoch at every variable
9978 * update. */
9979 #ifdef JIM_OPTIMIZATION
9980 {
9981 ScriptObj *initScript, *incrScript;
9982 ExprByteCode *expr;
9983 jim_wide start, stop, currentVal;
9984 unsigned jim_wide procEpoch = interp->procEpoch;
9985 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9986 int cmpType;
9987 struct Jim_Cmd *cmdPtr;
9988
9989 /* Do it only if there aren't shared arguments */
9990 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9991 goto evalstart;
9992 initScript = Jim_GetScript(interp, argv[1]);
9993 expr = Jim_GetExpression(interp, argv[2]);
9994 incrScript = Jim_GetScript(interp, argv[3]);
9995
9996 /* Ensure proper lengths to start */
9997 if (initScript->len != 6) goto evalstart;
9998 if (incrScript->len != 4) goto evalstart;
9999 if (expr->len != 3) goto evalstart;
10000 /* Ensure proper token types. */
10001 if (initScript->token[2].type != JIM_TT_ESC ||
10002 initScript->token[4].type != JIM_TT_ESC ||
10003 incrScript->token[2].type != JIM_TT_ESC ||
10004 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10005 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10006 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10007 (expr->opcode[2] != JIM_EXPROP_LT &&
10008 expr->opcode[2] != JIM_EXPROP_LTE))
10009 goto evalstart;
10010 cmpType = expr->opcode[2];
10011 /* Initialization command must be [set] */
10012 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10013 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10014 goto evalstart;
10015 /* Update command must be incr */
10016 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10017 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10018 goto evalstart;
10019 /* set, incr, expression must be about the same variable */
10020 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10021 incrScript->token[2].objPtr, 0))
10022 goto evalstart;
10023 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10024 expr->obj[0], 0))
10025 goto evalstart;
10026 /* Check that the initialization and comparison are valid integers */
10027 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10028 goto evalstart;
10029 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10030 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10031 {
10032 goto evalstart;
10033 }
10034
10035 /* Initialization */
10036 varNamePtr = expr->obj[0];
10037 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10038 stopVarNamePtr = expr->obj[1];
10039 Jim_IncrRefCount(stopVarNamePtr);
10040 }
10041 Jim_IncrRefCount(varNamePtr);
10042
10043 /* --- OPTIMIZED FOR --- */
10044 /* Start to loop */
10045 objPtr = Jim_NewIntObj(interp, start);
10046 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10047 Jim_DecrRefCount(interp, varNamePtr);
10048 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10049 Jim_FreeNewObj(interp, objPtr);
10050 goto evalstart;
10051 }
10052 while (1) {
10053 /* === Check condition === */
10054 /* Common code: */
10055 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10056 if (objPtr == NULL ||
10057 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10058 {
10059 Jim_DecrRefCount(interp, varNamePtr);
10060 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10061 goto testcond;
10062 }
10063 /* Immediate or Variable? get the 'stop' value if the latter. */
10064 if (stopVarNamePtr) {
10065 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10066 if (objPtr == NULL ||
10067 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10068 {
10069 Jim_DecrRefCount(interp, varNamePtr);
10070 Jim_DecrRefCount(interp, stopVarNamePtr);
10071 goto testcond;
10072 }
10073 }
10074 if (cmpType == JIM_EXPROP_LT) {
10075 if (currentVal >= stop) break;
10076 } else {
10077 if (currentVal > stop) break;
10078 }
10079 /* Eval body */
10080 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10081 switch (retval) {
10082 case JIM_BREAK:
10083 if (stopVarNamePtr)
10084 Jim_DecrRefCount(interp, stopVarNamePtr);
10085 Jim_DecrRefCount(interp, varNamePtr);
10086 goto out;
10087 case JIM_CONTINUE:
10088 /* nothing to do */
10089 break;
10090 default:
10091 if (stopVarNamePtr)
10092 Jim_DecrRefCount(interp, stopVarNamePtr);
10093 Jim_DecrRefCount(interp, varNamePtr);
10094 return retval;
10095 }
10096 }
10097 /* If there was a change in procedures/command continue
10098 * with the usual [for] command implementation */
10099 if (procEpoch != interp->procEpoch) {
10100 if (stopVarNamePtr)
10101 Jim_DecrRefCount(interp, stopVarNamePtr);
10102 Jim_DecrRefCount(interp, varNamePtr);
10103 goto evalnext;
10104 }
10105 /* Increment */
10106 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10107 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10108 objPtr->internalRep.wideValue ++;
10109 Jim_InvalidateStringRep(objPtr);
10110 } else {
10111 Jim_Obj *auxObjPtr;
10112
10113 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10114 if (stopVarNamePtr)
10115 Jim_DecrRefCount(interp, stopVarNamePtr);
10116 Jim_DecrRefCount(interp, varNamePtr);
10117 goto evalnext;
10118 }
10119 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10120 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10121 if (stopVarNamePtr)
10122 Jim_DecrRefCount(interp, stopVarNamePtr);
10123 Jim_DecrRefCount(interp, varNamePtr);
10124 Jim_FreeNewObj(interp, auxObjPtr);
10125 goto evalnext;
10126 }
10127 }
10128 }
10129 if (stopVarNamePtr)
10130 Jim_DecrRefCount(interp, stopVarNamePtr);
10131 Jim_DecrRefCount(interp, varNamePtr);
10132 Jim_SetEmptyResult(interp);
10133 return JIM_OK;
10134 }
10135 #endif
10136 evalstart:
10137 /* Eval start */
10138 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10139 return retval;
10140 while (1) {
10141 int boolean;
10142 testcond:
10143 /* Test the condition */
10144 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10145 != JIM_OK)
10146 return retval;
10147 if (!boolean) break;
10148 /* Eval body */
10149 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10150 switch (retval) {
10151 case JIM_BREAK:
10152 goto out;
10153 break;
10154 case JIM_CONTINUE:
10155 /* Nothing to do */
10156 break;
10157 default:
10158 return retval;
10159 }
10160 }
10161 evalnext:
10162 /* Eval next */
10163 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10164 switch (retval) {
10165 case JIM_BREAK:
10166 goto out;
10167 break;
10168 case JIM_CONTINUE:
10169 continue;
10170 break;
10171 default:
10172 return retval;
10173 }
10174 }
10175 }
10176 out:
10177 Jim_SetEmptyResult(interp);
10178 return JIM_OK;
10179 }
10180
10181 /* foreach + lmap implementation. */
10182 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10183 Jim_Obj *const *argv, int doMap)
10184 {
10185 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10186 int nbrOfLoops = 0;
10187 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10188
10189 if (argc < 4 || argc % 2 != 0) {
10190 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10191 return JIM_ERR;
10192 }
10193 if (doMap) {
10194 mapRes = Jim_NewListObj(interp, NULL, 0);
10195 Jim_IncrRefCount(mapRes);
10196 }
10197 emptyStr = Jim_NewEmptyStringObj(interp);
10198 Jim_IncrRefCount(emptyStr);
10199 script = argv[argc-1]; /* Last argument is a script */
10200 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10201 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10202 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10203 /* Initialize iterators and remember max nbr elements each list */
10204 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10205 /* Remember lengths of all lists and calculate how much rounds to loop */
10206 for (i = 0; i < nbrOfLists*2; i += 2) {
10207 div_t cnt;
10208 int count;
10209 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10210 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10211 if (listsEnd[i] == 0) {
10212 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10213 goto err;
10214 }
10215 cnt = div(listsEnd[i + 1], listsEnd[i]);
10216 count = cnt.quot + (cnt.rem ? 1 : 0);
10217 if (count > nbrOfLoops)
10218 nbrOfLoops = count;
10219 }
10220 for (; nbrOfLoops-- > 0; ) {
10221 for (i = 0; i < nbrOfLists; ++i) {
10222 int varIdx = 0, var = i * 2;
10223 while (varIdx < listsEnd[var]) {
10224 Jim_Obj *varName, *ele;
10225 int lst = i * 2 + 1;
10226 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10227 != JIM_OK)
10228 goto err;
10229 if (listsIdx[i] < listsEnd[lst]) {
10230 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10231 != JIM_OK)
10232 goto err;
10233 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10234 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10235 goto err;
10236 }
10237 ++listsIdx[i]; /* Remember next iterator of current list */
10238 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10239 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10240 goto err;
10241 }
10242 ++varIdx; /* Next variable */
10243 }
10244 }
10245 switch (result = Jim_EvalObj(interp, script)) {
10246 case JIM_OK:
10247 if (doMap)
10248 Jim_ListAppendElement(interp, mapRes, interp->result);
10249 break;
10250 case JIM_CONTINUE:
10251 break;
10252 case JIM_BREAK:
10253 goto out;
10254 break;
10255 default:
10256 goto err;
10257 }
10258 }
10259 out:
10260 result = JIM_OK;
10261 if (doMap)
10262 Jim_SetResult(interp, mapRes);
10263 else
10264 Jim_SetEmptyResult(interp);
10265 err:
10266 if (doMap)
10267 Jim_DecrRefCount(interp, mapRes);
10268 Jim_DecrRefCount(interp, emptyStr);
10269 Jim_Free(listsIdx);
10270 Jim_Free(listsEnd);
10271 return result;
10272 }
10273
10274 /* [foreach] */
10275 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10276 Jim_Obj *const *argv)
10277 {
10278 return JimForeachMapHelper(interp, argc, argv, 0);
10279 }
10280
10281 /* [lmap] */
10282 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10283 Jim_Obj *const *argv)
10284 {
10285 return JimForeachMapHelper(interp, argc, argv, 1);
10286 }
10287
10288 /* [if] */
10289 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10290 Jim_Obj *const *argv)
10291 {
10292 int boolean, retval, current = 1, falsebody = 0;
10293 if (argc >= 3) {
10294 while (1) {
10295 /* Far not enough arguments given! */
10296 if (current >= argc) goto err;
10297 if ((retval = Jim_GetBoolFromExpr(interp,
10298 argv[current++], &boolean))
10299 != JIM_OK)
10300 return retval;
10301 /* There lacks something, isn't it? */
10302 if (current >= argc) goto err;
10303 if (Jim_CompareStringImmediate(interp, argv[current],
10304 "then")) current++;
10305 /* Tsk tsk, no then-clause? */
10306 if (current >= argc) goto err;
10307 if (boolean)
10308 return Jim_EvalObj(interp, argv[current]);
10309 /* Ok: no else-clause follows */
10310 if (++current >= argc) {
10311 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10312 return JIM_OK;
10313 }
10314 falsebody = current++;
10315 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10316 "else")) {
10317 /* IIICKS - else-clause isn't last cmd? */
10318 if (current != argc-1) goto err;
10319 return Jim_EvalObj(interp, argv[current]);
10320 } else if (Jim_CompareStringImmediate(interp,
10321 argv[falsebody], "elseif"))
10322 /* Ok: elseif follows meaning all the stuff
10323 * again (how boring...) */
10324 continue;
10325 /* OOPS - else-clause is not last cmd?*/
10326 else if (falsebody != argc-1)
10327 goto err;
10328 return Jim_EvalObj(interp, argv[falsebody]);
10329 }
10330 return JIM_OK;
10331 }
10332 err:
10333 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10334 return JIM_ERR;
10335 }
10336
10337 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10338
10339 /* [switch] */
10340 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10341 Jim_Obj *const *argv)
10342 {
10343 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10344 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10345 Jim_Obj *script = 0;
10346 if (argc < 3) goto wrongnumargs;
10347 for (opt = 1; opt < argc; ++opt) {
10348 const char *option = Jim_GetString(argv[opt], 0);
10349 if (*option != '-') break;
10350 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10351 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10352 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10353 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10354 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10355 if ((argc - opt) < 2) goto wrongnumargs;
10356 command = argv[++opt];
10357 } else {
10358 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10359 Jim_AppendStrings(interp, Jim_GetResult(interp),
10360 "bad option \"", option, "\": must be -exact, -glob, "
10361 "-regexp, -command procname or --", 0);
10362 goto err;
10363 }
10364 if ((argc - opt) < 2) goto wrongnumargs;
10365 }
10366 strObj = argv[opt++];
10367 patCount = argc - opt;
10368 if (patCount == 1) {
10369 Jim_Obj **vector;
10370 JimListGetElements(interp, argv[opt], &patCount, &vector);
10371 caseList = vector;
10372 } else
10373 caseList = &argv[opt];
10374 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10375 for (i = 0; script == 0 && i < patCount; i += 2) {
10376 Jim_Obj *patObj = caseList[i];
10377 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10378 || i < (patCount-2)) {
10379 switch (matchOpt) {
10380 case SWITCH_EXACT:
10381 if (Jim_StringEqObj(strObj, patObj, 0))
10382 script = caseList[i + 1];
10383 break;
10384 case SWITCH_GLOB:
10385 if (Jim_StringMatchObj(patObj, strObj, 0))
10386 script = caseList[i + 1];
10387 break;
10388 case SWITCH_RE:
10389 command = Jim_NewStringObj(interp, "regexp", -1);
10390 /* Fall thru intentionally */
10391 case SWITCH_CMD: {
10392 Jim_Obj *parms[] = {command, patObj, strObj};
10393 int rc = Jim_EvalObjVector(interp, 3, parms);
10394 long matching;
10395 /* After the execution of a command we need to
10396 * make sure to reconvert the object into a list
10397 * again. Only for the single-list style [switch]. */
10398 if (argc-opt == 1) {
10399 Jim_Obj **vector;
10400 JimListGetElements(interp, argv[opt], &patCount,
10401 &vector);
10402 caseList = vector;
10403 }
10404 /* command is here already decref'd */
10405 if (rc != JIM_OK) {
10406 retcode = rc;
10407 goto err;
10408 }
10409 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10410 if (rc != JIM_OK) {
10411 retcode = rc;
10412 goto err;
10413 }
10414 if (matching)
10415 script = caseList[i + 1];
10416 break;
10417 }
10418 default:
10419 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10420 Jim_AppendStrings(interp, Jim_GetResult(interp),
10421 "internal error: no such option implemented", 0);
10422 goto err;
10423 }
10424 } else {
10425 script = caseList[i + 1];
10426 }
10427 }
10428 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10429 i += 2)
10430 script = caseList[i + 1];
10431 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10432 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10433 Jim_AppendStrings(interp, Jim_GetResult(interp),
10434 "no body specified for pattern \"",
10435 Jim_GetString(caseList[i-2], 0), "\"", 0);
10436 goto err;
10437 }
10438 retcode = JIM_OK;
10439 Jim_SetEmptyResult(interp);
10440 if (script != 0)
10441 retcode = Jim_EvalObj(interp, script);
10442 return retcode;
10443 wrongnumargs:
10444 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10445 "pattern body ... ?default body? or "
10446 "{pattern body ?pattern body ...?}");
10447 err:
10448 return retcode;
10449 }
10450
10451 /* [list] */
10452 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10453 Jim_Obj *const *argv)
10454 {
10455 Jim_Obj *listObjPtr;
10456
10457 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10458 Jim_SetResult(interp, listObjPtr);
10459 return JIM_OK;
10460 }
10461
10462 /* [lindex] */
10463 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10464 Jim_Obj *const *argv)
10465 {
10466 Jim_Obj *objPtr, *listObjPtr;
10467 int i;
10468 int index;
10469
10470 if (argc < 3) {
10471 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10472 return JIM_ERR;
10473 }
10474 objPtr = argv[1];
10475 Jim_IncrRefCount(objPtr);
10476 for (i = 2; i < argc; i++) {
10477 listObjPtr = objPtr;
10478 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10479 Jim_DecrRefCount(interp, listObjPtr);
10480 return JIM_ERR;
10481 }
10482 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10483 JIM_NONE) != JIM_OK) {
10484 /* Returns an empty object if the index
10485 * is out of range. */
10486 Jim_DecrRefCount(interp, listObjPtr);
10487 Jim_SetEmptyResult(interp);
10488 return JIM_OK;
10489 }
10490 Jim_IncrRefCount(objPtr);
10491 Jim_DecrRefCount(interp, listObjPtr);
10492 }
10493 Jim_SetResult(interp, objPtr);
10494 Jim_DecrRefCount(interp, objPtr);
10495 return JIM_OK;
10496 }
10497
10498 /* [llength] */
10499 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10500 Jim_Obj *const *argv)
10501 {
10502 int len;
10503
10504 if (argc != 2) {
10505 Jim_WrongNumArgs(interp, 1, argv, "list");
10506 return JIM_ERR;
10507 }
10508 Jim_ListLength(interp, argv[1], &len);
10509 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10510 return JIM_OK;
10511 }
10512
10513 /* [lappend] */
10514 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10515 Jim_Obj *const *argv)
10516 {
10517 Jim_Obj *listObjPtr;
10518 int shared, i;
10519
10520 if (argc < 2) {
10521 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10522 return JIM_ERR;
10523 }
10524 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10525 if (!listObjPtr) {
10526 /* Create the list if it does not exists */
10527 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10528 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10529 Jim_FreeNewObj(interp, listObjPtr);
10530 return JIM_ERR;
10531 }
10532 }
10533 shared = Jim_IsShared(listObjPtr);
10534 if (shared)
10535 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10536 for (i = 2; i < argc; i++)
10537 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10538 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10539 if (shared)
10540 Jim_FreeNewObj(interp, listObjPtr);
10541 return JIM_ERR;
10542 }
10543 Jim_SetResult(interp, listObjPtr);
10544 return JIM_OK;
10545 }
10546
10547 /* [linsert] */
10548 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10549 Jim_Obj *const *argv)
10550 {
10551 int index, len;
10552 Jim_Obj *listPtr;
10553
10554 if (argc < 4) {
10555 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10556 "?element ...?");
10557 return JIM_ERR;
10558 }
10559 listPtr = argv[1];
10560 if (Jim_IsShared(listPtr))
10561 listPtr = Jim_DuplicateObj(interp, listPtr);
10562 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10563 goto err;
10564 Jim_ListLength(interp, listPtr, &len);
10565 if (index >= len)
10566 index = len;
10567 else if (index < 0)
10568 index = len + index + 1;
10569 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10570 Jim_SetResult(interp, listPtr);
10571 return JIM_OK;
10572 err:
10573 if (listPtr != argv[1]) {
10574 Jim_FreeNewObj(interp, listPtr);
10575 }
10576 return JIM_ERR;
10577 }
10578
10579 /* [lset] */
10580 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10581 Jim_Obj *const *argv)
10582 {
10583 if (argc < 3) {
10584 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10585 return JIM_ERR;
10586 } else if (argc == 3) {
10587 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10588 return JIM_ERR;
10589 Jim_SetResult(interp, argv[2]);
10590 return JIM_OK;
10591 }
10592 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10593 == JIM_ERR) return JIM_ERR;
10594 return JIM_OK;
10595 }
10596
10597 /* [lsort] */
10598 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10599 {
10600 const char *options[] = {
10601 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10602 };
10603 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10604 Jim_Obj *resObj;
10605 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10606 int decreasing = 0;
10607
10608 if (argc < 2) {
10609 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10610 return JIM_ERR;
10611 }
10612 for (i = 1; i < (argc-1); i++) {
10613 int option;
10614
10615 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10616 != JIM_OK)
10617 return JIM_ERR;
10618 switch (option) {
10619 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10620 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10621 case OPT_INCREASING: decreasing = 0; break;
10622 case OPT_DECREASING: decreasing = 1; break;
10623 }
10624 }
10625 if (decreasing) {
10626 switch (lsortType) {
10627 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10628 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10629 }
10630 }
10631 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10632 ListSortElements(interp, resObj, lsortType);
10633 Jim_SetResult(interp, resObj);
10634 return JIM_OK;
10635 }
10636
10637 /* [append] */
10638 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10639 Jim_Obj *const *argv)
10640 {
10641 Jim_Obj *stringObjPtr;
10642 int shared, i;
10643
10644 if (argc < 2) {
10645 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10646 return JIM_ERR;
10647 }
10648 if (argc == 2) {
10649 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10650 if (!stringObjPtr) return JIM_ERR;
10651 } else {
10652 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10653 if (!stringObjPtr) {
10654 /* Create the string if it does not exists */
10655 stringObjPtr = Jim_NewEmptyStringObj(interp);
10656 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10657 != JIM_OK) {
10658 Jim_FreeNewObj(interp, stringObjPtr);
10659 return JIM_ERR;
10660 }
10661 }
10662 }
10663 shared = Jim_IsShared(stringObjPtr);
10664 if (shared)
10665 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10666 for (i = 2; i < argc; i++)
10667 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10668 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10669 if (shared)
10670 Jim_FreeNewObj(interp, stringObjPtr);
10671 return JIM_ERR;
10672 }
10673 Jim_SetResult(interp, stringObjPtr);
10674 return JIM_OK;
10675 }
10676
10677 /* [debug] */
10678 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10679 Jim_Obj *const *argv)
10680 {
10681 const char *options[] = {
10682 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10683 "exprbc",
10684 NULL
10685 };
10686 enum {
10687 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10688 OPT_EXPRLEN, OPT_EXPRBC
10689 };
10690 int option;
10691
10692 if (argc < 2) {
10693 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10694 return JIM_ERR;
10695 }
10696 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10697 JIM_ERRMSG) != JIM_OK)
10698 return JIM_ERR;
10699 if (option == OPT_REFCOUNT) {
10700 if (argc != 3) {
10701 Jim_WrongNumArgs(interp, 2, argv, "object");
10702 return JIM_ERR;
10703 }
10704 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10705 return JIM_OK;
10706 } else if (option == OPT_OBJCOUNT) {
10707 int freeobj = 0, liveobj = 0;
10708 char buf[256];
10709 Jim_Obj *objPtr;
10710
10711 if (argc != 2) {
10712 Jim_WrongNumArgs(interp, 2, argv, "");
10713 return JIM_ERR;
10714 }
10715 /* Count the number of free objects. */
10716 objPtr = interp->freeList;
10717 while (objPtr) {
10718 freeobj++;
10719 objPtr = objPtr->nextObjPtr;
10720 }
10721 /* Count the number of live objects. */
10722 objPtr = interp->liveList;
10723 while (objPtr) {
10724 liveobj++;
10725 objPtr = objPtr->nextObjPtr;
10726 }
10727 /* Set the result string and return. */
10728 sprintf(buf, "free %d used %d", freeobj, liveobj);
10729 Jim_SetResultString(interp, buf, -1);
10730 return JIM_OK;
10731 } else if (option == OPT_OBJECTS) {
10732 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10733 /* Count the number of live objects. */
10734 objPtr = interp->liveList;
10735 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10736 while (objPtr) {
10737 char buf[128];
10738 const char *type = objPtr->typePtr ?
10739 objPtr->typePtr->name : "";
10740 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10741 sprintf(buf, "%p", objPtr);
10742 Jim_ListAppendElement(interp, subListObjPtr,
10743 Jim_NewStringObj(interp, buf, -1));
10744 Jim_ListAppendElement(interp, subListObjPtr,
10745 Jim_NewStringObj(interp, type, -1));
10746 Jim_ListAppendElement(interp, subListObjPtr,
10747 Jim_NewIntObj(interp, objPtr->refCount));
10748 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10749 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10750 objPtr = objPtr->nextObjPtr;
10751 }
10752 Jim_SetResult(interp, listObjPtr);
10753 return JIM_OK;
10754 } else if (option == OPT_INVSTR) {
10755 Jim_Obj *objPtr;
10756
10757 if (argc != 3) {
10758 Jim_WrongNumArgs(interp, 2, argv, "object");
10759 return JIM_ERR;
10760 }
10761 objPtr = argv[2];
10762 if (objPtr->typePtr != NULL)
10763 Jim_InvalidateStringRep(objPtr);
10764 Jim_SetEmptyResult(interp);
10765 return JIM_OK;
10766 } else if (option == OPT_SCRIPTLEN) {
10767 ScriptObj *script;
10768 if (argc != 3) {
10769 Jim_WrongNumArgs(interp, 2, argv, "script");
10770 return JIM_ERR;
10771 }
10772 script = Jim_GetScript(interp, argv[2]);
10773 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10774 return JIM_OK;
10775 } else if (option == OPT_EXPRLEN) {
10776 ExprByteCode *expr;
10777 if (argc != 3) {
10778 Jim_WrongNumArgs(interp, 2, argv, "expression");
10779 return JIM_ERR;
10780 }
10781 expr = Jim_GetExpression(interp, argv[2]);
10782 if (expr == NULL)
10783 return JIM_ERR;
10784 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10785 return JIM_OK;
10786 } else if (option == OPT_EXPRBC) {
10787 Jim_Obj *objPtr;
10788 ExprByteCode *expr;
10789 int i;
10790
10791 if (argc != 3) {
10792 Jim_WrongNumArgs(interp, 2, argv, "expression");
10793 return JIM_ERR;
10794 }
10795 expr = Jim_GetExpression(interp, argv[2]);
10796 if (expr == NULL)
10797 return JIM_ERR;
10798 objPtr = Jim_NewListObj(interp, NULL, 0);
10799 for (i = 0; i < expr->len; i++) {
10800 const char *type;
10801 Jim_ExprOperator *op;
10802
10803 switch (expr->opcode[i]) {
10804 case JIM_EXPROP_NUMBER: type = "number"; break;
10805 case JIM_EXPROP_COMMAND: type = "command"; break;
10806 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10807 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10808 case JIM_EXPROP_SUBST: type = "subst"; break;
10809 case JIM_EXPROP_STRING: type = "string"; break;
10810 default:
10811 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10812 if (op == NULL) {
10813 type = "private";
10814 } else {
10815 type = "operator";
10816 }
10817 break;
10818 }
10819 Jim_ListAppendElement(interp, objPtr,
10820 Jim_NewStringObj(interp, type, -1));
10821 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10822 }
10823 Jim_SetResult(interp, objPtr);
10824 return JIM_OK;
10825 } else {
10826 Jim_SetResultString(interp,
10827 "bad option. Valid options are refcount, "
10828 "objcount, objects, invstr", -1);
10829 return JIM_ERR;
10830 }
10831 return JIM_OK; /* unreached */
10832 }
10833
10834 /* [eval] */
10835 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10836 Jim_Obj *const *argv)
10837 {
10838 if (argc == 2) {
10839 return Jim_EvalObj(interp, argv[1]);
10840 } else if (argc > 2) {
10841 Jim_Obj *objPtr;
10842 int retcode;
10843
10844 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10845 Jim_IncrRefCount(objPtr);
10846 retcode = Jim_EvalObj(interp, objPtr);
10847 Jim_DecrRefCount(interp, objPtr);
10848 return retcode;
10849 } else {
10850 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10851 return JIM_ERR;
10852 }
10853 }
10854
10855 /* [uplevel] */
10856 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10857 Jim_Obj *const *argv)
10858 {
10859 if (argc >= 2) {
10860 int retcode, newLevel, oldLevel;
10861 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10862 Jim_Obj *objPtr;
10863 const char *str;
10864
10865 /* Save the old callframe pointer */
10866 savedCallFrame = interp->framePtr;
10867
10868 /* Lookup the target frame pointer */
10869 str = Jim_GetString(argv[1], NULL);
10870 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10871 {
10872 if (Jim_GetCallFrameByLevel(interp, argv[1],
10873 &targetCallFrame,
10874 &newLevel) != JIM_OK)
10875 return JIM_ERR;
10876 argc--;
10877 argv++;
10878 } else {
10879 if (Jim_GetCallFrameByLevel(interp, NULL,
10880 &targetCallFrame,
10881 &newLevel) != JIM_OK)
10882 return JIM_ERR;
10883 }
10884 if (argc < 2) {
10885 argc++;
10886 argv--;
10887 Jim_WrongNumArgs(interp, 1, argv,
10888 "?level? command ?arg ...?");
10889 return JIM_ERR;
10890 }
10891 /* Eval the code in the target callframe. */
10892 interp->framePtr = targetCallFrame;
10893 oldLevel = interp->numLevels;
10894 interp->numLevels = newLevel;
10895 if (argc == 2) {
10896 retcode = Jim_EvalObj(interp, argv[1]);
10897 } else {
10898 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10899 Jim_IncrRefCount(objPtr);
10900 retcode = Jim_EvalObj(interp, objPtr);
10901 Jim_DecrRefCount(interp, objPtr);
10902 }
10903 interp->numLevels = oldLevel;
10904 interp->framePtr = savedCallFrame;
10905 return retcode;
10906 } else {
10907 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10908 return JIM_ERR;
10909 }
10910 }
10911
10912 /* [expr] */
10913 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10914 Jim_Obj *const *argv)
10915 {
10916 Jim_Obj *exprResultPtr;
10917 int retcode;
10918
10919 if (argc == 2) {
10920 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10921 } else if (argc > 2) {
10922 Jim_Obj *objPtr;
10923
10924 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10925 Jim_IncrRefCount(objPtr);
10926 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10927 Jim_DecrRefCount(interp, objPtr);
10928 } else {
10929 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10930 return JIM_ERR;
10931 }
10932 if (retcode != JIM_OK) return retcode;
10933 Jim_SetResult(interp, exprResultPtr);
10934 Jim_DecrRefCount(interp, exprResultPtr);
10935 return JIM_OK;
10936 }
10937
10938 /* [break] */
10939 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10940 Jim_Obj *const *argv)
10941 {
10942 if (argc != 1) {
10943 Jim_WrongNumArgs(interp, 1, argv, "");
10944 return JIM_ERR;
10945 }
10946 return JIM_BREAK;
10947 }
10948
10949 /* [continue] */
10950 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10951 Jim_Obj *const *argv)
10952 {
10953 if (argc != 1) {
10954 Jim_WrongNumArgs(interp, 1, argv, "");
10955 return JIM_ERR;
10956 }
10957 return JIM_CONTINUE;
10958 }
10959
10960 /* [return] */
10961 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10962 Jim_Obj *const *argv)
10963 {
10964 if (argc == 1) {
10965 return JIM_RETURN;
10966 } else if (argc == 2) {
10967 Jim_SetResult(interp, argv[1]);
10968 interp->returnCode = JIM_OK;
10969 return JIM_RETURN;
10970 } else if (argc == 3 || argc == 4) {
10971 int returnCode;
10972 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10973 return JIM_ERR;
10974 interp->returnCode = returnCode;
10975 if (argc == 4)
10976 Jim_SetResult(interp, argv[3]);
10977 return JIM_RETURN;
10978 } else {
10979 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10980 return JIM_ERR;
10981 }
10982 return JIM_RETURN; /* unreached */
10983 }
10984
10985 /* [tailcall] */
10986 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10987 Jim_Obj *const *argv)
10988 {
10989 Jim_Obj *objPtr;
10990
10991 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10992 Jim_SetResult(interp, objPtr);
10993 return JIM_EVAL;
10994 }
10995
10996 /* [proc] */
10997 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10998 Jim_Obj *const *argv)
10999 {
11000 int argListLen;
11001 int arityMin, arityMax;
11002
11003 if (argc != 4 && argc != 5) {
11004 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11005 return JIM_ERR;
11006 }
11007 Jim_ListLength(interp, argv[2], &argListLen);
11008 arityMin = arityMax = argListLen + 1;
11009
11010 if (argListLen) {
11011 const char *str;
11012 int len;
11013 Jim_Obj *argPtr;
11014
11015 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11016 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11017 str = Jim_GetString(argPtr, &len);
11018 if (len == 4 && memcmp(str, "args", 4) == 0) {
11019 arityMin--;
11020 arityMax = -1;
11021 }
11022
11023 /* Check for default arguments and reduce arityMin if necessary */
11024 while (arityMin > 1) {
11025 int len;
11026 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11027 Jim_ListLength(interp, argPtr, &len);
11028 if (len != 2) {
11029 /* No default argument */
11030 break;
11031 }
11032 arityMin--;
11033 }
11034 }
11035 if (argc == 4) {
11036 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11037 argv[2], NULL, argv[3], arityMin, arityMax);
11038 } else {
11039 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11040 argv[2], argv[3], argv[4], arityMin, arityMax);
11041 }
11042 }
11043
11044 /* [concat] */
11045 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11046 Jim_Obj *const *argv)
11047 {
11048 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11049 return JIM_OK;
11050 }
11051
11052 /* [upvar] */
11053 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11054 Jim_Obj *const *argv)
11055 {
11056 const char *str;
11057 int i;
11058 Jim_CallFrame *targetCallFrame;
11059
11060 /* Lookup the target frame pointer */
11061 str = Jim_GetString(argv[1], NULL);
11062 if (argc > 3 &&
11063 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11064 {
11065 if (Jim_GetCallFrameByLevel(interp, argv[1],
11066 &targetCallFrame, NULL) != JIM_OK)
11067 return JIM_ERR;
11068 argc--;
11069 argv++;
11070 } else {
11071 if (Jim_GetCallFrameByLevel(interp, NULL,
11072 &targetCallFrame, NULL) != JIM_OK)
11073 return JIM_ERR;
11074 }
11075 /* Check for arity */
11076 if (argc < 3 || ((argc-1)%2) != 0) {
11077 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11078 return JIM_ERR;
11079 }
11080 /* Now... for every other/local couple: */
11081 for (i = 1; i < argc; i += 2) {
11082 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11083 targetCallFrame) != JIM_OK) return JIM_ERR;
11084 }
11085 return JIM_OK;
11086 }
11087
11088 /* [global] */
11089 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11090 Jim_Obj *const *argv)
11091 {
11092 int i;
11093
11094 if (argc < 2) {
11095 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11096 return JIM_ERR;
11097 }
11098 /* Link every var to the toplevel having the same name */
11099 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11100 for (i = 1; i < argc; i++) {
11101 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11102 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11103 }
11104 return JIM_OK;
11105 }
11106
11107 /* does the [string map] operation. On error NULL is returned,
11108 * otherwise a new string object with the result, having refcount = 0,
11109 * is returned. */
11110 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11111 Jim_Obj *objPtr, int nocase)
11112 {
11113 int numMaps;
11114 const char **key, *str, *noMatchStart = NULL;
11115 Jim_Obj **value;
11116 int *keyLen, strLen, i;
11117 Jim_Obj *resultObjPtr;
11118
11119 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11120 if (numMaps % 2) {
11121 Jim_SetResultString(interp,
11122 "list must contain an even number of elements", -1);
11123 return NULL;
11124 }
11125 /* Initialization */
11126 numMaps /= 2;
11127 key = Jim_Alloc(sizeof(char*)*numMaps);
11128 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11129 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11130 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11131 for (i = 0; i < numMaps; i++) {
11132 Jim_Obj *eleObjPtr;
11133
11134 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11135 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11136 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11137 value[i] = eleObjPtr;
11138 }
11139 str = Jim_GetString(objPtr, &strLen);
11140 /* Map it */
11141 while (strLen) {
11142 for (i = 0; i < numMaps; i++) {
11143 if (strLen >= keyLen[i] && keyLen[i]) {
11144 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11145 nocase))
11146 {
11147 if (noMatchStart) {
11148 Jim_AppendString(interp, resultObjPtr,
11149 noMatchStart, str-noMatchStart);
11150 noMatchStart = NULL;
11151 }
11152 Jim_AppendObj(interp, resultObjPtr, value[i]);
11153 str += keyLen[i];
11154 strLen -= keyLen[i];
11155 break;
11156 }
11157 }
11158 }
11159 if (i == numMaps) { /* no match */
11160 if (noMatchStart == NULL)
11161 noMatchStart = str;
11162 str ++;
11163 strLen --;
11164 }
11165 }
11166 if (noMatchStart) {
11167 Jim_AppendString(interp, resultObjPtr,
11168 noMatchStart, str-noMatchStart);
11169 }
11170 Jim_Free((void*)key);
11171 Jim_Free(keyLen);
11172 Jim_Free(value);
11173 return resultObjPtr;
11174 }
11175
11176 /* [string] */
11177 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11178 Jim_Obj *const *argv)
11179 {
11180 int option;
11181 const char *options[] = {
11182 "length", "compare", "match", "equal", "range", "map", "repeat",
11183 "index", "first", "tolower", "toupper", NULL
11184 };
11185 enum {
11186 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11187 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11188 };
11189
11190 if (argc < 2) {
11191 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11192 return JIM_ERR;
11193 }
11194 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11195 JIM_ERRMSG) != JIM_OK)
11196 return JIM_ERR;
11197
11198 if (option == OPT_LENGTH) {
11199 int len;
11200
11201 if (argc != 3) {
11202 Jim_WrongNumArgs(interp, 2, argv, "string");
11203 return JIM_ERR;
11204 }
11205 Jim_GetString(argv[2], &len);
11206 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11207 return JIM_OK;
11208 } else if (option == OPT_COMPARE) {
11209 int nocase = 0;
11210 if ((argc != 4 && argc != 5) ||
11211 (argc == 5 && Jim_CompareStringImmediate(interp,
11212 argv[2], "-nocase") == 0)) {
11213 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11214 return JIM_ERR;
11215 }
11216 if (argc == 5) {
11217 nocase = 1;
11218 argv++;
11219 }
11220 Jim_SetResult(interp, Jim_NewIntObj(interp,
11221 Jim_StringCompareObj(argv[2],
11222 argv[3], nocase)));
11223 return JIM_OK;
11224 } else if (option == OPT_MATCH) {
11225 int nocase = 0;
11226 if ((argc != 4 && argc != 5) ||
11227 (argc == 5 && Jim_CompareStringImmediate(interp,
11228 argv[2], "-nocase") == 0)) {
11229 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11230 "string");
11231 return JIM_ERR;
11232 }
11233 if (argc == 5) {
11234 nocase = 1;
11235 argv++;
11236 }
11237 Jim_SetResult(interp,
11238 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11239 argv[3], nocase)));
11240 return JIM_OK;
11241 } else if (option == OPT_EQUAL) {
11242 if (argc != 4) {
11243 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11244 return JIM_ERR;
11245 }
11246 Jim_SetResult(interp,
11247 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11248 argv[3], 0)));
11249 return JIM_OK;
11250 } else if (option == OPT_RANGE) {
11251 Jim_Obj *objPtr;
11252
11253 if (argc != 5) {
11254 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11255 return JIM_ERR;
11256 }
11257 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11258 if (objPtr == NULL)
11259 return JIM_ERR;
11260 Jim_SetResult(interp, objPtr);
11261 return JIM_OK;
11262 } else if (option == OPT_MAP) {
11263 int nocase = 0;
11264 Jim_Obj *objPtr;
11265
11266 if ((argc != 4 && argc != 5) ||
11267 (argc == 5 && Jim_CompareStringImmediate(interp,
11268 argv[2], "-nocase") == 0)) {
11269 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11270 "string");
11271 return JIM_ERR;
11272 }
11273 if (argc == 5) {
11274 nocase = 1;
11275 argv++;
11276 }
11277 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11278 if (objPtr == NULL)
11279 return JIM_ERR;
11280 Jim_SetResult(interp, objPtr);
11281 return JIM_OK;
11282 } else if (option == OPT_REPEAT) {
11283 Jim_Obj *objPtr;
11284 jim_wide count;
11285
11286 if (argc != 4) {
11287 Jim_WrongNumArgs(interp, 2, argv, "string count");
11288 return JIM_ERR;
11289 }
11290 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11291 return JIM_ERR;
11292 objPtr = Jim_NewStringObj(interp, "", 0);
11293 while (count--) {
11294 Jim_AppendObj(interp, objPtr, argv[2]);
11295 }
11296 Jim_SetResult(interp, objPtr);
11297 return JIM_OK;
11298 } else if (option == OPT_INDEX) {
11299 int index, len;
11300 const char *str;
11301
11302 if (argc != 4) {
11303 Jim_WrongNumArgs(interp, 2, argv, "string index");
11304 return JIM_ERR;
11305 }
11306 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11307 return JIM_ERR;
11308 str = Jim_GetString(argv[2], &len);
11309 if (index != INT_MIN && index != INT_MAX)
11310 index = JimRelToAbsIndex(len, index);
11311 if (index < 0 || index >= len) {
11312 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11313 return JIM_OK;
11314 } else {
11315 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11316 return JIM_OK;
11317 }
11318 } else if (option == OPT_FIRST) {
11319 int index = 0, l1, l2;
11320 const char *s1, *s2;
11321
11322 if (argc != 4 && argc != 5) {
11323 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11324 return JIM_ERR;
11325 }
11326 s1 = Jim_GetString(argv[2], &l1);
11327 s2 = Jim_GetString(argv[3], &l2);
11328 if (argc == 5) {
11329 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11330 return JIM_ERR;
11331 index = JimRelToAbsIndex(l2, index);
11332 }
11333 Jim_SetResult(interp, Jim_NewIntObj(interp,
11334 JimStringFirst(s1, l1, s2, l2, index)));
11335 return JIM_OK;
11336 } else if (option == OPT_TOLOWER) {
11337 if (argc != 3) {
11338 Jim_WrongNumArgs(interp, 2, argv, "string");
11339 return JIM_ERR;
11340 }
11341 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11342 } else if (option == OPT_TOUPPER) {
11343 if (argc != 3) {
11344 Jim_WrongNumArgs(interp, 2, argv, "string");
11345 return JIM_ERR;
11346 }
11347 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11348 }
11349 return JIM_OK;
11350 }
11351
11352 /* [time] */
11353 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11354 Jim_Obj *const *argv)
11355 {
11356 long i, count = 1;
11357 jim_wide start, elapsed;
11358 char buf [256];
11359 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11360
11361 if (argc < 2) {
11362 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11363 return JIM_ERR;
11364 }
11365 if (argc == 3) {
11366 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11367 return JIM_ERR;
11368 }
11369 if (count < 0)
11370 return JIM_OK;
11371 i = count;
11372 start = JimClock();
11373 while (i-- > 0) {
11374 int retval;
11375
11376 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11377 return retval;
11378 }
11379 elapsed = JimClock() - start;
11380 sprintf(buf, fmt, elapsed/count);
11381 Jim_SetResultString(interp, buf, -1);
11382 return JIM_OK;
11383 }
11384
11385 /* [exit] */
11386 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11387 Jim_Obj *const *argv)
11388 {
11389 long exitCode = 0;
11390
11391 if (argc > 2) {
11392 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11393 return JIM_ERR;
11394 }
11395 if (argc == 2) {
11396 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11397 return JIM_ERR;
11398 }
11399 interp->exitCode = exitCode;
11400 return JIM_EXIT;
11401 }
11402
11403 /* [catch] */
11404 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11405 Jim_Obj *const *argv)
11406 {
11407 int exitCode = 0;
11408
11409 if (argc != 2 && argc != 3) {
11410 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11411 return JIM_ERR;
11412 }
11413 exitCode = Jim_EvalObj(interp, argv[1]);
11414 if (argc == 3) {
11415 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11416 != JIM_OK)
11417 return JIM_ERR;
11418 }
11419 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11420 return JIM_OK;
11421 }
11422
11423 /* [ref] */
11424 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11425 Jim_Obj *const *argv)
11426 {
11427 if (argc != 3 && argc != 4) {
11428 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11429 return JIM_ERR;
11430 }
11431 if (argc == 3) {
11432 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11433 } else {
11434 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11435 argv[3]));
11436 }
11437 return JIM_OK;
11438 }
11439
11440 /* [getref] */
11441 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11442 Jim_Obj *const *argv)
11443 {
11444 Jim_Reference *refPtr;
11445
11446 if (argc != 2) {
11447 Jim_WrongNumArgs(interp, 1, argv, "reference");
11448 return JIM_ERR;
11449 }
11450 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11451 return JIM_ERR;
11452 Jim_SetResult(interp, refPtr->objPtr);
11453 return JIM_OK;
11454 }
11455
11456 /* [setref] */
11457 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11458 Jim_Obj *const *argv)
11459 {
11460 Jim_Reference *refPtr;
11461
11462 if (argc != 3) {
11463 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11464 return JIM_ERR;
11465 }
11466 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11467 return JIM_ERR;
11468 Jim_IncrRefCount(argv[2]);
11469 Jim_DecrRefCount(interp, refPtr->objPtr);
11470 refPtr->objPtr = argv[2];
11471 Jim_SetResult(interp, argv[2]);
11472 return JIM_OK;
11473 }
11474
11475 /* [collect] */
11476 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11477 Jim_Obj *const *argv)
11478 {
11479 if (argc != 1) {
11480 Jim_WrongNumArgs(interp, 1, argv, "");
11481 return JIM_ERR;
11482 }
11483 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11484 return JIM_OK;
11485 }
11486
11487 /* [finalize] reference ?newValue? */
11488 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11489 Jim_Obj *const *argv)
11490 {
11491 if (argc != 2 && argc != 3) {
11492 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11493 return JIM_ERR;
11494 }
11495 if (argc == 2) {
11496 Jim_Obj *cmdNamePtr;
11497
11498 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11499 return JIM_ERR;
11500 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11501 Jim_SetResult(interp, cmdNamePtr);
11502 } else {
11503 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, argv[2]);
11506 }
11507 return JIM_OK;
11508 }
11509
11510 /* TODO */
11511 /* [info references] (list of all the references/finalizers) */
11512
11513 /* [rename] */
11514 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11515 Jim_Obj *const *argv)
11516 {
11517 const char *oldName, *newName;
11518
11519 if (argc != 3) {
11520 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11521 return JIM_ERR;
11522 }
11523 oldName = Jim_GetString(argv[1], NULL);
11524 newName = Jim_GetString(argv[2], NULL);
11525 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11526 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11527 Jim_AppendStrings(interp, Jim_GetResult(interp),
11528 "can't rename \"", oldName, "\": ",
11529 "command doesn't exist", NULL);
11530 return JIM_ERR;
11531 }
11532 return JIM_OK;
11533 }
11534
11535 /* [dict] */
11536 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11537 Jim_Obj *const *argv)
11538 {
11539 int option;
11540 const char *options[] = {
11541 "create", "get", "set", "unset", "exists", NULL
11542 };
11543 enum {
11544 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11545 };
11546
11547 if (argc < 2) {
11548 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11549 return JIM_ERR;
11550 }
11551
11552 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11553 JIM_ERRMSG) != JIM_OK)
11554 return JIM_ERR;
11555
11556 if (option == OPT_CREATE) {
11557 Jim_Obj *objPtr;
11558
11559 if (argc % 2) {
11560 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11561 return JIM_ERR;
11562 }
11563 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11564 Jim_SetResult(interp, objPtr);
11565 return JIM_OK;
11566 } else if (option == OPT_GET) {
11567 Jim_Obj *objPtr;
11568
11569 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11570 JIM_ERRMSG) != JIM_OK)
11571 return JIM_ERR;
11572 Jim_SetResult(interp, objPtr);
11573 return JIM_OK;
11574 } else if (option == OPT_SET) {
11575 if (argc < 5) {
11576 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11577 return JIM_ERR;
11578 }
11579 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11580 argv[argc-1]);
11581 } else if (option == OPT_UNSET) {
11582 if (argc < 4) {
11583 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11584 return JIM_ERR;
11585 }
11586 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11587 NULL);
11588 } else if (option == OPT_EXIST) {
11589 Jim_Obj *objPtr;
11590 int exists;
11591
11592 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11593 JIM_ERRMSG) == JIM_OK)
11594 exists = 1;
11595 else
11596 exists = 0;
11597 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11598 return JIM_OK;
11599 } else {
11600 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11601 Jim_AppendStrings(interp, Jim_GetResult(interp),
11602 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11603 " must be create, get, set", NULL);
11604 return JIM_ERR;
11605 }
11606 return JIM_OK;
11607 }
11608
11609 /* [load] */
11610 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11611 Jim_Obj *const *argv)
11612 {
11613 if (argc < 2) {
11614 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11615 return JIM_ERR;
11616 }
11617 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11618 }
11619
11620 /* [subst] */
11621 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11622 Jim_Obj *const *argv)
11623 {
11624 int i, flags = 0;
11625 Jim_Obj *objPtr;
11626
11627 if (argc < 2) {
11628 Jim_WrongNumArgs(interp, 1, argv,
11629 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11630 return JIM_ERR;
11631 }
11632 i = argc-2;
11633 while (i--) {
11634 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11635 "-nobackslashes"))
11636 flags |= JIM_SUBST_NOESC;
11637 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11638 "-novariables"))
11639 flags |= JIM_SUBST_NOVAR;
11640 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11641 "-nocommands"))
11642 flags |= JIM_SUBST_NOCMD;
11643 else {
11644 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11645 Jim_AppendStrings(interp, Jim_GetResult(interp),
11646 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11647 "\": must be -nobackslashes, -nocommands, or "
11648 "-novariables", NULL);
11649 return JIM_ERR;
11650 }
11651 }
11652 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11653 return JIM_ERR;
11654 Jim_SetResult(interp, objPtr);
11655 return JIM_OK;
11656 }
11657
11658 /* [info] */
11659 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11660 Jim_Obj *const *argv)
11661 {
11662 int cmd, result = JIM_OK;
11663 static const char *commands[] = {
11664 "body", "commands", "exists", "globals", "level", "locals",
11665 "vars", "version", "complete", "args", "hostname", NULL
11666 };
11667 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11668 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11669
11670 if (argc < 2) {
11671 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11672 return JIM_ERR;
11673 }
11674 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11675 != JIM_OK) {
11676 return JIM_ERR;
11677 }
11678
11679 if (cmd == INFO_COMMANDS) {
11680 if (argc != 2 && argc != 3) {
11681 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11682 return JIM_ERR;
11683 }
11684 if (argc == 3)
11685 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11686 else
11687 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11688 } else if (cmd == INFO_EXISTS) {
11689 Jim_Obj *exists;
11690 if (argc != 3) {
11691 Jim_WrongNumArgs(interp, 2, argv, "varName");
11692 return JIM_ERR;
11693 }
11694 exists = Jim_GetVariable(interp, argv[2], 0);
11695 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11696 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11697 int mode;
11698 switch (cmd) {
11699 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11700 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11701 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11702 default: mode = 0; /* avoid warning */; break;
11703 }
11704 if (argc != 2 && argc != 3) {
11705 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11706 return JIM_ERR;
11707 }
11708 if (argc == 3)
11709 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11710 else
11711 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11712 } else if (cmd == INFO_LEVEL) {
11713 Jim_Obj *objPtr;
11714 switch (argc) {
11715 case 2:
11716 Jim_SetResult(interp,
11717 Jim_NewIntObj(interp, interp->numLevels));
11718 break;
11719 case 3:
11720 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11721 return JIM_ERR;
11722 Jim_SetResult(interp, objPtr);
11723 break;
11724 default:
11725 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11726 return JIM_ERR;
11727 }
11728 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11729 Jim_Cmd *cmdPtr;
11730
11731 if (argc != 3) {
11732 Jim_WrongNumArgs(interp, 2, argv, "procname");
11733 return JIM_ERR;
11734 }
11735 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11736 return JIM_ERR;
11737 if (cmdPtr->cmdProc != NULL) {
11738 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11739 Jim_AppendStrings(interp, Jim_GetResult(interp),
11740 "command \"", Jim_GetString(argv[2], NULL),
11741 "\" is not a procedure", NULL);
11742 return JIM_ERR;
11743 }
11744 if (cmd == INFO_BODY)
11745 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11746 else
11747 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11748 } else if (cmd == INFO_VERSION) {
11749 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11750 sprintf(buf, "%d.%d",
11751 JIM_VERSION / 100, JIM_VERSION % 100);
11752 Jim_SetResultString(interp, buf, -1);
11753 } else if (cmd == INFO_COMPLETE) {
11754 const char *s;
11755 int len;
11756
11757 if (argc != 3) {
11758 Jim_WrongNumArgs(interp, 2, argv, "script");
11759 return JIM_ERR;
11760 }
11761 s = Jim_GetString(argv[2], &len);
11762 Jim_SetResult(interp,
11763 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11764 } else if (cmd == INFO_HOSTNAME) {
11765 /* Redirect to os.hostname if it exists */
11766 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11767 result = Jim_EvalObjVector(interp, 1, &command);
11768 }
11769 return result;
11770 }
11771
11772 /* [split] */
11773 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11774 Jim_Obj *const *argv)
11775 {
11776 const char *str, *splitChars, *noMatchStart;
11777 int splitLen, strLen, i;
11778 Jim_Obj *resObjPtr;
11779
11780 if (argc != 2 && argc != 3) {
11781 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11782 return JIM_ERR;
11783 }
11784 /* Init */
11785 if (argc == 2) {
11786 splitChars = " \n\t\r";
11787 splitLen = 4;
11788 } else {
11789 splitChars = Jim_GetString(argv[2], &splitLen);
11790 }
11791 str = Jim_GetString(argv[1], &strLen);
11792 if (!strLen) return JIM_OK;
11793 noMatchStart = str;
11794 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11795 /* Split */
11796 if (splitLen) {
11797 while (strLen) {
11798 for (i = 0; i < splitLen; i++) {
11799 if (*str == splitChars[i]) {
11800 Jim_Obj *objPtr;
11801
11802 objPtr = Jim_NewStringObj(interp, noMatchStart,
11803 (str-noMatchStart));
11804 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11805 noMatchStart = str + 1;
11806 break;
11807 }
11808 }
11809 str ++;
11810 strLen --;
11811 }
11812 Jim_ListAppendElement(interp, resObjPtr,
11813 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11814 } else {
11815 /* This handles the special case of splitchars eq {}. This
11816 * is trivial but we want to perform object sharing as Tcl does. */
11817 Jim_Obj *objCache[256];
11818 const unsigned char *u = (unsigned char*) str;
11819 memset(objCache, 0, sizeof(objCache));
11820 for (i = 0; i < strLen; i++) {
11821 int c = u[i];
11822
11823 if (objCache[c] == NULL)
11824 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11825 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11826 }
11827 }
11828 Jim_SetResult(interp, resObjPtr);
11829 return JIM_OK;
11830 }
11831
11832 /* [join] */
11833 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11834 Jim_Obj *const *argv)
11835 {
11836 const char *joinStr;
11837 int joinStrLen, i, listLen;
11838 Jim_Obj *resObjPtr;
11839
11840 if (argc != 2 && argc != 3) {
11841 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11842 return JIM_ERR;
11843 }
11844 /* Init */
11845 if (argc == 2) {
11846 joinStr = " ";
11847 joinStrLen = 1;
11848 } else {
11849 joinStr = Jim_GetString(argv[2], &joinStrLen);
11850 }
11851 Jim_ListLength(interp, argv[1], &listLen);
11852 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11853 /* Split */
11854 for (i = 0; i < listLen; i++) {
11855 Jim_Obj *objPtr;
11856
11857 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11858 Jim_AppendObj(interp, resObjPtr, objPtr);
11859 if (i + 1 != listLen) {
11860 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11861 }
11862 }
11863 Jim_SetResult(interp, resObjPtr);
11864 return JIM_OK;
11865 }
11866
11867 /* [format] */
11868 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11869 Jim_Obj *const *argv)
11870 {
11871 Jim_Obj *objPtr;
11872
11873 if (argc < 2) {
11874 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11875 return JIM_ERR;
11876 }
11877 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11878 if (objPtr == NULL)
11879 return JIM_ERR;
11880 Jim_SetResult(interp, objPtr);
11881 return JIM_OK;
11882 }
11883
11884 /* [scan] */
11885 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11886 Jim_Obj *const *argv)
11887 {
11888 Jim_Obj *listPtr, **outVec;
11889 int outc, i, count = 0;
11890
11891 if (argc < 3) {
11892 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11893 return JIM_ERR;
11894 }
11895 if (argv[2]->typePtr != &scanFmtStringObjType)
11896 SetScanFmtFromAny(interp, argv[2]);
11897 if (FormatGetError(argv[2]) != 0) {
11898 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11899 return JIM_ERR;
11900 }
11901 if (argc > 3) {
11902 int maxPos = FormatGetMaxPos(argv[2]);
11903 int count = FormatGetCnvCount(argv[2]);
11904 if (maxPos > argc-3) {
11905 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11906 return JIM_ERR;
11907 } else if (count != 0 && count < argc-3) {
11908 Jim_SetResultString(interp, "variable is not assigned by any "
11909 "conversion specifiers", -1);
11910 return JIM_ERR;
11911 } else if (count > argc-3) {
11912 Jim_SetResultString(interp, "different numbers of variable names and "
11913 "field specifiers", -1);
11914 return JIM_ERR;
11915 }
11916 }
11917 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11918 if (listPtr == 0)
11919 return JIM_ERR;
11920 if (argc > 3) {
11921 int len = 0;
11922 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11923 Jim_ListLength(interp, listPtr, &len);
11924 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11925 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11926 return JIM_OK;
11927 }
11928 JimListGetElements(interp, listPtr, &outc, &outVec);
11929 for (i = 0; i < outc; ++i) {
11930 if (Jim_Length(outVec[i]) > 0) {
11931 ++count;
11932 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11933 goto err;
11934 }
11935 }
11936 Jim_FreeNewObj(interp, listPtr);
11937 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11938 } else {
11939 if (listPtr == (Jim_Obj*)EOF) {
11940 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11941 return JIM_OK;
11942 }
11943 Jim_SetResult(interp, listPtr);
11944 }
11945 return JIM_OK;
11946 err:
11947 Jim_FreeNewObj(interp, listPtr);
11948 return JIM_ERR;
11949 }
11950
11951 /* [error] */
11952 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11953 Jim_Obj *const *argv)
11954 {
11955 if (argc != 2) {
11956 Jim_WrongNumArgs(interp, 1, argv, "message");
11957 return JIM_ERR;
11958 }
11959 Jim_SetResult(interp, argv[1]);
11960 return JIM_ERR;
11961 }
11962
11963 /* [lrange] */
11964 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11965 Jim_Obj *const *argv)
11966 {
11967 Jim_Obj *objPtr;
11968
11969 if (argc != 4) {
11970 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11971 return JIM_ERR;
11972 }
11973 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11974 return JIM_ERR;
11975 Jim_SetResult(interp, objPtr);
11976 return JIM_OK;
11977 }
11978
11979 /* [env] */
11980 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11981 Jim_Obj *const *argv)
11982 {
11983 const char *key;
11984 char *val;
11985
11986 if (argc == 1) {
11987
11988 #ifdef NEED_ENVIRON_EXTERN
11989 extern char **environ;
11990 #endif
11991
11992 int i;
11993 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11994
11995 for (i = 0; environ[i]; i++) {
11996 const char *equals = strchr(environ[i], '=');
11997 if (equals) {
11998 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11999 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12000 }
12001 }
12002
12003 Jim_SetResult(interp, listObjPtr);
12004 return JIM_OK;
12005 }
12006
12007 if (argc != 2) {
12008 Jim_WrongNumArgs(interp, 1, argv, "varName");
12009 return JIM_ERR;
12010 }
12011 key = Jim_GetString(argv[1], NULL);
12012 val = getenv(key);
12013 if (val == NULL) {
12014 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12015 Jim_AppendStrings(interp, Jim_GetResult(interp),
12016 "environment variable \"",
12017 key, "\" does not exist", NULL);
12018 return JIM_ERR;
12019 }
12020 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12021 return JIM_OK;
12022 }
12023
12024 /* [source] */
12025 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12026 Jim_Obj *const *argv)
12027 {
12028 int retval;
12029
12030 if (argc != 2) {
12031 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12032 return JIM_ERR;
12033 }
12034 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12035 if (retval == JIM_ERR) {
12036 return JIM_ERR_ADDSTACK;
12037 }
12038 if (retval == JIM_RETURN)
12039 return JIM_OK;
12040 return retval;
12041 }
12042
12043 /* [lreverse] */
12044 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12045 Jim_Obj *const *argv)
12046 {
12047 Jim_Obj *revObjPtr, **ele;
12048 int len;
12049
12050 if (argc != 2) {
12051 Jim_WrongNumArgs(interp, 1, argv, "list");
12052 return JIM_ERR;
12053 }
12054 JimListGetElements(interp, argv[1], &len, &ele);
12055 len--;
12056 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12057 while (len >= 0)
12058 ListAppendElement(revObjPtr, ele[len--]);
12059 Jim_SetResult(interp, revObjPtr);
12060 return JIM_OK;
12061 }
12062
12063 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12064 {
12065 jim_wide len;
12066
12067 if (step == 0) return -1;
12068 if (start == end) return 0;
12069 else if (step > 0 && start > end) return -1;
12070 else if (step < 0 && end > start) return -1;
12071 len = end-start;
12072 if (len < 0) len = -len; /* abs(len) */
12073 if (step < 0) step = -step; /* abs(step) */
12074 len = 1 + ((len-1)/step);
12075 /* We can truncate safely to INT_MAX, the range command
12076 * will always return an error for a such long range
12077 * because Tcl lists can't be so long. */
12078 if (len > INT_MAX) len = INT_MAX;
12079 return (int)((len < 0) ? -1 : len);
12080 }
12081
12082 /* [range] */
12083 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12084 Jim_Obj *const *argv)
12085 {
12086 jim_wide start = 0, end, step = 1;
12087 int len, i;
12088 Jim_Obj *objPtr;
12089
12090 if (argc < 2 || argc > 4) {
12091 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12092 return JIM_ERR;
12093 }
12094 if (argc == 2) {
12095 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12096 return JIM_ERR;
12097 } else {
12098 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12099 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12100 return JIM_ERR;
12101 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12102 return JIM_ERR;
12103 }
12104 if ((len = JimRangeLen(start, end, step)) == -1) {
12105 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12106 return JIM_ERR;
12107 }
12108 objPtr = Jim_NewListObj(interp, NULL, 0);
12109 for (i = 0; i < len; i++)
12110 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12111 Jim_SetResult(interp, objPtr);
12112 return JIM_OK;
12113 }
12114
12115 /* [rand] */
12116 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12117 Jim_Obj *const *argv)
12118 {
12119 jim_wide min = 0, max, len, maxMul;
12120
12121 if (argc < 1 || argc > 3) {
12122 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12123 return JIM_ERR;
12124 }
12125 if (argc == 1) {
12126 max = JIM_WIDE_MAX;
12127 } else if (argc == 2) {
12128 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12129 return JIM_ERR;
12130 } else if (argc == 3) {
12131 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12132 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12133 return JIM_ERR;
12134 }
12135 len = max-min;
12136 if (len < 0) {
12137 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12138 return JIM_ERR;
12139 }
12140 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12141 while (1) {
12142 jim_wide r;
12143
12144 JimRandomBytes(interp, &r, sizeof(jim_wide));
12145 if (r < 0 || r >= maxMul) continue;
12146 r = (len == 0) ? 0 : r%len;
12147 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12148 return JIM_OK;
12149 }
12150 }
12151
12152 /* [package] */
12153 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12154 Jim_Obj *const *argv)
12155 {
12156 int option;
12157 const char *options[] = {
12158 "require", "provide", NULL
12159 };
12160 enum {OPT_REQUIRE, OPT_PROVIDE};
12161
12162 if (argc < 2) {
12163 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12164 return JIM_ERR;
12165 }
12166 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12167 JIM_ERRMSG) != JIM_OK)
12168 return JIM_ERR;
12169
12170 if (option == OPT_REQUIRE) {
12171 int exact = 0;
12172 const char *ver;
12173
12174 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12175 exact = 1;
12176 argv++;
12177 argc--;
12178 }
12179 if (argc != 3 && argc != 4) {
12180 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12181 return JIM_ERR;
12182 }
12183 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12184 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12185 JIM_ERRMSG);
12186 if (ver == NULL)
12187 return JIM_ERR_ADDSTACK;
12188 Jim_SetResultString(interp, ver, -1);
12189 } else if (option == OPT_PROVIDE) {
12190 if (argc != 4) {
12191 Jim_WrongNumArgs(interp, 2, argv, "package version");
12192 return JIM_ERR;
12193 }
12194 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12195 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12196 }
12197 return JIM_OK;
12198 }
12199
12200 static struct {
12201 const char *name;
12202 Jim_CmdProc cmdProc;
12203 } Jim_CoreCommandsTable[] = {
12204 {"set", Jim_SetCoreCommand},
12205 {"unset", Jim_UnsetCoreCommand},
12206 {"puts", Jim_PutsCoreCommand},
12207 {"+", Jim_AddCoreCommand},
12208 {"*", Jim_MulCoreCommand},
12209 {"-", Jim_SubCoreCommand},
12210 {"/", Jim_DivCoreCommand},
12211 {"incr", Jim_IncrCoreCommand},
12212 {"while", Jim_WhileCoreCommand},
12213 {"for", Jim_ForCoreCommand},
12214 {"foreach", Jim_ForeachCoreCommand},
12215 {"lmap", Jim_LmapCoreCommand},
12216 {"if", Jim_IfCoreCommand},
12217 {"switch", Jim_SwitchCoreCommand},
12218 {"list", Jim_ListCoreCommand},
12219 {"lindex", Jim_LindexCoreCommand},
12220 {"lset", Jim_LsetCoreCommand},
12221 {"llength", Jim_LlengthCoreCommand},
12222 {"lappend", Jim_LappendCoreCommand},
12223 {"linsert", Jim_LinsertCoreCommand},
12224 {"lsort", Jim_LsortCoreCommand},
12225 {"append", Jim_AppendCoreCommand},
12226 {"debug", Jim_DebugCoreCommand},
12227 {"eval", Jim_EvalCoreCommand},
12228 {"uplevel", Jim_UplevelCoreCommand},
12229 {"expr", Jim_ExprCoreCommand},
12230 {"break", Jim_BreakCoreCommand},
12231 {"continue", Jim_ContinueCoreCommand},
12232 {"proc", Jim_ProcCoreCommand},
12233 {"concat", Jim_ConcatCoreCommand},
12234 {"return", Jim_ReturnCoreCommand},
12235 {"upvar", Jim_UpvarCoreCommand},
12236 {"global", Jim_GlobalCoreCommand},
12237 {"string", Jim_StringCoreCommand},
12238 {"time", Jim_TimeCoreCommand},
12239 {"exit", Jim_ExitCoreCommand},
12240 {"catch", Jim_CatchCoreCommand},
12241 {"ref", Jim_RefCoreCommand},
12242 {"getref", Jim_GetrefCoreCommand},
12243 {"setref", Jim_SetrefCoreCommand},
12244 {"finalize", Jim_FinalizeCoreCommand},
12245 {"collect", Jim_CollectCoreCommand},
12246 {"rename", Jim_RenameCoreCommand},
12247 {"dict", Jim_DictCoreCommand},
12248 {"load", Jim_LoadCoreCommand},
12249 {"subst", Jim_SubstCoreCommand},
12250 {"info", Jim_InfoCoreCommand},
12251 {"split", Jim_SplitCoreCommand},
12252 {"join", Jim_JoinCoreCommand},
12253 {"format", Jim_FormatCoreCommand},
12254 {"scan", Jim_ScanCoreCommand},
12255 {"error", Jim_ErrorCoreCommand},
12256 {"lrange", Jim_LrangeCoreCommand},
12257 {"env", Jim_EnvCoreCommand},
12258 {"source", Jim_SourceCoreCommand},
12259 {"lreverse", Jim_LreverseCoreCommand},
12260 {"range", Jim_RangeCoreCommand},
12261 {"rand", Jim_RandCoreCommand},
12262 {"package", Jim_PackageCoreCommand},
12263 {"tailcall", Jim_TailcallCoreCommand},
12264 {NULL, NULL},
12265 };
12266
12267 /* Some Jim core command is actually a procedure written in Jim itself. */
12268 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12269 {
12270 Jim_Eval(interp, (char*)
12271 "proc lambda {arglist args} {\n"
12272 " set name [ref {} function lambdaFinalizer]\n"
12273 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12274 " return $name\n"
12275 "}\n"
12276 "proc lambdaFinalizer {name val} {\n"
12277 " rename $name {}\n"
12278 "}\n"
12279 );
12280 }
12281
12282 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12283 {
12284 int i = 0;
12285
12286 while (Jim_CoreCommandsTable[i].name != NULL) {
12287 Jim_CreateCommand(interp,
12288 Jim_CoreCommandsTable[i].name,
12289 Jim_CoreCommandsTable[i].cmdProc,
12290 NULL, NULL);
12291 i++;
12292 }
12293 Jim_RegisterCoreProcedures(interp);
12294 }
12295
12296 /* -----------------------------------------------------------------------------
12297 * Interactive prompt
12298 * ---------------------------------------------------------------------------*/
12299 void Jim_PrintErrorMessage(Jim_Interp *interp)
12300 {
12301 int len, i;
12302
12303 if (*interp->errorFileName) {
12304 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12305 interp->errorFileName, interp->errorLine);
12306 }
12307 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12308 Jim_GetString(interp->result, NULL));
12309 Jim_ListLength(interp, interp->stackTrace, &len);
12310 for (i = len-3; i >= 0; i-= 3) {
12311 Jim_Obj *objPtr;
12312 const char *proc, *file, *line;
12313
12314 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12315 proc = Jim_GetString(objPtr, NULL);
12316 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12317 JIM_NONE);
12318 file = Jim_GetString(objPtr, NULL);
12319 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12320 JIM_NONE);
12321 line = Jim_GetString(objPtr, NULL);
12322 if (*proc) {
12323 Jim_fprintf(interp, interp->cookie_stderr,
12324 "in procedure '%s' ", proc);
12325 }
12326 if (*file) {
12327 Jim_fprintf(interp, interp->cookie_stderr,
12328 "called at file \"%s\", line %s",
12329 file, line);
12330 }
12331 if (*file || *proc) {
12332 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12333 }
12334 }
12335 }
12336
12337 int Jim_InteractivePrompt(Jim_Interp *interp)
12338 {
12339 int retcode = JIM_OK;
12340 Jim_Obj *scriptObjPtr;
12341
12342 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12343 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12344 JIM_VERSION / 100, JIM_VERSION % 100);
12345 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12346 while (1) {
12347 char buf[1024];
12348 const char *result;
12349 const char *retcodestr[] = {
12350 "ok", "error", "return", "break", "continue", "eval", "exit"
12351 };
12352 int reslen;
12353
12354 if (retcode != 0) {
12355 if (retcode >= 2 && retcode <= 6)
12356 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12357 else
12358 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12359 } else
12360 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12361 Jim_fflush(interp, interp->cookie_stdout);
12362 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12363 Jim_IncrRefCount(scriptObjPtr);
12364 while (1) {
12365 const char *str;
12366 char state;
12367 int len;
12368
12369 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12370 Jim_DecrRefCount(interp, scriptObjPtr);
12371 goto out;
12372 }
12373 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12374 str = Jim_GetString(scriptObjPtr, &len);
12375 if (Jim_ScriptIsComplete(str, len, &state))
12376 break;
12377 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12378 Jim_fflush(interp, interp->cookie_stdout);
12379 }
12380 retcode = Jim_EvalObj(interp, scriptObjPtr);
12381 Jim_DecrRefCount(interp, scriptObjPtr);
12382 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12383 if (retcode == JIM_ERR) {
12384 Jim_PrintErrorMessage(interp);
12385 } else if (retcode == JIM_EXIT) {
12386 exit(Jim_GetExitCode(interp));
12387 } else {
12388 if (reslen) {
12389 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12390 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12391 }
12392 }
12393 }
12394 out:
12395 return 0;
12396 }
12397
12398 /* -----------------------------------------------------------------------------
12399 * Jim's idea of STDIO..
12400 * ---------------------------------------------------------------------------*/
12401
12402 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ... )
12403 {
12404 int r;
12405
12406 va_list ap;
12407 va_start(ap,fmt);
12408 r = Jim_vfprintf(interp, cookie, fmt,ap );
12409 va_end(ap);
12410 return r;
12411 }
12412
12413 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12414 {
12415 if ((interp == NULL) || (interp->cb_vfprintf == NULL) ){
12416 errno = ENOTSUP;
12417 return -1;
12418 }
12419 return (*(interp->cb_vfprintf))(cookie, fmt, ap );
12420 }
12421
12422 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12423 {
12424 if ((interp == NULL) || (interp->cb_fwrite == NULL) ){
12425 errno = ENOTSUP;
12426 return 0;
12427 }
12428 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12429 }
12430
12431 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12432 {
12433 if ((interp == NULL) || (interp->cb_fread == NULL) ){
12434 errno = ENOTSUP;
12435 return 0;
12436 }
12437 return (*(interp->cb_fread))(ptr, size, n, cookie);
12438 }
12439
12440 int Jim_fflush(Jim_Interp *interp, void *cookie )
12441 {
12442 if ((interp == NULL) || (interp->cb_fflush == NULL) ){
12443 /* pretend all is well */
12444 return 0;
12445 }
12446 return (*(interp->cb_fflush))(cookie );
12447 }
12448
12449 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie )
12450 {
12451 if ((interp == NULL) || (interp->cb_fgets == NULL) ){
12452 errno = ENOTSUP;
12453 return NULL;
12454 }
12455 return (*(interp->cb_fgets))(s, size, cookie );
12456 }
12457 Jim_Nvp *
12458 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name )
12459 {
12460 while (p->name ){
12461 if (0 == strcmp(name, p->name ) ){
12462 break;
12463 }
12464 p++;
12465 }
12466 return ((Jim_Nvp *)(p));
12467 }
12468
12469 Jim_Nvp *
12470 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name )
12471 {
12472 while (p->name ){
12473 if (0 == strcasecmp(name, p->name ) ){
12474 break;
12475 }
12476 p++;
12477 }
12478 return ((Jim_Nvp *)(p));
12479 }
12480
12481 int
12482 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12483 const Jim_Nvp *p,
12484 Jim_Obj *o,
12485 Jim_Nvp **result )
12486 {
12487 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL ), result );
12488 }
12489
12490
12491 int
12492 Jim_Nvp_name2value(Jim_Interp *interp,
12493 const Jim_Nvp *_p,
12494 const char *name,
12495 Jim_Nvp **result)
12496 {
12497 const Jim_Nvp *p;
12498
12499 p = Jim_Nvp_name2value_simple(_p, name );
12500
12501 /* result */
12502 if (result ){
12503 *result = (Jim_Nvp *)(p);
12504 }
12505
12506 /* found? */
12507 if (p->name ){
12508 return JIM_OK;
12509 } else {
12510 return JIM_ERR;
12511 }
12512 }
12513
12514 int
12515 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12516 {
12517 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL ), puthere );
12518 }
12519
12520 int
12521 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12522 {
12523 const Jim_Nvp *p;
12524
12525 p = Jim_Nvp_name2value_nocase_simple(_p, name );
12526
12527 if (puthere ){
12528 *puthere = (Jim_Nvp *)(p);
12529 }
12530 /* found */
12531 if (p->name ){
12532 return JIM_OK;
12533 } else {
12534 return JIM_ERR;
12535 }
12536 }
12537
12538
12539 int
12540 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12541 {
12542 int e;;
12543 jim_wide w;
12544
12545 e = Jim_GetWide(interp, o, &w );
12546 if (e != JIM_OK ){
12547 return e;
12548 }
12549
12550 return Jim_Nvp_value2name(interp, p, w, result );
12551 }
12552
12553 Jim_Nvp *
12554 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value )
12555 {
12556 while (p->name ){
12557 if (value == p->value ){
12558 break;
12559 }
12560 p++;
12561 }
12562 return ((Jim_Nvp *)(p));
12563 }
12564
12565
12566 int
12567 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12568 {
12569 const Jim_Nvp *p;
12570
12571 p = Jim_Nvp_value2name_simple(_p, value );
12572
12573 if (result ){
12574 *result = (Jim_Nvp *)(p);
12575 }
12576
12577 if (p->name ){
12578 return JIM_OK;
12579 } else {
12580 return JIM_ERR;
12581 }
12582 }
12583
12584
12585 int
12586 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12587 {
12588 memset(p, 0, sizeof(*p) );
12589 p->interp = interp;
12590 p->argc = argc;
12591 p->argv = argv;
12592
12593 return JIM_OK;
12594 }
12595
12596 void
12597 Jim_GetOpt_Debug(Jim_GetOptInfo *p )
12598 {
12599 int x;
12600
12601 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12602 for (x = 0 ; x < p->argc ; x++ ){
12603 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12604 "%2d) %s\n",
12605 x,
12606 Jim_GetString(p->argv[x], NULL ) );
12607 }
12608 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12609 }
12610
12611
12612 int
12613 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere )
12614 {
12615 Jim_Obj *o;
12616
12617 o = NULL; // failure
12618 if (goi->argc ){
12619 // success
12620 o = goi->argv[0];
12621 goi->argc -= 1;
12622 goi->argv += 1;
12623 }
12624 if (puthere ){
12625 *puthere = o;
12626 }
12627 if (o != NULL ){
12628 return JIM_OK;
12629 } else {
12630 return JIM_ERR;
12631 }
12632 }
12633
12634 int
12635 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len )
12636 {
12637 int r;
12638 Jim_Obj *o;
12639 const char *cp;
12640
12641
12642 r = Jim_GetOpt_Obj(goi, &o );
12643 if (r == JIM_OK ){
12644 cp = Jim_GetString(o, len );
12645 if (puthere ){
12646 /* remove const */
12647 *puthere = (char *)(cp);
12648 }
12649 }
12650 return r;
12651 }
12652
12653 int
12654 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere )
12655 {
12656 int r;
12657 Jim_Obj *o;
12658 double _safe;
12659
12660 if (puthere == NULL ){
12661 puthere = &_safe;
12662 }
12663
12664 r = Jim_GetOpt_Obj(goi, &o );
12665 if (r == JIM_OK ){
12666 r = Jim_GetDouble(goi->interp, o, puthere );
12667 if (r != JIM_OK ){
12668 Jim_SetResult_sprintf(goi->interp,
12669 "not a number: %s",
12670 Jim_GetString(o, NULL ) );
12671 }
12672 }
12673 return r;
12674 }
12675
12676 int
12677 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere )
12678 {
12679 int r;
12680 Jim_Obj *o;
12681 jim_wide _safe;
12682
12683 if (puthere == NULL ){
12684 puthere = &_safe;
12685 }
12686
12687 r = Jim_GetOpt_Obj(goi, &o );
12688 if (r == JIM_OK ){
12689 r = Jim_GetWide(goi->interp, o, puthere );
12690 }
12691 return r;
12692 }
12693
12694 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12695 const Jim_Nvp *nvp,
12696 Jim_Nvp **puthere)
12697 {
12698 Jim_Nvp *_safe;
12699 Jim_Obj *o;
12700 int e;
12701
12702 if (puthere == NULL ){
12703 puthere = &_safe;
12704 }
12705
12706 e = Jim_GetOpt_Obj(goi, &o );
12707 if (e == JIM_OK ){
12708 e = Jim_Nvp_name2value_obj(goi->interp,
12709 nvp,
12710 o,
12711 puthere );
12712 }
12713
12714 return e;
12715 }
12716
12717 void
12718 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12719 const Jim_Nvp *nvptable,
12720 int hadprefix )
12721 {
12722 if (hadprefix ){
12723 Jim_SetResult_NvpUnknown(goi->interp,
12724 goi->argv[-2],
12725 goi->argv[-1],
12726 nvptable );
12727 } else {
12728 Jim_SetResult_NvpUnknown(goi->interp,
12729 NULL,
12730 goi->argv[-1],
12731 nvptable );
12732 }
12733 }
12734
12735
12736 int
12737 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12738 const char * const * lookup,
12739 int *puthere)
12740 {
12741 int _safe;
12742 Jim_Obj *o;
12743 int e;
12744
12745 if (puthere == NULL ){
12746 puthere = &_safe;
12747 }
12748 e = Jim_GetOpt_Obj(goi, &o );
12749 if (e == JIM_OK ){
12750 e = Jim_GetEnum(goi->interp,
12751 o,
12752 lookup,
12753 puthere,
12754 "option",
12755 JIM_ERRMSG );
12756 }
12757 return e;
12758 }
12759
12760
12761
12762 int
12763 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,... )
12764 {
12765 va_list ap;
12766 char *buf;
12767
12768 va_start(ap,fmt);
12769 buf = jim_vasprintf(fmt, ap );
12770 va_end(ap);
12771 if (buf ){
12772 Jim_SetResultString(interp, buf, -1 );
12773 jim_vasprintf_done(buf);
12774 }
12775 return JIM_OK;
12776 }
12777
12778
12779 void
12780 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12781 Jim_Obj *param_name,
12782 Jim_Obj *param_value,
12783 const Jim_Nvp *nvp )
12784 {
12785 if (param_name ){
12786 Jim_SetResult_sprintf(interp,
12787 "%s: Unknown: %s, try one of: ",
12788 Jim_GetString(param_name, NULL ),
12789 Jim_GetString(param_value, NULL ) );
12790 } else {
12791 Jim_SetResult_sprintf(interp,
12792 "Unknown param: %s, try one of: ",
12793 Jim_GetString(param_value, NULL ) );
12794 }
12795 while (nvp->name ){
12796 const char *a;
12797 const char *b;
12798
12799 if ((nvp + 1)->name ){
12800 a = nvp->name;
12801 b = ", ";
12802 } else {
12803 a = "or ";
12804 b = nvp->name;
12805 }
12806 Jim_AppendStrings(interp,
12807 Jim_GetResult(interp),
12808 a, b, NULL );
12809 nvp++;
12810 }
12811 }
12812
12813
12814 static Jim_Obj *debug_string_obj;
12815
12816 const char *
12817 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12818 {
12819 int x;
12820
12821 if (debug_string_obj ){
12822 Jim_FreeObj(interp, debug_string_obj );
12823 }
12824
12825 debug_string_obj = Jim_NewEmptyStringObj(interp );
12826 for (x = 0 ; x < argc ; x++ ){
12827 Jim_AppendStrings(interp,
12828 debug_string_obj,
12829 Jim_GetString(argv[x], NULL ),
12830 " ",
12831 NULL );
12832 }
12833
12834 return Jim_GetString(debug_string_obj, NULL );
12835 }

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)