Alan Carvalho de Assis <acassis@gmail.com> imx31pdk.cfg reset init event
[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 #define __JIM_CORE__
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44
45 #ifdef __ECOS
46 #include <pkgconf/jimtcl.h>
47 #endif
48 #ifndef JIM_ANSIC
49 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
50 #endif /* JIM_ANSIC */
51
52 #define _GNU_SOURCE /* for vasprintf() */
53 #include <stdio.h>
54 #include <stdlib.h>
55 #include <string.h>
56 #include <stdarg.h>
57 #include <ctype.h>
58 #include <limits.h>
59 #include <assert.h>
60 #include <errno.h>
61 #include <time.h>
62 #if defined(WIN32)
63 /* sys/time - need is different */
64 #else
65 #include <sys/time.h> // for gettimeofday()
66 #endif
67
68 #include "replacements.h"
69
70 /* Include the platform dependent libraries for
71 * dynamic loading of libraries. */
72 #ifdef JIM_DYNLIB
73 #if defined(_WIN32) || defined(WIN32)
74 #ifndef WIN32
75 #define WIN32 1
76 #endif
77 #ifndef STRICT
78 #define STRICT
79 #endif
80 #define WIN32_LEAN_AND_MEAN
81 #include <windows.h>
82 #if _MSC_VER >= 1000
83 #pragma warning(disable:4146)
84 #endif /* _MSC_VER */
85 #else
86 #include <dlfcn.h>
87 #endif /* WIN32 */
88 #endif /* JIM_DYNLIB */
89
90 #ifndef WIN32
91 #include <unistd.h>
92 #endif
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType JimVariablesHashTableType;
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf( const char *fmt, va_list ap )
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf( buf, sizeof(buf), fmt, ap );
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 vasprintf( &buf, fmt, ap );
137 #endif
138 return buf;
139 }
140
141 static void
142 jim_vasprintf_done( void *buf )
143 {
144 #ifndef HAVE_VASPRINTF
145 (void)(buf);
146 #else
147 free(buf);
148 #endif
149 }
150
151
152 /*
153 * Convert a string to a jim_wide INTEGER.
154 * This function originates from BSD.
155 *
156 * Ignores `locale' stuff. Assumes that the upper and lower case
157 * alphabets and digits are each contiguous.
158 */
159 #ifdef HAVE_LONG_LONG
160 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
161 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
162 {
163 register const char *s;
164 register unsigned jim_wide acc;
165 register unsigned char c;
166 register unsigned jim_wide qbase, cutoff;
167 register int neg, any, cutlim;
168
169 /*
170 * Skip white space and pick up leading +/- sign if any.
171 * If base is 0, allow 0x for hex and 0 for octal, else
172 * assume decimal; if base is already 16, allow 0x.
173 */
174 s = nptr;
175 do {
176 c = *s++;
177 } while (isspace(c));
178 if (c == '-') {
179 neg = 1;
180 c = *s++;
181 } else {
182 neg = 0;
183 if (c == '+')
184 c = *s++;
185 }
186 if ((base == 0 || base == 16) &&
187 c == '0' && (*s == 'x' || *s == 'X')) {
188 c = s[1];
189 s += 2;
190 base = 16;
191 }
192 if (base == 0)
193 base = c == '0' ? 8 : 10;
194
195 /*
196 * Compute the cutoff value between legal numbers and illegal
197 * numbers. That is the largest legal value, divided by the
198 * base. An input number that is greater than this value, if
199 * followed by a legal input character, is too big. One that
200 * is equal to this value may be valid or not; the limit
201 * between valid and invalid numbers is then based on the last
202 * digit. For instance, if the range for quads is
203 * [-9223372036854775808..9223372036854775807] and the input base
204 * is 10, cutoff will be set to 922337203685477580 and cutlim to
205 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
206 * accumulated a value > 922337203685477580, or equal but the
207 * next digit is > 7 (or 8), the number is too big, and we will
208 * return a range error.
209 *
210 * Set any if any `digits' consumed; make it negative to indicate
211 * overflow.
212 */
213 qbase = (unsigned)base;
214 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
215 : LLONG_MAX;
216 cutlim = (int)(cutoff % qbase);
217 cutoff /= qbase;
218 for (acc = 0, any = 0;; c = *s++) {
219 if (!JimIsAscii(c))
220 break;
221 if (isdigit(c))
222 c -= '0';
223 else if (isalpha(c))
224 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
225 else
226 break;
227 if (c >= base)
228 break;
229 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
230 any = -1;
231 else {
232 any = 1;
233 acc *= qbase;
234 acc += c;
235 }
236 }
237 if (any < 0) {
238 acc = neg ? LLONG_MIN : LLONG_MAX;
239 errno = ERANGE;
240 } else if (neg)
241 acc = -acc;
242 if (endptr != 0)
243 *endptr = (char *)(any ? s - 1 : nptr);
244 return (acc);
245 }
246 #endif
247
248 /* Glob-style pattern matching. */
249 static int JimStringMatch(const char *pattern, int patternLen,
250 const char *string, int stringLen, int nocase)
251 {
252 while(patternLen) {
253 switch(pattern[0]) {
254 case '*':
255 while (pattern[1] == '*') {
256 pattern++;
257 patternLen--;
258 }
259 if (patternLen == 1)
260 return 1; /* match */
261 while(stringLen) {
262 if (JimStringMatch(pattern+1, patternLen-1,
263 string, stringLen, nocase))
264 return 1; /* match */
265 string++;
266 stringLen--;
267 }
268 return 0; /* no match */
269 break;
270 case '?':
271 if (stringLen == 0)
272 return 0; /* no match */
273 string++;
274 stringLen--;
275 break;
276 case '[':
277 {
278 int not, match;
279
280 pattern++;
281 patternLen--;
282 not = pattern[0] == '^';
283 if (not) {
284 pattern++;
285 patternLen--;
286 }
287 match = 0;
288 while(1) {
289 if (pattern[0] == '\\') {
290 pattern++;
291 patternLen--;
292 if (pattern[0] == string[0])
293 match = 1;
294 } else if (pattern[0] == ']') {
295 break;
296 } else if (patternLen == 0) {
297 pattern--;
298 patternLen++;
299 break;
300 } else if (pattern[1] == '-' && patternLen >= 3) {
301 int start = pattern[0];
302 int end = pattern[2];
303 int c = string[0];
304 if (start > end) {
305 int t = start;
306 start = end;
307 end = t;
308 }
309 if (nocase) {
310 start = tolower(start);
311 end = tolower(end);
312 c = tolower(c);
313 }
314 pattern += 2;
315 patternLen -= 2;
316 if (c >= start && c <= end)
317 match = 1;
318 } else {
319 if (!nocase) {
320 if (pattern[0] == string[0])
321 match = 1;
322 } else {
323 if (tolower((int)pattern[0]) == tolower((int)string[0]))
324 match = 1;
325 }
326 }
327 pattern++;
328 patternLen--;
329 }
330 if (not)
331 match = !match;
332 if (!match)
333 return 0; /* no match */
334 string++;
335 stringLen--;
336 break;
337 }
338 case '\\':
339 if (patternLen >= 2) {
340 pattern++;
341 patternLen--;
342 }
343 /* fall through */
344 default:
345 if (!nocase) {
346 if (pattern[0] != string[0])
347 return 0; /* no match */
348 } else {
349 if (tolower((int)pattern[0]) != tolower((int)string[0]))
350 return 0; /* no match */
351 }
352 string++;
353 stringLen--;
354 break;
355 }
356 pattern++;
357 patternLen--;
358 if (stringLen == 0) {
359 while(*pattern == '*') {
360 pattern++;
361 patternLen--;
362 }
363 break;
364 }
365 }
366 if (patternLen == 0 && stringLen == 0)
367 return 1;
368 return 0;
369 }
370
371 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
372 int nocase)
373 {
374 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
375
376 if (nocase == 0) {
377 while(l1 && l2) {
378 if (*u1 != *u2)
379 return (int)*u1-*u2;
380 u1++; u2++; l1--; l2--;
381 }
382 if (!l1 && !l2) return 0;
383 return l1-l2;
384 } else {
385 while(l1 && l2) {
386 if (tolower((int)*u1) != tolower((int)*u2))
387 return tolower((int)*u1)-tolower((int)*u2);
388 u1++; u2++; l1--; l2--;
389 }
390 if (!l1 && !l2) return 0;
391 return l1-l2;
392 }
393 }
394
395 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
396 * The index of the first occurrence of s1 in s2 is returned.
397 * If s1 is not found inside s2, -1 is returned. */
398 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
399 {
400 int i;
401
402 if (!l1 || !l2 || l1 > l2) return -1;
403 if (index < 0) index = 0;
404 s2 += index;
405 for (i = index; i <= l2-l1; i++) {
406 if (memcmp(s2, s1, l1) == 0)
407 return i;
408 s2++;
409 }
410 return -1;
411 }
412
413 int Jim_WideToString(char *buf, jim_wide wideValue)
414 {
415 const char *fmt = "%" JIM_WIDE_MODIFIER;
416 return sprintf(buf, fmt, wideValue);
417 }
418
419 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
420 {
421 char *endptr;
422
423 #ifdef HAVE_LONG_LONG
424 *widePtr = JimStrtoll(str, &endptr, base);
425 #else
426 *widePtr = strtol(str, &endptr, base);
427 #endif
428 if ((str[0] == '\0') || (str == endptr) )
429 return JIM_ERR;
430 if (endptr[0] != '\0') {
431 while(*endptr) {
432 if (!isspace((int)*endptr))
433 return JIM_ERR;
434 endptr++;
435 }
436 }
437 return JIM_OK;
438 }
439
440 int Jim_StringToIndex(const char *str, int *intPtr)
441 {
442 char *endptr;
443
444 *intPtr = strtol(str, &endptr, 10);
445 if ( (str[0] == '\0') || (str == endptr) )
446 return JIM_ERR;
447 if (endptr[0] != '\0') {
448 while(*endptr) {
449 if (!isspace((int)*endptr))
450 return JIM_ERR;
451 endptr++;
452 }
453 }
454 return JIM_OK;
455 }
456
457 /* The string representation of references has two features in order
458 * to make the GC faster. The first is that every reference starts
459 * with a non common character '~', in order to make the string matching
460 * fater. The second is that the reference string rep his 32 characters
461 * in length, this allows to avoid to check every object with a string
462 * repr < 32, and usually there are many of this objects. */
463
464 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
465
466 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
467 {
468 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
469 sprintf(buf, fmt, refPtr->tag, id);
470 return JIM_REFERENCE_SPACE;
471 }
472
473 int Jim_DoubleToString(char *buf, double doubleValue)
474 {
475 char *s;
476 int len;
477
478 len = sprintf(buf, "%.17g", doubleValue);
479 s = buf;
480 while(*s) {
481 if (*s == '.') return len;
482 s++;
483 }
484 /* Add a final ".0" if it's a number. But not
485 * for NaN or InF */
486 if (isdigit((int)buf[0])
487 || ((buf[0] == '-' || buf[0] == '+')
488 && isdigit((int)buf[1]))) {
489 s[0] = '.';
490 s[1] = '0';
491 s[2] = '\0';
492 return len+2;
493 }
494 return len;
495 }
496
497 int Jim_StringToDouble(const char *str, double *doublePtr)
498 {
499 char *endptr;
500
501 *doublePtr = strtod(str, &endptr);
502 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
503 return JIM_ERR;
504 return JIM_OK;
505 }
506
507 static jim_wide JimPowWide(jim_wide b, jim_wide e)
508 {
509 jim_wide i, res = 1;
510 if ((b==0 && e!=0) || (e<0)) return 0;
511 for(i=0; i<e; i++) {res *= b;}
512 return res;
513 }
514
515 /* -----------------------------------------------------------------------------
516 * Special functions
517 * ---------------------------------------------------------------------------*/
518
519 /* Note that 'interp' may be NULL if not available in the
520 * context of the panic. It's only useful to get the error
521 * file descriptor, it will default to stderr otherwise. */
522 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
523 {
524 va_list ap;
525
526 va_start(ap, fmt);
527 /*
528 * Send it here first.. Assuming STDIO still works
529 */
530 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
531 vfprintf(stderr, fmt, ap);
532 fprintf(stderr, JIM_NL JIM_NL);
533 va_end(ap);
534
535 #ifdef HAVE_BACKTRACE
536 {
537 void *array[40];
538 int size, i;
539 char **strings;
540
541 size = backtrace(array, 40);
542 strings = backtrace_symbols(array, size);
543 for (i = 0; i < size; i++)
544 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
545 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
546 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
547 }
548 #endif
549
550 /* This may actually crash... we do it last */
551 if( interp && interp->cookie_stderr ){
552 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
553 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
554 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
555 }
556 abort();
557 }
558
559 /* -----------------------------------------------------------------------------
560 * Memory allocation
561 * ---------------------------------------------------------------------------*/
562
563 /* Macro used for memory debugging.
564 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
565 * and similary for Jim_Realloc and Jim_Free */
566 #if 0
567 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
568 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
569 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
570 #endif
571
572 void *Jim_Alloc(int size)
573 {
574 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
575 if (size==0)
576 size=1;
577 void *p = malloc(size);
578 if (p == NULL)
579 Jim_Panic(NULL,"malloc: Out of memory");
580 return p;
581 }
582
583 void Jim_Free(void *ptr) {
584 free(ptr);
585 }
586
587 void *Jim_Realloc(void *ptr, int size)
588 {
589 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
590 if (size==0)
591 size=1;
592 void *p = realloc(ptr, size);
593 if (p == NULL)
594 Jim_Panic(NULL,"realloc: Out of memory");
595 return p;
596 }
597
598 char *Jim_StrDup(const char *s)
599 {
600 int l = strlen(s);
601 char *copy = Jim_Alloc(l+1);
602
603 memcpy(copy, s, l+1);
604 return copy;
605 }
606
607 char *Jim_StrDupLen(const char *s, int l)
608 {
609 char *copy = Jim_Alloc(l+1);
610
611 memcpy(copy, s, l+1);
612 copy[l] = 0; /* Just to be sure, original could be substring */
613 return copy;
614 }
615
616 /* -----------------------------------------------------------------------------
617 * Time related functions
618 * ---------------------------------------------------------------------------*/
619 /* Returns microseconds of CPU used since start. */
620 static jim_wide JimClock(void)
621 {
622 #if (defined WIN32) && !(defined JIM_ANSIC)
623 LARGE_INTEGER t, f;
624 QueryPerformanceFrequency(&f);
625 QueryPerformanceCounter(&t);
626 return (long)((t.QuadPart * 1000000) / f.QuadPart);
627 #else /* !WIN32 */
628 clock_t clocks = clock();
629
630 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
631 #endif /* WIN32 */
632 }
633
634 /* -----------------------------------------------------------------------------
635 * Hash Tables
636 * ---------------------------------------------------------------------------*/
637
638 /* -------------------------- private prototypes ---------------------------- */
639 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
640 static unsigned int JimHashTableNextPower(unsigned int size);
641 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
642
643 /* -------------------------- hash functions -------------------------------- */
644
645 /* Thomas Wang's 32 bit Mix Function */
646 unsigned int Jim_IntHashFunction(unsigned int key)
647 {
648 key += ~(key << 15);
649 key ^= (key >> 10);
650 key += (key << 3);
651 key ^= (key >> 6);
652 key += ~(key << 11);
653 key ^= (key >> 16);
654 return key;
655 }
656
657 /* Identity hash function for integer keys */
658 unsigned int Jim_IdentityHashFunction(unsigned int key)
659 {
660 return key;
661 }
662
663 /* Generic hash function (we are using to multiply by 9 and add the byte
664 * as Tcl) */
665 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
666 {
667 unsigned int h = 0;
668 while(len--)
669 h += (h<<3)+*buf++;
670 return h;
671 }
672
673 /* ----------------------------- API implementation ------------------------- */
674 /* reset an hashtable already initialized with ht_init().
675 * NOTE: This function should only called by ht_destroy(). */
676 static void JimResetHashTable(Jim_HashTable *ht)
677 {
678 ht->table = NULL;
679 ht->size = 0;
680 ht->sizemask = 0;
681 ht->used = 0;
682 ht->collisions = 0;
683 }
684
685 /* Initialize the hash table */
686 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
687 void *privDataPtr)
688 {
689 JimResetHashTable(ht);
690 ht->type = type;
691 ht->privdata = privDataPtr;
692 return JIM_OK;
693 }
694
695 /* Resize the table to the minimal size that contains all the elements,
696 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
697 int Jim_ResizeHashTable(Jim_HashTable *ht)
698 {
699 int minimal = ht->used;
700
701 if (minimal < JIM_HT_INITIAL_SIZE)
702 minimal = JIM_HT_INITIAL_SIZE;
703 return Jim_ExpandHashTable(ht, minimal);
704 }
705
706 /* Expand or create the hashtable */
707 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
708 {
709 Jim_HashTable n; /* the new hashtable */
710 unsigned int realsize = JimHashTableNextPower(size), i;
711
712 /* the size is invalid if it is smaller than the number of
713 * elements already inside the hashtable */
714 if (ht->used >= size)
715 return JIM_ERR;
716
717 Jim_InitHashTable(&n, ht->type, ht->privdata);
718 n.size = realsize;
719 n.sizemask = realsize-1;
720 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
721
722 /* Initialize all the pointers to NULL */
723 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
724
725 /* Copy all the elements from the old to the new table:
726 * note that if the old hash table is empty ht->size is zero,
727 * so Jim_ExpandHashTable just creates an hash table. */
728 n.used = ht->used;
729 for (i = 0; i < ht->size && ht->used > 0; i++) {
730 Jim_HashEntry *he, *nextHe;
731
732 if (ht->table[i] == NULL) continue;
733
734 /* For each hash entry on this slot... */
735 he = ht->table[i];
736 while(he) {
737 unsigned int h;
738
739 nextHe = he->next;
740 /* Get the new element index */
741 h = Jim_HashKey(ht, he->key) & n.sizemask;
742 he->next = n.table[h];
743 n.table[h] = he;
744 ht->used--;
745 /* Pass to the next element */
746 he = nextHe;
747 }
748 }
749 assert(ht->used == 0);
750 Jim_Free(ht->table);
751
752 /* Remap the new hashtable in the old */
753 *ht = n;
754 return JIM_OK;
755 }
756
757 /* Add an element to the target hash table */
758 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
759 {
760 int index;
761 Jim_HashEntry *entry;
762
763 /* Get the index of the new element, or -1 if
764 * the element already exists. */
765 if ((index = JimInsertHashEntry(ht, key)) == -1)
766 return JIM_ERR;
767
768 /* Allocates the memory and stores key */
769 entry = Jim_Alloc(sizeof(*entry));
770 entry->next = ht->table[index];
771 ht->table[index] = entry;
772
773 /* Set the hash entry fields. */
774 Jim_SetHashKey(ht, entry, key);
775 Jim_SetHashVal(ht, entry, val);
776 ht->used++;
777 return JIM_OK;
778 }
779
780 /* Add an element, discarding the old if the key already exists */
781 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
782 {
783 Jim_HashEntry *entry;
784
785 /* Try to add the element. If the key
786 * does not exists Jim_AddHashEntry will suceed. */
787 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
788 return JIM_OK;
789 /* It already exists, get the entry */
790 entry = Jim_FindHashEntry(ht, key);
791 /* Free the old value and set the new one */
792 Jim_FreeEntryVal(ht, entry);
793 Jim_SetHashVal(ht, entry, val);
794 return JIM_OK;
795 }
796
797 /* Search and remove an element */
798 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
799 {
800 unsigned int h;
801 Jim_HashEntry *he, *prevHe;
802
803 if (ht->size == 0)
804 return JIM_ERR;
805 h = Jim_HashKey(ht, key) & ht->sizemask;
806 he = ht->table[h];
807
808 prevHe = NULL;
809 while(he) {
810 if (Jim_CompareHashKeys(ht, key, he->key)) {
811 /* Unlink the element from the list */
812 if (prevHe)
813 prevHe->next = he->next;
814 else
815 ht->table[h] = he->next;
816 Jim_FreeEntryKey(ht, he);
817 Jim_FreeEntryVal(ht, he);
818 Jim_Free(he);
819 ht->used--;
820 return JIM_OK;
821 }
822 prevHe = he;
823 he = he->next;
824 }
825 return JIM_ERR; /* not found */
826 }
827
828 /* Destroy an entire hash table */
829 int Jim_FreeHashTable(Jim_HashTable *ht)
830 {
831 unsigned int i;
832
833 /* Free all the elements */
834 for (i = 0; i < ht->size && ht->used > 0; i++) {
835 Jim_HashEntry *he, *nextHe;
836
837 if ((he = ht->table[i]) == NULL) continue;
838 while(he) {
839 nextHe = he->next;
840 Jim_FreeEntryKey(ht, he);
841 Jim_FreeEntryVal(ht, he);
842 Jim_Free(he);
843 ht->used--;
844 he = nextHe;
845 }
846 }
847 /* Free the table and the allocated cache structure */
848 Jim_Free(ht->table);
849 /* Re-initialize the table */
850 JimResetHashTable(ht);
851 return JIM_OK; /* never fails */
852 }
853
854 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
855 {
856 Jim_HashEntry *he;
857 unsigned int h;
858
859 if (ht->size == 0) return NULL;
860 h = Jim_HashKey(ht, key) & ht->sizemask;
861 he = ht->table[h];
862 while(he) {
863 if (Jim_CompareHashKeys(ht, key, he->key))
864 return he;
865 he = he->next;
866 }
867 return NULL;
868 }
869
870 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
871 {
872 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
873
874 iter->ht = ht;
875 iter->index = -1;
876 iter->entry = NULL;
877 iter->nextEntry = NULL;
878 return iter;
879 }
880
881 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
882 {
883 while (1) {
884 if (iter->entry == NULL) {
885 iter->index++;
886 if (iter->index >=
887 (signed)iter->ht->size) break;
888 iter->entry = iter->ht->table[iter->index];
889 } else {
890 iter->entry = iter->nextEntry;
891 }
892 if (iter->entry) {
893 /* We need to save the 'next' here, the iterator user
894 * may delete the entry we are returning. */
895 iter->nextEntry = iter->entry->next;
896 return iter->entry;
897 }
898 }
899 return NULL;
900 }
901
902 /* ------------------------- private functions ------------------------------ */
903
904 /* Expand the hash table if needed */
905 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
906 {
907 /* If the hash table is empty expand it to the intial size,
908 * if the table is "full" dobule its size. */
909 if (ht->size == 0)
910 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
911 if (ht->size == ht->used)
912 return Jim_ExpandHashTable(ht, ht->size*2);
913 return JIM_OK;
914 }
915
916 /* Our hash table capability is a power of two */
917 static unsigned int JimHashTableNextPower(unsigned int size)
918 {
919 unsigned int i = JIM_HT_INITIAL_SIZE;
920
921 if (size >= 2147483648U)
922 return 2147483648U;
923 while(1) {
924 if (i >= size)
925 return i;
926 i *= 2;
927 }
928 }
929
930 /* Returns the index of a free slot that can be populated with
931 * an hash entry for the given 'key'.
932 * If the key already exists, -1 is returned. */
933 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
934 {
935 unsigned int h;
936 Jim_HashEntry *he;
937
938 /* Expand the hashtable if needed */
939 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
940 return -1;
941 /* Compute the key hash value */
942 h = Jim_HashKey(ht, key) & ht->sizemask;
943 /* Search if this slot does not already contain the given key */
944 he = ht->table[h];
945 while(he) {
946 if (Jim_CompareHashKeys(ht, key, he->key))
947 return -1;
948 he = he->next;
949 }
950 return h;
951 }
952
953 /* ----------------------- StringCopy Hash Table Type ------------------------*/
954
955 static unsigned int JimStringCopyHTHashFunction(const void *key)
956 {
957 return Jim_GenHashFunction(key, strlen(key));
958 }
959
960 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
961 {
962 int len = strlen(key);
963 char *copy = Jim_Alloc(len+1);
964 JIM_NOTUSED(privdata);
965
966 memcpy(copy, key, len);
967 copy[len] = '\0';
968 return copy;
969 }
970
971 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
972 {
973 int len = strlen(val);
974 char *copy = Jim_Alloc(len+1);
975 JIM_NOTUSED(privdata);
976
977 memcpy(copy, val, len);
978 copy[len] = '\0';
979 return copy;
980 }
981
982 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
983 const void *key2)
984 {
985 JIM_NOTUSED(privdata);
986
987 return strcmp(key1, key2) == 0;
988 }
989
990 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
991 {
992 JIM_NOTUSED(privdata);
993
994 Jim_Free((void*)key); /* ATTENTION: const cast */
995 }
996
997 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
998 {
999 JIM_NOTUSED(privdata);
1000
1001 Jim_Free((void*)val); /* ATTENTION: const cast */
1002 }
1003
1004 static Jim_HashTableType JimStringCopyHashTableType = {
1005 JimStringCopyHTHashFunction, /* hash function */
1006 JimStringCopyHTKeyDup, /* key dup */
1007 NULL, /* val dup */
1008 JimStringCopyHTKeyCompare, /* key compare */
1009 JimStringCopyHTKeyDestructor, /* key destructor */
1010 NULL /* val destructor */
1011 };
1012
1013 /* This is like StringCopy but does not auto-duplicate the key.
1014 * It's used for intepreter's shared strings. */
1015 static Jim_HashTableType JimSharedStringsHashTableType = {
1016 JimStringCopyHTHashFunction, /* hash function */
1017 NULL, /* key dup */
1018 NULL, /* val dup */
1019 JimStringCopyHTKeyCompare, /* key compare */
1020 JimStringCopyHTKeyDestructor, /* key destructor */
1021 NULL /* val destructor */
1022 };
1023
1024 /* This is like StringCopy but also automatically handle dynamic
1025 * allocated C strings as values. */
1026 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1027 JimStringCopyHTHashFunction, /* hash function */
1028 JimStringCopyHTKeyDup, /* key dup */
1029 JimStringKeyValCopyHTValDup, /* val dup */
1030 JimStringCopyHTKeyCompare, /* key compare */
1031 JimStringCopyHTKeyDestructor, /* key destructor */
1032 JimStringKeyValCopyHTValDestructor, /* val destructor */
1033 };
1034
1035 typedef struct AssocDataValue {
1036 Jim_InterpDeleteProc *delProc;
1037 void *data;
1038 } AssocDataValue;
1039
1040 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1041 {
1042 AssocDataValue *assocPtr = (AssocDataValue *)data;
1043 if (assocPtr->delProc != NULL)
1044 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1045 Jim_Free(data);
1046 }
1047
1048 static Jim_HashTableType JimAssocDataHashTableType = {
1049 JimStringCopyHTHashFunction, /* hash function */
1050 JimStringCopyHTKeyDup, /* key dup */
1051 NULL, /* val dup */
1052 JimStringCopyHTKeyCompare, /* key compare */
1053 JimStringCopyHTKeyDestructor, /* key destructor */
1054 JimAssocDataHashTableValueDestructor /* val destructor */
1055 };
1056
1057 /* -----------------------------------------------------------------------------
1058 * Stack - This is a simple generic stack implementation. It is used for
1059 * example in the 'expr' expression compiler.
1060 * ---------------------------------------------------------------------------*/
1061 void Jim_InitStack(Jim_Stack *stack)
1062 {
1063 stack->len = 0;
1064 stack->maxlen = 0;
1065 stack->vector = NULL;
1066 }
1067
1068 void Jim_FreeStack(Jim_Stack *stack)
1069 {
1070 Jim_Free(stack->vector);
1071 }
1072
1073 int Jim_StackLen(Jim_Stack *stack)
1074 {
1075 return stack->len;
1076 }
1077
1078 void Jim_StackPush(Jim_Stack *stack, void *element) {
1079 int neededLen = stack->len+1;
1080 if (neededLen > stack->maxlen) {
1081 stack->maxlen = neededLen*2;
1082 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1083 }
1084 stack->vector[stack->len] = element;
1085 stack->len++;
1086 }
1087
1088 void *Jim_StackPop(Jim_Stack *stack)
1089 {
1090 if (stack->len == 0) return NULL;
1091 stack->len--;
1092 return stack->vector[stack->len];
1093 }
1094
1095 void *Jim_StackPeek(Jim_Stack *stack)
1096 {
1097 if (stack->len == 0) return NULL;
1098 return stack->vector[stack->len-1];
1099 }
1100
1101 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1102 {
1103 int i;
1104
1105 for (i = 0; i < stack->len; i++)
1106 freeFunc(stack->vector[i]);
1107 }
1108
1109 /* -----------------------------------------------------------------------------
1110 * Parser
1111 * ---------------------------------------------------------------------------*/
1112
1113 /* Token types */
1114 #define JIM_TT_NONE -1 /* No token returned */
1115 #define JIM_TT_STR 0 /* simple string */
1116 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1117 #define JIM_TT_VAR 2 /* var substitution */
1118 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1119 #define JIM_TT_CMD 4 /* command substitution */
1120 #define JIM_TT_SEP 5 /* word separator */
1121 #define JIM_TT_EOL 6 /* line separator */
1122
1123 /* Additional token types needed for expressions */
1124 #define JIM_TT_SUBEXPR_START 7
1125 #define JIM_TT_SUBEXPR_END 8
1126 #define JIM_TT_EXPR_NUMBER 9
1127 #define JIM_TT_EXPR_OPERATOR 10
1128
1129 /* Parser states */
1130 #define JIM_PS_DEF 0 /* Default state */
1131 #define JIM_PS_QUOTE 1 /* Inside "" */
1132
1133 /* Parser context structure. The same context is used both to parse
1134 * Tcl scripts and lists. */
1135 struct JimParserCtx {
1136 const char *prg; /* Program text */
1137 const char *p; /* Pointer to the point of the program we are parsing */
1138 int len; /* Left length of 'prg' */
1139 int linenr; /* Current line number */
1140 const char *tstart;
1141 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1142 int tline; /* Line number of the returned token */
1143 int tt; /* Token type */
1144 int eof; /* Non zero if EOF condition is true. */
1145 int state; /* Parser state */
1146 int comment; /* Non zero if the next chars may be a comment. */
1147 };
1148
1149 #define JimParserEof(c) ((c)->eof)
1150 #define JimParserTstart(c) ((c)->tstart)
1151 #define JimParserTend(c) ((c)->tend)
1152 #define JimParserTtype(c) ((c)->tt)
1153 #define JimParserTline(c) ((c)->tline)
1154
1155 static int JimParseScript(struct JimParserCtx *pc);
1156 static int JimParseSep(struct JimParserCtx *pc);
1157 static int JimParseEol(struct JimParserCtx *pc);
1158 static int JimParseCmd(struct JimParserCtx *pc);
1159 static int JimParseVar(struct JimParserCtx *pc);
1160 static int JimParseBrace(struct JimParserCtx *pc);
1161 static int JimParseStr(struct JimParserCtx *pc);
1162 static int JimParseComment(struct JimParserCtx *pc);
1163 static char *JimParserGetToken(struct JimParserCtx *pc,
1164 int *lenPtr, int *typePtr, int *linePtr);
1165
1166 /* Initialize a parser context.
1167 * 'prg' is a pointer to the program text, linenr is the line
1168 * number of the first line contained in the program. */
1169 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1170 int len, int linenr)
1171 {
1172 pc->prg = prg;
1173 pc->p = prg;
1174 pc->len = len;
1175 pc->tstart = NULL;
1176 pc->tend = NULL;
1177 pc->tline = 0;
1178 pc->tt = JIM_TT_NONE;
1179 pc->eof = 0;
1180 pc->state = JIM_PS_DEF;
1181 pc->linenr = linenr;
1182 pc->comment = 1;
1183 }
1184
1185 int JimParseScript(struct JimParserCtx *pc)
1186 {
1187 while(1) { /* the while is used to reiterate with continue if needed */
1188 if (!pc->len) {
1189 pc->tstart = pc->p;
1190 pc->tend = pc->p-1;
1191 pc->tline = pc->linenr;
1192 pc->tt = JIM_TT_EOL;
1193 pc->eof = 1;
1194 return JIM_OK;
1195 }
1196 switch(*(pc->p)) {
1197 case '\\':
1198 if (*(pc->p+1) == '\n')
1199 return JimParseSep(pc);
1200 else {
1201 pc->comment = 0;
1202 return JimParseStr(pc);
1203 }
1204 break;
1205 case ' ':
1206 case '\t':
1207 case '\r':
1208 if (pc->state == JIM_PS_DEF)
1209 return JimParseSep(pc);
1210 else {
1211 pc->comment = 0;
1212 return JimParseStr(pc);
1213 }
1214 break;
1215 case '\n':
1216 case ';':
1217 pc->comment = 1;
1218 if (pc->state == JIM_PS_DEF)
1219 return JimParseEol(pc);
1220 else
1221 return JimParseStr(pc);
1222 break;
1223 case '[':
1224 pc->comment = 0;
1225 return JimParseCmd(pc);
1226 break;
1227 case '$':
1228 pc->comment = 0;
1229 if (JimParseVar(pc) == JIM_ERR) {
1230 pc->tstart = pc->tend = pc->p++; pc->len--;
1231 pc->tline = pc->linenr;
1232 pc->tt = JIM_TT_STR;
1233 return JIM_OK;
1234 } else
1235 return JIM_OK;
1236 break;
1237 case '#':
1238 if (pc->comment) {
1239 JimParseComment(pc);
1240 continue;
1241 } else {
1242 return JimParseStr(pc);
1243 }
1244 default:
1245 pc->comment = 0;
1246 return JimParseStr(pc);
1247 break;
1248 }
1249 return JIM_OK;
1250 }
1251 }
1252
1253 int JimParseSep(struct JimParserCtx *pc)
1254 {
1255 pc->tstart = pc->p;
1256 pc->tline = pc->linenr;
1257 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1258 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1259 if (*pc->p == '\\') {
1260 pc->p++; pc->len--;
1261 pc->linenr++;
1262 }
1263 pc->p++; pc->len--;
1264 }
1265 pc->tend = pc->p-1;
1266 pc->tt = JIM_TT_SEP;
1267 return JIM_OK;
1268 }
1269
1270 int JimParseEol(struct JimParserCtx *pc)
1271 {
1272 pc->tstart = pc->p;
1273 pc->tline = pc->linenr;
1274 while (*pc->p == ' ' || *pc->p == '\n' ||
1275 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1276 if (*pc->p == '\n')
1277 pc->linenr++;
1278 pc->p++; pc->len--;
1279 }
1280 pc->tend = pc->p-1;
1281 pc->tt = JIM_TT_EOL;
1282 return JIM_OK;
1283 }
1284
1285 /* Todo. Don't stop if ']' appears inside {} or quoted.
1286 * Also should handle the case of puts [string length "]"] */
1287 int JimParseCmd(struct JimParserCtx *pc)
1288 {
1289 int level = 1;
1290 int blevel = 0;
1291
1292 pc->tstart = ++pc->p; pc->len--;
1293 pc->tline = pc->linenr;
1294 while (1) {
1295 if (pc->len == 0) {
1296 break;
1297 } else if (*pc->p == '[' && blevel == 0) {
1298 level++;
1299 } else if (*pc->p == ']' && blevel == 0) {
1300 level--;
1301 if (!level) break;
1302 } else if (*pc->p == '\\') {
1303 pc->p++; pc->len--;
1304 } else if (*pc->p == '{') {
1305 blevel++;
1306 } else if (*pc->p == '}') {
1307 if (blevel != 0)
1308 blevel--;
1309 } else if (*pc->p == '\n')
1310 pc->linenr++;
1311 pc->p++; pc->len--;
1312 }
1313 pc->tend = pc->p-1;
1314 pc->tt = JIM_TT_CMD;
1315 if (*pc->p == ']') {
1316 pc->p++; pc->len--;
1317 }
1318 return JIM_OK;
1319 }
1320
1321 int JimParseVar(struct JimParserCtx *pc)
1322 {
1323 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1324
1325 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1326 pc->tline = pc->linenr;
1327 if (*pc->p == '{') {
1328 pc->tstart = ++pc->p; pc->len--;
1329 brace = 1;
1330 }
1331 if (brace) {
1332 while (!stop) {
1333 if (*pc->p == '}' || pc->len == 0) {
1334 pc->tend = pc->p-1;
1335 stop = 1;
1336 if (pc->len == 0)
1337 break;
1338 }
1339 else if (*pc->p == '\n')
1340 pc->linenr++;
1341 pc->p++; pc->len--;
1342 }
1343 } else {
1344 /* Include leading colons */
1345 while (*pc->p == ':') {
1346 pc->p++;
1347 pc->len--;
1348 }
1349 while (!stop) {
1350 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1351 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1352 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1353 stop = 1;
1354 else {
1355 pc->p++; pc->len--;
1356 }
1357 }
1358 /* Parse [dict get] syntax sugar. */
1359 if (*pc->p == '(') {
1360 while (*pc->p != ')' && pc->len) {
1361 pc->p++; pc->len--;
1362 if (*pc->p == '\\' && pc->len >= 2) {
1363 pc->p += 2; pc->len -= 2;
1364 }
1365 }
1366 if (*pc->p != '\0') {
1367 pc->p++; pc->len--;
1368 }
1369 ttype = JIM_TT_DICTSUGAR;
1370 }
1371 pc->tend = pc->p-1;
1372 }
1373 /* Check if we parsed just the '$' character.
1374 * That's not a variable so an error is returned
1375 * to tell the state machine to consider this '$' just
1376 * a string. */
1377 if (pc->tstart == pc->p) {
1378 pc->p--; pc->len++;
1379 return JIM_ERR;
1380 }
1381 pc->tt = ttype;
1382 return JIM_OK;
1383 }
1384
1385 int JimParseBrace(struct JimParserCtx *pc)
1386 {
1387 int level = 1;
1388
1389 pc->tstart = ++pc->p; pc->len--;
1390 pc->tline = pc->linenr;
1391 while (1) {
1392 if (*pc->p == '\\' && pc->len >= 2) {
1393 pc->p++; pc->len--;
1394 if (*pc->p == '\n')
1395 pc->linenr++;
1396 } else if (*pc->p == '{') {
1397 level++;
1398 } else if (pc->len == 0 || *pc->p == '}') {
1399 level--;
1400 if (pc->len == 0 || level == 0) {
1401 pc->tend = pc->p-1;
1402 if (pc->len != 0) {
1403 pc->p++; pc->len--;
1404 }
1405 pc->tt = JIM_TT_STR;
1406 return JIM_OK;
1407 }
1408 } else if (*pc->p == '\n') {
1409 pc->linenr++;
1410 }
1411 pc->p++; pc->len--;
1412 }
1413 return JIM_OK; /* unreached */
1414 }
1415
1416 int JimParseStr(struct JimParserCtx *pc)
1417 {
1418 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1419 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1420 if (newword && *pc->p == '{') {
1421 return JimParseBrace(pc);
1422 } else if (newword && *pc->p == '"') {
1423 pc->state = JIM_PS_QUOTE;
1424 pc->p++; pc->len--;
1425 }
1426 pc->tstart = pc->p;
1427 pc->tline = pc->linenr;
1428 while (1) {
1429 if (pc->len == 0) {
1430 pc->tend = pc->p-1;
1431 pc->tt = JIM_TT_ESC;
1432 return JIM_OK;
1433 }
1434 switch(*pc->p) {
1435 case '\\':
1436 if (pc->state == JIM_PS_DEF &&
1437 *(pc->p+1) == '\n') {
1438 pc->tend = pc->p-1;
1439 pc->tt = JIM_TT_ESC;
1440 return JIM_OK;
1441 }
1442 if (pc->len >= 2) {
1443 pc->p++; pc->len--;
1444 }
1445 break;
1446 case '$':
1447 case '[':
1448 pc->tend = pc->p-1;
1449 pc->tt = JIM_TT_ESC;
1450 return JIM_OK;
1451 case ' ':
1452 case '\t':
1453 case '\n':
1454 case '\r':
1455 case ';':
1456 if (pc->state == JIM_PS_DEF) {
1457 pc->tend = pc->p-1;
1458 pc->tt = JIM_TT_ESC;
1459 return JIM_OK;
1460 } else if (*pc->p == '\n') {
1461 pc->linenr++;
1462 }
1463 break;
1464 case '"':
1465 if (pc->state == JIM_PS_QUOTE) {
1466 pc->tend = pc->p-1;
1467 pc->tt = JIM_TT_ESC;
1468 pc->p++; pc->len--;
1469 pc->state = JIM_PS_DEF;
1470 return JIM_OK;
1471 }
1472 break;
1473 }
1474 pc->p++; pc->len--;
1475 }
1476 return JIM_OK; /* unreached */
1477 }
1478
1479 int JimParseComment(struct JimParserCtx *pc)
1480 {
1481 while (*pc->p) {
1482 if (*pc->p == '\n') {
1483 pc->linenr++;
1484 if (*(pc->p-1) != '\\') {
1485 pc->p++; pc->len--;
1486 return JIM_OK;
1487 }
1488 }
1489 pc->p++; pc->len--;
1490 }
1491 return JIM_OK;
1492 }
1493
1494 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1495 static int xdigitval(int c)
1496 {
1497 if (c >= '0' && c <= '9') return c-'0';
1498 if (c >= 'a' && c <= 'f') return c-'a'+10;
1499 if (c >= 'A' && c <= 'F') return c-'A'+10;
1500 return -1;
1501 }
1502
1503 static int odigitval(int c)
1504 {
1505 if (c >= '0' && c <= '7') return c-'0';
1506 return -1;
1507 }
1508
1509 /* Perform Tcl escape substitution of 's', storing the result
1510 * string into 'dest'. The escaped string is guaranteed to
1511 * be the same length or shorted than the source string.
1512 * Slen is the length of the string at 's', if it's -1 the string
1513 * length will be calculated by the function.
1514 *
1515 * The function returns the length of the resulting string. */
1516 static int JimEscape(char *dest, const char *s, int slen)
1517 {
1518 char *p = dest;
1519 int i, len;
1520
1521 if (slen == -1)
1522 slen = strlen(s);
1523
1524 for (i = 0; i < slen; i++) {
1525 switch(s[i]) {
1526 case '\\':
1527 switch(s[i+1]) {
1528 case 'a': *p++ = 0x7; i++; break;
1529 case 'b': *p++ = 0x8; i++; break;
1530 case 'f': *p++ = 0xc; i++; break;
1531 case 'n': *p++ = 0xa; i++; break;
1532 case 'r': *p++ = 0xd; i++; break;
1533 case 't': *p++ = 0x9; i++; break;
1534 case 'v': *p++ = 0xb; i++; break;
1535 case '\0': *p++ = '\\'; i++; break;
1536 case '\n': *p++ = ' '; i++; break;
1537 default:
1538 if (s[i+1] == 'x') {
1539 int val = 0;
1540 int c = xdigitval(s[i+2]);
1541 if (c == -1) {
1542 *p++ = 'x';
1543 i++;
1544 break;
1545 }
1546 val = c;
1547 c = xdigitval(s[i+3]);
1548 if (c == -1) {
1549 *p++ = val;
1550 i += 2;
1551 break;
1552 }
1553 val = (val*16)+c;
1554 *p++ = val;
1555 i += 3;
1556 break;
1557 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1558 {
1559 int val = 0;
1560 int c = odigitval(s[i+1]);
1561 val = c;
1562 c = odigitval(s[i+2]);
1563 if (c == -1) {
1564 *p++ = val;
1565 i ++;
1566 break;
1567 }
1568 val = (val*8)+c;
1569 c = odigitval(s[i+3]);
1570 if (c == -1) {
1571 *p++ = val;
1572 i += 2;
1573 break;
1574 }
1575 val = (val*8)+c;
1576 *p++ = val;
1577 i += 3;
1578 } else {
1579 *p++ = s[i+1];
1580 i++;
1581 }
1582 break;
1583 }
1584 break;
1585 default:
1586 *p++ = s[i];
1587 break;
1588 }
1589 }
1590 len = p-dest;
1591 *p++ = '\0';
1592 return len;
1593 }
1594
1595 /* Returns a dynamically allocated copy of the current token in the
1596 * parser context. The function perform conversion of escapes if
1597 * the token is of type JIM_TT_ESC.
1598 *
1599 * Note that after the conversion, tokens that are grouped with
1600 * braces in the source code, are always recognizable from the
1601 * identical string obtained in a different way from the type.
1602 *
1603 * For exmple the string:
1604 *
1605 * {expand}$a
1606 *
1607 * will return as first token "expand", of type JIM_TT_STR
1608 *
1609 * While the string:
1610 *
1611 * expand$a
1612 *
1613 * will return as first token "expand", of type JIM_TT_ESC
1614 */
1615 char *JimParserGetToken(struct JimParserCtx *pc,
1616 int *lenPtr, int *typePtr, int *linePtr)
1617 {
1618 const char *start, *end;
1619 char *token;
1620 int len;
1621
1622 start = JimParserTstart(pc);
1623 end = JimParserTend(pc);
1624 if (start > end) {
1625 if (lenPtr) *lenPtr = 0;
1626 if (typePtr) *typePtr = JimParserTtype(pc);
1627 if (linePtr) *linePtr = JimParserTline(pc);
1628 token = Jim_Alloc(1);
1629 token[0] = '\0';
1630 return token;
1631 }
1632 len = (end-start)+1;
1633 token = Jim_Alloc(len+1);
1634 if (JimParserTtype(pc) != JIM_TT_ESC) {
1635 /* No escape conversion needed? Just copy it. */
1636 memcpy(token, start, len);
1637 token[len] = '\0';
1638 } else {
1639 /* Else convert the escape chars. */
1640 len = JimEscape(token, start, len);
1641 }
1642 if (lenPtr) *lenPtr = len;
1643 if (typePtr) *typePtr = JimParserTtype(pc);
1644 if (linePtr) *linePtr = JimParserTline(pc);
1645 return token;
1646 }
1647
1648 /* The following functin is not really part of the parsing engine of Jim,
1649 * but it somewhat related. Given an string and its length, it tries
1650 * to guess if the script is complete or there are instead " " or { }
1651 * open and not completed. This is useful for interactive shells
1652 * implementation and for [info complete].
1653 *
1654 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1655 * '{' on scripts incomplete missing one or more '}' to be balanced.
1656 * '"' on scripts incomplete missing a '"' char.
1657 *
1658 * If the script is complete, 1 is returned, otherwise 0. */
1659 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1660 {
1661 int level = 0;
1662 int state = ' ';
1663
1664 while(len) {
1665 switch (*s) {
1666 case '\\':
1667 if (len > 1)
1668 s++;
1669 break;
1670 case '"':
1671 if (state == ' ') {
1672 state = '"';
1673 } else if (state == '"') {
1674 state = ' ';
1675 }
1676 break;
1677 case '{':
1678 if (state == '{') {
1679 level++;
1680 } else if (state == ' ') {
1681 state = '{';
1682 level++;
1683 }
1684 break;
1685 case '}':
1686 if (state == '{') {
1687 level--;
1688 if (level == 0)
1689 state = ' ';
1690 }
1691 break;
1692 }
1693 s++;
1694 len--;
1695 }
1696 if (stateCharPtr)
1697 *stateCharPtr = state;
1698 return state == ' ';
1699 }
1700
1701 /* -----------------------------------------------------------------------------
1702 * Tcl Lists parsing
1703 * ---------------------------------------------------------------------------*/
1704 static int JimParseListSep(struct JimParserCtx *pc);
1705 static int JimParseListStr(struct JimParserCtx *pc);
1706
1707 int JimParseList(struct JimParserCtx *pc)
1708 {
1709 if (pc->len == 0) {
1710 pc->tstart = pc->tend = pc->p;
1711 pc->tline = pc->linenr;
1712 pc->tt = JIM_TT_EOL;
1713 pc->eof = 1;
1714 return JIM_OK;
1715 }
1716 switch(*pc->p) {
1717 case ' ':
1718 case '\n':
1719 case '\t':
1720 case '\r':
1721 if (pc->state == JIM_PS_DEF)
1722 return JimParseListSep(pc);
1723 else
1724 return JimParseListStr(pc);
1725 break;
1726 default:
1727 return JimParseListStr(pc);
1728 break;
1729 }
1730 return JIM_OK;
1731 }
1732
1733 int JimParseListSep(struct JimParserCtx *pc)
1734 {
1735 pc->tstart = pc->p;
1736 pc->tline = pc->linenr;
1737 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1738 {
1739 pc->p++; pc->len--;
1740 }
1741 pc->tend = pc->p-1;
1742 pc->tt = JIM_TT_SEP;
1743 return JIM_OK;
1744 }
1745
1746 int JimParseListStr(struct JimParserCtx *pc)
1747 {
1748 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1749 pc->tt == JIM_TT_NONE);
1750 if (newword && *pc->p == '{') {
1751 return JimParseBrace(pc);
1752 } else if (newword && *pc->p == '"') {
1753 pc->state = JIM_PS_QUOTE;
1754 pc->p++; pc->len--;
1755 }
1756 pc->tstart = pc->p;
1757 pc->tline = pc->linenr;
1758 while (1) {
1759 if (pc->len == 0) {
1760 pc->tend = pc->p-1;
1761 pc->tt = JIM_TT_ESC;
1762 return JIM_OK;
1763 }
1764 switch(*pc->p) {
1765 case '\\':
1766 pc->p++; pc->len--;
1767 break;
1768 case ' ':
1769 case '\t':
1770 case '\n':
1771 case '\r':
1772 if (pc->state == JIM_PS_DEF) {
1773 pc->tend = pc->p-1;
1774 pc->tt = JIM_TT_ESC;
1775 return JIM_OK;
1776 } else if (*pc->p == '\n') {
1777 pc->linenr++;
1778 }
1779 break;
1780 case '"':
1781 if (pc->state == JIM_PS_QUOTE) {
1782 pc->tend = pc->p-1;
1783 pc->tt = JIM_TT_ESC;
1784 pc->p++; pc->len--;
1785 pc->state = JIM_PS_DEF;
1786 return JIM_OK;
1787 }
1788 break;
1789 }
1790 pc->p++; pc->len--;
1791 }
1792 return JIM_OK; /* unreached */
1793 }
1794
1795 /* -----------------------------------------------------------------------------
1796 * Jim_Obj related functions
1797 * ---------------------------------------------------------------------------*/
1798
1799 /* Return a new initialized object. */
1800 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1801 {
1802 Jim_Obj *objPtr;
1803
1804 /* -- Check if there are objects in the free list -- */
1805 if (interp->freeList != NULL) {
1806 /* -- Unlink the object from the free list -- */
1807 objPtr = interp->freeList;
1808 interp->freeList = objPtr->nextObjPtr;
1809 } else {
1810 /* -- No ready to use objects: allocate a new one -- */
1811 objPtr = Jim_Alloc(sizeof(*objPtr));
1812 }
1813
1814 /* Object is returned with refCount of 0. Every
1815 * kind of GC implemented should take care to don't try
1816 * to scan objects with refCount == 0. */
1817 objPtr->refCount = 0;
1818 /* All the other fields are left not initialized to save time.
1819 * The caller will probably want set they to the right
1820 * value anyway. */
1821
1822 /* -- Put the object into the live list -- */
1823 objPtr->prevObjPtr = NULL;
1824 objPtr->nextObjPtr = interp->liveList;
1825 if (interp->liveList)
1826 interp->liveList->prevObjPtr = objPtr;
1827 interp->liveList = objPtr;
1828
1829 return objPtr;
1830 }
1831
1832 /* Free an object. Actually objects are never freed, but
1833 * just moved to the free objects list, where they will be
1834 * reused by Jim_NewObj(). */
1835 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1836 {
1837 /* Check if the object was already freed, panic. */
1838 if (objPtr->refCount != 0) {
1839 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1840 objPtr->refCount);
1841 }
1842 /* Free the internal representation */
1843 Jim_FreeIntRep(interp, objPtr);
1844 /* Free the string representation */
1845 if (objPtr->bytes != NULL) {
1846 if (objPtr->bytes != JimEmptyStringRep)
1847 Jim_Free(objPtr->bytes);
1848 }
1849 /* Unlink the object from the live objects list */
1850 if (objPtr->prevObjPtr)
1851 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1852 if (objPtr->nextObjPtr)
1853 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1854 if (interp->liveList == objPtr)
1855 interp->liveList = objPtr->nextObjPtr;
1856 /* Link the object into the free objects list */
1857 objPtr->prevObjPtr = NULL;
1858 objPtr->nextObjPtr = interp->freeList;
1859 if (interp->freeList)
1860 interp->freeList->prevObjPtr = objPtr;
1861 interp->freeList = objPtr;
1862 objPtr->refCount = -1;
1863 }
1864
1865 /* Invalidate the string representation of an object. */
1866 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1867 {
1868 if (objPtr->bytes != NULL) {
1869 if (objPtr->bytes != JimEmptyStringRep)
1870 Jim_Free(objPtr->bytes);
1871 }
1872 objPtr->bytes = NULL;
1873 }
1874
1875 #define Jim_SetStringRep(o, b, l) \
1876 do { (o)->bytes = b; (o)->length = l; } while (0)
1877
1878 /* Set the initial string representation for an object.
1879 * Does not try to free an old one. */
1880 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1881 {
1882 if (length == 0) {
1883 objPtr->bytes = JimEmptyStringRep;
1884 objPtr->length = 0;
1885 } else {
1886 objPtr->bytes = Jim_Alloc(length+1);
1887 objPtr->length = length;
1888 memcpy(objPtr->bytes, bytes, length);
1889 objPtr->bytes[length] = '\0';
1890 }
1891 }
1892
1893 /* Duplicate an object. The returned object has refcount = 0. */
1894 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1895 {
1896 Jim_Obj *dupPtr;
1897
1898 dupPtr = Jim_NewObj(interp);
1899 if (objPtr->bytes == NULL) {
1900 /* Object does not have a valid string representation. */
1901 dupPtr->bytes = NULL;
1902 } else {
1903 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1904 }
1905 if (objPtr->typePtr != NULL) {
1906 if (objPtr->typePtr->dupIntRepProc == NULL) {
1907 dupPtr->internalRep = objPtr->internalRep;
1908 } else {
1909 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1910 }
1911 dupPtr->typePtr = objPtr->typePtr;
1912 } else {
1913 dupPtr->typePtr = NULL;
1914 }
1915 return dupPtr;
1916 }
1917
1918 /* Return the string representation for objPtr. If the object
1919 * string representation is invalid, calls the method to create
1920 * a new one starting from the internal representation of the object. */
1921 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1922 {
1923 if (objPtr->bytes == NULL) {
1924 /* Invalid string repr. Generate it. */
1925 if (objPtr->typePtr->updateStringProc == NULL) {
1926 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1927 objPtr->typePtr->name);
1928 }
1929 objPtr->typePtr->updateStringProc(objPtr);
1930 }
1931 if (lenPtr)
1932 *lenPtr = objPtr->length;
1933 return objPtr->bytes;
1934 }
1935
1936 /* Just returns the length of the object's string rep */
1937 int Jim_Length(Jim_Obj *objPtr)
1938 {
1939 int len;
1940
1941 Jim_GetString(objPtr, &len);
1942 return len;
1943 }
1944
1945 /* -----------------------------------------------------------------------------
1946 * String Object
1947 * ---------------------------------------------------------------------------*/
1948 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1949 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1950
1951 static Jim_ObjType stringObjType = {
1952 "string",
1953 NULL,
1954 DupStringInternalRep,
1955 NULL,
1956 JIM_TYPE_REFERENCES,
1957 };
1958
1959 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1960 {
1961 JIM_NOTUSED(interp);
1962
1963 /* This is a bit subtle: the only caller of this function
1964 * should be Jim_DuplicateObj(), that will copy the
1965 * string representaion. After the copy, the duplicated
1966 * object will not have more room in teh buffer than
1967 * srcPtr->length bytes. So we just set it to length. */
1968 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1969 }
1970
1971 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1972 {
1973 /* Get a fresh string representation. */
1974 (void) Jim_GetString(objPtr, NULL);
1975 /* Free any other internal representation. */
1976 Jim_FreeIntRep(interp, objPtr);
1977 /* Set it as string, i.e. just set the maxLength field. */
1978 objPtr->typePtr = &stringObjType;
1979 objPtr->internalRep.strValue.maxLength = objPtr->length;
1980 return JIM_OK;
1981 }
1982
1983 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1984 {
1985 Jim_Obj *objPtr = Jim_NewObj(interp);
1986
1987 if (len == -1)
1988 len = strlen(s);
1989 /* Alloc/Set the string rep. */
1990 if (len == 0) {
1991 objPtr->bytes = JimEmptyStringRep;
1992 objPtr->length = 0;
1993 } else {
1994 objPtr->bytes = Jim_Alloc(len+1);
1995 objPtr->length = len;
1996 memcpy(objPtr->bytes, s, len);
1997 objPtr->bytes[len] = '\0';
1998 }
1999
2000 /* No typePtr field for the vanilla string object. */
2001 objPtr->typePtr = NULL;
2002 return objPtr;
2003 }
2004
2005 /* This version does not try to duplicate the 's' pointer, but
2006 * use it directly. */
2007 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2008 {
2009 Jim_Obj *objPtr = Jim_NewObj(interp);
2010
2011 if (len == -1)
2012 len = strlen(s);
2013 Jim_SetStringRep(objPtr, s, len);
2014 objPtr->typePtr = NULL;
2015 return objPtr;
2016 }
2017
2018 /* Low-level string append. Use it only against objects
2019 * of type "string". */
2020 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2021 {
2022 int needlen;
2023
2024 if (len == -1)
2025 len = strlen(str);
2026 needlen = objPtr->length + len;
2027 if (objPtr->internalRep.strValue.maxLength < needlen ||
2028 objPtr->internalRep.strValue.maxLength == 0) {
2029 if (objPtr->bytes == JimEmptyStringRep) {
2030 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2031 } else {
2032 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2033 }
2034 objPtr->internalRep.strValue.maxLength = needlen*2;
2035 }
2036 memcpy(objPtr->bytes + objPtr->length, str, len);
2037 objPtr->bytes[objPtr->length+len] = '\0';
2038 objPtr->length += len;
2039 }
2040
2041 /* Low-level wrapper to append an object. */
2042 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2043 {
2044 int len;
2045 const char *str;
2046
2047 str = Jim_GetString(appendObjPtr, &len);
2048 StringAppendString(objPtr, str, len);
2049 }
2050
2051 /* Higher level API to append strings to objects. */
2052 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2053 int len)
2054 {
2055 if (Jim_IsShared(objPtr))
2056 Jim_Panic(interp,"Jim_AppendString called with shared object");
2057 if (objPtr->typePtr != &stringObjType)
2058 SetStringFromAny(interp, objPtr);
2059 StringAppendString(objPtr, str, len);
2060 }
2061
2062 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2063 {
2064 char *buf;
2065 va_list ap;
2066
2067 va_start( ap, fmt );
2068 buf = jim_vasprintf( fmt, ap );
2069 va_end(ap);
2070
2071 if( buf ){
2072 Jim_AppendString( interp, objPtr, buf, -1 );
2073 jim_vasprintf_done(buf);
2074 }
2075 }
2076
2077
2078 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2079 Jim_Obj *appendObjPtr)
2080 {
2081 int len;
2082 const char *str;
2083
2084 str = Jim_GetString(appendObjPtr, &len);
2085 Jim_AppendString(interp, objPtr, str, len);
2086 }
2087
2088 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2089 {
2090 va_list ap;
2091
2092 if (objPtr->typePtr != &stringObjType)
2093 SetStringFromAny(interp, objPtr);
2094 va_start(ap, objPtr);
2095 while (1) {
2096 char *s = va_arg(ap, char*);
2097
2098 if (s == NULL) break;
2099 Jim_AppendString(interp, objPtr, s, -1);
2100 }
2101 va_end(ap);
2102 }
2103
2104 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2105 {
2106 const char *aStr, *bStr;
2107 int aLen, bLen, i;
2108
2109 if (aObjPtr == bObjPtr) return 1;
2110 aStr = Jim_GetString(aObjPtr, &aLen);
2111 bStr = Jim_GetString(bObjPtr, &bLen);
2112 if (aLen != bLen) return 0;
2113 if (nocase == 0)
2114 return memcmp(aStr, bStr, aLen) == 0;
2115 for (i = 0; i < aLen; i++) {
2116 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2117 return 0;
2118 }
2119 return 1;
2120 }
2121
2122 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2123 int nocase)
2124 {
2125 const char *pattern, *string;
2126 int patternLen, stringLen;
2127
2128 pattern = Jim_GetString(patternObjPtr, &patternLen);
2129 string = Jim_GetString(objPtr, &stringLen);
2130 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2131 }
2132
2133 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2134 Jim_Obj *secondObjPtr, int nocase)
2135 {
2136 const char *s1, *s2;
2137 int l1, l2;
2138
2139 s1 = Jim_GetString(firstObjPtr, &l1);
2140 s2 = Jim_GetString(secondObjPtr, &l2);
2141 return JimStringCompare(s1, l1, s2, l2, nocase);
2142 }
2143
2144 /* Convert a range, as returned by Jim_GetRange(), into
2145 * an absolute index into an object of the specified length.
2146 * This function may return negative values, or values
2147 * bigger or equal to the length of the list if the index
2148 * is out of range. */
2149 static int JimRelToAbsIndex(int len, int index)
2150 {
2151 if (index < 0)
2152 return len + index;
2153 return index;
2154 }
2155
2156 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2157 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2158 * for implementation of commands like [string range] and [lrange].
2159 *
2160 * The resulting range is guaranteed to address valid elements of
2161 * the structure. */
2162 static void JimRelToAbsRange(int len, int first, int last,
2163 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2164 {
2165 int rangeLen;
2166
2167 if (first > last) {
2168 rangeLen = 0;
2169 } else {
2170 rangeLen = last-first+1;
2171 if (rangeLen) {
2172 if (first < 0) {
2173 rangeLen += first;
2174 first = 0;
2175 }
2176 if (last >= len) {
2177 rangeLen -= (last-(len-1));
2178 last = len-1;
2179 }
2180 }
2181 }
2182 if (rangeLen < 0) rangeLen = 0;
2183
2184 *firstPtr = first;
2185 *lastPtr = last;
2186 *rangeLenPtr = rangeLen;
2187 }
2188
2189 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2190 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2191 {
2192 int first, last;
2193 const char *str;
2194 int len, rangeLen;
2195
2196 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2197 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2198 return NULL;
2199 str = Jim_GetString(strObjPtr, &len);
2200 first = JimRelToAbsIndex(len, first);
2201 last = JimRelToAbsIndex(len, last);
2202 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2203 return Jim_NewStringObj(interp, str+first, rangeLen);
2204 }
2205
2206 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2207 {
2208 char *buf;
2209 int i;
2210 if (strObjPtr->typePtr != &stringObjType) {
2211 SetStringFromAny(interp, strObjPtr);
2212 }
2213
2214 buf = Jim_Alloc(strObjPtr->length+1);
2215
2216 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2217 for (i = 0; i < strObjPtr->length; i++)
2218 buf[i] = tolower(buf[i]);
2219 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2220 }
2221
2222 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2223 {
2224 char *buf;
2225 int i;
2226 if (strObjPtr->typePtr != &stringObjType) {
2227 SetStringFromAny(interp, strObjPtr);
2228 }
2229
2230 buf = Jim_Alloc(strObjPtr->length+1);
2231
2232 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2233 for (i = 0; i < strObjPtr->length; i++)
2234 buf[i] = toupper(buf[i]);
2235 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2236 }
2237
2238 /* This is the core of the [format] command.
2239 * TODO: Lots of things work - via a hack
2240 * However, no format item can be >= JIM_MAX_FMT
2241 */
2242 #define JIM_MAX_FMT 2048
2243 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2244 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2245 {
2246 const char *fmt, *_fmt;
2247 int fmtLen;
2248 Jim_Obj *resObjPtr;
2249
2250
2251 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2252 _fmt = fmt;
2253 resObjPtr = Jim_NewStringObj(interp, "", 0);
2254 while (fmtLen) {
2255 const char *p = fmt;
2256 char spec[2], c;
2257 jim_wide wideValue;
2258 double doubleValue;
2259 /* we cheat and use Sprintf()! */
2260 char fmt_str[100];
2261 char *cp;
2262 int width;
2263 int ljust;
2264 int zpad;
2265 int spad;
2266 int altfm;
2267 int forceplus;
2268 int prec;
2269 int inprec;
2270 int haveprec;
2271 int accum;
2272
2273 while (*fmt != '%' && fmtLen) {
2274 fmt++; fmtLen--;
2275 }
2276 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2277 if (fmtLen == 0)
2278 break;
2279 fmt++; fmtLen--; /* skip '%' */
2280 zpad = 0;
2281 spad = 0;
2282 width = -1;
2283 ljust = 0;
2284 altfm = 0;
2285 forceplus = 0;
2286 inprec = 0;
2287 haveprec = 0;
2288 prec = -1; /* not found yet */
2289 next_fmt:
2290 if( fmtLen <= 0 ){
2291 break;
2292 }
2293 switch( *fmt ){
2294 /* terminals */
2295 case 'b': /* binary - not all printfs() do this */
2296 case 's': /* string */
2297 case 'i': /* integer */
2298 case 'd': /* decimal */
2299 case 'x': /* hex */
2300 case 'X': /* CAP hex */
2301 case 'c': /* char */
2302 case 'o': /* octal */
2303 case 'u': /* unsigned */
2304 case 'f': /* float */
2305 break;
2306
2307 /* non-terminals */
2308 case '0': /* zero pad */
2309 zpad = 1;
2310 fmt++; fmtLen--;
2311 goto next_fmt;
2312 break;
2313 case '+':
2314 forceplus = 1;
2315 fmt++; fmtLen--;
2316 goto next_fmt;
2317 break;
2318 case ' ': /* sign space */
2319 spad = 1;
2320 fmt++; fmtLen--;
2321 goto next_fmt;
2322 break;
2323 case '-':
2324 ljust = 1;
2325 fmt++; fmtLen--;
2326 goto next_fmt;
2327 break;
2328 case '#':
2329 altfm = 1;
2330 fmt++; fmtLen--;
2331 goto next_fmt;
2332
2333 case '.':
2334 inprec = 1;
2335 fmt++; fmtLen--;
2336 goto next_fmt;
2337 break;
2338 case '1':
2339 case '2':
2340 case '3':
2341 case '4':
2342 case '5':
2343 case '6':
2344 case '7':
2345 case '8':
2346 case '9':
2347 accum = 0;
2348 while( isdigit(*fmt) && (fmtLen > 0) ){
2349 accum = (accum * 10) + (*fmt - '0');
2350 fmt++; fmtLen--;
2351 }
2352 if( inprec ){
2353 haveprec = 1;
2354 prec = accum;
2355 } else {
2356 width = accum;
2357 }
2358 goto next_fmt;
2359 case '*':
2360 /* suck up the next item as an integer */
2361 fmt++; fmtLen--;
2362 objc--;
2363 if( objc <= 0 ){
2364 goto not_enough_args;
2365 }
2366 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2367 Jim_FreeNewObj(interp, resObjPtr );
2368 return NULL;
2369 }
2370 if( inprec ){
2371 haveprec = 1;
2372 prec = wideValue;
2373 if( prec < 0 ){
2374 /* man 3 printf says */
2375 /* if prec is negative, it is zero */
2376 prec = 0;
2377 }
2378 } else {
2379 width = wideValue;
2380 if( width < 0 ){
2381 ljust = 1;
2382 width = -width;
2383 }
2384 }
2385 objv++;
2386 goto next_fmt;
2387 break;
2388 }
2389
2390
2391 if (*fmt != '%') {
2392 if (objc == 0) {
2393 not_enough_args:
2394 Jim_FreeNewObj(interp, resObjPtr);
2395 Jim_SetResultString(interp,
2396 "not enough arguments for all format specifiers", -1);
2397 return NULL;
2398 } else {
2399 objc--;
2400 }
2401 }
2402
2403 /*
2404 * Create the formatter
2405 * cause we cheat and use sprintf()
2406 */
2407 cp = fmt_str;
2408 *cp++ = '%';
2409 if( altfm ){
2410 *cp++ = '#';
2411 }
2412 if( forceplus ){
2413 *cp++ = '+';
2414 } else if( spad ){
2415 /* PLUS overrides */
2416 *cp++ = ' ';
2417 }
2418 if( ljust ){
2419 *cp++ = '-';
2420 }
2421 if( zpad ){
2422 *cp++ = '0';
2423 }
2424 if( width > 0 ){
2425 sprintf( cp, "%d", width );
2426 /* skip ahead */
2427 cp = strchr(cp,0);
2428 }
2429 /* did we find a period? */
2430 if( inprec ){
2431 /* then add it */
2432 *cp++ = '.';
2433 /* did something occur after the period? */
2434 if( haveprec ){
2435 sprintf( cp, "%d", prec );
2436 }
2437 cp = strchr(cp,0);
2438 }
2439 *cp = 0;
2440
2441 /* here we do the work */
2442 /* actually - we make sprintf() do it for us */
2443 switch(*fmt) {
2444 case 's':
2445 *cp++ = 's';
2446 *cp = 0;
2447 /* BUG: we do not handled embeded NULLs */
2448 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2449 break;
2450 case 'c':
2451 *cp++ = 'c';
2452 *cp = 0;
2453 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2454 Jim_FreeNewObj(interp, resObjPtr);
2455 return NULL;
2456 }
2457 c = (char) wideValue;
2458 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2459 break;
2460 case 'f':
2461 case 'F':
2462 case 'g':
2463 case 'G':
2464 case 'e':
2465 case 'E':
2466 *cp++ = *fmt;
2467 *cp = 0;
2468 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2469 Jim_FreeNewObj( interp, resObjPtr );
2470 return NULL;
2471 }
2472 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2473 break;
2474 case 'b':
2475 case 'd':
2476 case 'o':
2477 case 'i':
2478 case 'u':
2479 case 'x':
2480 case 'X':
2481 /* jim widevaluse are 64bit */
2482 if( sizeof(jim_wide) == sizeof(long long) ){
2483 *cp++ = 'l';
2484 *cp++ = 'l';
2485 } else {
2486 *cp++ = 'l';
2487 }
2488 *cp++ = *fmt;
2489 *cp = 0;
2490 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2491 Jim_FreeNewObj(interp, resObjPtr);
2492 return NULL;
2493 }
2494 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2495 break;
2496 case '%':
2497 sprintf_buf[0] = '%';
2498 sprintf_buf[1] = 0;
2499 objv--; /* undo the objv++ below */
2500 break;
2501 default:
2502 spec[0] = *fmt; spec[1] = '\0';
2503 Jim_FreeNewObj(interp, resObjPtr);
2504 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2505 Jim_AppendStrings(interp, Jim_GetResult(interp),
2506 "bad field specifier \"", spec, "\"", NULL);
2507 return NULL;
2508 }
2509 /* force terminate */
2510 #if 0
2511 printf("FMT was: %s\n", fmt_str );
2512 printf("RES was: |%s|\n", sprintf_buf );
2513 #endif
2514
2515 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2516 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2517 /* next obj */
2518 objv++;
2519 fmt++;
2520 fmtLen--;
2521 }
2522 return resObjPtr;
2523 }
2524
2525 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2526 int objc, Jim_Obj *const *objv)
2527 {
2528 char *sprintf_buf=malloc(JIM_MAX_FMT);
2529 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2530 free(sprintf_buf);
2531 return t;
2532 }
2533
2534 /* -----------------------------------------------------------------------------
2535 * Compared String Object
2536 * ---------------------------------------------------------------------------*/
2537
2538 /* This is strange object that allows to compare a C literal string
2539 * with a Jim object in very short time if the same comparison is done
2540 * multiple times. For example every time the [if] command is executed,
2541 * Jim has to check if a given argument is "else". This comparions if
2542 * the code has no errors are true most of the times, so we can cache
2543 * inside the object the pointer of the string of the last matching
2544 * comparison. Because most C compilers perform literal sharing,
2545 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2546 * this works pretty well even if comparisons are at different places
2547 * inside the C code. */
2548
2549 static Jim_ObjType comparedStringObjType = {
2550 "compared-string",
2551 NULL,
2552 NULL,
2553 NULL,
2554 JIM_TYPE_REFERENCES,
2555 };
2556
2557 /* The only way this object is exposed to the API is via the following
2558 * function. Returns true if the string and the object string repr.
2559 * are the same, otherwise zero is returned.
2560 *
2561 * Note: this isn't binary safe, but it hardly needs to be.*/
2562 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2563 const char *str)
2564 {
2565 if (objPtr->typePtr == &comparedStringObjType &&
2566 objPtr->internalRep.ptr == str)
2567 return 1;
2568 else {
2569 const char *objStr = Jim_GetString(objPtr, NULL);
2570 if (strcmp(str, objStr) != 0) return 0;
2571 if (objPtr->typePtr != &comparedStringObjType) {
2572 Jim_FreeIntRep(interp, objPtr);
2573 objPtr->typePtr = &comparedStringObjType;
2574 }
2575 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2576 return 1;
2577 }
2578 }
2579
2580 int qsortCompareStringPointers(const void *a, const void *b)
2581 {
2582 char * const *sa = (char * const *)a;
2583 char * const *sb = (char * const *)b;
2584 return strcmp(*sa, *sb);
2585 }
2586
2587 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2588 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2589 {
2590 const char * const *entryPtr = NULL;
2591 char **tablePtrSorted;
2592 int i, count = 0;
2593
2594 *indexPtr = -1;
2595 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2596 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2597 *indexPtr = i;
2598 return JIM_OK;
2599 }
2600 count++; /* If nothing matches, this will reach the len of tablePtr */
2601 }
2602 if (flags & JIM_ERRMSG) {
2603 if (name == NULL)
2604 name = "option";
2605 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2606 Jim_AppendStrings(interp, Jim_GetResult(interp),
2607 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2608 NULL);
2609 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2610 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2611 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2612 for (i = 0; i < count; i++) {
2613 if (i+1 == count && count > 1)
2614 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2615 Jim_AppendString(interp, Jim_GetResult(interp),
2616 tablePtrSorted[i], -1);
2617 if (i+1 != count)
2618 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2619 }
2620 Jim_Free(tablePtrSorted);
2621 }
2622 return JIM_ERR;
2623 }
2624
2625 int Jim_GetNvp(Jim_Interp *interp,
2626 Jim_Obj *objPtr,
2627 const Jim_Nvp *nvp_table,
2628 const Jim_Nvp ** result)
2629 {
2630 Jim_Nvp *n;
2631 int e;
2632
2633 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2634 if( e == JIM_ERR ){
2635 return e;
2636 }
2637
2638 /* Success? found? */
2639 if( n->name ){
2640 /* remove const */
2641 *result = (Jim_Nvp *)n;
2642 return JIM_OK;
2643 } else {
2644 return JIM_ERR;
2645 }
2646 }
2647
2648 /* -----------------------------------------------------------------------------
2649 * Source Object
2650 *
2651 * This object is just a string from the language point of view, but
2652 * in the internal representation it contains the filename and line number
2653 * where this given token was read. This information is used by
2654 * Jim_EvalObj() if the object passed happens to be of type "source".
2655 *
2656 * This allows to propagate the information about line numbers and file
2657 * names and give error messages with absolute line numbers.
2658 *
2659 * Note that this object uses shared strings for filenames, and the
2660 * pointer to the filename together with the line number is taken into
2661 * the space for the "inline" internal represenation of the Jim_Object,
2662 * so there is almost memory zero-overhead.
2663 *
2664 * Also the object will be converted to something else if the given
2665 * token it represents in the source file is not something to be
2666 * evaluated (not a script), and will be specialized in some other way,
2667 * so the time overhead is alzo null.
2668 * ---------------------------------------------------------------------------*/
2669
2670 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2671 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2672
2673 static Jim_ObjType sourceObjType = {
2674 "source",
2675 FreeSourceInternalRep,
2676 DupSourceInternalRep,
2677 NULL,
2678 JIM_TYPE_REFERENCES,
2679 };
2680
2681 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2682 {
2683 Jim_ReleaseSharedString(interp,
2684 objPtr->internalRep.sourceValue.fileName);
2685 }
2686
2687 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2688 {
2689 dupPtr->internalRep.sourceValue.fileName =
2690 Jim_GetSharedString(interp,
2691 srcPtr->internalRep.sourceValue.fileName);
2692 dupPtr->internalRep.sourceValue.lineNumber =
2693 dupPtr->internalRep.sourceValue.lineNumber;
2694 dupPtr->typePtr = &sourceObjType;
2695 }
2696
2697 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2698 const char *fileName, int lineNumber)
2699 {
2700 if (Jim_IsShared(objPtr))
2701 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2702 if (objPtr->typePtr != NULL)
2703 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2704 objPtr->internalRep.sourceValue.fileName =
2705 Jim_GetSharedString(interp, fileName);
2706 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2707 objPtr->typePtr = &sourceObjType;
2708 }
2709
2710 /* -----------------------------------------------------------------------------
2711 * Script Object
2712 * ---------------------------------------------------------------------------*/
2713
2714 #define JIM_CMDSTRUCT_EXPAND -1
2715
2716 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2717 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2718 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2719
2720 static Jim_ObjType scriptObjType = {
2721 "script",
2722 FreeScriptInternalRep,
2723 DupScriptInternalRep,
2724 NULL,
2725 JIM_TYPE_REFERENCES,
2726 };
2727
2728 /* The ScriptToken structure represents every token into a scriptObj.
2729 * Every token contains an associated Jim_Obj that can be specialized
2730 * by commands operating on it. */
2731 typedef struct ScriptToken {
2732 int type;
2733 Jim_Obj *objPtr;
2734 int linenr;
2735 } ScriptToken;
2736
2737 /* This is the script object internal representation. An array of
2738 * ScriptToken structures, with an associated command structure array.
2739 * The command structure is a pre-computed representation of the
2740 * command length and arguments structure as a simple liner array
2741 * of integers.
2742 *
2743 * For example the script:
2744 *
2745 * puts hello
2746 * set $i $x$y [foo]BAR
2747 *
2748 * will produce a ScriptObj with the following Tokens:
2749 *
2750 * ESC puts
2751 * SEP
2752 * ESC hello
2753 * EOL
2754 * ESC set
2755 * EOL
2756 * VAR i
2757 * SEP
2758 * VAR x
2759 * VAR y
2760 * SEP
2761 * CMD foo
2762 * ESC BAR
2763 * EOL
2764 *
2765 * This is a description of the tokens, separators, and of lines.
2766 * The command structure instead represents the number of arguments
2767 * of every command, followed by the tokens of which every argument
2768 * is composed. So for the example script, the cmdstruct array will
2769 * contain:
2770 *
2771 * 2 1 1 4 1 1 2 2
2772 *
2773 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2774 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2775 * composed of single tokens (1 1) and the last two of double tokens
2776 * (2 2).
2777 *
2778 * The precomputation of the command structure makes Jim_Eval() faster,
2779 * and simpler because there aren't dynamic lengths / allocations.
2780 *
2781 * -- {expand} handling --
2782 *
2783 * Expand is handled in a special way. When a command
2784 * contains at least an argument with the {expand} prefix,
2785 * the command structure presents a -1 before the integer
2786 * describing the number of arguments. This is used in order
2787 * to send the command exection to a different path in case
2788 * of {expand} and guarantee a fast path for the more common
2789 * case. Also, the integers describing the number of tokens
2790 * are expressed with negative sign, to allow for fast check
2791 * of what's an {expand}-prefixed argument and what not.
2792 *
2793 * For example the command:
2794 *
2795 * list {expand}{1 2}
2796 *
2797 * Will produce the following cmdstruct array:
2798 *
2799 * -1 2 1 -2
2800 *
2801 * -- the substFlags field of the structure --
2802 *
2803 * The scriptObj structure is used to represent both "script" objects
2804 * and "subst" objects. In the second case, the cmdStruct related
2805 * fields are not used at all, but there is an additional field used
2806 * that is 'substFlags': this represents the flags used to turn
2807 * the string into the intenral representation used to perform the
2808 * substitution. If this flags are not what the application requires
2809 * the scriptObj is created again. For example the script:
2810 *
2811 * subst -nocommands $string
2812 * subst -novariables $string
2813 *
2814 * Will recreate the internal representation of the $string object
2815 * two times.
2816 */
2817 typedef struct ScriptObj {
2818 int len; /* Length as number of tokens. */
2819 int commands; /* number of top-level commands in script. */
2820 ScriptToken *token; /* Tokens array. */
2821 int *cmdStruct; /* commands structure */
2822 int csLen; /* length of the cmdStruct array. */
2823 int substFlags; /* flags used for the compilation of "subst" objects */
2824 int inUse; /* Used to share a ScriptObj. Currently
2825 only used by Jim_EvalObj() as protection against
2826 shimmering of the currently evaluated object. */
2827 char *fileName;
2828 } ScriptObj;
2829
2830 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2831 {
2832 int i;
2833 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2834
2835 script->inUse--;
2836 if (script->inUse != 0) return;
2837 for (i = 0; i < script->len; i++) {
2838 if (script->token[i].objPtr != NULL)
2839 Jim_DecrRefCount(interp, script->token[i].objPtr);
2840 }
2841 Jim_Free(script->token);
2842 Jim_Free(script->cmdStruct);
2843 Jim_Free(script->fileName);
2844 Jim_Free(script);
2845 }
2846
2847 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2848 {
2849 JIM_NOTUSED(interp);
2850 JIM_NOTUSED(srcPtr);
2851
2852 /* Just returns an simple string. */
2853 dupPtr->typePtr = NULL;
2854 }
2855
2856 /* Add a new token to the internal repr of a script object */
2857 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2858 char *strtoken, int len, int type, char *filename, int linenr)
2859 {
2860 int prevtype;
2861 struct ScriptToken *token;
2862
2863 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2864 script->token[script->len-1].type;
2865 /* Skip tokens without meaning, like words separators
2866 * following a word separator or an end of command and
2867 * so on. */
2868 if (prevtype == JIM_TT_EOL) {
2869 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2870 Jim_Free(strtoken);
2871 return;
2872 }
2873 } else if (prevtype == JIM_TT_SEP) {
2874 if (type == JIM_TT_SEP) {
2875 Jim_Free(strtoken);
2876 return;
2877 } else if (type == JIM_TT_EOL) {
2878 /* If an EOL is following by a SEP, drop the previous
2879 * separator. */
2880 script->len--;
2881 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2882 }
2883 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2884 type == JIM_TT_ESC && len == 0)
2885 {
2886 /* Don't add empty tokens used in interpolation */
2887 Jim_Free(strtoken);
2888 return;
2889 }
2890 /* Make space for a new istruction */
2891 script->len++;
2892 script->token = Jim_Realloc(script->token,
2893 sizeof(ScriptToken)*script->len);
2894 /* Initialize the new token */
2895 token = script->token+(script->len-1);
2896 token->type = type;
2897 /* Every object is intially as a string, but the
2898 * internal type may be specialized during execution of the
2899 * script. */
2900 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2901 /* To add source info to SEP and EOL tokens is useless because
2902 * they will never by called as arguments of Jim_EvalObj(). */
2903 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2904 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2905 Jim_IncrRefCount(token->objPtr);
2906 token->linenr = linenr;
2907 }
2908
2909 /* Add an integer into the command structure field of the script object. */
2910 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2911 {
2912 script->csLen++;
2913 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2914 sizeof(int)*script->csLen);
2915 script->cmdStruct[script->csLen-1] = val;
2916 }
2917
2918 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2919 * of objPtr. Search nested script objects recursively. */
2920 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2921 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2922 {
2923 int i;
2924
2925 for (i = 0; i < script->len; i++) {
2926 if (script->token[i].objPtr != objPtr &&
2927 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2928 return script->token[i].objPtr;
2929 }
2930 /* Enter recursively on scripts only if the object
2931 * is not the same as the one we are searching for
2932 * shared occurrences. */
2933 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2934 script->token[i].objPtr != objPtr) {
2935 Jim_Obj *foundObjPtr;
2936
2937 ScriptObj *subScript =
2938 script->token[i].objPtr->internalRep.ptr;
2939 /* Don't recursively enter the script we are trying
2940 * to make shared to avoid circular references. */
2941 if (subScript == scriptBarrier) continue;
2942 if (subScript != script) {
2943 foundObjPtr =
2944 ScriptSearchLiteral(interp, subScript,
2945 scriptBarrier, objPtr);
2946 if (foundObjPtr != NULL)
2947 return foundObjPtr;
2948 }
2949 }
2950 }
2951 return NULL;
2952 }
2953
2954 /* Share literals of a script recursively sharing sub-scripts literals. */
2955 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2956 ScriptObj *topLevelScript)
2957 {
2958 int i, j;
2959
2960 return;
2961 /* Try to share with toplevel object. */
2962 if (topLevelScript != NULL) {
2963 for (i = 0; i < script->len; i++) {
2964 Jim_Obj *foundObjPtr;
2965 char *str = script->token[i].objPtr->bytes;
2966
2967 if (script->token[i].objPtr->refCount != 1) continue;
2968 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2969 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2970 foundObjPtr = ScriptSearchLiteral(interp,
2971 topLevelScript,
2972 script, /* barrier */
2973 script->token[i].objPtr);
2974 if (foundObjPtr != NULL) {
2975 Jim_IncrRefCount(foundObjPtr);
2976 Jim_DecrRefCount(interp,
2977 script->token[i].objPtr);
2978 script->token[i].objPtr = foundObjPtr;
2979 }
2980 }
2981 }
2982 /* Try to share locally */
2983 for (i = 0; i < script->len; i++) {
2984 char *str = script->token[i].objPtr->bytes;
2985
2986 if (script->token[i].objPtr->refCount != 1) continue;
2987 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2988 for (j = 0; j < script->len; j++) {
2989 if (script->token[i].objPtr !=
2990 script->token[j].objPtr &&
2991 Jim_StringEqObj(script->token[i].objPtr,
2992 script->token[j].objPtr, 0))
2993 {
2994 Jim_IncrRefCount(script->token[j].objPtr);
2995 Jim_DecrRefCount(interp,
2996 script->token[i].objPtr);
2997 script->token[i].objPtr =
2998 script->token[j].objPtr;
2999 }
3000 }
3001 }
3002 }
3003
3004 /* This method takes the string representation of an object
3005 * as a Tcl script, and generates the pre-parsed internal representation
3006 * of the script. */
3007 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3008 {
3009 int scriptTextLen;
3010 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3011 struct JimParserCtx parser;
3012 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3013 ScriptToken *token;
3014 int args, tokens, start, end, i;
3015 int initialLineNumber;
3016 int propagateSourceInfo = 0;
3017
3018 script->len = 0;
3019 script->csLen = 0;
3020 script->commands = 0;
3021 script->token = NULL;
3022 script->cmdStruct = NULL;
3023 script->inUse = 1;
3024 /* Try to get information about filename / line number */
3025 if (objPtr->typePtr == &sourceObjType) {
3026 script->fileName =
3027 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3028 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3029 propagateSourceInfo = 1;
3030 } else {
3031 script->fileName = Jim_StrDup("");
3032 initialLineNumber = 1;
3033 }
3034
3035 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3036 while(!JimParserEof(&parser)) {
3037 char *token;
3038 int len, type, linenr;
3039
3040 JimParseScript(&parser);
3041 token = JimParserGetToken(&parser, &len, &type, &linenr);
3042 ScriptObjAddToken(interp, script, token, len, type,
3043 propagateSourceInfo ? script->fileName : NULL,
3044 linenr);
3045 }
3046 token = script->token;
3047
3048 /* Compute the command structure array
3049 * (see the ScriptObj struct definition for more info) */
3050 start = 0; /* Current command start token index */
3051 end = -1; /* Current command end token index */
3052 while (1) {
3053 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3054 int interpolation = 0; /* set to 1 if there is at least one
3055 argument of the command obtained via
3056 interpolation of more tokens. */
3057 /* Search for the end of command, while
3058 * count the number of args. */
3059 start = ++end;
3060 if (start >= script->len) break;
3061 args = 1; /* Number of args in current command */
3062 while (token[end].type != JIM_TT_EOL) {
3063 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3064 token[end-1].type == JIM_TT_EOL)
3065 {
3066 if (token[end].type == JIM_TT_STR &&
3067 token[end+1].type != JIM_TT_SEP &&
3068 token[end+1].type != JIM_TT_EOL &&
3069 (!strcmp(token[end].objPtr->bytes, "expand") ||
3070 !strcmp(token[end].objPtr->bytes, "*")))
3071 expand++;
3072 }
3073 if (token[end].type == JIM_TT_SEP)
3074 args++;
3075 end++;
3076 }
3077 interpolation = !((end-start+1) == args*2);
3078 /* Add the 'number of arguments' info into cmdstruct.
3079 * Negative value if there is list expansion involved. */
3080 if (expand)
3081 ScriptObjAddInt(script, -1);
3082 ScriptObjAddInt(script, args);
3083 /* Now add info about the number of tokens. */
3084 tokens = 0; /* Number of tokens in current argument. */
3085 expand = 0;
3086 for (i = start; i <= end; i++) {
3087 if (token[i].type == JIM_TT_SEP ||
3088 token[i].type == JIM_TT_EOL)
3089 {
3090 if (tokens == 1 && expand)
3091 expand = 0;
3092 ScriptObjAddInt(script,
3093 expand ? -tokens : tokens);
3094
3095 expand = 0;
3096 tokens = 0;
3097 continue;
3098 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3099 (!strcmp(token[i].objPtr->bytes, "expand") ||
3100 !strcmp(token[i].objPtr->bytes, "*")))
3101 {
3102 expand++;
3103 }
3104 tokens++;
3105 }
3106 }
3107 /* Perform literal sharing, but only for objects that appear
3108 * to be scripts written as literals inside the source code,
3109 * and not computed at runtime. Literal sharing is a costly
3110 * operation that should be done only against objects that
3111 * are likely to require compilation only the first time, and
3112 * then are executed multiple times. */
3113 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3114 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3115 if (bodyObjPtr->typePtr == &scriptObjType) {
3116 ScriptObj *bodyScript =
3117 bodyObjPtr->internalRep.ptr;
3118 ScriptShareLiterals(interp, script, bodyScript);
3119 }
3120 } else if (propagateSourceInfo) {
3121 ScriptShareLiterals(interp, script, NULL);
3122 }
3123 /* Free the old internal rep and set the new one. */
3124 Jim_FreeIntRep(interp, objPtr);
3125 Jim_SetIntRepPtr(objPtr, script);
3126 objPtr->typePtr = &scriptObjType;
3127 return JIM_OK;
3128 }
3129
3130 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3131 {
3132 if (objPtr->typePtr != &scriptObjType) {
3133 SetScriptFromAny(interp, objPtr);
3134 }
3135 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3136 }
3137
3138 /* -----------------------------------------------------------------------------
3139 * Commands
3140 * ---------------------------------------------------------------------------*/
3141
3142 /* Commands HashTable Type.
3143 *
3144 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3145 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3146 {
3147 Jim_Cmd *cmdPtr = (void*) val;
3148
3149 if (cmdPtr->cmdProc == NULL) {
3150 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3151 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3152 if (cmdPtr->staticVars) {
3153 Jim_FreeHashTable(cmdPtr->staticVars);
3154 Jim_Free(cmdPtr->staticVars);
3155 }
3156 } else if (cmdPtr->delProc != NULL) {
3157 /* If it was a C coded command, call the delProc if any */
3158 cmdPtr->delProc(interp, cmdPtr->privData);
3159 }
3160 Jim_Free(val);
3161 }
3162
3163 static Jim_HashTableType JimCommandsHashTableType = {
3164 JimStringCopyHTHashFunction, /* hash function */
3165 JimStringCopyHTKeyDup, /* key dup */
3166 NULL, /* val dup */
3167 JimStringCopyHTKeyCompare, /* key compare */
3168 JimStringCopyHTKeyDestructor, /* key destructor */
3169 Jim_CommandsHT_ValDestructor /* val destructor */
3170 };
3171
3172 /* ------------------------- Commands related functions --------------------- */
3173
3174 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3175 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3176 {
3177 Jim_HashEntry *he;
3178 Jim_Cmd *cmdPtr;
3179
3180 he = Jim_FindHashEntry(&interp->commands, cmdName);
3181 if (he == NULL) { /* New command to create */
3182 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3183 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3184 } else {
3185 Jim_InterpIncrProcEpoch(interp);
3186 /* Free the arglist/body objects if it was a Tcl procedure */
3187 cmdPtr = he->val;
3188 if (cmdPtr->cmdProc == NULL) {
3189 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3190 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3191 if (cmdPtr->staticVars) {
3192 Jim_FreeHashTable(cmdPtr->staticVars);
3193 Jim_Free(cmdPtr->staticVars);
3194 }
3195 cmdPtr->staticVars = NULL;
3196 } else if (cmdPtr->delProc != NULL) {
3197 /* If it was a C coded command, call the delProc if any */
3198 cmdPtr->delProc(interp, cmdPtr->privData);
3199 }
3200 }
3201
3202 /* Store the new details for this proc */
3203 cmdPtr->delProc = delProc;
3204 cmdPtr->cmdProc = cmdProc;
3205 cmdPtr->privData = privData;
3206
3207 /* There is no need to increment the 'proc epoch' because
3208 * creation of a new procedure can never affect existing
3209 * cached commands. We don't do negative caching. */
3210 return JIM_OK;
3211 }
3212
3213 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3214 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3215 int arityMin, int arityMax)
3216 {
3217 Jim_Cmd *cmdPtr;
3218
3219 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3220 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3221 cmdPtr->argListObjPtr = argListObjPtr;
3222 cmdPtr->bodyObjPtr = bodyObjPtr;
3223 Jim_IncrRefCount(argListObjPtr);
3224 Jim_IncrRefCount(bodyObjPtr);
3225 cmdPtr->arityMin = arityMin;
3226 cmdPtr->arityMax = arityMax;
3227 cmdPtr->staticVars = NULL;
3228
3229 /* Create the statics hash table. */
3230 if (staticsListObjPtr) {
3231 int len, i;
3232
3233 Jim_ListLength(interp, staticsListObjPtr, &len);
3234 if (len != 0) {
3235 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3236 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3237 interp);
3238 for (i = 0; i < len; i++) {
3239 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3240 Jim_Var *varPtr;
3241 int subLen;
3242
3243 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3244 /* Check if it's composed of two elements. */
3245 Jim_ListLength(interp, objPtr, &subLen);
3246 if (subLen == 1 || subLen == 2) {
3247 /* Try to get the variable value from the current
3248 * environment. */
3249 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3250 if (subLen == 1) {
3251 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3252 JIM_NONE);
3253 if (initObjPtr == NULL) {
3254 Jim_SetResult(interp,
3255 Jim_NewEmptyStringObj(interp));
3256 Jim_AppendStrings(interp, Jim_GetResult(interp),
3257 "variable for initialization of static \"",
3258 Jim_GetString(nameObjPtr, NULL),
3259 "\" not found in the local context",
3260 NULL);
3261 goto err;
3262 }
3263 } else {
3264 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3265 }
3266 varPtr = Jim_Alloc(sizeof(*varPtr));
3267 varPtr->objPtr = initObjPtr;
3268 Jim_IncrRefCount(initObjPtr);
3269 varPtr->linkFramePtr = NULL;
3270 if (Jim_AddHashEntry(cmdPtr->staticVars,
3271 Jim_GetString(nameObjPtr, NULL),
3272 varPtr) != JIM_OK)
3273 {
3274 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3275 Jim_AppendStrings(interp, Jim_GetResult(interp),
3276 "static variable name \"",
3277 Jim_GetString(objPtr, NULL), "\"",
3278 " duplicated in statics list", NULL);
3279 Jim_DecrRefCount(interp, initObjPtr);
3280 Jim_Free(varPtr);
3281 goto err;
3282 }
3283 } else {
3284 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3285 Jim_AppendStrings(interp, Jim_GetResult(interp),
3286 "too many fields in static specifier \"",
3287 objPtr, "\"", NULL);
3288 goto err;
3289 }
3290 }
3291 }
3292 }
3293
3294 /* Add the new command */
3295
3296 /* it may already exist, so we try to delete the old one */
3297 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3298 /* There was an old procedure with the same name, this requires
3299 * a 'proc epoch' update. */
3300 Jim_InterpIncrProcEpoch(interp);
3301 }
3302 /* If a procedure with the same name didn't existed there is no need
3303 * to increment the 'proc epoch' because creation of a new procedure
3304 * can never affect existing cached commands. We don't do
3305 * negative caching. */
3306 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3307 return JIM_OK;
3308
3309 err:
3310 Jim_FreeHashTable(cmdPtr->staticVars);
3311 Jim_Free(cmdPtr->staticVars);
3312 Jim_DecrRefCount(interp, argListObjPtr);
3313 Jim_DecrRefCount(interp, bodyObjPtr);
3314 Jim_Free(cmdPtr);
3315 return JIM_ERR;
3316 }
3317
3318 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3319 {
3320 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3321 return JIM_ERR;
3322 Jim_InterpIncrProcEpoch(interp);
3323 return JIM_OK;
3324 }
3325
3326 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3327 const char *newName)
3328 {
3329 Jim_Cmd *cmdPtr;
3330 Jim_HashEntry *he;
3331 Jim_Cmd *copyCmdPtr;
3332
3333 if (newName[0] == '\0') /* Delete! */
3334 return Jim_DeleteCommand(interp, oldName);
3335 /* Rename */
3336 he = Jim_FindHashEntry(&interp->commands, oldName);
3337 if (he == NULL)
3338 return JIM_ERR; /* Invalid command name */
3339 cmdPtr = he->val;
3340 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3341 *copyCmdPtr = *cmdPtr;
3342 /* In order to avoid that a procedure will get arglist/body/statics
3343 * freed by the hash table methods, fake a C-coded command
3344 * setting cmdPtr->cmdProc as not NULL */
3345 cmdPtr->cmdProc = (void*)1;
3346 /* Also make sure delProc is NULL. */
3347 cmdPtr->delProc = NULL;
3348 /* Destroy the old command, and make sure the new is freed
3349 * as well. */
3350 Jim_DeleteHashEntry(&interp->commands, oldName);
3351 Jim_DeleteHashEntry(&interp->commands, newName);
3352 /* Now the new command. We are sure it can't fail because
3353 * the target name was already freed. */
3354 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3355 /* Increment the epoch */
3356 Jim_InterpIncrProcEpoch(interp);
3357 return JIM_OK;
3358 }
3359
3360 /* -----------------------------------------------------------------------------
3361 * Command object
3362 * ---------------------------------------------------------------------------*/
3363
3364 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3365
3366 static Jim_ObjType commandObjType = {
3367 "command",
3368 NULL,
3369 NULL,
3370 NULL,
3371 JIM_TYPE_REFERENCES,
3372 };
3373
3374 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3375 {
3376 Jim_HashEntry *he;
3377 const char *cmdName;
3378
3379 /* Get the string representation */
3380 cmdName = Jim_GetString(objPtr, NULL);
3381 /* Lookup this name into the commands hash table */
3382 he = Jim_FindHashEntry(&interp->commands, cmdName);
3383 if (he == NULL)
3384 return JIM_ERR;
3385
3386 /* Free the old internal repr and set the new one. */
3387 Jim_FreeIntRep(interp, objPtr);
3388 objPtr->typePtr = &commandObjType;
3389 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3390 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3391 return JIM_OK;
3392 }
3393
3394 /* This function returns the command structure for the command name
3395 * stored in objPtr. It tries to specialize the objPtr to contain
3396 * a cached info instead to perform the lookup into the hash table
3397 * every time. The information cached may not be uptodate, in such
3398 * a case the lookup is performed and the cache updated. */
3399 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3400 {
3401 if ((objPtr->typePtr != &commandObjType ||
3402 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3403 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3404 if (flags & JIM_ERRMSG) {
3405 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3406 Jim_AppendStrings(interp, Jim_GetResult(interp),
3407 "invalid command name \"", objPtr->bytes, "\"",
3408 NULL);
3409 }
3410 return NULL;
3411 }
3412 return objPtr->internalRep.cmdValue.cmdPtr;
3413 }
3414
3415 /* -----------------------------------------------------------------------------
3416 * Variables
3417 * ---------------------------------------------------------------------------*/
3418
3419 /* Variables HashTable Type.
3420 *
3421 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3422 static void JimVariablesHTValDestructor(void *interp, void *val)
3423 {
3424 Jim_Var *varPtr = (void*) val;
3425
3426 Jim_DecrRefCount(interp, varPtr->objPtr);
3427 Jim_Free(val);
3428 }
3429
3430 static Jim_HashTableType JimVariablesHashTableType = {
3431 JimStringCopyHTHashFunction, /* hash function */
3432 JimStringCopyHTKeyDup, /* key dup */
3433 NULL, /* val dup */
3434 JimStringCopyHTKeyCompare, /* key compare */
3435 JimStringCopyHTKeyDestructor, /* key destructor */
3436 JimVariablesHTValDestructor /* val destructor */
3437 };
3438
3439 /* -----------------------------------------------------------------------------
3440 * Variable object
3441 * ---------------------------------------------------------------------------*/
3442
3443 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3444
3445 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3446
3447 static Jim_ObjType variableObjType = {
3448 "variable",
3449 NULL,
3450 NULL,
3451 NULL,
3452 JIM_TYPE_REFERENCES,
3453 };
3454
3455 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3456 * is in the form "varname(key)". */
3457 static int Jim_NameIsDictSugar(const char *str, int len)
3458 {
3459 if (len == -1)
3460 len = strlen(str);
3461 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3462 return 1;
3463 return 0;
3464 }
3465
3466 /* This method should be called only by the variable API.
3467 * It returns JIM_OK on success (variable already exists),
3468 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3469 * a variable name, but syntax glue for [dict] i.e. the last
3470 * character is ')' */
3471 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3472 {
3473 Jim_HashEntry *he;
3474 const char *varName;
3475 int len;
3476
3477 /* Check if the object is already an uptodate variable */
3478 if (objPtr->typePtr == &variableObjType &&
3479 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3480 return JIM_OK; /* nothing to do */
3481 /* Get the string representation */
3482 varName = Jim_GetString(objPtr, &len);
3483 /* Make sure it's not syntax glue to get/set dict. */
3484 if (Jim_NameIsDictSugar(varName, len))
3485 return JIM_DICT_SUGAR;
3486 if (varName[0] == ':' && varName[1] == ':') {
3487 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3488 if (he == NULL) {
3489 return JIM_ERR;
3490 }
3491 }
3492 else {
3493 /* Lookup this name into the variables hash table */
3494 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3495 if (he == NULL) {
3496 /* Try with static vars. */
3497 if (interp->framePtr->staticVars == NULL)
3498 return JIM_ERR;
3499 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3500 return JIM_ERR;
3501 }
3502 }
3503 /* Free the old internal repr and set the new one. */
3504 Jim_FreeIntRep(interp, objPtr);
3505 objPtr->typePtr = &variableObjType;
3506 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3507 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3508 return JIM_OK;
3509 }
3510
3511 /* -------------------- Variables related functions ------------------------- */
3512 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3513 Jim_Obj *valObjPtr);
3514 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3515
3516 /* For now that's dummy. Variables lookup should be optimized
3517 * in many ways, with caching of lookups, and possibly with
3518 * a table of pre-allocated vars in every CallFrame for local vars.
3519 * All the caching should also have an 'epoch' mechanism similar
3520 * to the one used by Tcl for procedures lookup caching. */
3521
3522 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3523 {
3524 const char *name;
3525 Jim_Var *var;
3526 int err;
3527
3528 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3529 /* Check for [dict] syntax sugar. */
3530 if (err == JIM_DICT_SUGAR)
3531 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3532 /* New variable to create */
3533 name = Jim_GetString(nameObjPtr, NULL);
3534
3535 var = Jim_Alloc(sizeof(*var));
3536 var->objPtr = valObjPtr;
3537 Jim_IncrRefCount(valObjPtr);
3538 var->linkFramePtr = NULL;
3539 /* Insert the new variable */
3540 if (name[0] == ':' && name[1] == ':') {
3541 /* Into to the top evel frame */
3542 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3543 }
3544 else {
3545 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3546 }
3547 /* Make the object int rep a variable */
3548 Jim_FreeIntRep(interp, nameObjPtr);
3549 nameObjPtr->typePtr = &variableObjType;
3550 nameObjPtr->internalRep.varValue.callFrameId =
3551 interp->framePtr->id;
3552 nameObjPtr->internalRep.varValue.varPtr = var;
3553 } else {
3554 var = nameObjPtr->internalRep.varValue.varPtr;
3555 if (var->linkFramePtr == NULL) {
3556 Jim_IncrRefCount(valObjPtr);
3557 Jim_DecrRefCount(interp, var->objPtr);
3558 var->objPtr = valObjPtr;
3559 } else { /* Else handle the link */
3560 Jim_CallFrame *savedCallFrame;
3561
3562 savedCallFrame = interp->framePtr;
3563 interp->framePtr = var->linkFramePtr;
3564 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3565 interp->framePtr = savedCallFrame;
3566 if (err != JIM_OK)
3567 return err;
3568 }
3569 }
3570 return JIM_OK;
3571 }
3572
3573 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3574 {
3575 Jim_Obj *nameObjPtr;
3576 int result;
3577
3578 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3579 Jim_IncrRefCount(nameObjPtr);
3580 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3581 Jim_DecrRefCount(interp, nameObjPtr);
3582 return result;
3583 }
3584
3585 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3586 {
3587 Jim_CallFrame *savedFramePtr;
3588 int result;
3589
3590 savedFramePtr = interp->framePtr;
3591 interp->framePtr = interp->topFramePtr;
3592 result = Jim_SetVariableStr(interp, name, objPtr);
3593 interp->framePtr = savedFramePtr;
3594 return result;
3595 }
3596
3597 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3598 {
3599 Jim_Obj *nameObjPtr, *valObjPtr;
3600 int result;
3601
3602 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3603 valObjPtr = Jim_NewStringObj(interp, val, -1);
3604 Jim_IncrRefCount(nameObjPtr);
3605 Jim_IncrRefCount(valObjPtr);
3606 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3607 Jim_DecrRefCount(interp, nameObjPtr);
3608 Jim_DecrRefCount(interp, valObjPtr);
3609 return result;
3610 }
3611
3612 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3613 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3614 {
3615 const char *varName;
3616 int len;
3617
3618 /* Check for cycles. */
3619 if (interp->framePtr == targetCallFrame) {
3620 Jim_Obj *objPtr = targetNameObjPtr;
3621 Jim_Var *varPtr;
3622 /* Cycles are only possible with 'uplevel 0' */
3623 while(1) {
3624 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3625 Jim_SetResultString(interp,
3626 "can't upvar from variable to itself", -1);
3627 return JIM_ERR;
3628 }
3629 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3630 break;
3631 varPtr = objPtr->internalRep.varValue.varPtr;
3632 if (varPtr->linkFramePtr != targetCallFrame) break;
3633 objPtr = varPtr->objPtr;
3634 }
3635 }
3636 varName = Jim_GetString(nameObjPtr, &len);
3637 if (Jim_NameIsDictSugar(varName, len)) {
3638 Jim_SetResultString(interp,
3639 "Dict key syntax invalid as link source", -1);
3640 return JIM_ERR;
3641 }
3642 /* Perform the binding */
3643 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3644 /* We are now sure 'nameObjPtr' type is variableObjType */
3645 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3646 return JIM_OK;
3647 }
3648
3649 /* Return the Jim_Obj pointer associated with a variable name,
3650 * or NULL if the variable was not found in the current context.
3651 * The same optimization discussed in the comment to the
3652 * 'SetVariable' function should apply here. */
3653 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3654 {
3655 int err;
3656
3657 /* All the rest is handled here */
3658 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3659 /* Check for [dict] syntax sugar. */
3660 if (err == JIM_DICT_SUGAR)
3661 return JimDictSugarGet(interp, nameObjPtr);
3662 if (flags & JIM_ERRMSG) {
3663 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3664 Jim_AppendStrings(interp, Jim_GetResult(interp),
3665 "can't read \"", nameObjPtr->bytes,
3666 "\": no such variable", NULL);
3667 }
3668 return NULL;
3669 } else {
3670 Jim_Var *varPtr;
3671 Jim_Obj *objPtr;
3672 Jim_CallFrame *savedCallFrame;
3673
3674 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3675 if (varPtr->linkFramePtr == NULL)
3676 return varPtr->objPtr;
3677 /* The variable is a link? Resolve it. */
3678 savedCallFrame = interp->framePtr;
3679 interp->framePtr = varPtr->linkFramePtr;
3680 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3681 if (objPtr == NULL && flags & JIM_ERRMSG) {
3682 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3683 Jim_AppendStrings(interp, Jim_GetResult(interp),
3684 "can't read \"", nameObjPtr->bytes,
3685 "\": no such variable", NULL);
3686 }
3687 interp->framePtr = savedCallFrame;
3688 return objPtr;
3689 }
3690 }
3691
3692 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3693 int flags)
3694 {
3695 Jim_CallFrame *savedFramePtr;
3696 Jim_Obj *objPtr;
3697
3698 savedFramePtr = interp->framePtr;
3699 interp->framePtr = interp->topFramePtr;
3700 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3701 interp->framePtr = savedFramePtr;
3702
3703 return objPtr;
3704 }
3705
3706 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3707 {
3708 Jim_Obj *nameObjPtr, *varObjPtr;
3709
3710 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3711 Jim_IncrRefCount(nameObjPtr);
3712 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3713 Jim_DecrRefCount(interp, nameObjPtr);
3714 return varObjPtr;
3715 }
3716
3717 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3718 int flags)
3719 {
3720 Jim_CallFrame *savedFramePtr;
3721 Jim_Obj *objPtr;
3722
3723 savedFramePtr = interp->framePtr;
3724 interp->framePtr = interp->topFramePtr;
3725 objPtr = Jim_GetVariableStr(interp, name, flags);
3726 interp->framePtr = savedFramePtr;
3727
3728 return objPtr;
3729 }
3730
3731 /* Unset a variable.
3732 * Note: On success unset invalidates all the variable objects created
3733 * in the current call frame incrementing. */
3734 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3735 {
3736 const char *name;
3737 Jim_Var *varPtr;
3738 int err;
3739
3740 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3741 /* Check for [dict] syntax sugar. */
3742 if (err == JIM_DICT_SUGAR)
3743 return JimDictSugarSet(interp, nameObjPtr, NULL);
3744 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3745 Jim_AppendStrings(interp, Jim_GetResult(interp),
3746 "can't unset \"", nameObjPtr->bytes,
3747 "\": no such variable", NULL);
3748 return JIM_ERR; /* var not found */
3749 }
3750 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3751 /* If it's a link call UnsetVariable recursively */
3752 if (varPtr->linkFramePtr) {
3753 int retval;
3754
3755 Jim_CallFrame *savedCallFrame;
3756
3757 savedCallFrame = interp->framePtr;
3758 interp->framePtr = varPtr->linkFramePtr;
3759 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3760 interp->framePtr = savedCallFrame;
3761 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3762 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3763 Jim_AppendStrings(interp, Jim_GetResult(interp),
3764 "can't unset \"", nameObjPtr->bytes,
3765 "\": no such variable", NULL);
3766 }
3767 return retval;
3768 } else {
3769 name = Jim_GetString(nameObjPtr, NULL);
3770 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3771 != JIM_OK) return JIM_ERR;
3772 /* Change the callframe id, invalidating var lookup caching */
3773 JimChangeCallFrameId(interp, interp->framePtr);
3774 return JIM_OK;
3775 }
3776 }
3777
3778 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3779
3780 /* Given a variable name for [dict] operation syntax sugar,
3781 * this function returns two objects, the first with the name
3782 * of the variable to set, and the second with the rispective key.
3783 * For example "foo(bar)" will return objects with string repr. of
3784 * "foo" and "bar".
3785 *
3786 * The returned objects have refcount = 1. The function can't fail. */
3787 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3788 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3789 {
3790 const char *str, *p;
3791 char *t;
3792 int len, keyLen, nameLen;
3793 Jim_Obj *varObjPtr, *keyObjPtr;
3794
3795 str = Jim_GetString(objPtr, &len);
3796 p = strchr(str, '(');
3797 p++;
3798 keyLen = len-((p-str)+1);
3799 nameLen = (p-str)-1;
3800 /* Create the objects with the variable name and key. */
3801 t = Jim_Alloc(nameLen+1);
3802 memcpy(t, str, nameLen);
3803 t[nameLen] = '\0';
3804 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3805
3806 t = Jim_Alloc(keyLen+1);
3807 memcpy(t, p, keyLen);
3808 t[keyLen] = '\0';
3809 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3810
3811 Jim_IncrRefCount(varObjPtr);
3812 Jim_IncrRefCount(keyObjPtr);
3813 *varPtrPtr = varObjPtr;
3814 *keyPtrPtr = keyObjPtr;
3815 }
3816
3817 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3818 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3819 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3820 Jim_Obj *valObjPtr)
3821 {
3822 Jim_Obj *varObjPtr, *keyObjPtr;
3823 int err = JIM_OK;
3824
3825 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3826 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3827 valObjPtr);
3828 Jim_DecrRefCount(interp, varObjPtr);
3829 Jim_DecrRefCount(interp, keyObjPtr);
3830 return err;
3831 }
3832
3833 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3834 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3835 {
3836 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3837
3838 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3839 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3840 if (!dictObjPtr) {
3841 resObjPtr = NULL;
3842 goto err;
3843 }
3844 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3845 != JIM_OK) {
3846 resObjPtr = NULL;
3847 }
3848 err:
3849 Jim_DecrRefCount(interp, varObjPtr);
3850 Jim_DecrRefCount(interp, keyObjPtr);
3851 return resObjPtr;
3852 }
3853
3854 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3855
3856 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3857 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3858 Jim_Obj *dupPtr);
3859
3860 static Jim_ObjType dictSubstObjType = {
3861 "dict-substitution",
3862 FreeDictSubstInternalRep,
3863 DupDictSubstInternalRep,
3864 NULL,
3865 JIM_TYPE_NONE,
3866 };
3867
3868 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3869 {
3870 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3871 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3872 }
3873
3874 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3875 Jim_Obj *dupPtr)
3876 {
3877 JIM_NOTUSED(interp);
3878
3879 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3880 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3881 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3882 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3883 dupPtr->typePtr = &dictSubstObjType;
3884 }
3885
3886 /* This function is used to expand [dict get] sugar in the form
3887 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3888 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3889 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3890 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3891 * the [dict]ionary contained in variable VARNAME. */
3892 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3893 {
3894 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3895 Jim_Obj *substKeyObjPtr = NULL;
3896
3897 if (objPtr->typePtr != &dictSubstObjType) {
3898 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3899 Jim_FreeIntRep(interp, objPtr);
3900 objPtr->typePtr = &dictSubstObjType;
3901 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3902 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3903 }
3904 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3905 &substKeyObjPtr, JIM_NONE)
3906 != JIM_OK) {
3907 substKeyObjPtr = NULL;
3908 goto err;
3909 }
3910 Jim_IncrRefCount(substKeyObjPtr);
3911 dictObjPtr = Jim_GetVariable(interp,
3912 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3913 if (!dictObjPtr) {
3914 resObjPtr = NULL;
3915 goto err;
3916 }
3917 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3918 != JIM_OK) {
3919 resObjPtr = NULL;
3920 goto err;
3921 }
3922 err:
3923 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3924 return resObjPtr;
3925 }
3926
3927 /* -----------------------------------------------------------------------------
3928 * CallFrame
3929 * ---------------------------------------------------------------------------*/
3930
3931 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3932 {
3933 Jim_CallFrame *cf;
3934 if (interp->freeFramesList) {
3935 cf = interp->freeFramesList;
3936 interp->freeFramesList = cf->nextFramePtr;
3937 } else {
3938 cf = Jim_Alloc(sizeof(*cf));
3939 cf->vars.table = NULL;
3940 }
3941
3942 cf->id = interp->callFrameEpoch++;
3943 cf->parentCallFrame = NULL;
3944 cf->argv = NULL;
3945 cf->argc = 0;
3946 cf->procArgsObjPtr = NULL;
3947 cf->procBodyObjPtr = NULL;
3948 cf->nextFramePtr = NULL;
3949 cf->staticVars = NULL;
3950 if (cf->vars.table == NULL)
3951 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3952 return cf;
3953 }
3954
3955 /* Used to invalidate every caching related to callframe stability. */
3956 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3957 {
3958 cf->id = interp->callFrameEpoch++;
3959 }
3960
3961 #define JIM_FCF_NONE 0 /* no flags */
3962 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3963 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3964 int flags)
3965 {
3966 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3967 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3968 if (!(flags & JIM_FCF_NOHT))
3969 Jim_FreeHashTable(&cf->vars);
3970 else {
3971 int i;
3972 Jim_HashEntry **table = cf->vars.table, *he;
3973
3974 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3975 he = table[i];
3976 while (he != NULL) {
3977 Jim_HashEntry *nextEntry = he->next;
3978 Jim_Var *varPtr = (void*) he->val;
3979
3980 Jim_DecrRefCount(interp, varPtr->objPtr);
3981 Jim_Free(he->val);
3982 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3983 Jim_Free(he);
3984 table[i] = NULL;
3985 he = nextEntry;
3986 }
3987 }
3988 cf->vars.used = 0;
3989 }
3990 cf->nextFramePtr = interp->freeFramesList;
3991 interp->freeFramesList = cf;
3992 }
3993
3994 /* -----------------------------------------------------------------------------
3995 * References
3996 * ---------------------------------------------------------------------------*/
3997
3998 /* References HashTable Type.
3999 *
4000 * Keys are jim_wide integers, dynamically allocated for now but in the
4001 * future it's worth to cache this 8 bytes objects. Values are poitners
4002 * to Jim_References. */
4003 static void JimReferencesHTValDestructor(void *interp, void *val)
4004 {
4005 Jim_Reference *refPtr = (void*) val;
4006
4007 Jim_DecrRefCount(interp, refPtr->objPtr);
4008 if (refPtr->finalizerCmdNamePtr != NULL) {
4009 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4010 }
4011 Jim_Free(val);
4012 }
4013
4014 unsigned int JimReferencesHTHashFunction(const void *key)
4015 {
4016 /* Only the least significant bits are used. */
4017 const jim_wide *widePtr = key;
4018 unsigned int intValue = (unsigned int) *widePtr;
4019 return Jim_IntHashFunction(intValue);
4020 }
4021
4022 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4023 {
4024 /* Only the least significant bits are used. */
4025 const jim_wide *widePtr = key;
4026 unsigned int intValue = (unsigned int) *widePtr;
4027 return intValue; /* identity function. */
4028 }
4029
4030 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4031 {
4032 void *copy = Jim_Alloc(sizeof(jim_wide));
4033 JIM_NOTUSED(privdata);
4034
4035 memcpy(copy, key, sizeof(jim_wide));
4036 return copy;
4037 }
4038
4039 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4040 const void *key2)
4041 {
4042 JIM_NOTUSED(privdata);
4043
4044 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4045 }
4046
4047 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4048 {
4049 JIM_NOTUSED(privdata);
4050
4051 Jim_Free((void*)key);
4052 }
4053
4054 static Jim_HashTableType JimReferencesHashTableType = {
4055 JimReferencesHTHashFunction, /* hash function */
4056 JimReferencesHTKeyDup, /* key dup */
4057 NULL, /* val dup */
4058 JimReferencesHTKeyCompare, /* key compare */
4059 JimReferencesHTKeyDestructor, /* key destructor */
4060 JimReferencesHTValDestructor /* val destructor */
4061 };
4062
4063 /* -----------------------------------------------------------------------------
4064 * Reference object type and References API
4065 * ---------------------------------------------------------------------------*/
4066
4067 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4068
4069 static Jim_ObjType referenceObjType = {
4070 "reference",
4071 NULL,
4072 NULL,
4073 UpdateStringOfReference,
4074 JIM_TYPE_REFERENCES,
4075 };
4076
4077 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4078 {
4079 int len;
4080 char buf[JIM_REFERENCE_SPACE+1];
4081 Jim_Reference *refPtr;
4082
4083 refPtr = objPtr->internalRep.refValue.refPtr;
4084 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4085 objPtr->bytes = Jim_Alloc(len+1);
4086 memcpy(objPtr->bytes, buf, len+1);
4087 objPtr->length = len;
4088 }
4089
4090 /* returns true if 'c' is a valid reference tag character.
4091 * i.e. inside the range [_a-zA-Z0-9] */
4092 static int isrefchar(int c)
4093 {
4094 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4095 (c >= '0' && c <= '9')) return 1;
4096 return 0;
4097 }
4098
4099 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4100 {
4101 jim_wide wideValue;
4102 int i, len;
4103 const char *str, *start, *end;
4104 char refId[21];
4105 Jim_Reference *refPtr;
4106 Jim_HashEntry *he;
4107
4108 /* Get the string representation */
4109 str = Jim_GetString(objPtr, &len);
4110 /* Check if it looks like a reference */
4111 if (len < JIM_REFERENCE_SPACE) goto badformat;
4112 /* Trim spaces */
4113 start = str;
4114 end = str+len-1;
4115 while (*start == ' ') start++;
4116 while (*end == ' ' && end > start) end--;
4117 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4118 /* <reference.<1234567>.%020> */
4119 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4120 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4121 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4122 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4123 if (!isrefchar(start[12+i])) goto badformat;
4124 }
4125 /* Extract info from the refernece. */
4126 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4127 refId[20] = '\0';
4128 /* Try to convert the ID into a jim_wide */
4129 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4130 /* Check if the reference really exists! */
4131 he = Jim_FindHashEntry(&interp->references, &wideValue);
4132 if (he == NULL) {
4133 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4134 Jim_AppendStrings(interp, Jim_GetResult(interp),
4135 "Invalid reference ID \"", str, "\"", NULL);
4136 return JIM_ERR;
4137 }
4138 refPtr = he->val;
4139 /* Free the old internal repr and set the new one. */
4140 Jim_FreeIntRep(interp, objPtr);
4141 objPtr->typePtr = &referenceObjType;
4142 objPtr->internalRep.refValue.id = wideValue;
4143 objPtr->internalRep.refValue.refPtr = refPtr;
4144 return JIM_OK;
4145
4146 badformat:
4147 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4148 Jim_AppendStrings(interp, Jim_GetResult(interp),
4149 "expected reference but got \"", str, "\"", NULL);
4150 return JIM_ERR;
4151 }
4152
4153 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4154 * as finalizer command (or NULL if there is no finalizer).
4155 * The returned reference object has refcount = 0. */
4156 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4157 Jim_Obj *cmdNamePtr)
4158 {
4159 struct Jim_Reference *refPtr;
4160 jim_wide wideValue = interp->referenceNextId;
4161 Jim_Obj *refObjPtr;
4162 const char *tag;
4163 int tagLen, i;
4164
4165 /* Perform the Garbage Collection if needed. */
4166 Jim_CollectIfNeeded(interp);
4167
4168 refPtr = Jim_Alloc(sizeof(*refPtr));
4169 refPtr->objPtr = objPtr;
4170 Jim_IncrRefCount(objPtr);
4171 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4172 if (cmdNamePtr)
4173 Jim_IncrRefCount(cmdNamePtr);
4174 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4175 refObjPtr = Jim_NewObj(interp);
4176 refObjPtr->typePtr = &referenceObjType;
4177 refObjPtr->bytes = NULL;
4178 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4179 refObjPtr->internalRep.refValue.refPtr = refPtr;
4180 interp->referenceNextId++;
4181 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4182 * that does not pass the 'isrefchar' test is replaced with '_' */
4183 tag = Jim_GetString(tagPtr, &tagLen);
4184 if (tagLen > JIM_REFERENCE_TAGLEN)
4185 tagLen = JIM_REFERENCE_TAGLEN;
4186 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4187 if (i < tagLen)
4188 refPtr->tag[i] = tag[i];
4189 else
4190 refPtr->tag[i] = '_';
4191 }
4192 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4193 return refObjPtr;
4194 }
4195
4196 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4197 {
4198 if (objPtr->typePtr != &referenceObjType &&
4199 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4200 return NULL;
4201 return objPtr->internalRep.refValue.refPtr;
4202 }
4203
4204 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4205 {
4206 Jim_Reference *refPtr;
4207
4208 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4209 return JIM_ERR;
4210 Jim_IncrRefCount(cmdNamePtr);
4211 if (refPtr->finalizerCmdNamePtr)
4212 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4213 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4214 return JIM_OK;
4215 }
4216
4217 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4218 {
4219 Jim_Reference *refPtr;
4220
4221 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4222 return JIM_ERR;
4223 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4224 return JIM_OK;
4225 }
4226
4227 /* -----------------------------------------------------------------------------
4228 * References Garbage Collection
4229 * ---------------------------------------------------------------------------*/
4230
4231 /* This the hash table type for the "MARK" phase of the GC */
4232 static Jim_HashTableType JimRefMarkHashTableType = {
4233 JimReferencesHTHashFunction, /* hash function */
4234 JimReferencesHTKeyDup, /* key dup */
4235 NULL, /* val dup */
4236 JimReferencesHTKeyCompare, /* key compare */
4237 JimReferencesHTKeyDestructor, /* key destructor */
4238 NULL /* val destructor */
4239 };
4240
4241 /* #define JIM_DEBUG_GC 1 */
4242
4243 /* Performs the garbage collection. */
4244 int Jim_Collect(Jim_Interp *interp)
4245 {
4246 Jim_HashTable marks;
4247 Jim_HashTableIterator *htiter;
4248 Jim_HashEntry *he;
4249 Jim_Obj *objPtr;
4250 int collected = 0;
4251
4252 /* Avoid recursive calls */
4253 if (interp->lastCollectId == -1) {
4254 /* Jim_Collect() already running. Return just now. */
4255 return 0;
4256 }
4257 interp->lastCollectId = -1;
4258
4259 /* Mark all the references found into the 'mark' hash table.
4260 * The references are searched in every live object that
4261 * is of a type that can contain references. */
4262 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4263 objPtr = interp->liveList;
4264 while(objPtr) {
4265 if (objPtr->typePtr == NULL ||
4266 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4267 const char *str, *p;
4268 int len;
4269
4270 /* If the object is of type reference, to get the
4271 * Id is simple... */
4272 if (objPtr->typePtr == &referenceObjType) {
4273 Jim_AddHashEntry(&marks,
4274 &objPtr->internalRep.refValue.id, NULL);
4275 #ifdef JIM_DEBUG_GC
4276 Jim_fprintf(interp,interp->cookie_stdout,
4277 "MARK (reference): %d refcount: %d" JIM_NL,
4278 (int) objPtr->internalRep.refValue.id,
4279 objPtr->refCount);
4280 #endif
4281 objPtr = objPtr->nextObjPtr;
4282 continue;
4283 }
4284 /* Get the string repr of the object we want
4285 * to scan for references. */
4286 p = str = Jim_GetString(objPtr, &len);
4287 /* Skip objects too little to contain references. */
4288 if (len < JIM_REFERENCE_SPACE) {
4289 objPtr = objPtr->nextObjPtr;
4290 continue;
4291 }
4292 /* Extract references from the object string repr. */
4293 while(1) {
4294 int i;
4295 jim_wide id;
4296 char buf[21];
4297
4298 if ((p = strstr(p, "<reference.<")) == NULL)
4299 break;
4300 /* Check if it's a valid reference. */
4301 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4302 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4303 for (i = 21; i <= 40; i++)
4304 if (!isdigit((int)p[i]))
4305 break;
4306 /* Get the ID */
4307 memcpy(buf, p+21, 20);
4308 buf[20] = '\0';
4309 Jim_StringToWide(buf, &id, 10);
4310
4311 /* Ok, a reference for the given ID
4312 * was found. Mark it. */
4313 Jim_AddHashEntry(&marks, &id, NULL);
4314 #ifdef JIM_DEBUG_GC
4315 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4316 #endif
4317 p += JIM_REFERENCE_SPACE;
4318 }
4319 }
4320 objPtr = objPtr->nextObjPtr;
4321 }
4322
4323 /* Run the references hash table to destroy every reference that
4324 * is not referenced outside (not present in the mark HT). */
4325 htiter = Jim_GetHashTableIterator(&interp->references);
4326 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4327 const jim_wide *refId;
4328 Jim_Reference *refPtr;
4329
4330 refId = he->key;
4331 /* Check if in the mark phase we encountered
4332 * this reference. */
4333 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4334 #ifdef JIM_DEBUG_GC
4335 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4336 #endif
4337 collected++;
4338 /* Drop the reference, but call the
4339 * finalizer first if registered. */
4340 refPtr = he->val;
4341 if (refPtr->finalizerCmdNamePtr) {
4342 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4343 Jim_Obj *objv[3], *oldResult;
4344
4345 JimFormatReference(refstr, refPtr, *refId);
4346
4347 objv[0] = refPtr->finalizerCmdNamePtr;
4348 objv[1] = Jim_NewStringObjNoAlloc(interp,
4349 refstr, 32);
4350 objv[2] = refPtr->objPtr;
4351 Jim_IncrRefCount(objv[0]);
4352 Jim_IncrRefCount(objv[1]);
4353 Jim_IncrRefCount(objv[2]);
4354
4355 /* Drop the reference itself */
4356 Jim_DeleteHashEntry(&interp->references, refId);
4357
4358 /* Call the finalizer. Errors ignored. */
4359 oldResult = interp->result;
4360 Jim_IncrRefCount(oldResult);
4361 Jim_EvalObjVector(interp, 3, objv);
4362 Jim_SetResult(interp, oldResult);
4363 Jim_DecrRefCount(interp, oldResult);
4364
4365 Jim_DecrRefCount(interp, objv[0]);
4366 Jim_DecrRefCount(interp, objv[1]);
4367 Jim_DecrRefCount(interp, objv[2]);
4368 } else {
4369 Jim_DeleteHashEntry(&interp->references, refId);
4370 }
4371 }
4372 }
4373 Jim_FreeHashTableIterator(htiter);
4374 Jim_FreeHashTable(&marks);
4375 interp->lastCollectId = interp->referenceNextId;
4376 interp->lastCollectTime = time(NULL);
4377 return collected;
4378 }
4379
4380 #define JIM_COLLECT_ID_PERIOD 5000
4381 #define JIM_COLLECT_TIME_PERIOD 300
4382
4383 void Jim_CollectIfNeeded(Jim_Interp *interp)
4384 {
4385 jim_wide elapsedId;
4386 int elapsedTime;
4387
4388 elapsedId = interp->referenceNextId - interp->lastCollectId;
4389 elapsedTime = time(NULL) - interp->lastCollectTime;
4390
4391
4392 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4393 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4394 Jim_Collect(interp);
4395 }
4396 }
4397
4398 /* -----------------------------------------------------------------------------
4399 * Interpreter related functions
4400 * ---------------------------------------------------------------------------*/
4401
4402 Jim_Interp *Jim_CreateInterp(void)
4403 {
4404 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4405 Jim_Obj *pathPtr;
4406
4407 i->errorLine = 0;
4408 i->errorFileName = Jim_StrDup("");
4409 i->numLevels = 0;
4410 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4411 i->returnCode = JIM_OK;
4412 i->exitCode = 0;
4413 i->procEpoch = 0;
4414 i->callFrameEpoch = 0;
4415 i->liveList = i->freeList = NULL;
4416 i->scriptFileName = Jim_StrDup("");
4417 i->referenceNextId = 0;
4418 i->lastCollectId = 0;
4419 i->lastCollectTime = time(NULL);
4420 i->freeFramesList = NULL;
4421 i->prngState = NULL;
4422 i->evalRetcodeLevel = -1;
4423 i->cookie_stdin = stdin;
4424 i->cookie_stdout = stdout;
4425 i->cookie_stderr = stderr;
4426 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4427 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4428 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4429 i->cb_fflush = ((int (*)( void *))(fflush));
4430 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4431
4432 /* Note that we can create objects only after the
4433 * interpreter liveList and freeList pointers are
4434 * initialized to NULL. */
4435 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4436 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4437 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4438 NULL);
4439 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4440 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4441 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4442 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4443 i->emptyObj = Jim_NewEmptyStringObj(i);
4444 i->result = i->emptyObj;
4445 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4446 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4447 i->unknown_called = 0;
4448 Jim_IncrRefCount(i->emptyObj);
4449 Jim_IncrRefCount(i->result);
4450 Jim_IncrRefCount(i->stackTrace);
4451 Jim_IncrRefCount(i->unknown);
4452
4453 /* Initialize key variables every interpreter should contain */
4454 pathPtr = Jim_NewStringObj(i, "./", -1);
4455 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4456 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4457
4458 /* Export the core API to extensions */
4459 JimRegisterCoreApi(i);
4460 return i;
4461 }
4462
4463 /* This is the only function Jim exports directly without
4464 * to use the STUB system. It is only used by embedders
4465 * in order to get an interpreter with the Jim API pointers
4466 * registered. */
4467 Jim_Interp *ExportedJimCreateInterp(void)
4468 {
4469 return Jim_CreateInterp();
4470 }
4471
4472 void Jim_FreeInterp(Jim_Interp *i)
4473 {
4474 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4475 Jim_Obj *objPtr, *nextObjPtr;
4476
4477 Jim_DecrRefCount(i, i->emptyObj);
4478 Jim_DecrRefCount(i, i->result);
4479 Jim_DecrRefCount(i, i->stackTrace);
4480 Jim_DecrRefCount(i, i->unknown);
4481 Jim_Free((void*)i->errorFileName);
4482 Jim_Free((void*)i->scriptFileName);
4483 Jim_FreeHashTable(&i->commands);
4484 Jim_FreeHashTable(&i->references);
4485 Jim_FreeHashTable(&i->stub);
4486 Jim_FreeHashTable(&i->assocData);
4487 Jim_FreeHashTable(&i->packages);
4488 Jim_Free(i->prngState);
4489 /* Free the call frames list */
4490 while(cf) {
4491 prevcf = cf->parentCallFrame;
4492 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4493 cf = prevcf;
4494 }
4495 /* Check that the live object list is empty, otherwise
4496 * there is a memory leak. */
4497 if (i->liveList != NULL) {
4498 Jim_Obj *objPtr = i->liveList;
4499
4500 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4501 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4502 while(objPtr) {
4503 const char *type = objPtr->typePtr ?
4504 objPtr->typePtr->name : "";
4505 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4506 objPtr, type,
4507 objPtr->bytes ? objPtr->bytes
4508 : "(null)", objPtr->refCount);
4509 if (objPtr->typePtr == &sourceObjType) {
4510 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4511 objPtr->internalRep.sourceValue.fileName,
4512 objPtr->internalRep.sourceValue.lineNumber);
4513 }
4514 objPtr = objPtr->nextObjPtr;
4515 }
4516 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4517 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4518 }
4519 /* Free all the freed objects. */
4520 objPtr = i->freeList;
4521 while (objPtr) {
4522 nextObjPtr = objPtr->nextObjPtr;
4523 Jim_Free(objPtr);
4524 objPtr = nextObjPtr;
4525 }
4526 /* Free cached CallFrame structures */
4527 cf = i->freeFramesList;
4528 while(cf) {
4529 nextcf = cf->nextFramePtr;
4530 if (cf->vars.table != NULL)
4531 Jim_Free(cf->vars.table);
4532 Jim_Free(cf);
4533 cf = nextcf;
4534 }
4535 /* Free the sharedString hash table. Make sure to free it
4536 * after every other Jim_Object was freed. */
4537 Jim_FreeHashTable(&i->sharedStrings);
4538 /* Free the interpreter structure. */
4539 Jim_Free(i);
4540 }
4541
4542 /* Store the call frame relative to the level represented by
4543 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4544 * level is assumed to be '1'.
4545 *
4546 * If a newLevelptr int pointer is specified, the function stores
4547 * the absolute level integer value of the new target callframe into
4548 * *newLevelPtr. (this is used to adjust interp->numLevels
4549 * in the implementation of [uplevel], so that [info level] will
4550 * return a correct information).
4551 *
4552 * This function accepts the 'level' argument in the form
4553 * of the commands [uplevel] and [upvar].
4554 *
4555 * For a function accepting a relative integer as level suitable
4556 * for implementation of [info level ?level?] check the
4557 * GetCallFrameByInteger() function. */
4558 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4559 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4560 {
4561 long level;
4562 const char *str;
4563 Jim_CallFrame *framePtr;
4564
4565 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4566 if (levelObjPtr) {
4567 str = Jim_GetString(levelObjPtr, NULL);
4568 if (str[0] == '#') {
4569 char *endptr;
4570 /* speedup for the toplevel (level #0) */
4571 if (str[1] == '0' && str[2] == '\0') {
4572 if (newLevelPtr) *newLevelPtr = 0;
4573 *framePtrPtr = interp->topFramePtr;
4574 return JIM_OK;
4575 }
4576
4577 level = strtol(str+1, &endptr, 0);
4578 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4579 goto badlevel;
4580 /* An 'absolute' level is converted into the
4581 * 'number of levels to go back' format. */
4582 level = interp->numLevels - level;
4583 if (level < 0) goto badlevel;
4584 } else {
4585 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4586 goto badlevel;
4587 }
4588 } else {
4589 str = "1"; /* Needed to format the error message. */
4590 level = 1;
4591 }
4592 /* Lookup */
4593 framePtr = interp->framePtr;
4594 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4595 while (level--) {
4596 framePtr = framePtr->parentCallFrame;
4597 if (framePtr == NULL) goto badlevel;
4598 }
4599 *framePtrPtr = framePtr;
4600 return JIM_OK;
4601 badlevel:
4602 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4603 Jim_AppendStrings(interp, Jim_GetResult(interp),
4604 "bad level \"", str, "\"", NULL);
4605 return JIM_ERR;
4606 }
4607
4608 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4609 * as a relative integer like in the [info level ?level?] command. */
4610 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4611 Jim_CallFrame **framePtrPtr)
4612 {
4613 jim_wide level;
4614 jim_wide relLevel; /* level relative to the current one. */
4615 Jim_CallFrame *framePtr;
4616
4617 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4618 goto badlevel;
4619 if (level > 0) {
4620 /* An 'absolute' level is converted into the
4621 * 'number of levels to go back' format. */
4622 relLevel = interp->numLevels - level;
4623 } else {
4624 relLevel = -level;
4625 }
4626 /* Lookup */
4627 framePtr = interp->framePtr;
4628 while (relLevel--) {
4629 framePtr = framePtr->parentCallFrame;
4630 if (framePtr == NULL) goto badlevel;
4631 }
4632 *framePtrPtr = framePtr;
4633 return JIM_OK;
4634 badlevel:
4635 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4636 Jim_AppendStrings(interp, Jim_GetResult(interp),
4637 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4638 return JIM_ERR;
4639 }
4640
4641 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4642 {
4643 Jim_Free((void*)interp->errorFileName);
4644 interp->errorFileName = Jim_StrDup(filename);
4645 }
4646
4647 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4648 {
4649 interp->errorLine = linenr;
4650 }
4651
4652 static void JimResetStackTrace(Jim_Interp *interp)
4653 {
4654 Jim_DecrRefCount(interp, interp->stackTrace);
4655 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4656 Jim_IncrRefCount(interp->stackTrace);
4657 }
4658
4659 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4660 const char *filename, int linenr)
4661 {
4662 /* No need to add this dummy entry to the stack trace */
4663 if (strcmp(procname, "unknown") == 0) {
4664 return;
4665 }
4666
4667 if (Jim_IsShared(interp->stackTrace)) {
4668 interp->stackTrace =
4669 Jim_DuplicateObj(interp, interp->stackTrace);
4670 Jim_IncrRefCount(interp->stackTrace);
4671 }
4672 Jim_ListAppendElement(interp, interp->stackTrace,
4673 Jim_NewStringObj(interp, procname, -1));
4674 Jim_ListAppendElement(interp, interp->stackTrace,
4675 Jim_NewStringObj(interp, filename, -1));
4676 Jim_ListAppendElement(interp, interp->stackTrace,
4677 Jim_NewIntObj(interp, linenr));
4678 }
4679
4680 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4681 {
4682 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4683 assocEntryPtr->delProc = delProc;
4684 assocEntryPtr->data = data;
4685 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4686 }
4687
4688 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4689 {
4690 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4691 if (entryPtr != NULL) {
4692 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4693 return assocEntryPtr->data;
4694 }
4695 return NULL;
4696 }
4697
4698 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4699 {
4700 return Jim_DeleteHashEntry(&interp->assocData, key);
4701 }
4702
4703 int Jim_GetExitCode(Jim_Interp *interp) {
4704 return interp->exitCode;
4705 }
4706
4707 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4708 {
4709 if (fp != NULL) interp->cookie_stdin = fp;
4710 return interp->cookie_stdin;
4711 }
4712
4713 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4714 {
4715 if (fp != NULL) interp->cookie_stdout = fp;
4716 return interp->cookie_stdout;
4717 }
4718
4719 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4720 {
4721 if (fp != NULL) interp->cookie_stderr = fp;
4722 return interp->cookie_stderr;
4723 }
4724
4725 /* -----------------------------------------------------------------------------
4726 * Shared strings.
4727 * Every interpreter has an hash table where to put shared dynamically
4728 * allocate strings that are likely to be used a lot of times.
4729 * For example, in the 'source' object type, there is a pointer to
4730 * the filename associated with that object. Every script has a lot
4731 * of this objects with the identical file name, so it is wise to share
4732 * this info.
4733 *
4734 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4735 * returns the pointer to the shared string. Every time a reference
4736 * to the string is no longer used, the user should call
4737 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4738 * a given string, it is removed from the hash table.
4739 * ---------------------------------------------------------------------------*/
4740 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4741 {
4742 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4743
4744 if (he == NULL) {
4745 char *strCopy = Jim_StrDup(str);
4746
4747 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4748 return strCopy;
4749 } else {
4750 long refCount = (long) he->val;
4751
4752 refCount++;
4753 he->val = (void*) refCount;
4754 return he->key;
4755 }
4756 }
4757
4758 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4759 {
4760 long refCount;
4761 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4762
4763 if (he == NULL)
4764 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4765 "unknown shared string '%s'", str);
4766 refCount = (long) he->val;
4767 refCount--;
4768 if (refCount == 0) {
4769 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4770 } else {
4771 he->val = (void*) refCount;
4772 }
4773 }
4774
4775 /* -----------------------------------------------------------------------------
4776 * Integer object
4777 * ---------------------------------------------------------------------------*/
4778 #define JIM_INTEGER_SPACE 24
4779
4780 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4781 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4782
4783 static Jim_ObjType intObjType = {
4784 "int",
4785 NULL,
4786 NULL,
4787 UpdateStringOfInt,
4788 JIM_TYPE_NONE,
4789 };
4790
4791 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4792 {
4793 int len;
4794 char buf[JIM_INTEGER_SPACE+1];
4795
4796 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4797 objPtr->bytes = Jim_Alloc(len+1);
4798 memcpy(objPtr->bytes, buf, len+1);
4799 objPtr->length = len;
4800 }
4801
4802 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4803 {
4804 jim_wide wideValue;
4805 const char *str;
4806
4807 /* Get the string representation */
4808 str = Jim_GetString(objPtr, NULL);
4809 /* Try to convert into a jim_wide */
4810 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4811 if (flags & JIM_ERRMSG) {
4812 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4813 Jim_AppendStrings(interp, Jim_GetResult(interp),
4814 "expected integer but got \"", str, "\"", NULL);
4815 }
4816 return JIM_ERR;
4817 }
4818 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4819 errno == ERANGE) {
4820 Jim_SetResultString(interp,
4821 "Integer value too big to be represented", -1);
4822 return JIM_ERR;
4823 }
4824 /* Free the old internal repr and set the new one. */
4825 Jim_FreeIntRep(interp, objPtr);
4826 objPtr->typePtr = &intObjType;
4827 objPtr->internalRep.wideValue = wideValue;
4828 return JIM_OK;
4829 }
4830
4831 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4832 {
4833 if (objPtr->typePtr != &intObjType &&
4834 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4835 return JIM_ERR;
4836 *widePtr = objPtr->internalRep.wideValue;
4837 return JIM_OK;
4838 }
4839
4840 /* Get a wide but does not set an error if the format is bad. */
4841 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4842 jim_wide *widePtr)
4843 {
4844 if (objPtr->typePtr != &intObjType &&
4845 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4846 return JIM_ERR;
4847 *widePtr = objPtr->internalRep.wideValue;
4848 return JIM_OK;
4849 }
4850
4851 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4852 {
4853 jim_wide wideValue;
4854 int retval;
4855
4856 retval = Jim_GetWide(interp, objPtr, &wideValue);
4857 if (retval == JIM_OK) {
4858 *longPtr = (long) wideValue;
4859 return JIM_OK;
4860 }
4861 return JIM_ERR;
4862 }
4863
4864 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4865 {
4866 if (Jim_IsShared(objPtr))
4867 Jim_Panic(interp,"Jim_SetWide called with shared object");
4868 if (objPtr->typePtr != &intObjType) {
4869 Jim_FreeIntRep(interp, objPtr);
4870 objPtr->typePtr = &intObjType;
4871 }
4872 Jim_InvalidateStringRep(objPtr);
4873 objPtr->internalRep.wideValue = wideValue;
4874 }
4875
4876 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4877 {
4878 Jim_Obj *objPtr;
4879
4880 objPtr = Jim_NewObj(interp);
4881 objPtr->typePtr = &intObjType;
4882 objPtr->bytes = NULL;
4883 objPtr->internalRep.wideValue = wideValue;
4884 return objPtr;
4885 }
4886
4887 /* -----------------------------------------------------------------------------
4888 * Double object
4889 * ---------------------------------------------------------------------------*/
4890 #define JIM_DOUBLE_SPACE 30
4891
4892 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4893 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4894
4895 static Jim_ObjType doubleObjType = {
4896 "double",
4897 NULL,
4898 NULL,
4899 UpdateStringOfDouble,
4900 JIM_TYPE_NONE,
4901 };
4902
4903 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4904 {
4905 int len;
4906 char buf[JIM_DOUBLE_SPACE+1];
4907
4908 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4909 objPtr->bytes = Jim_Alloc(len+1);
4910 memcpy(objPtr->bytes, buf, len+1);
4911 objPtr->length = len;
4912 }
4913
4914 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4915 {
4916 double doubleValue;
4917 const char *str;
4918
4919 /* Get the string representation */
4920 str = Jim_GetString(objPtr, NULL);
4921 /* Try to convert into a double */
4922 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4923 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4924 Jim_AppendStrings(interp, Jim_GetResult(interp),
4925 "expected number but got '", str, "'", NULL);
4926 return JIM_ERR;
4927 }
4928 /* Free the old internal repr and set the new one. */
4929 Jim_FreeIntRep(interp, objPtr);
4930 objPtr->typePtr = &doubleObjType;
4931 objPtr->internalRep.doubleValue = doubleValue;
4932 return JIM_OK;
4933 }
4934
4935 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4936 {
4937 if (objPtr->typePtr != &doubleObjType &&
4938 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4939 return JIM_ERR;
4940 *doublePtr = objPtr->internalRep.doubleValue;
4941 return JIM_OK;
4942 }
4943
4944 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4945 {
4946 if (Jim_IsShared(objPtr))
4947 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4948 if (objPtr->typePtr != &doubleObjType) {
4949 Jim_FreeIntRep(interp, objPtr);
4950 objPtr->typePtr = &doubleObjType;
4951 }
4952 Jim_InvalidateStringRep(objPtr);
4953 objPtr->internalRep.doubleValue = doubleValue;
4954 }
4955
4956 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4957 {
4958 Jim_Obj *objPtr;
4959
4960 objPtr = Jim_NewObj(interp);
4961 objPtr->typePtr = &doubleObjType;
4962 objPtr->bytes = NULL;
4963 objPtr->internalRep.doubleValue = doubleValue;
4964 return objPtr;
4965 }
4966
4967 /* -----------------------------------------------------------------------------
4968 * List object
4969 * ---------------------------------------------------------------------------*/
4970 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4971 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4972 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4973 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4974 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4975
4976 /* Note that while the elements of the list may contain references,
4977 * the list object itself can't. This basically means that the
4978 * list object string representation as a whole can't contain references
4979 * that are not presents in the single elements. */
4980 static Jim_ObjType listObjType = {
4981 "list",
4982 FreeListInternalRep,
4983 DupListInternalRep,
4984 UpdateStringOfList,
4985 JIM_TYPE_NONE,
4986 };
4987
4988 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4989 {
4990 int i;
4991
4992 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4993 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4994 }
4995 Jim_Free(objPtr->internalRep.listValue.ele);
4996 }
4997
4998 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4999 {
5000 int i;
5001 JIM_NOTUSED(interp);
5002
5003 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5004 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5005 dupPtr->internalRep.listValue.ele =
5006 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5007 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5008 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5009 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5010 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5011 }
5012 dupPtr->typePtr = &listObjType;
5013 }
5014
5015 /* The following function checks if a given string can be encoded
5016 * into a list element without any kind of quoting, surrounded by braces,
5017 * or using escapes to quote. */
5018 #define JIM_ELESTR_SIMPLE 0
5019 #define JIM_ELESTR_BRACE 1
5020 #define JIM_ELESTR_QUOTE 2
5021 static int ListElementQuotingType(const char *s, int len)
5022 {
5023 int i, level, trySimple = 1;
5024
5025 /* Try with the SIMPLE case */
5026 if (len == 0) return JIM_ELESTR_BRACE;
5027 if (s[0] == '"' || s[0] == '{') {
5028 trySimple = 0;
5029 goto testbrace;
5030 }
5031 for (i = 0; i < len; i++) {
5032 switch(s[i]) {
5033 case ' ':
5034 case '$':
5035 case '"':
5036 case '[':
5037 case ']':
5038 case ';':
5039 case '\\':
5040 case '\r':
5041 case '\n':
5042 case '\t':
5043 case '\f':
5044 case '\v':
5045 trySimple = 0;
5046 case '{':
5047 case '}':
5048 goto testbrace;
5049 }
5050 }
5051 return JIM_ELESTR_SIMPLE;
5052
5053 testbrace:
5054 /* Test if it's possible to do with braces */
5055 if (s[len-1] == '\\' ||
5056 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5057 level = 0;
5058 for (i = 0; i < len; i++) {
5059 switch(s[i]) {
5060 case '{': level++; break;
5061 case '}': level--;
5062 if (level < 0) return JIM_ELESTR_QUOTE;
5063 break;
5064 case '\\':
5065 if (s[i+1] == '\n')
5066 return JIM_ELESTR_QUOTE;
5067 else
5068 if (s[i+1] != '\0') i++;
5069 break;
5070 }
5071 }
5072 if (level == 0) {
5073 if (!trySimple) return JIM_ELESTR_BRACE;
5074 for (i = 0; i < len; i++) {
5075 switch(s[i]) {
5076 case ' ':
5077 case '$':
5078 case '"':
5079 case '[':
5080 case ']':
5081 case ';':
5082 case '\\':
5083 case '\r':
5084 case '\n':
5085 case '\t':
5086 case '\f':
5087 case '\v':
5088 return JIM_ELESTR_BRACE;
5089 break;
5090 }
5091 }
5092 return JIM_ELESTR_SIMPLE;
5093 }
5094 return JIM_ELESTR_QUOTE;
5095 }
5096
5097 /* Returns the malloc-ed representation of a string
5098 * using backslash to quote special chars. */
5099 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5100 {
5101 char *q = Jim_Alloc(len*2+1), *p;
5102
5103 p = q;
5104 while(*s) {
5105 switch (*s) {
5106 case ' ':
5107 case '$':
5108 case '"':
5109 case '[':
5110 case ']':
5111 case '{':
5112 case '}':
5113 case ';':
5114 case '\\':
5115 *p++ = '\\';
5116 *p++ = *s++;
5117 break;
5118 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5119 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5120 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5121 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5122 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5123 default:
5124 *p++ = *s++;
5125 break;
5126 }
5127 }
5128 *p = '\0';
5129 *qlenPtr = p-q;
5130 return q;
5131 }
5132
5133 void UpdateStringOfList(struct Jim_Obj *objPtr)
5134 {
5135 int i, bufLen, realLength;
5136 const char *strRep;
5137 char *p;
5138 int *quotingType;
5139 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5140
5141 /* (Over) Estimate the space needed. */
5142 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5143 bufLen = 0;
5144 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5145 int len;
5146
5147 strRep = Jim_GetString(ele[i], &len);
5148 quotingType[i] = ListElementQuotingType(strRep, len);
5149 switch (quotingType[i]) {
5150 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5151 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5152 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5153 }
5154 bufLen++; /* elements separator. */
5155 }
5156 bufLen++;
5157
5158 /* Generate the string rep. */
5159 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5160 realLength = 0;
5161 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5162 int len, qlen;
5163 const char *strRep = Jim_GetString(ele[i], &len);
5164 char *q;
5165
5166 switch(quotingType[i]) {
5167 case JIM_ELESTR_SIMPLE:
5168 memcpy(p, strRep, len);
5169 p += len;
5170 realLength += len;
5171 break;
5172 case JIM_ELESTR_BRACE:
5173 *p++ = '{';
5174 memcpy(p, strRep, len);
5175 p += len;
5176 *p++ = '}';
5177 realLength += len+2;
5178 break;
5179 case JIM_ELESTR_QUOTE:
5180 q = BackslashQuoteString(strRep, len, &qlen);
5181 memcpy(p, q, qlen);
5182 Jim_Free(q);
5183 p += qlen;
5184 realLength += qlen;
5185 break;
5186 }
5187 /* Add a separating space */
5188 if (i+1 != objPtr->internalRep.listValue.len) {
5189 *p++ = ' ';
5190 realLength ++;
5191 }
5192 }
5193 *p = '\0'; /* nul term. */
5194 objPtr->length = realLength;
5195 Jim_Free(quotingType);
5196 }
5197
5198 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5199 {
5200 struct JimParserCtx parser;
5201 const char *str;
5202 int strLen;
5203
5204 /* Get the string representation */
5205 str = Jim_GetString(objPtr, &strLen);
5206
5207 /* Free the old internal repr just now and initialize the
5208 * new one just now. The string->list conversion can't fail. */
5209 Jim_FreeIntRep(interp, objPtr);
5210 objPtr->typePtr = &listObjType;
5211 objPtr->internalRep.listValue.len = 0;
5212 objPtr->internalRep.listValue.maxLen = 0;
5213 objPtr->internalRep.listValue.ele = NULL;
5214
5215 /* Convert into a list */
5216 JimParserInit(&parser, str, strLen, 1);
5217 while(!JimParserEof(&parser)) {
5218 char *token;
5219 int tokenLen, type;
5220 Jim_Obj *elementPtr;
5221
5222 JimParseList(&parser);
5223 if (JimParserTtype(&parser) != JIM_TT_STR &&
5224 JimParserTtype(&parser) != JIM_TT_ESC)
5225 continue;
5226 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5227 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5228 ListAppendElement(objPtr, elementPtr);
5229 }
5230 return JIM_OK;
5231 }
5232
5233 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5234 int len)
5235 {
5236 Jim_Obj *objPtr;
5237 int i;
5238
5239 objPtr = Jim_NewObj(interp);
5240 objPtr->typePtr = &listObjType;
5241 objPtr->bytes = NULL;
5242 objPtr->internalRep.listValue.ele = NULL;
5243 objPtr->internalRep.listValue.len = 0;
5244 objPtr->internalRep.listValue.maxLen = 0;
5245 for (i = 0; i < len; i++) {
5246 ListAppendElement(objPtr, elements[i]);
5247 }
5248 return objPtr;
5249 }
5250
5251 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5252 * length of the vector. Note that the user of this function should make
5253 * sure that the list object can't shimmer while the vector returned
5254 * is in use, this vector is the one stored inside the internal representation
5255 * of the list object. This function is not exported, extensions should
5256 * always access to the List object elements using Jim_ListIndex(). */
5257 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5258 Jim_Obj ***listVec)
5259 {
5260 Jim_ListLength(interp, listObj, argc);
5261 assert(listObj->typePtr == &listObjType);
5262 *listVec = listObj->internalRep.listValue.ele;
5263 }
5264
5265 /* ListSortElements type values */
5266 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5267 JIM_LSORT_NOCASE_DECR};
5268
5269 /* Sort the internal rep of a list. */
5270 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5271 {
5272 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5273 }
5274
5275 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5276 {
5277 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5278 }
5279
5280 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5281 {
5282 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5283 }
5284
5285 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5286 {
5287 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5288 }
5289
5290 /* Sort a list *in place*. MUST be called with non-shared objects. */
5291 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5292 {
5293 typedef int (qsort_comparator)(const void *, const void *);
5294 int (*fn)(Jim_Obj**, Jim_Obj**);
5295 Jim_Obj **vector;
5296 int len;
5297
5298 if (Jim_IsShared(listObjPtr))
5299 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5300 if (listObjPtr->typePtr != &listObjType)
5301 SetListFromAny(interp, listObjPtr);
5302
5303 vector = listObjPtr->internalRep.listValue.ele;
5304 len = listObjPtr->internalRep.listValue.len;
5305 switch (type) {
5306 case JIM_LSORT_ASCII: fn = ListSortString; break;
5307 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5308 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5309 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5310 default:
5311 fn = NULL; /* avoid warning */
5312 Jim_Panic(interp,"ListSort called with invalid sort type");
5313 }
5314 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5315 Jim_InvalidateStringRep(listObjPtr);
5316 }
5317
5318 /* This is the low-level function to append an element to a list.
5319 * The higher-level Jim_ListAppendElement() performs shared object
5320 * check and invalidate the string repr. This version is used
5321 * in the internals of the List Object and is not exported.
5322 *
5323 * NOTE: this function can be called only against objects
5324 * with internal type of List. */
5325 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5326 {
5327 int requiredLen = listPtr->internalRep.listValue.len + 1;
5328
5329 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5330 int maxLen = requiredLen * 2;
5331
5332 listPtr->internalRep.listValue.ele =
5333 Jim_Realloc(listPtr->internalRep.listValue.ele,
5334 sizeof(Jim_Obj*)*maxLen);
5335 listPtr->internalRep.listValue.maxLen = maxLen;
5336 }
5337 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5338 objPtr;
5339 listPtr->internalRep.listValue.len ++;
5340 Jim_IncrRefCount(objPtr);
5341 }
5342
5343 /* This is the low-level function to insert elements into a list.
5344 * The higher-level Jim_ListInsertElements() performs shared object
5345 * check and invalidate the string repr. This version is used
5346 * in the internals of the List Object and is not exported.
5347 *
5348 * NOTE: this function can be called only against objects
5349 * with internal type of List. */
5350 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5351 Jim_Obj *const *elemVec)
5352 {
5353 int currentLen = listPtr->internalRep.listValue.len;
5354 int requiredLen = currentLen + elemc;
5355 int i;
5356 Jim_Obj **point;
5357
5358 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5359 int maxLen = requiredLen * 2;
5360
5361 listPtr->internalRep.listValue.ele =
5362 Jim_Realloc(listPtr->internalRep.listValue.ele,
5363 sizeof(Jim_Obj*)*maxLen);
5364 listPtr->internalRep.listValue.maxLen = maxLen;
5365 }
5366 point = listPtr->internalRep.listValue.ele + index;
5367 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5368 for (i=0; i < elemc; ++i) {
5369 point[i] = elemVec[i];
5370 Jim_IncrRefCount(point[i]);
5371 }
5372 listPtr->internalRep.listValue.len += elemc;
5373 }
5374
5375 /* Appends every element of appendListPtr into listPtr.
5376 * Both have to be of the list type. */
5377 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5378 {
5379 int i, oldLen = listPtr->internalRep.listValue.len;
5380 int appendLen = appendListPtr->internalRep.listValue.len;
5381 int requiredLen = oldLen + appendLen;
5382
5383 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5384 int maxLen = requiredLen * 2;
5385
5386 listPtr->internalRep.listValue.ele =
5387 Jim_Realloc(listPtr->internalRep.listValue.ele,
5388 sizeof(Jim_Obj*)*maxLen);
5389 listPtr->internalRep.listValue.maxLen = maxLen;
5390 }
5391 for (i = 0; i < appendLen; i++) {
5392 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5393 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5394 Jim_IncrRefCount(objPtr);
5395 }
5396 listPtr->internalRep.listValue.len += appendLen;
5397 }
5398
5399 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5400 {
5401 if (Jim_IsShared(listPtr))
5402 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5403 if (listPtr->typePtr != &listObjType)
5404 SetListFromAny(interp, listPtr);
5405 Jim_InvalidateStringRep(listPtr);
5406 ListAppendElement(listPtr, objPtr);
5407 }
5408
5409 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5410 {
5411 if (Jim_IsShared(listPtr))
5412 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5413 if (listPtr->typePtr != &listObjType)
5414 SetListFromAny(interp, listPtr);
5415 Jim_InvalidateStringRep(listPtr);
5416 ListAppendList(listPtr, appendListPtr);
5417 }
5418
5419 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5420 {
5421 if (listPtr->typePtr != &listObjType)
5422 SetListFromAny(interp, listPtr);
5423 *intPtr = listPtr->internalRep.listValue.len;
5424 }
5425
5426 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5427 int objc, Jim_Obj *const *objVec)
5428 {
5429 if (Jim_IsShared(listPtr))
5430 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5431 if (listPtr->typePtr != &listObjType)
5432 SetListFromAny(interp, listPtr);
5433 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5434 index = listPtr->internalRep.listValue.len;
5435 else if (index < 0 )
5436 index = 0;
5437 Jim_InvalidateStringRep(listPtr);
5438 ListInsertElements(listPtr, index, objc, objVec);
5439 }
5440
5441 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5442 Jim_Obj **objPtrPtr, int flags)
5443 {
5444 if (listPtr->typePtr != &listObjType)
5445 SetListFromAny(interp, listPtr);
5446 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5447 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5448 if (flags & JIM_ERRMSG) {
5449 Jim_SetResultString(interp,
5450 "list index out of range", -1);
5451 }
5452 return JIM_ERR;
5453 }
5454 if (index < 0)
5455 index = listPtr->internalRep.listValue.len+index;
5456 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5457 return JIM_OK;
5458 }
5459
5460 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5461 Jim_Obj *newObjPtr, int flags)
5462 {
5463 if (listPtr->typePtr != &listObjType)
5464 SetListFromAny(interp, listPtr);
5465 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5466 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5467 if (flags & JIM_ERRMSG) {
5468 Jim_SetResultString(interp,
5469 "list index out of range", -1);
5470 }
5471 return JIM_ERR;
5472 }
5473 if (index < 0)
5474 index = listPtr->internalRep.listValue.len+index;
5475 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5476 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5477 Jim_IncrRefCount(newObjPtr);
5478 return JIM_OK;
5479 }
5480
5481 /* Modify the list stored into the variable named 'varNamePtr'
5482 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5483 * with the new element 'newObjptr'. */
5484 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5485 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5486 {
5487 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5488 int shared, i, index;
5489
5490 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5491 if (objPtr == NULL)
5492 return JIM_ERR;
5493 if ((shared = Jim_IsShared(objPtr)))
5494 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5495 for (i = 0; i < indexc-1; i++) {
5496 listObjPtr = objPtr;
5497 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5498 goto err;
5499 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5500 JIM_ERRMSG) != JIM_OK) {
5501 goto err;
5502 }
5503 if (Jim_IsShared(objPtr)) {
5504 objPtr = Jim_DuplicateObj(interp, objPtr);
5505 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5506 }
5507 Jim_InvalidateStringRep(listObjPtr);
5508 }
5509 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5510 goto err;
5511 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5512 goto err;
5513 Jim_InvalidateStringRep(objPtr);
5514 Jim_InvalidateStringRep(varObjPtr);
5515 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5516 goto err;
5517 Jim_SetResult(interp, varObjPtr);
5518 return JIM_OK;
5519 err:
5520 if (shared) {
5521 Jim_FreeNewObj(interp, varObjPtr);
5522 }
5523 return JIM_ERR;
5524 }
5525
5526 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5527 {
5528 int i;
5529
5530 /* If all the objects in objv are lists without string rep.
5531 * it's possible to return a list as result, that's the
5532 * concatenation of all the lists. */
5533 for (i = 0; i < objc; i++) {
5534 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5535 break;
5536 }
5537 if (i == objc) {
5538 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5539 for (i = 0; i < objc; i++)
5540 Jim_ListAppendList(interp, objPtr, objv[i]);
5541 return objPtr;
5542 } else {
5543 /* Else... we have to glue strings together */
5544 int len = 0, objLen;
5545 char *bytes, *p;
5546
5547 /* Compute the length */
5548 for (i = 0; i < objc; i++) {
5549 Jim_GetString(objv[i], &objLen);
5550 len += objLen;
5551 }
5552 if (objc) len += objc-1;
5553 /* Create the string rep, and a stinrg object holding it. */
5554 p = bytes = Jim_Alloc(len+1);
5555 for (i = 0; i < objc; i++) {
5556 const char *s = Jim_GetString(objv[i], &objLen);
5557 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5558 {
5559 s++; objLen--; len--;
5560 }
5561 while (objLen && (s[objLen-1] == ' ' ||
5562 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5563 objLen--; len--;
5564 }
5565 memcpy(p, s, objLen);
5566 p += objLen;
5567 if (objLen && i+1 != objc) {
5568 *p++ = ' ';
5569 } else if (i+1 != objc) {
5570 /* Drop the space calcuated for this
5571 * element that is instead null. */
5572 len--;
5573 }
5574 }
5575 *p = '\0';
5576 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5577 }
5578 }
5579
5580 /* Returns a list composed of the elements in the specified range.
5581 * first and start are directly accepted as Jim_Objects and
5582 * processed for the end?-index? case. */
5583 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5584 {
5585 int first, last;
5586 int len, rangeLen;
5587
5588 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5589 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5590 return NULL;
5591 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5592 first = JimRelToAbsIndex(len, first);
5593 last = JimRelToAbsIndex(len, last);
5594 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5595 return Jim_NewListObj(interp,
5596 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5597 }
5598
5599 /* -----------------------------------------------------------------------------
5600 * Dict object
5601 * ---------------------------------------------------------------------------*/
5602 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5603 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5604 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5605 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5606
5607 /* Dict HashTable Type.
5608 *
5609 * Keys and Values are Jim objects. */
5610
5611 unsigned int JimObjectHTHashFunction(const void *key)
5612 {
5613 const char *str;
5614 Jim_Obj *objPtr = (Jim_Obj*) key;
5615 int len, h;
5616
5617 str = Jim_GetString(objPtr, &len);
5618 h = Jim_GenHashFunction((unsigned char*)str, len);
5619 return h;
5620 }
5621
5622 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5623 {
5624 JIM_NOTUSED(privdata);
5625
5626 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5627 }
5628
5629 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5630 {
5631 Jim_Obj *objPtr = val;
5632
5633 Jim_DecrRefCount(interp, objPtr);
5634 }
5635
5636 static Jim_HashTableType JimDictHashTableType = {
5637 JimObjectHTHashFunction, /* hash function */
5638 NULL, /* key dup */
5639 NULL, /* val dup */
5640 JimObjectHTKeyCompare, /* key compare */
5641 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5642 JimObjectHTKeyValDestructor, /* key destructor */
5643 JimObjectHTKeyValDestructor /* val destructor */
5644 };
5645
5646 /* Note that while the elements of the dict may contain references,
5647 * the list object itself can't. This basically means that the
5648 * dict object string representation as a whole can't contain references
5649 * that are not presents in the single elements. */
5650 static Jim_ObjType dictObjType = {
5651 "dict",
5652 FreeDictInternalRep,
5653 DupDictInternalRep,
5654 UpdateStringOfDict,
5655 JIM_TYPE_NONE,
5656 };
5657
5658 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5659 {
5660 JIM_NOTUSED(interp);
5661
5662 Jim_FreeHashTable(objPtr->internalRep.ptr);
5663 Jim_Free(objPtr->internalRep.ptr);
5664 }
5665
5666 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5667 {
5668 Jim_HashTable *ht, *dupHt;
5669 Jim_HashTableIterator *htiter;
5670 Jim_HashEntry *he;
5671
5672 /* Create a new hash table */
5673 ht = srcPtr->internalRep.ptr;
5674 dupHt = Jim_Alloc(sizeof(*dupHt));
5675 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5676 if (ht->size != 0)
5677 Jim_ExpandHashTable(dupHt, ht->size);
5678 /* Copy every element from the source to the dup hash table */
5679 htiter = Jim_GetHashTableIterator(ht);
5680 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5681 const Jim_Obj *keyObjPtr = he->key;
5682 Jim_Obj *valObjPtr = he->val;
5683
5684 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5685 Jim_IncrRefCount(valObjPtr);
5686 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5687 }
5688 Jim_FreeHashTableIterator(htiter);
5689
5690 dupPtr->internalRep.ptr = dupHt;
5691 dupPtr->typePtr = &dictObjType;
5692 }
5693
5694 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5695 {
5696 int i, bufLen, realLength;
5697 const char *strRep;
5698 char *p;
5699 int *quotingType, objc;
5700 Jim_HashTable *ht;
5701 Jim_HashTableIterator *htiter;
5702 Jim_HashEntry *he;
5703 Jim_Obj **objv;
5704
5705 /* Trun the hash table into a flat vector of Jim_Objects. */
5706 ht = objPtr->internalRep.ptr;
5707 objc = ht->used*2;
5708 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5709 htiter = Jim_GetHashTableIterator(ht);
5710 i = 0;
5711 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5712 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5713 objv[i++] = he->val;
5714 }
5715 Jim_FreeHashTableIterator(htiter);
5716 /* (Over) Estimate the space needed. */
5717 quotingType = Jim_Alloc(sizeof(int)*objc);
5718 bufLen = 0;
5719 for (i = 0; i < objc; i++) {
5720 int len;
5721
5722 strRep = Jim_GetString(objv[i], &len);
5723 quotingType[i] = ListElementQuotingType(strRep, len);
5724 switch (quotingType[i]) {
5725 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5726 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5727 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5728 }
5729 bufLen++; /* elements separator. */
5730 }
5731 bufLen++;
5732
5733 /* Generate the string rep. */
5734 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5735 realLength = 0;
5736 for (i = 0; i < objc; i++) {
5737 int len, qlen;
5738 const char *strRep = Jim_GetString(objv[i], &len);
5739 char *q;
5740
5741 switch(quotingType[i]) {
5742 case JIM_ELESTR_SIMPLE:
5743 memcpy(p, strRep, len);
5744 p += len;
5745 realLength += len;
5746 break;
5747 case JIM_ELESTR_BRACE:
5748 *p++ = '{';
5749 memcpy(p, strRep, len);
5750 p += len;
5751 *p++ = '}';
5752 realLength += len+2;
5753 break;
5754 case JIM_ELESTR_QUOTE:
5755 q = BackslashQuoteString(strRep, len, &qlen);
5756 memcpy(p, q, qlen);
5757 Jim_Free(q);
5758 p += qlen;
5759 realLength += qlen;
5760 break;
5761 }
5762 /* Add a separating space */
5763 if (i+1 != objc) {
5764 *p++ = ' ';
5765 realLength ++;
5766 }
5767 }
5768 *p = '\0'; /* nul term. */
5769 objPtr->length = realLength;
5770 Jim_Free(quotingType);
5771 Jim_Free(objv);
5772 }
5773
5774 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5775 {
5776 struct JimParserCtx parser;
5777 Jim_HashTable *ht;
5778 Jim_Obj *objv[2];
5779 const char *str;
5780 int i, strLen;
5781
5782 /* Get the string representation */
5783 str = Jim_GetString(objPtr, &strLen);
5784
5785 /* Free the old internal repr just now and initialize the
5786 * new one just now. The string->list conversion can't fail. */
5787 Jim_FreeIntRep(interp, objPtr);
5788 ht = Jim_Alloc(sizeof(*ht));
5789 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5790 objPtr->typePtr = &dictObjType;
5791 objPtr->internalRep.ptr = ht;
5792
5793 /* Convert into a dict */
5794 JimParserInit(&parser, str, strLen, 1);
5795 i = 0;
5796 while(!JimParserEof(&parser)) {
5797 char *token;
5798 int tokenLen, type;
5799
5800 JimParseList(&parser);
5801 if (JimParserTtype(&parser) != JIM_TT_STR &&
5802 JimParserTtype(&parser) != JIM_TT_ESC)
5803 continue;
5804 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5805 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5806 if (i == 2) {
5807 i = 0;
5808 Jim_IncrRefCount(objv[0]);
5809 Jim_IncrRefCount(objv[1]);
5810 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5811 Jim_HashEntry *he;
5812 he = Jim_FindHashEntry(ht, objv[0]);
5813 Jim_DecrRefCount(interp, objv[0]);
5814 /* ATTENTION: const cast */
5815 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5816 he->val = objv[1];
5817 }
5818 }
5819 }
5820 if (i) {
5821 Jim_FreeNewObj(interp, objv[0]);
5822 objPtr->typePtr = NULL;
5823 Jim_FreeHashTable(ht);
5824 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5825 return JIM_ERR;
5826 }
5827 return JIM_OK;
5828 }
5829
5830 /* Dict object API */
5831
5832 /* Add an element to a dict. objPtr must be of the "dict" type.
5833 * The higer-level exported function is Jim_DictAddElement().
5834 * If an element with the specified key already exists, the value
5835 * associated is replaced with the new one.
5836 *
5837 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5838 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5839 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5840 {
5841 Jim_HashTable *ht = objPtr->internalRep.ptr;
5842
5843 if (valueObjPtr == NULL) { /* unset */
5844 Jim_DeleteHashEntry(ht, keyObjPtr);
5845 return;
5846 }
5847 Jim_IncrRefCount(keyObjPtr);
5848 Jim_IncrRefCount(valueObjPtr);
5849 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5850 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5851 Jim_DecrRefCount(interp, keyObjPtr);
5852 /* ATTENTION: const cast */
5853 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5854 he->val = valueObjPtr;
5855 }
5856 }
5857
5858 /* Add an element, higher-level interface for DictAddElement().
5859 * If valueObjPtr == NULL, the key is removed if it exists. */
5860 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5861 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5862 {
5863 if (Jim_IsShared(objPtr))
5864 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5865 if (objPtr->typePtr != &dictObjType) {
5866 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5867 return JIM_ERR;
5868 }
5869 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5870 Jim_InvalidateStringRep(objPtr);
5871 return JIM_OK;
5872 }
5873
5874 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5875 {
5876 Jim_Obj *objPtr;
5877 int i;
5878
5879 if (len % 2)
5880 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5881
5882 objPtr = Jim_NewObj(interp);
5883 objPtr->typePtr = &dictObjType;
5884 objPtr->bytes = NULL;
5885 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5886 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5887 for (i = 0; i < len; i += 2)
5888 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5889 return objPtr;
5890 }
5891
5892 /* Return the value associated to the specified dict key */
5893 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5894 Jim_Obj **objPtrPtr, int flags)
5895 {
5896 Jim_HashEntry *he;
5897 Jim_HashTable *ht;
5898
5899 if (dictPtr->typePtr != &dictObjType) {
5900 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5901 return JIM_ERR;
5902 }
5903 ht = dictPtr->internalRep.ptr;
5904 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5905 if (flags & JIM_ERRMSG) {
5906 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5907 Jim_AppendStrings(interp, Jim_GetResult(interp),
5908 "key \"", Jim_GetString(keyPtr, NULL),
5909 "\" not found in dictionary", NULL);
5910 }
5911 return JIM_ERR;
5912 }
5913 *objPtrPtr = he->val;
5914 return JIM_OK;
5915 }
5916
5917 /* Return the value associated to the specified dict keys */
5918 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5919 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5920 {
5921 Jim_Obj *objPtr;
5922 int i;
5923
5924 if (keyc == 0) {
5925 *objPtrPtr = dictPtr;
5926 return JIM_OK;
5927 }
5928
5929 for (i = 0; i < keyc; i++) {
5930 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5931 != JIM_OK)
5932 return JIM_ERR;
5933 dictPtr = objPtr;
5934 }
5935 *objPtrPtr = objPtr;
5936 return JIM_OK;
5937 }
5938
5939 /* Modify the dict stored into the variable named 'varNamePtr'
5940 * setting the element specified by the 'keyc' keys objects in 'keyv',
5941 * with the new value of the element 'newObjPtr'.
5942 *
5943 * If newObjPtr == NULL the operation is to remove the given key
5944 * from the dictionary. */
5945 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5946 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5947 {
5948 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5949 int shared, i;
5950
5951 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5952 if (objPtr == NULL) {
5953 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5954 return JIM_ERR;
5955 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5956 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5957 Jim_FreeNewObj(interp, varObjPtr);
5958 return JIM_ERR;
5959 }
5960 }
5961 if ((shared = Jim_IsShared(objPtr)))
5962 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5963 for (i = 0; i < keyc-1; i++) {
5964 dictObjPtr = objPtr;
5965
5966 /* Check if it's a valid dictionary */
5967 if (dictObjPtr->typePtr != &dictObjType) {
5968 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5969 goto err;
5970 }
5971 /* Check if the given key exists. */
5972 Jim_InvalidateStringRep(dictObjPtr);
5973 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5974 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5975 {
5976 /* This key exists at the current level.
5977 * Make sure it's not shared!. */
5978 if (Jim_IsShared(objPtr)) {
5979 objPtr = Jim_DuplicateObj(interp, objPtr);
5980 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5981 }
5982 } else {
5983 /* Key not found. If it's an [unset] operation
5984 * this is an error. Only the last key may not
5985 * exist. */
5986 if (newObjPtr == NULL)
5987 goto err;
5988 /* Otherwise set an empty dictionary
5989 * as key's value. */
5990 objPtr = Jim_NewDictObj(interp, NULL, 0);
5991 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5992 }
5993 }
5994 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5995 != JIM_OK)
5996 goto err;
5997 Jim_InvalidateStringRep(objPtr);
5998 Jim_InvalidateStringRep(varObjPtr);
5999 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6000 goto err;
6001 Jim_SetResult(interp, varObjPtr);
6002 return JIM_OK;
6003 err:
6004 if (shared) {
6005 Jim_FreeNewObj(interp, varObjPtr);
6006 }
6007 return JIM_ERR;
6008 }
6009
6010 /* -----------------------------------------------------------------------------
6011 * Index object
6012 * ---------------------------------------------------------------------------*/
6013 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6014 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6015
6016 static Jim_ObjType indexObjType = {
6017 "index",
6018 NULL,
6019 NULL,
6020 UpdateStringOfIndex,
6021 JIM_TYPE_NONE,
6022 };
6023
6024 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6025 {
6026 int len;
6027 char buf[JIM_INTEGER_SPACE+1];
6028
6029 if (objPtr->internalRep.indexValue >= 0)
6030 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6031 else if (objPtr->internalRep.indexValue == -1)
6032 len = sprintf(buf, "end");
6033 else {
6034 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6035 }
6036 objPtr->bytes = Jim_Alloc(len+1);
6037 memcpy(objPtr->bytes, buf, len+1);
6038 objPtr->length = len;
6039 }
6040
6041 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6042 {
6043 int index, end = 0;
6044 const char *str;
6045
6046 /* Get the string representation */
6047 str = Jim_GetString(objPtr, NULL);
6048 /* Try to convert into an index */
6049 if (!strcmp(str, "end")) {
6050 index = 0;
6051 end = 1;
6052 } else {
6053 if (!strncmp(str, "end-", 4)) {
6054 str += 4;
6055 end = 1;
6056 }
6057 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6058 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6059 Jim_AppendStrings(interp, Jim_GetResult(interp),
6060 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6061 "must be integer or end?-integer?", NULL);
6062 return JIM_ERR;
6063 }
6064 }
6065 if (end) {
6066 if (index < 0)
6067 index = INT_MAX;
6068 else
6069 index = -(index+1);
6070 } else if (!end && index < 0)
6071 index = -INT_MAX;
6072 /* Free the old internal repr and set the new one. */
6073 Jim_FreeIntRep(interp, objPtr);
6074 objPtr->typePtr = &indexObjType;
6075 objPtr->internalRep.indexValue = index;
6076 return JIM_OK;
6077 }
6078
6079 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6080 {
6081 /* Avoid shimmering if the object is an integer. */
6082 if (objPtr->typePtr == &intObjType) {
6083 jim_wide val = objPtr->internalRep.wideValue;
6084 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6085 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6086 return JIM_OK;
6087 }
6088 }
6089 if (objPtr->typePtr != &indexObjType &&
6090 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6091 return JIM_ERR;
6092 *indexPtr = objPtr->internalRep.indexValue;
6093 return JIM_OK;
6094 }
6095
6096 /* -----------------------------------------------------------------------------
6097 * Return Code Object.
6098 * ---------------------------------------------------------------------------*/
6099
6100 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6101
6102 static Jim_ObjType returnCodeObjType = {
6103 "return-code",
6104 NULL,
6105 NULL,
6106 NULL,
6107 JIM_TYPE_NONE,
6108 };
6109
6110 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6111 {
6112 const char *str;
6113 int strLen, returnCode;
6114 jim_wide wideValue;
6115
6116 /* Get the string representation */
6117 str = Jim_GetString(objPtr, &strLen);
6118 /* Try to convert into an integer */
6119 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6120 returnCode = (int) wideValue;
6121 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6122 returnCode = JIM_OK;
6123 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6124 returnCode = JIM_ERR;
6125 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6126 returnCode = JIM_RETURN;
6127 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6128 returnCode = JIM_BREAK;
6129 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6130 returnCode = JIM_CONTINUE;
6131 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6132 returnCode = JIM_EVAL;
6133 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6134 returnCode = JIM_EXIT;
6135 else {
6136 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6137 Jim_AppendStrings(interp, Jim_GetResult(interp),
6138 "expected return code but got '", str, "'",
6139 NULL);
6140 return JIM_ERR;
6141 }
6142 /* Free the old internal repr and set the new one. */
6143 Jim_FreeIntRep(interp, objPtr);
6144 objPtr->typePtr = &returnCodeObjType;
6145 objPtr->internalRep.returnCode = returnCode;
6146 return JIM_OK;
6147 }
6148
6149 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6150 {
6151 if (objPtr->typePtr != &returnCodeObjType &&
6152 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6153 return JIM_ERR;
6154 *intPtr = objPtr->internalRep.returnCode;
6155 return JIM_OK;
6156 }
6157
6158 /* -----------------------------------------------------------------------------
6159 * Expression Parsing
6160 * ---------------------------------------------------------------------------*/
6161 static int JimParseExprOperator(struct JimParserCtx *pc);
6162 static int JimParseExprNumber(struct JimParserCtx *pc);
6163 static int JimParseExprIrrational(struct JimParserCtx *pc);
6164
6165 /* Exrp's Stack machine operators opcodes. */
6166
6167 /* Binary operators (numbers) */
6168 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6169 #define JIM_EXPROP_MUL 0
6170 #define JIM_EXPROP_DIV 1
6171 #define JIM_EXPROP_MOD 2
6172 #define JIM_EXPROP_SUB 3
6173 #define JIM_EXPROP_ADD 4
6174 #define JIM_EXPROP_LSHIFT 5
6175 #define JIM_EXPROP_RSHIFT 6
6176 #define JIM_EXPROP_ROTL 7
6177 #define JIM_EXPROP_ROTR 8
6178 #define JIM_EXPROP_LT 9
6179 #define JIM_EXPROP_GT 10
6180 #define JIM_EXPROP_LTE 11
6181 #define JIM_EXPROP_GTE 12
6182 #define JIM_EXPROP_NUMEQ 13
6183 #define JIM_EXPROP_NUMNE 14
6184 #define JIM_EXPROP_BITAND 15
6185 #define JIM_EXPROP_BITXOR 16
6186 #define JIM_EXPROP_BITOR 17
6187 #define JIM_EXPROP_LOGICAND 18
6188 #define JIM_EXPROP_LOGICOR 19
6189 #define JIM_EXPROP_LOGICAND_LEFT 20
6190 #define JIM_EXPROP_LOGICOR_LEFT 21
6191 #define JIM_EXPROP_POW 22
6192 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6193
6194 /* Binary operators (strings) */
6195 #define JIM_EXPROP_STREQ 23
6196 #define JIM_EXPROP_STRNE 24
6197
6198 /* Unary operators (numbers) */
6199 #define JIM_EXPROP_NOT 25
6200 #define JIM_EXPROP_BITNOT 26
6201 #define JIM_EXPROP_UNARYMINUS 27
6202 #define JIM_EXPROP_UNARYPLUS 28
6203 #define JIM_EXPROP_LOGICAND_RIGHT 29
6204 #define JIM_EXPROP_LOGICOR_RIGHT 30
6205
6206 /* Ternary operators */
6207 #define JIM_EXPROP_TERNARY 31
6208
6209 /* Operands */
6210 #define JIM_EXPROP_NUMBER 32
6211 #define JIM_EXPROP_COMMAND 33
6212 #define JIM_EXPROP_VARIABLE 34
6213 #define JIM_EXPROP_DICTSUGAR 35
6214 #define JIM_EXPROP_SUBST 36
6215 #define JIM_EXPROP_STRING 37
6216
6217 /* Operators table */
6218 typedef struct Jim_ExprOperator {
6219 const char *name;
6220 int precedence;
6221 int arity;
6222 int opcode;
6223 } Jim_ExprOperator;
6224
6225 /* name - precedence - arity - opcode */
6226 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6227 {"!", 300, 1, JIM_EXPROP_NOT},
6228 {"~", 300, 1, JIM_EXPROP_BITNOT},
6229 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6230 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6231
6232 {"**", 250, 2, JIM_EXPROP_POW},
6233
6234 {"*", 200, 2, JIM_EXPROP_MUL},
6235 {"/", 200, 2, JIM_EXPROP_DIV},
6236 {"%", 200, 2, JIM_EXPROP_MOD},
6237
6238 {"-", 100, 2, JIM_EXPROP_SUB},
6239 {"+", 100, 2, JIM_EXPROP_ADD},
6240
6241 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6242 {">>>", 90, 3, JIM_EXPROP_ROTR},
6243 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6244 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6245
6246 {"<", 80, 2, JIM_EXPROP_LT},
6247 {">", 80, 2, JIM_EXPROP_GT},
6248 {"<=", 80, 2, JIM_EXPROP_LTE},
6249 {">=", 80, 2, JIM_EXPROP_GTE},
6250
6251 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6252 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6253
6254 {"eq", 60, 2, JIM_EXPROP_STREQ},
6255 {"ne", 60, 2, JIM_EXPROP_STRNE},
6256
6257 {"&", 50, 2, JIM_EXPROP_BITAND},
6258 {"^", 49, 2, JIM_EXPROP_BITXOR},
6259 {"|", 48, 2, JIM_EXPROP_BITOR},
6260
6261 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6262 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6263
6264 {"?", 5, 3, JIM_EXPROP_TERNARY},
6265 /* private operators */
6266 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6267 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6268 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6269 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6270 };
6271
6272 #define JIM_EXPR_OPERATORS_NUM \
6273 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6274
6275 int JimParseExpression(struct JimParserCtx *pc)
6276 {
6277 /* Discard spaces and quoted newline */
6278 while(*(pc->p) == ' ' ||
6279 *(pc->p) == '\t' ||
6280 *(pc->p) == '\r' ||
6281 *(pc->p) == '\n' ||
6282 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6283 pc->p++; pc->len--;
6284 }
6285
6286 if (pc->len == 0) {
6287 pc->tstart = pc->tend = pc->p;
6288 pc->tline = pc->linenr;
6289 pc->tt = JIM_TT_EOL;
6290 pc->eof = 1;
6291 return JIM_OK;
6292 }
6293 switch(*(pc->p)) {
6294 case '(':
6295 pc->tstart = pc->tend = pc->p;
6296 pc->tline = pc->linenr;
6297 pc->tt = JIM_TT_SUBEXPR_START;
6298 pc->p++; pc->len--;
6299 break;
6300 case ')':
6301 pc->tstart = pc->tend = pc->p;
6302 pc->tline = pc->linenr;
6303 pc->tt = JIM_TT_SUBEXPR_END;
6304 pc->p++; pc->len--;
6305 break;
6306 case '[':
6307 return JimParseCmd(pc);
6308 break;
6309 case '$':
6310 if (JimParseVar(pc) == JIM_ERR)
6311 return JimParseExprOperator(pc);
6312 else
6313 return JIM_OK;
6314 break;
6315 case '-':
6316 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6317 isdigit((int)*(pc->p+1)))
6318 return JimParseExprNumber(pc);
6319 else
6320 return JimParseExprOperator(pc);
6321 break;
6322 case '0': case '1': case '2': case '3': case '4':
6323 case '5': case '6': case '7': case '8': case '9': case '.':
6324 return JimParseExprNumber(pc);
6325 break;
6326 case '"':
6327 case '{':
6328 /* Here it's possible to reuse the List String parsing. */
6329 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6330 return JimParseListStr(pc);
6331 break;
6332 case 'N': case 'I':
6333 case 'n': case 'i':
6334 if (JimParseExprIrrational(pc) == JIM_ERR)
6335 return JimParseExprOperator(pc);
6336 break;
6337 default:
6338 return JimParseExprOperator(pc);
6339 break;
6340 }
6341 return JIM_OK;
6342 }
6343
6344 int JimParseExprNumber(struct JimParserCtx *pc)
6345 {
6346 int allowdot = 1;
6347 int allowhex = 0;
6348
6349 pc->tstart = pc->p;
6350 pc->tline = pc->linenr;
6351 if (*pc->p == '-') {
6352 pc->p++; pc->len--;
6353 }
6354 while ( isdigit((int)*pc->p)
6355 || (allowhex && isxdigit((int)*pc->p) )
6356 || (allowdot && *pc->p == '.')
6357 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6358 (*pc->p == 'x' || *pc->p == 'X'))
6359 )
6360 {
6361 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6362 allowhex = 1;
6363 allowdot = 0;
6364 }
6365 if (*pc->p == '.')
6366 allowdot = 0;
6367 pc->p++; pc->len--;
6368 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6369 pc->p += 2; pc->len -= 2;
6370 }
6371 }
6372 pc->tend = pc->p-1;
6373 pc->tt = JIM_TT_EXPR_NUMBER;
6374 return JIM_OK;
6375 }
6376
6377 int JimParseExprIrrational(struct JimParserCtx *pc)
6378 {
6379 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6380 const char **token;
6381 for (token = Tokens; *token != NULL; token++) {
6382 int len = strlen(*token);
6383 if (strncmp(*token, pc->p, len) == 0) {
6384 pc->tstart = pc->p;
6385 pc->tend = pc->p + len - 1;
6386 pc->p += len; pc->len -= len;
6387 pc->tline = pc->linenr;
6388 pc->tt = JIM_TT_EXPR_NUMBER;
6389 return JIM_OK;
6390 }
6391 }
6392 return JIM_ERR;
6393 }
6394
6395 int JimParseExprOperator(struct JimParserCtx *pc)
6396 {
6397 int i;
6398 int bestIdx = -1, bestLen = 0;
6399
6400 /* Try to get the longest match. */
6401 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6402 const char *opname;
6403 int oplen;
6404
6405 opname = Jim_ExprOperators[i].name;
6406 if (opname == NULL) continue;
6407 oplen = strlen(opname);
6408
6409 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6410 bestIdx = i;
6411 bestLen = oplen;
6412 }
6413 }
6414 if (bestIdx == -1) return JIM_ERR;
6415 pc->tstart = pc->p;
6416 pc->tend = pc->p + bestLen - 1;
6417 pc->p += bestLen; pc->len -= bestLen;
6418 pc->tline = pc->linenr;
6419 pc->tt = JIM_TT_EXPR_OPERATOR;
6420 return JIM_OK;
6421 }
6422
6423 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6424 {
6425 int i;
6426 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6427 if (Jim_ExprOperators[i].name &&
6428 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6429 return &Jim_ExprOperators[i];
6430 return NULL;
6431 }
6432
6433 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6434 {
6435 int i;
6436 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6437 if (Jim_ExprOperators[i].opcode == opcode)
6438 return &Jim_ExprOperators[i];
6439 return NULL;
6440 }
6441
6442 /* -----------------------------------------------------------------------------
6443 * Expression Object
6444 * ---------------------------------------------------------------------------*/
6445 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6446 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6447 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6448
6449 static Jim_ObjType exprObjType = {
6450 "expression",
6451 FreeExprInternalRep,
6452 DupExprInternalRep,
6453 NULL,
6454 JIM_TYPE_REFERENCES,
6455 };
6456
6457 /* Expr bytecode structure */
6458 typedef struct ExprByteCode {
6459 int *opcode; /* Integer array of opcodes. */
6460 Jim_Obj **obj; /* Array of associated Jim Objects. */
6461 int len; /* Bytecode length */
6462 int inUse; /* Used for sharing. */
6463 } ExprByteCode;
6464
6465 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6466 {
6467 int i;
6468 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6469
6470 expr->inUse--;
6471 if (expr->inUse != 0) return;
6472 for (i = 0; i < expr->len; i++)
6473 Jim_DecrRefCount(interp, expr->obj[i]);
6474 Jim_Free(expr->opcode);
6475 Jim_Free(expr->obj);
6476 Jim_Free(expr);
6477 }
6478
6479 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6480 {
6481 JIM_NOTUSED(interp);
6482 JIM_NOTUSED(srcPtr);
6483
6484 /* Just returns an simple string. */
6485 dupPtr->typePtr = NULL;
6486 }
6487
6488 /* Add a new instruction to an expression bytecode structure. */
6489 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6490 int opcode, char *str, int len)
6491 {
6492 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6493 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6494 expr->opcode[expr->len] = opcode;
6495 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6496 Jim_IncrRefCount(expr->obj[expr->len]);
6497 expr->len++;
6498 }
6499
6500 /* Check if an expr program looks correct. */
6501 static int ExprCheckCorrectness(ExprByteCode *expr)
6502 {
6503 int i;
6504 int stacklen = 0;
6505
6506 /* Try to check if there are stack underflows,
6507 * and make sure at the end of the program there is
6508 * a single result on the stack. */
6509 for (i = 0; i < expr->len; i++) {
6510 switch(expr->opcode[i]) {
6511 case JIM_EXPROP_NUMBER:
6512 case JIM_EXPROP_STRING:
6513 case JIM_EXPROP_SUBST:
6514 case JIM_EXPROP_VARIABLE:
6515 case JIM_EXPROP_DICTSUGAR:
6516 case JIM_EXPROP_COMMAND:
6517 stacklen++;
6518 break;
6519 case JIM_EXPROP_NOT:
6520 case JIM_EXPROP_BITNOT:
6521 case JIM_EXPROP_UNARYMINUS:
6522 case JIM_EXPROP_UNARYPLUS:
6523 /* Unary operations */
6524 if (stacklen < 1) return JIM_ERR;
6525 break;
6526 case JIM_EXPROP_ADD:
6527 case JIM_EXPROP_SUB:
6528 case JIM_EXPROP_MUL:
6529 case JIM_EXPROP_DIV:
6530 case JIM_EXPROP_MOD:
6531 case JIM_EXPROP_LT:
6532 case JIM_EXPROP_GT:
6533 case JIM_EXPROP_LTE:
6534 case JIM_EXPROP_GTE:
6535 case JIM_EXPROP_ROTL:
6536 case JIM_EXPROP_ROTR:
6537 case JIM_EXPROP_LSHIFT:
6538 case JIM_EXPROP_RSHIFT:
6539 case JIM_EXPROP_NUMEQ:
6540 case JIM_EXPROP_NUMNE:
6541 case JIM_EXPROP_STREQ:
6542 case JIM_EXPROP_STRNE:
6543 case JIM_EXPROP_BITAND:
6544 case JIM_EXPROP_BITXOR:
6545 case JIM_EXPROP_BITOR:
6546 case JIM_EXPROP_LOGICAND:
6547 case JIM_EXPROP_LOGICOR:
6548 case JIM_EXPROP_POW:
6549 /* binary operations */
6550 if (stacklen < 2) return JIM_ERR;
6551 stacklen--;
6552 break;
6553 default:
6554 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6555 break;
6556 }
6557 }
6558 if (stacklen != 1) return JIM_ERR;
6559 return JIM_OK;
6560 }
6561
6562 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6563 ScriptObj *topLevelScript)
6564 {
6565 int i;
6566
6567 return;
6568 for (i = 0; i < expr->len; i++) {
6569 Jim_Obj *foundObjPtr;
6570
6571 if (expr->obj[i] == NULL) continue;
6572 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6573 NULL, expr->obj[i]);
6574 if (foundObjPtr != NULL) {
6575 Jim_IncrRefCount(foundObjPtr);
6576 Jim_DecrRefCount(interp, expr->obj[i]);
6577 expr->obj[i] = foundObjPtr;
6578 }
6579 }
6580 }
6581
6582 /* This procedure converts every occurrence of || and && opereators
6583 * in lazy unary versions.
6584 *
6585 * a b || is converted into:
6586 *
6587 * a <offset> |L b |R
6588 *
6589 * a b && is converted into:
6590 *
6591 * a <offset> &L b &R
6592 *
6593 * "|L" checks if 'a' is true:
6594 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6595 * the opcode just after |R.
6596 * 2) if it is false does nothing.
6597 * "|R" checks if 'b' is true:
6598 * 1) if it is true pushes 1, otherwise pushes 0.
6599 *
6600 * "&L" checks if 'a' is true:
6601 * 1) if it is true does nothing.
6602 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6603 * the opcode just after &R
6604 * "&R" checks if 'a' is true:
6605 * if it is true pushes 1, otherwise pushes 0.
6606 */
6607 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6608 {
6609 while (1) {
6610 int index = -1, leftindex, arity, i, offset;
6611 Jim_ExprOperator *op;
6612
6613 /* Search for || or && */
6614 for (i = 0; i < expr->len; i++) {
6615 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6616 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6617 index = i;
6618 break;
6619 }
6620 }
6621 if (index == -1) return;
6622 /* Search for the end of the first operator */
6623 leftindex = index-1;
6624 arity = 1;
6625 while(arity) {
6626 switch(expr->opcode[leftindex]) {
6627 case JIM_EXPROP_NUMBER:
6628 case JIM_EXPROP_COMMAND:
6629 case JIM_EXPROP_VARIABLE:
6630 case JIM_EXPROP_DICTSUGAR:
6631 case JIM_EXPROP_SUBST:
6632 case JIM_EXPROP_STRING:
6633 break;
6634 default:
6635 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6636 if (op == NULL) {
6637 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6638 }
6639 arity += op->arity;
6640 break;
6641 }
6642 arity--;
6643 leftindex--;
6644 }
6645 leftindex++;
6646 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6647 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6648 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6649 sizeof(int)*(expr->len-leftindex));
6650 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6651 sizeof(Jim_Obj*)*(expr->len-leftindex));
6652 expr->len += 2;
6653 index += 2;
6654 offset = (index-leftindex)-1;
6655 Jim_DecrRefCount(interp, expr->obj[index]);
6656 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6657 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6658 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6659 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6660 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6661 } else {
6662 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6663 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6664 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6665 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6666 }
6667 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6668 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6669 Jim_IncrRefCount(expr->obj[index]);
6670 Jim_IncrRefCount(expr->obj[leftindex]);
6671 Jim_IncrRefCount(expr->obj[leftindex+1]);
6672 }
6673 }
6674
6675 /* This method takes the string representation of an expression
6676 * and generates a program for the Expr's stack-based VM. */
6677 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6678 {
6679 int exprTextLen;
6680 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6681 struct JimParserCtx parser;
6682 int i, shareLiterals;
6683 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6684 Jim_Stack stack;
6685 Jim_ExprOperator *op;
6686
6687 /* Perform literal sharing with the current procedure
6688 * running only if this expression appears to be not generated
6689 * at runtime. */
6690 shareLiterals = objPtr->typePtr == &sourceObjType;
6691
6692 expr->opcode = NULL;
6693 expr->obj = NULL;
6694 expr->len = 0;
6695 expr->inUse = 1;
6696
6697 Jim_InitStack(&stack);
6698 JimParserInit(&parser, exprText, exprTextLen, 1);
6699 while(!JimParserEof(&parser)) {
6700 char *token;
6701 int len, type;
6702
6703 if (JimParseExpression(&parser) != JIM_OK) {
6704 Jim_SetResultString(interp, "Syntax error in expression", -1);
6705 goto err;
6706 }
6707 token = JimParserGetToken(&parser, &len, &type, NULL);
6708 if (type == JIM_TT_EOL) {
6709 Jim_Free(token);
6710 break;
6711 }
6712 switch(type) {
6713 case JIM_TT_STR:
6714 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6715 break;
6716 case JIM_TT_ESC:
6717 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6718 break;
6719 case JIM_TT_VAR:
6720 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6721 break;
6722 case JIM_TT_DICTSUGAR:
6723 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6724 break;
6725 case JIM_TT_CMD:
6726 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6727 break;
6728 case JIM_TT_EXPR_NUMBER:
6729 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6730 break;
6731 case JIM_TT_EXPR_OPERATOR:
6732 op = JimExprOperatorInfo(token);
6733 while(1) {
6734 Jim_ExprOperator *stackTopOp;
6735
6736 if (Jim_StackPeek(&stack) != NULL) {
6737 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6738 } else {
6739 stackTopOp = NULL;
6740 }
6741 if (Jim_StackLen(&stack) && op->arity != 1 &&
6742 stackTopOp && stackTopOp->precedence >= op->precedence)
6743 {
6744 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6745 Jim_StackPeek(&stack), -1);
6746 Jim_StackPop(&stack);
6747 } else {
6748 break;
6749 }
6750 }
6751 Jim_StackPush(&stack, token);
6752 break;
6753 case JIM_TT_SUBEXPR_START:
6754 Jim_StackPush(&stack, Jim_StrDup("("));
6755 Jim_Free(token);
6756 break;
6757 case JIM_TT_SUBEXPR_END:
6758 {
6759 int found = 0;
6760 while(Jim_StackLen(&stack)) {
6761 char *opstr = Jim_StackPop(&stack);
6762 if (!strcmp(opstr, "(")) {
6763 Jim_Free(opstr);
6764 found = 1;
6765 break;
6766 }
6767 op = JimExprOperatorInfo(opstr);
6768 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6769 }
6770 if (!found) {
6771 Jim_SetResultString(interp,
6772 "Unexpected close parenthesis", -1);
6773 goto err;
6774 }
6775 }
6776 Jim_Free(token);
6777 break;
6778 default:
6779 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6780 break;
6781 }
6782 }
6783 while (Jim_StackLen(&stack)) {
6784 char *opstr = Jim_StackPop(&stack);
6785 op = JimExprOperatorInfo(opstr);
6786 if (op == NULL && !strcmp(opstr, "(")) {
6787 Jim_Free(opstr);
6788 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6789 goto err;
6790 }
6791 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6792 }
6793 /* Check program correctness. */
6794 if (ExprCheckCorrectness(expr) != JIM_OK) {
6795 Jim_SetResultString(interp, "Invalid expression", -1);
6796 goto err;
6797 }
6798
6799 /* Free the stack used for the compilation. */
6800 Jim_FreeStackElements(&stack, Jim_Free);
6801 Jim_FreeStack(&stack);
6802
6803 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6804 ExprMakeLazy(interp, expr);
6805
6806 /* Perform literal sharing */
6807 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6808 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6809 if (bodyObjPtr->typePtr == &scriptObjType) {
6810 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6811 ExprShareLiterals(interp, expr, bodyScript);
6812 }
6813 }
6814
6815 /* Free the old internal rep and set the new one. */
6816 Jim_FreeIntRep(interp, objPtr);
6817 Jim_SetIntRepPtr(objPtr, expr);
6818 objPtr->typePtr = &exprObjType;
6819 return JIM_OK;
6820
6821 err: /* we jump here on syntax/compile errors. */
6822 Jim_FreeStackElements(&stack, Jim_Free);
6823 Jim_FreeStack(&stack);
6824 Jim_Free(expr->opcode);
6825 for (i = 0; i < expr->len; i++) {
6826 Jim_DecrRefCount(interp,expr->obj[i]);
6827 }
6828 Jim_Free(expr->obj);
6829 Jim_Free(expr);
6830 return JIM_ERR;
6831 }
6832
6833 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6834 {
6835 if (objPtr->typePtr != &exprObjType) {
6836 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6837 return NULL;
6838 }
6839 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6840 }
6841
6842 /* -----------------------------------------------------------------------------
6843 * Expressions evaluation.
6844 * Jim uses a specialized stack-based virtual machine for expressions,
6845 * that takes advantage of the fact that expr's operators
6846 * can't be redefined.
6847 *
6848 * Jim_EvalExpression() uses the bytecode compiled by
6849 * SetExprFromAny() method of the "expression" object.
6850 *
6851 * On success a Tcl Object containing the result of the evaluation
6852 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6853 * returned.
6854 * On error the function returns a retcode != to JIM_OK and set a suitable
6855 * error on the interp.
6856 * ---------------------------------------------------------------------------*/
6857 #define JIM_EE_STATICSTACK_LEN 10
6858
6859 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6860 Jim_Obj **exprResultPtrPtr)
6861 {
6862 ExprByteCode *expr;
6863 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6864 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6865
6866 Jim_IncrRefCount(exprObjPtr);
6867 expr = Jim_GetExpression(interp, exprObjPtr);
6868 if (!expr) {
6869 Jim_DecrRefCount(interp, exprObjPtr);
6870 return JIM_ERR; /* error in expression. */
6871 }
6872 /* In order to avoid that the internal repr gets freed due to
6873 * shimmering of the exprObjPtr's object, we make the internal rep
6874 * shared. */
6875 expr->inUse++;
6876
6877 /* The stack-based expr VM itself */
6878
6879 /* Stack allocation. Expr programs have the feature that
6880 * a program of length N can't require a stack longer than
6881 * N. */
6882 if (expr->len > JIM_EE_STATICSTACK_LEN)
6883 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6884 else
6885 stack = staticStack;
6886
6887 /* Execute every istruction */
6888 for (i = 0; i < expr->len; i++) {
6889 Jim_Obj *A, *B, *objPtr;
6890 jim_wide wA, wB, wC;
6891 double dA, dB, dC;
6892 const char *sA, *sB;
6893 int Alen, Blen, retcode;
6894 int opcode = expr->opcode[i];
6895
6896 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6897 stack[stacklen++] = expr->obj[i];
6898 Jim_IncrRefCount(expr->obj[i]);
6899 } else if (opcode == JIM_EXPROP_VARIABLE) {
6900 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6901 if (objPtr == NULL) {
6902 error = 1;
6903 goto err;
6904 }
6905 stack[stacklen++] = objPtr;
6906 Jim_IncrRefCount(objPtr);
6907 } else if (opcode == JIM_EXPROP_SUBST) {
6908 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6909 &objPtr, JIM_NONE)) != JIM_OK)
6910 {
6911 error = 1;
6912 errRetCode = retcode;
6913 goto err;
6914 }
6915 stack[stacklen++] = objPtr;
6916 Jim_IncrRefCount(objPtr);
6917 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6918 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6919 if (objPtr == NULL) {
6920 error = 1;
6921 goto err;
6922 }
6923 stack[stacklen++] = objPtr;
6924 Jim_IncrRefCount(objPtr);
6925 } else if (opcode == JIM_EXPROP_COMMAND) {
6926 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6927 error = 1;
6928 errRetCode = retcode;
6929 goto err;
6930 }
6931 stack[stacklen++] = interp->result;
6932 Jim_IncrRefCount(interp->result);
6933 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6934 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6935 {
6936 /* Note that there isn't to increment the
6937 * refcount of objects. the references are moved
6938 * from stack to A and B. */
6939 B = stack[--stacklen];
6940 A = stack[--stacklen];
6941
6942 /* --- Integer --- */
6943 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6944 (B->typePtr == &doubleObjType && !B->bytes) ||
6945 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6946 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6947 goto trydouble;
6948 }
6949 Jim_DecrRefCount(interp, A);
6950 Jim_DecrRefCount(interp, B);
6951 switch(expr->opcode[i]) {
6952 case JIM_EXPROP_ADD: wC = wA+wB; break;
6953 case JIM_EXPROP_SUB: wC = wA-wB; break;
6954 case JIM_EXPROP_MUL: wC = wA*wB; break;
6955 case JIM_EXPROP_LT: wC = wA<wB; break;
6956 case JIM_EXPROP_GT: wC = wA>wB; break;
6957 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6958 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6959 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6960 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6961 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6962 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6963 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6964 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6965 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6966 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6967 case JIM_EXPROP_LOGICAND_LEFT:
6968 if (wA == 0) {
6969 i += (int)wB;
6970 wC = 0;
6971 } else {
6972 continue;
6973 }
6974 break;
6975 case JIM_EXPROP_LOGICOR_LEFT:
6976 if (wA != 0) {
6977 i += (int)wB;
6978 wC = 1;
6979 } else {
6980 continue;
6981 }
6982 break;
6983 case JIM_EXPROP_DIV:
6984 if (wB == 0) goto divbyzero;
6985 wC = wA/wB;
6986 break;
6987 case JIM_EXPROP_MOD:
6988 if (wB == 0) goto divbyzero;
6989 wC = wA%wB;
6990 break;
6991 case JIM_EXPROP_ROTL: {
6992 /* uint32_t would be better. But not everyone has inttypes.h?*/
6993 unsigned long uA = (unsigned long)wA;
6994 #ifdef _MSC_VER
6995 wC = _rotl(uA,(unsigned long)wB);
6996 #else
6997 const unsigned int S = sizeof(unsigned long) * 8;
6998 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6999 #endif
7000 break;
7001 }
7002 case JIM_EXPROP_ROTR: {
7003 unsigned long uA = (unsigned long)wA;
7004 #ifdef _MSC_VER
7005 wC = _rotr(uA,(unsigned long)wB);
7006 #else
7007 const unsigned int S = sizeof(unsigned long) * 8;
7008 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7009 #endif
7010 break;
7011 }
7012
7013 default:
7014 wC = 0; /* avoid gcc warning */
7015 break;
7016 }
7017 stack[stacklen] = Jim_NewIntObj(interp, wC);
7018 Jim_IncrRefCount(stack[stacklen]);
7019 stacklen++;
7020 continue;
7021 trydouble:
7022 /* --- Double --- */
7023 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7024 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7025
7026 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7027 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7028 opcode = JIM_EXPROP_STRNE;
7029 goto retry_as_string;
7030 }
7031 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7032 opcode = JIM_EXPROP_STREQ;
7033 goto retry_as_string;
7034 }
7035 Jim_DecrRefCount(interp, A);
7036 Jim_DecrRefCount(interp, B);
7037 error = 1;
7038 goto err;
7039 }
7040 Jim_DecrRefCount(interp, A);
7041 Jim_DecrRefCount(interp, B);
7042 switch(expr->opcode[i]) {
7043 case JIM_EXPROP_ROTL:
7044 case JIM_EXPROP_ROTR:
7045 case JIM_EXPROP_LSHIFT:
7046 case JIM_EXPROP_RSHIFT:
7047 case JIM_EXPROP_BITAND:
7048 case JIM_EXPROP_BITXOR:
7049 case JIM_EXPROP_BITOR:
7050 case JIM_EXPROP_MOD:
7051 case JIM_EXPROP_POW:
7052 Jim_SetResultString(interp,
7053 "Got floating-point value where integer was expected", -1);
7054 error = 1;
7055 goto err;
7056 break;
7057 case JIM_EXPROP_ADD: dC = dA+dB; break;
7058 case JIM_EXPROP_SUB: dC = dA-dB; break;
7059 case JIM_EXPROP_MUL: dC = dA*dB; break;
7060 case JIM_EXPROP_LT: dC = dA<dB; break;
7061 case JIM_EXPROP_GT: dC = dA>dB; break;
7062 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7063 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7064 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7065 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7066 case JIM_EXPROP_LOGICAND_LEFT:
7067 if (dA == 0) {
7068 i += (int)dB;
7069 dC = 0;
7070 } else {
7071 continue;
7072 }
7073 break;
7074 case JIM_EXPROP_LOGICOR_LEFT:
7075 if (dA != 0) {
7076 i += (int)dB;
7077 dC = 1;
7078 } else {
7079 continue;
7080 }
7081 break;
7082 case JIM_EXPROP_DIV:
7083 if (dB == 0) goto divbyzero;
7084 dC = dA/dB;
7085 break;
7086 default:
7087 dC = 0; /* avoid gcc warning */
7088 break;
7089 }
7090 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7091 Jim_IncrRefCount(stack[stacklen]);
7092 stacklen++;
7093 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7094 B = stack[--stacklen];
7095 A = stack[--stacklen];
7096 retry_as_string:
7097 sA = Jim_GetString(A, &Alen);
7098 sB = Jim_GetString(B, &Blen);
7099 switch(opcode) {
7100 case JIM_EXPROP_STREQ:
7101 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7102 wC = 1;
7103 else
7104 wC = 0;
7105 break;
7106 case JIM_EXPROP_STRNE:
7107 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7108 wC = 1;
7109 else
7110 wC = 0;
7111 break;
7112 default:
7113 wC = 0; /* avoid gcc warning */
7114 break;
7115 }
7116 Jim_DecrRefCount(interp, A);
7117 Jim_DecrRefCount(interp, B);
7118 stack[stacklen] = Jim_NewIntObj(interp, wC);
7119 Jim_IncrRefCount(stack[stacklen]);
7120 stacklen++;
7121 } else if (opcode == JIM_EXPROP_NOT ||
7122 opcode == JIM_EXPROP_BITNOT ||
7123 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7124 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7125 /* Note that there isn't to increment the
7126 * refcount of objects. the references are moved
7127 * from stack to A and B. */
7128 A = stack[--stacklen];
7129
7130 /* --- Integer --- */
7131 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7132 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7133 goto trydouble_unary;
7134 }
7135 Jim_DecrRefCount(interp, A);
7136 switch(expr->opcode[i]) {
7137 case JIM_EXPROP_NOT: wC = !wA; break;
7138 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7139 case JIM_EXPROP_LOGICAND_RIGHT:
7140 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7141 default:
7142 wC = 0; /* avoid gcc warning */
7143 break;
7144 }
7145 stack[stacklen] = Jim_NewIntObj(interp, wC);
7146 Jim_IncrRefCount(stack[stacklen]);
7147 stacklen++;
7148 continue;
7149 trydouble_unary:
7150 /* --- Double --- */
7151 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7152 Jim_DecrRefCount(interp, A);
7153 error = 1;
7154 goto err;
7155 }
7156 Jim_DecrRefCount(interp, A);
7157 switch(expr->opcode[i]) {
7158 case JIM_EXPROP_NOT: dC = !dA; break;
7159 case JIM_EXPROP_LOGICAND_RIGHT:
7160 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7161 case JIM_EXPROP_BITNOT:
7162 Jim_SetResultString(interp,
7163 "Got floating-point value where integer was expected", -1);
7164 error = 1;
7165 goto err;
7166 break;
7167 default:
7168 dC = 0; /* avoid gcc warning */
7169 break;
7170 }
7171 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7172 Jim_IncrRefCount(stack[stacklen]);
7173 stacklen++;
7174 } else {
7175 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7176 }
7177 }
7178 err:
7179 /* There is no need to decerement the inUse field because
7180 * this reference is transfered back into the exprObjPtr. */
7181 Jim_FreeIntRep(interp, exprObjPtr);
7182 exprObjPtr->typePtr = &exprObjType;
7183 Jim_SetIntRepPtr(exprObjPtr, expr);
7184 Jim_DecrRefCount(interp, exprObjPtr);
7185 if (!error) {
7186 *exprResultPtrPtr = stack[0];
7187 Jim_IncrRefCount(stack[0]);
7188 errRetCode = JIM_OK;
7189 }
7190 for (i = 0; i < stacklen; i++) {
7191 Jim_DecrRefCount(interp, stack[i]);
7192 }
7193 if (stack != staticStack)
7194 Jim_Free(stack);
7195 return errRetCode;
7196 divbyzero:
7197 error = 1;
7198 Jim_SetResultString(interp, "Division by zero", -1);
7199 goto err;
7200 }
7201
7202 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7203 {
7204 int retcode;
7205 jim_wide wideValue;
7206 double doubleValue;
7207 Jim_Obj *exprResultPtr;
7208
7209 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7210 if (retcode != JIM_OK)
7211 return retcode;
7212 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7213 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7214 {
7215 Jim_DecrRefCount(interp, exprResultPtr);
7216 return JIM_ERR;
7217 } else {
7218 Jim_DecrRefCount(interp, exprResultPtr);
7219 *boolPtr = doubleValue != 0;
7220 return JIM_OK;
7221 }
7222 }
7223 Jim_DecrRefCount(interp, exprResultPtr);
7224 *boolPtr = wideValue != 0;
7225 return JIM_OK;
7226 }
7227
7228 /* -----------------------------------------------------------------------------
7229 * ScanFormat String Object
7230 * ---------------------------------------------------------------------------*/
7231
7232 /* This Jim_Obj will held a parsed representation of a format string passed to
7233 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7234 * to be parsed in its entirely first and then, if correct, can be used for
7235 * scanning. To avoid endless re-parsing, the parsed representation will be
7236 * stored in an internal representation and re-used for performance reason. */
7237
7238 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7239 * scanformat string. This part will later be used to extract information
7240 * out from the string to be parsed by Jim_ScanString */
7241
7242 typedef struct ScanFmtPartDescr {
7243 char type; /* Type of conversion (e.g. c, d, f) */
7244 char modifier; /* Modify type (e.g. l - long, h - short */
7245 size_t width; /* Maximal width of input to be converted */
7246 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7247 char *arg; /* Specification of a CHARSET conversion */
7248 char *prefix; /* Prefix to be scanned literally before conversion */
7249 } ScanFmtPartDescr;
7250
7251 /* The ScanFmtStringObj will held the internal representation of a scanformat
7252 * string parsed and separated in part descriptions. Furthermore it contains
7253 * the original string representation of the scanformat string to allow for
7254 * fast update of the Jim_Obj's string representation part.
7255 *
7256 * As add-on the internal object representation add some scratch pad area
7257 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7258 * memory for purpose of string scanning.
7259 *
7260 * The error member points to a static allocated string in case of a mal-
7261 * formed scanformat string or it contains '0' (NULL) in case of a valid
7262 * parse representation.
7263 *
7264 * The whole memory of the internal representation is allocated as a single
7265 * area of memory that will be internally separated. So freeing and duplicating
7266 * of such an object is cheap */
7267
7268 typedef struct ScanFmtStringObj {
7269 jim_wide size; /* Size of internal repr in bytes */
7270 char *stringRep; /* Original string representation */
7271 size_t count; /* Number of ScanFmtPartDescr contained */
7272 size_t convCount; /* Number of conversions that will assign */
7273 size_t maxPos; /* Max position index if XPG3 is used */
7274 const char *error; /* Ptr to error text (NULL if no error */
7275 char *scratch; /* Some scratch pad used by Jim_ScanString */
7276 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7277 } ScanFmtStringObj;
7278
7279
7280 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7281 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7282 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7283
7284 static Jim_ObjType scanFmtStringObjType = {
7285 "scanformatstring",
7286 FreeScanFmtInternalRep,
7287 DupScanFmtInternalRep,
7288 UpdateStringOfScanFmt,
7289 JIM_TYPE_NONE,
7290 };
7291
7292 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7293 {
7294 JIM_NOTUSED(interp);
7295 Jim_Free((char*)objPtr->internalRep.ptr);
7296 objPtr->internalRep.ptr = 0;
7297 }
7298
7299 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7300 {
7301 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7302 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7303
7304 JIM_NOTUSED(interp);
7305 memcpy(newVec, srcPtr->internalRep.ptr, size);
7306 dupPtr->internalRep.ptr = newVec;
7307 dupPtr->typePtr = &scanFmtStringObjType;
7308 }
7309
7310 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7311 {
7312 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7313
7314 objPtr->bytes = Jim_StrDup(bytes);
7315 objPtr->length = strlen(bytes);
7316 }
7317
7318 /* SetScanFmtFromAny will parse a given string and create the internal
7319 * representation of the format specification. In case of an error
7320 * the error data member of the internal representation will be set
7321 * to an descriptive error text and the function will be left with
7322 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7323 * specification */
7324
7325 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7326 {
7327 ScanFmtStringObj *fmtObj;
7328 char *buffer;
7329 int maxCount, i, approxSize, lastPos = -1;
7330 const char *fmt = objPtr->bytes;
7331 int maxFmtLen = objPtr->length;
7332 const char *fmtEnd = fmt + maxFmtLen;
7333 int curr;
7334
7335 Jim_FreeIntRep(interp, objPtr);
7336 /* Count how many conversions could take place maximally */
7337 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7338 if (fmt[i] == '%')
7339 ++maxCount;
7340 /* Calculate an approximation of the memory necessary */
7341 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7342 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7343 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7344 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7345 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7346 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7347 + 1; /* safety byte */
7348 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7349 memset(fmtObj, 0, approxSize);
7350 fmtObj->size = approxSize;
7351 fmtObj->maxPos = 0;
7352 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7353 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7354 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7355 buffer = fmtObj->stringRep + maxFmtLen + 1;
7356 objPtr->internalRep.ptr = fmtObj;
7357 objPtr->typePtr = &scanFmtStringObjType;
7358 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7359 int width=0, skip;
7360 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7361 fmtObj->count++;
7362 descr->width = 0; /* Assume width unspecified */
7363 /* Overread and store any "literal" prefix */
7364 if (*fmt != '%' || fmt[1] == '%') {
7365 descr->type = 0;
7366 descr->prefix = &buffer[i];
7367 for (; fmt < fmtEnd; ++fmt) {
7368 if (*fmt == '%') {
7369 if (fmt[1] != '%') break;
7370 ++fmt;
7371 }
7372 buffer[i++] = *fmt;
7373 }
7374 buffer[i++] = 0;
7375 }
7376 /* Skip the conversion introducing '%' sign */
7377 ++fmt;
7378 /* End reached due to non-conversion literal only? */
7379 if (fmt >= fmtEnd)
7380 goto done;
7381 descr->pos = 0; /* Assume "natural" positioning */
7382 if (*fmt == '*') {
7383 descr->pos = -1; /* Okay, conversion will not be assigned */
7384 ++fmt;
7385 } else
7386 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7387 /* Check if next token is a number (could be width or pos */
7388 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7389 fmt += skip;
7390 /* Was the number a XPG3 position specifier? */
7391 if (descr->pos != -1 && *fmt == '$') {
7392 int prev;
7393 ++fmt;
7394 descr->pos = width;
7395 width = 0;
7396 /* Look if "natural" postioning and XPG3 one was mixed */
7397 if ((lastPos == 0 && descr->pos > 0)
7398 || (lastPos > 0 && descr->pos == 0)) {
7399 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7400 return JIM_ERR;
7401 }
7402 /* Look if this position was already used */
7403 for (prev=0; prev < curr; ++prev) {
7404 if (fmtObj->descr[prev].pos == -1) continue;
7405 if (fmtObj->descr[prev].pos == descr->pos) {
7406 fmtObj->error = "same \"%n$\" conversion specifier "
7407 "used more than once";
7408 return JIM_ERR;
7409 }
7410 }
7411 /* Try to find a width after the XPG3 specifier */
7412 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7413 descr->width = width;
7414 fmt += skip;
7415 }
7416 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7417 fmtObj->maxPos = descr->pos;
7418 } else {
7419 /* Number was not a XPG3, so it has to be a width */
7420 descr->width = width;
7421 }
7422 }
7423 /* If positioning mode was undetermined yet, fix this */
7424 if (lastPos == -1)
7425 lastPos = descr->pos;
7426 /* Handle CHARSET conversion type ... */
7427 if (*fmt == '[') {
7428 int swapped = 1, beg = i, end, j;
7429 descr->type = '[';
7430 descr->arg = &buffer[i];
7431 ++fmt;
7432 if (*fmt == '^') buffer[i++] = *fmt++;
7433 if (*fmt == ']') buffer[i++] = *fmt++;
7434 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7435 if (*fmt != ']') {
7436 fmtObj->error = "unmatched [ in format string";
7437 return JIM_ERR;
7438 }
7439 end = i;
7440 buffer[i++] = 0;
7441 /* In case a range fence was given "backwards", swap it */
7442 while (swapped) {
7443 swapped = 0;
7444 for (j=beg+1; j < end-1; ++j) {
7445 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7446 char tmp = buffer[j-1];
7447 buffer[j-1] = buffer[j+1];
7448 buffer[j+1] = tmp;
7449 swapped = 1;
7450 }
7451 }
7452 }
7453 } else {
7454 /* Remember any valid modifier if given */
7455 if (strchr("hlL", *fmt) != 0)
7456 descr->modifier = tolower((int)*fmt++);
7457
7458 descr->type = *fmt;
7459 if (strchr("efgcsndoxui", *fmt) == 0) {
7460 fmtObj->error = "bad scan conversion character";
7461 return JIM_ERR;
7462 } else if (*fmt == 'c' && descr->width != 0) {
7463 fmtObj->error = "field width may not be specified in %c "
7464 "conversion";
7465 return JIM_ERR;
7466 } else if (*fmt == 'u' && descr->modifier == 'l') {
7467 fmtObj->error = "unsigned wide not supported";
7468 return JIM_ERR;
7469 }
7470 }
7471 curr++;
7472 }
7473 done:
7474 if (fmtObj->convCount == 0) {
7475 fmtObj->error = "no any conversion specifier given";
7476 return JIM_ERR;
7477 }
7478 return JIM_OK;
7479 }
7480
7481 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7482
7483 #define FormatGetCnvCount(_fo_) \
7484 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7485 #define FormatGetMaxPos(_fo_) \
7486 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7487 #define FormatGetError(_fo_) \
7488 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7489
7490 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7491 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7492 * bitvector implementation in Jim? */
7493
7494 static int JimTestBit(const char *bitvec, char ch)
7495 {
7496 div_t pos = div(ch-1, 8);
7497 return bitvec[pos.quot] & (1 << pos.rem);
7498 }
7499
7500 static void JimSetBit(char *bitvec, char ch)
7501 {
7502 div_t pos = div(ch-1, 8);
7503 bitvec[pos.quot] |= (1 << pos.rem);
7504 }
7505
7506 #if 0 /* currently not used */
7507 static void JimClearBit(char *bitvec, char ch)
7508 {
7509 div_t pos = div(ch-1, 8);
7510 bitvec[pos.quot] &= ~(1 << pos.rem);
7511 }
7512 #endif
7513
7514 /* JimScanAString is used to scan an unspecified string that ends with
7515 * next WS, or a string that is specified via a charset. The charset
7516 * is currently implemented in a way to only allow for usage with
7517 * ASCII. Whenever we will switch to UNICODE, another idea has to
7518 * be born :-/
7519 *
7520 * FIXME: Works only with ASCII */
7521
7522 static Jim_Obj *
7523 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7524 {
7525 size_t i;
7526 Jim_Obj *result;
7527 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7528 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7529
7530 /* First init charset to nothing or all, depending if a specified
7531 * or an unspecified string has to be parsed */
7532 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7533 if (sdescr) {
7534 /* There was a set description given, that means we are parsing
7535 * a specified string. So we have to build a corresponding
7536 * charset reflecting the description */
7537 int notFlag = 0;
7538 /* Should the set be negated at the end? */
7539 if (*sdescr == '^') {
7540 notFlag = 1;
7541 ++sdescr;
7542 }
7543 /* Here '-' is meant literally and not to define a range */
7544 if (*sdescr == '-') {
7545 JimSetBit(charset, '-');
7546 ++sdescr;
7547 }
7548 while (*sdescr) {
7549 if (sdescr[1] == '-' && sdescr[2] != 0) {
7550 /* Handle range definitions */
7551 int i;
7552 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7553 JimSetBit(charset, (char)i);
7554 sdescr += 3;
7555 } else {
7556 /* Handle verbatim character definitions */
7557 JimSetBit(charset, *sdescr++);
7558 }
7559 }
7560 /* Negate the charset if there was a NOT given */
7561 for (i=0; notFlag && i < sizeof(charset); ++i)
7562 charset[i] = ~charset[i];
7563 }
7564 /* And after all the mess above, the real work begin ... */
7565 while (str && *str) {
7566 if (!sdescr && isspace((int)*str))
7567 break; /* EOS via WS if unspecified */
7568 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7569 else break; /* EOS via mismatch if specified scanning */
7570 }
7571 *buffer = 0; /* Close the string properly ... */
7572 result = Jim_NewStringObj(interp, anchor, -1);
7573 Jim_Free(anchor); /* ... and free it afer usage */
7574 return result;
7575 }
7576
7577 /* ScanOneEntry will scan one entry out of the string passed as argument.
7578 * It use the sscanf() function for this task. After extracting and
7579 * converting of the value, the count of scanned characters will be
7580 * returned of -1 in case of no conversion tool place and string was
7581 * already scanned thru */
7582
7583 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7584 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7585 {
7586 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7587 ? sizeof(jim_wide) \
7588 : sizeof(double))
7589 char buffer[MAX_SIZE];
7590 char *value = buffer;
7591 const char *tok;
7592 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7593 size_t sLen = strlen(&str[pos]), scanned = 0;
7594 size_t anchor = pos;
7595 int i;
7596
7597 /* First pessimiticly assume, we will not scan anything :-) */
7598 *valObjPtr = 0;
7599 if (descr->prefix) {
7600 /* There was a prefix given before the conversion, skip it and adjust
7601 * the string-to-be-parsed accordingly */
7602 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7603 /* If prefix require, skip WS */
7604 if (isspace((int)descr->prefix[i]))
7605 while (str[pos] && isspace((int)str[pos])) ++pos;
7606 else if (descr->prefix[i] != str[pos])
7607 break; /* Prefix do not match here, leave the loop */
7608 else
7609 ++pos; /* Prefix matched so far, next round */
7610 }
7611 if (str[pos] == 0)
7612 return -1; /* All of str consumed: EOF condition */
7613 else if (descr->prefix[i] != 0)
7614 return 0; /* Not whole prefix consumed, no conversion possible */
7615 }
7616 /* For all but following conversion, skip leading WS */
7617 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7618 while (isspace((int)str[pos])) ++pos;
7619 /* Determine how much skipped/scanned so far */
7620 scanned = pos - anchor;
7621 if (descr->type == 'n') {
7622 /* Return pseudo conversion means: how much scanned so far? */
7623 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7624 } else if (str[pos] == 0) {
7625 /* Cannot scan anything, as str is totally consumed */
7626 return -1;
7627 } else {
7628 /* Processing of conversions follows ... */
7629 if (descr->width > 0) {
7630 /* Do not try to scan as fas as possible but only the given width.
7631 * To ensure this, we copy the part that should be scanned. */
7632 size_t tLen = descr->width > sLen ? sLen : descr->width;
7633 tok = Jim_StrDupLen(&str[pos], tLen);
7634 } else {
7635 /* As no width was given, simply refer to the original string */
7636 tok = &str[pos];
7637 }
7638 switch (descr->type) {
7639 case 'c':
7640 *valObjPtr = Jim_NewIntObj(interp, *tok);
7641 scanned += 1;
7642 break;
7643 case 'd': case 'o': case 'x': case 'u': case 'i': {
7644 char *endp; /* Position where the number finished */
7645 int base = descr->type == 'o' ? 8
7646 : descr->type == 'x' ? 16
7647 : descr->type == 'i' ? 0
7648 : 10;
7649
7650 do {
7651 /* Try to scan a number with the given base */
7652 if (descr->modifier == 'l')
7653 #ifdef HAVE_LONG_LONG
7654 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7655 #else
7656 *(jim_wide*)value = strtol(tok, &endp, base);
7657 #endif
7658 else
7659 if (descr->type == 'u')
7660 *(long*)value = strtoul(tok, &endp, base);
7661 else
7662 *(long*)value = strtol(tok, &endp, base);
7663 /* If scanning failed, and base was undetermined, simply
7664 * put it to 10 and try once more. This should catch the
7665 * case where %i begin to parse a number prefix (e.g.
7666 * '0x' but no further digits follows. This will be
7667 * handled as a ZERO followed by a char 'x' by Tcl */
7668 if (endp == tok && base == 0) base = 10;
7669 else break;
7670 } while (1);
7671 if (endp != tok) {
7672 /* There was some number sucessfully scanned! */
7673 if (descr->modifier == 'l')
7674 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7675 else
7676 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7677 /* Adjust the number-of-chars scanned so far */
7678 scanned += endp - tok;
7679 } else {
7680 /* Nothing was scanned. We have to determine if this
7681 * happened due to e.g. prefix mismatch or input str
7682 * exhausted */
7683 scanned = *tok ? 0 : -1;
7684 }
7685 break;
7686 }
7687 case 's': case '[': {
7688 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7689 scanned += Jim_Length(*valObjPtr);
7690 break;
7691 }
7692 case 'e': case 'f': case 'g': {
7693 char *endp;
7694
7695 *(double*)value = strtod(tok, &endp);
7696 if (endp != tok) {
7697 /* There was some number sucessfully scanned! */
7698 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7699 /* Adjust the number-of-chars scanned so far */
7700 scanned += endp - tok;
7701 } else {
7702 /* Nothing was scanned. We have to determine if this
7703 * happened due to e.g. prefix mismatch or input str
7704 * exhausted */
7705 scanned = *tok ? 0 : -1;
7706 }
7707 break;
7708 }
7709 }
7710 /* If a substring was allocated (due to pre-defined width) do not
7711 * forget to free it */
7712 if (tok != &str[pos])
7713 Jim_Free((char*)tok);
7714 }
7715 return scanned;
7716 }
7717
7718 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7719 * string and returns all converted (and not ignored) values in a list back
7720 * to the caller. If an error occured, a NULL pointer will be returned */
7721
7722 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7723 Jim_Obj *fmtObjPtr, int flags)
7724 {
7725 size_t i, pos;
7726 int scanned = 1;
7727 const char *str = Jim_GetString(strObjPtr, 0);
7728 Jim_Obj *resultList = 0;
7729 Jim_Obj **resultVec;
7730 int resultc;
7731 Jim_Obj *emptyStr = 0;
7732 ScanFmtStringObj *fmtObj;
7733
7734 /* If format specification is not an object, convert it! */
7735 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7736 SetScanFmtFromAny(interp, fmtObjPtr);
7737 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7738 /* Check if format specification was valid */
7739 if (fmtObj->error != 0) {
7740 if (flags & JIM_ERRMSG)
7741 Jim_SetResultString(interp, fmtObj->error, -1);
7742 return 0;
7743 }
7744 /* Allocate a new "shared" empty string for all unassigned conversions */
7745 emptyStr = Jim_NewEmptyStringObj(interp);
7746 Jim_IncrRefCount(emptyStr);
7747 /* Create a list and fill it with empty strings up to max specified XPG3 */
7748 resultList = Jim_NewListObj(interp, 0, 0);
7749 if (fmtObj->maxPos > 0) {
7750 for (i=0; i < fmtObj->maxPos; ++i)
7751 Jim_ListAppendElement(interp, resultList, emptyStr);
7752 JimListGetElements(interp, resultList, &resultc, &resultVec);
7753 }
7754 /* Now handle every partial format description */
7755 for (i=0, pos=0; i < fmtObj->count; ++i) {
7756 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7757 Jim_Obj *value = 0;
7758 /* Only last type may be "literal" w/o conversion - skip it! */
7759 if (descr->type == 0) continue;
7760 /* As long as any conversion could be done, we will proceed */
7761 if (scanned > 0)
7762 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7763 /* In case our first try results in EOF, we will leave */
7764 if (scanned == -1 && i == 0)
7765 goto eof;
7766 /* Advance next pos-to-be-scanned for the amount scanned already */
7767 pos += scanned;
7768 /* value == 0 means no conversion took place so take empty string */
7769 if (value == 0)
7770 value = Jim_NewEmptyStringObj(interp);
7771 /* If value is a non-assignable one, skip it */
7772 if (descr->pos == -1) {
7773 Jim_FreeNewObj(interp, value);
7774 } else if (descr->pos == 0)
7775 /* Otherwise append it to the result list if no XPG3 was given */
7776 Jim_ListAppendElement(interp, resultList, value);
7777 else if (resultVec[descr->pos-1] == emptyStr) {
7778 /* But due to given XPG3, put the value into the corr. slot */
7779 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7780 Jim_IncrRefCount(value);
7781 resultVec[descr->pos-1] = value;
7782 } else {
7783 /* Otherwise, the slot was already used - free obj and ERROR */
7784 Jim_FreeNewObj(interp, value);
7785 goto err;
7786 }
7787 }
7788 Jim_DecrRefCount(interp, emptyStr);
7789 return resultList;
7790 eof:
7791 Jim_DecrRefCount(interp, emptyStr);
7792 Jim_FreeNewObj(interp, resultList);
7793 return (Jim_Obj*)EOF;
7794 err:
7795 Jim_DecrRefCount(interp, emptyStr);
7796 Jim_FreeNewObj(interp, resultList);
7797 return 0;
7798 }
7799
7800 /* -----------------------------------------------------------------------------
7801 * Pseudo Random Number Generation
7802 * ---------------------------------------------------------------------------*/
7803 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7804 int seedLen);
7805
7806 /* Initialize the sbox with the numbers from 0 to 255 */
7807 static void JimPrngInit(Jim_Interp *interp)
7808 {
7809 int i;
7810 unsigned int seed[256];
7811
7812 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7813 for (i = 0; i < 256; i++)
7814 seed[i] = (rand() ^ time(NULL) ^ clock());
7815 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7816 }
7817
7818 /* Generates N bytes of random data */
7819 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7820 {
7821 Jim_PrngState *prng;
7822 unsigned char *destByte = (unsigned char*) dest;
7823 unsigned int si, sj, x;
7824
7825 /* initialization, only needed the first time */
7826 if (interp->prngState == NULL)
7827 JimPrngInit(interp);
7828 prng = interp->prngState;
7829 /* generates 'len' bytes of pseudo-random numbers */
7830 for (x = 0; x < len; x++) {
7831 prng->i = (prng->i+1) & 0xff;
7832 si = prng->sbox[prng->i];
7833 prng->j = (prng->j + si) & 0xff;
7834 sj = prng->sbox[prng->j];
7835 prng->sbox[prng->i] = sj;
7836 prng->sbox[prng->j] = si;
7837 *destByte++ = prng->sbox[(si+sj)&0xff];
7838 }
7839 }
7840
7841 /* Re-seed the generator with user-provided bytes */
7842 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7843 int seedLen)
7844 {
7845 int i;
7846 unsigned char buf[256];
7847 Jim_PrngState *prng;
7848
7849 /* initialization, only needed the first time */
7850 if (interp->prngState == NULL)
7851 JimPrngInit(interp);
7852 prng = interp->prngState;
7853
7854 /* Set the sbox[i] with i */
7855 for (i = 0; i < 256; i++)
7856 prng->sbox[i] = i;
7857 /* Now use the seed to perform a random permutation of the sbox */
7858 for (i = 0; i < seedLen; i++) {
7859 unsigned char t;
7860
7861 t = prng->sbox[i&0xFF];
7862 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7863 prng->sbox[seed[i]] = t;
7864 }
7865 prng->i = prng->j = 0;
7866 /* discard the first 256 bytes of stream. */
7867 JimRandomBytes(interp, buf, 256);
7868 }
7869
7870 /* -----------------------------------------------------------------------------
7871 * Dynamic libraries support (WIN32 not supported)
7872 * ---------------------------------------------------------------------------*/
7873
7874 #ifdef JIM_DYNLIB
7875 #ifdef WIN32
7876 #define RTLD_LAZY 0
7877 void * dlopen(const char *path, int mode)
7878 {
7879 JIM_NOTUSED(mode);
7880
7881 return (void *)LoadLibraryA(path);
7882 }
7883 int dlclose(void *handle)
7884 {
7885 FreeLibrary((HANDLE)handle);
7886 return 0;
7887 }
7888 void *dlsym(void *handle, const char *symbol)
7889 {
7890 return GetProcAddress((HMODULE)handle, symbol);
7891 }
7892 static char win32_dlerror_string[121];
7893 const char *dlerror(void)
7894 {
7895 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7896 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7897 return win32_dlerror_string;
7898 }
7899 #endif /* WIN32 */
7900
7901 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7902 {
7903 Jim_Obj *libPathObjPtr;
7904 int prefixc, i;
7905 void *handle;
7906 int (*onload)(Jim_Interp *interp);
7907
7908 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7909 if (libPathObjPtr == NULL) {
7910 prefixc = 0;
7911 libPathObjPtr = NULL;
7912 } else {
7913 Jim_IncrRefCount(libPathObjPtr);
7914 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7915 }
7916
7917 for (i = -1; i < prefixc; i++) {
7918 if (i < 0) {
7919 handle = dlopen(pathName, RTLD_LAZY);
7920 } else {
7921 FILE *fp;
7922 char buf[JIM_PATH_LEN];
7923 const char *prefix;
7924 int prefixlen;
7925 Jim_Obj *prefixObjPtr;
7926
7927 buf[0] = '\0';
7928 if (Jim_ListIndex(interp, libPathObjPtr, i,
7929 &prefixObjPtr, JIM_NONE) != JIM_OK)
7930 continue;
7931 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7932 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7933 continue;
7934 if (*pathName == '/') {
7935 strcpy(buf, pathName);
7936 }
7937 else if (prefixlen && prefix[prefixlen-1] == '/')
7938 sprintf(buf, "%s%s", prefix, pathName);
7939 else
7940 sprintf(buf, "%s/%s", prefix, pathName);
7941 fp = fopen(buf, "r");
7942 if (fp == NULL)
7943 continue;
7944 fclose(fp);
7945 handle = dlopen(buf, RTLD_LAZY);
7946 }
7947 if (handle == NULL) {
7948 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7949 Jim_AppendStrings(interp, Jim_GetResult(interp),
7950 "error loading extension \"", pathName,
7951 "\": ", dlerror(), NULL);
7952 if (i < 0)
7953 continue;
7954 goto err;
7955 }
7956 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7957 Jim_SetResultString(interp,
7958 "No Jim_OnLoad symbol found on extension", -1);
7959 goto err;
7960 }
7961 if (onload(interp) == JIM_ERR) {
7962 dlclose(handle);
7963 goto err;
7964 }
7965 Jim_SetEmptyResult(interp);
7966 if (libPathObjPtr != NULL)
7967 Jim_DecrRefCount(interp, libPathObjPtr);
7968 return JIM_OK;
7969 }
7970 err:
7971 if (libPathObjPtr != NULL)
7972 Jim_DecrRefCount(interp, libPathObjPtr);
7973 return JIM_ERR;
7974 }
7975 #else /* JIM_DYNLIB */
7976 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7977 {
7978 JIM_NOTUSED(interp);
7979 JIM_NOTUSED(pathName);
7980
7981 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7982 return JIM_ERR;
7983 }
7984 #endif/* JIM_DYNLIB */
7985
7986 /* -----------------------------------------------------------------------------
7987 * Packages handling
7988 * ---------------------------------------------------------------------------*/
7989
7990 #define JIM_PKG_ANY_VERSION -1
7991
7992 /* Convert a string of the type "1.2" into an integer.
7993 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7994 * to the integer with value 102 */
7995 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7996 int *intPtr, int flags)
7997 {
7998 char *copy;
7999 jim_wide major, minor;
8000 char *majorStr, *minorStr, *p;
8001
8002 if (v[0] == '\0') {
8003 *intPtr = JIM_PKG_ANY_VERSION;
8004 return JIM_OK;
8005 }
8006
8007 copy = Jim_StrDup(v);
8008 p = strchr(copy, '.');
8009 if (p == NULL) goto badfmt;
8010 *p = '\0';
8011 majorStr = copy;
8012 minorStr = p+1;
8013
8014 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8015 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8016 goto badfmt;
8017 *intPtr = (int)(major*100+minor);
8018 Jim_Free(copy);
8019 return JIM_OK;
8020
8021 badfmt:
8022 Jim_Free(copy);
8023 if (flags & JIM_ERRMSG) {
8024 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8025 Jim_AppendStrings(interp, Jim_GetResult(interp),
8026 "invalid package version '", v, "'", NULL);
8027 }
8028 return JIM_ERR;
8029 }
8030
8031 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8032 static int JimPackageMatchVersion(int needed, int actual, int flags)
8033 {
8034 if (needed == JIM_PKG_ANY_VERSION) return 1;
8035 if (flags & JIM_MATCHVER_EXACT) {
8036 return needed == actual;
8037 } else {
8038 return needed/100 == actual/100 && (needed <= actual);
8039 }
8040 }
8041
8042 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8043 int flags)
8044 {
8045 int intVersion;
8046 /* Check if the version format is ok */
8047 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8048 return JIM_ERR;
8049 /* If the package was already provided returns an error. */
8050 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8051 if (flags & JIM_ERRMSG) {
8052 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8053 Jim_AppendStrings(interp, Jim_GetResult(interp),
8054 "package '", name, "' was already provided", NULL);
8055 }
8056 return JIM_ERR;
8057 }
8058 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8059 return JIM_OK;
8060 }
8061
8062 #ifndef JIM_ANSIC
8063
8064 #ifndef WIN32
8065 # include <sys/types.h>
8066 # include <dirent.h>
8067 #else
8068 # include <io.h>
8069 /* Posix dirent.h compatiblity layer for WIN32.
8070 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8071 * Copyright Salvatore Sanfilippo ,2005.
8072 *
8073 * Permission to use, copy, modify, and distribute this software and its
8074 * documentation for any purpose is hereby granted without fee, provided
8075 * that this copyright and permissions notice appear in all copies and
8076 * derivatives.
8077 *
8078 * This software is supplied "as is" without express or implied warranty.
8079 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8080 */
8081
8082 struct dirent {
8083 char *d_name;
8084 };
8085
8086 typedef struct DIR {
8087 long handle; /* -1 for failed rewind */
8088 struct _finddata_t info;
8089 struct dirent result; /* d_name null iff first time */
8090 char *name; /* null-terminated char string */
8091 } DIR;
8092
8093 DIR *opendir(const char *name)
8094 {
8095 DIR *dir = 0;
8096
8097 if(name && name[0]) {
8098 size_t base_length = strlen(name);
8099 const char *all = /* search pattern must end with suitable wildcard */
8100 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8101
8102 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8103 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8104 {
8105 strcat(strcpy(dir->name, name), all);
8106
8107 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8108 dir->result.d_name = 0;
8109 else { /* rollback */
8110 Jim_Free(dir->name);
8111 Jim_Free(dir);
8112 dir = 0;
8113 }
8114 } else { /* rollback */
8115 Jim_Free(dir);
8116 dir = 0;
8117 errno = ENOMEM;
8118 }
8119 } else {
8120 errno = EINVAL;
8121 }
8122 return dir;
8123 }
8124
8125 int closedir(DIR *dir)
8126 {
8127 int result = -1;
8128
8129 if(dir) {
8130 if(dir->handle != -1)
8131 result = _findclose(dir->handle);
8132 Jim_Free(dir->name);
8133 Jim_Free(dir);
8134 }
8135 if(result == -1) /* map all errors to EBADF */
8136 errno = EBADF;
8137 return result;
8138 }
8139
8140 struct dirent *readdir(DIR *dir)
8141 {
8142 struct dirent *result = 0;
8143
8144 if(dir && dir->handle != -1) {
8145 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8146 result = &dir->result;
8147 result->d_name = dir->info.name;
8148 }
8149 } else {
8150 errno = EBADF;
8151 }
8152 return result;
8153 }
8154
8155 #endif /* WIN32 */
8156
8157 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8158 int prefixc, const char *pkgName, int pkgVer, int flags)
8159 {
8160 int bestVer = -1, i;
8161 int pkgNameLen = strlen(pkgName);
8162 char *bestPackage = NULL;
8163 struct dirent *de;
8164
8165 for (i = 0; i < prefixc; i++) {
8166 DIR *dir;
8167 char buf[JIM_PATH_LEN];
8168 int prefixLen;
8169
8170 if (prefixes[i] == NULL) continue;
8171 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8172 buf[JIM_PATH_LEN-1] = '\0';
8173 prefixLen = strlen(buf);
8174 if (prefixLen && buf[prefixLen-1] == '/')
8175 buf[prefixLen-1] = '\0';
8176
8177 if ((dir = opendir(buf)) == NULL) continue;
8178 while ((de = readdir(dir)) != NULL) {
8179 char *fileName = de->d_name;
8180 int fileNameLen = strlen(fileName);
8181
8182 if (strncmp(fileName, "jim-", 4) == 0 &&
8183 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8184 *(fileName+4+pkgNameLen) == '-' &&
8185 fileNameLen > 4 && /* note that this is not really useful */
8186 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8187 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8188 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8189 {
8190 char ver[6]; /* xx.yy<nulterm> */
8191 char *p = strrchr(fileName, '.');
8192 int verLen, fileVer;
8193
8194 verLen = p - (fileName+4+pkgNameLen+1);
8195 if (verLen < 3 || verLen > 5) continue;
8196 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8197 ver[verLen] = '\0';
8198 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8199 != JIM_OK) continue;
8200 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8201 (bestVer == -1 || bestVer < fileVer))
8202 {
8203 bestVer = fileVer;
8204 Jim_Free(bestPackage);
8205 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8206 sprintf(bestPackage, "%s/%s", buf, fileName);
8207 }
8208 }
8209 }
8210 closedir(dir);
8211 }
8212 return bestPackage;
8213 }
8214
8215 #else /* JIM_ANSIC */
8216
8217 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8218 int prefixc, const char *pkgName, int pkgVer, int flags)
8219 {
8220 JIM_NOTUSED(interp);
8221 JIM_NOTUSED(prefixes);
8222 JIM_NOTUSED(prefixc);
8223 JIM_NOTUSED(pkgName);
8224 JIM_NOTUSED(pkgVer);
8225 JIM_NOTUSED(flags);
8226 return NULL;
8227 }
8228
8229 #endif /* JIM_ANSIC */
8230
8231 /* Search for a suitable package under every dir specified by jim_libpath
8232 * and load it if possible. If a suitable package was loaded with success
8233 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8234 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8235 int flags)
8236 {
8237 Jim_Obj *libPathObjPtr;
8238 char **prefixes, *best;
8239 int prefixc, i, retCode = JIM_OK;
8240
8241 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8242 if (libPathObjPtr == NULL) {
8243 prefixc = 0;
8244 libPathObjPtr = NULL;
8245 } else {
8246 Jim_IncrRefCount(libPathObjPtr);
8247 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8248 }
8249
8250 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8251 for (i = 0; i < prefixc; i++) {
8252 Jim_Obj *prefixObjPtr;
8253 if (Jim_ListIndex(interp, libPathObjPtr, i,
8254 &prefixObjPtr, JIM_NONE) != JIM_OK)
8255 {
8256 prefixes[i] = NULL;
8257 continue;
8258 }
8259 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8260 }
8261 /* Scan every directory to find the "best" package. */
8262 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8263 if (best != NULL) {
8264 char *p = strrchr(best, '.');
8265 /* Try to load/source it */
8266 if (p && strcmp(p, ".tcl") == 0) {
8267 retCode = Jim_EvalFile(interp, best);
8268 } else {
8269 retCode = Jim_LoadLibrary(interp, best);
8270 }
8271 } else {
8272 retCode = JIM_ERR;
8273 }
8274 Jim_Free(best);
8275 for (i = 0; i < prefixc; i++)
8276 Jim_Free(prefixes[i]);
8277 Jim_Free(prefixes);
8278 if (libPathObjPtr)
8279 Jim_DecrRefCount(interp, libPathObjPtr);
8280 return retCode;
8281 }
8282
8283 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8284 const char *ver, int flags)
8285 {
8286 Jim_HashEntry *he;
8287 int requiredVer;
8288
8289 /* Start with an empty error string */
8290 Jim_SetResultString(interp, "", 0);
8291
8292 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8293 return NULL;
8294 he = Jim_FindHashEntry(&interp->packages, name);
8295 if (he == NULL) {
8296 /* Try to load the package. */
8297 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8298 he = Jim_FindHashEntry(&interp->packages, name);
8299 if (he == NULL) {
8300 return "?";
8301 }
8302 return he->val;
8303 }
8304 /* No way... return an error. */
8305 if (flags & JIM_ERRMSG) {
8306 int len;
8307 Jim_GetString(Jim_GetResult(interp), &len);
8308 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8309 "Can't find package '", name, "'", NULL);
8310 }
8311 return NULL;
8312 } else {
8313 int actualVer;
8314 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8315 != JIM_OK)
8316 {
8317 return NULL;
8318 }
8319 /* Check if version matches. */
8320 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8321 Jim_AppendStrings(interp, Jim_GetResult(interp),
8322 "Package '", name, "' already loaded, but with version ",
8323 he->val, NULL);
8324 return NULL;
8325 }
8326 return he->val;
8327 }
8328 }
8329
8330 /* -----------------------------------------------------------------------------
8331 * Eval
8332 * ---------------------------------------------------------------------------*/
8333 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8334 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8335
8336 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8337 Jim_Obj *const *argv);
8338
8339 /* Handle calls to the [unknown] command */
8340 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8341 {
8342 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8343 int retCode;
8344
8345 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8346 * done here
8347 */
8348 if (interp->unknown_called) {
8349 return JIM_ERR;
8350 }
8351
8352 /* If the [unknown] command does not exists returns
8353 * just now */
8354 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8355 return JIM_ERR;
8356
8357 /* The object interp->unknown just contains
8358 * the "unknown" string, it is used in order to
8359 * avoid to lookup the unknown command every time
8360 * but instread to cache the result. */
8361 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8362 v = sv;
8363 else
8364 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8365 /* Make a copy of the arguments vector, but shifted on
8366 * the right of one position. The command name of the
8367 * command will be instead the first argument of the
8368 * [unknonw] call. */
8369 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8370 v[0] = interp->unknown;
8371 /* Call it */
8372 interp->unknown_called++;
8373 retCode = Jim_EvalObjVector(interp, argc+1, v);
8374 interp->unknown_called--;
8375
8376 /* Clean up */
8377 if (v != sv)
8378 Jim_Free(v);
8379 return retCode;
8380 }
8381
8382 /* Eval the object vector 'objv' composed of 'objc' elements.
8383 * Every element is used as single argument.
8384 * Jim_EvalObj() will call this function every time its object
8385 * argument is of "list" type, with no string representation.
8386 *
8387 * This is possible because the string representation of a
8388 * list object generated by the UpdateStringOfList is made
8389 * in a way that ensures that every list element is a different
8390 * command argument. */
8391 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8392 {
8393 int i, retcode;
8394 Jim_Cmd *cmdPtr;
8395
8396 /* Incr refcount of arguments. */
8397 for (i = 0; i < objc; i++)
8398 Jim_IncrRefCount(objv[i]);
8399 /* Command lookup */
8400 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8401 if (cmdPtr == NULL) {
8402 retcode = JimUnknown(interp, objc, objv);
8403 } else {
8404 /* Call it -- Make sure result is an empty object. */
8405 Jim_SetEmptyResult(interp);
8406 if (cmdPtr->cmdProc) {
8407 interp->cmdPrivData = cmdPtr->privData;
8408 retcode = cmdPtr->cmdProc(interp, objc, objv);
8409 if (retcode == JIM_ERR_ADDSTACK) {
8410 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8411 retcode = JIM_ERR;
8412 }
8413 } else {
8414 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8415 if (retcode == JIM_ERR) {
8416 JimAppendStackTrace(interp,
8417 Jim_GetString(objv[0], NULL), "", 1);
8418 }
8419 }
8420 }
8421 /* Decr refcount of arguments and return the retcode */
8422 for (i = 0; i < objc; i++)
8423 Jim_DecrRefCount(interp, objv[i]);
8424 return retcode;
8425 }
8426
8427 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8428 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8429 * The returned object has refcount = 0. */
8430 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8431 int tokens, Jim_Obj **objPtrPtr)
8432 {
8433 int totlen = 0, i, retcode;
8434 Jim_Obj **intv;
8435 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8436 Jim_Obj *objPtr;
8437 char *s;
8438
8439 if (tokens <= JIM_EVAL_SINTV_LEN)
8440 intv = sintv;
8441 else
8442 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8443 tokens);
8444 /* Compute every token forming the argument
8445 * in the intv objects vector. */
8446 for (i = 0; i < tokens; i++) {
8447 switch(token[i].type) {
8448 case JIM_TT_ESC:
8449 case JIM_TT_STR:
8450 intv[i] = token[i].objPtr;
8451 break;
8452 case JIM_TT_VAR:
8453 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8454 if (!intv[i]) {
8455 retcode = JIM_ERR;
8456 goto err;
8457 }
8458 break;
8459 case JIM_TT_DICTSUGAR:
8460 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8461 if (!intv[i]) {
8462 retcode = JIM_ERR;
8463 goto err;
8464 }
8465 break;
8466 case JIM_TT_CMD:
8467 retcode = Jim_EvalObj(interp, token[i].objPtr);
8468 if (retcode != JIM_OK)
8469 goto err;
8470 intv[i] = Jim_GetResult(interp);
8471 break;
8472 default:
8473 Jim_Panic(interp,
8474 "default token type reached "
8475 "in Jim_InterpolateTokens().");
8476 break;
8477 }
8478 Jim_IncrRefCount(intv[i]);
8479 /* Make sure there is a valid
8480 * string rep, and add the string
8481 * length to the total legnth. */
8482 Jim_GetString(intv[i], NULL);
8483 totlen += intv[i]->length;
8484 }
8485 /* Concatenate every token in an unique
8486 * object. */
8487 objPtr = Jim_NewStringObjNoAlloc(interp,
8488 NULL, 0);
8489 s = objPtr->bytes = Jim_Alloc(totlen+1);
8490 objPtr->length = totlen;
8491 for (i = 0; i < tokens; i++) {
8492 memcpy(s, intv[i]->bytes, intv[i]->length);
8493 s += intv[i]->length;
8494 Jim_DecrRefCount(interp, intv[i]);
8495 }
8496 objPtr->bytes[totlen] = '\0';
8497 /* Free the intv vector if not static. */
8498 if (tokens > JIM_EVAL_SINTV_LEN)
8499 Jim_Free(intv);
8500 *objPtrPtr = objPtr;
8501 return JIM_OK;
8502 err:
8503 i--;
8504 for (; i >= 0; i--)
8505 Jim_DecrRefCount(interp, intv[i]);
8506 if (tokens > JIM_EVAL_SINTV_LEN)
8507 Jim_Free(intv);
8508 return retcode;
8509 }
8510
8511 /* Helper of Jim_EvalObj() to perform argument expansion.
8512 * Basically this function append an argument to 'argv'
8513 * (and increments argc by reference accordingly), performing
8514 * expansion of the list object if 'expand' is non-zero, or
8515 * just adding objPtr to argv if 'expand' is zero. */
8516 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8517 int *argcPtr, int expand, Jim_Obj *objPtr)
8518 {
8519 if (!expand) {
8520 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8521 /* refcount of objPtr not incremented because
8522 * we are actually transfering a reference from
8523 * the old 'argv' to the expanded one. */
8524 (*argv)[*argcPtr] = objPtr;
8525 (*argcPtr)++;
8526 } else {
8527 int len, i;
8528
8529 Jim_ListLength(interp, objPtr, &len);
8530 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8531 for (i = 0; i < len; i++) {
8532 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8533 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8534 (*argcPtr)++;
8535 }
8536 /* The original object reference is no longer needed,
8537 * after the expansion it is no longer present on
8538 * the argument vector, but the single elements are
8539 * in its place. */
8540 Jim_DecrRefCount(interp, objPtr);
8541 }
8542 }
8543
8544 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8545 {
8546 int i, j = 0, len;
8547 ScriptObj *script;
8548 ScriptToken *token;
8549 int *cs; /* command structure array */
8550 int retcode = JIM_OK;
8551 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8552
8553 interp->errorFlag = 0;
8554
8555 /* If the object is of type "list" and there is no
8556 * string representation for this object, we can call
8557 * a specialized version of Jim_EvalObj() */
8558 if (scriptObjPtr->typePtr == &listObjType &&
8559 scriptObjPtr->internalRep.listValue.len &&
8560 scriptObjPtr->bytes == NULL) {
8561 Jim_IncrRefCount(scriptObjPtr);
8562 retcode = Jim_EvalObjVector(interp,
8563 scriptObjPtr->internalRep.listValue.len,
8564 scriptObjPtr->internalRep.listValue.ele);
8565 Jim_DecrRefCount(interp, scriptObjPtr);
8566 return retcode;
8567 }
8568
8569 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8570 script = Jim_GetScript(interp, scriptObjPtr);
8571 /* Now we have to make sure the internal repr will not be
8572 * freed on shimmering.
8573 *
8574 * Think for example to this:
8575 *
8576 * set x {llength $x; ... some more code ...}; eval $x
8577 *
8578 * In order to preserve the internal rep, we increment the
8579 * inUse field of the script internal rep structure. */
8580 script->inUse++;
8581
8582 token = script->token;
8583 len = script->len;
8584 cs = script->cmdStruct;
8585 i = 0; /* 'i' is the current token index. */
8586
8587 /* Reset the interpreter result. This is useful to
8588 * return the emtpy result in the case of empty program. */
8589 Jim_SetEmptyResult(interp);
8590
8591 /* Execute every command sequentially, returns on
8592 * error (i.e. if a command does not return JIM_OK) */
8593 while (i < len) {
8594 int expand = 0;
8595 int argc = *cs++; /* Get the number of arguments */
8596 Jim_Cmd *cmd;
8597
8598 /* Set the expand flag if needed. */
8599 if (argc == -1) {
8600 expand++;
8601 argc = *cs++;
8602 }
8603 /* Allocate the arguments vector */
8604 if (argc <= JIM_EVAL_SARGV_LEN)
8605 argv = sargv;
8606 else
8607 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8608 /* Populate the arguments objects. */
8609 for (j = 0; j < argc; j++) {
8610 int tokens = *cs++;
8611
8612 /* tokens is negative if expansion is needed.
8613 * for this argument. */
8614 if (tokens < 0) {
8615 tokens = (-tokens)-1;
8616 i++;
8617 }
8618 if (tokens == 1) {
8619 /* Fast path if the token does not
8620 * need interpolation */
8621 switch(token[i].type) {
8622 case JIM_TT_ESC:
8623 case JIM_TT_STR:
8624 argv[j] = token[i].objPtr;
8625 break;
8626 case JIM_TT_VAR:
8627 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8628 JIM_ERRMSG);
8629 if (!tmpObjPtr) {
8630 retcode = JIM_ERR;
8631 goto err;
8632 }
8633 argv[j] = tmpObjPtr;
8634 break;
8635 case JIM_TT_DICTSUGAR:
8636 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8637 if (!tmpObjPtr) {
8638 retcode = JIM_ERR;
8639 goto err;
8640 }
8641 argv[j] = tmpObjPtr;
8642 break;
8643 case JIM_TT_CMD:
8644 retcode = Jim_EvalObj(interp, token[i].objPtr);
8645 if (retcode != JIM_OK)
8646 goto err;
8647 argv[j] = Jim_GetResult(interp);
8648 break;
8649 default:
8650 Jim_Panic(interp,
8651 "default token type reached "
8652 "in Jim_EvalObj().");
8653 break;
8654 }
8655 Jim_IncrRefCount(argv[j]);
8656 i += 2;
8657 } else {
8658 /* For interpolation we call an helper
8659 * function doing the work for us. */
8660 if ((retcode = Jim_InterpolateTokens(interp,
8661 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8662 {
8663 goto err;
8664 }
8665 argv[j] = tmpObjPtr;
8666 Jim_IncrRefCount(argv[j]);
8667 i += tokens+1;
8668 }
8669 }
8670 /* Handle {expand} expansion */
8671 if (expand) {
8672 int *ecs = cs - argc;
8673 int eargc = 0;
8674 Jim_Obj **eargv = NULL;
8675
8676 for (j = 0; j < argc; j++) {
8677 Jim_ExpandArgument( interp, &eargv, &eargc,
8678 ecs[j] < 0, argv[j]);
8679 }
8680 if (argv != sargv)
8681 Jim_Free(argv);
8682 argc = eargc;
8683 argv = eargv;
8684 j = argc;
8685 if (argc == 0) {
8686 /* Nothing to do with zero args. */
8687 Jim_Free(eargv);
8688 continue;
8689 }
8690 }
8691 /* Lookup the command to call */
8692 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8693 if (cmd != NULL) {
8694 /* Call it -- Make sure result is an empty object. */
8695 Jim_SetEmptyResult(interp);
8696 if (cmd->cmdProc) {
8697 interp->cmdPrivData = cmd->privData;
8698 retcode = cmd->cmdProc(interp, argc, argv);
8699 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8700 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8701 retcode = JIM_ERR;
8702 }
8703 } else {
8704 retcode = JimCallProcedure(interp, cmd, argc, argv);
8705 if (retcode == JIM_ERR) {
8706 JimAppendStackTrace(interp,
8707 Jim_GetString(argv[0], NULL), script->fileName,
8708 token[i-argc*2].linenr);
8709 }
8710 }
8711 } else {
8712 /* Call [unknown] */
8713 retcode = JimUnknown(interp, argc, argv);
8714 if (retcode == JIM_ERR) {
8715 JimAppendStackTrace(interp,
8716 "", script->fileName,
8717 token[i-argc*2].linenr);
8718 }
8719 }
8720 if (retcode != JIM_OK) {
8721 i -= argc*2; /* point to the command name. */
8722 goto err;
8723 }
8724 /* Decrement the arguments count */
8725 for (j = 0; j < argc; j++) {
8726 Jim_DecrRefCount(interp, argv[j]);
8727 }
8728
8729 if (argv != sargv) {
8730 Jim_Free(argv);
8731 argv = NULL;
8732 }
8733 }
8734 /* Note that we don't have to decrement inUse, because the
8735 * following code transfers our use of the reference again to
8736 * the script object. */
8737 j = 0; /* on normal termination, the argv array is already
8738 Jim_DecrRefCount-ed. */
8739 err:
8740 /* Handle errors. */
8741 if (retcode == JIM_ERR && !interp->errorFlag) {
8742 interp->errorFlag = 1;
8743 JimSetErrorFileName(interp, script->fileName);
8744 JimSetErrorLineNumber(interp, token[i].linenr);
8745 JimResetStackTrace(interp);
8746 }
8747 Jim_FreeIntRep(interp, scriptObjPtr);
8748 scriptObjPtr->typePtr = &scriptObjType;
8749 Jim_SetIntRepPtr(scriptObjPtr, script);
8750 Jim_DecrRefCount(interp, scriptObjPtr);
8751 for (i = 0; i < j; i++) {
8752 Jim_DecrRefCount(interp, argv[i]);
8753 }
8754 if (argv != sargv)
8755 Jim_Free(argv);
8756 return retcode;
8757 }
8758
8759 /* Call a procedure implemented in Tcl.
8760 * It's possible to speed-up a lot this function, currently
8761 * the callframes are not cached, but allocated and
8762 * destroied every time. What is expecially costly is
8763 * to create/destroy the local vars hash table every time.
8764 *
8765 * This can be fixed just implementing callframes caching
8766 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8767 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8768 Jim_Obj *const *argv)
8769 {
8770 int i, retcode;
8771 Jim_CallFrame *callFramePtr;
8772 int num_args;
8773
8774 /* Check arity */
8775 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8776 argc > cmd->arityMax)) {
8777 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8778 Jim_AppendStrings(interp, objPtr,
8779 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8780 (cmd->arityMin > 1) ? " " : "",
8781 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8782 Jim_SetResult(interp, objPtr);
8783 return JIM_ERR;
8784 }
8785 /* Check if there are too nested calls */
8786 if (interp->numLevels == interp->maxNestingDepth) {
8787 Jim_SetResultString(interp,
8788 "Too many nested calls. Infinite recursion?", -1);
8789 return JIM_ERR;
8790 }
8791 /* Create a new callframe */
8792 callFramePtr = JimCreateCallFrame(interp);
8793 callFramePtr->parentCallFrame = interp->framePtr;
8794 callFramePtr->argv = argv;
8795 callFramePtr->argc = argc;
8796 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8797 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8798 callFramePtr->staticVars = cmd->staticVars;
8799 Jim_IncrRefCount(cmd->argListObjPtr);
8800 Jim_IncrRefCount(cmd->bodyObjPtr);
8801 interp->framePtr = callFramePtr;
8802 interp->numLevels ++;
8803
8804 /* Set arguments */
8805 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8806
8807 /* If last argument is 'args', don't set it here */
8808 if (cmd->arityMax == -1) {
8809 num_args--;
8810 }
8811
8812 for (i = 0; i < num_args; i++) {
8813 Jim_Obj *argObjPtr;
8814 Jim_Obj *nameObjPtr;
8815 Jim_Obj *valueObjPtr;
8816
8817 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8818 if (i + 1 >= cmd->arityMin) {
8819 /* The name is the first element of the list */
8820 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8821 }
8822 else {
8823 /* The element arg is the name */
8824 nameObjPtr = argObjPtr;
8825 }
8826
8827 if (i + 1 >= argc) {
8828 /* No more values, so use default */
8829 /* The value is the second element of the list */
8830 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8831 }
8832 else {
8833 valueObjPtr = argv[i+1];
8834 }
8835 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8836 }
8837 /* Set optional arguments */
8838 if (cmd->arityMax == -1) {
8839 Jim_Obj *listObjPtr, *objPtr;
8840
8841 i++;
8842 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8843 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8844 Jim_SetVariable(interp, objPtr, listObjPtr);
8845 }
8846 /* Eval the body */
8847 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8848
8849 /* Destroy the callframe */
8850 interp->numLevels --;
8851 interp->framePtr = interp->framePtr->parentCallFrame;
8852 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8853 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8854 } else {
8855 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8856 }
8857 /* Handle the JIM_EVAL return code */
8858 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8859 int savedLevel = interp->evalRetcodeLevel;
8860
8861 interp->evalRetcodeLevel = interp->numLevels;
8862 while (retcode == JIM_EVAL) {
8863 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8864 Jim_IncrRefCount(resultScriptObjPtr);
8865 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8866 Jim_DecrRefCount(interp, resultScriptObjPtr);
8867 }
8868 interp->evalRetcodeLevel = savedLevel;
8869 }
8870 /* Handle the JIM_RETURN return code */
8871 if (retcode == JIM_RETURN) {
8872 retcode = interp->returnCode;
8873 interp->returnCode = JIM_OK;
8874 }
8875 return retcode;
8876 }
8877
8878 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8879 {
8880 int retval;
8881 Jim_Obj *scriptObjPtr;
8882
8883 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8884 Jim_IncrRefCount(scriptObjPtr);
8885
8886
8887 if( filename ){
8888 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8889 }
8890
8891 retval = Jim_EvalObj(interp, scriptObjPtr);
8892 Jim_DecrRefCount(interp, scriptObjPtr);
8893 return retval;
8894 }
8895
8896 int Jim_Eval(Jim_Interp *interp, const char *script)
8897 {
8898 return Jim_Eval_Named( interp, script, NULL, 0 );
8899 }
8900
8901
8902
8903 /* Execute script in the scope of the global level */
8904 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8905 {
8906 Jim_CallFrame *savedFramePtr;
8907 int retval;
8908
8909 savedFramePtr = interp->framePtr;
8910 interp->framePtr = interp->topFramePtr;
8911 retval = Jim_Eval(interp, script);
8912 interp->framePtr = savedFramePtr;
8913 return retval;
8914 }
8915
8916 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8917 {
8918 Jim_CallFrame *savedFramePtr;
8919 int retval;
8920
8921 savedFramePtr = interp->framePtr;
8922 interp->framePtr = interp->topFramePtr;
8923 retval = Jim_EvalObj(interp, scriptObjPtr);
8924 interp->framePtr = savedFramePtr;
8925 /* Try to report the error (if any) via the bgerror proc */
8926 if (retval != JIM_OK) {
8927 Jim_Obj *objv[2];
8928
8929 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8930 objv[1] = Jim_GetResult(interp);
8931 Jim_IncrRefCount(objv[0]);
8932 Jim_IncrRefCount(objv[1]);
8933 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8934 /* Report the error to stderr. */
8935 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8936 Jim_PrintErrorMessage(interp);
8937 }
8938 Jim_DecrRefCount(interp, objv[0]);
8939 Jim_DecrRefCount(interp, objv[1]);
8940 }
8941 return retval;
8942 }
8943
8944 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8945 {
8946 char *prg = NULL;
8947 FILE *fp;
8948 int nread, totread, maxlen, buflen;
8949 int retval;
8950 Jim_Obj *scriptObjPtr;
8951
8952 if ((fp = fopen(filename, "r")) == NULL) {
8953 const int cwd_len=2048;
8954 char *cwd=malloc(cwd_len);
8955 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8956 getcwd( cwd, cwd_len );
8957 Jim_AppendStrings(interp, Jim_GetResult(interp),
8958 "Error loading script \"", filename, "\"",
8959 " cwd: ", cwd,
8960 " err: ", strerror(errno), NULL);
8961 free(cwd);
8962 return JIM_ERR;
8963 }
8964 buflen = 1024;
8965 maxlen = totread = 0;
8966 while (1) {
8967 if (maxlen < totread+buflen+1) {
8968 maxlen = totread+buflen+1;
8969 prg = Jim_Realloc(prg, maxlen);
8970 }
8971 /* do not use Jim_fread() - this is really a file */
8972 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8973 totread += nread;
8974 }
8975 prg[totread] = '\0';
8976 /* do not use Jim_fclose() - this is really a file */
8977 fclose(fp);
8978
8979 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8980 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8981 Jim_IncrRefCount(scriptObjPtr);
8982 retval = Jim_EvalObj(interp, scriptObjPtr);
8983 Jim_DecrRefCount(interp, scriptObjPtr);
8984 return retval;
8985 }
8986
8987 /* -----------------------------------------------------------------------------
8988 * Subst
8989 * ---------------------------------------------------------------------------*/
8990 static int JimParseSubstStr(struct JimParserCtx *pc)
8991 {
8992 pc->tstart = pc->p;
8993 pc->tline = pc->linenr;
8994 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8995 pc->p++; pc->len--;
8996 }
8997 pc->tend = pc->p-1;
8998 pc->tt = JIM_TT_ESC;
8999 return JIM_OK;
9000 }
9001
9002 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9003 {
9004 int retval;
9005
9006 if (pc->len == 0) {
9007 pc->tstart = pc->tend = pc->p;
9008 pc->tline = pc->linenr;
9009 pc->tt = JIM_TT_EOL;
9010 pc->eof = 1;
9011 return JIM_OK;
9012 }
9013 switch(*pc->p) {
9014 case '[':
9015 retval = JimParseCmd(pc);
9016 if (flags & JIM_SUBST_NOCMD) {
9017 pc->tstart--;
9018 pc->tend++;
9019 pc->tt = (flags & JIM_SUBST_NOESC) ?
9020 JIM_TT_STR : JIM_TT_ESC;
9021 }
9022 return retval;
9023 break;
9024 case '$':
9025 if (JimParseVar(pc) == JIM_ERR) {
9026 pc->tstart = pc->tend = pc->p++; pc->len--;
9027 pc->tline = pc->linenr;
9028 pc->tt = JIM_TT_STR;
9029 } else {
9030 if (flags & JIM_SUBST_NOVAR) {
9031 pc->tstart--;
9032 if (flags & JIM_SUBST_NOESC)
9033 pc->tt = JIM_TT_STR;
9034 else
9035 pc->tt = JIM_TT_ESC;
9036 if (*pc->tstart == '{') {
9037 pc->tstart--;
9038 if (*(pc->tend+1))
9039 pc->tend++;
9040 }
9041 }
9042 }
9043 break;
9044 default:
9045 retval = JimParseSubstStr(pc);
9046 if (flags & JIM_SUBST_NOESC)
9047 pc->tt = JIM_TT_STR;
9048 return retval;
9049 break;
9050 }
9051 return JIM_OK;
9052 }
9053
9054 /* The subst object type reuses most of the data structures and functions
9055 * of the script object. Script's data structures are a bit more complex
9056 * for what is needed for [subst]itution tasks, but the reuse helps to
9057 * deal with a single data structure at the cost of some more memory
9058 * usage for substitutions. */
9059 static Jim_ObjType substObjType = {
9060 "subst",
9061 FreeScriptInternalRep,
9062 DupScriptInternalRep,
9063 NULL,
9064 JIM_TYPE_REFERENCES,
9065 };
9066
9067 /* This method takes the string representation of an object
9068 * as a Tcl string where to perform [subst]itution, and generates
9069 * the pre-parsed internal representation. */
9070 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9071 {
9072 int scriptTextLen;
9073 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9074 struct JimParserCtx parser;
9075 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9076
9077 script->len = 0;
9078 script->csLen = 0;
9079 script->commands = 0;
9080 script->token = NULL;
9081 script->cmdStruct = NULL;
9082 script->inUse = 1;
9083 script->substFlags = flags;
9084 script->fileName = NULL;
9085
9086 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9087 while(1) {
9088 char *token;
9089 int len, type, linenr;
9090
9091 JimParseSubst(&parser, flags);
9092 if (JimParserEof(&parser)) break;
9093 token = JimParserGetToken(&parser, &len, &type, &linenr);
9094 ScriptObjAddToken(interp, script, token, len, type,
9095 NULL, linenr);
9096 }
9097 /* Free the old internal rep and set the new one. */
9098 Jim_FreeIntRep(interp, objPtr);
9099 Jim_SetIntRepPtr(objPtr, script);
9100 objPtr->typePtr = &scriptObjType;
9101 return JIM_OK;
9102 }
9103
9104 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9105 {
9106 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9107
9108 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9109 SetSubstFromAny(interp, objPtr, flags);
9110 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9111 }
9112
9113 /* Performs commands,variables,blackslashes substitution,
9114 * storing the result object (with refcount 0) into
9115 * resObjPtrPtr. */
9116 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9117 Jim_Obj **resObjPtrPtr, int flags)
9118 {
9119 ScriptObj *script;
9120 ScriptToken *token;
9121 int i, len, retcode = JIM_OK;
9122 Jim_Obj *resObjPtr, *savedResultObjPtr;
9123
9124 script = Jim_GetSubst(interp, substObjPtr, flags);
9125 #ifdef JIM_OPTIMIZATION
9126 /* Fast path for a very common case with array-alike syntax,
9127 * that's: $foo($bar) */
9128 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9129 Jim_Obj *varObjPtr = script->token[0].objPtr;
9130
9131 Jim_IncrRefCount(varObjPtr);
9132 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9133 if (resObjPtr == NULL) {
9134 Jim_DecrRefCount(interp, varObjPtr);
9135 return JIM_ERR;
9136 }
9137 Jim_DecrRefCount(interp, varObjPtr);
9138 *resObjPtrPtr = resObjPtr;
9139 return JIM_OK;
9140 }
9141 #endif
9142
9143 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9144 /* In order to preserve the internal rep, we increment the
9145 * inUse field of the script internal rep structure. */
9146 script->inUse++;
9147
9148 token = script->token;
9149 len = script->len;
9150
9151 /* Save the interp old result, to set it again before
9152 * to return. */
9153 savedResultObjPtr = interp->result;
9154 Jim_IncrRefCount(savedResultObjPtr);
9155
9156 /* Perform the substitution. Starts with an empty object
9157 * and adds every token (performing the appropriate
9158 * var/command/escape substitution). */
9159 resObjPtr = Jim_NewStringObj(interp, "", 0);
9160 for (i = 0; i < len; i++) {
9161 Jim_Obj *objPtr;
9162
9163 switch(token[i].type) {
9164 case JIM_TT_STR:
9165 case JIM_TT_ESC:
9166 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9167 break;
9168 case JIM_TT_VAR:
9169 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9170 if (objPtr == NULL) goto err;
9171 Jim_IncrRefCount(objPtr);
9172 Jim_AppendObj(interp, resObjPtr, objPtr);
9173 Jim_DecrRefCount(interp, objPtr);
9174 break;
9175 case JIM_TT_DICTSUGAR:
9176 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9177 if (!objPtr) {
9178 retcode = JIM_ERR;
9179 goto err;
9180 }
9181 break;
9182 case JIM_TT_CMD:
9183 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9184 goto err;
9185 Jim_AppendObj(interp, resObjPtr, interp->result);
9186 break;
9187 default:
9188 Jim_Panic(interp,
9189 "default token type (%d) reached "
9190 "in Jim_SubstObj().", token[i].type);
9191 break;
9192 }
9193 }
9194 ok:
9195 if (retcode == JIM_OK)
9196 Jim_SetResult(interp, savedResultObjPtr);
9197 Jim_DecrRefCount(interp, savedResultObjPtr);
9198 /* Note that we don't have to decrement inUse, because the
9199 * following code transfers our use of the reference again to
9200 * the script object. */
9201 Jim_FreeIntRep(interp, substObjPtr);
9202 substObjPtr->typePtr = &scriptObjType;
9203 Jim_SetIntRepPtr(substObjPtr, script);
9204 Jim_DecrRefCount(interp, substObjPtr);
9205 *resObjPtrPtr = resObjPtr;
9206 return retcode;
9207 err:
9208 Jim_FreeNewObj(interp, resObjPtr);
9209 retcode = JIM_ERR;
9210 goto ok;
9211 }
9212
9213 /* -----------------------------------------------------------------------------
9214 * API Input/Export functions
9215 * ---------------------------------------------------------------------------*/
9216
9217 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9218 {
9219 Jim_HashEntry *he;
9220
9221 he = Jim_FindHashEntry(&interp->stub, funcname);
9222 if (!he)
9223 return JIM_ERR;
9224 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9225 return JIM_OK;
9226 }
9227
9228 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9229 {
9230 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9231 }
9232
9233 #define JIM_REGISTER_API(name) \
9234 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9235
9236 void JimRegisterCoreApi(Jim_Interp *interp)
9237 {
9238 interp->getApiFuncPtr = Jim_GetApi;
9239 JIM_REGISTER_API(Alloc);
9240 JIM_REGISTER_API(Free);
9241 JIM_REGISTER_API(Eval);
9242 JIM_REGISTER_API(Eval_Named);
9243 JIM_REGISTER_API(EvalGlobal);
9244 JIM_REGISTER_API(EvalFile);
9245 JIM_REGISTER_API(EvalObj);
9246 JIM_REGISTER_API(EvalObjBackground);
9247 JIM_REGISTER_API(EvalObjVector);
9248 JIM_REGISTER_API(InitHashTable);
9249 JIM_REGISTER_API(ExpandHashTable);
9250 JIM_REGISTER_API(AddHashEntry);
9251 JIM_REGISTER_API(ReplaceHashEntry);
9252 JIM_REGISTER_API(DeleteHashEntry);
9253 JIM_REGISTER_API(FreeHashTable);
9254 JIM_REGISTER_API(FindHashEntry);
9255 JIM_REGISTER_API(ResizeHashTable);
9256 JIM_REGISTER_API(GetHashTableIterator);
9257 JIM_REGISTER_API(NextHashEntry);
9258 JIM_REGISTER_API(NewObj);
9259 JIM_REGISTER_API(FreeObj);
9260 JIM_REGISTER_API(InvalidateStringRep);
9261 JIM_REGISTER_API(InitStringRep);
9262 JIM_REGISTER_API(DuplicateObj);
9263 JIM_REGISTER_API(GetString);
9264 JIM_REGISTER_API(Length);
9265 JIM_REGISTER_API(InvalidateStringRep);
9266 JIM_REGISTER_API(NewStringObj);
9267 JIM_REGISTER_API(NewStringObjNoAlloc);
9268 JIM_REGISTER_API(AppendString);
9269 JIM_REGISTER_API(AppendString_sprintf);
9270 JIM_REGISTER_API(AppendObj);
9271 JIM_REGISTER_API(AppendStrings);
9272 JIM_REGISTER_API(StringEqObj);
9273 JIM_REGISTER_API(StringMatchObj);
9274 JIM_REGISTER_API(StringRangeObj);
9275 JIM_REGISTER_API(FormatString);
9276 JIM_REGISTER_API(CompareStringImmediate);
9277 JIM_REGISTER_API(NewReference);
9278 JIM_REGISTER_API(GetReference);
9279 JIM_REGISTER_API(SetFinalizer);
9280 JIM_REGISTER_API(GetFinalizer);
9281 JIM_REGISTER_API(CreateInterp);
9282 JIM_REGISTER_API(FreeInterp);
9283 JIM_REGISTER_API(GetExitCode);
9284 JIM_REGISTER_API(SetStdin);
9285 JIM_REGISTER_API(SetStdout);
9286 JIM_REGISTER_API(SetStderr);
9287 JIM_REGISTER_API(CreateCommand);
9288 JIM_REGISTER_API(CreateProcedure);
9289 JIM_REGISTER_API(DeleteCommand);
9290 JIM_REGISTER_API(RenameCommand);
9291 JIM_REGISTER_API(GetCommand);
9292 JIM_REGISTER_API(SetVariable);
9293 JIM_REGISTER_API(SetVariableStr);
9294 JIM_REGISTER_API(SetGlobalVariableStr);
9295 JIM_REGISTER_API(SetVariableStrWithStr);
9296 JIM_REGISTER_API(SetVariableLink);
9297 JIM_REGISTER_API(GetVariable);
9298 JIM_REGISTER_API(GetCallFrameByLevel);
9299 JIM_REGISTER_API(Collect);
9300 JIM_REGISTER_API(CollectIfNeeded);
9301 JIM_REGISTER_API(GetIndex);
9302 JIM_REGISTER_API(NewListObj);
9303 JIM_REGISTER_API(ListAppendElement);
9304 JIM_REGISTER_API(ListAppendList);
9305 JIM_REGISTER_API(ListLength);
9306 JIM_REGISTER_API(ListIndex);
9307 JIM_REGISTER_API(SetListIndex);
9308 JIM_REGISTER_API(ConcatObj);
9309 JIM_REGISTER_API(NewDictObj);
9310 JIM_REGISTER_API(DictKey);
9311 JIM_REGISTER_API(DictKeysVector);
9312 JIM_REGISTER_API(GetIndex);
9313 JIM_REGISTER_API(GetReturnCode);
9314 JIM_REGISTER_API(EvalExpression);
9315 JIM_REGISTER_API(GetBoolFromExpr);
9316 JIM_REGISTER_API(GetWide);
9317 JIM_REGISTER_API(GetLong);
9318 JIM_REGISTER_API(SetWide);
9319 JIM_REGISTER_API(NewIntObj);
9320 JIM_REGISTER_API(GetDouble);
9321 JIM_REGISTER_API(SetDouble);
9322 JIM_REGISTER_API(NewDoubleObj);
9323 JIM_REGISTER_API(WrongNumArgs);
9324 JIM_REGISTER_API(SetDictKeysVector);
9325 JIM_REGISTER_API(SubstObj);
9326 JIM_REGISTER_API(RegisterApi);
9327 JIM_REGISTER_API(PrintErrorMessage);
9328 JIM_REGISTER_API(InteractivePrompt);
9329 JIM_REGISTER_API(RegisterCoreCommands);
9330 JIM_REGISTER_API(GetSharedString);
9331 JIM_REGISTER_API(ReleaseSharedString);
9332 JIM_REGISTER_API(Panic);
9333 JIM_REGISTER_API(StrDup);
9334 JIM_REGISTER_API(UnsetVariable);
9335 JIM_REGISTER_API(GetVariableStr);
9336 JIM_REGISTER_API(GetGlobalVariable);
9337 JIM_REGISTER_API(GetGlobalVariableStr);
9338 JIM_REGISTER_API(GetAssocData);
9339 JIM_REGISTER_API(SetAssocData);
9340 JIM_REGISTER_API(DeleteAssocData);
9341 JIM_REGISTER_API(GetEnum);
9342 JIM_REGISTER_API(ScriptIsComplete);
9343 JIM_REGISTER_API(PackageRequire);
9344 JIM_REGISTER_API(PackageProvide);
9345 JIM_REGISTER_API(InitStack);
9346 JIM_REGISTER_API(FreeStack);
9347 JIM_REGISTER_API(StackLen);
9348 JIM_REGISTER_API(StackPush);
9349 JIM_REGISTER_API(StackPop);
9350 JIM_REGISTER_API(StackPeek);
9351 JIM_REGISTER_API(FreeStackElements);
9352 JIM_REGISTER_API(fprintf );
9353 JIM_REGISTER_API(vfprintf );
9354 JIM_REGISTER_API(fwrite );
9355 JIM_REGISTER_API(fread );
9356 JIM_REGISTER_API(fflush );
9357 JIM_REGISTER_API(fgets );
9358 JIM_REGISTER_API(GetNvp);
9359 JIM_REGISTER_API(Nvp_name2value);
9360 JIM_REGISTER_API(Nvp_name2value_simple);
9361 JIM_REGISTER_API(Nvp_name2value_obj);
9362 JIM_REGISTER_API(Nvp_name2value_nocase);
9363 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9364
9365 JIM_REGISTER_API(Nvp_value2name);
9366 JIM_REGISTER_API(Nvp_value2name_simple);
9367 JIM_REGISTER_API(Nvp_value2name_obj);
9368
9369 JIM_REGISTER_API(GetOpt_Setup);
9370 JIM_REGISTER_API(GetOpt_Debug);
9371 JIM_REGISTER_API(GetOpt_Obj);
9372 JIM_REGISTER_API(GetOpt_String);
9373 JIM_REGISTER_API(GetOpt_Double);
9374 JIM_REGISTER_API(GetOpt_Wide);
9375 JIM_REGISTER_API(GetOpt_Nvp);
9376 JIM_REGISTER_API(GetOpt_NvpUnknown);
9377 JIM_REGISTER_API(GetOpt_Enum);
9378
9379 JIM_REGISTER_API(Debug_ArgvString);
9380 JIM_REGISTER_API(SetResult_sprintf);
9381 JIM_REGISTER_API(SetResult_NvpUnknown);
9382
9383 }
9384
9385 /* -----------------------------------------------------------------------------
9386 * Core commands utility functions
9387 * ---------------------------------------------------------------------------*/
9388 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9389 const char *msg)
9390 {
9391 int i;
9392 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9393
9394 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9395 for (i = 0; i < argc; i++) {
9396 Jim_AppendObj(interp, objPtr, argv[i]);
9397 if (!(i+1 == argc && msg[0] == '\0'))
9398 Jim_AppendString(interp, objPtr, " ", 1);
9399 }
9400 Jim_AppendString(interp, objPtr, msg, -1);
9401 Jim_AppendString(interp, objPtr, "\"", 1);
9402 Jim_SetResult(interp, objPtr);
9403 }
9404
9405 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9406 {
9407 Jim_HashTableIterator *htiter;
9408 Jim_HashEntry *he;
9409 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9410 const char *pattern;
9411 int patternLen;
9412
9413 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9414 htiter = Jim_GetHashTableIterator(&interp->commands);
9415 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9416 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9417 strlen((const char*)he->key), 0))
9418 continue;
9419 Jim_ListAppendElement(interp, listObjPtr,
9420 Jim_NewStringObj(interp, he->key, -1));
9421 }
9422 Jim_FreeHashTableIterator(htiter);
9423 return listObjPtr;
9424 }
9425
9426 #define JIM_VARLIST_GLOBALS 0
9427 #define JIM_VARLIST_LOCALS 1
9428 #define JIM_VARLIST_VARS 2
9429
9430 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9431 int mode)
9432 {
9433 Jim_HashTableIterator *htiter;
9434 Jim_HashEntry *he;
9435 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9436 const char *pattern;
9437 int patternLen;
9438
9439 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9440 if (mode == JIM_VARLIST_GLOBALS) {
9441 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9442 } else {
9443 /* For [info locals], if we are at top level an emtpy list
9444 * is returned. I don't agree, but we aim at compatibility (SS) */
9445 if (mode == JIM_VARLIST_LOCALS &&
9446 interp->framePtr == interp->topFramePtr)
9447 return listObjPtr;
9448 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9449 }
9450 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9451 Jim_Var *varPtr = (Jim_Var*) he->val;
9452 if (mode == JIM_VARLIST_LOCALS) {
9453 if (varPtr->linkFramePtr != NULL)
9454 continue;
9455 }
9456 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9457 strlen((const char*)he->key), 0))
9458 continue;
9459 Jim_ListAppendElement(interp, listObjPtr,
9460 Jim_NewStringObj(interp, he->key, -1));
9461 }
9462 Jim_FreeHashTableIterator(htiter);
9463 return listObjPtr;
9464 }
9465
9466 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9467 Jim_Obj **objPtrPtr)
9468 {
9469 Jim_CallFrame *targetCallFrame;
9470
9471 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9472 != JIM_OK)
9473 return JIM_ERR;
9474 /* No proc call at toplevel callframe */
9475 if (targetCallFrame == interp->topFramePtr) {
9476 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9477 Jim_AppendStrings(interp, Jim_GetResult(interp),
9478 "bad level \"",
9479 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9480 return JIM_ERR;
9481 }
9482 *objPtrPtr = Jim_NewListObj(interp,
9483 targetCallFrame->argv,
9484 targetCallFrame->argc);
9485 return JIM_OK;
9486 }
9487
9488 /* -----------------------------------------------------------------------------
9489 * Core commands
9490 * ---------------------------------------------------------------------------*/
9491
9492 /* fake [puts] -- not the real puts, just for debugging. */
9493 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9494 Jim_Obj *const *argv)
9495 {
9496 const char *str;
9497 int len, nonewline = 0;
9498
9499 if (argc != 2 && argc != 3) {
9500 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9501 return JIM_ERR;
9502 }
9503 if (argc == 3) {
9504 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9505 {
9506 Jim_SetResultString(interp, "The second argument must "
9507 "be -nonewline", -1);
9508 return JIM_OK;
9509 } else {
9510 nonewline = 1;
9511 argv++;
9512 }
9513 }
9514 str = Jim_GetString(argv[1], &len);
9515 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9516 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9517 return JIM_OK;
9518 }
9519
9520 /* Helper for [+] and [*] */
9521 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9522 Jim_Obj *const *argv, int op)
9523 {
9524 jim_wide wideValue, res;
9525 double doubleValue, doubleRes;
9526 int i;
9527
9528 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9529
9530 for (i = 1; i < argc; i++) {
9531 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9532 goto trydouble;
9533 if (op == JIM_EXPROP_ADD)
9534 res += wideValue;
9535 else
9536 res *= wideValue;
9537 }
9538 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9539 return JIM_OK;
9540 trydouble:
9541 doubleRes = (double) res;
9542 for (;i < argc; i++) {
9543 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9544 return JIM_ERR;
9545 if (op == JIM_EXPROP_ADD)
9546 doubleRes += doubleValue;
9547 else
9548 doubleRes *= doubleValue;
9549 }
9550 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9551 return JIM_OK;
9552 }
9553
9554 /* Helper for [-] and [/] */
9555 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9556 Jim_Obj *const *argv, int op)
9557 {
9558 jim_wide wideValue, res = 0;
9559 double doubleValue, doubleRes = 0;
9560 int i = 2;
9561
9562 if (argc < 2) {
9563 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9564 return JIM_ERR;
9565 } else if (argc == 2) {
9566 /* The arity = 2 case is different. For [- x] returns -x,
9567 * while [/ x] returns 1/x. */
9568 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9569 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9570 JIM_OK)
9571 {
9572 return JIM_ERR;
9573 } else {
9574 if (op == JIM_EXPROP_SUB)
9575 doubleRes = -doubleValue;
9576 else
9577 doubleRes = 1.0/doubleValue;
9578 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9579 doubleRes));
9580 return JIM_OK;
9581 }
9582 }
9583 if (op == JIM_EXPROP_SUB) {
9584 res = -wideValue;
9585 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9586 } else {
9587 doubleRes = 1.0/wideValue;
9588 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9589 doubleRes));
9590 }
9591 return JIM_OK;
9592 } else {
9593 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9594 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9595 != JIM_OK) {
9596 return JIM_ERR;
9597 } else {
9598 goto trydouble;
9599 }
9600 }
9601 }
9602 for (i = 2; i < argc; i++) {
9603 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9604 doubleRes = (double) res;
9605 goto trydouble;
9606 }
9607 if (op == JIM_EXPROP_SUB)
9608 res -= wideValue;
9609 else
9610 res /= wideValue;
9611 }
9612 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9613 return JIM_OK;
9614 trydouble:
9615 for (;i < argc; i++) {
9616 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9617 return JIM_ERR;
9618 if (op == JIM_EXPROP_SUB)
9619 doubleRes -= doubleValue;
9620 else
9621 doubleRes /= doubleValue;
9622 }
9623 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9624 return JIM_OK;
9625 }
9626
9627
9628 /* [+] */
9629 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9630 Jim_Obj *const *argv)
9631 {
9632 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9633 }
9634
9635 /* [*] */
9636 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9637 Jim_Obj *const *argv)
9638 {
9639 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9640 }
9641
9642 /* [-] */
9643 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9644 Jim_Obj *const *argv)
9645 {
9646 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9647 }
9648
9649 /* [/] */
9650 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9651 Jim_Obj *const *argv)
9652 {
9653 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9654 }
9655
9656 /* [set] */
9657 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9658 Jim_Obj *const *argv)
9659 {
9660 if (argc != 2 && argc != 3) {
9661 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9662 return JIM_ERR;
9663 }
9664 if (argc == 2) {
9665 Jim_Obj *objPtr;
9666 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9667 if (!objPtr)
9668 return JIM_ERR;
9669 Jim_SetResult(interp, objPtr);
9670 return JIM_OK;
9671 }
9672 /* argc == 3 case. */
9673 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9674 return JIM_ERR;
9675 Jim_SetResult(interp, argv[2]);
9676 return JIM_OK;
9677 }
9678
9679 /* [unset] */
9680 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9681 Jim_Obj *const *argv)
9682 {
9683 int i;
9684
9685 if (argc < 2) {
9686 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9687 return JIM_ERR;
9688 }
9689 for (i = 1; i < argc; i++) {
9690 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9691 return JIM_ERR;
9692 }
9693 return JIM_OK;
9694 }
9695
9696 /* [incr] */
9697 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9698 Jim_Obj *const *argv)
9699 {
9700 jim_wide wideValue, increment = 1;
9701 Jim_Obj *intObjPtr;
9702
9703 if (argc != 2 && argc != 3) {
9704 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9705 return JIM_ERR;
9706 }
9707 if (argc == 3) {
9708 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9709 return JIM_ERR;
9710 }
9711 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9712 if (!intObjPtr) return JIM_ERR;
9713 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9714 return JIM_ERR;
9715 if (Jim_IsShared(intObjPtr)) {
9716 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9717 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9718 Jim_FreeNewObj(interp, intObjPtr);
9719 return JIM_ERR;
9720 }
9721 } else {
9722 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9723 /* The following step is required in order to invalidate the
9724 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9725 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9726 return JIM_ERR;
9727 }
9728 }
9729 Jim_SetResult(interp, intObjPtr);
9730 return JIM_OK;
9731 }
9732
9733 /* [while] */
9734 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9735 Jim_Obj *const *argv)
9736 {
9737 if (argc != 3) {
9738 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9739 return JIM_ERR;
9740 }
9741 /* Try to run a specialized version of while if the expression
9742 * is in one of the following forms:
9743 *
9744 * $a < CONST, $a < $b
9745 * $a <= CONST, $a <= $b
9746 * $a > CONST, $a > $b
9747 * $a >= CONST, $a >= $b
9748 * $a != CONST, $a != $b
9749 * $a == CONST, $a == $b
9750 * $a
9751 * !$a
9752 * CONST
9753 */
9754
9755 #ifdef JIM_OPTIMIZATION
9756 {
9757 ExprByteCode *expr;
9758 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9759 int exprLen, retval;
9760
9761 /* STEP 1 -- Check if there are the conditions to run the specialized
9762 * version of while */
9763
9764 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9765 if (expr->len <= 0 || expr->len > 3) goto noopt;
9766 switch(expr->len) {
9767 case 1:
9768 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9769 expr->opcode[0] != JIM_EXPROP_NUMBER)
9770 goto noopt;
9771 break;
9772 case 2:
9773 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9774 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9775 goto noopt;
9776 break;
9777 case 3:
9778 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9779 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9780 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9781 goto noopt;
9782 switch(expr->opcode[2]) {
9783 case JIM_EXPROP_LT:
9784 case JIM_EXPROP_LTE:
9785 case JIM_EXPROP_GT:
9786 case JIM_EXPROP_GTE:
9787 case JIM_EXPROP_NUMEQ:
9788 case JIM_EXPROP_NUMNE:
9789 /* nothing to do */
9790 break;
9791 default:
9792 goto noopt;
9793 }
9794 break;
9795 default:
9796 Jim_Panic(interp,
9797 "Unexpected default reached in Jim_WhileCoreCommand()");
9798 break;
9799 }
9800
9801 /* STEP 2 -- conditions meet. Initialization. Take different
9802 * branches for different expression lengths. */
9803 exprLen = expr->len;
9804
9805 if (exprLen == 1) {
9806 jim_wide wideValue;
9807
9808 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9809 varAObjPtr = expr->obj[0];
9810 Jim_IncrRefCount(varAObjPtr);
9811 } else {
9812 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9813 goto noopt;
9814 }
9815 while (1) {
9816 if (varAObjPtr) {
9817 if (!(objPtr =
9818 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9819 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9820 {
9821 Jim_DecrRefCount(interp, varAObjPtr);
9822 goto noopt;
9823 }
9824 }
9825 if (!wideValue) break;
9826 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9827 switch(retval) {
9828 case JIM_BREAK:
9829 if (varAObjPtr)
9830 Jim_DecrRefCount(interp, varAObjPtr);
9831 goto out;
9832 break;
9833 case JIM_CONTINUE:
9834 continue;
9835 break;
9836 default:
9837 if (varAObjPtr)
9838 Jim_DecrRefCount(interp, varAObjPtr);
9839 return retval;
9840 }
9841 }
9842 }
9843 if (varAObjPtr)
9844 Jim_DecrRefCount(interp, varAObjPtr);
9845 } else if (exprLen == 3) {
9846 jim_wide wideValueA, wideValueB, cmpRes = 0;
9847 int cmpType = expr->opcode[2];
9848
9849 varAObjPtr = expr->obj[0];
9850 Jim_IncrRefCount(varAObjPtr);
9851 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9852 varBObjPtr = expr->obj[1];
9853 Jim_IncrRefCount(varBObjPtr);
9854 } else {
9855 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9856 goto noopt;
9857 }
9858 while (1) {
9859 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9860 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9861 {
9862 Jim_DecrRefCount(interp, varAObjPtr);
9863 if (varBObjPtr)
9864 Jim_DecrRefCount(interp, varBObjPtr);
9865 goto noopt;
9866 }
9867 if (varBObjPtr) {
9868 if (!(objPtr =
9869 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9870 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9871 {
9872 Jim_DecrRefCount(interp, varAObjPtr);
9873 if (varBObjPtr)
9874 Jim_DecrRefCount(interp, varBObjPtr);
9875 goto noopt;
9876 }
9877 }
9878 switch(cmpType) {
9879 case JIM_EXPROP_LT:
9880 cmpRes = wideValueA < wideValueB; break;
9881 case JIM_EXPROP_LTE:
9882 cmpRes = wideValueA <= wideValueB; break;
9883 case JIM_EXPROP_GT:
9884 cmpRes = wideValueA > wideValueB; break;
9885 case JIM_EXPROP_GTE:
9886 cmpRes = wideValueA >= wideValueB; break;
9887 case JIM_EXPROP_NUMEQ:
9888 cmpRes = wideValueA == wideValueB; break;
9889 case JIM_EXPROP_NUMNE:
9890 cmpRes = wideValueA != wideValueB; break;
9891 }
9892 if (!cmpRes) break;
9893 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9894 switch(retval) {
9895 case JIM_BREAK:
9896 Jim_DecrRefCount(interp, varAObjPtr);
9897 if (varBObjPtr)
9898 Jim_DecrRefCount(interp, varBObjPtr);
9899 goto out;
9900 break;
9901 case JIM_CONTINUE:
9902 continue;
9903 break;
9904 default:
9905 Jim_DecrRefCount(interp, varAObjPtr);
9906 if (varBObjPtr)
9907 Jim_DecrRefCount(interp, varBObjPtr);
9908 return retval;
9909 }
9910 }
9911 }
9912 Jim_DecrRefCount(interp, varAObjPtr);
9913 if (varBObjPtr)
9914 Jim_DecrRefCount(interp, varBObjPtr);
9915 } else {
9916 /* TODO: case for len == 2 */
9917 goto noopt;
9918 }
9919 Jim_SetEmptyResult(interp);
9920 return JIM_OK;
9921 }
9922 noopt:
9923 #endif
9924
9925 /* The general purpose implementation of while starts here */
9926 while (1) {
9927 int boolean, retval;
9928
9929 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9930 &boolean)) != JIM_OK)
9931 return retval;
9932 if (!boolean) break;
9933 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9934 switch(retval) {
9935 case JIM_BREAK:
9936 goto out;
9937 break;
9938 case JIM_CONTINUE:
9939 continue;
9940 break;
9941 default:
9942 return retval;
9943 }
9944 }
9945 }
9946 out:
9947 Jim_SetEmptyResult(interp);
9948 return JIM_OK;
9949 }
9950
9951 /* [for] */
9952 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9953 Jim_Obj *const *argv)
9954 {
9955 int retval;
9956
9957 if (argc != 5) {
9958 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9959 return JIM_ERR;
9960 }
9961 /* Check if the for is on the form:
9962 * for {set i CONST} {$i < CONST} {incr i}
9963 * for {set i CONST} {$i < $j} {incr i}
9964 * for {set i CONST} {$i <= CONST} {incr i}
9965 * for {set i CONST} {$i <= $j} {incr i}
9966 * XXX: NOTE: if variable traces are implemented, this optimization
9967 * need to be modified to check for the proc epoch at every variable
9968 * update. */
9969 #ifdef JIM_OPTIMIZATION
9970 {
9971 ScriptObj *initScript, *incrScript;
9972 ExprByteCode *expr;
9973 jim_wide start, stop, currentVal;
9974 unsigned jim_wide procEpoch = interp->procEpoch;
9975 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9976 int cmpType;
9977 struct Jim_Cmd *cmdPtr;
9978
9979 /* Do it only if there aren't shared arguments */
9980 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9981 goto evalstart;
9982 initScript = Jim_GetScript(interp, argv[1]);
9983 expr = Jim_GetExpression(interp, argv[2]);
9984 incrScript = Jim_GetScript(interp, argv[3]);
9985
9986 /* Ensure proper lengths to start */
9987 if (initScript->len != 6) goto evalstart;
9988 if (incrScript->len != 4) goto evalstart;
9989 if (expr->len != 3) goto evalstart;
9990 /* Ensure proper token types. */
9991 if (initScript->token[2].type != JIM_TT_ESC ||
9992 initScript->token[4].type != JIM_TT_ESC ||
9993 incrScript->token[2].type != JIM_TT_ESC ||
9994 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9995 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9996 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9997 (expr->opcode[2] != JIM_EXPROP_LT &&
9998 expr->opcode[2] != JIM_EXPROP_LTE))
9999 goto evalstart;
10000 cmpType = expr->opcode[2];
10001 /* Initialization command must be [set] */
10002 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10003 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10004 goto evalstart;
10005 /* Update command must be incr */
10006 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10007 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10008 goto evalstart;
10009 /* set, incr, expression must be about the same variable */
10010 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10011 incrScript->token[2].objPtr, 0))
10012 goto evalstart;
10013 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10014 expr->obj[0], 0))
10015 goto evalstart;
10016 /* Check that the initialization and comparison are valid integers */
10017 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10018 goto evalstart;
10019 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10020 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10021 {
10022 goto evalstart;
10023 }
10024
10025 /* Initialization */
10026 varNamePtr = expr->obj[0];
10027 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10028 stopVarNamePtr = expr->obj[1];
10029 Jim_IncrRefCount(stopVarNamePtr);
10030 }
10031 Jim_IncrRefCount(varNamePtr);
10032
10033 /* --- OPTIMIZED FOR --- */
10034 /* Start to loop */
10035 objPtr = Jim_NewIntObj(interp, start);
10036 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10037 Jim_DecrRefCount(interp, varNamePtr);
10038 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10039 Jim_FreeNewObj(interp, objPtr);
10040 goto evalstart;
10041 }
10042 while (1) {
10043 /* === Check condition === */
10044 /* Common code: */
10045 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10046 if (objPtr == NULL ||
10047 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10048 {
10049 Jim_DecrRefCount(interp, varNamePtr);
10050 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10051 goto testcond;
10052 }
10053 /* Immediate or Variable? get the 'stop' value if the latter. */
10054 if (stopVarNamePtr) {
10055 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10056 if (objPtr == NULL ||
10057 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10058 {
10059 Jim_DecrRefCount(interp, varNamePtr);
10060 Jim_DecrRefCount(interp, stopVarNamePtr);
10061 goto testcond;
10062 }
10063 }
10064 if (cmpType == JIM_EXPROP_LT) {
10065 if (currentVal >= stop) break;
10066 } else {
10067 if (currentVal > stop) break;
10068 }
10069 /* Eval body */
10070 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10071 switch(retval) {
10072 case JIM_BREAK:
10073 if (stopVarNamePtr)
10074 Jim_DecrRefCount(interp, stopVarNamePtr);
10075 Jim_DecrRefCount(interp, varNamePtr);
10076 goto out;
10077 case JIM_CONTINUE:
10078 /* nothing to do */
10079 break;
10080 default:
10081 if (stopVarNamePtr)
10082 Jim_DecrRefCount(interp, stopVarNamePtr);
10083 Jim_DecrRefCount(interp, varNamePtr);
10084 return retval;
10085 }
10086 }
10087 /* If there was a change in procedures/command continue
10088 * with the usual [for] command implementation */
10089 if (procEpoch != interp->procEpoch) {
10090 if (stopVarNamePtr)
10091 Jim_DecrRefCount(interp, stopVarNamePtr);
10092 Jim_DecrRefCount(interp, varNamePtr);
10093 goto evalnext;
10094 }
10095 /* Increment */
10096 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10097 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10098 objPtr->internalRep.wideValue ++;
10099 Jim_InvalidateStringRep(objPtr);
10100 } else {
10101 Jim_Obj *auxObjPtr;
10102
10103 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10104 if (stopVarNamePtr)
10105 Jim_DecrRefCount(interp, stopVarNamePtr);
10106 Jim_DecrRefCount(interp, varNamePtr);
10107 goto evalnext;
10108 }
10109 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10110 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10111 if (stopVarNamePtr)
10112 Jim_DecrRefCount(interp, stopVarNamePtr);
10113 Jim_DecrRefCount(interp, varNamePtr);
10114 Jim_FreeNewObj(interp, auxObjPtr);
10115 goto evalnext;
10116 }
10117 }
10118 }
10119 if (stopVarNamePtr)
10120 Jim_DecrRefCount(interp, stopVarNamePtr);
10121 Jim_DecrRefCount(interp, varNamePtr);
10122 Jim_SetEmptyResult(interp);
10123 return JIM_OK;
10124 }
10125 #endif
10126 evalstart:
10127 /* Eval start */
10128 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10129 return retval;
10130 while (1) {
10131 int boolean;
10132 testcond:
10133 /* Test the condition */
10134 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10135 != JIM_OK)
10136 return retval;
10137 if (!boolean) break;
10138 /* Eval body */
10139 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10140 switch(retval) {
10141 case JIM_BREAK:
10142 goto out;
10143 break;
10144 case JIM_CONTINUE:
10145 /* Nothing to do */
10146 break;
10147 default:
10148 return retval;
10149 }
10150 }
10151 evalnext:
10152 /* Eval next */
10153 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10154 switch(retval) {
10155 case JIM_BREAK:
10156 goto out;
10157 break;
10158 case JIM_CONTINUE:
10159 continue;
10160 break;
10161 default:
10162 return retval;
10163 }
10164 }
10165 }
10166 out:
10167 Jim_SetEmptyResult(interp);
10168 return JIM_OK;
10169 }
10170
10171 /* foreach + lmap implementation. */
10172 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10173 Jim_Obj *const *argv, int doMap)
10174 {
10175 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10176 int nbrOfLoops = 0;
10177 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10178
10179 if (argc < 4 || argc % 2 != 0) {
10180 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10181 return JIM_ERR;
10182 }
10183 if (doMap) {
10184 mapRes = Jim_NewListObj(interp, NULL, 0);
10185 Jim_IncrRefCount(mapRes);
10186 }
10187 emptyStr = Jim_NewEmptyStringObj(interp);
10188 Jim_IncrRefCount(emptyStr);
10189 script = argv[argc-1]; /* Last argument is a script */
10190 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10191 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10192 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10193 /* Initialize iterators and remember max nbr elements each list */
10194 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10195 /* Remember lengths of all lists and calculate how much rounds to loop */
10196 for (i=0; i < nbrOfLists*2; i += 2) {
10197 div_t cnt;
10198 int count;
10199 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10200 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10201 if (listsEnd[i] == 0) {
10202 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10203 goto err;
10204 }
10205 cnt = div(listsEnd[i+1], listsEnd[i]);
10206 count = cnt.quot + (cnt.rem ? 1 : 0);
10207 if (count > nbrOfLoops)
10208 nbrOfLoops = count;
10209 }
10210 for (; nbrOfLoops-- > 0; ) {
10211 for (i=0; i < nbrOfLists; ++i) {
10212 int varIdx = 0, var = i * 2;
10213 while (varIdx < listsEnd[var]) {
10214 Jim_Obj *varName, *ele;
10215 int lst = i * 2 + 1;
10216 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10217 != JIM_OK)
10218 goto err;
10219 if (listsIdx[i] < listsEnd[lst]) {
10220 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10221 != JIM_OK)
10222 goto err;
10223 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10224 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10225 goto err;
10226 }
10227 ++listsIdx[i]; /* Remember next iterator of current list */
10228 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10229 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10230 goto err;
10231 }
10232 ++varIdx; /* Next variable */
10233 }
10234 }
10235 switch (result = Jim_EvalObj(interp, script)) {
10236 case JIM_OK:
10237 if (doMap)
10238 Jim_ListAppendElement(interp, mapRes, interp->result);
10239 break;
10240 case JIM_CONTINUE:
10241 break;
10242 case JIM_BREAK:
10243 goto out;
10244 break;
10245 default:
10246 goto err;
10247 }
10248 }
10249 out:
10250 result = JIM_OK;
10251 if (doMap)
10252 Jim_SetResult(interp, mapRes);
10253 else
10254 Jim_SetEmptyResult(interp);
10255 err:
10256 if (doMap)
10257 Jim_DecrRefCount(interp, mapRes);
10258 Jim_DecrRefCount(interp, emptyStr);
10259 Jim_Free(listsIdx);
10260 Jim_Free(listsEnd);
10261 return result;
10262 }
10263
10264 /* [foreach] */
10265 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10266 Jim_Obj *const *argv)
10267 {
10268 return JimForeachMapHelper(interp, argc, argv, 0);
10269 }
10270
10271 /* [lmap] */
10272 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10273 Jim_Obj *const *argv)
10274 {
10275 return JimForeachMapHelper(interp, argc, argv, 1);
10276 }
10277
10278 /* [if] */
10279 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10280 Jim_Obj *const *argv)
10281 {
10282 int boolean, retval, current = 1, falsebody = 0;
10283 if (argc >= 3) {
10284 while (1) {
10285 /* Far not enough arguments given! */
10286 if (current >= argc) goto err;
10287 if ((retval = Jim_GetBoolFromExpr(interp,
10288 argv[current++], &boolean))
10289 != JIM_OK)
10290 return retval;
10291 /* There lacks something, isn't it? */
10292 if (current >= argc) goto err;
10293 if (Jim_CompareStringImmediate(interp, argv[current],
10294 "then")) current++;
10295 /* Tsk tsk, no then-clause? */
10296 if (current >= argc) goto err;
10297 if (boolean)
10298 return Jim_EvalObj(interp, argv[current]);
10299 /* Ok: no else-clause follows */
10300 if (++current >= argc) {
10301 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10302 return JIM_OK;
10303 }
10304 falsebody = current++;
10305 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10306 "else")) {
10307 /* IIICKS - else-clause isn't last cmd? */
10308 if (current != argc-1) goto err;
10309 return Jim_EvalObj(interp, argv[current]);
10310 } else if (Jim_CompareStringImmediate(interp,
10311 argv[falsebody], "elseif"))
10312 /* Ok: elseif follows meaning all the stuff
10313 * again (how boring...) */
10314 continue;
10315 /* OOPS - else-clause is not last cmd?*/
10316 else if (falsebody != argc-1)
10317 goto err;
10318 return Jim_EvalObj(interp, argv[falsebody]);
10319 }
10320 return JIM_OK;
10321 }
10322 err:
10323 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10324 return JIM_ERR;
10325 }
10326
10327 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10328
10329 /* [switch] */
10330 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10331 Jim_Obj *const *argv)
10332 {
10333 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10334 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10335 Jim_Obj *script = 0;
10336 if (argc < 3) goto wrongnumargs;
10337 for (opt=1; opt < argc; ++opt) {
10338 const char *option = Jim_GetString(argv[opt], 0);
10339 if (*option != '-') break;
10340 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10341 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10342 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10343 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10344 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10345 if ((argc - opt) < 2) goto wrongnumargs;
10346 command = argv[++opt];
10347 } else {
10348 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10349 Jim_AppendStrings(interp, Jim_GetResult(interp),
10350 "bad option \"", option, "\": must be -exact, -glob, "
10351 "-regexp, -command procname or --", 0);
10352 goto err;
10353 }
10354 if ((argc - opt) < 2) goto wrongnumargs;
10355 }
10356 strObj = argv[opt++];
10357 patCount = argc - opt;
10358 if (patCount == 1) {
10359 Jim_Obj **vector;
10360 JimListGetElements(interp, argv[opt], &patCount, &vector);
10361 caseList = vector;
10362 } else
10363 caseList = &argv[opt];
10364 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10365 for (i=0; script == 0 && i < patCount; i += 2) {
10366 Jim_Obj *patObj = caseList[i];
10367 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10368 || i < (patCount-2)) {
10369 switch (matchOpt) {
10370 case SWITCH_EXACT:
10371 if (Jim_StringEqObj(strObj, patObj, 0))
10372 script = caseList[i+1];
10373 break;
10374 case SWITCH_GLOB:
10375 if (Jim_StringMatchObj(patObj, strObj, 0))
10376 script = caseList[i+1];
10377 break;
10378 case SWITCH_RE:
10379 command = Jim_NewStringObj(interp, "regexp", -1);
10380 /* Fall thru intentionally */
10381 case SWITCH_CMD: {
10382 Jim_Obj *parms[] = {command, patObj, strObj};
10383 int rc = Jim_EvalObjVector(interp, 3, parms);
10384 long matching;
10385 /* After the execution of a command we need to
10386 * make sure to reconvert the object into a list
10387 * again. Only for the single-list style [switch]. */
10388 if (argc-opt == 1) {
10389 Jim_Obj **vector;
10390 JimListGetElements(interp, argv[opt], &patCount,
10391 &vector);
10392 caseList = vector;
10393 }
10394 /* command is here already decref'd */
10395 if (rc != JIM_OK) {
10396 retcode = rc;
10397 goto err;
10398 }
10399 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10400 if (rc != JIM_OK) {
10401 retcode = rc;
10402 goto err;
10403 }
10404 if (matching)
10405 script = caseList[i+1];
10406 break;
10407 }
10408 default:
10409 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10410 Jim_AppendStrings(interp, Jim_GetResult(interp),
10411 "internal error: no such option implemented", 0);
10412 goto err;
10413 }
10414 } else {
10415 script = caseList[i+1];
10416 }
10417 }
10418 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10419 i += 2)
10420 script = caseList[i+1];
10421 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10422 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10423 Jim_AppendStrings(interp, Jim_GetResult(interp),
10424 "no body specified for pattern \"",
10425 Jim_GetString(caseList[i-2], 0), "\"", 0);
10426 goto err;
10427 }
10428 retcode = JIM_OK;
10429 Jim_SetEmptyResult(interp);
10430 if (script != 0)
10431 retcode = Jim_EvalObj(interp, script);
10432 return retcode;
10433 wrongnumargs:
10434 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10435 "pattern body ... ?default body? or "
10436 "{pattern body ?pattern body ...?}");
10437 err:
10438 return retcode;
10439 }
10440
10441 /* [list] */
10442 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10443 Jim_Obj *const *argv)
10444 {
10445 Jim_Obj *listObjPtr;
10446
10447 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10448 Jim_SetResult(interp, listObjPtr);
10449 return JIM_OK;
10450 }
10451
10452 /* [lindex] */
10453 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10454 Jim_Obj *const *argv)
10455 {
10456 Jim_Obj *objPtr, *listObjPtr;
10457 int i;
10458 int index;
10459
10460 if (argc < 3) {
10461 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10462 return JIM_ERR;
10463 }
10464 objPtr = argv[1];
10465 Jim_IncrRefCount(objPtr);
10466 for (i = 2; i < argc; i++) {
10467 listObjPtr = objPtr;
10468 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10469 Jim_DecrRefCount(interp, listObjPtr);
10470 return JIM_ERR;
10471 }
10472 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10473 JIM_NONE) != JIM_OK) {
10474 /* Returns an empty object if the index
10475 * is out of range. */
10476 Jim_DecrRefCount(interp, listObjPtr);
10477 Jim_SetEmptyResult(interp);
10478 return JIM_OK;
10479 }
10480 Jim_IncrRefCount(objPtr);
10481 Jim_DecrRefCount(interp, listObjPtr);
10482 }
10483 Jim_SetResult(interp, objPtr);
10484 Jim_DecrRefCount(interp, objPtr);
10485 return JIM_OK;
10486 }
10487
10488 /* [llength] */
10489 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10490 Jim_Obj *const *argv)
10491 {
10492 int len;
10493
10494 if (argc != 2) {
10495 Jim_WrongNumArgs(interp, 1, argv, "list");
10496 return JIM_ERR;
10497 }
10498 Jim_ListLength(interp, argv[1], &len);
10499 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10500 return JIM_OK;
10501 }
10502
10503 /* [lappend] */
10504 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10505 Jim_Obj *const *argv)
10506 {
10507 Jim_Obj *listObjPtr;
10508 int shared, i;
10509
10510 if (argc < 2) {
10511 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10512 return JIM_ERR;
10513 }
10514 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10515 if (!listObjPtr) {
10516 /* Create the list if it does not exists */
10517 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10518 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10519 Jim_FreeNewObj(interp, listObjPtr);
10520 return JIM_ERR;
10521 }
10522 }
10523 shared = Jim_IsShared(listObjPtr);
10524 if (shared)
10525 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10526 for (i = 2; i < argc; i++)
10527 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10528 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10529 if (shared)
10530 Jim_FreeNewObj(interp, listObjPtr);
10531 return JIM_ERR;
10532 }
10533 Jim_SetResult(interp, listObjPtr);
10534 return JIM_OK;
10535 }
10536
10537 /* [linsert] */
10538 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10539 Jim_Obj *const *argv)
10540 {
10541 int index, len;
10542 Jim_Obj *listPtr;
10543
10544 if (argc < 4) {
10545 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10546 "?element ...?");
10547 return JIM_ERR;
10548 }
10549 listPtr = argv[1];
10550 if (Jim_IsShared(listPtr))
10551 listPtr = Jim_DuplicateObj(interp, listPtr);
10552 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10553 goto err;
10554 Jim_ListLength(interp, listPtr, &len);
10555 if (index >= len)
10556 index = len;
10557 else if (index < 0)
10558 index = len + index + 1;
10559 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10560 Jim_SetResult(interp, listPtr);
10561 return JIM_OK;
10562 err:
10563 if (listPtr != argv[1]) {
10564 Jim_FreeNewObj(interp, listPtr);
10565 }
10566 return JIM_ERR;
10567 }
10568
10569 /* [lset] */
10570 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10571 Jim_Obj *const *argv)
10572 {
10573 if (argc < 3) {
10574 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10575 return JIM_ERR;
10576 } else if (argc == 3) {
10577 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10578 return JIM_ERR;
10579 Jim_SetResult(interp, argv[2]);
10580 return JIM_OK;
10581 }
10582 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10583 == JIM_ERR) return JIM_ERR;
10584 return JIM_OK;
10585 }
10586
10587 /* [lsort] */
10588 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10589 {
10590 const char *options[] = {
10591 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10592 };
10593 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10594 Jim_Obj *resObj;
10595 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10596 int decreasing = 0;
10597
10598 if (argc < 2) {
10599 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10600 return JIM_ERR;
10601 }
10602 for (i = 1; i < (argc-1); i++) {
10603 int option;
10604
10605 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10606 != JIM_OK)
10607 return JIM_ERR;
10608 switch(option) {
10609 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10610 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10611 case OPT_INCREASING: decreasing = 0; break;
10612 case OPT_DECREASING: decreasing = 1; break;
10613 }
10614 }
10615 if (decreasing) {
10616 switch(lsortType) {
10617 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10618 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10619 }
10620 }
10621 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10622 ListSortElements(interp, resObj, lsortType);
10623 Jim_SetResult(interp, resObj);
10624 return JIM_OK;
10625 }
10626
10627 /* [append] */
10628 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10629 Jim_Obj *const *argv)
10630 {
10631 Jim_Obj *stringObjPtr;
10632 int shared, i;
10633
10634 if (argc < 2) {
10635 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10636 return JIM_ERR;
10637 }
10638 if (argc == 2) {
10639 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10640 if (!stringObjPtr) return JIM_ERR;
10641 } else {
10642 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10643 if (!stringObjPtr) {
10644 /* Create the string if it does not exists */
10645 stringObjPtr = Jim_NewEmptyStringObj(interp);
10646 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10647 != JIM_OK) {
10648 Jim_FreeNewObj(interp, stringObjPtr);
10649 return JIM_ERR;
10650 }
10651 }
10652 }
10653 shared = Jim_IsShared(stringObjPtr);
10654 if (shared)
10655 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10656 for (i = 2; i < argc; i++)
10657 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10658 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10659 if (shared)
10660 Jim_FreeNewObj(interp, stringObjPtr);
10661 return JIM_ERR;
10662 }
10663 Jim_SetResult(interp, stringObjPtr);
10664 return JIM_OK;
10665 }
10666
10667 /* [debug] */
10668 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10669 Jim_Obj *const *argv)
10670 {
10671 const char *options[] = {
10672 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10673 "exprbc",
10674 NULL
10675 };
10676 enum {
10677 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10678 OPT_EXPRLEN, OPT_EXPRBC
10679 };
10680 int option;
10681
10682 if (argc < 2) {
10683 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10684 return JIM_ERR;
10685 }
10686 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10687 JIM_ERRMSG) != JIM_OK)
10688 return JIM_ERR;
10689 if (option == OPT_REFCOUNT) {
10690 if (argc != 3) {
10691 Jim_WrongNumArgs(interp, 2, argv, "object");
10692 return JIM_ERR;
10693 }
10694 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10695 return JIM_OK;
10696 } else if (option == OPT_OBJCOUNT) {
10697 int freeobj = 0, liveobj = 0;
10698 char buf[256];
10699 Jim_Obj *objPtr;
10700
10701 if (argc != 2) {
10702 Jim_WrongNumArgs(interp, 2, argv, "");
10703 return JIM_ERR;
10704 }
10705 /* Count the number of free objects. */
10706 objPtr = interp->freeList;
10707 while (objPtr) {
10708 freeobj++;
10709 objPtr = objPtr->nextObjPtr;
10710 }
10711 /* Count the number of live objects. */
10712 objPtr = interp->liveList;
10713 while (objPtr) {
10714 liveobj++;
10715 objPtr = objPtr->nextObjPtr;
10716 }
10717 /* Set the result string and return. */
10718 sprintf(buf, "free %d used %d", freeobj, liveobj);
10719 Jim_SetResultString(interp, buf, -1);
10720 return JIM_OK;
10721 } else if (option == OPT_OBJECTS) {
10722 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10723 /* Count the number of live objects. */
10724 objPtr = interp->liveList;
10725 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10726 while (objPtr) {
10727 char buf[128];
10728 const char *type = objPtr->typePtr ?
10729 objPtr->typePtr->name : "";
10730 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10731 sprintf(buf, "%p", objPtr);
10732 Jim_ListAppendElement(interp, subListObjPtr,
10733 Jim_NewStringObj(interp, buf, -1));
10734 Jim_ListAppendElement(interp, subListObjPtr,
10735 Jim_NewStringObj(interp, type, -1));
10736 Jim_ListAppendElement(interp, subListObjPtr,
10737 Jim_NewIntObj(interp, objPtr->refCount));
10738 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10739 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10740 objPtr = objPtr->nextObjPtr;
10741 }
10742 Jim_SetResult(interp, listObjPtr);
10743 return JIM_OK;
10744 } else if (option == OPT_INVSTR) {
10745 Jim_Obj *objPtr;
10746
10747 if (argc != 3) {
10748 Jim_WrongNumArgs(interp, 2, argv, "object");
10749 return JIM_ERR;
10750 }
10751 objPtr = argv[2];
10752 if (objPtr->typePtr != NULL)
10753 Jim_InvalidateStringRep(objPtr);
10754 Jim_SetEmptyResult(interp);
10755 return JIM_OK;
10756 } else if (option == OPT_SCRIPTLEN) {
10757 ScriptObj *script;
10758 if (argc != 3) {
10759 Jim_WrongNumArgs(interp, 2, argv, "script");
10760 return JIM_ERR;
10761 }
10762 script = Jim_GetScript(interp, argv[2]);
10763 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10764 return JIM_OK;
10765 } else if (option == OPT_EXPRLEN) {
10766 ExprByteCode *expr;
10767 if (argc != 3) {
10768 Jim_WrongNumArgs(interp, 2, argv, "expression");
10769 return JIM_ERR;
10770 }
10771 expr = Jim_GetExpression(interp, argv[2]);
10772 if (expr == NULL)
10773 return JIM_ERR;
10774 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10775 return JIM_OK;
10776 } else if (option == OPT_EXPRBC) {
10777 Jim_Obj *objPtr;
10778 ExprByteCode *expr;
10779 int i;
10780
10781 if (argc != 3) {
10782 Jim_WrongNumArgs(interp, 2, argv, "expression");
10783 return JIM_ERR;
10784 }
10785 expr = Jim_GetExpression(interp, argv[2]);
10786 if (expr == NULL)
10787 return JIM_ERR;
10788 objPtr = Jim_NewListObj(interp, NULL, 0);
10789 for (i = 0; i < expr->len; i++) {
10790 const char *type;
10791 Jim_ExprOperator *op;
10792
10793 switch(expr->opcode[i]) {
10794 case JIM_EXPROP_NUMBER: type = "number"; break;
10795 case JIM_EXPROP_COMMAND: type = "command"; break;
10796 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10797 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10798 case JIM_EXPROP_SUBST: type = "subst"; break;
10799 case JIM_EXPROP_STRING: type = "string"; break;
10800 default:
10801 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10802 if (op == NULL) {
10803 type = "private";
10804 } else {
10805 type = "operator";
10806 }
10807 break;
10808 }
10809 Jim_ListAppendElement(interp, objPtr,
10810 Jim_NewStringObj(interp, type, -1));
10811 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10812 }
10813 Jim_SetResult(interp, objPtr);
10814 return JIM_OK;
10815 } else {
10816 Jim_SetResultString(interp,
10817 "bad option. Valid options are refcount, "
10818 "objcount, objects, invstr", -1);
10819 return JIM_ERR;
10820 }
10821 return JIM_OK; /* unreached */
10822 }
10823
10824 /* [eval] */
10825 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10826 Jim_Obj *const *argv)
10827 {
10828 if (argc == 2) {
10829 return Jim_EvalObj(interp, argv[1]);
10830 } else if (argc > 2) {
10831 Jim_Obj *objPtr;
10832 int retcode;
10833
10834 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10835 Jim_IncrRefCount(objPtr);
10836 retcode = Jim_EvalObj(interp, objPtr);
10837 Jim_DecrRefCount(interp, objPtr);
10838 return retcode;
10839 } else {
10840 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10841 return JIM_ERR;
10842 }
10843 }
10844
10845 /* [uplevel] */
10846 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10847 Jim_Obj *const *argv)
10848 {
10849 if (argc >= 2) {
10850 int retcode, newLevel, oldLevel;
10851 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10852 Jim_Obj *objPtr;
10853 const char *str;
10854
10855 /* Save the old callframe pointer */
10856 savedCallFrame = interp->framePtr;
10857
10858 /* Lookup the target frame pointer */
10859 str = Jim_GetString(argv[1], NULL);
10860 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10861 {
10862 if (Jim_GetCallFrameByLevel(interp, argv[1],
10863 &targetCallFrame,
10864 &newLevel) != JIM_OK)
10865 return JIM_ERR;
10866 argc--;
10867 argv++;
10868 } else {
10869 if (Jim_GetCallFrameByLevel(interp, NULL,
10870 &targetCallFrame,
10871 &newLevel) != JIM_OK)
10872 return JIM_ERR;
10873 }
10874 if (argc < 2) {
10875 argc++;
10876 argv--;
10877 Jim_WrongNumArgs(interp, 1, argv,
10878 "?level? command ?arg ...?");
10879 return JIM_ERR;
10880 }
10881 /* Eval the code in the target callframe. */
10882 interp->framePtr = targetCallFrame;
10883 oldLevel = interp->numLevels;
10884 interp->numLevels = newLevel;
10885 if (argc == 2) {
10886 retcode = Jim_EvalObj(interp, argv[1]);
10887 } else {
10888 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10889 Jim_IncrRefCount(objPtr);
10890 retcode = Jim_EvalObj(interp, objPtr);
10891 Jim_DecrRefCount(interp, objPtr);
10892 }
10893 interp->numLevels = oldLevel;
10894 interp->framePtr = savedCallFrame;
10895 return retcode;
10896 } else {
10897 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10898 return JIM_ERR;
10899 }
10900 }
10901
10902 /* [expr] */
10903 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10904 Jim_Obj *const *argv)
10905 {
10906 Jim_Obj *exprResultPtr;
10907 int retcode;
10908
10909 if (argc == 2) {
10910 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10911 } else if (argc > 2) {
10912 Jim_Obj *objPtr;
10913
10914 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10915 Jim_IncrRefCount(objPtr);
10916 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10917 Jim_DecrRefCount(interp, objPtr);
10918 } else {
10919 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10920 return JIM_ERR;
10921 }
10922 if (retcode != JIM_OK) return retcode;
10923 Jim_SetResult(interp, exprResultPtr);
10924 Jim_DecrRefCount(interp, exprResultPtr);
10925 return JIM_OK;
10926 }
10927
10928 /* [break] */
10929 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10930 Jim_Obj *const *argv)
10931 {
10932 if (argc != 1) {
10933 Jim_WrongNumArgs(interp, 1, argv, "");
10934 return JIM_ERR;
10935 }
10936 return JIM_BREAK;
10937 }
10938
10939 /* [continue] */
10940 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10941 Jim_Obj *const *argv)
10942 {
10943 if (argc != 1) {
10944 Jim_WrongNumArgs(interp, 1, argv, "");
10945 return JIM_ERR;
10946 }
10947 return JIM_CONTINUE;
10948 }
10949
10950 /* [return] */
10951 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10952 Jim_Obj *const *argv)
10953 {
10954 if (argc == 1) {
10955 return JIM_RETURN;
10956 } else if (argc == 2) {
10957 Jim_SetResult(interp, argv[1]);
10958 interp->returnCode = JIM_OK;
10959 return JIM_RETURN;
10960 } else if (argc == 3 || argc == 4) {
10961 int returnCode;
10962 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10963 return JIM_ERR;
10964 interp->returnCode = returnCode;
10965 if (argc == 4)
10966 Jim_SetResult(interp, argv[3]);
10967 return JIM_RETURN;
10968 } else {
10969 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10970 return JIM_ERR;
10971 }
10972 return JIM_RETURN; /* unreached */
10973 }
10974
10975 /* [tailcall] */
10976 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10977 Jim_Obj *const *argv)
10978 {
10979 Jim_Obj *objPtr;
10980
10981 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10982 Jim_SetResult(interp, objPtr);
10983 return JIM_EVAL;
10984 }
10985
10986 /* [proc] */
10987 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10988 Jim_Obj *const *argv)
10989 {
10990 int argListLen;
10991 int arityMin, arityMax;
10992
10993 if (argc != 4 && argc != 5) {
10994 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10995 return JIM_ERR;
10996 }
10997 Jim_ListLength(interp, argv[2], &argListLen);
10998 arityMin = arityMax = argListLen+1;
10999
11000 if (argListLen) {
11001 const char *str;
11002 int len;
11003 Jim_Obj *argPtr;
11004
11005 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11006 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11007 str = Jim_GetString(argPtr, &len);
11008 if (len == 4 && memcmp(str, "args", 4) == 0) {
11009 arityMin--;
11010 arityMax = -1;
11011 }
11012
11013 /* Check for default arguments and reduce arityMin if necessary */
11014 while (arityMin > 1) {
11015 int len;
11016 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11017 Jim_ListLength(interp, argPtr, &len);
11018 if (len != 2) {
11019 /* No default argument */
11020 break;
11021 }
11022 arityMin--;
11023 }
11024 }
11025 if (argc == 4) {
11026 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11027 argv[2], NULL, argv[3], arityMin, arityMax);
11028 } else {
11029 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11030 argv[2], argv[3], argv[4], arityMin, arityMax);
11031 }
11032 }
11033
11034 /* [concat] */
11035 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11036 Jim_Obj *const *argv)
11037 {
11038 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11039 return JIM_OK;
11040 }
11041
11042 /* [upvar] */
11043 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11044 Jim_Obj *const *argv)
11045 {
11046 const char *str;
11047 int i;
11048 Jim_CallFrame *targetCallFrame;
11049
11050 /* Lookup the target frame pointer */
11051 str = Jim_GetString(argv[1], NULL);
11052 if (argc > 3 &&
11053 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11054 {
11055 if (Jim_GetCallFrameByLevel(interp, argv[1],
11056 &targetCallFrame, NULL) != JIM_OK)
11057 return JIM_ERR;
11058 argc--;
11059 argv++;
11060 } else {
11061 if (Jim_GetCallFrameByLevel(interp, NULL,
11062 &targetCallFrame, NULL) != JIM_OK)
11063 return JIM_ERR;
11064 }
11065 /* Check for arity */
11066 if (argc < 3 || ((argc-1)%2) != 0) {
11067 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11068 return JIM_ERR;
11069 }
11070 /* Now... for every other/local couple: */
11071 for (i = 1; i < argc; i += 2) {
11072 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11073 targetCallFrame) != JIM_OK) return JIM_ERR;
11074 }
11075 return JIM_OK;
11076 }
11077
11078 /* [global] */
11079 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11080 Jim_Obj *const *argv)
11081 {
11082 int i;
11083
11084 if (argc < 2) {
11085 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11086 return JIM_ERR;
11087 }
11088 /* Link every var to the toplevel having the same name */
11089 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11090 for (i = 1; i < argc; i++) {
11091 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11092 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11093 }
11094 return JIM_OK;
11095 }
11096
11097 /* does the [string map] operation. On error NULL is returned,
11098 * otherwise a new string object with the result, having refcount = 0,
11099 * is returned. */
11100 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11101 Jim_Obj *objPtr, int nocase)
11102 {
11103 int numMaps;
11104 const char **key, *str, *noMatchStart = NULL;
11105 Jim_Obj **value;
11106 int *keyLen, strLen, i;
11107 Jim_Obj *resultObjPtr;
11108
11109 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11110 if (numMaps % 2) {
11111 Jim_SetResultString(interp,
11112 "list must contain an even number of elements", -1);
11113 return NULL;
11114 }
11115 /* Initialization */
11116 numMaps /= 2;
11117 key = Jim_Alloc(sizeof(char*)*numMaps);
11118 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11119 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11120 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11121 for (i = 0; i < numMaps; i++) {
11122 Jim_Obj *eleObjPtr;
11123
11124 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11125 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11126 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11127 value[i] = eleObjPtr;
11128 }
11129 str = Jim_GetString(objPtr, &strLen);
11130 /* Map it */
11131 while(strLen) {
11132 for (i = 0; i < numMaps; i++) {
11133 if (strLen >= keyLen[i] && keyLen[i]) {
11134 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11135 nocase))
11136 {
11137 if (noMatchStart) {
11138 Jim_AppendString(interp, resultObjPtr,
11139 noMatchStart, str-noMatchStart);
11140 noMatchStart = NULL;
11141 }
11142 Jim_AppendObj(interp, resultObjPtr, value[i]);
11143 str += keyLen[i];
11144 strLen -= keyLen[i];
11145 break;
11146 }
11147 }
11148 }
11149 if (i == numMaps) { /* no match */
11150 if (noMatchStart == NULL)
11151 noMatchStart = str;
11152 str ++;
11153 strLen --;
11154 }
11155 }
11156 if (noMatchStart) {
11157 Jim_AppendString(interp, resultObjPtr,
11158 noMatchStart, str-noMatchStart);
11159 }
11160 Jim_Free((void*)key);
11161 Jim_Free(keyLen);
11162 Jim_Free(value);
11163 return resultObjPtr;
11164 }
11165
11166 /* [string] */
11167 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11168 Jim_Obj *const *argv)
11169 {
11170 int option;
11171 const char *options[] = {
11172 "length", "compare", "match", "equal", "range", "map", "repeat",
11173 "index", "first", "tolower", "toupper", NULL
11174 };
11175 enum {
11176 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11177 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11178 };
11179
11180 if (argc < 2) {
11181 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11182 return JIM_ERR;
11183 }
11184 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11185 JIM_ERRMSG) != JIM_OK)
11186 return JIM_ERR;
11187
11188 if (option == OPT_LENGTH) {
11189 int len;
11190
11191 if (argc != 3) {
11192 Jim_WrongNumArgs(interp, 2, argv, "string");
11193 return JIM_ERR;
11194 }
11195 Jim_GetString(argv[2], &len);
11196 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11197 return JIM_OK;
11198 } else if (option == OPT_COMPARE) {
11199 int nocase = 0;
11200 if ((argc != 4 && argc != 5) ||
11201 (argc == 5 && Jim_CompareStringImmediate(interp,
11202 argv[2], "-nocase") == 0)) {
11203 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11204 return JIM_ERR;
11205 }
11206 if (argc == 5) {
11207 nocase = 1;
11208 argv++;
11209 }
11210 Jim_SetResult(interp, Jim_NewIntObj(interp,
11211 Jim_StringCompareObj(argv[2],
11212 argv[3], nocase)));
11213 return JIM_OK;
11214 } else if (option == OPT_MATCH) {
11215 int nocase = 0;
11216 if ((argc != 4 && argc != 5) ||
11217 (argc == 5 && Jim_CompareStringImmediate(interp,
11218 argv[2], "-nocase") == 0)) {
11219 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11220 "string");
11221 return JIM_ERR;
11222 }
11223 if (argc == 5) {
11224 nocase = 1;
11225 argv++;
11226 }
11227 Jim_SetResult(interp,
11228 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11229 argv[3], nocase)));
11230 return JIM_OK;
11231 } else if (option == OPT_EQUAL) {
11232 if (argc != 4) {
11233 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11234 return JIM_ERR;
11235 }
11236 Jim_SetResult(interp,
11237 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11238 argv[3], 0)));
11239 return JIM_OK;
11240 } else if (option == OPT_RANGE) {
11241 Jim_Obj *objPtr;
11242
11243 if (argc != 5) {
11244 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11245 return JIM_ERR;
11246 }
11247 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11248 if (objPtr == NULL)
11249 return JIM_ERR;
11250 Jim_SetResult(interp, objPtr);
11251 return JIM_OK;
11252 } else if (option == OPT_MAP) {
11253 int nocase = 0;
11254 Jim_Obj *objPtr;
11255
11256 if ((argc != 4 && argc != 5) ||
11257 (argc == 5 && Jim_CompareStringImmediate(interp,
11258 argv[2], "-nocase") == 0)) {
11259 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11260 "string");
11261 return JIM_ERR;
11262 }
11263 if (argc == 5) {
11264 nocase = 1;
11265 argv++;
11266 }
11267 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11268 if (objPtr == NULL)
11269 return JIM_ERR;
11270 Jim_SetResult(interp, objPtr);
11271 return JIM_OK;
11272 } else if (option == OPT_REPEAT) {
11273 Jim_Obj *objPtr;
11274 jim_wide count;
11275
11276 if (argc != 4) {
11277 Jim_WrongNumArgs(interp, 2, argv, "string count");
11278 return JIM_ERR;
11279 }
11280 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11281 return JIM_ERR;
11282 objPtr = Jim_NewStringObj(interp, "", 0);
11283 while (count--) {
11284 Jim_AppendObj(interp, objPtr, argv[2]);
11285 }
11286 Jim_SetResult(interp, objPtr);
11287 return JIM_OK;
11288 } else if (option == OPT_INDEX) {
11289 int index, len;
11290 const char *str;
11291
11292 if (argc != 4) {
11293 Jim_WrongNumArgs(interp, 2, argv, "string index");
11294 return JIM_ERR;
11295 }
11296 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11297 return JIM_ERR;
11298 str = Jim_GetString(argv[2], &len);
11299 if (index != INT_MIN && index != INT_MAX)
11300 index = JimRelToAbsIndex(len, index);
11301 if (index < 0 || index >= len) {
11302 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11303 return JIM_OK;
11304 } else {
11305 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11306 return JIM_OK;
11307 }
11308 } else if (option == OPT_FIRST) {
11309 int index = 0, l1, l2;
11310 const char *s1, *s2;
11311
11312 if (argc != 4 && argc != 5) {
11313 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11314 return JIM_ERR;
11315 }
11316 s1 = Jim_GetString(argv[2], &l1);
11317 s2 = Jim_GetString(argv[3], &l2);
11318 if (argc == 5) {
11319 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11320 return JIM_ERR;
11321 index = JimRelToAbsIndex(l2, index);
11322 }
11323 Jim_SetResult(interp, Jim_NewIntObj(interp,
11324 JimStringFirst(s1, l1, s2, l2, index)));
11325 return JIM_OK;
11326 } else if (option == OPT_TOLOWER) {
11327 if (argc != 3) {
11328 Jim_WrongNumArgs(interp, 2, argv, "string");
11329 return JIM_ERR;
11330 }
11331 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11332 } else if (option == OPT_TOUPPER) {
11333 if (argc != 3) {
11334 Jim_WrongNumArgs(interp, 2, argv, "string");
11335 return JIM_ERR;
11336 }
11337 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11338 }
11339 return JIM_OK;
11340 }
11341
11342 /* [time] */
11343 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11344 Jim_Obj *const *argv)
11345 {
11346 long i, count = 1;
11347 jim_wide start, elapsed;
11348 char buf [256];
11349 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11350
11351 if (argc < 2) {
11352 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11353 return JIM_ERR;
11354 }
11355 if (argc == 3) {
11356 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11357 return JIM_ERR;
11358 }
11359 if (count < 0)
11360 return JIM_OK;
11361 i = count;
11362 start = JimClock();
11363 while (i-- > 0) {
11364 int retval;
11365
11366 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11367 return retval;
11368 }
11369 elapsed = JimClock() - start;
11370 sprintf(buf, fmt, elapsed/count);
11371 Jim_SetResultString(interp, buf, -1);
11372 return JIM_OK;
11373 }
11374
11375 /* [exit] */
11376 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11377 Jim_Obj *const *argv)
11378 {
11379 long exitCode = 0;
11380
11381 if (argc > 2) {
11382 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11383 return JIM_ERR;
11384 }
11385 if (argc == 2) {
11386 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11387 return JIM_ERR;
11388 }
11389 interp->exitCode = exitCode;
11390 return JIM_EXIT;
11391 }
11392
11393 /* [catch] */
11394 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11395 Jim_Obj *const *argv)
11396 {
11397 int exitCode = 0;
11398
11399 if (argc != 2 && argc != 3) {
11400 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11401 return JIM_ERR;
11402 }
11403 exitCode = Jim_EvalObj(interp, argv[1]);
11404 if (argc == 3) {
11405 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11406 != JIM_OK)
11407 return JIM_ERR;
11408 }
11409 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11410 return JIM_OK;
11411 }
11412
11413 /* [ref] */
11414 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11415 Jim_Obj *const *argv)
11416 {
11417 if (argc != 3 && argc != 4) {
11418 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11419 return JIM_ERR;
11420 }
11421 if (argc == 3) {
11422 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11423 } else {
11424 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11425 argv[3]));
11426 }
11427 return JIM_OK;
11428 }
11429
11430 /* [getref] */
11431 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11432 Jim_Obj *const *argv)
11433 {
11434 Jim_Reference *refPtr;
11435
11436 if (argc != 2) {
11437 Jim_WrongNumArgs(interp, 1, argv, "reference");
11438 return JIM_ERR;
11439 }
11440 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11441 return JIM_ERR;
11442 Jim_SetResult(interp, refPtr->objPtr);
11443 return JIM_OK;
11444 }
11445
11446 /* [setref] */
11447 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11448 Jim_Obj *const *argv)
11449 {
11450 Jim_Reference *refPtr;
11451
11452 if (argc != 3) {
11453 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11454 return JIM_ERR;
11455 }
11456 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11457 return JIM_ERR;
11458 Jim_IncrRefCount(argv[2]);
11459 Jim_DecrRefCount(interp, refPtr->objPtr);
11460 refPtr->objPtr = argv[2];
11461 Jim_SetResult(interp, argv[2]);
11462 return JIM_OK;
11463 }
11464
11465 /* [collect] */
11466 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11467 Jim_Obj *const *argv)
11468 {
11469 if (argc != 1) {
11470 Jim_WrongNumArgs(interp, 1, argv, "");
11471 return JIM_ERR;
11472 }
11473 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11474 return JIM_OK;
11475 }
11476
11477 /* [finalize] reference ?newValue? */
11478 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11479 Jim_Obj *const *argv)
11480 {
11481 if (argc != 2 && argc != 3) {
11482 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11483 return JIM_ERR;
11484 }
11485 if (argc == 2) {
11486 Jim_Obj *cmdNamePtr;
11487
11488 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11489 return JIM_ERR;
11490 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11491 Jim_SetResult(interp, cmdNamePtr);
11492 } else {
11493 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11494 return JIM_ERR;
11495 Jim_SetResult(interp, argv[2]);
11496 }
11497 return JIM_OK;
11498 }
11499
11500 /* TODO */
11501 /* [info references] (list of all the references/finalizers) */
11502
11503 /* [rename] */
11504 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11505 Jim_Obj *const *argv)
11506 {
11507 const char *oldName, *newName;
11508
11509 if (argc != 3) {
11510 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11511 return JIM_ERR;
11512 }
11513 oldName = Jim_GetString(argv[1], NULL);
11514 newName = Jim_GetString(argv[2], NULL);
11515 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11516 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11517 Jim_AppendStrings(interp, Jim_GetResult(interp),
11518 "can't rename \"", oldName, "\": ",
11519 "command doesn't exist", NULL);
11520 return JIM_ERR;
11521 }
11522 return JIM_OK;
11523 }
11524
11525 /* [dict] */
11526 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11527 Jim_Obj *const *argv)
11528 {
11529 int option;
11530 const char *options[] = {
11531 "create", "get", "set", "unset", "exists", NULL
11532 };
11533 enum {
11534 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11535 };
11536
11537 if (argc < 2) {
11538 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11539 return JIM_ERR;
11540 }
11541
11542 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11543 JIM_ERRMSG) != JIM_OK)
11544 return JIM_ERR;
11545
11546 if (option == OPT_CREATE) {
11547 Jim_Obj *objPtr;
11548
11549 if (argc % 2) {
11550 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11551 return JIM_ERR;
11552 }
11553 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11554 Jim_SetResult(interp, objPtr);
11555 return JIM_OK;
11556 } else if (option == OPT_GET) {
11557 Jim_Obj *objPtr;
11558
11559 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11560 JIM_ERRMSG) != JIM_OK)
11561 return JIM_ERR;
11562 Jim_SetResult(interp, objPtr);
11563 return JIM_OK;
11564 } else if (option == OPT_SET) {
11565 if (argc < 5) {
11566 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11567 return JIM_ERR;
11568 }
11569 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11570 argv[argc-1]);
11571 } else if (option == OPT_UNSET) {
11572 if (argc < 4) {
11573 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11574 return JIM_ERR;
11575 }
11576 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11577 NULL);
11578 } else if (option == OPT_EXIST) {
11579 Jim_Obj *objPtr;
11580 int exists;
11581
11582 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11583 JIM_ERRMSG) == JIM_OK)
11584 exists = 1;
11585 else
11586 exists = 0;
11587 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11588 return JIM_OK;
11589 } else {
11590 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11591 Jim_AppendStrings(interp, Jim_GetResult(interp),
11592 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11593 " must be create, get, set", NULL);
11594 return JIM_ERR;
11595 }
11596 return JIM_OK;
11597 }
11598
11599 /* [load] */
11600 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11601 Jim_Obj *const *argv)
11602 {
11603 if (argc < 2) {
11604 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11605 return JIM_ERR;
11606 }
11607 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11608 }
11609
11610 /* [subst] */
11611 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11612 Jim_Obj *const *argv)
11613 {
11614 int i, flags = 0;
11615 Jim_Obj *objPtr;
11616
11617 if (argc < 2) {
11618 Jim_WrongNumArgs(interp, 1, argv,
11619 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11620 return JIM_ERR;
11621 }
11622 i = argc-2;
11623 while(i--) {
11624 if (Jim_CompareStringImmediate(interp, argv[i+1],
11625 "-nobackslashes"))
11626 flags |= JIM_SUBST_NOESC;
11627 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11628 "-novariables"))
11629 flags |= JIM_SUBST_NOVAR;
11630 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11631 "-nocommands"))
11632 flags |= JIM_SUBST_NOCMD;
11633 else {
11634 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11635 Jim_AppendStrings(interp, Jim_GetResult(interp),
11636 "bad option \"", Jim_GetString(argv[i+1], NULL),
11637 "\": must be -nobackslashes, -nocommands, or "
11638 "-novariables", NULL);
11639 return JIM_ERR;
11640 }
11641 }
11642 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11643 return JIM_ERR;
11644 Jim_SetResult(interp, objPtr);
11645 return JIM_OK;
11646 }
11647
11648 /* [info] */
11649 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11650 Jim_Obj *const *argv)
11651 {
11652 int cmd, result = JIM_OK;
11653 static const char *commands[] = {
11654 "body", "commands", "exists", "globals", "level", "locals",
11655 "vars", "version", "complete", "args", "hostname", NULL
11656 };
11657 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11658 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11659
11660 if (argc < 2) {
11661 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11662 return JIM_ERR;
11663 }
11664 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11665 != JIM_OK) {
11666 return JIM_ERR;
11667 }
11668
11669 if (cmd == INFO_COMMANDS) {
11670 if (argc != 2 && argc != 3) {
11671 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11672 return JIM_ERR;
11673 }
11674 if (argc == 3)
11675 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11676 else
11677 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11678 } else if (cmd == INFO_EXISTS) {
11679 Jim_Obj *exists;
11680 if (argc != 3) {
11681 Jim_WrongNumArgs(interp, 2, argv, "varName");
11682 return JIM_ERR;
11683 }
11684 exists = Jim_GetVariable(interp, argv[2], 0);
11685 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11686 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11687 int mode;
11688 switch (cmd) {
11689 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11690 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11691 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11692 default: mode = 0; /* avoid warning */; break;
11693 }
11694 if (argc != 2 && argc != 3) {
11695 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11696 return JIM_ERR;
11697 }
11698 if (argc == 3)
11699 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11700 else
11701 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11702 } else if (cmd == INFO_LEVEL) {
11703 Jim_Obj *objPtr;
11704 switch (argc) {
11705 case 2:
11706 Jim_SetResult(interp,
11707 Jim_NewIntObj(interp, interp->numLevels));
11708 break;
11709 case 3:
11710 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11711 return JIM_ERR;
11712 Jim_SetResult(interp, objPtr);
11713 break;
11714 default:
11715 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11716 return JIM_ERR;
11717 }
11718 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11719 Jim_Cmd *cmdPtr;
11720
11721 if (argc != 3) {
11722 Jim_WrongNumArgs(interp, 2, argv, "procname");
11723 return JIM_ERR;
11724 }
11725 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11726 return JIM_ERR;
11727 if (cmdPtr->cmdProc != NULL) {
11728 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11729 Jim_AppendStrings(interp, Jim_GetResult(interp),
11730 "command \"", Jim_GetString(argv[2], NULL),
11731 "\" is not a procedure", NULL);
11732 return JIM_ERR;
11733 }
11734 if (cmd == INFO_BODY)
11735 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11736 else
11737 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11738 } else if (cmd == INFO_VERSION) {
11739 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11740 sprintf(buf, "%d.%d",
11741 JIM_VERSION / 100, JIM_VERSION % 100);
11742 Jim_SetResultString(interp, buf, -1);
11743 } else if (cmd == INFO_COMPLETE) {
11744 const char *s;
11745 int len;
11746
11747 if (argc != 3) {
11748 Jim_WrongNumArgs(interp, 2, argv, "script");
11749 return JIM_ERR;
11750 }
11751 s = Jim_GetString(argv[2], &len);
11752 Jim_SetResult(interp,
11753 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11754 } else if (cmd == INFO_HOSTNAME) {
11755 /* Redirect to os.hostname if it exists */
11756 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11757 result = Jim_EvalObjVector(interp, 1, &command);
11758 }
11759 return result;
11760 }
11761
11762 /* [split] */
11763 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11764 Jim_Obj *const *argv)
11765 {
11766 const char *str, *splitChars, *noMatchStart;
11767 int splitLen, strLen, i;
11768 Jim_Obj *resObjPtr;
11769
11770 if (argc != 2 && argc != 3) {
11771 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11772 return JIM_ERR;
11773 }
11774 /* Init */
11775 if (argc == 2) {
11776 splitChars = " \n\t\r";
11777 splitLen = 4;
11778 } else {
11779 splitChars = Jim_GetString(argv[2], &splitLen);
11780 }
11781 str = Jim_GetString(argv[1], &strLen);
11782 if (!strLen) return JIM_OK;
11783 noMatchStart = str;
11784 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11785 /* Split */
11786 if (splitLen) {
11787 while (strLen) {
11788 for (i = 0; i < splitLen; i++) {
11789 if (*str == splitChars[i]) {
11790 Jim_Obj *objPtr;
11791
11792 objPtr = Jim_NewStringObj(interp, noMatchStart,
11793 (str-noMatchStart));
11794 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11795 noMatchStart = str+1;
11796 break;
11797 }
11798 }
11799 str ++;
11800 strLen --;
11801 }
11802 Jim_ListAppendElement(interp, resObjPtr,
11803 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11804 } else {
11805 /* This handles the special case of splitchars eq {}. This
11806 * is trivial but we want to perform object sharing as Tcl does. */
11807 Jim_Obj *objCache[256];
11808 const unsigned char *u = (unsigned char*) str;
11809 memset(objCache, 0, sizeof(objCache));
11810 for (i = 0; i < strLen; i++) {
11811 int c = u[i];
11812
11813 if (objCache[c] == NULL)
11814 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11815 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11816 }
11817 }
11818 Jim_SetResult(interp, resObjPtr);
11819 return JIM_OK;
11820 }
11821
11822 /* [join] */
11823 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11824 Jim_Obj *const *argv)
11825 {
11826 const char *joinStr;
11827 int joinStrLen, i, listLen;
11828 Jim_Obj *resObjPtr;
11829
11830 if (argc != 2 && argc != 3) {
11831 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11832 return JIM_ERR;
11833 }
11834 /* Init */
11835 if (argc == 2) {
11836 joinStr = " ";
11837 joinStrLen = 1;
11838 } else {
11839 joinStr = Jim_GetString(argv[2], &joinStrLen);
11840 }
11841 Jim_ListLength(interp, argv[1], &listLen);
11842 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11843 /* Split */
11844 for (i = 0; i < listLen; i++) {
11845 Jim_Obj *objPtr;
11846
11847 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11848 Jim_AppendObj(interp, resObjPtr, objPtr);
11849 if (i+1 != listLen) {
11850 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11851 }
11852 }
11853 Jim_SetResult(interp, resObjPtr);
11854 return JIM_OK;
11855 }
11856
11857 /* [format] */
11858 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11859 Jim_Obj *const *argv)
11860 {
11861 Jim_Obj *objPtr;
11862
11863 if (argc < 2) {
11864 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11865 return JIM_ERR;
11866 }
11867 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11868 if (objPtr == NULL)
11869 return JIM_ERR;
11870 Jim_SetResult(interp, objPtr);
11871 return JIM_OK;
11872 }
11873
11874 /* [scan] */
11875 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11876 Jim_Obj *const *argv)
11877 {
11878 Jim_Obj *listPtr, **outVec;
11879 int outc, i, count = 0;
11880
11881 if (argc < 3) {
11882 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11883 return JIM_ERR;
11884 }
11885 if (argv[2]->typePtr != &scanFmtStringObjType)
11886 SetScanFmtFromAny(interp, argv[2]);
11887 if (FormatGetError(argv[2]) != 0) {
11888 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11889 return JIM_ERR;
11890 }
11891 if (argc > 3) {
11892 int maxPos = FormatGetMaxPos(argv[2]);
11893 int count = FormatGetCnvCount(argv[2]);
11894 if (maxPos > argc-3) {
11895 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11896 return JIM_ERR;
11897 } else if (count != 0 && count < argc-3) {
11898 Jim_SetResultString(interp, "variable is not assigned by any "
11899 "conversion specifiers", -1);
11900 return JIM_ERR;
11901 } else if (count > argc-3) {
11902 Jim_SetResultString(interp, "different numbers of variable names and "
11903 "field specifiers", -1);
11904 return JIM_ERR;
11905 }
11906 }
11907 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11908 if (listPtr == 0)
11909 return JIM_ERR;
11910 if (argc > 3) {
11911 int len = 0;
11912 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11913 Jim_ListLength(interp, listPtr, &len);
11914 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11915 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11916 return JIM_OK;
11917 }
11918 JimListGetElements(interp, listPtr, &outc, &outVec);
11919 for (i = 0; i < outc; ++i) {
11920 if (Jim_Length(outVec[i]) > 0) {
11921 ++count;
11922 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11923 goto err;
11924 }
11925 }
11926 Jim_FreeNewObj(interp, listPtr);
11927 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11928 } else {
11929 if (listPtr == (Jim_Obj*)EOF) {
11930 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11931 return JIM_OK;
11932 }
11933 Jim_SetResult(interp, listPtr);
11934 }
11935 return JIM_OK;
11936 err:
11937 Jim_FreeNewObj(interp, listPtr);
11938 return JIM_ERR;
11939 }
11940
11941 /* [error] */
11942 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11943 Jim_Obj *const *argv)
11944 {
11945 if (argc != 2) {
11946 Jim_WrongNumArgs(interp, 1, argv, "message");
11947 return JIM_ERR;
11948 }
11949 Jim_SetResult(interp, argv[1]);
11950 return JIM_ERR;
11951 }
11952
11953 /* [lrange] */
11954 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11955 Jim_Obj *const *argv)
11956 {
11957 Jim_Obj *objPtr;
11958
11959 if (argc != 4) {
11960 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11961 return JIM_ERR;
11962 }
11963 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11964 return JIM_ERR;
11965 Jim_SetResult(interp, objPtr);
11966 return JIM_OK;
11967 }
11968
11969 /* [env] */
11970 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11971 Jim_Obj *const *argv)
11972 {
11973 const char *key;
11974 char *val;
11975
11976 if (argc == 1) {
11977 extern char **environ;
11978
11979 int i;
11980 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11981
11982 for (i = 0; environ[i]; i++) {
11983 const char *equals = strchr(environ[i], '=');
11984 if (equals) {
11985 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11986 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11987 }
11988 }
11989
11990 Jim_SetResult(interp, listObjPtr);
11991 return JIM_OK;
11992 }
11993
11994 if (argc != 2) {
11995 Jim_WrongNumArgs(interp, 1, argv, "varName");
11996 return JIM_ERR;
11997 }
11998 key = Jim_GetString(argv[1], NULL);
11999 val = getenv(key);
12000 if (val == NULL) {
12001 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12002 Jim_AppendStrings(interp, Jim_GetResult(interp),
12003 "environment variable \"",
12004 key, "\" does not exist", NULL);
12005 return JIM_ERR;
12006 }
12007 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12008 return JIM_OK;
12009 }
12010
12011 /* [source] */
12012 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12013 Jim_Obj *const *argv)
12014 {
12015 int retval;
12016
12017 if (argc != 2) {
12018 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12019 return JIM_ERR;
12020 }
12021 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12022 if (retval == JIM_ERR) {
12023 return JIM_ERR_ADDSTACK;
12024 }
12025 if (retval == JIM_RETURN)
12026 return JIM_OK;
12027 return retval;
12028 }
12029
12030 /* [lreverse] */
12031 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12032 Jim_Obj *const *argv)
12033 {
12034 Jim_Obj *revObjPtr, **ele;
12035 int len;
12036
12037 if (argc != 2) {
12038 Jim_WrongNumArgs(interp, 1, argv, "list");
12039 return JIM_ERR;
12040 }
12041 JimListGetElements(interp, argv[1], &len, &ele);
12042 len--;
12043 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12044 while (len >= 0)
12045 ListAppendElement(revObjPtr, ele[len--]);
12046 Jim_SetResult(interp, revObjPtr);
12047 return JIM_OK;
12048 }
12049
12050 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12051 {
12052 jim_wide len;
12053
12054 if (step == 0) return -1;
12055 if (start == end) return 0;
12056 else if (step > 0 && start > end) return -1;
12057 else if (step < 0 && end > start) return -1;
12058 len = end-start;
12059 if (len < 0) len = -len; /* abs(len) */
12060 if (step < 0) step = -step; /* abs(step) */
12061 len = 1 + ((len-1)/step);
12062 /* We can truncate safely to INT_MAX, the range command
12063 * will always return an error for a such long range
12064 * because Tcl lists can't be so long. */
12065 if (len > INT_MAX) len = INT_MAX;
12066 return (int)((len < 0) ? -1 : len);
12067 }
12068
12069 /* [range] */
12070 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12071 Jim_Obj *const *argv)
12072 {
12073 jim_wide start = 0, end, step = 1;
12074 int len, i;
12075 Jim_Obj *objPtr;
12076
12077 if (argc < 2 || argc > 4) {
12078 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12079 return JIM_ERR;
12080 }
12081 if (argc == 2) {
12082 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12083 return JIM_ERR;
12084 } else {
12085 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12086 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12087 return JIM_ERR;
12088 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12089 return JIM_ERR;
12090 }
12091 if ((len = JimRangeLen(start, end, step)) == -1) {
12092 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12093 return JIM_ERR;
12094 }
12095 objPtr = Jim_NewListObj(interp, NULL, 0);
12096 for (i = 0; i < len; i++)
12097 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12098 Jim_SetResult(interp, objPtr);
12099 return JIM_OK;
12100 }
12101
12102 /* [rand] */
12103 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12104 Jim_Obj *const *argv)
12105 {
12106 jim_wide min = 0, max, len, maxMul;
12107
12108 if (argc < 1 || argc > 3) {
12109 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12110 return JIM_ERR;
12111 }
12112 if (argc == 1) {
12113 max = JIM_WIDE_MAX;
12114 } else if (argc == 2) {
12115 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12116 return JIM_ERR;
12117 } else if (argc == 3) {
12118 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12119 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12120 return JIM_ERR;
12121 }
12122 len = max-min;
12123 if (len < 0) {
12124 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12125 return JIM_ERR;
12126 }
12127 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12128 while (1) {
12129 jim_wide r;
12130
12131 JimRandomBytes(interp, &r, sizeof(jim_wide));
12132 if (r < 0 || r >= maxMul) continue;
12133 r = (len == 0) ? 0 : r%len;
12134 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12135 return JIM_OK;
12136 }
12137 }
12138
12139 /* [package] */
12140 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12141 Jim_Obj *const *argv)
12142 {
12143 int option;
12144 const char *options[] = {
12145 "require", "provide", NULL
12146 };
12147 enum {OPT_REQUIRE, OPT_PROVIDE};
12148
12149 if (argc < 2) {
12150 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12151 return JIM_ERR;
12152 }
12153 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12154 JIM_ERRMSG) != JIM_OK)
12155 return JIM_ERR;
12156
12157 if (option == OPT_REQUIRE) {
12158 int exact = 0;
12159 const char *ver;
12160
12161 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12162 exact = 1;
12163 argv++;
12164 argc--;
12165 }
12166 if (argc != 3 && argc != 4) {
12167 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12168 return JIM_ERR;
12169 }
12170 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12171 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12172 JIM_ERRMSG);
12173 if (ver == NULL)
12174 return JIM_ERR_ADDSTACK;
12175 Jim_SetResultString(interp, ver, -1);
12176 } else if (option == OPT_PROVIDE) {
12177 if (argc != 4) {
12178 Jim_WrongNumArgs(interp, 2, argv, "package version");
12179 return JIM_ERR;
12180 }
12181 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12182 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12183 }
12184 return JIM_OK;
12185 }
12186
12187 static struct {
12188 const char *name;
12189 Jim_CmdProc cmdProc;
12190 } Jim_CoreCommandsTable[] = {
12191 {"set", Jim_SetCoreCommand},
12192 {"unset", Jim_UnsetCoreCommand},
12193 {"puts", Jim_PutsCoreCommand},
12194 {"+", Jim_AddCoreCommand},
12195 {"*", Jim_MulCoreCommand},
12196 {"-", Jim_SubCoreCommand},
12197 {"/", Jim_DivCoreCommand},
12198 {"incr", Jim_IncrCoreCommand},
12199 {"while", Jim_WhileCoreCommand},
12200 {"for", Jim_ForCoreCommand},
12201 {"foreach", Jim_ForeachCoreCommand},
12202 {"lmap", Jim_LmapCoreCommand},
12203 {"if", Jim_IfCoreCommand},
12204 {"switch", Jim_SwitchCoreCommand},
12205 {"list", Jim_ListCoreCommand},
12206 {"lindex", Jim_LindexCoreCommand},
12207 {"lset", Jim_LsetCoreCommand},
12208 {"llength", Jim_LlengthCoreCommand},
12209 {"lappend", Jim_LappendCoreCommand},
12210 {"linsert", Jim_LinsertCoreCommand},
12211 {"lsort", Jim_LsortCoreCommand},
12212 {"append", Jim_AppendCoreCommand},
12213 {"debug", Jim_DebugCoreCommand},
12214 {"eval", Jim_EvalCoreCommand},
12215 {"uplevel", Jim_UplevelCoreCommand},
12216 {"expr", Jim_ExprCoreCommand},
12217 {"break", Jim_BreakCoreCommand},
12218 {"continue", Jim_ContinueCoreCommand},
12219 {"proc", Jim_ProcCoreCommand},
12220 {"concat", Jim_ConcatCoreCommand},
12221 {"return", Jim_ReturnCoreCommand},
12222 {"upvar", Jim_UpvarCoreCommand},
12223 {"global", Jim_GlobalCoreCommand},
12224 {"string", Jim_StringCoreCommand},
12225 {"time", Jim_TimeCoreCommand},
12226 {"exit", Jim_ExitCoreCommand},
12227 {"catch", Jim_CatchCoreCommand},
12228 {"ref", Jim_RefCoreCommand},
12229 {"getref", Jim_GetrefCoreCommand},
12230 {"setref", Jim_SetrefCoreCommand},
12231 {"finalize", Jim_FinalizeCoreCommand},
12232 {"collect", Jim_CollectCoreCommand},
12233 {"rename", Jim_RenameCoreCommand},
12234 {"dict", Jim_DictCoreCommand},
12235 {"load", Jim_LoadCoreCommand},
12236 {"subst", Jim_SubstCoreCommand},
12237 {"info", Jim_InfoCoreCommand},
12238 {"split", Jim_SplitCoreCommand},
12239 {"join", Jim_JoinCoreCommand},
12240 {"format", Jim_FormatCoreCommand},
12241 {"scan", Jim_ScanCoreCommand},
12242 {"error", Jim_ErrorCoreCommand},
12243 {"lrange", Jim_LrangeCoreCommand},
12244 {"env", Jim_EnvCoreCommand},
12245 {"source", Jim_SourceCoreCommand},
12246 {"lreverse", Jim_LreverseCoreCommand},
12247 {"range", Jim_RangeCoreCommand},
12248 {"rand", Jim_RandCoreCommand},
12249 {"package", Jim_PackageCoreCommand},
12250 {"tailcall", Jim_TailcallCoreCommand},
12251 {NULL, NULL},
12252 };
12253
12254 /* Some Jim core command is actually a procedure written in Jim itself. */
12255 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12256 {
12257 Jim_Eval(interp, (char*)
12258 "proc lambda {arglist args} {\n"
12259 " set name [ref {} function lambdaFinalizer]\n"
12260 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12261 " return $name\n"
12262 "}\n"
12263 "proc lambdaFinalizer {name val} {\n"
12264 " rename $name {}\n"
12265 "}\n"
12266 );
12267 }
12268
12269 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12270 {
12271 int i = 0;
12272
12273 while(Jim_CoreCommandsTable[i].name != NULL) {
12274 Jim_CreateCommand(interp,
12275 Jim_CoreCommandsTable[i].name,
12276 Jim_CoreCommandsTable[i].cmdProc,
12277 NULL, NULL);
12278 i++;
12279 }
12280 Jim_RegisterCoreProcedures(interp);
12281 }
12282
12283 /* -----------------------------------------------------------------------------
12284 * Interactive prompt
12285 * ---------------------------------------------------------------------------*/
12286 void Jim_PrintErrorMessage(Jim_Interp *interp)
12287 {
12288 int len, i;
12289
12290 if (*interp->errorFileName) {
12291 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12292 interp->errorFileName, interp->errorLine);
12293 }
12294 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12295 Jim_GetString(interp->result, NULL));
12296 Jim_ListLength(interp, interp->stackTrace, &len);
12297 for (i = len-3; i >= 0; i-= 3) {
12298 Jim_Obj *objPtr;
12299 const char *proc, *file, *line;
12300
12301 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12302 proc = Jim_GetString(objPtr, NULL);
12303 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12304 JIM_NONE);
12305 file = Jim_GetString(objPtr, NULL);
12306 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12307 JIM_NONE);
12308 line = Jim_GetString(objPtr, NULL);
12309 if (*proc) {
12310 Jim_fprintf( interp, interp->cookie_stderr,
12311 "in procedure '%s' ", proc);
12312 }
12313 if (*file) {
12314 Jim_fprintf( interp, interp->cookie_stderr,
12315 "called at file \"%s\", line %s",
12316 file, line);
12317 }
12318 if (*file || *proc) {
12319 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12320 }
12321 }
12322 }
12323
12324 int Jim_InteractivePrompt(Jim_Interp *interp)
12325 {
12326 int retcode = JIM_OK;
12327 Jim_Obj *scriptObjPtr;
12328
12329 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12330 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12331 JIM_VERSION / 100, JIM_VERSION % 100);
12332 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12333 while (1) {
12334 char buf[1024];
12335 const char *result;
12336 const char *retcodestr[] = {
12337 "ok", "error", "return", "break", "continue", "eval", "exit"
12338 };
12339 int reslen;
12340
12341 if (retcode != 0) {
12342 if (retcode >= 2 && retcode <= 6)
12343 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12344 else
12345 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12346 } else
12347 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12348 Jim_fflush( interp, interp->cookie_stdout);
12349 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12350 Jim_IncrRefCount(scriptObjPtr);
12351 while(1) {
12352 const char *str;
12353 char state;
12354 int len;
12355
12356 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12357 Jim_DecrRefCount(interp, scriptObjPtr);
12358 goto out;
12359 }
12360 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12361 str = Jim_GetString(scriptObjPtr, &len);
12362 if (Jim_ScriptIsComplete(str, len, &state))
12363 break;
12364 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12365 Jim_fflush( interp, interp->cookie_stdout);
12366 }
12367 retcode = Jim_EvalObj(interp, scriptObjPtr);
12368 Jim_DecrRefCount(interp, scriptObjPtr);
12369 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12370 if (retcode == JIM_ERR) {
12371 Jim_PrintErrorMessage(interp);
12372 } else if (retcode == JIM_EXIT) {
12373 exit(Jim_GetExitCode(interp));
12374 } else {
12375 if (reslen) {
12376 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12377 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12378 }
12379 }
12380 }
12381 out:
12382 return 0;
12383 }
12384
12385 /* -----------------------------------------------------------------------------
12386 * Jim's idea of STDIO..
12387 * ---------------------------------------------------------------------------*/
12388
12389 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12390 {
12391 int r;
12392
12393 va_list ap;
12394 va_start(ap,fmt);
12395 r = Jim_vfprintf( interp, cookie, fmt,ap );
12396 va_end(ap);
12397 return r;
12398 }
12399
12400 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12401 {
12402 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12403 errno = ENOTSUP;
12404 return -1;
12405 }
12406 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12407 }
12408
12409 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12410 {
12411 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12412 errno = ENOTSUP;
12413 return 0;
12414 }
12415 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12416 }
12417
12418 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12419 {
12420 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12421 errno = ENOTSUP;
12422 return 0;
12423 }
12424 return (*(interp->cb_fread))( ptr, size, n, cookie);
12425 }
12426
12427 int Jim_fflush( Jim_Interp *interp, void *cookie )
12428 {
12429 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12430 /* pretend all is well */
12431 return 0;
12432 }
12433 return (*(interp->cb_fflush))( cookie );
12434 }
12435
12436 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12437 {
12438 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12439 errno = ENOTSUP;
12440 return NULL;
12441 }
12442 return (*(interp->cb_fgets))( s, size, cookie );
12443 }
12444 Jim_Nvp *
12445 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12446 {
12447 while( p->name ){
12448 if( 0 == strcmp( name, p->name ) ){
12449 break;
12450 }
12451 p++;
12452 }
12453 return ((Jim_Nvp *)(p));
12454 }
12455
12456 Jim_Nvp *
12457 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12458 {
12459 while( p->name ){
12460 if( 0 == strcasecmp( name, p->name ) ){
12461 break;
12462 }
12463 p++;
12464 }
12465 return ((Jim_Nvp *)(p));
12466 }
12467
12468 int
12469 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12470 const Jim_Nvp *p,
12471 Jim_Obj *o,
12472 Jim_Nvp **result )
12473 {
12474 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12475 }
12476
12477
12478 int
12479 Jim_Nvp_name2value( Jim_Interp *interp,
12480 const Jim_Nvp *_p,
12481 const char *name,
12482 Jim_Nvp **result)
12483 {
12484 const Jim_Nvp *p;
12485
12486 p = Jim_Nvp_name2value_simple( _p, name );
12487
12488 /* result */
12489 if( result ){
12490 *result = (Jim_Nvp *)(p);
12491 }
12492
12493 /* found? */
12494 if( p->name ){
12495 return JIM_OK;
12496 } else {
12497 return JIM_ERR;
12498 }
12499 }
12500
12501 int
12502 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12503 {
12504 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12505 }
12506
12507 int
12508 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12509 {
12510 const Jim_Nvp *p;
12511
12512 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12513
12514 if( puthere ){
12515 *puthere = (Jim_Nvp *)(p);
12516 }
12517 /* found */
12518 if( p->name ){
12519 return JIM_OK;
12520 } else {
12521 return JIM_ERR;
12522 }
12523 }
12524
12525
12526 int
12527 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12528 {
12529 int e;;
12530 jim_wide w;
12531
12532 e = Jim_GetWide( interp, o, &w );
12533 if( e != JIM_OK ){
12534 return e;
12535 }
12536
12537 return Jim_Nvp_value2name( interp, p, w, result );
12538 }
12539
12540 Jim_Nvp *
12541 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12542 {
12543 while( p->name ){
12544 if( value == p->value ){
12545 break;
12546 }
12547 p++;
12548 }
12549 return ((Jim_Nvp *)(p));
12550 }
12551
12552
12553 int
12554 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12555 {
12556 const Jim_Nvp *p;
12557
12558 p = Jim_Nvp_value2name_simple( _p, value );
12559
12560 if( result ){
12561 *result = (Jim_Nvp *)(p);
12562 }
12563
12564 if( p->name ){
12565 return JIM_OK;
12566 } else {
12567 return JIM_ERR;
12568 }
12569 }
12570
12571
12572 int
12573 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12574 {
12575 memset( p, 0, sizeof(*p) );
12576 p->interp = interp;
12577 p->argc = argc;
12578 p->argv = argv;
12579
12580 return JIM_OK;
12581 }
12582
12583 void
12584 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12585 {
12586 int x;
12587
12588 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12589 for( x = 0 ; x < p->argc ; x++ ){
12590 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12591 "%2d) %s\n",
12592 x,
12593 Jim_GetString( p->argv[x], NULL ) );
12594 }
12595 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12596 }
12597
12598
12599 int
12600 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12601 {
12602 Jim_Obj *o;
12603
12604 o = NULL; // failure
12605 if( goi->argc ){
12606 // success
12607 o = goi->argv[0];
12608 goi->argc -= 1;
12609 goi->argv += 1;
12610 }
12611 if( puthere ){
12612 *puthere = o;
12613 }
12614 if( o != NULL ){
12615 return JIM_OK;
12616 } else {
12617 return JIM_ERR;
12618 }
12619 }
12620
12621 int
12622 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12623 {
12624 int r;
12625 Jim_Obj *o;
12626 const char *cp;
12627
12628
12629 r = Jim_GetOpt_Obj( goi, &o );
12630 if( r == JIM_OK ){
12631 cp = Jim_GetString( o, len );
12632 if( puthere ){
12633 /* remove const */
12634 *puthere = (char *)(cp);
12635 }
12636 }
12637 return r;
12638 }
12639
12640 int
12641 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12642 {
12643 int r;
12644 Jim_Obj *o;
12645 double _safe;
12646
12647 if( puthere == NULL ){
12648 puthere = &_safe;
12649 }
12650
12651 r = Jim_GetOpt_Obj( goi, &o );
12652 if( r == JIM_OK ){
12653 r = Jim_GetDouble( goi->interp, o, puthere );
12654 if( r != JIM_OK ){
12655 Jim_SetResult_sprintf( goi->interp,
12656 "not a number: %s",
12657 Jim_GetString( o, NULL ) );
12658 }
12659 }
12660 return r;
12661 }
12662
12663 int
12664 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12665 {
12666 int r;
12667 Jim_Obj *o;
12668 jim_wide _safe;
12669
12670 if( puthere == NULL ){
12671 puthere = &_safe;
12672 }
12673
12674 r = Jim_GetOpt_Obj( goi, &o );
12675 if( r == JIM_OK ){
12676 r = Jim_GetWide( goi->interp, o, puthere );
12677 }
12678 return r;
12679 }
12680
12681 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12682 const Jim_Nvp *nvp,
12683 Jim_Nvp **puthere)
12684 {
12685 Jim_Nvp *_safe;
12686 Jim_Obj *o;
12687 int e;
12688
12689 if( puthere == NULL ){
12690 puthere = &_safe;
12691 }
12692
12693 e = Jim_GetOpt_Obj( goi, &o );
12694 if( e == JIM_OK ){
12695 e = Jim_Nvp_name2value_obj( goi->interp,
12696 nvp,
12697 o,
12698 puthere );
12699 }
12700
12701 return e;
12702 }
12703
12704 void
12705 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12706 const Jim_Nvp *nvptable,
12707 int hadprefix )
12708 {
12709 if( hadprefix ){
12710 Jim_SetResult_NvpUnknown( goi->interp,
12711 goi->argv[-2],
12712 goi->argv[-1],
12713 nvptable );
12714 } else {
12715 Jim_SetResult_NvpUnknown( goi->interp,
12716 NULL,
12717 goi->argv[-1],
12718 nvptable );
12719 }
12720 }
12721
12722
12723 int
12724 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12725 const char * const * lookup,
12726 int *puthere)
12727 {
12728 int _safe;
12729 Jim_Obj *o;
12730 int e;
12731
12732 if( puthere == NULL ){
12733 puthere = &_safe;
12734 }
12735 e = Jim_GetOpt_Obj( goi, &o );
12736 if( e == JIM_OK ){
12737 e = Jim_GetEnum( goi->interp,
12738 o,
12739 lookup,
12740 puthere,
12741 "option",
12742 JIM_ERRMSG );
12743 }
12744 return e;
12745 }
12746
12747
12748
12749 int
12750 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12751 {
12752 va_list ap;
12753 char *buf;
12754
12755 va_start(ap,fmt);
12756 buf = jim_vasprintf( fmt, ap );
12757 va_end(ap);
12758 if( buf ){
12759 Jim_SetResultString( interp, buf, -1 );
12760 jim_vasprintf_done(buf);
12761 }
12762 return JIM_OK;
12763 }
12764
12765
12766 void
12767 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12768 Jim_Obj *param_name,
12769 Jim_Obj *param_value,
12770 const Jim_Nvp *nvp )
12771 {
12772 if( param_name ){
12773 Jim_SetResult_sprintf( interp,
12774 "%s: Unknown: %s, try one of: ",
12775 Jim_GetString( param_name, NULL ),
12776 Jim_GetString( param_value, NULL ) );
12777 } else {
12778 Jim_SetResult_sprintf( interp,
12779 "Unknown param: %s, try one of: ",
12780 Jim_GetString( param_value, NULL ) );
12781 }
12782 while( nvp->name ){
12783 const char *a;
12784 const char *b;
12785
12786 if( (nvp+1)->name ){
12787 a = nvp->name;
12788 b = ", ";
12789 } else {
12790 a = "or ";
12791 b = nvp->name;
12792 }
12793 Jim_AppendStrings( interp,
12794 Jim_GetResult(interp),
12795 a, b, NULL );
12796 nvp++;
12797 }
12798 }
12799
12800
12801 static Jim_Obj *debug_string_obj;
12802
12803 const char *
12804 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12805 {
12806 int x;
12807
12808 if( debug_string_obj ){
12809 Jim_FreeObj( interp, debug_string_obj );
12810 }
12811
12812 debug_string_obj = Jim_NewEmptyStringObj( interp );
12813 for( x = 0 ; x < argc ; x++ ){
12814 Jim_AppendStrings( interp,
12815 debug_string_obj,
12816 Jim_GetString( argv[x], NULL ),
12817 " ",
12818 NULL );
12819 }
12820
12821 return Jim_GetString( debug_string_obj, NULL );
12822 }
12823
12824
12825
12826 /*
12827 * Local Variables: ***
12828 * c-basic-offset: 4 ***
12829 * tab-width: 4 ***
12830 * End: ***
12831 */

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)