Fix environ declaration for non-glibc systems
[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 #ifndef _GNU_SOURCE
53 #define _GNU_SOURCE /* for vasprintf() */
54 #endif
55 #include <stdio.h>
56 #include <stdlib.h>
57 #include <string.h>
58 #include <stdarg.h>
59 #include <ctype.h>
60 #include <limits.h>
61 #include <assert.h>
62 #include <errno.h>
63 #include <time.h>
64 #if defined(WIN32)
65 /* sys/time - need is different */
66 #else
67 #include <sys/time.h> // for gettimeofday()
68 #endif
69
70 #include "replacements.h"
71
72 /* Include the platform dependent libraries for
73 * dynamic loading of libraries. */
74 #ifdef JIM_DYNLIB
75 #if defined(_WIN32) || defined(WIN32)
76 #ifndef WIN32
77 #define WIN32 1
78 #endif
79 #ifndef STRICT
80 #define STRICT
81 #endif
82 #define WIN32_LEAN_AND_MEAN
83 #include <windows.h>
84 #if _MSC_VER >= 1000
85 #pragma warning(disable:4146)
86 #endif /* _MSC_VER */
87 #else
88 #include <dlfcn.h>
89 #endif /* WIN32 */
90 #endif /* JIM_DYNLIB */
91
92 #ifdef HAVE_UNISTD_H
93 #include <unistd.h>
94 #endif
95
96 #ifdef __ECOS
97 #include <cyg/jimtcl/jim.h>
98 #else
99 #include "jim.h"
100 #endif
101
102 #ifdef HAVE_BACKTRACE
103 #include <execinfo.h>
104 #endif
105
106 /* -----------------------------------------------------------------------------
107 * Global variables
108 * ---------------------------------------------------------------------------*/
109
110 /* A shared empty string for the objects string representation.
111 * Jim_InvalidateStringRep knows about it and don't try to free. */
112 static char *JimEmptyStringRep = (char*) "";
113
114 /* -----------------------------------------------------------------------------
115 * Required prototypes of not exported functions
116 * ---------------------------------------------------------------------------*/
117 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
118 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
119 static void JimRegisterCoreApi(Jim_Interp *interp);
120
121 static Jim_HashTableType *getJimVariablesHashTableType(void);
122
123 /* -----------------------------------------------------------------------------
124 * Utility functions
125 * ---------------------------------------------------------------------------*/
126
127 static char *
128 jim_vasprintf( const char *fmt, va_list ap )
129 {
130 #ifndef HAVE_VASPRINTF
131 /* yucky way */
132 static char buf[2048];
133 vsnprintf( buf, sizeof(buf), fmt, ap );
134 /* garentee termination */
135 buf[sizeof(buf)-1] = 0;
136 #else
137 char *buf;
138 int result;
139 result = vasprintf( &buf, fmt, ap );
140 if (result < 0) exit(-1);
141 #endif
142 return buf;
143 }
144
145 static void
146 jim_vasprintf_done( void *buf )
147 {
148 #ifndef HAVE_VASPRINTF
149 (void)(buf);
150 #else
151 free(buf);
152 #endif
153 }
154
155
156 /*
157 * Convert a string to a jim_wide INTEGER.
158 * This function originates from BSD.
159 *
160 * Ignores `locale' stuff. Assumes that the upper and lower case
161 * alphabets and digits are each contiguous.
162 */
163 #ifdef HAVE_LONG_LONG
164 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
165 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
166 {
167 register const char *s;
168 register unsigned jim_wide acc;
169 register unsigned char c;
170 register unsigned jim_wide qbase, cutoff;
171 register int neg, any, cutlim;
172
173 /*
174 * Skip white space and pick up leading +/- sign if any.
175 * If base is 0, allow 0x for hex and 0 for octal, else
176 * assume decimal; if base is already 16, allow 0x.
177 */
178 s = nptr;
179 do {
180 c = *s++;
181 } while (isspace(c));
182 if (c == '-') {
183 neg = 1;
184 c = *s++;
185 } else {
186 neg = 0;
187 if (c == '+')
188 c = *s++;
189 }
190 if ((base == 0 || base == 16) &&
191 c == '0' && (*s == 'x' || *s == 'X')) {
192 c = s[1];
193 s += 2;
194 base = 16;
195 }
196 if (base == 0)
197 base = c == '0' ? 8 : 10;
198
199 /*
200 * Compute the cutoff value between legal numbers and illegal
201 * numbers. That is the largest legal value, divided by the
202 * base. An input number that is greater than this value, if
203 * followed by a legal input character, is too big. One that
204 * is equal to this value may be valid or not; the limit
205 * between valid and invalid numbers is then based on the last
206 * digit. For instance, if the range for quads is
207 * [-9223372036854775808..9223372036854775807] and the input base
208 * is 10, cutoff will be set to 922337203685477580 and cutlim to
209 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
210 * accumulated a value > 922337203685477580, or equal but the
211 * next digit is > 7 (or 8), the number is too big, and we will
212 * return a range error.
213 *
214 * Set any if any `digits' consumed; make it negative to indicate
215 * overflow.
216 */
217 qbase = (unsigned)base;
218 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
219 : LLONG_MAX;
220 cutlim = (int)(cutoff % qbase);
221 cutoff /= qbase;
222 for (acc = 0, any = 0;; c = *s++) {
223 if (!JimIsAscii(c))
224 break;
225 if (isdigit(c))
226 c -= '0';
227 else if (isalpha(c))
228 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
229 else
230 break;
231 if (c >= base)
232 break;
233 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
234 any = -1;
235 else {
236 any = 1;
237 acc *= qbase;
238 acc += c;
239 }
240 }
241 if (any < 0) {
242 acc = neg ? LLONG_MIN : LLONG_MAX;
243 errno = ERANGE;
244 } else if (neg)
245 acc = -acc;
246 if (endptr != 0)
247 *endptr = (char *)(any ? s - 1 : nptr);
248 return (acc);
249 }
250 #endif
251
252 /* Glob-style pattern matching. */
253 static int JimStringMatch(const char *pattern, int patternLen,
254 const char *string, int stringLen, int nocase)
255 {
256 while(patternLen) {
257 switch(pattern[0]) {
258 case '*':
259 while (pattern[1] == '*') {
260 pattern++;
261 patternLen--;
262 }
263 if (patternLen == 1)
264 return 1; /* match */
265 while(stringLen) {
266 if (JimStringMatch(pattern+1, patternLen-1,
267 string, stringLen, nocase))
268 return 1; /* match */
269 string++;
270 stringLen--;
271 }
272 return 0; /* no match */
273 break;
274 case '?':
275 if (stringLen == 0)
276 return 0; /* no match */
277 string++;
278 stringLen--;
279 break;
280 case '[':
281 {
282 int not, match;
283
284 pattern++;
285 patternLen--;
286 not = pattern[0] == '^';
287 if (not) {
288 pattern++;
289 patternLen--;
290 }
291 match = 0;
292 while(1) {
293 if (pattern[0] == '\\') {
294 pattern++;
295 patternLen--;
296 if (pattern[0] == string[0])
297 match = 1;
298 } else if (pattern[0] == ']') {
299 break;
300 } else if (patternLen == 0) {
301 pattern--;
302 patternLen++;
303 break;
304 } else if (pattern[1] == '-' && patternLen >= 3) {
305 int start = pattern[0];
306 int end = pattern[2];
307 int c = string[0];
308 if (start > end) {
309 int t = start;
310 start = end;
311 end = t;
312 }
313 if (nocase) {
314 start = tolower(start);
315 end = tolower(end);
316 c = tolower(c);
317 }
318 pattern += 2;
319 patternLen -= 2;
320 if (c >= start && c <= end)
321 match = 1;
322 } else {
323 if (!nocase) {
324 if (pattern[0] == string[0])
325 match = 1;
326 } else {
327 if (tolower((int)pattern[0]) == tolower((int)string[0]))
328 match = 1;
329 }
330 }
331 pattern++;
332 patternLen--;
333 }
334 if (not)
335 match = !match;
336 if (!match)
337 return 0; /* no match */
338 string++;
339 stringLen--;
340 break;
341 }
342 case '\\':
343 if (patternLen >= 2) {
344 pattern++;
345 patternLen--;
346 }
347 /* fall through */
348 default:
349 if (!nocase) {
350 if (pattern[0] != string[0])
351 return 0; /* no match */
352 } else {
353 if (tolower((int)pattern[0]) != tolower((int)string[0]))
354 return 0; /* no match */
355 }
356 string++;
357 stringLen--;
358 break;
359 }
360 pattern++;
361 patternLen--;
362 if (stringLen == 0) {
363 while(*pattern == '*') {
364 pattern++;
365 patternLen--;
366 }
367 break;
368 }
369 }
370 if (patternLen == 0 && stringLen == 0)
371 return 1;
372 return 0;
373 }
374
375 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
376 int nocase)
377 {
378 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
379
380 if (nocase == 0) {
381 while(l1 && l2) {
382 if (*u1 != *u2)
383 return (int)*u1-*u2;
384 u1++; u2++; l1--; l2--;
385 }
386 if (!l1 && !l2) return 0;
387 return l1-l2;
388 } else {
389 while(l1 && l2) {
390 if (tolower((int)*u1) != tolower((int)*u2))
391 return tolower((int)*u1)-tolower((int)*u2);
392 u1++; u2++; l1--; l2--;
393 }
394 if (!l1 && !l2) return 0;
395 return l1-l2;
396 }
397 }
398
399 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
400 * The index of the first occurrence of s1 in s2 is returned.
401 * If s1 is not found inside s2, -1 is returned. */
402 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
403 {
404 int i;
405
406 if (!l1 || !l2 || l1 > l2) return -1;
407 if (index < 0) index = 0;
408 s2 += index;
409 for (i = index; i <= l2-l1; i++) {
410 if (memcmp(s2, s1, l1) == 0)
411 return i;
412 s2++;
413 }
414 return -1;
415 }
416
417 int Jim_WideToString(char *buf, jim_wide wideValue)
418 {
419 const char *fmt = "%" JIM_WIDE_MODIFIER;
420 return sprintf(buf, fmt, wideValue);
421 }
422
423 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
424 {
425 char *endptr;
426
427 #ifdef HAVE_LONG_LONG
428 *widePtr = JimStrtoll(str, &endptr, base);
429 #else
430 *widePtr = strtol(str, &endptr, base);
431 #endif
432 if ((str[0] == '\0') || (str == endptr) )
433 return JIM_ERR;
434 if (endptr[0] != '\0') {
435 while(*endptr) {
436 if (!isspace((int)*endptr))
437 return JIM_ERR;
438 endptr++;
439 }
440 }
441 return JIM_OK;
442 }
443
444 int Jim_StringToIndex(const char *str, int *intPtr)
445 {
446 char *endptr;
447
448 *intPtr = strtol(str, &endptr, 10);
449 if ( (str[0] == '\0') || (str == endptr) )
450 return JIM_ERR;
451 if (endptr[0] != '\0') {
452 while(*endptr) {
453 if (!isspace((int)*endptr))
454 return JIM_ERR;
455 endptr++;
456 }
457 }
458 return JIM_OK;
459 }
460
461 /* The string representation of references has two features in order
462 * to make the GC faster. The first is that every reference starts
463 * with a non common character '~', in order to make the string matching
464 * fater. The second is that the reference string rep his 32 characters
465 * in length, this allows to avoid to check every object with a string
466 * repr < 32, and usually there are many of this objects. */
467
468 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
469
470 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
471 {
472 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
473 sprintf(buf, fmt, refPtr->tag, id);
474 return JIM_REFERENCE_SPACE;
475 }
476
477 int Jim_DoubleToString(char *buf, double doubleValue)
478 {
479 char *s;
480 int len;
481
482 len = sprintf(buf, "%.17g", doubleValue);
483 s = buf;
484 while(*s) {
485 if (*s == '.') return len;
486 s++;
487 }
488 /* Add a final ".0" if it's a number. But not
489 * for NaN or InF */
490 if (isdigit((int)buf[0])
491 || ((buf[0] == '-' || buf[0] == '+')
492 && isdigit((int)buf[1]))) {
493 s[0] = '.';
494 s[1] = '0';
495 s[2] = '\0';
496 return len+2;
497 }
498 return len;
499 }
500
501 int Jim_StringToDouble(const char *str, double *doublePtr)
502 {
503 char *endptr;
504
505 *doublePtr = strtod(str, &endptr);
506 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
507 return JIM_ERR;
508 return JIM_OK;
509 }
510
511 static jim_wide JimPowWide(jim_wide b, jim_wide e)
512 {
513 jim_wide i, res = 1;
514 if ((b==0 && e!=0) || (e<0)) return 0;
515 for(i=0; i<e; i++) {res *= b;}
516 return res;
517 }
518
519 /* -----------------------------------------------------------------------------
520 * Special functions
521 * ---------------------------------------------------------------------------*/
522
523 /* Note that 'interp' may be NULL if not available in the
524 * context of the panic. It's only useful to get the error
525 * file descriptor, it will default to stderr otherwise. */
526 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
527 {
528 va_list ap;
529
530 va_start(ap, fmt);
531 /*
532 * Send it here first.. Assuming STDIO still works
533 */
534 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
535 vfprintf(stderr, fmt, ap);
536 fprintf(stderr, JIM_NL JIM_NL);
537 va_end(ap);
538
539 #ifdef HAVE_BACKTRACE
540 {
541 void *array[40];
542 int size, i;
543 char **strings;
544
545 size = backtrace(array, 40);
546 strings = backtrace_symbols(array, size);
547 for (i = 0; i < size; i++)
548 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
549 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
550 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
551 }
552 #endif
553
554 /* This may actually crash... we do it last */
555 if( interp && interp->cookie_stderr ){
556 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
557 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
558 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
559 }
560 abort();
561 }
562
563 /* -----------------------------------------------------------------------------
564 * Memory allocation
565 * ---------------------------------------------------------------------------*/
566
567 /* Macro used for memory debugging.
568 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
569 * and similary for Jim_Realloc and Jim_Free */
570 #if 0
571 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
572 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
573 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
574 #endif
575
576 void *Jim_Alloc(int size)
577 {
578 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
579 if (size==0)
580 size=1;
581 void *p = malloc(size);
582 if (p == NULL)
583 Jim_Panic(NULL,"malloc: Out of memory");
584 return p;
585 }
586
587 void Jim_Free(void *ptr) {
588 free(ptr);
589 }
590
591 void *Jim_Realloc(void *ptr, int size)
592 {
593 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
594 if (size==0)
595 size=1;
596 void *p = realloc(ptr, size);
597 if (p == NULL)
598 Jim_Panic(NULL,"realloc: Out of memory");
599 return p;
600 }
601
602 char *Jim_StrDup(const char *s)
603 {
604 int l = strlen(s);
605 char *copy = Jim_Alloc(l+1);
606
607 memcpy(copy, s, l+1);
608 return copy;
609 }
610
611 char *Jim_StrDupLen(const char *s, int l)
612 {
613 char *copy = Jim_Alloc(l+1);
614
615 memcpy(copy, s, l+1);
616 copy[l] = 0; /* Just to be sure, original could be substring */
617 return copy;
618 }
619
620 /* -----------------------------------------------------------------------------
621 * Time related functions
622 * ---------------------------------------------------------------------------*/
623 /* Returns microseconds of CPU used since start. */
624 static jim_wide JimClock(void)
625 {
626 #if (defined WIN32) && !(defined JIM_ANSIC)
627 LARGE_INTEGER t, f;
628 QueryPerformanceFrequency(&f);
629 QueryPerformanceCounter(&t);
630 return (long)((t.QuadPart * 1000000) / f.QuadPart);
631 #else /* !WIN32 */
632 clock_t clocks = clock();
633
634 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
635 #endif /* WIN32 */
636 }
637
638 /* -----------------------------------------------------------------------------
639 * Hash Tables
640 * ---------------------------------------------------------------------------*/
641
642 /* -------------------------- private prototypes ---------------------------- */
643 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
644 static unsigned int JimHashTableNextPower(unsigned int size);
645 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
646
647 /* -------------------------- hash functions -------------------------------- */
648
649 /* Thomas Wang's 32 bit Mix Function */
650 unsigned int Jim_IntHashFunction(unsigned int key)
651 {
652 key += ~(key << 15);
653 key ^= (key >> 10);
654 key += (key << 3);
655 key ^= (key >> 6);
656 key += ~(key << 11);
657 key ^= (key >> 16);
658 return key;
659 }
660
661 /* Identity hash function for integer keys */
662 unsigned int Jim_IdentityHashFunction(unsigned int key)
663 {
664 return key;
665 }
666
667 /* Generic hash function (we are using to multiply by 9 and add the byte
668 * as Tcl) */
669 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
670 {
671 unsigned int h = 0;
672 while(len--)
673 h += (h<<3)+*buf++;
674 return h;
675 }
676
677 /* ----------------------------- API implementation ------------------------- */
678 /* reset an hashtable already initialized with ht_init().
679 * NOTE: This function should only called by ht_destroy(). */
680 static void JimResetHashTable(Jim_HashTable *ht)
681 {
682 ht->table = NULL;
683 ht->size = 0;
684 ht->sizemask = 0;
685 ht->used = 0;
686 ht->collisions = 0;
687 }
688
689 /* Initialize the hash table */
690 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
691 void *privDataPtr)
692 {
693 JimResetHashTable(ht);
694 ht->type = type;
695 ht->privdata = privDataPtr;
696 return JIM_OK;
697 }
698
699 /* Resize the table to the minimal size that contains all the elements,
700 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
701 int Jim_ResizeHashTable(Jim_HashTable *ht)
702 {
703 int minimal = ht->used;
704
705 if (minimal < JIM_HT_INITIAL_SIZE)
706 minimal = JIM_HT_INITIAL_SIZE;
707 return Jim_ExpandHashTable(ht, minimal);
708 }
709
710 /* Expand or create the hashtable */
711 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
712 {
713 Jim_HashTable n; /* the new hashtable */
714 unsigned int realsize = JimHashTableNextPower(size), i;
715
716 /* the size is invalid if it is smaller than the number of
717 * elements already inside the hashtable */
718 if (ht->used >= size)
719 return JIM_ERR;
720
721 Jim_InitHashTable(&n, ht->type, ht->privdata);
722 n.size = realsize;
723 n.sizemask = realsize-1;
724 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
725
726 /* Initialize all the pointers to NULL */
727 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
728
729 /* Copy all the elements from the old to the new table:
730 * note that if the old hash table is empty ht->size is zero,
731 * so Jim_ExpandHashTable just creates an hash table. */
732 n.used = ht->used;
733 for (i = 0; i < ht->size && ht->used > 0; i++) {
734 Jim_HashEntry *he, *nextHe;
735
736 if (ht->table[i] == NULL) continue;
737
738 /* For each hash entry on this slot... */
739 he = ht->table[i];
740 while(he) {
741 unsigned int h;
742
743 nextHe = he->next;
744 /* Get the new element index */
745 h = Jim_HashKey(ht, he->key) & n.sizemask;
746 he->next = n.table[h];
747 n.table[h] = he;
748 ht->used--;
749 /* Pass to the next element */
750 he = nextHe;
751 }
752 }
753 assert(ht->used == 0);
754 Jim_Free(ht->table);
755
756 /* Remap the new hashtable in the old */
757 *ht = n;
758 return JIM_OK;
759 }
760
761 /* Add an element to the target hash table */
762 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
763 {
764 int index;
765 Jim_HashEntry *entry;
766
767 /* Get the index of the new element, or -1 if
768 * the element already exists. */
769 if ((index = JimInsertHashEntry(ht, key)) == -1)
770 return JIM_ERR;
771
772 /* Allocates the memory and stores key */
773 entry = Jim_Alloc(sizeof(*entry));
774 entry->next = ht->table[index];
775 ht->table[index] = entry;
776
777 /* Set the hash entry fields. */
778 Jim_SetHashKey(ht, entry, key);
779 Jim_SetHashVal(ht, entry, val);
780 ht->used++;
781 return JIM_OK;
782 }
783
784 /* Add an element, discarding the old if the key already exists */
785 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
786 {
787 Jim_HashEntry *entry;
788
789 /* Try to add the element. If the key
790 * does not exists Jim_AddHashEntry will suceed. */
791 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
792 return JIM_OK;
793 /* It already exists, get the entry */
794 entry = Jim_FindHashEntry(ht, key);
795 /* Free the old value and set the new one */
796 Jim_FreeEntryVal(ht, entry);
797 Jim_SetHashVal(ht, entry, val);
798 return JIM_OK;
799 }
800
801 /* Search and remove an element */
802 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
803 {
804 unsigned int h;
805 Jim_HashEntry *he, *prevHe;
806
807 if (ht->size == 0)
808 return JIM_ERR;
809 h = Jim_HashKey(ht, key) & ht->sizemask;
810 he = ht->table[h];
811
812 prevHe = NULL;
813 while(he) {
814 if (Jim_CompareHashKeys(ht, key, he->key)) {
815 /* Unlink the element from the list */
816 if (prevHe)
817 prevHe->next = he->next;
818 else
819 ht->table[h] = he->next;
820 Jim_FreeEntryKey(ht, he);
821 Jim_FreeEntryVal(ht, he);
822 Jim_Free(he);
823 ht->used--;
824 return JIM_OK;
825 }
826 prevHe = he;
827 he = he->next;
828 }
829 return JIM_ERR; /* not found */
830 }
831
832 /* Destroy an entire hash table */
833 int Jim_FreeHashTable(Jim_HashTable *ht)
834 {
835 unsigned int i;
836
837 /* Free all the elements */
838 for (i = 0; i < ht->size && ht->used > 0; i++) {
839 Jim_HashEntry *he, *nextHe;
840
841 if ((he = ht->table[i]) == NULL) continue;
842 while(he) {
843 nextHe = he->next;
844 Jim_FreeEntryKey(ht, he);
845 Jim_FreeEntryVal(ht, he);
846 Jim_Free(he);
847 ht->used--;
848 he = nextHe;
849 }
850 }
851 /* Free the table and the allocated cache structure */
852 Jim_Free(ht->table);
853 /* Re-initialize the table */
854 JimResetHashTable(ht);
855 return JIM_OK; /* never fails */
856 }
857
858 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
859 {
860 Jim_HashEntry *he;
861 unsigned int h;
862
863 if (ht->size == 0) return NULL;
864 h = Jim_HashKey(ht, key) & ht->sizemask;
865 he = ht->table[h];
866 while(he) {
867 if (Jim_CompareHashKeys(ht, key, he->key))
868 return he;
869 he = he->next;
870 }
871 return NULL;
872 }
873
874 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
875 {
876 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
877
878 iter->ht = ht;
879 iter->index = -1;
880 iter->entry = NULL;
881 iter->nextEntry = NULL;
882 return iter;
883 }
884
885 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
886 {
887 while (1) {
888 if (iter->entry == NULL) {
889 iter->index++;
890 if (iter->index >=
891 (signed)iter->ht->size) break;
892 iter->entry = iter->ht->table[iter->index];
893 } else {
894 iter->entry = iter->nextEntry;
895 }
896 if (iter->entry) {
897 /* We need to save the 'next' here, the iterator user
898 * may delete the entry we are returning. */
899 iter->nextEntry = iter->entry->next;
900 return iter->entry;
901 }
902 }
903 return NULL;
904 }
905
906 /* ------------------------- private functions ------------------------------ */
907
908 /* Expand the hash table if needed */
909 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
910 {
911 /* If the hash table is empty expand it to the intial size,
912 * if the table is "full" dobule its size. */
913 if (ht->size == 0)
914 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
915 if (ht->size == ht->used)
916 return Jim_ExpandHashTable(ht, ht->size*2);
917 return JIM_OK;
918 }
919
920 /* Our hash table capability is a power of two */
921 static unsigned int JimHashTableNextPower(unsigned int size)
922 {
923 unsigned int i = JIM_HT_INITIAL_SIZE;
924
925 if (size >= 2147483648U)
926 return 2147483648U;
927 while(1) {
928 if (i >= size)
929 return i;
930 i *= 2;
931 }
932 }
933
934 /* Returns the index of a free slot that can be populated with
935 * an hash entry for the given 'key'.
936 * If the key already exists, -1 is returned. */
937 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
938 {
939 unsigned int h;
940 Jim_HashEntry *he;
941
942 /* Expand the hashtable if needed */
943 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
944 return -1;
945 /* Compute the key hash value */
946 h = Jim_HashKey(ht, key) & ht->sizemask;
947 /* Search if this slot does not already contain the given key */
948 he = ht->table[h];
949 while(he) {
950 if (Jim_CompareHashKeys(ht, key, he->key))
951 return -1;
952 he = he->next;
953 }
954 return h;
955 }
956
957 /* ----------------------- StringCopy Hash Table Type ------------------------*/
958
959 static unsigned int JimStringCopyHTHashFunction(const void *key)
960 {
961 return Jim_GenHashFunction(key, strlen(key));
962 }
963
964 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
965 {
966 int len = strlen(key);
967 char *copy = Jim_Alloc(len+1);
968 JIM_NOTUSED(privdata);
969
970 memcpy(copy, key, len);
971 copy[len] = '\0';
972 return copy;
973 }
974
975 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
976 {
977 int len = strlen(val);
978 char *copy = Jim_Alloc(len+1);
979 JIM_NOTUSED(privdata);
980
981 memcpy(copy, val, len);
982 copy[len] = '\0';
983 return copy;
984 }
985
986 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
987 const void *key2)
988 {
989 JIM_NOTUSED(privdata);
990
991 return strcmp(key1, key2) == 0;
992 }
993
994 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
995 {
996 JIM_NOTUSED(privdata);
997
998 Jim_Free((void*)key); /* ATTENTION: const cast */
999 }
1000
1001 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
1002 {
1003 JIM_NOTUSED(privdata);
1004
1005 Jim_Free((void*)val); /* ATTENTION: const cast */
1006 }
1007
1008 static Jim_HashTableType JimStringCopyHashTableType = {
1009 JimStringCopyHTHashFunction, /* hash function */
1010 JimStringCopyHTKeyDup, /* key dup */
1011 NULL, /* val dup */
1012 JimStringCopyHTKeyCompare, /* key compare */
1013 JimStringCopyHTKeyDestructor, /* key destructor */
1014 NULL /* val destructor */
1015 };
1016
1017 /* This is like StringCopy but does not auto-duplicate the key.
1018 * It's used for intepreter's shared strings. */
1019 static Jim_HashTableType JimSharedStringsHashTableType = {
1020 JimStringCopyHTHashFunction, /* hash function */
1021 NULL, /* key dup */
1022 NULL, /* val dup */
1023 JimStringCopyHTKeyCompare, /* key compare */
1024 JimStringCopyHTKeyDestructor, /* key destructor */
1025 NULL /* val destructor */
1026 };
1027
1028 /* This is like StringCopy but also automatically handle dynamic
1029 * allocated C strings as values. */
1030 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1031 JimStringCopyHTHashFunction, /* hash function */
1032 JimStringCopyHTKeyDup, /* key dup */
1033 JimStringKeyValCopyHTValDup, /* val dup */
1034 JimStringCopyHTKeyCompare, /* key compare */
1035 JimStringCopyHTKeyDestructor, /* key destructor */
1036 JimStringKeyValCopyHTValDestructor, /* val destructor */
1037 };
1038
1039 typedef struct AssocDataValue {
1040 Jim_InterpDeleteProc *delProc;
1041 void *data;
1042 } AssocDataValue;
1043
1044 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1045 {
1046 AssocDataValue *assocPtr = (AssocDataValue *)data;
1047 if (assocPtr->delProc != NULL)
1048 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1049 Jim_Free(data);
1050 }
1051
1052 static Jim_HashTableType JimAssocDataHashTableType = {
1053 JimStringCopyHTHashFunction, /* hash function */
1054 JimStringCopyHTKeyDup, /* key dup */
1055 NULL, /* val dup */
1056 JimStringCopyHTKeyCompare, /* key compare */
1057 JimStringCopyHTKeyDestructor, /* key destructor */
1058 JimAssocDataHashTableValueDestructor /* val destructor */
1059 };
1060
1061 /* -----------------------------------------------------------------------------
1062 * Stack - This is a simple generic stack implementation. It is used for
1063 * example in the 'expr' expression compiler.
1064 * ---------------------------------------------------------------------------*/
1065 void Jim_InitStack(Jim_Stack *stack)
1066 {
1067 stack->len = 0;
1068 stack->maxlen = 0;
1069 stack->vector = NULL;
1070 }
1071
1072 void Jim_FreeStack(Jim_Stack *stack)
1073 {
1074 Jim_Free(stack->vector);
1075 }
1076
1077 int Jim_StackLen(Jim_Stack *stack)
1078 {
1079 return stack->len;
1080 }
1081
1082 void Jim_StackPush(Jim_Stack *stack, void *element) {
1083 int neededLen = stack->len+1;
1084 if (neededLen > stack->maxlen) {
1085 stack->maxlen = neededLen*2;
1086 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1087 }
1088 stack->vector[stack->len] = element;
1089 stack->len++;
1090 }
1091
1092 void *Jim_StackPop(Jim_Stack *stack)
1093 {
1094 if (stack->len == 0) return NULL;
1095 stack->len--;
1096 return stack->vector[stack->len];
1097 }
1098
1099 void *Jim_StackPeek(Jim_Stack *stack)
1100 {
1101 if (stack->len == 0) return NULL;
1102 return stack->vector[stack->len-1];
1103 }
1104
1105 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1106 {
1107 int i;
1108
1109 for (i = 0; i < stack->len; i++)
1110 freeFunc(stack->vector[i]);
1111 }
1112
1113 /* -----------------------------------------------------------------------------
1114 * Parser
1115 * ---------------------------------------------------------------------------*/
1116
1117 /* Token types */
1118 #define JIM_TT_NONE -1 /* No token returned */
1119 #define JIM_TT_STR 0 /* simple string */
1120 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1121 #define JIM_TT_VAR 2 /* var substitution */
1122 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1123 #define JIM_TT_CMD 4 /* command substitution */
1124 #define JIM_TT_SEP 5 /* word separator */
1125 #define JIM_TT_EOL 6 /* line separator */
1126
1127 /* Additional token types needed for expressions */
1128 #define JIM_TT_SUBEXPR_START 7
1129 #define JIM_TT_SUBEXPR_END 8
1130 #define JIM_TT_EXPR_NUMBER 9
1131 #define JIM_TT_EXPR_OPERATOR 10
1132
1133 /* Parser states */
1134 #define JIM_PS_DEF 0 /* Default state */
1135 #define JIM_PS_QUOTE 1 /* Inside "" */
1136
1137 /* Parser context structure. The same context is used both to parse
1138 * Tcl scripts and lists. */
1139 struct JimParserCtx {
1140 const char *prg; /* Program text */
1141 const char *p; /* Pointer to the point of the program we are parsing */
1142 int len; /* Left length of 'prg' */
1143 int linenr; /* Current line number */
1144 const char *tstart;
1145 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1146 int tline; /* Line number of the returned token */
1147 int tt; /* Token type */
1148 int eof; /* Non zero if EOF condition is true. */
1149 int state; /* Parser state */
1150 int comment; /* Non zero if the next chars may be a comment. */
1151 };
1152
1153 #define JimParserEof(c) ((c)->eof)
1154 #define JimParserTstart(c) ((c)->tstart)
1155 #define JimParserTend(c) ((c)->tend)
1156 #define JimParserTtype(c) ((c)->tt)
1157 #define JimParserTline(c) ((c)->tline)
1158
1159 static int JimParseScript(struct JimParserCtx *pc);
1160 static int JimParseSep(struct JimParserCtx *pc);
1161 static int JimParseEol(struct JimParserCtx *pc);
1162 static int JimParseCmd(struct JimParserCtx *pc);
1163 static int JimParseVar(struct JimParserCtx *pc);
1164 static int JimParseBrace(struct JimParserCtx *pc);
1165 static int JimParseStr(struct JimParserCtx *pc);
1166 static int JimParseComment(struct JimParserCtx *pc);
1167 static char *JimParserGetToken(struct JimParserCtx *pc,
1168 int *lenPtr, int *typePtr, int *linePtr);
1169
1170 /* Initialize a parser context.
1171 * 'prg' is a pointer to the program text, linenr is the line
1172 * number of the first line contained in the program. */
1173 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1174 int len, int linenr)
1175 {
1176 pc->prg = prg;
1177 pc->p = prg;
1178 pc->len = len;
1179 pc->tstart = NULL;
1180 pc->tend = NULL;
1181 pc->tline = 0;
1182 pc->tt = JIM_TT_NONE;
1183 pc->eof = 0;
1184 pc->state = JIM_PS_DEF;
1185 pc->linenr = linenr;
1186 pc->comment = 1;
1187 }
1188
1189 int JimParseScript(struct JimParserCtx *pc)
1190 {
1191 while(1) { /* the while is used to reiterate with continue if needed */
1192 if (!pc->len) {
1193 pc->tstart = pc->p;
1194 pc->tend = pc->p-1;
1195 pc->tline = pc->linenr;
1196 pc->tt = JIM_TT_EOL;
1197 pc->eof = 1;
1198 return JIM_OK;
1199 }
1200 switch(*(pc->p)) {
1201 case '\\':
1202 if (*(pc->p+1) == '\n')
1203 return JimParseSep(pc);
1204 else {
1205 pc->comment = 0;
1206 return JimParseStr(pc);
1207 }
1208 break;
1209 case ' ':
1210 case '\t':
1211 case '\r':
1212 if (pc->state == JIM_PS_DEF)
1213 return JimParseSep(pc);
1214 else {
1215 pc->comment = 0;
1216 return JimParseStr(pc);
1217 }
1218 break;
1219 case '\n':
1220 case ';':
1221 pc->comment = 1;
1222 if (pc->state == JIM_PS_DEF)
1223 return JimParseEol(pc);
1224 else
1225 return JimParseStr(pc);
1226 break;
1227 case '[':
1228 pc->comment = 0;
1229 return JimParseCmd(pc);
1230 break;
1231 case '$':
1232 pc->comment = 0;
1233 if (JimParseVar(pc) == JIM_ERR) {
1234 pc->tstart = pc->tend = pc->p++; pc->len--;
1235 pc->tline = pc->linenr;
1236 pc->tt = JIM_TT_STR;
1237 return JIM_OK;
1238 } else
1239 return JIM_OK;
1240 break;
1241 case '#':
1242 if (pc->comment) {
1243 JimParseComment(pc);
1244 continue;
1245 } else {
1246 return JimParseStr(pc);
1247 }
1248 default:
1249 pc->comment = 0;
1250 return JimParseStr(pc);
1251 break;
1252 }
1253 return JIM_OK;
1254 }
1255 }
1256
1257 int JimParseSep(struct JimParserCtx *pc)
1258 {
1259 pc->tstart = pc->p;
1260 pc->tline = pc->linenr;
1261 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1262 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1263 if (*pc->p == '\\') {
1264 pc->p++; pc->len--;
1265 pc->linenr++;
1266 }
1267 pc->p++; pc->len--;
1268 }
1269 pc->tend = pc->p-1;
1270 pc->tt = JIM_TT_SEP;
1271 return JIM_OK;
1272 }
1273
1274 int JimParseEol(struct JimParserCtx *pc)
1275 {
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (*pc->p == ' ' || *pc->p == '\n' ||
1279 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1280 if (*pc->p == '\n')
1281 pc->linenr++;
1282 pc->p++; pc->len--;
1283 }
1284 pc->tend = pc->p-1;
1285 pc->tt = JIM_TT_EOL;
1286 return JIM_OK;
1287 }
1288
1289 /* Todo. Don't stop if ']' appears inside {} or quoted.
1290 * Also should handle the case of puts [string length "]"] */
1291 int JimParseCmd(struct JimParserCtx *pc)
1292 {
1293 int level = 1;
1294 int blevel = 0;
1295
1296 pc->tstart = ++pc->p; pc->len--;
1297 pc->tline = pc->linenr;
1298 while (1) {
1299 if (pc->len == 0) {
1300 break;
1301 } else if (*pc->p == '[' && blevel == 0) {
1302 level++;
1303 } else if (*pc->p == ']' && blevel == 0) {
1304 level--;
1305 if (!level) break;
1306 } else if (*pc->p == '\\') {
1307 pc->p++; pc->len--;
1308 } else if (*pc->p == '{') {
1309 blevel++;
1310 } else if (*pc->p == '}') {
1311 if (blevel != 0)
1312 blevel--;
1313 } else if (*pc->p == '\n')
1314 pc->linenr++;
1315 pc->p++; pc->len--;
1316 }
1317 pc->tend = pc->p-1;
1318 pc->tt = JIM_TT_CMD;
1319 if (*pc->p == ']') {
1320 pc->p++; pc->len--;
1321 }
1322 return JIM_OK;
1323 }
1324
1325 int JimParseVar(struct JimParserCtx *pc)
1326 {
1327 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1328
1329 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1330 pc->tline = pc->linenr;
1331 if (*pc->p == '{') {
1332 pc->tstart = ++pc->p; pc->len--;
1333 brace = 1;
1334 }
1335 if (brace) {
1336 while (!stop) {
1337 if (*pc->p == '}' || pc->len == 0) {
1338 pc->tend = pc->p-1;
1339 stop = 1;
1340 if (pc->len == 0)
1341 break;
1342 }
1343 else if (*pc->p == '\n')
1344 pc->linenr++;
1345 pc->p++; pc->len--;
1346 }
1347 } else {
1348 /* Include leading colons */
1349 while (*pc->p == ':') {
1350 pc->p++;
1351 pc->len--;
1352 }
1353 while (!stop) {
1354 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1355 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1356 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1357 stop = 1;
1358 else {
1359 pc->p++; pc->len--;
1360 }
1361 }
1362 /* Parse [dict get] syntax sugar. */
1363 if (*pc->p == '(') {
1364 while (*pc->p != ')' && pc->len) {
1365 pc->p++; pc->len--;
1366 if (*pc->p == '\\' && pc->len >= 2) {
1367 pc->p += 2; pc->len -= 2;
1368 }
1369 }
1370 if (*pc->p != '\0') {
1371 pc->p++; pc->len--;
1372 }
1373 ttype = JIM_TT_DICTSUGAR;
1374 }
1375 pc->tend = pc->p-1;
1376 }
1377 /* Check if we parsed just the '$' character.
1378 * That's not a variable so an error is returned
1379 * to tell the state machine to consider this '$' just
1380 * a string. */
1381 if (pc->tstart == pc->p) {
1382 pc->p--; pc->len++;
1383 return JIM_ERR;
1384 }
1385 pc->tt = ttype;
1386 return JIM_OK;
1387 }
1388
1389 int JimParseBrace(struct JimParserCtx *pc)
1390 {
1391 int level = 1;
1392
1393 pc->tstart = ++pc->p; pc->len--;
1394 pc->tline = pc->linenr;
1395 while (1) {
1396 if (*pc->p == '\\' && pc->len >= 2) {
1397 pc->p++; pc->len--;
1398 if (*pc->p == '\n')
1399 pc->linenr++;
1400 } else if (*pc->p == '{') {
1401 level++;
1402 } else if (pc->len == 0 || *pc->p == '}') {
1403 level--;
1404 if (pc->len == 0 || level == 0) {
1405 pc->tend = pc->p-1;
1406 if (pc->len != 0) {
1407 pc->p++; pc->len--;
1408 }
1409 pc->tt = JIM_TT_STR;
1410 return JIM_OK;
1411 }
1412 } else if (*pc->p == '\n') {
1413 pc->linenr++;
1414 }
1415 pc->p++; pc->len--;
1416 }
1417 return JIM_OK; /* unreached */
1418 }
1419
1420 int JimParseStr(struct JimParserCtx *pc)
1421 {
1422 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1423 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1424 if (newword && *pc->p == '{') {
1425 return JimParseBrace(pc);
1426 } else if (newword && *pc->p == '"') {
1427 pc->state = JIM_PS_QUOTE;
1428 pc->p++; pc->len--;
1429 }
1430 pc->tstart = pc->p;
1431 pc->tline = pc->linenr;
1432 while (1) {
1433 if (pc->len == 0) {
1434 pc->tend = pc->p-1;
1435 pc->tt = JIM_TT_ESC;
1436 return JIM_OK;
1437 }
1438 switch(*pc->p) {
1439 case '\\':
1440 if (pc->state == JIM_PS_DEF &&
1441 *(pc->p+1) == '\n') {
1442 pc->tend = pc->p-1;
1443 pc->tt = JIM_TT_ESC;
1444 return JIM_OK;
1445 }
1446 if (pc->len >= 2) {
1447 pc->p++; pc->len--;
1448 }
1449 break;
1450 case '$':
1451 case '[':
1452 pc->tend = pc->p-1;
1453 pc->tt = JIM_TT_ESC;
1454 return JIM_OK;
1455 case ' ':
1456 case '\t':
1457 case '\n':
1458 case '\r':
1459 case ';':
1460 if (pc->state == JIM_PS_DEF) {
1461 pc->tend = pc->p-1;
1462 pc->tt = JIM_TT_ESC;
1463 return JIM_OK;
1464 } else if (*pc->p == '\n') {
1465 pc->linenr++;
1466 }
1467 break;
1468 case '"':
1469 if (pc->state == JIM_PS_QUOTE) {
1470 pc->tend = pc->p-1;
1471 pc->tt = JIM_TT_ESC;
1472 pc->p++; pc->len--;
1473 pc->state = JIM_PS_DEF;
1474 return JIM_OK;
1475 }
1476 break;
1477 }
1478 pc->p++; pc->len--;
1479 }
1480 return JIM_OK; /* unreached */
1481 }
1482
1483 int JimParseComment(struct JimParserCtx *pc)
1484 {
1485 while (*pc->p) {
1486 if (*pc->p == '\n') {
1487 pc->linenr++;
1488 if (*(pc->p-1) != '\\') {
1489 pc->p++; pc->len--;
1490 return JIM_OK;
1491 }
1492 }
1493 pc->p++; pc->len--;
1494 }
1495 return JIM_OK;
1496 }
1497
1498 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1499 static int xdigitval(int c)
1500 {
1501 if (c >= '0' && c <= '9') return c-'0';
1502 if (c >= 'a' && c <= 'f') return c-'a'+10;
1503 if (c >= 'A' && c <= 'F') return c-'A'+10;
1504 return -1;
1505 }
1506
1507 static int odigitval(int c)
1508 {
1509 if (c >= '0' && c <= '7') return c-'0';
1510 return -1;
1511 }
1512
1513 /* Perform Tcl escape substitution of 's', storing the result
1514 * string into 'dest'. The escaped string is guaranteed to
1515 * be the same length or shorted than the source string.
1516 * Slen is the length of the string at 's', if it's -1 the string
1517 * length will be calculated by the function.
1518 *
1519 * The function returns the length of the resulting string. */
1520 static int JimEscape(char *dest, const char *s, int slen)
1521 {
1522 char *p = dest;
1523 int i, len;
1524
1525 if (slen == -1)
1526 slen = strlen(s);
1527
1528 for (i = 0; i < slen; i++) {
1529 switch(s[i]) {
1530 case '\\':
1531 switch(s[i+1]) {
1532 case 'a': *p++ = 0x7; i++; break;
1533 case 'b': *p++ = 0x8; i++; break;
1534 case 'f': *p++ = 0xc; i++; break;
1535 case 'n': *p++ = 0xa; i++; break;
1536 case 'r': *p++ = 0xd; i++; break;
1537 case 't': *p++ = 0x9; i++; break;
1538 case 'v': *p++ = 0xb; i++; break;
1539 case '\0': *p++ = '\\'; i++; break;
1540 case '\n': *p++ = ' '; i++; break;
1541 default:
1542 if (s[i+1] == 'x') {
1543 int val = 0;
1544 int c = xdigitval(s[i+2]);
1545 if (c == -1) {
1546 *p++ = 'x';
1547 i++;
1548 break;
1549 }
1550 val = c;
1551 c = xdigitval(s[i+3]);
1552 if (c == -1) {
1553 *p++ = val;
1554 i += 2;
1555 break;
1556 }
1557 val = (val*16)+c;
1558 *p++ = val;
1559 i += 3;
1560 break;
1561 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1562 {
1563 int val = 0;
1564 int c = odigitval(s[i+1]);
1565 val = c;
1566 c = odigitval(s[i+2]);
1567 if (c == -1) {
1568 *p++ = val;
1569 i ++;
1570 break;
1571 }
1572 val = (val*8)+c;
1573 c = odigitval(s[i+3]);
1574 if (c == -1) {
1575 *p++ = val;
1576 i += 2;
1577 break;
1578 }
1579 val = (val*8)+c;
1580 *p++ = val;
1581 i += 3;
1582 } else {
1583 *p++ = s[i+1];
1584 i++;
1585 }
1586 break;
1587 }
1588 break;
1589 default:
1590 *p++ = s[i];
1591 break;
1592 }
1593 }
1594 len = p-dest;
1595 *p++ = '\0';
1596 return len;
1597 }
1598
1599 /* Returns a dynamically allocated copy of the current token in the
1600 * parser context. The function perform conversion of escapes if
1601 * the token is of type JIM_TT_ESC.
1602 *
1603 * Note that after the conversion, tokens that are grouped with
1604 * braces in the source code, are always recognizable from the
1605 * identical string obtained in a different way from the type.
1606 *
1607 * For exmple the string:
1608 *
1609 * {expand}$a
1610 *
1611 * will return as first token "expand", of type JIM_TT_STR
1612 *
1613 * While the string:
1614 *
1615 * expand$a
1616 *
1617 * will return as first token "expand", of type JIM_TT_ESC
1618 */
1619 char *JimParserGetToken(struct JimParserCtx *pc,
1620 int *lenPtr, int *typePtr, int *linePtr)
1621 {
1622 const char *start, *end;
1623 char *token;
1624 int len;
1625
1626 start = JimParserTstart(pc);
1627 end = JimParserTend(pc);
1628 if (start > end) {
1629 if (lenPtr) *lenPtr = 0;
1630 if (typePtr) *typePtr = JimParserTtype(pc);
1631 if (linePtr) *linePtr = JimParserTline(pc);
1632 token = Jim_Alloc(1);
1633 token[0] = '\0';
1634 return token;
1635 }
1636 len = (end-start)+1;
1637 token = Jim_Alloc(len+1);
1638 if (JimParserTtype(pc) != JIM_TT_ESC) {
1639 /* No escape conversion needed? Just copy it. */
1640 memcpy(token, start, len);
1641 token[len] = '\0';
1642 } else {
1643 /* Else convert the escape chars. */
1644 len = JimEscape(token, start, len);
1645 }
1646 if (lenPtr) *lenPtr = len;
1647 if (typePtr) *typePtr = JimParserTtype(pc);
1648 if (linePtr) *linePtr = JimParserTline(pc);
1649 return token;
1650 }
1651
1652 /* The following functin is not really part of the parsing engine of Jim,
1653 * but it somewhat related. Given an string and its length, it tries
1654 * to guess if the script is complete or there are instead " " or { }
1655 * open and not completed. This is useful for interactive shells
1656 * implementation and for [info complete].
1657 *
1658 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1659 * '{' on scripts incomplete missing one or more '}' to be balanced.
1660 * '"' on scripts incomplete missing a '"' char.
1661 *
1662 * If the script is complete, 1 is returned, otherwise 0. */
1663 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1664 {
1665 int level = 0;
1666 int state = ' ';
1667
1668 while(len) {
1669 switch (*s) {
1670 case '\\':
1671 if (len > 1)
1672 s++;
1673 break;
1674 case '"':
1675 if (state == ' ') {
1676 state = '"';
1677 } else if (state == '"') {
1678 state = ' ';
1679 }
1680 break;
1681 case '{':
1682 if (state == '{') {
1683 level++;
1684 } else if (state == ' ') {
1685 state = '{';
1686 level++;
1687 }
1688 break;
1689 case '}':
1690 if (state == '{') {
1691 level--;
1692 if (level == 0)
1693 state = ' ';
1694 }
1695 break;
1696 }
1697 s++;
1698 len--;
1699 }
1700 if (stateCharPtr)
1701 *stateCharPtr = state;
1702 return state == ' ';
1703 }
1704
1705 /* -----------------------------------------------------------------------------
1706 * Tcl Lists parsing
1707 * ---------------------------------------------------------------------------*/
1708 static int JimParseListSep(struct JimParserCtx *pc);
1709 static int JimParseListStr(struct JimParserCtx *pc);
1710
1711 int JimParseList(struct JimParserCtx *pc)
1712 {
1713 if (pc->len == 0) {
1714 pc->tstart = pc->tend = pc->p;
1715 pc->tline = pc->linenr;
1716 pc->tt = JIM_TT_EOL;
1717 pc->eof = 1;
1718 return JIM_OK;
1719 }
1720 switch(*pc->p) {
1721 case ' ':
1722 case '\n':
1723 case '\t':
1724 case '\r':
1725 if (pc->state == JIM_PS_DEF)
1726 return JimParseListSep(pc);
1727 else
1728 return JimParseListStr(pc);
1729 break;
1730 default:
1731 return JimParseListStr(pc);
1732 break;
1733 }
1734 return JIM_OK;
1735 }
1736
1737 int JimParseListSep(struct JimParserCtx *pc)
1738 {
1739 pc->tstart = pc->p;
1740 pc->tline = pc->linenr;
1741 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1742 {
1743 pc->p++; pc->len--;
1744 }
1745 pc->tend = pc->p-1;
1746 pc->tt = JIM_TT_SEP;
1747 return JIM_OK;
1748 }
1749
1750 int JimParseListStr(struct JimParserCtx *pc)
1751 {
1752 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1753 pc->tt == JIM_TT_NONE);
1754 if (newword && *pc->p == '{') {
1755 return JimParseBrace(pc);
1756 } else if (newword && *pc->p == '"') {
1757 pc->state = JIM_PS_QUOTE;
1758 pc->p++; pc->len--;
1759 }
1760 pc->tstart = pc->p;
1761 pc->tline = pc->linenr;
1762 while (1) {
1763 if (pc->len == 0) {
1764 pc->tend = pc->p-1;
1765 pc->tt = JIM_TT_ESC;
1766 return JIM_OK;
1767 }
1768 switch(*pc->p) {
1769 case '\\':
1770 pc->p++; pc->len--;
1771 break;
1772 case ' ':
1773 case '\t':
1774 case '\n':
1775 case '\r':
1776 if (pc->state == JIM_PS_DEF) {
1777 pc->tend = pc->p-1;
1778 pc->tt = JIM_TT_ESC;
1779 return JIM_OK;
1780 } else if (*pc->p == '\n') {
1781 pc->linenr++;
1782 }
1783 break;
1784 case '"':
1785 if (pc->state == JIM_PS_QUOTE) {
1786 pc->tend = pc->p-1;
1787 pc->tt = JIM_TT_ESC;
1788 pc->p++; pc->len--;
1789 pc->state = JIM_PS_DEF;
1790 return JIM_OK;
1791 }
1792 break;
1793 }
1794 pc->p++; pc->len--;
1795 }
1796 return JIM_OK; /* unreached */
1797 }
1798
1799 /* -----------------------------------------------------------------------------
1800 * Jim_Obj related functions
1801 * ---------------------------------------------------------------------------*/
1802
1803 /* Return a new initialized object. */
1804 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1805 {
1806 Jim_Obj *objPtr;
1807
1808 /* -- Check if there are objects in the free list -- */
1809 if (interp->freeList != NULL) {
1810 /* -- Unlink the object from the free list -- */
1811 objPtr = interp->freeList;
1812 interp->freeList = objPtr->nextObjPtr;
1813 } else {
1814 /* -- No ready to use objects: allocate a new one -- */
1815 objPtr = Jim_Alloc(sizeof(*objPtr));
1816 }
1817
1818 /* Object is returned with refCount of 0. Every
1819 * kind of GC implemented should take care to don't try
1820 * to scan objects with refCount == 0. */
1821 objPtr->refCount = 0;
1822 /* All the other fields are left not initialized to save time.
1823 * The caller will probably want set they to the right
1824 * value anyway. */
1825
1826 /* -- Put the object into the live list -- */
1827 objPtr->prevObjPtr = NULL;
1828 objPtr->nextObjPtr = interp->liveList;
1829 if (interp->liveList)
1830 interp->liveList->prevObjPtr = objPtr;
1831 interp->liveList = objPtr;
1832
1833 return objPtr;
1834 }
1835
1836 /* Free an object. Actually objects are never freed, but
1837 * just moved to the free objects list, where they will be
1838 * reused by Jim_NewObj(). */
1839 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1840 {
1841 /* Check if the object was already freed, panic. */
1842 if (objPtr->refCount != 0) {
1843 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1844 objPtr->refCount);
1845 }
1846 /* Free the internal representation */
1847 Jim_FreeIntRep(interp, objPtr);
1848 /* Free the string representation */
1849 if (objPtr->bytes != NULL) {
1850 if (objPtr->bytes != JimEmptyStringRep)
1851 Jim_Free(objPtr->bytes);
1852 }
1853 /* Unlink the object from the live objects list */
1854 if (objPtr->prevObjPtr)
1855 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1856 if (objPtr->nextObjPtr)
1857 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1858 if (interp->liveList == objPtr)
1859 interp->liveList = objPtr->nextObjPtr;
1860 /* Link the object into the free objects list */
1861 objPtr->prevObjPtr = NULL;
1862 objPtr->nextObjPtr = interp->freeList;
1863 if (interp->freeList)
1864 interp->freeList->prevObjPtr = objPtr;
1865 interp->freeList = objPtr;
1866 objPtr->refCount = -1;
1867 }
1868
1869 /* Invalidate the string representation of an object. */
1870 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1871 {
1872 if (objPtr->bytes != NULL) {
1873 if (objPtr->bytes != JimEmptyStringRep)
1874 Jim_Free(objPtr->bytes);
1875 }
1876 objPtr->bytes = NULL;
1877 }
1878
1879 #define Jim_SetStringRep(o, b, l) \
1880 do { (o)->bytes = b; (o)->length = l; } while (0)
1881
1882 /* Set the initial string representation for an object.
1883 * Does not try to free an old one. */
1884 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1885 {
1886 if (length == 0) {
1887 objPtr->bytes = JimEmptyStringRep;
1888 objPtr->length = 0;
1889 } else {
1890 objPtr->bytes = Jim_Alloc(length+1);
1891 objPtr->length = length;
1892 memcpy(objPtr->bytes, bytes, length);
1893 objPtr->bytes[length] = '\0';
1894 }
1895 }
1896
1897 /* Duplicate an object. The returned object has refcount = 0. */
1898 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1899 {
1900 Jim_Obj *dupPtr;
1901
1902 dupPtr = Jim_NewObj(interp);
1903 if (objPtr->bytes == NULL) {
1904 /* Object does not have a valid string representation. */
1905 dupPtr->bytes = NULL;
1906 } else {
1907 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1908 }
1909 if (objPtr->typePtr != NULL) {
1910 if (objPtr->typePtr->dupIntRepProc == NULL) {
1911 dupPtr->internalRep = objPtr->internalRep;
1912 } else {
1913 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1914 }
1915 dupPtr->typePtr = objPtr->typePtr;
1916 } else {
1917 dupPtr->typePtr = NULL;
1918 }
1919 return dupPtr;
1920 }
1921
1922 /* Return the string representation for objPtr. If the object
1923 * string representation is invalid, calls the method to create
1924 * a new one starting from the internal representation of the object. */
1925 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1926 {
1927 if (objPtr->bytes == NULL) {
1928 /* Invalid string repr. Generate it. */
1929 if (objPtr->typePtr->updateStringProc == NULL) {
1930 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1931 objPtr->typePtr->name);
1932 }
1933 objPtr->typePtr->updateStringProc(objPtr);
1934 }
1935 if (lenPtr)
1936 *lenPtr = objPtr->length;
1937 return objPtr->bytes;
1938 }
1939
1940 /* Just returns the length of the object's string rep */
1941 int Jim_Length(Jim_Obj *objPtr)
1942 {
1943 int len;
1944
1945 Jim_GetString(objPtr, &len);
1946 return len;
1947 }
1948
1949 /* -----------------------------------------------------------------------------
1950 * String Object
1951 * ---------------------------------------------------------------------------*/
1952 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1953 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1954
1955 static Jim_ObjType stringObjType = {
1956 "string",
1957 NULL,
1958 DupStringInternalRep,
1959 NULL,
1960 JIM_TYPE_REFERENCES,
1961 };
1962
1963 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1964 {
1965 JIM_NOTUSED(interp);
1966
1967 /* This is a bit subtle: the only caller of this function
1968 * should be Jim_DuplicateObj(), that will copy the
1969 * string representaion. After the copy, the duplicated
1970 * object will not have more room in teh buffer than
1971 * srcPtr->length bytes. So we just set it to length. */
1972 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1973 }
1974
1975 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1976 {
1977 /* Get a fresh string representation. */
1978 (void) Jim_GetString(objPtr, NULL);
1979 /* Free any other internal representation. */
1980 Jim_FreeIntRep(interp, objPtr);
1981 /* Set it as string, i.e. just set the maxLength field. */
1982 objPtr->typePtr = &stringObjType;
1983 objPtr->internalRep.strValue.maxLength = objPtr->length;
1984 return JIM_OK;
1985 }
1986
1987 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1988 {
1989 Jim_Obj *objPtr = Jim_NewObj(interp);
1990
1991 if (len == -1)
1992 len = strlen(s);
1993 /* Alloc/Set the string rep. */
1994 if (len == 0) {
1995 objPtr->bytes = JimEmptyStringRep;
1996 objPtr->length = 0;
1997 } else {
1998 objPtr->bytes = Jim_Alloc(len+1);
1999 objPtr->length = len;
2000 memcpy(objPtr->bytes, s, len);
2001 objPtr->bytes[len] = '\0';
2002 }
2003
2004 /* No typePtr field for the vanilla string object. */
2005 objPtr->typePtr = NULL;
2006 return objPtr;
2007 }
2008
2009 /* This version does not try to duplicate the 's' pointer, but
2010 * use it directly. */
2011 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2012 {
2013 Jim_Obj *objPtr = Jim_NewObj(interp);
2014
2015 if (len == -1)
2016 len = strlen(s);
2017 Jim_SetStringRep(objPtr, s, len);
2018 objPtr->typePtr = NULL;
2019 return objPtr;
2020 }
2021
2022 /* Low-level string append. Use it only against objects
2023 * of type "string". */
2024 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2025 {
2026 int needlen;
2027
2028 if (len == -1)
2029 len = strlen(str);
2030 needlen = objPtr->length + len;
2031 if (objPtr->internalRep.strValue.maxLength < needlen ||
2032 objPtr->internalRep.strValue.maxLength == 0) {
2033 if (objPtr->bytes == JimEmptyStringRep) {
2034 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2035 } else {
2036 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2037 }
2038 objPtr->internalRep.strValue.maxLength = needlen*2;
2039 }
2040 memcpy(objPtr->bytes + objPtr->length, str, len);
2041 objPtr->bytes[objPtr->length+len] = '\0';
2042 objPtr->length += len;
2043 }
2044
2045 /* Low-level wrapper to append an object. */
2046 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2047 {
2048 int len;
2049 const char *str;
2050
2051 str = Jim_GetString(appendObjPtr, &len);
2052 StringAppendString(objPtr, str, len);
2053 }
2054
2055 /* Higher level API to append strings to objects. */
2056 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2057 int len)
2058 {
2059 if (Jim_IsShared(objPtr))
2060 Jim_Panic(interp,"Jim_AppendString called with shared object");
2061 if (objPtr->typePtr != &stringObjType)
2062 SetStringFromAny(interp, objPtr);
2063 StringAppendString(objPtr, str, len);
2064 }
2065
2066 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2067 {
2068 char *buf;
2069 va_list ap;
2070
2071 va_start( ap, fmt );
2072 buf = jim_vasprintf( fmt, ap );
2073 va_end(ap);
2074
2075 if( buf ){
2076 Jim_AppendString( interp, objPtr, buf, -1 );
2077 jim_vasprintf_done(buf);
2078 }
2079 }
2080
2081
2082 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2083 Jim_Obj *appendObjPtr)
2084 {
2085 int len;
2086 const char *str;
2087
2088 str = Jim_GetString(appendObjPtr, &len);
2089 Jim_AppendString(interp, objPtr, str, len);
2090 }
2091
2092 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2093 {
2094 va_list ap;
2095
2096 if (objPtr->typePtr != &stringObjType)
2097 SetStringFromAny(interp, objPtr);
2098 va_start(ap, objPtr);
2099 while (1) {
2100 char *s = va_arg(ap, char*);
2101
2102 if (s == NULL) break;
2103 Jim_AppendString(interp, objPtr, s, -1);
2104 }
2105 va_end(ap);
2106 }
2107
2108 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2109 {
2110 const char *aStr, *bStr;
2111 int aLen, bLen, i;
2112
2113 if (aObjPtr == bObjPtr) return 1;
2114 aStr = Jim_GetString(aObjPtr, &aLen);
2115 bStr = Jim_GetString(bObjPtr, &bLen);
2116 if (aLen != bLen) return 0;
2117 if (nocase == 0)
2118 return memcmp(aStr, bStr, aLen) == 0;
2119 for (i = 0; i < aLen; i++) {
2120 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2121 return 0;
2122 }
2123 return 1;
2124 }
2125
2126 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2127 int nocase)
2128 {
2129 const char *pattern, *string;
2130 int patternLen, stringLen;
2131
2132 pattern = Jim_GetString(patternObjPtr, &patternLen);
2133 string = Jim_GetString(objPtr, &stringLen);
2134 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2135 }
2136
2137 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2138 Jim_Obj *secondObjPtr, int nocase)
2139 {
2140 const char *s1, *s2;
2141 int l1, l2;
2142
2143 s1 = Jim_GetString(firstObjPtr, &l1);
2144 s2 = Jim_GetString(secondObjPtr, &l2);
2145 return JimStringCompare(s1, l1, s2, l2, nocase);
2146 }
2147
2148 /* Convert a range, as returned by Jim_GetRange(), into
2149 * an absolute index into an object of the specified length.
2150 * This function may return negative values, or values
2151 * bigger or equal to the length of the list if the index
2152 * is out of range. */
2153 static int JimRelToAbsIndex(int len, int index)
2154 {
2155 if (index < 0)
2156 return len + index;
2157 return index;
2158 }
2159
2160 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2161 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2162 * for implementation of commands like [string range] and [lrange].
2163 *
2164 * The resulting range is guaranteed to address valid elements of
2165 * the structure. */
2166 static void JimRelToAbsRange(int len, int first, int last,
2167 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2168 {
2169 int rangeLen;
2170
2171 if (first > last) {
2172 rangeLen = 0;
2173 } else {
2174 rangeLen = last-first+1;
2175 if (rangeLen) {
2176 if (first < 0) {
2177 rangeLen += first;
2178 first = 0;
2179 }
2180 if (last >= len) {
2181 rangeLen -= (last-(len-1));
2182 last = len-1;
2183 }
2184 }
2185 }
2186 if (rangeLen < 0) rangeLen = 0;
2187
2188 *firstPtr = first;
2189 *lastPtr = last;
2190 *rangeLenPtr = rangeLen;
2191 }
2192
2193 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2194 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2195 {
2196 int first, last;
2197 const char *str;
2198 int len, rangeLen;
2199
2200 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2201 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2202 return NULL;
2203 str = Jim_GetString(strObjPtr, &len);
2204 first = JimRelToAbsIndex(len, first);
2205 last = JimRelToAbsIndex(len, last);
2206 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2207 return Jim_NewStringObj(interp, str+first, rangeLen);
2208 }
2209
2210 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2211 {
2212 char *buf;
2213 int i;
2214 if (strObjPtr->typePtr != &stringObjType) {
2215 SetStringFromAny(interp, strObjPtr);
2216 }
2217
2218 buf = Jim_Alloc(strObjPtr->length+1);
2219
2220 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2221 for (i = 0; i < strObjPtr->length; i++)
2222 buf[i] = tolower(buf[i]);
2223 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2224 }
2225
2226 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2227 {
2228 char *buf;
2229 int i;
2230 if (strObjPtr->typePtr != &stringObjType) {
2231 SetStringFromAny(interp, strObjPtr);
2232 }
2233
2234 buf = Jim_Alloc(strObjPtr->length+1);
2235
2236 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2237 for (i = 0; i < strObjPtr->length; i++)
2238 buf[i] = toupper(buf[i]);
2239 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2240 }
2241
2242 /* This is the core of the [format] command.
2243 * TODO: Lots of things work - via a hack
2244 * However, no format item can be >= JIM_MAX_FMT
2245 */
2246 #define JIM_MAX_FMT 2048
2247 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2248 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2249 {
2250 const char *fmt, *_fmt;
2251 int fmtLen;
2252 Jim_Obj *resObjPtr;
2253
2254
2255 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2256 _fmt = fmt;
2257 resObjPtr = Jim_NewStringObj(interp, "", 0);
2258 while (fmtLen) {
2259 const char *p = fmt;
2260 char spec[2], c;
2261 jim_wide wideValue;
2262 double doubleValue;
2263 /* we cheat and use Sprintf()! */
2264 char fmt_str[100];
2265 char *cp;
2266 int width;
2267 int ljust;
2268 int zpad;
2269 int spad;
2270 int altfm;
2271 int forceplus;
2272 int prec;
2273 int inprec;
2274 int haveprec;
2275 int accum;
2276
2277 while (*fmt != '%' && fmtLen) {
2278 fmt++; fmtLen--;
2279 }
2280 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2281 if (fmtLen == 0)
2282 break;
2283 fmt++; fmtLen--; /* skip '%' */
2284 zpad = 0;
2285 spad = 0;
2286 width = -1;
2287 ljust = 0;
2288 altfm = 0;
2289 forceplus = 0;
2290 inprec = 0;
2291 haveprec = 0;
2292 prec = -1; /* not found yet */
2293 next_fmt:
2294 if( fmtLen <= 0 ){
2295 break;
2296 }
2297 switch( *fmt ){
2298 /* terminals */
2299 case 'b': /* binary - not all printfs() do this */
2300 case 's': /* string */
2301 case 'i': /* integer */
2302 case 'd': /* decimal */
2303 case 'x': /* hex */
2304 case 'X': /* CAP hex */
2305 case 'c': /* char */
2306 case 'o': /* octal */
2307 case 'u': /* unsigned */
2308 case 'f': /* float */
2309 break;
2310
2311 /* non-terminals */
2312 case '0': /* zero pad */
2313 zpad = 1;
2314 fmt++; fmtLen--;
2315 goto next_fmt;
2316 break;
2317 case '+':
2318 forceplus = 1;
2319 fmt++; fmtLen--;
2320 goto next_fmt;
2321 break;
2322 case ' ': /* sign space */
2323 spad = 1;
2324 fmt++; fmtLen--;
2325 goto next_fmt;
2326 break;
2327 case '-':
2328 ljust = 1;
2329 fmt++; fmtLen--;
2330 goto next_fmt;
2331 break;
2332 case '#':
2333 altfm = 1;
2334 fmt++; fmtLen--;
2335 goto next_fmt;
2336
2337 case '.':
2338 inprec = 1;
2339 fmt++; fmtLen--;
2340 goto next_fmt;
2341 break;
2342 case '1':
2343 case '2':
2344 case '3':
2345 case '4':
2346 case '5':
2347 case '6':
2348 case '7':
2349 case '8':
2350 case '9':
2351 accum = 0;
2352 while( isdigit(*fmt) && (fmtLen > 0) ){
2353 accum = (accum * 10) + (*fmt - '0');
2354 fmt++; fmtLen--;
2355 }
2356 if( inprec ){
2357 haveprec = 1;
2358 prec = accum;
2359 } else {
2360 width = accum;
2361 }
2362 goto next_fmt;
2363 case '*':
2364 /* suck up the next item as an integer */
2365 fmt++; fmtLen--;
2366 objc--;
2367 if( objc <= 0 ){
2368 goto not_enough_args;
2369 }
2370 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2371 Jim_FreeNewObj(interp, resObjPtr );
2372 return NULL;
2373 }
2374 if( inprec ){
2375 haveprec = 1;
2376 prec = wideValue;
2377 if( prec < 0 ){
2378 /* man 3 printf says */
2379 /* if prec is negative, it is zero */
2380 prec = 0;
2381 }
2382 } else {
2383 width = wideValue;
2384 if( width < 0 ){
2385 ljust = 1;
2386 width = -width;
2387 }
2388 }
2389 objv++;
2390 goto next_fmt;
2391 break;
2392 }
2393
2394
2395 if (*fmt != '%') {
2396 if (objc == 0) {
2397 not_enough_args:
2398 Jim_FreeNewObj(interp, resObjPtr);
2399 Jim_SetResultString(interp,
2400 "not enough arguments for all format specifiers", -1);
2401 return NULL;
2402 } else {
2403 objc--;
2404 }
2405 }
2406
2407 /*
2408 * Create the formatter
2409 * cause we cheat and use sprintf()
2410 */
2411 cp = fmt_str;
2412 *cp++ = '%';
2413 if( altfm ){
2414 *cp++ = '#';
2415 }
2416 if( forceplus ){
2417 *cp++ = '+';
2418 } else if( spad ){
2419 /* PLUS overrides */
2420 *cp++ = ' ';
2421 }
2422 if( ljust ){
2423 *cp++ = '-';
2424 }
2425 if( zpad ){
2426 *cp++ = '0';
2427 }
2428 if( width > 0 ){
2429 sprintf( cp, "%d", width );
2430 /* skip ahead */
2431 cp = strchr(cp,0);
2432 }
2433 /* did we find a period? */
2434 if( inprec ){
2435 /* then add it */
2436 *cp++ = '.';
2437 /* did something occur after the period? */
2438 if( haveprec ){
2439 sprintf( cp, "%d", prec );
2440 }
2441 cp = strchr(cp,0);
2442 }
2443 *cp = 0;
2444
2445 /* here we do the work */
2446 /* actually - we make sprintf() do it for us */
2447 switch(*fmt) {
2448 case 's':
2449 *cp++ = 's';
2450 *cp = 0;
2451 /* BUG: we do not handled embeded NULLs */
2452 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2453 break;
2454 case 'c':
2455 *cp++ = 'c';
2456 *cp = 0;
2457 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2458 Jim_FreeNewObj(interp, resObjPtr);
2459 return NULL;
2460 }
2461 c = (char) wideValue;
2462 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2463 break;
2464 case 'f':
2465 case 'F':
2466 case 'g':
2467 case 'G':
2468 case 'e':
2469 case 'E':
2470 *cp++ = *fmt;
2471 *cp = 0;
2472 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2473 Jim_FreeNewObj( interp, resObjPtr );
2474 return NULL;
2475 }
2476 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2477 break;
2478 case 'b':
2479 case 'd':
2480 case 'o':
2481 case 'i':
2482 case 'u':
2483 case 'x':
2484 case 'X':
2485 /* jim widevaluse are 64bit */
2486 if( sizeof(jim_wide) == sizeof(long long) ){
2487 *cp++ = 'l';
2488 *cp++ = 'l';
2489 } else {
2490 *cp++ = 'l';
2491 }
2492 *cp++ = *fmt;
2493 *cp = 0;
2494 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2495 Jim_FreeNewObj(interp, resObjPtr);
2496 return NULL;
2497 }
2498 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2499 break;
2500 case '%':
2501 sprintf_buf[0] = '%';
2502 sprintf_buf[1] = 0;
2503 objv--; /* undo the objv++ below */
2504 break;
2505 default:
2506 spec[0] = *fmt; spec[1] = '\0';
2507 Jim_FreeNewObj(interp, resObjPtr);
2508 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2509 Jim_AppendStrings(interp, Jim_GetResult(interp),
2510 "bad field specifier \"", spec, "\"", NULL);
2511 return NULL;
2512 }
2513 /* force terminate */
2514 #if 0
2515 printf("FMT was: %s\n", fmt_str );
2516 printf("RES was: |%s|\n", sprintf_buf );
2517 #endif
2518
2519 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2520 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2521 /* next obj */
2522 objv++;
2523 fmt++;
2524 fmtLen--;
2525 }
2526 return resObjPtr;
2527 }
2528
2529 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2530 int objc, Jim_Obj *const *objv)
2531 {
2532 char *sprintf_buf=malloc(JIM_MAX_FMT);
2533 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2534 free(sprintf_buf);
2535 return t;
2536 }
2537
2538 /* -----------------------------------------------------------------------------
2539 * Compared String Object
2540 * ---------------------------------------------------------------------------*/
2541
2542 /* This is strange object that allows to compare a C literal string
2543 * with a Jim object in very short time if the same comparison is done
2544 * multiple times. For example every time the [if] command is executed,
2545 * Jim has to check if a given argument is "else". This comparions if
2546 * the code has no errors are true most of the times, so we can cache
2547 * inside the object the pointer of the string of the last matching
2548 * comparison. Because most C compilers perform literal sharing,
2549 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2550 * this works pretty well even if comparisons are at different places
2551 * inside the C code. */
2552
2553 static Jim_ObjType comparedStringObjType = {
2554 "compared-string",
2555 NULL,
2556 NULL,
2557 NULL,
2558 JIM_TYPE_REFERENCES,
2559 };
2560
2561 /* The only way this object is exposed to the API is via the following
2562 * function. Returns true if the string and the object string repr.
2563 * are the same, otherwise zero is returned.
2564 *
2565 * Note: this isn't binary safe, but it hardly needs to be.*/
2566 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2567 const char *str)
2568 {
2569 if (objPtr->typePtr == &comparedStringObjType &&
2570 objPtr->internalRep.ptr == str)
2571 return 1;
2572 else {
2573 const char *objStr = Jim_GetString(objPtr, NULL);
2574 if (strcmp(str, objStr) != 0) return 0;
2575 if (objPtr->typePtr != &comparedStringObjType) {
2576 Jim_FreeIntRep(interp, objPtr);
2577 objPtr->typePtr = &comparedStringObjType;
2578 }
2579 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2580 return 1;
2581 }
2582 }
2583
2584 int qsortCompareStringPointers(const void *a, const void *b)
2585 {
2586 char * const *sa = (char * const *)a;
2587 char * const *sb = (char * const *)b;
2588 return strcmp(*sa, *sb);
2589 }
2590
2591 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2592 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2593 {
2594 const char * const *entryPtr = NULL;
2595 char **tablePtrSorted;
2596 int i, count = 0;
2597
2598 *indexPtr = -1;
2599 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2600 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2601 *indexPtr = i;
2602 return JIM_OK;
2603 }
2604 count++; /* If nothing matches, this will reach the len of tablePtr */
2605 }
2606 if (flags & JIM_ERRMSG) {
2607 if (name == NULL)
2608 name = "option";
2609 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2610 Jim_AppendStrings(interp, Jim_GetResult(interp),
2611 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2612 NULL);
2613 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2614 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2615 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2616 for (i = 0; i < count; i++) {
2617 if (i+1 == count && count > 1)
2618 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2619 Jim_AppendString(interp, Jim_GetResult(interp),
2620 tablePtrSorted[i], -1);
2621 if (i+1 != count)
2622 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2623 }
2624 Jim_Free(tablePtrSorted);
2625 }
2626 return JIM_ERR;
2627 }
2628
2629 int Jim_GetNvp(Jim_Interp *interp,
2630 Jim_Obj *objPtr,
2631 const Jim_Nvp *nvp_table,
2632 const Jim_Nvp ** result)
2633 {
2634 Jim_Nvp *n;
2635 int e;
2636
2637 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2638 if( e == JIM_ERR ){
2639 return e;
2640 }
2641
2642 /* Success? found? */
2643 if( n->name ){
2644 /* remove const */
2645 *result = (Jim_Nvp *)n;
2646 return JIM_OK;
2647 } else {
2648 return JIM_ERR;
2649 }
2650 }
2651
2652 /* -----------------------------------------------------------------------------
2653 * Source Object
2654 *
2655 * This object is just a string from the language point of view, but
2656 * in the internal representation it contains the filename and line number
2657 * where this given token was read. This information is used by
2658 * Jim_EvalObj() if the object passed happens to be of type "source".
2659 *
2660 * This allows to propagate the information about line numbers and file
2661 * names and give error messages with absolute line numbers.
2662 *
2663 * Note that this object uses shared strings for filenames, and the
2664 * pointer to the filename together with the line number is taken into
2665 * the space for the "inline" internal represenation of the Jim_Object,
2666 * so there is almost memory zero-overhead.
2667 *
2668 * Also the object will be converted to something else if the given
2669 * token it represents in the source file is not something to be
2670 * evaluated (not a script), and will be specialized in some other way,
2671 * so the time overhead is alzo null.
2672 * ---------------------------------------------------------------------------*/
2673
2674 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2675 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2676
2677 static Jim_ObjType sourceObjType = {
2678 "source",
2679 FreeSourceInternalRep,
2680 DupSourceInternalRep,
2681 NULL,
2682 JIM_TYPE_REFERENCES,
2683 };
2684
2685 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2686 {
2687 Jim_ReleaseSharedString(interp,
2688 objPtr->internalRep.sourceValue.fileName);
2689 }
2690
2691 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2692 {
2693 dupPtr->internalRep.sourceValue.fileName =
2694 Jim_GetSharedString(interp,
2695 srcPtr->internalRep.sourceValue.fileName);
2696 dupPtr->internalRep.sourceValue.lineNumber =
2697 dupPtr->internalRep.sourceValue.lineNumber;
2698 dupPtr->typePtr = &sourceObjType;
2699 }
2700
2701 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2702 const char *fileName, int lineNumber)
2703 {
2704 if (Jim_IsShared(objPtr))
2705 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2706 if (objPtr->typePtr != NULL)
2707 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2708 objPtr->internalRep.sourceValue.fileName =
2709 Jim_GetSharedString(interp, fileName);
2710 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2711 objPtr->typePtr = &sourceObjType;
2712 }
2713
2714 /* -----------------------------------------------------------------------------
2715 * Script Object
2716 * ---------------------------------------------------------------------------*/
2717
2718 #define JIM_CMDSTRUCT_EXPAND -1
2719
2720 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2721 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2722 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2723
2724 static Jim_ObjType scriptObjType = {
2725 "script",
2726 FreeScriptInternalRep,
2727 DupScriptInternalRep,
2728 NULL,
2729 JIM_TYPE_REFERENCES,
2730 };
2731
2732 /* The ScriptToken structure represents every token into a scriptObj.
2733 * Every token contains an associated Jim_Obj that can be specialized
2734 * by commands operating on it. */
2735 typedef struct ScriptToken {
2736 int type;
2737 Jim_Obj *objPtr;
2738 int linenr;
2739 } ScriptToken;
2740
2741 /* This is the script object internal representation. An array of
2742 * ScriptToken structures, with an associated command structure array.
2743 * The command structure is a pre-computed representation of the
2744 * command length and arguments structure as a simple liner array
2745 * of integers.
2746 *
2747 * For example the script:
2748 *
2749 * puts hello
2750 * set $i $x$y [foo]BAR
2751 *
2752 * will produce a ScriptObj with the following Tokens:
2753 *
2754 * ESC puts
2755 * SEP
2756 * ESC hello
2757 * EOL
2758 * ESC set
2759 * EOL
2760 * VAR i
2761 * SEP
2762 * VAR x
2763 * VAR y
2764 * SEP
2765 * CMD foo
2766 * ESC BAR
2767 * EOL
2768 *
2769 * This is a description of the tokens, separators, and of lines.
2770 * The command structure instead represents the number of arguments
2771 * of every command, followed by the tokens of which every argument
2772 * is composed. So for the example script, the cmdstruct array will
2773 * contain:
2774 *
2775 * 2 1 1 4 1 1 2 2
2776 *
2777 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2778 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2779 * composed of single tokens (1 1) and the last two of double tokens
2780 * (2 2).
2781 *
2782 * The precomputation of the command structure makes Jim_Eval() faster,
2783 * and simpler because there aren't dynamic lengths / allocations.
2784 *
2785 * -- {expand} handling --
2786 *
2787 * Expand is handled in a special way. When a command
2788 * contains at least an argument with the {expand} prefix,
2789 * the command structure presents a -1 before the integer
2790 * describing the number of arguments. This is used in order
2791 * to send the command exection to a different path in case
2792 * of {expand} and guarantee a fast path for the more common
2793 * case. Also, the integers describing the number of tokens
2794 * are expressed with negative sign, to allow for fast check
2795 * of what's an {expand}-prefixed argument and what not.
2796 *
2797 * For example the command:
2798 *
2799 * list {expand}{1 2}
2800 *
2801 * Will produce the following cmdstruct array:
2802 *
2803 * -1 2 1 -2
2804 *
2805 * -- the substFlags field of the structure --
2806 *
2807 * The scriptObj structure is used to represent both "script" objects
2808 * and "subst" objects. In the second case, the cmdStruct related
2809 * fields are not used at all, but there is an additional field used
2810 * that is 'substFlags': this represents the flags used to turn
2811 * the string into the intenral representation used to perform the
2812 * substitution. If this flags are not what the application requires
2813 * the scriptObj is created again. For example the script:
2814 *
2815 * subst -nocommands $string
2816 * subst -novariables $string
2817 *
2818 * Will recreate the internal representation of the $string object
2819 * two times.
2820 */
2821 typedef struct ScriptObj {
2822 int len; /* Length as number of tokens. */
2823 int commands; /* number of top-level commands in script. */
2824 ScriptToken *token; /* Tokens array. */
2825 int *cmdStruct; /* commands structure */
2826 int csLen; /* length of the cmdStruct array. */
2827 int substFlags; /* flags used for the compilation of "subst" objects */
2828 int inUse; /* Used to share a ScriptObj. Currently
2829 only used by Jim_EvalObj() as protection against
2830 shimmering of the currently evaluated object. */
2831 char *fileName;
2832 } ScriptObj;
2833
2834 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2835 {
2836 int i;
2837 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2838
2839 script->inUse--;
2840 if (script->inUse != 0) return;
2841 for (i = 0; i < script->len; i++) {
2842 if (script->token[i].objPtr != NULL)
2843 Jim_DecrRefCount(interp, script->token[i].objPtr);
2844 }
2845 Jim_Free(script->token);
2846 Jim_Free(script->cmdStruct);
2847 Jim_Free(script->fileName);
2848 Jim_Free(script);
2849 }
2850
2851 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2852 {
2853 JIM_NOTUSED(interp);
2854 JIM_NOTUSED(srcPtr);
2855
2856 /* Just returns an simple string. */
2857 dupPtr->typePtr = NULL;
2858 }
2859
2860 /* Add a new token to the internal repr of a script object */
2861 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2862 char *strtoken, int len, int type, char *filename, int linenr)
2863 {
2864 int prevtype;
2865 struct ScriptToken *token;
2866
2867 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2868 script->token[script->len-1].type;
2869 /* Skip tokens without meaning, like words separators
2870 * following a word separator or an end of command and
2871 * so on. */
2872 if (prevtype == JIM_TT_EOL) {
2873 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2874 Jim_Free(strtoken);
2875 return;
2876 }
2877 } else if (prevtype == JIM_TT_SEP) {
2878 if (type == JIM_TT_SEP) {
2879 Jim_Free(strtoken);
2880 return;
2881 } else if (type == JIM_TT_EOL) {
2882 /* If an EOL is following by a SEP, drop the previous
2883 * separator. */
2884 script->len--;
2885 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2886 }
2887 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2888 type == JIM_TT_ESC && len == 0)
2889 {
2890 /* Don't add empty tokens used in interpolation */
2891 Jim_Free(strtoken);
2892 return;
2893 }
2894 /* Make space for a new istruction */
2895 script->len++;
2896 script->token = Jim_Realloc(script->token,
2897 sizeof(ScriptToken)*script->len);
2898 /* Initialize the new token */
2899 token = script->token+(script->len-1);
2900 token->type = type;
2901 /* Every object is intially as a string, but the
2902 * internal type may be specialized during execution of the
2903 * script. */
2904 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2905 /* To add source info to SEP and EOL tokens is useless because
2906 * they will never by called as arguments of Jim_EvalObj(). */
2907 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2908 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2909 Jim_IncrRefCount(token->objPtr);
2910 token->linenr = linenr;
2911 }
2912
2913 /* Add an integer into the command structure field of the script object. */
2914 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2915 {
2916 script->csLen++;
2917 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2918 sizeof(int)*script->csLen);
2919 script->cmdStruct[script->csLen-1] = val;
2920 }
2921
2922 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2923 * of objPtr. Search nested script objects recursively. */
2924 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2925 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2926 {
2927 int i;
2928
2929 for (i = 0; i < script->len; i++) {
2930 if (script->token[i].objPtr != objPtr &&
2931 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2932 return script->token[i].objPtr;
2933 }
2934 /* Enter recursively on scripts only if the object
2935 * is not the same as the one we are searching for
2936 * shared occurrences. */
2937 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2938 script->token[i].objPtr != objPtr) {
2939 Jim_Obj *foundObjPtr;
2940
2941 ScriptObj *subScript =
2942 script->token[i].objPtr->internalRep.ptr;
2943 /* Don't recursively enter the script we are trying
2944 * to make shared to avoid circular references. */
2945 if (subScript == scriptBarrier) continue;
2946 if (subScript != script) {
2947 foundObjPtr =
2948 ScriptSearchLiteral(interp, subScript,
2949 scriptBarrier, objPtr);
2950 if (foundObjPtr != NULL)
2951 return foundObjPtr;
2952 }
2953 }
2954 }
2955 return NULL;
2956 }
2957
2958 /* Share literals of a script recursively sharing sub-scripts literals. */
2959 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2960 ScriptObj *topLevelScript)
2961 {
2962 int i, j;
2963
2964 return;
2965 /* Try to share with toplevel object. */
2966 if (topLevelScript != NULL) {
2967 for (i = 0; i < script->len; i++) {
2968 Jim_Obj *foundObjPtr;
2969 char *str = script->token[i].objPtr->bytes;
2970
2971 if (script->token[i].objPtr->refCount != 1) continue;
2972 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2973 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2974 foundObjPtr = ScriptSearchLiteral(interp,
2975 topLevelScript,
2976 script, /* barrier */
2977 script->token[i].objPtr);
2978 if (foundObjPtr != NULL) {
2979 Jim_IncrRefCount(foundObjPtr);
2980 Jim_DecrRefCount(interp,
2981 script->token[i].objPtr);
2982 script->token[i].objPtr = foundObjPtr;
2983 }
2984 }
2985 }
2986 /* Try to share locally */
2987 for (i = 0; i < script->len; i++) {
2988 char *str = script->token[i].objPtr->bytes;
2989
2990 if (script->token[i].objPtr->refCount != 1) continue;
2991 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2992 for (j = 0; j < script->len; j++) {
2993 if (script->token[i].objPtr !=
2994 script->token[j].objPtr &&
2995 Jim_StringEqObj(script->token[i].objPtr,
2996 script->token[j].objPtr, 0))
2997 {
2998 Jim_IncrRefCount(script->token[j].objPtr);
2999 Jim_DecrRefCount(interp,
3000 script->token[i].objPtr);
3001 script->token[i].objPtr =
3002 script->token[j].objPtr;
3003 }
3004 }
3005 }
3006 }
3007
3008 /* This method takes the string representation of an object
3009 * as a Tcl script, and generates the pre-parsed internal representation
3010 * of the script. */
3011 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3012 {
3013 int scriptTextLen;
3014 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3015 struct JimParserCtx parser;
3016 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3017 ScriptToken *token;
3018 int args, tokens, start, end, i;
3019 int initialLineNumber;
3020 int propagateSourceInfo = 0;
3021
3022 script->len = 0;
3023 script->csLen = 0;
3024 script->commands = 0;
3025 script->token = NULL;
3026 script->cmdStruct = NULL;
3027 script->inUse = 1;
3028 /* Try to get information about filename / line number */
3029 if (objPtr->typePtr == &sourceObjType) {
3030 script->fileName =
3031 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3032 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3033 propagateSourceInfo = 1;
3034 } else {
3035 script->fileName = Jim_StrDup("");
3036 initialLineNumber = 1;
3037 }
3038
3039 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3040 while(!JimParserEof(&parser)) {
3041 char *token;
3042 int len, type, linenr;
3043
3044 JimParseScript(&parser);
3045 token = JimParserGetToken(&parser, &len, &type, &linenr);
3046 ScriptObjAddToken(interp, script, token, len, type,
3047 propagateSourceInfo ? script->fileName : NULL,
3048 linenr);
3049 }
3050 token = script->token;
3051
3052 /* Compute the command structure array
3053 * (see the ScriptObj struct definition for more info) */
3054 start = 0; /* Current command start token index */
3055 end = -1; /* Current command end token index */
3056 while (1) {
3057 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3058 int interpolation = 0; /* set to 1 if there is at least one
3059 argument of the command obtained via
3060 interpolation of more tokens. */
3061 /* Search for the end of command, while
3062 * count the number of args. */
3063 start = ++end;
3064 if (start >= script->len) break;
3065 args = 1; /* Number of args in current command */
3066 while (token[end].type != JIM_TT_EOL) {
3067 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3068 token[end-1].type == JIM_TT_EOL)
3069 {
3070 if (token[end].type == JIM_TT_STR &&
3071 token[end+1].type != JIM_TT_SEP &&
3072 token[end+1].type != JIM_TT_EOL &&
3073 (!strcmp(token[end].objPtr->bytes, "expand") ||
3074 !strcmp(token[end].objPtr->bytes, "*")))
3075 expand++;
3076 }
3077 if (token[end].type == JIM_TT_SEP)
3078 args++;
3079 end++;
3080 }
3081 interpolation = !((end-start+1) == args*2);
3082 /* Add the 'number of arguments' info into cmdstruct.
3083 * Negative value if there is list expansion involved. */
3084 if (expand)
3085 ScriptObjAddInt(script, -1);
3086 ScriptObjAddInt(script, args);
3087 /* Now add info about the number of tokens. */
3088 tokens = 0; /* Number of tokens in current argument. */
3089 expand = 0;
3090 for (i = start; i <= end; i++) {
3091 if (token[i].type == JIM_TT_SEP ||
3092 token[i].type == JIM_TT_EOL)
3093 {
3094 if (tokens == 1 && expand)
3095 expand = 0;
3096 ScriptObjAddInt(script,
3097 expand ? -tokens : tokens);
3098
3099 expand = 0;
3100 tokens = 0;
3101 continue;
3102 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3103 (!strcmp(token[i].objPtr->bytes, "expand") ||
3104 !strcmp(token[i].objPtr->bytes, "*")))
3105 {
3106 expand++;
3107 }
3108 tokens++;
3109 }
3110 }
3111 /* Perform literal sharing, but only for objects that appear
3112 * to be scripts written as literals inside the source code,
3113 * and not computed at runtime. Literal sharing is a costly
3114 * operation that should be done only against objects that
3115 * are likely to require compilation only the first time, and
3116 * then are executed multiple times. */
3117 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3118 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3119 if (bodyObjPtr->typePtr == &scriptObjType) {
3120 ScriptObj *bodyScript =
3121 bodyObjPtr->internalRep.ptr;
3122 ScriptShareLiterals(interp, script, bodyScript);
3123 }
3124 } else if (propagateSourceInfo) {
3125 ScriptShareLiterals(interp, script, NULL);
3126 }
3127 /* Free the old internal rep and set the new one. */
3128 Jim_FreeIntRep(interp, objPtr);
3129 Jim_SetIntRepPtr(objPtr, script);
3130 objPtr->typePtr = &scriptObjType;
3131 return JIM_OK;
3132 }
3133
3134 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3135 {
3136 if (objPtr->typePtr != &scriptObjType) {
3137 SetScriptFromAny(interp, objPtr);
3138 }
3139 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3140 }
3141
3142 /* -----------------------------------------------------------------------------
3143 * Commands
3144 * ---------------------------------------------------------------------------*/
3145
3146 /* Commands HashTable Type.
3147 *
3148 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3149 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3150 {
3151 Jim_Cmd *cmdPtr = (void*) val;
3152
3153 if (cmdPtr->cmdProc == NULL) {
3154 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3155 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3156 if (cmdPtr->staticVars) {
3157 Jim_FreeHashTable(cmdPtr->staticVars);
3158 Jim_Free(cmdPtr->staticVars);
3159 }
3160 } else if (cmdPtr->delProc != NULL) {
3161 /* If it was a C coded command, call the delProc if any */
3162 cmdPtr->delProc(interp, cmdPtr->privData);
3163 }
3164 Jim_Free(val);
3165 }
3166
3167 static Jim_HashTableType JimCommandsHashTableType = {
3168 JimStringCopyHTHashFunction, /* hash function */
3169 JimStringCopyHTKeyDup, /* key dup */
3170 NULL, /* val dup */
3171 JimStringCopyHTKeyCompare, /* key compare */
3172 JimStringCopyHTKeyDestructor, /* key destructor */
3173 Jim_CommandsHT_ValDestructor /* val destructor */
3174 };
3175
3176 /* ------------------------- Commands related functions --------------------- */
3177
3178 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3179 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3180 {
3181 Jim_HashEntry *he;
3182 Jim_Cmd *cmdPtr;
3183
3184 he = Jim_FindHashEntry(&interp->commands, cmdName);
3185 if (he == NULL) { /* New command to create */
3186 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3187 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3188 } else {
3189 Jim_InterpIncrProcEpoch(interp);
3190 /* Free the arglist/body objects if it was a Tcl procedure */
3191 cmdPtr = he->val;
3192 if (cmdPtr->cmdProc == NULL) {
3193 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3194 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3195 if (cmdPtr->staticVars) {
3196 Jim_FreeHashTable(cmdPtr->staticVars);
3197 Jim_Free(cmdPtr->staticVars);
3198 }
3199 cmdPtr->staticVars = NULL;
3200 } else if (cmdPtr->delProc != NULL) {
3201 /* If it was a C coded command, call the delProc if any */
3202 cmdPtr->delProc(interp, cmdPtr->privData);
3203 }
3204 }
3205
3206 /* Store the new details for this proc */
3207 cmdPtr->delProc = delProc;
3208 cmdPtr->cmdProc = cmdProc;
3209 cmdPtr->privData = privData;
3210
3211 /* There is no need to increment the 'proc epoch' because
3212 * creation of a new procedure can never affect existing
3213 * cached commands. We don't do negative caching. */
3214 return JIM_OK;
3215 }
3216
3217 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3218 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3219 int arityMin, int arityMax)
3220 {
3221 Jim_Cmd *cmdPtr;
3222
3223 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3224 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3225 cmdPtr->argListObjPtr = argListObjPtr;
3226 cmdPtr->bodyObjPtr = bodyObjPtr;
3227 Jim_IncrRefCount(argListObjPtr);
3228 Jim_IncrRefCount(bodyObjPtr);
3229 cmdPtr->arityMin = arityMin;
3230 cmdPtr->arityMax = arityMax;
3231 cmdPtr->staticVars = NULL;
3232
3233 /* Create the statics hash table. */
3234 if (staticsListObjPtr) {
3235 int len, i;
3236
3237 Jim_ListLength(interp, staticsListObjPtr, &len);
3238 if (len != 0) {
3239 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3240 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3241 interp);
3242 for (i = 0; i < len; i++) {
3243 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3244 Jim_Var *varPtr;
3245 int subLen;
3246
3247 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3248 /* Check if it's composed of two elements. */
3249 Jim_ListLength(interp, objPtr, &subLen);
3250 if (subLen == 1 || subLen == 2) {
3251 /* Try to get the variable value from the current
3252 * environment. */
3253 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3254 if (subLen == 1) {
3255 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3256 JIM_NONE);
3257 if (initObjPtr == NULL) {
3258 Jim_SetResult(interp,
3259 Jim_NewEmptyStringObj(interp));
3260 Jim_AppendStrings(interp, Jim_GetResult(interp),
3261 "variable for initialization of static \"",
3262 Jim_GetString(nameObjPtr, NULL),
3263 "\" not found in the local context",
3264 NULL);
3265 goto err;
3266 }
3267 } else {
3268 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3269 }
3270 varPtr = Jim_Alloc(sizeof(*varPtr));
3271 varPtr->objPtr = initObjPtr;
3272 Jim_IncrRefCount(initObjPtr);
3273 varPtr->linkFramePtr = NULL;
3274 if (Jim_AddHashEntry(cmdPtr->staticVars,
3275 Jim_GetString(nameObjPtr, NULL),
3276 varPtr) != JIM_OK)
3277 {
3278 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3279 Jim_AppendStrings(interp, Jim_GetResult(interp),
3280 "static variable name \"",
3281 Jim_GetString(objPtr, NULL), "\"",
3282 " duplicated in statics list", NULL);
3283 Jim_DecrRefCount(interp, initObjPtr);
3284 Jim_Free(varPtr);
3285 goto err;
3286 }
3287 } else {
3288 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3289 Jim_AppendStrings(interp, Jim_GetResult(interp),
3290 "too many fields in static specifier \"",
3291 objPtr, "\"", NULL);
3292 goto err;
3293 }
3294 }
3295 }
3296 }
3297
3298 /* Add the new command */
3299
3300 /* it may already exist, so we try to delete the old one */
3301 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3302 /* There was an old procedure with the same name, this requires
3303 * a 'proc epoch' update. */
3304 Jim_InterpIncrProcEpoch(interp);
3305 }
3306 /* If a procedure with the same name didn't existed there is no need
3307 * to increment the 'proc epoch' because creation of a new procedure
3308 * can never affect existing cached commands. We don't do
3309 * negative caching. */
3310 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3311 return JIM_OK;
3312
3313 err:
3314 Jim_FreeHashTable(cmdPtr->staticVars);
3315 Jim_Free(cmdPtr->staticVars);
3316 Jim_DecrRefCount(interp, argListObjPtr);
3317 Jim_DecrRefCount(interp, bodyObjPtr);
3318 Jim_Free(cmdPtr);
3319 return JIM_ERR;
3320 }
3321
3322 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3323 {
3324 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3325 return JIM_ERR;
3326 Jim_InterpIncrProcEpoch(interp);
3327 return JIM_OK;
3328 }
3329
3330 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3331 const char *newName)
3332 {
3333 Jim_Cmd *cmdPtr;
3334 Jim_HashEntry *he;
3335 Jim_Cmd *copyCmdPtr;
3336
3337 if (newName[0] == '\0') /* Delete! */
3338 return Jim_DeleteCommand(interp, oldName);
3339 /* Rename */
3340 he = Jim_FindHashEntry(&interp->commands, oldName);
3341 if (he == NULL)
3342 return JIM_ERR; /* Invalid command name */
3343 cmdPtr = he->val;
3344 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3345 *copyCmdPtr = *cmdPtr;
3346 /* In order to avoid that a procedure will get arglist/body/statics
3347 * freed by the hash table methods, fake a C-coded command
3348 * setting cmdPtr->cmdProc as not NULL */
3349 cmdPtr->cmdProc = (void*)1;
3350 /* Also make sure delProc is NULL. */
3351 cmdPtr->delProc = NULL;
3352 /* Destroy the old command, and make sure the new is freed
3353 * as well. */
3354 Jim_DeleteHashEntry(&interp->commands, oldName);
3355 Jim_DeleteHashEntry(&interp->commands, newName);
3356 /* Now the new command. We are sure it can't fail because
3357 * the target name was already freed. */
3358 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3359 /* Increment the epoch */
3360 Jim_InterpIncrProcEpoch(interp);
3361 return JIM_OK;
3362 }
3363
3364 /* -----------------------------------------------------------------------------
3365 * Command object
3366 * ---------------------------------------------------------------------------*/
3367
3368 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3369
3370 static Jim_ObjType commandObjType = {
3371 "command",
3372 NULL,
3373 NULL,
3374 NULL,
3375 JIM_TYPE_REFERENCES,
3376 };
3377
3378 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3379 {
3380 Jim_HashEntry *he;
3381 const char *cmdName;
3382
3383 /* Get the string representation */
3384 cmdName = Jim_GetString(objPtr, NULL);
3385 /* Lookup this name into the commands hash table */
3386 he = Jim_FindHashEntry(&interp->commands, cmdName);
3387 if (he == NULL)
3388 return JIM_ERR;
3389
3390 /* Free the old internal repr and set the new one. */
3391 Jim_FreeIntRep(interp, objPtr);
3392 objPtr->typePtr = &commandObjType;
3393 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3394 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3395 return JIM_OK;
3396 }
3397
3398 /* This function returns the command structure for the command name
3399 * stored in objPtr. It tries to specialize the objPtr to contain
3400 * a cached info instead to perform the lookup into the hash table
3401 * every time. The information cached may not be uptodate, in such
3402 * a case the lookup is performed and the cache updated. */
3403 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3404 {
3405 if ((objPtr->typePtr != &commandObjType ||
3406 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3407 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3408 if (flags & JIM_ERRMSG) {
3409 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3410 Jim_AppendStrings(interp, Jim_GetResult(interp),
3411 "invalid command name \"", objPtr->bytes, "\"",
3412 NULL);
3413 }
3414 return NULL;
3415 }
3416 return objPtr->internalRep.cmdValue.cmdPtr;
3417 }
3418
3419 /* -----------------------------------------------------------------------------
3420 * Variables
3421 * ---------------------------------------------------------------------------*/
3422
3423 /* Variables HashTable Type.
3424 *
3425 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3426 static void JimVariablesHTValDestructor(void *interp, void *val)
3427 {
3428 Jim_Var *varPtr = (void*) val;
3429
3430 Jim_DecrRefCount(interp, varPtr->objPtr);
3431 Jim_Free(val);
3432 }
3433
3434 static Jim_HashTableType JimVariablesHashTableType = {
3435 JimStringCopyHTHashFunction, /* hash function */
3436 JimStringCopyHTKeyDup, /* key dup */
3437 NULL, /* val dup */
3438 JimStringCopyHTKeyCompare, /* key compare */
3439 JimStringCopyHTKeyDestructor, /* key destructor */
3440 JimVariablesHTValDestructor /* val destructor */
3441 };
3442
3443 static Jim_HashTableType *getJimVariablesHashTableType(void)
3444 {
3445 return &JimVariablesHashTableType;
3446 }
3447
3448 /* -----------------------------------------------------------------------------
3449 * Variable object
3450 * ---------------------------------------------------------------------------*/
3451
3452 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3453
3454 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3455
3456 static Jim_ObjType variableObjType = {
3457 "variable",
3458 NULL,
3459 NULL,
3460 NULL,
3461 JIM_TYPE_REFERENCES,
3462 };
3463
3464 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3465 * is in the form "varname(key)". */
3466 static int Jim_NameIsDictSugar(const char *str, int len)
3467 {
3468 if (len == -1)
3469 len = strlen(str);
3470 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3471 return 1;
3472 return 0;
3473 }
3474
3475 /* This method should be called only by the variable API.
3476 * It returns JIM_OK on success (variable already exists),
3477 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3478 * a variable name, but syntax glue for [dict] i.e. the last
3479 * character is ')' */
3480 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3481 {
3482 Jim_HashEntry *he;
3483 const char *varName;
3484 int len;
3485
3486 /* Check if the object is already an uptodate variable */
3487 if (objPtr->typePtr == &variableObjType &&
3488 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3489 return JIM_OK; /* nothing to do */
3490 /* Get the string representation */
3491 varName = Jim_GetString(objPtr, &len);
3492 /* Make sure it's not syntax glue to get/set dict. */
3493 if (Jim_NameIsDictSugar(varName, len))
3494 return JIM_DICT_SUGAR;
3495 if (varName[0] == ':' && varName[1] == ':') {
3496 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3497 if (he == NULL) {
3498 return JIM_ERR;
3499 }
3500 }
3501 else {
3502 /* Lookup this name into the variables hash table */
3503 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3504 if (he == NULL) {
3505 /* Try with static vars. */
3506 if (interp->framePtr->staticVars == NULL)
3507 return JIM_ERR;
3508 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3509 return JIM_ERR;
3510 }
3511 }
3512 /* Free the old internal repr and set the new one. */
3513 Jim_FreeIntRep(interp, objPtr);
3514 objPtr->typePtr = &variableObjType;
3515 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3516 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3517 return JIM_OK;
3518 }
3519
3520 /* -------------------- Variables related functions ------------------------- */
3521 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3522 Jim_Obj *valObjPtr);
3523 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3524
3525 /* For now that's dummy. Variables lookup should be optimized
3526 * in many ways, with caching of lookups, and possibly with
3527 * a table of pre-allocated vars in every CallFrame for local vars.
3528 * All the caching should also have an 'epoch' mechanism similar
3529 * to the one used by Tcl for procedures lookup caching. */
3530
3531 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3532 {
3533 const char *name;
3534 Jim_Var *var;
3535 int err;
3536
3537 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3538 /* Check for [dict] syntax sugar. */
3539 if (err == JIM_DICT_SUGAR)
3540 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3541 /* New variable to create */
3542 name = Jim_GetString(nameObjPtr, NULL);
3543
3544 var = Jim_Alloc(sizeof(*var));
3545 var->objPtr = valObjPtr;
3546 Jim_IncrRefCount(valObjPtr);
3547 var->linkFramePtr = NULL;
3548 /* Insert the new variable */
3549 if (name[0] == ':' && name[1] == ':') {
3550 /* Into to the top evel frame */
3551 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3552 }
3553 else {
3554 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3555 }
3556 /* Make the object int rep a variable */
3557 Jim_FreeIntRep(interp, nameObjPtr);
3558 nameObjPtr->typePtr = &variableObjType;
3559 nameObjPtr->internalRep.varValue.callFrameId =
3560 interp->framePtr->id;
3561 nameObjPtr->internalRep.varValue.varPtr = var;
3562 } else {
3563 var = nameObjPtr->internalRep.varValue.varPtr;
3564 if (var->linkFramePtr == NULL) {
3565 Jim_IncrRefCount(valObjPtr);
3566 Jim_DecrRefCount(interp, var->objPtr);
3567 var->objPtr = valObjPtr;
3568 } else { /* Else handle the link */
3569 Jim_CallFrame *savedCallFrame;
3570
3571 savedCallFrame = interp->framePtr;
3572 interp->framePtr = var->linkFramePtr;
3573 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3574 interp->framePtr = savedCallFrame;
3575 if (err != JIM_OK)
3576 return err;
3577 }
3578 }
3579 return JIM_OK;
3580 }
3581
3582 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3583 {
3584 Jim_Obj *nameObjPtr;
3585 int result;
3586
3587 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3588 Jim_IncrRefCount(nameObjPtr);
3589 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3590 Jim_DecrRefCount(interp, nameObjPtr);
3591 return result;
3592 }
3593
3594 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3595 {
3596 Jim_CallFrame *savedFramePtr;
3597 int result;
3598
3599 savedFramePtr = interp->framePtr;
3600 interp->framePtr = interp->topFramePtr;
3601 result = Jim_SetVariableStr(interp, name, objPtr);
3602 interp->framePtr = savedFramePtr;
3603 return result;
3604 }
3605
3606 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3607 {
3608 Jim_Obj *nameObjPtr, *valObjPtr;
3609 int result;
3610
3611 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3612 valObjPtr = Jim_NewStringObj(interp, val, -1);
3613 Jim_IncrRefCount(nameObjPtr);
3614 Jim_IncrRefCount(valObjPtr);
3615 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3616 Jim_DecrRefCount(interp, nameObjPtr);
3617 Jim_DecrRefCount(interp, valObjPtr);
3618 return result;
3619 }
3620
3621 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3622 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3623 {
3624 const char *varName;
3625 int len;
3626
3627 /* Check for cycles. */
3628 if (interp->framePtr == targetCallFrame) {
3629 Jim_Obj *objPtr = targetNameObjPtr;
3630 Jim_Var *varPtr;
3631 /* Cycles are only possible with 'uplevel 0' */
3632 while(1) {
3633 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3634 Jim_SetResultString(interp,
3635 "can't upvar from variable to itself", -1);
3636 return JIM_ERR;
3637 }
3638 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3639 break;
3640 varPtr = objPtr->internalRep.varValue.varPtr;
3641 if (varPtr->linkFramePtr != targetCallFrame) break;
3642 objPtr = varPtr->objPtr;
3643 }
3644 }
3645 varName = Jim_GetString(nameObjPtr, &len);
3646 if (Jim_NameIsDictSugar(varName, len)) {
3647 Jim_SetResultString(interp,
3648 "Dict key syntax invalid as link source", -1);
3649 return JIM_ERR;
3650 }
3651 /* Perform the binding */
3652 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3653 /* We are now sure 'nameObjPtr' type is variableObjType */
3654 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3655 return JIM_OK;
3656 }
3657
3658 /* Return the Jim_Obj pointer associated with a variable name,
3659 * or NULL if the variable was not found in the current context.
3660 * The same optimization discussed in the comment to the
3661 * 'SetVariable' function should apply here. */
3662 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3663 {
3664 int err;
3665
3666 /* All the rest is handled here */
3667 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3668 /* Check for [dict] syntax sugar. */
3669 if (err == JIM_DICT_SUGAR)
3670 return JimDictSugarGet(interp, nameObjPtr);
3671 if (flags & JIM_ERRMSG) {
3672 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3673 Jim_AppendStrings(interp, Jim_GetResult(interp),
3674 "can't read \"", nameObjPtr->bytes,
3675 "\": no such variable", NULL);
3676 }
3677 return NULL;
3678 } else {
3679 Jim_Var *varPtr;
3680 Jim_Obj *objPtr;
3681 Jim_CallFrame *savedCallFrame;
3682
3683 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3684 if (varPtr->linkFramePtr == NULL)
3685 return varPtr->objPtr;
3686 /* The variable is a link? Resolve it. */
3687 savedCallFrame = interp->framePtr;
3688 interp->framePtr = varPtr->linkFramePtr;
3689 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3690 if (objPtr == NULL && flags & JIM_ERRMSG) {
3691 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3692 Jim_AppendStrings(interp, Jim_GetResult(interp),
3693 "can't read \"", nameObjPtr->bytes,
3694 "\": no such variable", NULL);
3695 }
3696 interp->framePtr = savedCallFrame;
3697 return objPtr;
3698 }
3699 }
3700
3701 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3702 int flags)
3703 {
3704 Jim_CallFrame *savedFramePtr;
3705 Jim_Obj *objPtr;
3706
3707 savedFramePtr = interp->framePtr;
3708 interp->framePtr = interp->topFramePtr;
3709 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3710 interp->framePtr = savedFramePtr;
3711
3712 return objPtr;
3713 }
3714
3715 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3716 {
3717 Jim_Obj *nameObjPtr, *varObjPtr;
3718
3719 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3720 Jim_IncrRefCount(nameObjPtr);
3721 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3722 Jim_DecrRefCount(interp, nameObjPtr);
3723 return varObjPtr;
3724 }
3725
3726 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3727 int flags)
3728 {
3729 Jim_CallFrame *savedFramePtr;
3730 Jim_Obj *objPtr;
3731
3732 savedFramePtr = interp->framePtr;
3733 interp->framePtr = interp->topFramePtr;
3734 objPtr = Jim_GetVariableStr(interp, name, flags);
3735 interp->framePtr = savedFramePtr;
3736
3737 return objPtr;
3738 }
3739
3740 /* Unset a variable.
3741 * Note: On success unset invalidates all the variable objects created
3742 * in the current call frame incrementing. */
3743 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3744 {
3745 const char *name;
3746 Jim_Var *varPtr;
3747 int err;
3748
3749 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3750 /* Check for [dict] syntax sugar. */
3751 if (err == JIM_DICT_SUGAR)
3752 return JimDictSugarSet(interp, nameObjPtr, NULL);
3753 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3754 Jim_AppendStrings(interp, Jim_GetResult(interp),
3755 "can't unset \"", nameObjPtr->bytes,
3756 "\": no such variable", NULL);
3757 return JIM_ERR; /* var not found */
3758 }
3759 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3760 /* If it's a link call UnsetVariable recursively */
3761 if (varPtr->linkFramePtr) {
3762 int retval;
3763
3764 Jim_CallFrame *savedCallFrame;
3765
3766 savedCallFrame = interp->framePtr;
3767 interp->framePtr = varPtr->linkFramePtr;
3768 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3769 interp->framePtr = savedCallFrame;
3770 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3771 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3772 Jim_AppendStrings(interp, Jim_GetResult(interp),
3773 "can't unset \"", nameObjPtr->bytes,
3774 "\": no such variable", NULL);
3775 }
3776 return retval;
3777 } else {
3778 name = Jim_GetString(nameObjPtr, NULL);
3779 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3780 != JIM_OK) return JIM_ERR;
3781 /* Change the callframe id, invalidating var lookup caching */
3782 JimChangeCallFrameId(interp, interp->framePtr);
3783 return JIM_OK;
3784 }
3785 }
3786
3787 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3788
3789 /* Given a variable name for [dict] operation syntax sugar,
3790 * this function returns two objects, the first with the name
3791 * of the variable to set, and the second with the rispective key.
3792 * For example "foo(bar)" will return objects with string repr. of
3793 * "foo" and "bar".
3794 *
3795 * The returned objects have refcount = 1. The function can't fail. */
3796 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3797 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3798 {
3799 const char *str, *p;
3800 char *t;
3801 int len, keyLen, nameLen;
3802 Jim_Obj *varObjPtr, *keyObjPtr;
3803
3804 str = Jim_GetString(objPtr, &len);
3805 p = strchr(str, '(');
3806 p++;
3807 keyLen = len-((p-str)+1);
3808 nameLen = (p-str)-1;
3809 /* Create the objects with the variable name and key. */
3810 t = Jim_Alloc(nameLen+1);
3811 memcpy(t, str, nameLen);
3812 t[nameLen] = '\0';
3813 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3814
3815 t = Jim_Alloc(keyLen+1);
3816 memcpy(t, p, keyLen);
3817 t[keyLen] = '\0';
3818 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3819
3820 Jim_IncrRefCount(varObjPtr);
3821 Jim_IncrRefCount(keyObjPtr);
3822 *varPtrPtr = varObjPtr;
3823 *keyPtrPtr = keyObjPtr;
3824 }
3825
3826 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3827 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3828 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3829 Jim_Obj *valObjPtr)
3830 {
3831 Jim_Obj *varObjPtr, *keyObjPtr;
3832 int err = JIM_OK;
3833
3834 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3835 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3836 valObjPtr);
3837 Jim_DecrRefCount(interp, varObjPtr);
3838 Jim_DecrRefCount(interp, keyObjPtr);
3839 return err;
3840 }
3841
3842 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3843 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3844 {
3845 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3846
3847 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3848 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3849 if (!dictObjPtr) {
3850 resObjPtr = NULL;
3851 goto err;
3852 }
3853 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3854 != JIM_OK) {
3855 resObjPtr = NULL;
3856 }
3857 err:
3858 Jim_DecrRefCount(interp, varObjPtr);
3859 Jim_DecrRefCount(interp, keyObjPtr);
3860 return resObjPtr;
3861 }
3862
3863 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3864
3865 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3866 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3867 Jim_Obj *dupPtr);
3868
3869 static Jim_ObjType dictSubstObjType = {
3870 "dict-substitution",
3871 FreeDictSubstInternalRep,
3872 DupDictSubstInternalRep,
3873 NULL,
3874 JIM_TYPE_NONE,
3875 };
3876
3877 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3878 {
3879 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3880 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3881 }
3882
3883 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3884 Jim_Obj *dupPtr)
3885 {
3886 JIM_NOTUSED(interp);
3887
3888 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3889 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3890 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3891 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3892 dupPtr->typePtr = &dictSubstObjType;
3893 }
3894
3895 /* This function is used to expand [dict get] sugar in the form
3896 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3897 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3898 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3899 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3900 * the [dict]ionary contained in variable VARNAME. */
3901 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3902 {
3903 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3904 Jim_Obj *substKeyObjPtr = NULL;
3905
3906 if (objPtr->typePtr != &dictSubstObjType) {
3907 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3908 Jim_FreeIntRep(interp, objPtr);
3909 objPtr->typePtr = &dictSubstObjType;
3910 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3911 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3912 }
3913 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3914 &substKeyObjPtr, JIM_NONE)
3915 != JIM_OK) {
3916 substKeyObjPtr = NULL;
3917 goto err;
3918 }
3919 Jim_IncrRefCount(substKeyObjPtr);
3920 dictObjPtr = Jim_GetVariable(interp,
3921 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3922 if (!dictObjPtr) {
3923 resObjPtr = NULL;
3924 goto err;
3925 }
3926 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3927 != JIM_OK) {
3928 resObjPtr = NULL;
3929 goto err;
3930 }
3931 err:
3932 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3933 return resObjPtr;
3934 }
3935
3936 /* -----------------------------------------------------------------------------
3937 * CallFrame
3938 * ---------------------------------------------------------------------------*/
3939
3940 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3941 {
3942 Jim_CallFrame *cf;
3943 if (interp->freeFramesList) {
3944 cf = interp->freeFramesList;
3945 interp->freeFramesList = cf->nextFramePtr;
3946 } else {
3947 cf = Jim_Alloc(sizeof(*cf));
3948 cf->vars.table = NULL;
3949 }
3950
3951 cf->id = interp->callFrameEpoch++;
3952 cf->parentCallFrame = NULL;
3953 cf->argv = NULL;
3954 cf->argc = 0;
3955 cf->procArgsObjPtr = NULL;
3956 cf->procBodyObjPtr = NULL;
3957 cf->nextFramePtr = NULL;
3958 cf->staticVars = NULL;
3959 if (cf->vars.table == NULL)
3960 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3961 return cf;
3962 }
3963
3964 /* Used to invalidate every caching related to callframe stability. */
3965 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3966 {
3967 cf->id = interp->callFrameEpoch++;
3968 }
3969
3970 #define JIM_FCF_NONE 0 /* no flags */
3971 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3972 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3973 int flags)
3974 {
3975 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3976 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3977 if (!(flags & JIM_FCF_NOHT))
3978 Jim_FreeHashTable(&cf->vars);
3979 else {
3980 int i;
3981 Jim_HashEntry **table = cf->vars.table, *he;
3982
3983 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3984 he = table[i];
3985 while (he != NULL) {
3986 Jim_HashEntry *nextEntry = he->next;
3987 Jim_Var *varPtr = (void*) he->val;
3988
3989 Jim_DecrRefCount(interp, varPtr->objPtr);
3990 Jim_Free(he->val);
3991 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3992 Jim_Free(he);
3993 table[i] = NULL;
3994 he = nextEntry;
3995 }
3996 }
3997 cf->vars.used = 0;
3998 }
3999 cf->nextFramePtr = interp->freeFramesList;
4000 interp->freeFramesList = cf;
4001 }
4002
4003 /* -----------------------------------------------------------------------------
4004 * References
4005 * ---------------------------------------------------------------------------*/
4006
4007 /* References HashTable Type.
4008 *
4009 * Keys are jim_wide integers, dynamically allocated for now but in the
4010 * future it's worth to cache this 8 bytes objects. Values are poitners
4011 * to Jim_References. */
4012 static void JimReferencesHTValDestructor(void *interp, void *val)
4013 {
4014 Jim_Reference *refPtr = (void*) val;
4015
4016 Jim_DecrRefCount(interp, refPtr->objPtr);
4017 if (refPtr->finalizerCmdNamePtr != NULL) {
4018 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4019 }
4020 Jim_Free(val);
4021 }
4022
4023 unsigned int JimReferencesHTHashFunction(const void *key)
4024 {
4025 /* Only the least significant bits are used. */
4026 const jim_wide *widePtr = key;
4027 unsigned int intValue = (unsigned int) *widePtr;
4028 return Jim_IntHashFunction(intValue);
4029 }
4030
4031 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4032 {
4033 /* Only the least significant bits are used. */
4034 const jim_wide *widePtr = key;
4035 unsigned int intValue = (unsigned int) *widePtr;
4036 return intValue; /* identity function. */
4037 }
4038
4039 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4040 {
4041 void *copy = Jim_Alloc(sizeof(jim_wide));
4042 JIM_NOTUSED(privdata);
4043
4044 memcpy(copy, key, sizeof(jim_wide));
4045 return copy;
4046 }
4047
4048 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4049 const void *key2)
4050 {
4051 JIM_NOTUSED(privdata);
4052
4053 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4054 }
4055
4056 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4057 {
4058 JIM_NOTUSED(privdata);
4059
4060 Jim_Free((void*)key);
4061 }
4062
4063 static Jim_HashTableType JimReferencesHashTableType = {
4064 JimReferencesHTHashFunction, /* hash function */
4065 JimReferencesHTKeyDup, /* key dup */
4066 NULL, /* val dup */
4067 JimReferencesHTKeyCompare, /* key compare */
4068 JimReferencesHTKeyDestructor, /* key destructor */
4069 JimReferencesHTValDestructor /* val destructor */
4070 };
4071
4072 /* -----------------------------------------------------------------------------
4073 * Reference object type and References API
4074 * ---------------------------------------------------------------------------*/
4075
4076 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4077
4078 static Jim_ObjType referenceObjType = {
4079 "reference",
4080 NULL,
4081 NULL,
4082 UpdateStringOfReference,
4083 JIM_TYPE_REFERENCES,
4084 };
4085
4086 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4087 {
4088 int len;
4089 char buf[JIM_REFERENCE_SPACE+1];
4090 Jim_Reference *refPtr;
4091
4092 refPtr = objPtr->internalRep.refValue.refPtr;
4093 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4094 objPtr->bytes = Jim_Alloc(len+1);
4095 memcpy(objPtr->bytes, buf, len+1);
4096 objPtr->length = len;
4097 }
4098
4099 /* returns true if 'c' is a valid reference tag character.
4100 * i.e. inside the range [_a-zA-Z0-9] */
4101 static int isrefchar(int c)
4102 {
4103 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4104 (c >= '0' && c <= '9')) return 1;
4105 return 0;
4106 }
4107
4108 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4109 {
4110 jim_wide wideValue;
4111 int i, len;
4112 const char *str, *start, *end;
4113 char refId[21];
4114 Jim_Reference *refPtr;
4115 Jim_HashEntry *he;
4116
4117 /* Get the string representation */
4118 str = Jim_GetString(objPtr, &len);
4119 /* Check if it looks like a reference */
4120 if (len < JIM_REFERENCE_SPACE) goto badformat;
4121 /* Trim spaces */
4122 start = str;
4123 end = str+len-1;
4124 while (*start == ' ') start++;
4125 while (*end == ' ' && end > start) end--;
4126 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4127 /* <reference.<1234567>.%020> */
4128 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4129 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4130 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4131 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4132 if (!isrefchar(start[12+i])) goto badformat;
4133 }
4134 /* Extract info from the refernece. */
4135 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4136 refId[20] = '\0';
4137 /* Try to convert the ID into a jim_wide */
4138 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4139 /* Check if the reference really exists! */
4140 he = Jim_FindHashEntry(&interp->references, &wideValue);
4141 if (he == NULL) {
4142 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4143 Jim_AppendStrings(interp, Jim_GetResult(interp),
4144 "Invalid reference ID \"", str, "\"", NULL);
4145 return JIM_ERR;
4146 }
4147 refPtr = he->val;
4148 /* Free the old internal repr and set the new one. */
4149 Jim_FreeIntRep(interp, objPtr);
4150 objPtr->typePtr = &referenceObjType;
4151 objPtr->internalRep.refValue.id = wideValue;
4152 objPtr->internalRep.refValue.refPtr = refPtr;
4153 return JIM_OK;
4154
4155 badformat:
4156 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4157 Jim_AppendStrings(interp, Jim_GetResult(interp),
4158 "expected reference but got \"", str, "\"", NULL);
4159 return JIM_ERR;
4160 }
4161
4162 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4163 * as finalizer command (or NULL if there is no finalizer).
4164 * The returned reference object has refcount = 0. */
4165 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4166 Jim_Obj *cmdNamePtr)
4167 {
4168 struct Jim_Reference *refPtr;
4169 jim_wide wideValue = interp->referenceNextId;
4170 Jim_Obj *refObjPtr;
4171 const char *tag;
4172 int tagLen, i;
4173
4174 /* Perform the Garbage Collection if needed. */
4175 Jim_CollectIfNeeded(interp);
4176
4177 refPtr = Jim_Alloc(sizeof(*refPtr));
4178 refPtr->objPtr = objPtr;
4179 Jim_IncrRefCount(objPtr);
4180 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4181 if (cmdNamePtr)
4182 Jim_IncrRefCount(cmdNamePtr);
4183 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4184 refObjPtr = Jim_NewObj(interp);
4185 refObjPtr->typePtr = &referenceObjType;
4186 refObjPtr->bytes = NULL;
4187 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4188 refObjPtr->internalRep.refValue.refPtr = refPtr;
4189 interp->referenceNextId++;
4190 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4191 * that does not pass the 'isrefchar' test is replaced with '_' */
4192 tag = Jim_GetString(tagPtr, &tagLen);
4193 if (tagLen > JIM_REFERENCE_TAGLEN)
4194 tagLen = JIM_REFERENCE_TAGLEN;
4195 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4196 if (i < tagLen)
4197 refPtr->tag[i] = tag[i];
4198 else
4199 refPtr->tag[i] = '_';
4200 }
4201 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4202 return refObjPtr;
4203 }
4204
4205 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4206 {
4207 if (objPtr->typePtr != &referenceObjType &&
4208 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4209 return NULL;
4210 return objPtr->internalRep.refValue.refPtr;
4211 }
4212
4213 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4214 {
4215 Jim_Reference *refPtr;
4216
4217 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4218 return JIM_ERR;
4219 Jim_IncrRefCount(cmdNamePtr);
4220 if (refPtr->finalizerCmdNamePtr)
4221 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4222 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4223 return JIM_OK;
4224 }
4225
4226 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4227 {
4228 Jim_Reference *refPtr;
4229
4230 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4231 return JIM_ERR;
4232 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4233 return JIM_OK;
4234 }
4235
4236 /* -----------------------------------------------------------------------------
4237 * References Garbage Collection
4238 * ---------------------------------------------------------------------------*/
4239
4240 /* This the hash table type for the "MARK" phase of the GC */
4241 static Jim_HashTableType JimRefMarkHashTableType = {
4242 JimReferencesHTHashFunction, /* hash function */
4243 JimReferencesHTKeyDup, /* key dup */
4244 NULL, /* val dup */
4245 JimReferencesHTKeyCompare, /* key compare */
4246 JimReferencesHTKeyDestructor, /* key destructor */
4247 NULL /* val destructor */
4248 };
4249
4250 /* #define JIM_DEBUG_GC 1 */
4251
4252 /* Performs the garbage collection. */
4253 int Jim_Collect(Jim_Interp *interp)
4254 {
4255 Jim_HashTable marks;
4256 Jim_HashTableIterator *htiter;
4257 Jim_HashEntry *he;
4258 Jim_Obj *objPtr;
4259 int collected = 0;
4260
4261 /* Avoid recursive calls */
4262 if (interp->lastCollectId == -1) {
4263 /* Jim_Collect() already running. Return just now. */
4264 return 0;
4265 }
4266 interp->lastCollectId = -1;
4267
4268 /* Mark all the references found into the 'mark' hash table.
4269 * The references are searched in every live object that
4270 * is of a type that can contain references. */
4271 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4272 objPtr = interp->liveList;
4273 while(objPtr) {
4274 if (objPtr->typePtr == NULL ||
4275 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4276 const char *str, *p;
4277 int len;
4278
4279 /* If the object is of type reference, to get the
4280 * Id is simple... */
4281 if (objPtr->typePtr == &referenceObjType) {
4282 Jim_AddHashEntry(&marks,
4283 &objPtr->internalRep.refValue.id, NULL);
4284 #ifdef JIM_DEBUG_GC
4285 Jim_fprintf(interp,interp->cookie_stdout,
4286 "MARK (reference): %d refcount: %d" JIM_NL,
4287 (int) objPtr->internalRep.refValue.id,
4288 objPtr->refCount);
4289 #endif
4290 objPtr = objPtr->nextObjPtr;
4291 continue;
4292 }
4293 /* Get the string repr of the object we want
4294 * to scan for references. */
4295 p = str = Jim_GetString(objPtr, &len);
4296 /* Skip objects too little to contain references. */
4297 if (len < JIM_REFERENCE_SPACE) {
4298 objPtr = objPtr->nextObjPtr;
4299 continue;
4300 }
4301 /* Extract references from the object string repr. */
4302 while(1) {
4303 int i;
4304 jim_wide id;
4305 char buf[21];
4306
4307 if ((p = strstr(p, "<reference.<")) == NULL)
4308 break;
4309 /* Check if it's a valid reference. */
4310 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4311 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4312 for (i = 21; i <= 40; i++)
4313 if (!isdigit((int)p[i]))
4314 break;
4315 /* Get the ID */
4316 memcpy(buf, p+21, 20);
4317 buf[20] = '\0';
4318 Jim_StringToWide(buf, &id, 10);
4319
4320 /* Ok, a reference for the given ID
4321 * was found. Mark it. */
4322 Jim_AddHashEntry(&marks, &id, NULL);
4323 #ifdef JIM_DEBUG_GC
4324 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4325 #endif
4326 p += JIM_REFERENCE_SPACE;
4327 }
4328 }
4329 objPtr = objPtr->nextObjPtr;
4330 }
4331
4332 /* Run the references hash table to destroy every reference that
4333 * is not referenced outside (not present in the mark HT). */
4334 htiter = Jim_GetHashTableIterator(&interp->references);
4335 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4336 const jim_wide *refId;
4337 Jim_Reference *refPtr;
4338
4339 refId = he->key;
4340 /* Check if in the mark phase we encountered
4341 * this reference. */
4342 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4343 #ifdef JIM_DEBUG_GC
4344 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4345 #endif
4346 collected++;
4347 /* Drop the reference, but call the
4348 * finalizer first if registered. */
4349 refPtr = he->val;
4350 if (refPtr->finalizerCmdNamePtr) {
4351 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4352 Jim_Obj *objv[3], *oldResult;
4353
4354 JimFormatReference(refstr, refPtr, *refId);
4355
4356 objv[0] = refPtr->finalizerCmdNamePtr;
4357 objv[1] = Jim_NewStringObjNoAlloc(interp,
4358 refstr, 32);
4359 objv[2] = refPtr->objPtr;
4360 Jim_IncrRefCount(objv[0]);
4361 Jim_IncrRefCount(objv[1]);
4362 Jim_IncrRefCount(objv[2]);
4363
4364 /* Drop the reference itself */
4365 Jim_DeleteHashEntry(&interp->references, refId);
4366
4367 /* Call the finalizer. Errors ignored. */
4368 oldResult = interp->result;
4369 Jim_IncrRefCount(oldResult);
4370 Jim_EvalObjVector(interp, 3, objv);
4371 Jim_SetResult(interp, oldResult);
4372 Jim_DecrRefCount(interp, oldResult);
4373
4374 Jim_DecrRefCount(interp, objv[0]);
4375 Jim_DecrRefCount(interp, objv[1]);
4376 Jim_DecrRefCount(interp, objv[2]);
4377 } else {
4378 Jim_DeleteHashEntry(&interp->references, refId);
4379 }
4380 }
4381 }
4382 Jim_FreeHashTableIterator(htiter);
4383 Jim_FreeHashTable(&marks);
4384 interp->lastCollectId = interp->referenceNextId;
4385 interp->lastCollectTime = time(NULL);
4386 return collected;
4387 }
4388
4389 #define JIM_COLLECT_ID_PERIOD 5000
4390 #define JIM_COLLECT_TIME_PERIOD 300
4391
4392 void Jim_CollectIfNeeded(Jim_Interp *interp)
4393 {
4394 jim_wide elapsedId;
4395 int elapsedTime;
4396
4397 elapsedId = interp->referenceNextId - interp->lastCollectId;
4398 elapsedTime = time(NULL) - interp->lastCollectTime;
4399
4400
4401 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4402 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4403 Jim_Collect(interp);
4404 }
4405 }
4406
4407 /* -----------------------------------------------------------------------------
4408 * Interpreter related functions
4409 * ---------------------------------------------------------------------------*/
4410
4411 Jim_Interp *Jim_CreateInterp(void)
4412 {
4413 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4414 Jim_Obj *pathPtr;
4415
4416 i->errorLine = 0;
4417 i->errorFileName = Jim_StrDup("");
4418 i->numLevels = 0;
4419 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4420 i->returnCode = JIM_OK;
4421 i->exitCode = 0;
4422 i->procEpoch = 0;
4423 i->callFrameEpoch = 0;
4424 i->liveList = i->freeList = NULL;
4425 i->scriptFileName = Jim_StrDup("");
4426 i->referenceNextId = 0;
4427 i->lastCollectId = 0;
4428 i->lastCollectTime = time(NULL);
4429 i->freeFramesList = NULL;
4430 i->prngState = NULL;
4431 i->evalRetcodeLevel = -1;
4432 i->cookie_stdin = stdin;
4433 i->cookie_stdout = stdout;
4434 i->cookie_stderr = stderr;
4435 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4436 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4437 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4438 i->cb_fflush = ((int (*)( void *))(fflush));
4439 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4440
4441 /* Note that we can create objects only after the
4442 * interpreter liveList and freeList pointers are
4443 * initialized to NULL. */
4444 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4445 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4446 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4447 NULL);
4448 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4449 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4450 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4451 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4452 i->emptyObj = Jim_NewEmptyStringObj(i);
4453 i->result = i->emptyObj;
4454 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4455 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4456 i->unknown_called = 0;
4457 Jim_IncrRefCount(i->emptyObj);
4458 Jim_IncrRefCount(i->result);
4459 Jim_IncrRefCount(i->stackTrace);
4460 Jim_IncrRefCount(i->unknown);
4461
4462 /* Initialize key variables every interpreter should contain */
4463 pathPtr = Jim_NewStringObj(i, "./", -1);
4464 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4465 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4466
4467 /* Export the core API to extensions */
4468 JimRegisterCoreApi(i);
4469 return i;
4470 }
4471
4472 /* This is the only function Jim exports directly without
4473 * to use the STUB system. It is only used by embedders
4474 * in order to get an interpreter with the Jim API pointers
4475 * registered. */
4476 Jim_Interp *ExportedJimCreateInterp(void)
4477 {
4478 return Jim_CreateInterp();
4479 }
4480
4481 void Jim_FreeInterp(Jim_Interp *i)
4482 {
4483 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4484 Jim_Obj *objPtr, *nextObjPtr;
4485
4486 Jim_DecrRefCount(i, i->emptyObj);
4487 Jim_DecrRefCount(i, i->result);
4488 Jim_DecrRefCount(i, i->stackTrace);
4489 Jim_DecrRefCount(i, i->unknown);
4490 Jim_Free((void*)i->errorFileName);
4491 Jim_Free((void*)i->scriptFileName);
4492 Jim_FreeHashTable(&i->commands);
4493 Jim_FreeHashTable(&i->references);
4494 Jim_FreeHashTable(&i->stub);
4495 Jim_FreeHashTable(&i->assocData);
4496 Jim_FreeHashTable(&i->packages);
4497 Jim_Free(i->prngState);
4498 /* Free the call frames list */
4499 while(cf) {
4500 prevcf = cf->parentCallFrame;
4501 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4502 cf = prevcf;
4503 }
4504 /* Check that the live object list is empty, otherwise
4505 * there is a memory leak. */
4506 if (i->liveList != NULL) {
4507 Jim_Obj *objPtr = i->liveList;
4508
4509 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4510 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4511 while(objPtr) {
4512 const char *type = objPtr->typePtr ?
4513 objPtr->typePtr->name : "";
4514 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4515 objPtr, type,
4516 objPtr->bytes ? objPtr->bytes
4517 : "(null)", objPtr->refCount);
4518 if (objPtr->typePtr == &sourceObjType) {
4519 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4520 objPtr->internalRep.sourceValue.fileName,
4521 objPtr->internalRep.sourceValue.lineNumber);
4522 }
4523 objPtr = objPtr->nextObjPtr;
4524 }
4525 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4526 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4527 }
4528 /* Free all the freed objects. */
4529 objPtr = i->freeList;
4530 while (objPtr) {
4531 nextObjPtr = objPtr->nextObjPtr;
4532 Jim_Free(objPtr);
4533 objPtr = nextObjPtr;
4534 }
4535 /* Free cached CallFrame structures */
4536 cf = i->freeFramesList;
4537 while(cf) {
4538 nextcf = cf->nextFramePtr;
4539 if (cf->vars.table != NULL)
4540 Jim_Free(cf->vars.table);
4541 Jim_Free(cf);
4542 cf = nextcf;
4543 }
4544 /* Free the sharedString hash table. Make sure to free it
4545 * after every other Jim_Object was freed. */
4546 Jim_FreeHashTable(&i->sharedStrings);
4547 /* Free the interpreter structure. */
4548 Jim_Free(i);
4549 }
4550
4551 /* Store the call frame relative to the level represented by
4552 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4553 * level is assumed to be '1'.
4554 *
4555 * If a newLevelptr int pointer is specified, the function stores
4556 * the absolute level integer value of the new target callframe into
4557 * *newLevelPtr. (this is used to adjust interp->numLevels
4558 * in the implementation of [uplevel], so that [info level] will
4559 * return a correct information).
4560 *
4561 * This function accepts the 'level' argument in the form
4562 * of the commands [uplevel] and [upvar].
4563 *
4564 * For a function accepting a relative integer as level suitable
4565 * for implementation of [info level ?level?] check the
4566 * GetCallFrameByInteger() function. */
4567 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4568 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4569 {
4570 long level;
4571 const char *str;
4572 Jim_CallFrame *framePtr;
4573
4574 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4575 if (levelObjPtr) {
4576 str = Jim_GetString(levelObjPtr, NULL);
4577 if (str[0] == '#') {
4578 char *endptr;
4579 /* speedup for the toplevel (level #0) */
4580 if (str[1] == '0' && str[2] == '\0') {
4581 if (newLevelPtr) *newLevelPtr = 0;
4582 *framePtrPtr = interp->topFramePtr;
4583 return JIM_OK;
4584 }
4585
4586 level = strtol(str+1, &endptr, 0);
4587 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4588 goto badlevel;
4589 /* An 'absolute' level is converted into the
4590 * 'number of levels to go back' format. */
4591 level = interp->numLevels - level;
4592 if (level < 0) goto badlevel;
4593 } else {
4594 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4595 goto badlevel;
4596 }
4597 } else {
4598 str = "1"; /* Needed to format the error message. */
4599 level = 1;
4600 }
4601 /* Lookup */
4602 framePtr = interp->framePtr;
4603 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4604 while (level--) {
4605 framePtr = framePtr->parentCallFrame;
4606 if (framePtr == NULL) goto badlevel;
4607 }
4608 *framePtrPtr = framePtr;
4609 return JIM_OK;
4610 badlevel:
4611 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4612 Jim_AppendStrings(interp, Jim_GetResult(interp),
4613 "bad level \"", str, "\"", NULL);
4614 return JIM_ERR;
4615 }
4616
4617 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4618 * as a relative integer like in the [info level ?level?] command. */
4619 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4620 Jim_CallFrame **framePtrPtr)
4621 {
4622 jim_wide level;
4623 jim_wide relLevel; /* level relative to the current one. */
4624 Jim_CallFrame *framePtr;
4625
4626 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4627 goto badlevel;
4628 if (level > 0) {
4629 /* An 'absolute' level is converted into the
4630 * 'number of levels to go back' format. */
4631 relLevel = interp->numLevels - level;
4632 } else {
4633 relLevel = -level;
4634 }
4635 /* Lookup */
4636 framePtr = interp->framePtr;
4637 while (relLevel--) {
4638 framePtr = framePtr->parentCallFrame;
4639 if (framePtr == NULL) goto badlevel;
4640 }
4641 *framePtrPtr = framePtr;
4642 return JIM_OK;
4643 badlevel:
4644 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4645 Jim_AppendStrings(interp, Jim_GetResult(interp),
4646 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4647 return JIM_ERR;
4648 }
4649
4650 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4651 {
4652 Jim_Free((void*)interp->errorFileName);
4653 interp->errorFileName = Jim_StrDup(filename);
4654 }
4655
4656 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4657 {
4658 interp->errorLine = linenr;
4659 }
4660
4661 static void JimResetStackTrace(Jim_Interp *interp)
4662 {
4663 Jim_DecrRefCount(interp, interp->stackTrace);
4664 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4665 Jim_IncrRefCount(interp->stackTrace);
4666 }
4667
4668 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4669 const char *filename, int linenr)
4670 {
4671 /* No need to add this dummy entry to the stack trace */
4672 if (strcmp(procname, "unknown") == 0) {
4673 return;
4674 }
4675
4676 if (Jim_IsShared(interp->stackTrace)) {
4677 interp->stackTrace =
4678 Jim_DuplicateObj(interp, interp->stackTrace);
4679 Jim_IncrRefCount(interp->stackTrace);
4680 }
4681 Jim_ListAppendElement(interp, interp->stackTrace,
4682 Jim_NewStringObj(interp, procname, -1));
4683 Jim_ListAppendElement(interp, interp->stackTrace,
4684 Jim_NewStringObj(interp, filename, -1));
4685 Jim_ListAppendElement(interp, interp->stackTrace,
4686 Jim_NewIntObj(interp, linenr));
4687 }
4688
4689 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4690 {
4691 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4692 assocEntryPtr->delProc = delProc;
4693 assocEntryPtr->data = data;
4694 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4695 }
4696
4697 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4698 {
4699 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4700 if (entryPtr != NULL) {
4701 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4702 return assocEntryPtr->data;
4703 }
4704 return NULL;
4705 }
4706
4707 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4708 {
4709 return Jim_DeleteHashEntry(&interp->assocData, key);
4710 }
4711
4712 int Jim_GetExitCode(Jim_Interp *interp) {
4713 return interp->exitCode;
4714 }
4715
4716 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4717 {
4718 if (fp != NULL) interp->cookie_stdin = fp;
4719 return interp->cookie_stdin;
4720 }
4721
4722 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4723 {
4724 if (fp != NULL) interp->cookie_stdout = fp;
4725 return interp->cookie_stdout;
4726 }
4727
4728 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4729 {
4730 if (fp != NULL) interp->cookie_stderr = fp;
4731 return interp->cookie_stderr;
4732 }
4733
4734 /* -----------------------------------------------------------------------------
4735 * Shared strings.
4736 * Every interpreter has an hash table where to put shared dynamically
4737 * allocate strings that are likely to be used a lot of times.
4738 * For example, in the 'source' object type, there is a pointer to
4739 * the filename associated with that object. Every script has a lot
4740 * of this objects with the identical file name, so it is wise to share
4741 * this info.
4742 *
4743 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4744 * returns the pointer to the shared string. Every time a reference
4745 * to the string is no longer used, the user should call
4746 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4747 * a given string, it is removed from the hash table.
4748 * ---------------------------------------------------------------------------*/
4749 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4750 {
4751 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4752
4753 if (he == NULL) {
4754 char *strCopy = Jim_StrDup(str);
4755
4756 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4757 return strCopy;
4758 } else {
4759 long refCount = (long) he->val;
4760
4761 refCount++;
4762 he->val = (void*) refCount;
4763 return he->key;
4764 }
4765 }
4766
4767 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4768 {
4769 long refCount;
4770 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4771
4772 if (he == NULL)
4773 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4774 "unknown shared string '%s'", str);
4775 refCount = (long) he->val;
4776 refCount--;
4777 if (refCount == 0) {
4778 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4779 } else {
4780 he->val = (void*) refCount;
4781 }
4782 }
4783
4784 /* -----------------------------------------------------------------------------
4785 * Integer object
4786 * ---------------------------------------------------------------------------*/
4787 #define JIM_INTEGER_SPACE 24
4788
4789 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4790 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4791
4792 static Jim_ObjType intObjType = {
4793 "int",
4794 NULL,
4795 NULL,
4796 UpdateStringOfInt,
4797 JIM_TYPE_NONE,
4798 };
4799
4800 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4801 {
4802 int len;
4803 char buf[JIM_INTEGER_SPACE+1];
4804
4805 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4806 objPtr->bytes = Jim_Alloc(len+1);
4807 memcpy(objPtr->bytes, buf, len+1);
4808 objPtr->length = len;
4809 }
4810
4811 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4812 {
4813 jim_wide wideValue;
4814 const char *str;
4815
4816 /* Get the string representation */
4817 str = Jim_GetString(objPtr, NULL);
4818 /* Try to convert into a jim_wide */
4819 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4820 if (flags & JIM_ERRMSG) {
4821 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4822 Jim_AppendStrings(interp, Jim_GetResult(interp),
4823 "expected integer but got \"", str, "\"", NULL);
4824 }
4825 return JIM_ERR;
4826 }
4827 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4828 errno == ERANGE) {
4829 Jim_SetResultString(interp,
4830 "Integer value too big to be represented", -1);
4831 return JIM_ERR;
4832 }
4833 /* Free the old internal repr and set the new one. */
4834 Jim_FreeIntRep(interp, objPtr);
4835 objPtr->typePtr = &intObjType;
4836 objPtr->internalRep.wideValue = wideValue;
4837 return JIM_OK;
4838 }
4839
4840 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4841 {
4842 if (objPtr->typePtr != &intObjType &&
4843 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4844 return JIM_ERR;
4845 *widePtr = objPtr->internalRep.wideValue;
4846 return JIM_OK;
4847 }
4848
4849 /* Get a wide but does not set an error if the format is bad. */
4850 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4851 jim_wide *widePtr)
4852 {
4853 if (objPtr->typePtr != &intObjType &&
4854 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4855 return JIM_ERR;
4856 *widePtr = objPtr->internalRep.wideValue;
4857 return JIM_OK;
4858 }
4859
4860 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4861 {
4862 jim_wide wideValue;
4863 int retval;
4864
4865 retval = Jim_GetWide(interp, objPtr, &wideValue);
4866 if (retval == JIM_OK) {
4867 *longPtr = (long) wideValue;
4868 return JIM_OK;
4869 }
4870 return JIM_ERR;
4871 }
4872
4873 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4874 {
4875 if (Jim_IsShared(objPtr))
4876 Jim_Panic(interp,"Jim_SetWide called with shared object");
4877 if (objPtr->typePtr != &intObjType) {
4878 Jim_FreeIntRep(interp, objPtr);
4879 objPtr->typePtr = &intObjType;
4880 }
4881 Jim_InvalidateStringRep(objPtr);
4882 objPtr->internalRep.wideValue = wideValue;
4883 }
4884
4885 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4886 {
4887 Jim_Obj *objPtr;
4888
4889 objPtr = Jim_NewObj(interp);
4890 objPtr->typePtr = &intObjType;
4891 objPtr->bytes = NULL;
4892 objPtr->internalRep.wideValue = wideValue;
4893 return objPtr;
4894 }
4895
4896 /* -----------------------------------------------------------------------------
4897 * Double object
4898 * ---------------------------------------------------------------------------*/
4899 #define JIM_DOUBLE_SPACE 30
4900
4901 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4902 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4903
4904 static Jim_ObjType doubleObjType = {
4905 "double",
4906 NULL,
4907 NULL,
4908 UpdateStringOfDouble,
4909 JIM_TYPE_NONE,
4910 };
4911
4912 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4913 {
4914 int len;
4915 char buf[JIM_DOUBLE_SPACE+1];
4916
4917 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4918 objPtr->bytes = Jim_Alloc(len+1);
4919 memcpy(objPtr->bytes, buf, len+1);
4920 objPtr->length = len;
4921 }
4922
4923 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4924 {
4925 double doubleValue;
4926 const char *str;
4927
4928 /* Get the string representation */
4929 str = Jim_GetString(objPtr, NULL);
4930 /* Try to convert into a double */
4931 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4932 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4933 Jim_AppendStrings(interp, Jim_GetResult(interp),
4934 "expected number but got '", str, "'", NULL);
4935 return JIM_ERR;
4936 }
4937 /* Free the old internal repr and set the new one. */
4938 Jim_FreeIntRep(interp, objPtr);
4939 objPtr->typePtr = &doubleObjType;
4940 objPtr->internalRep.doubleValue = doubleValue;
4941 return JIM_OK;
4942 }
4943
4944 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4945 {
4946 if (objPtr->typePtr != &doubleObjType &&
4947 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4948 return JIM_ERR;
4949 *doublePtr = objPtr->internalRep.doubleValue;
4950 return JIM_OK;
4951 }
4952
4953 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4954 {
4955 if (Jim_IsShared(objPtr))
4956 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4957 if (objPtr->typePtr != &doubleObjType) {
4958 Jim_FreeIntRep(interp, objPtr);
4959 objPtr->typePtr = &doubleObjType;
4960 }
4961 Jim_InvalidateStringRep(objPtr);
4962 objPtr->internalRep.doubleValue = doubleValue;
4963 }
4964
4965 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4966 {
4967 Jim_Obj *objPtr;
4968
4969 objPtr = Jim_NewObj(interp);
4970 objPtr->typePtr = &doubleObjType;
4971 objPtr->bytes = NULL;
4972 objPtr->internalRep.doubleValue = doubleValue;
4973 return objPtr;
4974 }
4975
4976 /* -----------------------------------------------------------------------------
4977 * List object
4978 * ---------------------------------------------------------------------------*/
4979 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4980 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4981 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4982 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4983 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4984
4985 /* Note that while the elements of the list may contain references,
4986 * the list object itself can't. This basically means that the
4987 * list object string representation as a whole can't contain references
4988 * that are not presents in the single elements. */
4989 static Jim_ObjType listObjType = {
4990 "list",
4991 FreeListInternalRep,
4992 DupListInternalRep,
4993 UpdateStringOfList,
4994 JIM_TYPE_NONE,
4995 };
4996
4997 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4998 {
4999 int i;
5000
5001 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5002 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5003 }
5004 Jim_Free(objPtr->internalRep.listValue.ele);
5005 }
5006
5007 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5008 {
5009 int i;
5010 JIM_NOTUSED(interp);
5011
5012 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5013 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5014 dupPtr->internalRep.listValue.ele =
5015 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5016 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5017 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5018 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5019 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5020 }
5021 dupPtr->typePtr = &listObjType;
5022 }
5023
5024 /* The following function checks if a given string can be encoded
5025 * into a list element without any kind of quoting, surrounded by braces,
5026 * or using escapes to quote. */
5027 #define JIM_ELESTR_SIMPLE 0
5028 #define JIM_ELESTR_BRACE 1
5029 #define JIM_ELESTR_QUOTE 2
5030 static int ListElementQuotingType(const char *s, int len)
5031 {
5032 int i, level, trySimple = 1;
5033
5034 /* Try with the SIMPLE case */
5035 if (len == 0) return JIM_ELESTR_BRACE;
5036 if (s[0] == '"' || s[0] == '{') {
5037 trySimple = 0;
5038 goto testbrace;
5039 }
5040 for (i = 0; i < len; i++) {
5041 switch(s[i]) {
5042 case ' ':
5043 case '$':
5044 case '"':
5045 case '[':
5046 case ']':
5047 case ';':
5048 case '\\':
5049 case '\r':
5050 case '\n':
5051 case '\t':
5052 case '\f':
5053 case '\v':
5054 trySimple = 0;
5055 case '{':
5056 case '}':
5057 goto testbrace;
5058 }
5059 }
5060 return JIM_ELESTR_SIMPLE;
5061
5062 testbrace:
5063 /* Test if it's possible to do with braces */
5064 if (s[len-1] == '\\' ||
5065 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5066 level = 0;
5067 for (i = 0; i < len; i++) {
5068 switch(s[i]) {
5069 case '{': level++; break;
5070 case '}': level--;
5071 if (level < 0) return JIM_ELESTR_QUOTE;
5072 break;
5073 case '\\':
5074 if (s[i+1] == '\n')
5075 return JIM_ELESTR_QUOTE;
5076 else
5077 if (s[i+1] != '\0') i++;
5078 break;
5079 }
5080 }
5081 if (level == 0) {
5082 if (!trySimple) return JIM_ELESTR_BRACE;
5083 for (i = 0; i < len; i++) {
5084 switch(s[i]) {
5085 case ' ':
5086 case '$':
5087 case '"':
5088 case '[':
5089 case ']':
5090 case ';':
5091 case '\\':
5092 case '\r':
5093 case '\n':
5094 case '\t':
5095 case '\f':
5096 case '\v':
5097 return JIM_ELESTR_BRACE;
5098 break;
5099 }
5100 }
5101 return JIM_ELESTR_SIMPLE;
5102 }
5103 return JIM_ELESTR_QUOTE;
5104 }
5105
5106 /* Returns the malloc-ed representation of a string
5107 * using backslash to quote special chars. */
5108 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5109 {
5110 char *q = Jim_Alloc(len*2+1), *p;
5111
5112 p = q;
5113 while(*s) {
5114 switch (*s) {
5115 case ' ':
5116 case '$':
5117 case '"':
5118 case '[':
5119 case ']':
5120 case '{':
5121 case '}':
5122 case ';':
5123 case '\\':
5124 *p++ = '\\';
5125 *p++ = *s++;
5126 break;
5127 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5128 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5129 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5130 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5131 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5132 default:
5133 *p++ = *s++;
5134 break;
5135 }
5136 }
5137 *p = '\0';
5138 *qlenPtr = p-q;
5139 return q;
5140 }
5141
5142 void UpdateStringOfList(struct Jim_Obj *objPtr)
5143 {
5144 int i, bufLen, realLength;
5145 const char *strRep;
5146 char *p;
5147 int *quotingType;
5148 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5149
5150 /* (Over) Estimate the space needed. */
5151 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5152 bufLen = 0;
5153 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5154 int len;
5155
5156 strRep = Jim_GetString(ele[i], &len);
5157 quotingType[i] = ListElementQuotingType(strRep, len);
5158 switch (quotingType[i]) {
5159 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5160 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5161 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5162 }
5163 bufLen++; /* elements separator. */
5164 }
5165 bufLen++;
5166
5167 /* Generate the string rep. */
5168 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5169 realLength = 0;
5170 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5171 int len, qlen;
5172 const char *strRep = Jim_GetString(ele[i], &len);
5173 char *q;
5174
5175 switch(quotingType[i]) {
5176 case JIM_ELESTR_SIMPLE:
5177 memcpy(p, strRep, len);
5178 p += len;
5179 realLength += len;
5180 break;
5181 case JIM_ELESTR_BRACE:
5182 *p++ = '{';
5183 memcpy(p, strRep, len);
5184 p += len;
5185 *p++ = '}';
5186 realLength += len+2;
5187 break;
5188 case JIM_ELESTR_QUOTE:
5189 q = BackslashQuoteString(strRep, len, &qlen);
5190 memcpy(p, q, qlen);
5191 Jim_Free(q);
5192 p += qlen;
5193 realLength += qlen;
5194 break;
5195 }
5196 /* Add a separating space */
5197 if (i+1 != objPtr->internalRep.listValue.len) {
5198 *p++ = ' ';
5199 realLength ++;
5200 }
5201 }
5202 *p = '\0'; /* nul term. */
5203 objPtr->length = realLength;
5204 Jim_Free(quotingType);
5205 }
5206
5207 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5208 {
5209 struct JimParserCtx parser;
5210 const char *str;
5211 int strLen;
5212
5213 /* Get the string representation */
5214 str = Jim_GetString(objPtr, &strLen);
5215
5216 /* Free the old internal repr just now and initialize the
5217 * new one just now. The string->list conversion can't fail. */
5218 Jim_FreeIntRep(interp, objPtr);
5219 objPtr->typePtr = &listObjType;
5220 objPtr->internalRep.listValue.len = 0;
5221 objPtr->internalRep.listValue.maxLen = 0;
5222 objPtr->internalRep.listValue.ele = NULL;
5223
5224 /* Convert into a list */
5225 JimParserInit(&parser, str, strLen, 1);
5226 while(!JimParserEof(&parser)) {
5227 char *token;
5228 int tokenLen, type;
5229 Jim_Obj *elementPtr;
5230
5231 JimParseList(&parser);
5232 if (JimParserTtype(&parser) != JIM_TT_STR &&
5233 JimParserTtype(&parser) != JIM_TT_ESC)
5234 continue;
5235 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5236 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5237 ListAppendElement(objPtr, elementPtr);
5238 }
5239 return JIM_OK;
5240 }
5241
5242 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5243 int len)
5244 {
5245 Jim_Obj *objPtr;
5246 int i;
5247
5248 objPtr = Jim_NewObj(interp);
5249 objPtr->typePtr = &listObjType;
5250 objPtr->bytes = NULL;
5251 objPtr->internalRep.listValue.ele = NULL;
5252 objPtr->internalRep.listValue.len = 0;
5253 objPtr->internalRep.listValue.maxLen = 0;
5254 for (i = 0; i < len; i++) {
5255 ListAppendElement(objPtr, elements[i]);
5256 }
5257 return objPtr;
5258 }
5259
5260 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5261 * length of the vector. Note that the user of this function should make
5262 * sure that the list object can't shimmer while the vector returned
5263 * is in use, this vector is the one stored inside the internal representation
5264 * of the list object. This function is not exported, extensions should
5265 * always access to the List object elements using Jim_ListIndex(). */
5266 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5267 Jim_Obj ***listVec)
5268 {
5269 Jim_ListLength(interp, listObj, argc);
5270 assert(listObj->typePtr == &listObjType);
5271 *listVec = listObj->internalRep.listValue.ele;
5272 }
5273
5274 /* ListSortElements type values */
5275 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5276 JIM_LSORT_NOCASE_DECR};
5277
5278 /* Sort the internal rep of a list. */
5279 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5280 {
5281 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5282 }
5283
5284 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5285 {
5286 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5287 }
5288
5289 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5290 {
5291 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5292 }
5293
5294 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5295 {
5296 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5297 }
5298
5299 /* Sort a list *in place*. MUST be called with non-shared objects. */
5300 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5301 {
5302 typedef int (qsort_comparator)(const void *, const void *);
5303 int (*fn)(Jim_Obj**, Jim_Obj**);
5304 Jim_Obj **vector;
5305 int len;
5306
5307 if (Jim_IsShared(listObjPtr))
5308 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5309 if (listObjPtr->typePtr != &listObjType)
5310 SetListFromAny(interp, listObjPtr);
5311
5312 vector = listObjPtr->internalRep.listValue.ele;
5313 len = listObjPtr->internalRep.listValue.len;
5314 switch (type) {
5315 case JIM_LSORT_ASCII: fn = ListSortString; break;
5316 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5317 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5318 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5319 default:
5320 fn = NULL; /* avoid warning */
5321 Jim_Panic(interp,"ListSort called with invalid sort type");
5322 }
5323 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5324 Jim_InvalidateStringRep(listObjPtr);
5325 }
5326
5327 /* This is the low-level function to append an element to a list.
5328 * The higher-level Jim_ListAppendElement() performs shared object
5329 * check and invalidate the string repr. This version is used
5330 * in the internals of the List Object and is not exported.
5331 *
5332 * NOTE: this function can be called only against objects
5333 * with internal type of List. */
5334 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5335 {
5336 int requiredLen = listPtr->internalRep.listValue.len + 1;
5337
5338 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5339 int maxLen = requiredLen * 2;
5340
5341 listPtr->internalRep.listValue.ele =
5342 Jim_Realloc(listPtr->internalRep.listValue.ele,
5343 sizeof(Jim_Obj*)*maxLen);
5344 listPtr->internalRep.listValue.maxLen = maxLen;
5345 }
5346 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5347 objPtr;
5348 listPtr->internalRep.listValue.len ++;
5349 Jim_IncrRefCount(objPtr);
5350 }
5351
5352 /* This is the low-level function to insert elements into a list.
5353 * The higher-level Jim_ListInsertElements() performs shared object
5354 * check and invalidate the string repr. This version is used
5355 * in the internals of the List Object and is not exported.
5356 *
5357 * NOTE: this function can be called only against objects
5358 * with internal type of List. */
5359 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5360 Jim_Obj *const *elemVec)
5361 {
5362 int currentLen = listPtr->internalRep.listValue.len;
5363 int requiredLen = currentLen + elemc;
5364 int i;
5365 Jim_Obj **point;
5366
5367 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5368 int maxLen = requiredLen * 2;
5369
5370 listPtr->internalRep.listValue.ele =
5371 Jim_Realloc(listPtr->internalRep.listValue.ele,
5372 sizeof(Jim_Obj*)*maxLen);
5373 listPtr->internalRep.listValue.maxLen = maxLen;
5374 }
5375 point = listPtr->internalRep.listValue.ele + index;
5376 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5377 for (i=0; i < elemc; ++i) {
5378 point[i] = elemVec[i];
5379 Jim_IncrRefCount(point[i]);
5380 }
5381 listPtr->internalRep.listValue.len += elemc;
5382 }
5383
5384 /* Appends every element of appendListPtr into listPtr.
5385 * Both have to be of the list type. */
5386 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5387 {
5388 int i, oldLen = listPtr->internalRep.listValue.len;
5389 int appendLen = appendListPtr->internalRep.listValue.len;
5390 int requiredLen = oldLen + appendLen;
5391
5392 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5393 int maxLen = requiredLen * 2;
5394
5395 listPtr->internalRep.listValue.ele =
5396 Jim_Realloc(listPtr->internalRep.listValue.ele,
5397 sizeof(Jim_Obj*)*maxLen);
5398 listPtr->internalRep.listValue.maxLen = maxLen;
5399 }
5400 for (i = 0; i < appendLen; i++) {
5401 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5402 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5403 Jim_IncrRefCount(objPtr);
5404 }
5405 listPtr->internalRep.listValue.len += appendLen;
5406 }
5407
5408 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5409 {
5410 if (Jim_IsShared(listPtr))
5411 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5412 if (listPtr->typePtr != &listObjType)
5413 SetListFromAny(interp, listPtr);
5414 Jim_InvalidateStringRep(listPtr);
5415 ListAppendElement(listPtr, objPtr);
5416 }
5417
5418 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5419 {
5420 if (Jim_IsShared(listPtr))
5421 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5422 if (listPtr->typePtr != &listObjType)
5423 SetListFromAny(interp, listPtr);
5424 Jim_InvalidateStringRep(listPtr);
5425 ListAppendList(listPtr, appendListPtr);
5426 }
5427
5428 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5429 {
5430 if (listPtr->typePtr != &listObjType)
5431 SetListFromAny(interp, listPtr);
5432 *intPtr = listPtr->internalRep.listValue.len;
5433 }
5434
5435 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5436 int objc, Jim_Obj *const *objVec)
5437 {
5438 if (Jim_IsShared(listPtr))
5439 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5440 if (listPtr->typePtr != &listObjType)
5441 SetListFromAny(interp, listPtr);
5442 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5443 index = listPtr->internalRep.listValue.len;
5444 else if (index < 0 )
5445 index = 0;
5446 Jim_InvalidateStringRep(listPtr);
5447 ListInsertElements(listPtr, index, objc, objVec);
5448 }
5449
5450 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5451 Jim_Obj **objPtrPtr, int flags)
5452 {
5453 if (listPtr->typePtr != &listObjType)
5454 SetListFromAny(interp, listPtr);
5455 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5456 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5457 if (flags & JIM_ERRMSG) {
5458 Jim_SetResultString(interp,
5459 "list index out of range", -1);
5460 }
5461 return JIM_ERR;
5462 }
5463 if (index < 0)
5464 index = listPtr->internalRep.listValue.len+index;
5465 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5466 return JIM_OK;
5467 }
5468
5469 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5470 Jim_Obj *newObjPtr, int flags)
5471 {
5472 if (listPtr->typePtr != &listObjType)
5473 SetListFromAny(interp, listPtr);
5474 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5475 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5476 if (flags & JIM_ERRMSG) {
5477 Jim_SetResultString(interp,
5478 "list index out of range", -1);
5479 }
5480 return JIM_ERR;
5481 }
5482 if (index < 0)
5483 index = listPtr->internalRep.listValue.len+index;
5484 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5485 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5486 Jim_IncrRefCount(newObjPtr);
5487 return JIM_OK;
5488 }
5489
5490 /* Modify the list stored into the variable named 'varNamePtr'
5491 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5492 * with the new element 'newObjptr'. */
5493 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5494 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5495 {
5496 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5497 int shared, i, index;
5498
5499 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5500 if (objPtr == NULL)
5501 return JIM_ERR;
5502 if ((shared = Jim_IsShared(objPtr)))
5503 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5504 for (i = 0; i < indexc-1; i++) {
5505 listObjPtr = objPtr;
5506 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5507 goto err;
5508 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5509 JIM_ERRMSG) != JIM_OK) {
5510 goto err;
5511 }
5512 if (Jim_IsShared(objPtr)) {
5513 objPtr = Jim_DuplicateObj(interp, objPtr);
5514 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5515 }
5516 Jim_InvalidateStringRep(listObjPtr);
5517 }
5518 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5519 goto err;
5520 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5521 goto err;
5522 Jim_InvalidateStringRep(objPtr);
5523 Jim_InvalidateStringRep(varObjPtr);
5524 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5525 goto err;
5526 Jim_SetResult(interp, varObjPtr);
5527 return JIM_OK;
5528 err:
5529 if (shared) {
5530 Jim_FreeNewObj(interp, varObjPtr);
5531 }
5532 return JIM_ERR;
5533 }
5534
5535 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5536 {
5537 int i;
5538
5539 /* If all the objects in objv are lists without string rep.
5540 * it's possible to return a list as result, that's the
5541 * concatenation of all the lists. */
5542 for (i = 0; i < objc; i++) {
5543 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5544 break;
5545 }
5546 if (i == objc) {
5547 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5548 for (i = 0; i < objc; i++)
5549 Jim_ListAppendList(interp, objPtr, objv[i]);
5550 return objPtr;
5551 } else {
5552 /* Else... we have to glue strings together */
5553 int len = 0, objLen;
5554 char *bytes, *p;
5555
5556 /* Compute the length */
5557 for (i = 0; i < objc; i++) {
5558 Jim_GetString(objv[i], &objLen);
5559 len += objLen;
5560 }
5561 if (objc) len += objc-1;
5562 /* Create the string rep, and a stinrg object holding it. */
5563 p = bytes = Jim_Alloc(len+1);
5564 for (i = 0; i < objc; i++) {
5565 const char *s = Jim_GetString(objv[i], &objLen);
5566 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5567 {
5568 s++; objLen--; len--;
5569 }
5570 while (objLen && (s[objLen-1] == ' ' ||
5571 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5572 objLen--; len--;
5573 }
5574 memcpy(p, s, objLen);
5575 p += objLen;
5576 if (objLen && i+1 != objc) {
5577 *p++ = ' ';
5578 } else if (i+1 != objc) {
5579 /* Drop the space calcuated for this
5580 * element that is instead null. */
5581 len--;
5582 }
5583 }
5584 *p = '\0';
5585 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5586 }
5587 }
5588
5589 /* Returns a list composed of the elements in the specified range.
5590 * first and start are directly accepted as Jim_Objects and
5591 * processed for the end?-index? case. */
5592 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5593 {
5594 int first, last;
5595 int len, rangeLen;
5596
5597 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5598 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5599 return NULL;
5600 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5601 first = JimRelToAbsIndex(len, first);
5602 last = JimRelToAbsIndex(len, last);
5603 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5604 return Jim_NewListObj(interp,
5605 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5606 }
5607
5608 /* -----------------------------------------------------------------------------
5609 * Dict object
5610 * ---------------------------------------------------------------------------*/
5611 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5612 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5613 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5614 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5615
5616 /* Dict HashTable Type.
5617 *
5618 * Keys and Values are Jim objects. */
5619
5620 unsigned int JimObjectHTHashFunction(const void *key)
5621 {
5622 const char *str;
5623 Jim_Obj *objPtr = (Jim_Obj*) key;
5624 int len, h;
5625
5626 str = Jim_GetString(objPtr, &len);
5627 h = Jim_GenHashFunction((unsigned char*)str, len);
5628 return h;
5629 }
5630
5631 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5632 {
5633 JIM_NOTUSED(privdata);
5634
5635 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5636 }
5637
5638 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5639 {
5640 Jim_Obj *objPtr = val;
5641
5642 Jim_DecrRefCount(interp, objPtr);
5643 }
5644
5645 static Jim_HashTableType JimDictHashTableType = {
5646 JimObjectHTHashFunction, /* hash function */
5647 NULL, /* key dup */
5648 NULL, /* val dup */
5649 JimObjectHTKeyCompare, /* key compare */
5650 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5651 JimObjectHTKeyValDestructor, /* key destructor */
5652 JimObjectHTKeyValDestructor /* val destructor */
5653 };
5654
5655 /* Note that while the elements of the dict may contain references,
5656 * the list object itself can't. This basically means that the
5657 * dict object string representation as a whole can't contain references
5658 * that are not presents in the single elements. */
5659 static Jim_ObjType dictObjType = {
5660 "dict",
5661 FreeDictInternalRep,
5662 DupDictInternalRep,
5663 UpdateStringOfDict,
5664 JIM_TYPE_NONE,
5665 };
5666
5667 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5668 {
5669 JIM_NOTUSED(interp);
5670
5671 Jim_FreeHashTable(objPtr->internalRep.ptr);
5672 Jim_Free(objPtr->internalRep.ptr);
5673 }
5674
5675 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5676 {
5677 Jim_HashTable *ht, *dupHt;
5678 Jim_HashTableIterator *htiter;
5679 Jim_HashEntry *he;
5680
5681 /* Create a new hash table */
5682 ht = srcPtr->internalRep.ptr;
5683 dupHt = Jim_Alloc(sizeof(*dupHt));
5684 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5685 if (ht->size != 0)
5686 Jim_ExpandHashTable(dupHt, ht->size);
5687 /* Copy every element from the source to the dup hash table */
5688 htiter = Jim_GetHashTableIterator(ht);
5689 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5690 const Jim_Obj *keyObjPtr = he->key;
5691 Jim_Obj *valObjPtr = he->val;
5692
5693 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5694 Jim_IncrRefCount(valObjPtr);
5695 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5696 }
5697 Jim_FreeHashTableIterator(htiter);
5698
5699 dupPtr->internalRep.ptr = dupHt;
5700 dupPtr->typePtr = &dictObjType;
5701 }
5702
5703 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5704 {
5705 int i, bufLen, realLength;
5706 const char *strRep;
5707 char *p;
5708 int *quotingType, objc;
5709 Jim_HashTable *ht;
5710 Jim_HashTableIterator *htiter;
5711 Jim_HashEntry *he;
5712 Jim_Obj **objv;
5713
5714 /* Trun the hash table into a flat vector of Jim_Objects. */
5715 ht = objPtr->internalRep.ptr;
5716 objc = ht->used*2;
5717 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5718 htiter = Jim_GetHashTableIterator(ht);
5719 i = 0;
5720 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5721 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5722 objv[i++] = he->val;
5723 }
5724 Jim_FreeHashTableIterator(htiter);
5725 /* (Over) Estimate the space needed. */
5726 quotingType = Jim_Alloc(sizeof(int)*objc);
5727 bufLen = 0;
5728 for (i = 0; i < objc; i++) {
5729 int len;
5730
5731 strRep = Jim_GetString(objv[i], &len);
5732 quotingType[i] = ListElementQuotingType(strRep, len);
5733 switch (quotingType[i]) {
5734 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5735 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5736 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5737 }
5738 bufLen++; /* elements separator. */
5739 }
5740 bufLen++;
5741
5742 /* Generate the string rep. */
5743 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5744 realLength = 0;
5745 for (i = 0; i < objc; i++) {
5746 int len, qlen;
5747 const char *strRep = Jim_GetString(objv[i], &len);
5748 char *q;
5749
5750 switch(quotingType[i]) {
5751 case JIM_ELESTR_SIMPLE:
5752 memcpy(p, strRep, len);
5753 p += len;
5754 realLength += len;
5755 break;
5756 case JIM_ELESTR_BRACE:
5757 *p++ = '{';
5758 memcpy(p, strRep, len);
5759 p += len;
5760 *p++ = '}';
5761 realLength += len+2;
5762 break;
5763 case JIM_ELESTR_QUOTE:
5764 q = BackslashQuoteString(strRep, len, &qlen);
5765 memcpy(p, q, qlen);
5766 Jim_Free(q);
5767 p += qlen;
5768 realLength += qlen;
5769 break;
5770 }
5771 /* Add a separating space */
5772 if (i+1 != objc) {
5773 *p++ = ' ';
5774 realLength ++;
5775 }
5776 }
5777 *p = '\0'; /* nul term. */
5778 objPtr->length = realLength;
5779 Jim_Free(quotingType);
5780 Jim_Free(objv);
5781 }
5782
5783 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5784 {
5785 struct JimParserCtx parser;
5786 Jim_HashTable *ht;
5787 Jim_Obj *objv[2];
5788 const char *str;
5789 int i, strLen;
5790
5791 /* Get the string representation */
5792 str = Jim_GetString(objPtr, &strLen);
5793
5794 /* Free the old internal repr just now and initialize the
5795 * new one just now. The string->list conversion can't fail. */
5796 Jim_FreeIntRep(interp, objPtr);
5797 ht = Jim_Alloc(sizeof(*ht));
5798 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5799 objPtr->typePtr = &dictObjType;
5800 objPtr->internalRep.ptr = ht;
5801
5802 /* Convert into a dict */
5803 JimParserInit(&parser, str, strLen, 1);
5804 i = 0;
5805 while(!JimParserEof(&parser)) {
5806 char *token;
5807 int tokenLen, type;
5808
5809 JimParseList(&parser);
5810 if (JimParserTtype(&parser) != JIM_TT_STR &&
5811 JimParserTtype(&parser) != JIM_TT_ESC)
5812 continue;
5813 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5814 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5815 if (i == 2) {
5816 i = 0;
5817 Jim_IncrRefCount(objv[0]);
5818 Jim_IncrRefCount(objv[1]);
5819 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5820 Jim_HashEntry *he;
5821 he = Jim_FindHashEntry(ht, objv[0]);
5822 Jim_DecrRefCount(interp, objv[0]);
5823 /* ATTENTION: const cast */
5824 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5825 he->val = objv[1];
5826 }
5827 }
5828 }
5829 if (i) {
5830 Jim_FreeNewObj(interp, objv[0]);
5831 objPtr->typePtr = NULL;
5832 Jim_FreeHashTable(ht);
5833 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5834 return JIM_ERR;
5835 }
5836 return JIM_OK;
5837 }
5838
5839 /* Dict object API */
5840
5841 /* Add an element to a dict. objPtr must be of the "dict" type.
5842 * The higer-level exported function is Jim_DictAddElement().
5843 * If an element with the specified key already exists, the value
5844 * associated is replaced with the new one.
5845 *
5846 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5847 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5848 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5849 {
5850 Jim_HashTable *ht = objPtr->internalRep.ptr;
5851
5852 if (valueObjPtr == NULL) { /* unset */
5853 Jim_DeleteHashEntry(ht, keyObjPtr);
5854 return;
5855 }
5856 Jim_IncrRefCount(keyObjPtr);
5857 Jim_IncrRefCount(valueObjPtr);
5858 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5859 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5860 Jim_DecrRefCount(interp, keyObjPtr);
5861 /* ATTENTION: const cast */
5862 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5863 he->val = valueObjPtr;
5864 }
5865 }
5866
5867 /* Add an element, higher-level interface for DictAddElement().
5868 * If valueObjPtr == NULL, the key is removed if it exists. */
5869 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5870 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5871 {
5872 if (Jim_IsShared(objPtr))
5873 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5874 if (objPtr->typePtr != &dictObjType) {
5875 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5876 return JIM_ERR;
5877 }
5878 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5879 Jim_InvalidateStringRep(objPtr);
5880 return JIM_OK;
5881 }
5882
5883 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5884 {
5885 Jim_Obj *objPtr;
5886 int i;
5887
5888 if (len % 2)
5889 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5890
5891 objPtr = Jim_NewObj(interp);
5892 objPtr->typePtr = &dictObjType;
5893 objPtr->bytes = NULL;
5894 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5895 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5896 for (i = 0; i < len; i += 2)
5897 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5898 return objPtr;
5899 }
5900
5901 /* Return the value associated to the specified dict key */
5902 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5903 Jim_Obj **objPtrPtr, int flags)
5904 {
5905 Jim_HashEntry *he;
5906 Jim_HashTable *ht;
5907
5908 if (dictPtr->typePtr != &dictObjType) {
5909 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5910 return JIM_ERR;
5911 }
5912 ht = dictPtr->internalRep.ptr;
5913 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5914 if (flags & JIM_ERRMSG) {
5915 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5916 Jim_AppendStrings(interp, Jim_GetResult(interp),
5917 "key \"", Jim_GetString(keyPtr, NULL),
5918 "\" not found in dictionary", NULL);
5919 }
5920 return JIM_ERR;
5921 }
5922 *objPtrPtr = he->val;
5923 return JIM_OK;
5924 }
5925
5926 /* Return the value associated to the specified dict keys */
5927 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5928 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5929 {
5930 Jim_Obj *objPtr;
5931 int i;
5932
5933 if (keyc == 0) {
5934 *objPtrPtr = dictPtr;
5935 return JIM_OK;
5936 }
5937
5938 for (i = 0; i < keyc; i++) {
5939 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5940 != JIM_OK)
5941 return JIM_ERR;
5942 dictPtr = objPtr;
5943 }
5944 *objPtrPtr = objPtr;
5945 return JIM_OK;
5946 }
5947
5948 /* Modify the dict stored into the variable named 'varNamePtr'
5949 * setting the element specified by the 'keyc' keys objects in 'keyv',
5950 * with the new value of the element 'newObjPtr'.
5951 *
5952 * If newObjPtr == NULL the operation is to remove the given key
5953 * from the dictionary. */
5954 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5955 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5956 {
5957 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5958 int shared, i;
5959
5960 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5961 if (objPtr == NULL) {
5962 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5963 return JIM_ERR;
5964 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5965 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5966 Jim_FreeNewObj(interp, varObjPtr);
5967 return JIM_ERR;
5968 }
5969 }
5970 if ((shared = Jim_IsShared(objPtr)))
5971 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5972 for (i = 0; i < keyc-1; i++) {
5973 dictObjPtr = objPtr;
5974
5975 /* Check if it's a valid dictionary */
5976 if (dictObjPtr->typePtr != &dictObjType) {
5977 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5978 goto err;
5979 }
5980 /* Check if the given key exists. */
5981 Jim_InvalidateStringRep(dictObjPtr);
5982 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5983 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5984 {
5985 /* This key exists at the current level.
5986 * Make sure it's not shared!. */
5987 if (Jim_IsShared(objPtr)) {
5988 objPtr = Jim_DuplicateObj(interp, objPtr);
5989 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5990 }
5991 } else {
5992 /* Key not found. If it's an [unset] operation
5993 * this is an error. Only the last key may not
5994 * exist. */
5995 if (newObjPtr == NULL)
5996 goto err;
5997 /* Otherwise set an empty dictionary
5998 * as key's value. */
5999 objPtr = Jim_NewDictObj(interp, NULL, 0);
6000 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6001 }
6002 }
6003 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6004 != JIM_OK)
6005 goto err;
6006 Jim_InvalidateStringRep(objPtr);
6007 Jim_InvalidateStringRep(varObjPtr);
6008 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6009 goto err;
6010 Jim_SetResult(interp, varObjPtr);
6011 return JIM_OK;
6012 err:
6013 if (shared) {
6014 Jim_FreeNewObj(interp, varObjPtr);
6015 }
6016 return JIM_ERR;
6017 }
6018
6019 /* -----------------------------------------------------------------------------
6020 * Index object
6021 * ---------------------------------------------------------------------------*/
6022 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6023 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6024
6025 static Jim_ObjType indexObjType = {
6026 "index",
6027 NULL,
6028 NULL,
6029 UpdateStringOfIndex,
6030 JIM_TYPE_NONE,
6031 };
6032
6033 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6034 {
6035 int len;
6036 char buf[JIM_INTEGER_SPACE+1];
6037
6038 if (objPtr->internalRep.indexValue >= 0)
6039 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6040 else if (objPtr->internalRep.indexValue == -1)
6041 len = sprintf(buf, "end");
6042 else {
6043 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6044 }
6045 objPtr->bytes = Jim_Alloc(len+1);
6046 memcpy(objPtr->bytes, buf, len+1);
6047 objPtr->length = len;
6048 }
6049
6050 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6051 {
6052 int index, end = 0;
6053 const char *str;
6054
6055 /* Get the string representation */
6056 str = Jim_GetString(objPtr, NULL);
6057 /* Try to convert into an index */
6058 if (!strcmp(str, "end")) {
6059 index = 0;
6060 end = 1;
6061 } else {
6062 if (!strncmp(str, "end-", 4)) {
6063 str += 4;
6064 end = 1;
6065 }
6066 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6067 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6068 Jim_AppendStrings(interp, Jim_GetResult(interp),
6069 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6070 "must be integer or end?-integer?", NULL);
6071 return JIM_ERR;
6072 }
6073 }
6074 if (end) {
6075 if (index < 0)
6076 index = INT_MAX;
6077 else
6078 index = -(index+1);
6079 } else if (!end && index < 0)
6080 index = -INT_MAX;
6081 /* Free the old internal repr and set the new one. */
6082 Jim_FreeIntRep(interp, objPtr);
6083 objPtr->typePtr = &indexObjType;
6084 objPtr->internalRep.indexValue = index;
6085 return JIM_OK;
6086 }
6087
6088 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6089 {
6090 /* Avoid shimmering if the object is an integer. */
6091 if (objPtr->typePtr == &intObjType) {
6092 jim_wide val = objPtr->internalRep.wideValue;
6093 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6094 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6095 return JIM_OK;
6096 }
6097 }
6098 if (objPtr->typePtr != &indexObjType &&
6099 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6100 return JIM_ERR;
6101 *indexPtr = objPtr->internalRep.indexValue;
6102 return JIM_OK;
6103 }
6104
6105 /* -----------------------------------------------------------------------------
6106 * Return Code Object.
6107 * ---------------------------------------------------------------------------*/
6108
6109 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6110
6111 static Jim_ObjType returnCodeObjType = {
6112 "return-code",
6113 NULL,
6114 NULL,
6115 NULL,
6116 JIM_TYPE_NONE,
6117 };
6118
6119 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6120 {
6121 const char *str;
6122 int strLen, returnCode;
6123 jim_wide wideValue;
6124
6125 /* Get the string representation */
6126 str = Jim_GetString(objPtr, &strLen);
6127 /* Try to convert into an integer */
6128 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6129 returnCode = (int) wideValue;
6130 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6131 returnCode = JIM_OK;
6132 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6133 returnCode = JIM_ERR;
6134 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6135 returnCode = JIM_RETURN;
6136 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6137 returnCode = JIM_BREAK;
6138 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6139 returnCode = JIM_CONTINUE;
6140 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6141 returnCode = JIM_EVAL;
6142 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6143 returnCode = JIM_EXIT;
6144 else {
6145 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6146 Jim_AppendStrings(interp, Jim_GetResult(interp),
6147 "expected return code but got '", str, "'",
6148 NULL);
6149 return JIM_ERR;
6150 }
6151 /* Free the old internal repr and set the new one. */
6152 Jim_FreeIntRep(interp, objPtr);
6153 objPtr->typePtr = &returnCodeObjType;
6154 objPtr->internalRep.returnCode = returnCode;
6155 return JIM_OK;
6156 }
6157
6158 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6159 {
6160 if (objPtr->typePtr != &returnCodeObjType &&
6161 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6162 return JIM_ERR;
6163 *intPtr = objPtr->internalRep.returnCode;
6164 return JIM_OK;
6165 }
6166
6167 /* -----------------------------------------------------------------------------
6168 * Expression Parsing
6169 * ---------------------------------------------------------------------------*/
6170 static int JimParseExprOperator(struct JimParserCtx *pc);
6171 static int JimParseExprNumber(struct JimParserCtx *pc);
6172 static int JimParseExprIrrational(struct JimParserCtx *pc);
6173
6174 /* Exrp's Stack machine operators opcodes. */
6175
6176 /* Binary operators (numbers) */
6177 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6178 #define JIM_EXPROP_MUL 0
6179 #define JIM_EXPROP_DIV 1
6180 #define JIM_EXPROP_MOD 2
6181 #define JIM_EXPROP_SUB 3
6182 #define JIM_EXPROP_ADD 4
6183 #define JIM_EXPROP_LSHIFT 5
6184 #define JIM_EXPROP_RSHIFT 6
6185 #define JIM_EXPROP_ROTL 7
6186 #define JIM_EXPROP_ROTR 8
6187 #define JIM_EXPROP_LT 9
6188 #define JIM_EXPROP_GT 10
6189 #define JIM_EXPROP_LTE 11
6190 #define JIM_EXPROP_GTE 12
6191 #define JIM_EXPROP_NUMEQ 13
6192 #define JIM_EXPROP_NUMNE 14
6193 #define JIM_EXPROP_BITAND 15
6194 #define JIM_EXPROP_BITXOR 16
6195 #define JIM_EXPROP_BITOR 17
6196 #define JIM_EXPROP_LOGICAND 18
6197 #define JIM_EXPROP_LOGICOR 19
6198 #define JIM_EXPROP_LOGICAND_LEFT 20
6199 #define JIM_EXPROP_LOGICOR_LEFT 21
6200 #define JIM_EXPROP_POW 22
6201 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6202
6203 /* Binary operators (strings) */
6204 #define JIM_EXPROP_STREQ 23
6205 #define JIM_EXPROP_STRNE 24
6206
6207 /* Unary operators (numbers) */
6208 #define JIM_EXPROP_NOT 25
6209 #define JIM_EXPROP_BITNOT 26
6210 #define JIM_EXPROP_UNARYMINUS 27
6211 #define JIM_EXPROP_UNARYPLUS 28
6212 #define JIM_EXPROP_LOGICAND_RIGHT 29
6213 #define JIM_EXPROP_LOGICOR_RIGHT 30
6214
6215 /* Ternary operators */
6216 #define JIM_EXPROP_TERNARY 31
6217
6218 /* Operands */
6219 #define JIM_EXPROP_NUMBER 32
6220 #define JIM_EXPROP_COMMAND 33
6221 #define JIM_EXPROP_VARIABLE 34
6222 #define JIM_EXPROP_DICTSUGAR 35
6223 #define JIM_EXPROP_SUBST 36
6224 #define JIM_EXPROP_STRING 37
6225
6226 /* Operators table */
6227 typedef struct Jim_ExprOperator {
6228 const char *name;
6229 int precedence;
6230 int arity;
6231 int opcode;
6232 } Jim_ExprOperator;
6233
6234 /* name - precedence - arity - opcode */
6235 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6236 {"!", 300, 1, JIM_EXPROP_NOT},
6237 {"~", 300, 1, JIM_EXPROP_BITNOT},
6238 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6239 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6240
6241 {"**", 250, 2, JIM_EXPROP_POW},
6242
6243 {"*", 200, 2, JIM_EXPROP_MUL},
6244 {"/", 200, 2, JIM_EXPROP_DIV},
6245 {"%", 200, 2, JIM_EXPROP_MOD},
6246
6247 {"-", 100, 2, JIM_EXPROP_SUB},
6248 {"+", 100, 2, JIM_EXPROP_ADD},
6249
6250 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6251 {">>>", 90, 3, JIM_EXPROP_ROTR},
6252 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6253 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6254
6255 {"<", 80, 2, JIM_EXPROP_LT},
6256 {">", 80, 2, JIM_EXPROP_GT},
6257 {"<=", 80, 2, JIM_EXPROP_LTE},
6258 {">=", 80, 2, JIM_EXPROP_GTE},
6259
6260 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6261 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6262
6263 {"eq", 60, 2, JIM_EXPROP_STREQ},
6264 {"ne", 60, 2, JIM_EXPROP_STRNE},
6265
6266 {"&", 50, 2, JIM_EXPROP_BITAND},
6267 {"^", 49, 2, JIM_EXPROP_BITXOR},
6268 {"|", 48, 2, JIM_EXPROP_BITOR},
6269
6270 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6271 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6272
6273 {"?", 5, 3, JIM_EXPROP_TERNARY},
6274 /* private operators */
6275 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6276 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6277 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6278 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6279 };
6280
6281 #define JIM_EXPR_OPERATORS_NUM \
6282 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6283
6284 int JimParseExpression(struct JimParserCtx *pc)
6285 {
6286 /* Discard spaces and quoted newline */
6287 while(*(pc->p) == ' ' ||
6288 *(pc->p) == '\t' ||
6289 *(pc->p) == '\r' ||
6290 *(pc->p) == '\n' ||
6291 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6292 pc->p++; pc->len--;
6293 }
6294
6295 if (pc->len == 0) {
6296 pc->tstart = pc->tend = pc->p;
6297 pc->tline = pc->linenr;
6298 pc->tt = JIM_TT_EOL;
6299 pc->eof = 1;
6300 return JIM_OK;
6301 }
6302 switch(*(pc->p)) {
6303 case '(':
6304 pc->tstart = pc->tend = pc->p;
6305 pc->tline = pc->linenr;
6306 pc->tt = JIM_TT_SUBEXPR_START;
6307 pc->p++; pc->len--;
6308 break;
6309 case ')':
6310 pc->tstart = pc->tend = pc->p;
6311 pc->tline = pc->linenr;
6312 pc->tt = JIM_TT_SUBEXPR_END;
6313 pc->p++; pc->len--;
6314 break;
6315 case '[':
6316 return JimParseCmd(pc);
6317 break;
6318 case '$':
6319 if (JimParseVar(pc) == JIM_ERR)
6320 return JimParseExprOperator(pc);
6321 else
6322 return JIM_OK;
6323 break;
6324 case '-':
6325 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6326 isdigit((int)*(pc->p+1)))
6327 return JimParseExprNumber(pc);
6328 else
6329 return JimParseExprOperator(pc);
6330 break;
6331 case '0': case '1': case '2': case '3': case '4':
6332 case '5': case '6': case '7': case '8': case '9': case '.':
6333 return JimParseExprNumber(pc);
6334 break;
6335 case '"':
6336 case '{':
6337 /* Here it's possible to reuse the List String parsing. */
6338 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6339 return JimParseListStr(pc);
6340 break;
6341 case 'N': case 'I':
6342 case 'n': case 'i':
6343 if (JimParseExprIrrational(pc) == JIM_ERR)
6344 return JimParseExprOperator(pc);
6345 break;
6346 default:
6347 return JimParseExprOperator(pc);
6348 break;
6349 }
6350 return JIM_OK;
6351 }
6352
6353 int JimParseExprNumber(struct JimParserCtx *pc)
6354 {
6355 int allowdot = 1;
6356 int allowhex = 0;
6357
6358 pc->tstart = pc->p;
6359 pc->tline = pc->linenr;
6360 if (*pc->p == '-') {
6361 pc->p++; pc->len--;
6362 }
6363 while ( isdigit((int)*pc->p)
6364 || (allowhex && isxdigit((int)*pc->p) )
6365 || (allowdot && *pc->p == '.')
6366 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6367 (*pc->p == 'x' || *pc->p == 'X'))
6368 )
6369 {
6370 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6371 allowhex = 1;
6372 allowdot = 0;
6373 }
6374 if (*pc->p == '.')
6375 allowdot = 0;
6376 pc->p++; pc->len--;
6377 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6378 pc->p += 2; pc->len -= 2;
6379 }
6380 }
6381 pc->tend = pc->p-1;
6382 pc->tt = JIM_TT_EXPR_NUMBER;
6383 return JIM_OK;
6384 }
6385
6386 int JimParseExprIrrational(struct JimParserCtx *pc)
6387 {
6388 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6389 const char **token;
6390 for (token = Tokens; *token != NULL; token++) {
6391 int len = strlen(*token);
6392 if (strncmp(*token, pc->p, len) == 0) {
6393 pc->tstart = pc->p;
6394 pc->tend = pc->p + len - 1;
6395 pc->p += len; pc->len -= len;
6396 pc->tline = pc->linenr;
6397 pc->tt = JIM_TT_EXPR_NUMBER;
6398 return JIM_OK;
6399 }
6400 }
6401 return JIM_ERR;
6402 }
6403
6404 int JimParseExprOperator(struct JimParserCtx *pc)
6405 {
6406 int i;
6407 int bestIdx = -1, bestLen = 0;
6408
6409 /* Try to get the longest match. */
6410 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6411 const char *opname;
6412 int oplen;
6413
6414 opname = Jim_ExprOperators[i].name;
6415 if (opname == NULL) continue;
6416 oplen = strlen(opname);
6417
6418 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6419 bestIdx = i;
6420 bestLen = oplen;
6421 }
6422 }
6423 if (bestIdx == -1) return JIM_ERR;
6424 pc->tstart = pc->p;
6425 pc->tend = pc->p + bestLen - 1;
6426 pc->p += bestLen; pc->len -= bestLen;
6427 pc->tline = pc->linenr;
6428 pc->tt = JIM_TT_EXPR_OPERATOR;
6429 return JIM_OK;
6430 }
6431
6432 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6433 {
6434 int i;
6435 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6436 if (Jim_ExprOperators[i].name &&
6437 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6438 return &Jim_ExprOperators[i];
6439 return NULL;
6440 }
6441
6442 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6443 {
6444 int i;
6445 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6446 if (Jim_ExprOperators[i].opcode == opcode)
6447 return &Jim_ExprOperators[i];
6448 return NULL;
6449 }
6450
6451 /* -----------------------------------------------------------------------------
6452 * Expression Object
6453 * ---------------------------------------------------------------------------*/
6454 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6455 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6456 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6457
6458 static Jim_ObjType exprObjType = {
6459 "expression",
6460 FreeExprInternalRep,
6461 DupExprInternalRep,
6462 NULL,
6463 JIM_TYPE_REFERENCES,
6464 };
6465
6466 /* Expr bytecode structure */
6467 typedef struct ExprByteCode {
6468 int *opcode; /* Integer array of opcodes. */
6469 Jim_Obj **obj; /* Array of associated Jim Objects. */
6470 int len; /* Bytecode length */
6471 int inUse; /* Used for sharing. */
6472 } ExprByteCode;
6473
6474 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6475 {
6476 int i;
6477 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6478
6479 expr->inUse--;
6480 if (expr->inUse != 0) return;
6481 for (i = 0; i < expr->len; i++)
6482 Jim_DecrRefCount(interp, expr->obj[i]);
6483 Jim_Free(expr->opcode);
6484 Jim_Free(expr->obj);
6485 Jim_Free(expr);
6486 }
6487
6488 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6489 {
6490 JIM_NOTUSED(interp);
6491 JIM_NOTUSED(srcPtr);
6492
6493 /* Just returns an simple string. */
6494 dupPtr->typePtr = NULL;
6495 }
6496
6497 /* Add a new instruction to an expression bytecode structure. */
6498 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6499 int opcode, char *str, int len)
6500 {
6501 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6502 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6503 expr->opcode[expr->len] = opcode;
6504 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6505 Jim_IncrRefCount(expr->obj[expr->len]);
6506 expr->len++;
6507 }
6508
6509 /* Check if an expr program looks correct. */
6510 static int ExprCheckCorrectness(ExprByteCode *expr)
6511 {
6512 int i;
6513 int stacklen = 0;
6514
6515 /* Try to check if there are stack underflows,
6516 * and make sure at the end of the program there is
6517 * a single result on the stack. */
6518 for (i = 0; i < expr->len; i++) {
6519 switch(expr->opcode[i]) {
6520 case JIM_EXPROP_NUMBER:
6521 case JIM_EXPROP_STRING:
6522 case JIM_EXPROP_SUBST:
6523 case JIM_EXPROP_VARIABLE:
6524 case JIM_EXPROP_DICTSUGAR:
6525 case JIM_EXPROP_COMMAND:
6526 stacklen++;
6527 break;
6528 case JIM_EXPROP_NOT:
6529 case JIM_EXPROP_BITNOT:
6530 case JIM_EXPROP_UNARYMINUS:
6531 case JIM_EXPROP_UNARYPLUS:
6532 /* Unary operations */
6533 if (stacklen < 1) return JIM_ERR;
6534 break;
6535 case JIM_EXPROP_ADD:
6536 case JIM_EXPROP_SUB:
6537 case JIM_EXPROP_MUL:
6538 case JIM_EXPROP_DIV:
6539 case JIM_EXPROP_MOD:
6540 case JIM_EXPROP_LT:
6541 case JIM_EXPROP_GT:
6542 case JIM_EXPROP_LTE:
6543 case JIM_EXPROP_GTE:
6544 case JIM_EXPROP_ROTL:
6545 case JIM_EXPROP_ROTR:
6546 case JIM_EXPROP_LSHIFT:
6547 case JIM_EXPROP_RSHIFT:
6548 case JIM_EXPROP_NUMEQ:
6549 case JIM_EXPROP_NUMNE:
6550 case JIM_EXPROP_STREQ:
6551 case JIM_EXPROP_STRNE:
6552 case JIM_EXPROP_BITAND:
6553 case JIM_EXPROP_BITXOR:
6554 case JIM_EXPROP_BITOR:
6555 case JIM_EXPROP_LOGICAND:
6556 case JIM_EXPROP_LOGICOR:
6557 case JIM_EXPROP_POW:
6558 /* binary operations */
6559 if (stacklen < 2) return JIM_ERR;
6560 stacklen--;
6561 break;
6562 default:
6563 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6564 break;
6565 }
6566 }
6567 if (stacklen != 1) return JIM_ERR;
6568 return JIM_OK;
6569 }
6570
6571 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6572 ScriptObj *topLevelScript)
6573 {
6574 int i;
6575
6576 return;
6577 for (i = 0; i < expr->len; i++) {
6578 Jim_Obj *foundObjPtr;
6579
6580 if (expr->obj[i] == NULL) continue;
6581 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6582 NULL, expr->obj[i]);
6583 if (foundObjPtr != NULL) {
6584 Jim_IncrRefCount(foundObjPtr);
6585 Jim_DecrRefCount(interp, expr->obj[i]);
6586 expr->obj[i] = foundObjPtr;
6587 }
6588 }
6589 }
6590
6591 /* This procedure converts every occurrence of || and && opereators
6592 * in lazy unary versions.
6593 *
6594 * a b || is converted into:
6595 *
6596 * a <offset> |L b |R
6597 *
6598 * a b && is converted into:
6599 *
6600 * a <offset> &L b &R
6601 *
6602 * "|L" checks if 'a' is true:
6603 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6604 * the opcode just after |R.
6605 * 2) if it is false does nothing.
6606 * "|R" checks if 'b' is true:
6607 * 1) if it is true pushes 1, otherwise pushes 0.
6608 *
6609 * "&L" checks if 'a' is true:
6610 * 1) if it is true does nothing.
6611 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6612 * the opcode just after &R
6613 * "&R" checks if 'a' is true:
6614 * if it is true pushes 1, otherwise pushes 0.
6615 */
6616 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6617 {
6618 while (1) {
6619 int index = -1, leftindex, arity, i, offset;
6620 Jim_ExprOperator *op;
6621
6622 /* Search for || or && */
6623 for (i = 0; i < expr->len; i++) {
6624 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6625 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6626 index = i;
6627 break;
6628 }
6629 }
6630 if (index == -1) return;
6631 /* Search for the end of the first operator */
6632 leftindex = index-1;
6633 arity = 1;
6634 while(arity) {
6635 switch(expr->opcode[leftindex]) {
6636 case JIM_EXPROP_NUMBER:
6637 case JIM_EXPROP_COMMAND:
6638 case JIM_EXPROP_VARIABLE:
6639 case JIM_EXPROP_DICTSUGAR:
6640 case JIM_EXPROP_SUBST:
6641 case JIM_EXPROP_STRING:
6642 break;
6643 default:
6644 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6645 if (op == NULL) {
6646 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6647 }
6648 arity += op->arity;
6649 break;
6650 }
6651 arity--;
6652 leftindex--;
6653 }
6654 leftindex++;
6655 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6656 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6657 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6658 sizeof(int)*(expr->len-leftindex));
6659 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6660 sizeof(Jim_Obj*)*(expr->len-leftindex));
6661 expr->len += 2;
6662 index += 2;
6663 offset = (index-leftindex)-1;
6664 Jim_DecrRefCount(interp, expr->obj[index]);
6665 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6666 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6667 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6668 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6669 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6670 } else {
6671 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6672 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6673 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6674 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6675 }
6676 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6677 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6678 Jim_IncrRefCount(expr->obj[index]);
6679 Jim_IncrRefCount(expr->obj[leftindex]);
6680 Jim_IncrRefCount(expr->obj[leftindex+1]);
6681 }
6682 }
6683
6684 /* This method takes the string representation of an expression
6685 * and generates a program for the Expr's stack-based VM. */
6686 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6687 {
6688 int exprTextLen;
6689 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6690 struct JimParserCtx parser;
6691 int i, shareLiterals;
6692 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6693 Jim_Stack stack;
6694 Jim_ExprOperator *op;
6695
6696 /* Perform literal sharing with the current procedure
6697 * running only if this expression appears to be not generated
6698 * at runtime. */
6699 shareLiterals = objPtr->typePtr == &sourceObjType;
6700
6701 expr->opcode = NULL;
6702 expr->obj = NULL;
6703 expr->len = 0;
6704 expr->inUse = 1;
6705
6706 Jim_InitStack(&stack);
6707 JimParserInit(&parser, exprText, exprTextLen, 1);
6708 while(!JimParserEof(&parser)) {
6709 char *token;
6710 int len, type;
6711
6712 if (JimParseExpression(&parser) != JIM_OK) {
6713 Jim_SetResultString(interp, "Syntax error in expression", -1);
6714 goto err;
6715 }
6716 token = JimParserGetToken(&parser, &len, &type, NULL);
6717 if (type == JIM_TT_EOL) {
6718 Jim_Free(token);
6719 break;
6720 }
6721 switch(type) {
6722 case JIM_TT_STR:
6723 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6724 break;
6725 case JIM_TT_ESC:
6726 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6727 break;
6728 case JIM_TT_VAR:
6729 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6730 break;
6731 case JIM_TT_DICTSUGAR:
6732 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6733 break;
6734 case JIM_TT_CMD:
6735 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6736 break;
6737 case JIM_TT_EXPR_NUMBER:
6738 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6739 break;
6740 case JIM_TT_EXPR_OPERATOR:
6741 op = JimExprOperatorInfo(token);
6742 while(1) {
6743 Jim_ExprOperator *stackTopOp;
6744
6745 if (Jim_StackPeek(&stack) != NULL) {
6746 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6747 } else {
6748 stackTopOp = NULL;
6749 }
6750 if (Jim_StackLen(&stack) && op->arity != 1 &&
6751 stackTopOp && stackTopOp->precedence >= op->precedence)
6752 {
6753 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6754 Jim_StackPeek(&stack), -1);
6755 Jim_StackPop(&stack);
6756 } else {
6757 break;
6758 }
6759 }
6760 Jim_StackPush(&stack, token);
6761 break;
6762 case JIM_TT_SUBEXPR_START:
6763 Jim_StackPush(&stack, Jim_StrDup("("));
6764 Jim_Free(token);
6765 break;
6766 case JIM_TT_SUBEXPR_END:
6767 {
6768 int found = 0;
6769 while(Jim_StackLen(&stack)) {
6770 char *opstr = Jim_StackPop(&stack);
6771 if (!strcmp(opstr, "(")) {
6772 Jim_Free(opstr);
6773 found = 1;
6774 break;
6775 }
6776 op = JimExprOperatorInfo(opstr);
6777 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6778 }
6779 if (!found) {
6780 Jim_SetResultString(interp,
6781 "Unexpected close parenthesis", -1);
6782 goto err;
6783 }
6784 }
6785 Jim_Free(token);
6786 break;
6787 default:
6788 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6789 break;
6790 }
6791 }
6792 while (Jim_StackLen(&stack)) {
6793 char *opstr = Jim_StackPop(&stack);
6794 op = JimExprOperatorInfo(opstr);
6795 if (op == NULL && !strcmp(opstr, "(")) {
6796 Jim_Free(opstr);
6797 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6798 goto err;
6799 }
6800 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6801 }
6802 /* Check program correctness. */
6803 if (ExprCheckCorrectness(expr) != JIM_OK) {
6804 Jim_SetResultString(interp, "Invalid expression", -1);
6805 goto err;
6806 }
6807
6808 /* Free the stack used for the compilation. */
6809 Jim_FreeStackElements(&stack, Jim_Free);
6810 Jim_FreeStack(&stack);
6811
6812 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6813 ExprMakeLazy(interp, expr);
6814
6815 /* Perform literal sharing */
6816 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6817 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6818 if (bodyObjPtr->typePtr == &scriptObjType) {
6819 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6820 ExprShareLiterals(interp, expr, bodyScript);
6821 }
6822 }
6823
6824 /* Free the old internal rep and set the new one. */
6825 Jim_FreeIntRep(interp, objPtr);
6826 Jim_SetIntRepPtr(objPtr, expr);
6827 objPtr->typePtr = &exprObjType;
6828 return JIM_OK;
6829
6830 err: /* we jump here on syntax/compile errors. */
6831 Jim_FreeStackElements(&stack, Jim_Free);
6832 Jim_FreeStack(&stack);
6833 Jim_Free(expr->opcode);
6834 for (i = 0; i < expr->len; i++) {
6835 Jim_DecrRefCount(interp,expr->obj[i]);
6836 }
6837 Jim_Free(expr->obj);
6838 Jim_Free(expr);
6839 return JIM_ERR;
6840 }
6841
6842 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6843 {
6844 if (objPtr->typePtr != &exprObjType) {
6845 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6846 return NULL;
6847 }
6848 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6849 }
6850
6851 /* -----------------------------------------------------------------------------
6852 * Expressions evaluation.
6853 * Jim uses a specialized stack-based virtual machine for expressions,
6854 * that takes advantage of the fact that expr's operators
6855 * can't be redefined.
6856 *
6857 * Jim_EvalExpression() uses the bytecode compiled by
6858 * SetExprFromAny() method of the "expression" object.
6859 *
6860 * On success a Tcl Object containing the result of the evaluation
6861 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6862 * returned.
6863 * On error the function returns a retcode != to JIM_OK and set a suitable
6864 * error on the interp.
6865 * ---------------------------------------------------------------------------*/
6866 #define JIM_EE_STATICSTACK_LEN 10
6867
6868 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6869 Jim_Obj **exprResultPtrPtr)
6870 {
6871 ExprByteCode *expr;
6872 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6873 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6874
6875 Jim_IncrRefCount(exprObjPtr);
6876 expr = Jim_GetExpression(interp, exprObjPtr);
6877 if (!expr) {
6878 Jim_DecrRefCount(interp, exprObjPtr);
6879 return JIM_ERR; /* error in expression. */
6880 }
6881 /* In order to avoid that the internal repr gets freed due to
6882 * shimmering of the exprObjPtr's object, we make the internal rep
6883 * shared. */
6884 expr->inUse++;
6885
6886 /* The stack-based expr VM itself */
6887
6888 /* Stack allocation. Expr programs have the feature that
6889 * a program of length N can't require a stack longer than
6890 * N. */
6891 if (expr->len > JIM_EE_STATICSTACK_LEN)
6892 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6893 else
6894 stack = staticStack;
6895
6896 /* Execute every istruction */
6897 for (i = 0; i < expr->len; i++) {
6898 Jim_Obj *A, *B, *objPtr;
6899 jim_wide wA, wB, wC;
6900 double dA, dB, dC;
6901 const char *sA, *sB;
6902 int Alen, Blen, retcode;
6903 int opcode = expr->opcode[i];
6904
6905 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6906 stack[stacklen++] = expr->obj[i];
6907 Jim_IncrRefCount(expr->obj[i]);
6908 } else if (opcode == JIM_EXPROP_VARIABLE) {
6909 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6910 if (objPtr == NULL) {
6911 error = 1;
6912 goto err;
6913 }
6914 stack[stacklen++] = objPtr;
6915 Jim_IncrRefCount(objPtr);
6916 } else if (opcode == JIM_EXPROP_SUBST) {
6917 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6918 &objPtr, JIM_NONE)) != JIM_OK)
6919 {
6920 error = 1;
6921 errRetCode = retcode;
6922 goto err;
6923 }
6924 stack[stacklen++] = objPtr;
6925 Jim_IncrRefCount(objPtr);
6926 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6927 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6928 if (objPtr == NULL) {
6929 error = 1;
6930 goto err;
6931 }
6932 stack[stacklen++] = objPtr;
6933 Jim_IncrRefCount(objPtr);
6934 } else if (opcode == JIM_EXPROP_COMMAND) {
6935 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6936 error = 1;
6937 errRetCode = retcode;
6938 goto err;
6939 }
6940 stack[stacklen++] = interp->result;
6941 Jim_IncrRefCount(interp->result);
6942 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6943 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6944 {
6945 /* Note that there isn't to increment the
6946 * refcount of objects. the references are moved
6947 * from stack to A and B. */
6948 B = stack[--stacklen];
6949 A = stack[--stacklen];
6950
6951 /* --- Integer --- */
6952 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6953 (B->typePtr == &doubleObjType && !B->bytes) ||
6954 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6955 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6956 goto trydouble;
6957 }
6958 Jim_DecrRefCount(interp, A);
6959 Jim_DecrRefCount(interp, B);
6960 switch(expr->opcode[i]) {
6961 case JIM_EXPROP_ADD: wC = wA+wB; break;
6962 case JIM_EXPROP_SUB: wC = wA-wB; break;
6963 case JIM_EXPROP_MUL: wC = wA*wB; break;
6964 case JIM_EXPROP_LT: wC = wA<wB; break;
6965 case JIM_EXPROP_GT: wC = wA>wB; break;
6966 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6967 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6968 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6969 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6970 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6971 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6972 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6973 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6974 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6975 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6976 case JIM_EXPROP_LOGICAND_LEFT:
6977 if (wA == 0) {
6978 i += (int)wB;
6979 wC = 0;
6980 } else {
6981 continue;
6982 }
6983 break;
6984 case JIM_EXPROP_LOGICOR_LEFT:
6985 if (wA != 0) {
6986 i += (int)wB;
6987 wC = 1;
6988 } else {
6989 continue;
6990 }
6991 break;
6992 case JIM_EXPROP_DIV:
6993 if (wB == 0) goto divbyzero;
6994 wC = wA/wB;
6995 break;
6996 case JIM_EXPROP_MOD:
6997 if (wB == 0) goto divbyzero;
6998 wC = wA%wB;
6999 break;
7000 case JIM_EXPROP_ROTL: {
7001 /* uint32_t would be better. But not everyone has inttypes.h?*/
7002 unsigned long uA = (unsigned long)wA;
7003 #ifdef _MSC_VER
7004 wC = _rotl(uA,(unsigned long)wB);
7005 #else
7006 const unsigned int S = sizeof(unsigned long) * 8;
7007 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
7008 #endif
7009 break;
7010 }
7011 case JIM_EXPROP_ROTR: {
7012 unsigned long uA = (unsigned long)wA;
7013 #ifdef _MSC_VER
7014 wC = _rotr(uA,(unsigned long)wB);
7015 #else
7016 const unsigned int S = sizeof(unsigned long) * 8;
7017 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7018 #endif
7019 break;
7020 }
7021
7022 default:
7023 wC = 0; /* avoid gcc warning */
7024 break;
7025 }
7026 stack[stacklen] = Jim_NewIntObj(interp, wC);
7027 Jim_IncrRefCount(stack[stacklen]);
7028 stacklen++;
7029 continue;
7030 trydouble:
7031 /* --- Double --- */
7032 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7033 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7034
7035 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7036 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7037 opcode = JIM_EXPROP_STRNE;
7038 goto retry_as_string;
7039 }
7040 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7041 opcode = JIM_EXPROP_STREQ;
7042 goto retry_as_string;
7043 }
7044 Jim_DecrRefCount(interp, A);
7045 Jim_DecrRefCount(interp, B);
7046 error = 1;
7047 goto err;
7048 }
7049 Jim_DecrRefCount(interp, A);
7050 Jim_DecrRefCount(interp, B);
7051 switch(expr->opcode[i]) {
7052 case JIM_EXPROP_ROTL:
7053 case JIM_EXPROP_ROTR:
7054 case JIM_EXPROP_LSHIFT:
7055 case JIM_EXPROP_RSHIFT:
7056 case JIM_EXPROP_BITAND:
7057 case JIM_EXPROP_BITXOR:
7058 case JIM_EXPROP_BITOR:
7059 case JIM_EXPROP_MOD:
7060 case JIM_EXPROP_POW:
7061 Jim_SetResultString(interp,
7062 "Got floating-point value where integer was expected", -1);
7063 error = 1;
7064 goto err;
7065 break;
7066 case JIM_EXPROP_ADD: dC = dA+dB; break;
7067 case JIM_EXPROP_SUB: dC = dA-dB; break;
7068 case JIM_EXPROP_MUL: dC = dA*dB; break;
7069 case JIM_EXPROP_LT: dC = dA<dB; break;
7070 case JIM_EXPROP_GT: dC = dA>dB; break;
7071 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7072 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7073 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7074 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7075 case JIM_EXPROP_LOGICAND_LEFT:
7076 if (dA == 0) {
7077 i += (int)dB;
7078 dC = 0;
7079 } else {
7080 continue;
7081 }
7082 break;
7083 case JIM_EXPROP_LOGICOR_LEFT:
7084 if (dA != 0) {
7085 i += (int)dB;
7086 dC = 1;
7087 } else {
7088 continue;
7089 }
7090 break;
7091 case JIM_EXPROP_DIV:
7092 if (dB == 0) goto divbyzero;
7093 dC = dA/dB;
7094 break;
7095 default:
7096 dC = 0; /* avoid gcc warning */
7097 break;
7098 }
7099 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7100 Jim_IncrRefCount(stack[stacklen]);
7101 stacklen++;
7102 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7103 B = stack[--stacklen];
7104 A = stack[--stacklen];
7105 retry_as_string:
7106 sA = Jim_GetString(A, &Alen);
7107 sB = Jim_GetString(B, &Blen);
7108 switch(opcode) {
7109 case JIM_EXPROP_STREQ:
7110 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7111 wC = 1;
7112 else
7113 wC = 0;
7114 break;
7115 case JIM_EXPROP_STRNE:
7116 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7117 wC = 1;
7118 else
7119 wC = 0;
7120 break;
7121 default:
7122 wC = 0; /* avoid gcc warning */
7123 break;
7124 }
7125 Jim_DecrRefCount(interp, A);
7126 Jim_DecrRefCount(interp, B);
7127 stack[stacklen] = Jim_NewIntObj(interp, wC);
7128 Jim_IncrRefCount(stack[stacklen]);
7129 stacklen++;
7130 } else if (opcode == JIM_EXPROP_NOT ||
7131 opcode == JIM_EXPROP_BITNOT ||
7132 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7133 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7134 /* Note that there isn't to increment the
7135 * refcount of objects. the references are moved
7136 * from stack to A and B. */
7137 A = stack[--stacklen];
7138
7139 /* --- Integer --- */
7140 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7141 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7142 goto trydouble_unary;
7143 }
7144 Jim_DecrRefCount(interp, A);
7145 switch(expr->opcode[i]) {
7146 case JIM_EXPROP_NOT: wC = !wA; break;
7147 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7148 case JIM_EXPROP_LOGICAND_RIGHT:
7149 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7150 default:
7151 wC = 0; /* avoid gcc warning */
7152 break;
7153 }
7154 stack[stacklen] = Jim_NewIntObj(interp, wC);
7155 Jim_IncrRefCount(stack[stacklen]);
7156 stacklen++;
7157 continue;
7158 trydouble_unary:
7159 /* --- Double --- */
7160 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7161 Jim_DecrRefCount(interp, A);
7162 error = 1;
7163 goto err;
7164 }
7165 Jim_DecrRefCount(interp, A);
7166 switch(expr->opcode[i]) {
7167 case JIM_EXPROP_NOT: dC = !dA; break;
7168 case JIM_EXPROP_LOGICAND_RIGHT:
7169 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7170 case JIM_EXPROP_BITNOT:
7171 Jim_SetResultString(interp,
7172 "Got floating-point value where integer was expected", -1);
7173 error = 1;
7174 goto err;
7175 break;
7176 default:
7177 dC = 0; /* avoid gcc warning */
7178 break;
7179 }
7180 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7181 Jim_IncrRefCount(stack[stacklen]);
7182 stacklen++;
7183 } else {
7184 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7185 }
7186 }
7187 err:
7188 /* There is no need to decerement the inUse field because
7189 * this reference is transfered back into the exprObjPtr. */
7190 Jim_FreeIntRep(interp, exprObjPtr);
7191 exprObjPtr->typePtr = &exprObjType;
7192 Jim_SetIntRepPtr(exprObjPtr, expr);
7193 Jim_DecrRefCount(interp, exprObjPtr);
7194 if (!error) {
7195 *exprResultPtrPtr = stack[0];
7196 Jim_IncrRefCount(stack[0]);
7197 errRetCode = JIM_OK;
7198 }
7199 for (i = 0; i < stacklen; i++) {
7200 Jim_DecrRefCount(interp, stack[i]);
7201 }
7202 if (stack != staticStack)
7203 Jim_Free(stack);
7204 return errRetCode;
7205 divbyzero:
7206 error = 1;
7207 Jim_SetResultString(interp, "Division by zero", -1);
7208 goto err;
7209 }
7210
7211 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7212 {
7213 int retcode;
7214 jim_wide wideValue;
7215 double doubleValue;
7216 Jim_Obj *exprResultPtr;
7217
7218 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7219 if (retcode != JIM_OK)
7220 return retcode;
7221 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7222 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7223 {
7224 Jim_DecrRefCount(interp, exprResultPtr);
7225 return JIM_ERR;
7226 } else {
7227 Jim_DecrRefCount(interp, exprResultPtr);
7228 *boolPtr = doubleValue != 0;
7229 return JIM_OK;
7230 }
7231 }
7232 Jim_DecrRefCount(interp, exprResultPtr);
7233 *boolPtr = wideValue != 0;
7234 return JIM_OK;
7235 }
7236
7237 /* -----------------------------------------------------------------------------
7238 * ScanFormat String Object
7239 * ---------------------------------------------------------------------------*/
7240
7241 /* This Jim_Obj will held a parsed representation of a format string passed to
7242 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7243 * to be parsed in its entirely first and then, if correct, can be used for
7244 * scanning. To avoid endless re-parsing, the parsed representation will be
7245 * stored in an internal representation and re-used for performance reason. */
7246
7247 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7248 * scanformat string. This part will later be used to extract information
7249 * out from the string to be parsed by Jim_ScanString */
7250
7251 typedef struct ScanFmtPartDescr {
7252 char type; /* Type of conversion (e.g. c, d, f) */
7253 char modifier; /* Modify type (e.g. l - long, h - short */
7254 size_t width; /* Maximal width of input to be converted */
7255 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7256 char *arg; /* Specification of a CHARSET conversion */
7257 char *prefix; /* Prefix to be scanned literally before conversion */
7258 } ScanFmtPartDescr;
7259
7260 /* The ScanFmtStringObj will held the internal representation of a scanformat
7261 * string parsed and separated in part descriptions. Furthermore it contains
7262 * the original string representation of the scanformat string to allow for
7263 * fast update of the Jim_Obj's string representation part.
7264 *
7265 * As add-on the internal object representation add some scratch pad area
7266 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7267 * memory for purpose of string scanning.
7268 *
7269 * The error member points to a static allocated string in case of a mal-
7270 * formed scanformat string or it contains '0' (NULL) in case of a valid
7271 * parse representation.
7272 *
7273 * The whole memory of the internal representation is allocated as a single
7274 * area of memory that will be internally separated. So freeing and duplicating
7275 * of such an object is cheap */
7276
7277 typedef struct ScanFmtStringObj {
7278 jim_wide size; /* Size of internal repr in bytes */
7279 char *stringRep; /* Original string representation */
7280 size_t count; /* Number of ScanFmtPartDescr contained */
7281 size_t convCount; /* Number of conversions that will assign */
7282 size_t maxPos; /* Max position index if XPG3 is used */
7283 const char *error; /* Ptr to error text (NULL if no error */
7284 char *scratch; /* Some scratch pad used by Jim_ScanString */
7285 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7286 } ScanFmtStringObj;
7287
7288
7289 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7290 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7291 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7292
7293 static Jim_ObjType scanFmtStringObjType = {
7294 "scanformatstring",
7295 FreeScanFmtInternalRep,
7296 DupScanFmtInternalRep,
7297 UpdateStringOfScanFmt,
7298 JIM_TYPE_NONE,
7299 };
7300
7301 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7302 {
7303 JIM_NOTUSED(interp);
7304 Jim_Free((char*)objPtr->internalRep.ptr);
7305 objPtr->internalRep.ptr = 0;
7306 }
7307
7308 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7309 {
7310 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7311 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7312
7313 JIM_NOTUSED(interp);
7314 memcpy(newVec, srcPtr->internalRep.ptr, size);
7315 dupPtr->internalRep.ptr = newVec;
7316 dupPtr->typePtr = &scanFmtStringObjType;
7317 }
7318
7319 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7320 {
7321 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7322
7323 objPtr->bytes = Jim_StrDup(bytes);
7324 objPtr->length = strlen(bytes);
7325 }
7326
7327 /* SetScanFmtFromAny will parse a given string and create the internal
7328 * representation of the format specification. In case of an error
7329 * the error data member of the internal representation will be set
7330 * to an descriptive error text and the function will be left with
7331 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7332 * specification */
7333
7334 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7335 {
7336 ScanFmtStringObj *fmtObj;
7337 char *buffer;
7338 int maxCount, i, approxSize, lastPos = -1;
7339 const char *fmt = objPtr->bytes;
7340 int maxFmtLen = objPtr->length;
7341 const char *fmtEnd = fmt + maxFmtLen;
7342 int curr;
7343
7344 Jim_FreeIntRep(interp, objPtr);
7345 /* Count how many conversions could take place maximally */
7346 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7347 if (fmt[i] == '%')
7348 ++maxCount;
7349 /* Calculate an approximation of the memory necessary */
7350 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7351 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7352 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7353 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7354 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7355 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7356 + 1; /* safety byte */
7357 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7358 memset(fmtObj, 0, approxSize);
7359 fmtObj->size = approxSize;
7360 fmtObj->maxPos = 0;
7361 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7362 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7363 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7364 buffer = fmtObj->stringRep + maxFmtLen + 1;
7365 objPtr->internalRep.ptr = fmtObj;
7366 objPtr->typePtr = &scanFmtStringObjType;
7367 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7368 int width=0, skip;
7369 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7370 fmtObj->count++;
7371 descr->width = 0; /* Assume width unspecified */
7372 /* Overread and store any "literal" prefix */
7373 if (*fmt != '%' || fmt[1] == '%') {
7374 descr->type = 0;
7375 descr->prefix = &buffer[i];
7376 for (; fmt < fmtEnd; ++fmt) {
7377 if (*fmt == '%') {
7378 if (fmt[1] != '%') break;
7379 ++fmt;
7380 }
7381 buffer[i++] = *fmt;
7382 }
7383 buffer[i++] = 0;
7384 }
7385 /* Skip the conversion introducing '%' sign */
7386 ++fmt;
7387 /* End reached due to non-conversion literal only? */
7388 if (fmt >= fmtEnd)
7389 goto done;
7390 descr->pos = 0; /* Assume "natural" positioning */
7391 if (*fmt == '*') {
7392 descr->pos = -1; /* Okay, conversion will not be assigned */
7393 ++fmt;
7394 } else
7395 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7396 /* Check if next token is a number (could be width or pos */
7397 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7398 fmt += skip;
7399 /* Was the number a XPG3 position specifier? */
7400 if (descr->pos != -1 && *fmt == '$') {
7401 int prev;
7402 ++fmt;
7403 descr->pos = width;
7404 width = 0;
7405 /* Look if "natural" postioning and XPG3 one was mixed */
7406 if ((lastPos == 0 && descr->pos > 0)
7407 || (lastPos > 0 && descr->pos == 0)) {
7408 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7409 return JIM_ERR;
7410 }
7411 /* Look if this position was already used */
7412 for (prev=0; prev < curr; ++prev) {
7413 if (fmtObj->descr[prev].pos == -1) continue;
7414 if (fmtObj->descr[prev].pos == descr->pos) {
7415 fmtObj->error = "same \"%n$\" conversion specifier "
7416 "used more than once";
7417 return JIM_ERR;
7418 }
7419 }
7420 /* Try to find a width after the XPG3 specifier */
7421 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7422 descr->width = width;
7423 fmt += skip;
7424 }
7425 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7426 fmtObj->maxPos = descr->pos;
7427 } else {
7428 /* Number was not a XPG3, so it has to be a width */
7429 descr->width = width;
7430 }
7431 }
7432 /* If positioning mode was undetermined yet, fix this */
7433 if (lastPos == -1)
7434 lastPos = descr->pos;
7435 /* Handle CHARSET conversion type ... */
7436 if (*fmt == '[') {
7437 int swapped = 1, beg = i, end, j;
7438 descr->type = '[';
7439 descr->arg = &buffer[i];
7440 ++fmt;
7441 if (*fmt == '^') buffer[i++] = *fmt++;
7442 if (*fmt == ']') buffer[i++] = *fmt++;
7443 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7444 if (*fmt != ']') {
7445 fmtObj->error = "unmatched [ in format string";
7446 return JIM_ERR;
7447 }
7448 end = i;
7449 buffer[i++] = 0;
7450 /* In case a range fence was given "backwards", swap it */
7451 while (swapped) {
7452 swapped = 0;
7453 for (j=beg+1; j < end-1; ++j) {
7454 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7455 char tmp = buffer[j-1];
7456 buffer[j-1] = buffer[j+1];
7457 buffer[j+1] = tmp;
7458 swapped = 1;
7459 }
7460 }
7461 }
7462 } else {
7463 /* Remember any valid modifier if given */
7464 if (strchr("hlL", *fmt) != 0)
7465 descr->modifier = tolower((int)*fmt++);
7466
7467 descr->type = *fmt;
7468 if (strchr("efgcsndoxui", *fmt) == 0) {
7469 fmtObj->error = "bad scan conversion character";
7470 return JIM_ERR;
7471 } else if (*fmt == 'c' && descr->width != 0) {
7472 fmtObj->error = "field width may not be specified in %c "
7473 "conversion";
7474 return JIM_ERR;
7475 } else if (*fmt == 'u' && descr->modifier == 'l') {
7476 fmtObj->error = "unsigned wide not supported";
7477 return JIM_ERR;
7478 }
7479 }
7480 curr++;
7481 }
7482 done:
7483 if (fmtObj->convCount == 0) {
7484 fmtObj->error = "no any conversion specifier given";
7485 return JIM_ERR;
7486 }
7487 return JIM_OK;
7488 }
7489
7490 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7491
7492 #define FormatGetCnvCount(_fo_) \
7493 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7494 #define FormatGetMaxPos(_fo_) \
7495 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7496 #define FormatGetError(_fo_) \
7497 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7498
7499 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7500 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7501 * bitvector implementation in Jim? */
7502
7503 static int JimTestBit(const char *bitvec, char ch)
7504 {
7505 div_t pos = div(ch-1, 8);
7506 return bitvec[pos.quot] & (1 << pos.rem);
7507 }
7508
7509 static void JimSetBit(char *bitvec, char ch)
7510 {
7511 div_t pos = div(ch-1, 8);
7512 bitvec[pos.quot] |= (1 << pos.rem);
7513 }
7514
7515 #if 0 /* currently not used */
7516 static void JimClearBit(char *bitvec, char ch)
7517 {
7518 div_t pos = div(ch-1, 8);
7519 bitvec[pos.quot] &= ~(1 << pos.rem);
7520 }
7521 #endif
7522
7523 /* JimScanAString is used to scan an unspecified string that ends with
7524 * next WS, or a string that is specified via a charset. The charset
7525 * is currently implemented in a way to only allow for usage with
7526 * ASCII. Whenever we will switch to UNICODE, another idea has to
7527 * be born :-/
7528 *
7529 * FIXME: Works only with ASCII */
7530
7531 static Jim_Obj *
7532 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7533 {
7534 size_t i;
7535 Jim_Obj *result;
7536 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7537 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7538
7539 /* First init charset to nothing or all, depending if a specified
7540 * or an unspecified string has to be parsed */
7541 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7542 if (sdescr) {
7543 /* There was a set description given, that means we are parsing
7544 * a specified string. So we have to build a corresponding
7545 * charset reflecting the description */
7546 int notFlag = 0;
7547 /* Should the set be negated at the end? */
7548 if (*sdescr == '^') {
7549 notFlag = 1;
7550 ++sdescr;
7551 }
7552 /* Here '-' is meant literally and not to define a range */
7553 if (*sdescr == '-') {
7554 JimSetBit(charset, '-');
7555 ++sdescr;
7556 }
7557 while (*sdescr) {
7558 if (sdescr[1] == '-' && sdescr[2] != 0) {
7559 /* Handle range definitions */
7560 int i;
7561 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7562 JimSetBit(charset, (char)i);
7563 sdescr += 3;
7564 } else {
7565 /* Handle verbatim character definitions */
7566 JimSetBit(charset, *sdescr++);
7567 }
7568 }
7569 /* Negate the charset if there was a NOT given */
7570 for (i=0; notFlag && i < sizeof(charset); ++i)
7571 charset[i] = ~charset[i];
7572 }
7573 /* And after all the mess above, the real work begin ... */
7574 while (str && *str) {
7575 if (!sdescr && isspace((int)*str))
7576 break; /* EOS via WS if unspecified */
7577 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7578 else break; /* EOS via mismatch if specified scanning */
7579 }
7580 *buffer = 0; /* Close the string properly ... */
7581 result = Jim_NewStringObj(interp, anchor, -1);
7582 Jim_Free(anchor); /* ... and free it afer usage */
7583 return result;
7584 }
7585
7586 /* ScanOneEntry will scan one entry out of the string passed as argument.
7587 * It use the sscanf() function for this task. After extracting and
7588 * converting of the value, the count of scanned characters will be
7589 * returned of -1 in case of no conversion tool place and string was
7590 * already scanned thru */
7591
7592 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7593 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7594 {
7595 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7596 ? sizeof(jim_wide) \
7597 : sizeof(double))
7598 char buffer[MAX_SIZE];
7599 char *value = buffer;
7600 const char *tok;
7601 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7602 size_t sLen = strlen(&str[pos]), scanned = 0;
7603 size_t anchor = pos;
7604 int i;
7605
7606 /* First pessimiticly assume, we will not scan anything :-) */
7607 *valObjPtr = 0;
7608 if (descr->prefix) {
7609 /* There was a prefix given before the conversion, skip it and adjust
7610 * the string-to-be-parsed accordingly */
7611 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7612 /* If prefix require, skip WS */
7613 if (isspace((int)descr->prefix[i]))
7614 while (str[pos] && isspace((int)str[pos])) ++pos;
7615 else if (descr->prefix[i] != str[pos])
7616 break; /* Prefix do not match here, leave the loop */
7617 else
7618 ++pos; /* Prefix matched so far, next round */
7619 }
7620 if (str[pos] == 0)
7621 return -1; /* All of str consumed: EOF condition */
7622 else if (descr->prefix[i] != 0)
7623 return 0; /* Not whole prefix consumed, no conversion possible */
7624 }
7625 /* For all but following conversion, skip leading WS */
7626 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7627 while (isspace((int)str[pos])) ++pos;
7628 /* Determine how much skipped/scanned so far */
7629 scanned = pos - anchor;
7630 if (descr->type == 'n') {
7631 /* Return pseudo conversion means: how much scanned so far? */
7632 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7633 } else if (str[pos] == 0) {
7634 /* Cannot scan anything, as str is totally consumed */
7635 return -1;
7636 } else {
7637 /* Processing of conversions follows ... */
7638 if (descr->width > 0) {
7639 /* Do not try to scan as fas as possible but only the given width.
7640 * To ensure this, we copy the part that should be scanned. */
7641 size_t tLen = descr->width > sLen ? sLen : descr->width;
7642 tok = Jim_StrDupLen(&str[pos], tLen);
7643 } else {
7644 /* As no width was given, simply refer to the original string */
7645 tok = &str[pos];
7646 }
7647 switch (descr->type) {
7648 case 'c':
7649 *valObjPtr = Jim_NewIntObj(interp, *tok);
7650 scanned += 1;
7651 break;
7652 case 'd': case 'o': case 'x': case 'u': case 'i': {
7653 char *endp; /* Position where the number finished */
7654 int base = descr->type == 'o' ? 8
7655 : descr->type == 'x' ? 16
7656 : descr->type == 'i' ? 0
7657 : 10;
7658
7659 do {
7660 /* Try to scan a number with the given base */
7661 if (descr->modifier == 'l')
7662 #ifdef HAVE_LONG_LONG
7663 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7664 #else
7665 *(jim_wide*)value = strtol(tok, &endp, base);
7666 #endif
7667 else
7668 if (descr->type == 'u')
7669 *(long*)value = strtoul(tok, &endp, base);
7670 else
7671 *(long*)value = strtol(tok, &endp, base);
7672 /* If scanning failed, and base was undetermined, simply
7673 * put it to 10 and try once more. This should catch the
7674 * case where %i begin to parse a number prefix (e.g.
7675 * '0x' but no further digits follows. This will be
7676 * handled as a ZERO followed by a char 'x' by Tcl */
7677 if (endp == tok && base == 0) base = 10;
7678 else break;
7679 } while (1);
7680 if (endp != tok) {
7681 /* There was some number sucessfully scanned! */
7682 if (descr->modifier == 'l')
7683 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7684 else
7685 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7686 /* Adjust the number-of-chars scanned so far */
7687 scanned += endp - tok;
7688 } else {
7689 /* Nothing was scanned. We have to determine if this
7690 * happened due to e.g. prefix mismatch or input str
7691 * exhausted */
7692 scanned = *tok ? 0 : -1;
7693 }
7694 break;
7695 }
7696 case 's': case '[': {
7697 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7698 scanned += Jim_Length(*valObjPtr);
7699 break;
7700 }
7701 case 'e': case 'f': case 'g': {
7702 char *endp;
7703
7704 *(double*)value = strtod(tok, &endp);
7705 if (endp != tok) {
7706 /* There was some number sucessfully scanned! */
7707 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7708 /* Adjust the number-of-chars scanned so far */
7709 scanned += endp - tok;
7710 } else {
7711 /* Nothing was scanned. We have to determine if this
7712 * happened due to e.g. prefix mismatch or input str
7713 * exhausted */
7714 scanned = *tok ? 0 : -1;
7715 }
7716 break;
7717 }
7718 }
7719 /* If a substring was allocated (due to pre-defined width) do not
7720 * forget to free it */
7721 if (tok != &str[pos])
7722 Jim_Free((char*)tok);
7723 }
7724 return scanned;
7725 }
7726
7727 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7728 * string and returns all converted (and not ignored) values in a list back
7729 * to the caller. If an error occured, a NULL pointer will be returned */
7730
7731 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7732 Jim_Obj *fmtObjPtr, int flags)
7733 {
7734 size_t i, pos;
7735 int scanned = 1;
7736 const char *str = Jim_GetString(strObjPtr, 0);
7737 Jim_Obj *resultList = 0;
7738 Jim_Obj **resultVec;
7739 int resultc;
7740 Jim_Obj *emptyStr = 0;
7741 ScanFmtStringObj *fmtObj;
7742
7743 /* If format specification is not an object, convert it! */
7744 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7745 SetScanFmtFromAny(interp, fmtObjPtr);
7746 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7747 /* Check if format specification was valid */
7748 if (fmtObj->error != 0) {
7749 if (flags & JIM_ERRMSG)
7750 Jim_SetResultString(interp, fmtObj->error, -1);
7751 return 0;
7752 }
7753 /* Allocate a new "shared" empty string for all unassigned conversions */
7754 emptyStr = Jim_NewEmptyStringObj(interp);
7755 Jim_IncrRefCount(emptyStr);
7756 /* Create a list and fill it with empty strings up to max specified XPG3 */
7757 resultList = Jim_NewListObj(interp, 0, 0);
7758 if (fmtObj->maxPos > 0) {
7759 for (i=0; i < fmtObj->maxPos; ++i)
7760 Jim_ListAppendElement(interp, resultList, emptyStr);
7761 JimListGetElements(interp, resultList, &resultc, &resultVec);
7762 }
7763 /* Now handle every partial format description */
7764 for (i=0, pos=0; i < fmtObj->count; ++i) {
7765 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7766 Jim_Obj *value = 0;
7767 /* Only last type may be "literal" w/o conversion - skip it! */
7768 if (descr->type == 0) continue;
7769 /* As long as any conversion could be done, we will proceed */
7770 if (scanned > 0)
7771 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7772 /* In case our first try results in EOF, we will leave */
7773 if (scanned == -1 && i == 0)
7774 goto eof;
7775 /* Advance next pos-to-be-scanned for the amount scanned already */
7776 pos += scanned;
7777 /* value == 0 means no conversion took place so take empty string */
7778 if (value == 0)
7779 value = Jim_NewEmptyStringObj(interp);
7780 /* If value is a non-assignable one, skip it */
7781 if (descr->pos == -1) {
7782 Jim_FreeNewObj(interp, value);
7783 } else if (descr->pos == 0)
7784 /* Otherwise append it to the result list if no XPG3 was given */
7785 Jim_ListAppendElement(interp, resultList, value);
7786 else if (resultVec[descr->pos-1] == emptyStr) {
7787 /* But due to given XPG3, put the value into the corr. slot */
7788 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7789 Jim_IncrRefCount(value);
7790 resultVec[descr->pos-1] = value;
7791 } else {
7792 /* Otherwise, the slot was already used - free obj and ERROR */
7793 Jim_FreeNewObj(interp, value);
7794 goto err;
7795 }
7796 }
7797 Jim_DecrRefCount(interp, emptyStr);
7798 return resultList;
7799 eof:
7800 Jim_DecrRefCount(interp, emptyStr);
7801 Jim_FreeNewObj(interp, resultList);
7802 return (Jim_Obj*)EOF;
7803 err:
7804 Jim_DecrRefCount(interp, emptyStr);
7805 Jim_FreeNewObj(interp, resultList);
7806 return 0;
7807 }
7808
7809 /* -----------------------------------------------------------------------------
7810 * Pseudo Random Number Generation
7811 * ---------------------------------------------------------------------------*/
7812 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7813 int seedLen);
7814
7815 /* Initialize the sbox with the numbers from 0 to 255 */
7816 static void JimPrngInit(Jim_Interp *interp)
7817 {
7818 int i;
7819 unsigned int seed[256];
7820
7821 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7822 for (i = 0; i < 256; i++)
7823 seed[i] = (rand() ^ time(NULL) ^ clock());
7824 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7825 }
7826
7827 /* Generates N bytes of random data */
7828 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7829 {
7830 Jim_PrngState *prng;
7831 unsigned char *destByte = (unsigned char*) dest;
7832 unsigned int si, sj, x;
7833
7834 /* initialization, only needed the first time */
7835 if (interp->prngState == NULL)
7836 JimPrngInit(interp);
7837 prng = interp->prngState;
7838 /* generates 'len' bytes of pseudo-random numbers */
7839 for (x = 0; x < len; x++) {
7840 prng->i = (prng->i+1) & 0xff;
7841 si = prng->sbox[prng->i];
7842 prng->j = (prng->j + si) & 0xff;
7843 sj = prng->sbox[prng->j];
7844 prng->sbox[prng->i] = sj;
7845 prng->sbox[prng->j] = si;
7846 *destByte++ = prng->sbox[(si+sj)&0xff];
7847 }
7848 }
7849
7850 /* Re-seed the generator with user-provided bytes */
7851 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7852 int seedLen)
7853 {
7854 int i;
7855 unsigned char buf[256];
7856 Jim_PrngState *prng;
7857
7858 /* initialization, only needed the first time */
7859 if (interp->prngState == NULL)
7860 JimPrngInit(interp);
7861 prng = interp->prngState;
7862
7863 /* Set the sbox[i] with i */
7864 for (i = 0; i < 256; i++)
7865 prng->sbox[i] = i;
7866 /* Now use the seed to perform a random permutation of the sbox */
7867 for (i = 0; i < seedLen; i++) {
7868 unsigned char t;
7869
7870 t = prng->sbox[i&0xFF];
7871 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7872 prng->sbox[seed[i]] = t;
7873 }
7874 prng->i = prng->j = 0;
7875 /* discard the first 256 bytes of stream. */
7876 JimRandomBytes(interp, buf, 256);
7877 }
7878
7879 /* -----------------------------------------------------------------------------
7880 * Dynamic libraries support (WIN32 not supported)
7881 * ---------------------------------------------------------------------------*/
7882
7883 #ifdef JIM_DYNLIB
7884 #ifdef WIN32
7885 #define RTLD_LAZY 0
7886 void * dlopen(const char *path, int mode)
7887 {
7888 JIM_NOTUSED(mode);
7889
7890 return (void *)LoadLibraryA(path);
7891 }
7892 int dlclose(void *handle)
7893 {
7894 FreeLibrary((HANDLE)handle);
7895 return 0;
7896 }
7897 void *dlsym(void *handle, const char *symbol)
7898 {
7899 return GetProcAddress((HMODULE)handle, symbol);
7900 }
7901 static char win32_dlerror_string[121];
7902 const char *dlerror(void)
7903 {
7904 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7905 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7906 return win32_dlerror_string;
7907 }
7908 #endif /* WIN32 */
7909
7910 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7911 {
7912 Jim_Obj *libPathObjPtr;
7913 int prefixc, i;
7914 void *handle;
7915 int (*onload)(Jim_Interp *interp);
7916
7917 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7918 if (libPathObjPtr == NULL) {
7919 prefixc = 0;
7920 libPathObjPtr = NULL;
7921 } else {
7922 Jim_IncrRefCount(libPathObjPtr);
7923 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7924 }
7925
7926 for (i = -1; i < prefixc; i++) {
7927 if (i < 0) {
7928 handle = dlopen(pathName, RTLD_LAZY);
7929 } else {
7930 FILE *fp;
7931 char buf[JIM_PATH_LEN];
7932 const char *prefix;
7933 int prefixlen;
7934 Jim_Obj *prefixObjPtr;
7935
7936 buf[0] = '\0';
7937 if (Jim_ListIndex(interp, libPathObjPtr, i,
7938 &prefixObjPtr, JIM_NONE) != JIM_OK)
7939 continue;
7940 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7941 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7942 continue;
7943 if (*pathName == '/') {
7944 strcpy(buf, pathName);
7945 }
7946 else if (prefixlen && prefix[prefixlen-1] == '/')
7947 sprintf(buf, "%s%s", prefix, pathName);
7948 else
7949 sprintf(buf, "%s/%s", prefix, pathName);
7950 fp = fopen(buf, "r");
7951 if (fp == NULL)
7952 continue;
7953 fclose(fp);
7954 handle = dlopen(buf, RTLD_LAZY);
7955 }
7956 if (handle == NULL) {
7957 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7958 Jim_AppendStrings(interp, Jim_GetResult(interp),
7959 "error loading extension \"", pathName,
7960 "\": ", dlerror(), NULL);
7961 if (i < 0)
7962 continue;
7963 goto err;
7964 }
7965 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7966 Jim_SetResultString(interp,
7967 "No Jim_OnLoad symbol found on extension", -1);
7968 goto err;
7969 }
7970 if (onload(interp) == JIM_ERR) {
7971 dlclose(handle);
7972 goto err;
7973 }
7974 Jim_SetEmptyResult(interp);
7975 if (libPathObjPtr != NULL)
7976 Jim_DecrRefCount(interp, libPathObjPtr);
7977 return JIM_OK;
7978 }
7979 err:
7980 if (libPathObjPtr != NULL)
7981 Jim_DecrRefCount(interp, libPathObjPtr);
7982 return JIM_ERR;
7983 }
7984 #else /* JIM_DYNLIB */
7985 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7986 {
7987 JIM_NOTUSED(interp);
7988 JIM_NOTUSED(pathName);
7989
7990 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7991 return JIM_ERR;
7992 }
7993 #endif/* JIM_DYNLIB */
7994
7995 /* -----------------------------------------------------------------------------
7996 * Packages handling
7997 * ---------------------------------------------------------------------------*/
7998
7999 #define JIM_PKG_ANY_VERSION -1
8000
8001 /* Convert a string of the type "1.2" into an integer.
8002 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
8003 * to the integer with value 102 */
8004 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8005 int *intPtr, int flags)
8006 {
8007 char *copy;
8008 jim_wide major, minor;
8009 char *majorStr, *minorStr, *p;
8010
8011 if (v[0] == '\0') {
8012 *intPtr = JIM_PKG_ANY_VERSION;
8013 return JIM_OK;
8014 }
8015
8016 copy = Jim_StrDup(v);
8017 p = strchr(copy, '.');
8018 if (p == NULL) goto badfmt;
8019 *p = '\0';
8020 majorStr = copy;
8021 minorStr = p+1;
8022
8023 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8024 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8025 goto badfmt;
8026 *intPtr = (int)(major*100+minor);
8027 Jim_Free(copy);
8028 return JIM_OK;
8029
8030 badfmt:
8031 Jim_Free(copy);
8032 if (flags & JIM_ERRMSG) {
8033 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8034 Jim_AppendStrings(interp, Jim_GetResult(interp),
8035 "invalid package version '", v, "'", NULL);
8036 }
8037 return JIM_ERR;
8038 }
8039
8040 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8041 static int JimPackageMatchVersion(int needed, int actual, int flags)
8042 {
8043 if (needed == JIM_PKG_ANY_VERSION) return 1;
8044 if (flags & JIM_MATCHVER_EXACT) {
8045 return needed == actual;
8046 } else {
8047 return needed/100 == actual/100 && (needed <= actual);
8048 }
8049 }
8050
8051 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8052 int flags)
8053 {
8054 int intVersion;
8055 /* Check if the version format is ok */
8056 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8057 return JIM_ERR;
8058 /* If the package was already provided returns an error. */
8059 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8060 if (flags & JIM_ERRMSG) {
8061 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8062 Jim_AppendStrings(interp, Jim_GetResult(interp),
8063 "package '", name, "' was already provided", NULL);
8064 }
8065 return JIM_ERR;
8066 }
8067 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8068 return JIM_OK;
8069 }
8070
8071 #ifndef JIM_ANSIC
8072
8073 #ifndef WIN32
8074 # include <sys/types.h>
8075 # include <dirent.h>
8076 #else
8077 # include <io.h>
8078 /* Posix dirent.h compatiblity layer for WIN32.
8079 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8080 * Copyright Salvatore Sanfilippo ,2005.
8081 *
8082 * Permission to use, copy, modify, and distribute this software and its
8083 * documentation for any purpose is hereby granted without fee, provided
8084 * that this copyright and permissions notice appear in all copies and
8085 * derivatives.
8086 *
8087 * This software is supplied "as is" without express or implied warranty.
8088 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8089 */
8090
8091 struct dirent {
8092 char *d_name;
8093 };
8094
8095 typedef struct DIR {
8096 long handle; /* -1 for failed rewind */
8097 struct _finddata_t info;
8098 struct dirent result; /* d_name null iff first time */
8099 char *name; /* null-terminated char string */
8100 } DIR;
8101
8102 DIR *opendir(const char *name)
8103 {
8104 DIR *dir = 0;
8105
8106 if(name && name[0]) {
8107 size_t base_length = strlen(name);
8108 const char *all = /* search pattern must end with suitable wildcard */
8109 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8110
8111 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8112 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8113 {
8114 strcat(strcpy(dir->name, name), all);
8115
8116 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8117 dir->result.d_name = 0;
8118 else { /* rollback */
8119 Jim_Free(dir->name);
8120 Jim_Free(dir);
8121 dir = 0;
8122 }
8123 } else { /* rollback */
8124 Jim_Free(dir);
8125 dir = 0;
8126 errno = ENOMEM;
8127 }
8128 } else {
8129 errno = EINVAL;
8130 }
8131 return dir;
8132 }
8133
8134 int closedir(DIR *dir)
8135 {
8136 int result = -1;
8137
8138 if(dir) {
8139 if(dir->handle != -1)
8140 result = _findclose(dir->handle);
8141 Jim_Free(dir->name);
8142 Jim_Free(dir);
8143 }
8144 if(result == -1) /* map all errors to EBADF */
8145 errno = EBADF;
8146 return result;
8147 }
8148
8149 struct dirent *readdir(DIR *dir)
8150 {
8151 struct dirent *result = 0;
8152
8153 if(dir && dir->handle != -1) {
8154 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8155 result = &dir->result;
8156 result->d_name = dir->info.name;
8157 }
8158 } else {
8159 errno = EBADF;
8160 }
8161 return result;
8162 }
8163
8164 #endif /* WIN32 */
8165
8166 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8167 int prefixc, const char *pkgName, int pkgVer, int flags)
8168 {
8169 int bestVer = -1, i;
8170 int pkgNameLen = strlen(pkgName);
8171 char *bestPackage = NULL;
8172 struct dirent *de;
8173
8174 for (i = 0; i < prefixc; i++) {
8175 DIR *dir;
8176 char buf[JIM_PATH_LEN];
8177 int prefixLen;
8178
8179 if (prefixes[i] == NULL) continue;
8180 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8181 buf[JIM_PATH_LEN-1] = '\0';
8182 prefixLen = strlen(buf);
8183 if (prefixLen && buf[prefixLen-1] == '/')
8184 buf[prefixLen-1] = '\0';
8185
8186 if ((dir = opendir(buf)) == NULL) continue;
8187 while ((de = readdir(dir)) != NULL) {
8188 char *fileName = de->d_name;
8189 int fileNameLen = strlen(fileName);
8190
8191 if (strncmp(fileName, "jim-", 4) == 0 &&
8192 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8193 *(fileName+4+pkgNameLen) == '-' &&
8194 fileNameLen > 4 && /* note that this is not really useful */
8195 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8196 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8197 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8198 {
8199 char ver[6]; /* xx.yy<nulterm> */
8200 char *p = strrchr(fileName, '.');
8201 int verLen, fileVer;
8202
8203 verLen = p - (fileName+4+pkgNameLen+1);
8204 if (verLen < 3 || verLen > 5) continue;
8205 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8206 ver[verLen] = '\0';
8207 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8208 != JIM_OK) continue;
8209 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8210 (bestVer == -1 || bestVer < fileVer))
8211 {
8212 bestVer = fileVer;
8213 Jim_Free(bestPackage);
8214 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8215 sprintf(bestPackage, "%s/%s", buf, fileName);
8216 }
8217 }
8218 }
8219 closedir(dir);
8220 }
8221 return bestPackage;
8222 }
8223
8224 #else /* JIM_ANSIC */
8225
8226 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8227 int prefixc, const char *pkgName, int pkgVer, int flags)
8228 {
8229 JIM_NOTUSED(interp);
8230 JIM_NOTUSED(prefixes);
8231 JIM_NOTUSED(prefixc);
8232 JIM_NOTUSED(pkgName);
8233 JIM_NOTUSED(pkgVer);
8234 JIM_NOTUSED(flags);
8235 return NULL;
8236 }
8237
8238 #endif /* JIM_ANSIC */
8239
8240 /* Search for a suitable package under every dir specified by jim_libpath
8241 * and load it if possible. If a suitable package was loaded with success
8242 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8243 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8244 int flags)
8245 {
8246 Jim_Obj *libPathObjPtr;
8247 char **prefixes, *best;
8248 int prefixc, i, retCode = JIM_OK;
8249
8250 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8251 if (libPathObjPtr == NULL) {
8252 prefixc = 0;
8253 libPathObjPtr = NULL;
8254 } else {
8255 Jim_IncrRefCount(libPathObjPtr);
8256 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8257 }
8258
8259 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8260 for (i = 0; i < prefixc; i++) {
8261 Jim_Obj *prefixObjPtr;
8262 if (Jim_ListIndex(interp, libPathObjPtr, i,
8263 &prefixObjPtr, JIM_NONE) != JIM_OK)
8264 {
8265 prefixes[i] = NULL;
8266 continue;
8267 }
8268 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8269 }
8270 /* Scan every directory to find the "best" package. */
8271 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8272 if (best != NULL) {
8273 char *p = strrchr(best, '.');
8274 /* Try to load/source it */
8275 if (p && strcmp(p, ".tcl") == 0) {
8276 retCode = Jim_EvalFile(interp, best);
8277 } else {
8278 retCode = Jim_LoadLibrary(interp, best);
8279 }
8280 } else {
8281 retCode = JIM_ERR;
8282 }
8283 Jim_Free(best);
8284 for (i = 0; i < prefixc; i++)
8285 Jim_Free(prefixes[i]);
8286 Jim_Free(prefixes);
8287 if (libPathObjPtr)
8288 Jim_DecrRefCount(interp, libPathObjPtr);
8289 return retCode;
8290 }
8291
8292 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8293 const char *ver, int flags)
8294 {
8295 Jim_HashEntry *he;
8296 int requiredVer;
8297
8298 /* Start with an empty error string */
8299 Jim_SetResultString(interp, "", 0);
8300
8301 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8302 return NULL;
8303 he = Jim_FindHashEntry(&interp->packages, name);
8304 if (he == NULL) {
8305 /* Try to load the package. */
8306 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8307 he = Jim_FindHashEntry(&interp->packages, name);
8308 if (he == NULL) {
8309 return "?";
8310 }
8311 return he->val;
8312 }
8313 /* No way... return an error. */
8314 if (flags & JIM_ERRMSG) {
8315 int len;
8316 Jim_GetString(Jim_GetResult(interp), &len);
8317 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8318 "Can't find package '", name, "'", NULL);
8319 }
8320 return NULL;
8321 } else {
8322 int actualVer;
8323 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8324 != JIM_OK)
8325 {
8326 return NULL;
8327 }
8328 /* Check if version matches. */
8329 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8330 Jim_AppendStrings(interp, Jim_GetResult(interp),
8331 "Package '", name, "' already loaded, but with version ",
8332 he->val, NULL);
8333 return NULL;
8334 }
8335 return he->val;
8336 }
8337 }
8338
8339 /* -----------------------------------------------------------------------------
8340 * Eval
8341 * ---------------------------------------------------------------------------*/
8342 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8343 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8344
8345 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8346 Jim_Obj *const *argv);
8347
8348 /* Handle calls to the [unknown] command */
8349 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8350 {
8351 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8352 int retCode;
8353
8354 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8355 * done here
8356 */
8357 if (interp->unknown_called) {
8358 return JIM_ERR;
8359 }
8360
8361 /* If the [unknown] command does not exists returns
8362 * just now */
8363 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8364 return JIM_ERR;
8365
8366 /* The object interp->unknown just contains
8367 * the "unknown" string, it is used in order to
8368 * avoid to lookup the unknown command every time
8369 * but instread to cache the result. */
8370 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8371 v = sv;
8372 else
8373 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8374 /* Make a copy of the arguments vector, but shifted on
8375 * the right of one position. The command name of the
8376 * command will be instead the first argument of the
8377 * [unknonw] call. */
8378 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8379 v[0] = interp->unknown;
8380 /* Call it */
8381 interp->unknown_called++;
8382 retCode = Jim_EvalObjVector(interp, argc+1, v);
8383 interp->unknown_called--;
8384
8385 /* Clean up */
8386 if (v != sv)
8387 Jim_Free(v);
8388 return retCode;
8389 }
8390
8391 /* Eval the object vector 'objv' composed of 'objc' elements.
8392 * Every element is used as single argument.
8393 * Jim_EvalObj() will call this function every time its object
8394 * argument is of "list" type, with no string representation.
8395 *
8396 * This is possible because the string representation of a
8397 * list object generated by the UpdateStringOfList is made
8398 * in a way that ensures that every list element is a different
8399 * command argument. */
8400 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8401 {
8402 int i, retcode;
8403 Jim_Cmd *cmdPtr;
8404
8405 /* Incr refcount of arguments. */
8406 for (i = 0; i < objc; i++)
8407 Jim_IncrRefCount(objv[i]);
8408 /* Command lookup */
8409 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8410 if (cmdPtr == NULL) {
8411 retcode = JimUnknown(interp, objc, objv);
8412 } else {
8413 /* Call it -- Make sure result is an empty object. */
8414 Jim_SetEmptyResult(interp);
8415 if (cmdPtr->cmdProc) {
8416 interp->cmdPrivData = cmdPtr->privData;
8417 retcode = cmdPtr->cmdProc(interp, objc, objv);
8418 if (retcode == JIM_ERR_ADDSTACK) {
8419 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8420 retcode = JIM_ERR;
8421 }
8422 } else {
8423 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8424 if (retcode == JIM_ERR) {
8425 JimAppendStackTrace(interp,
8426 Jim_GetString(objv[0], NULL), "", 1);
8427 }
8428 }
8429 }
8430 /* Decr refcount of arguments and return the retcode */
8431 for (i = 0; i < objc; i++)
8432 Jim_DecrRefCount(interp, objv[i]);
8433 return retcode;
8434 }
8435
8436 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8437 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8438 * The returned object has refcount = 0. */
8439 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8440 int tokens, Jim_Obj **objPtrPtr)
8441 {
8442 int totlen = 0, i, retcode;
8443 Jim_Obj **intv;
8444 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8445 Jim_Obj *objPtr;
8446 char *s;
8447
8448 if (tokens <= JIM_EVAL_SINTV_LEN)
8449 intv = sintv;
8450 else
8451 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8452 tokens);
8453 /* Compute every token forming the argument
8454 * in the intv objects vector. */
8455 for (i = 0; i < tokens; i++) {
8456 switch(token[i].type) {
8457 case JIM_TT_ESC:
8458 case JIM_TT_STR:
8459 intv[i] = token[i].objPtr;
8460 break;
8461 case JIM_TT_VAR:
8462 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8463 if (!intv[i]) {
8464 retcode = JIM_ERR;
8465 goto err;
8466 }
8467 break;
8468 case JIM_TT_DICTSUGAR:
8469 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8470 if (!intv[i]) {
8471 retcode = JIM_ERR;
8472 goto err;
8473 }
8474 break;
8475 case JIM_TT_CMD:
8476 retcode = Jim_EvalObj(interp, token[i].objPtr);
8477 if (retcode != JIM_OK)
8478 goto err;
8479 intv[i] = Jim_GetResult(interp);
8480 break;
8481 default:
8482 Jim_Panic(interp,
8483 "default token type reached "
8484 "in Jim_InterpolateTokens().");
8485 break;
8486 }
8487 Jim_IncrRefCount(intv[i]);
8488 /* Make sure there is a valid
8489 * string rep, and add the string
8490 * length to the total legnth. */
8491 Jim_GetString(intv[i], NULL);
8492 totlen += intv[i]->length;
8493 }
8494 /* Concatenate every token in an unique
8495 * object. */
8496 objPtr = Jim_NewStringObjNoAlloc(interp,
8497 NULL, 0);
8498 s = objPtr->bytes = Jim_Alloc(totlen+1);
8499 objPtr->length = totlen;
8500 for (i = 0; i < tokens; i++) {
8501 memcpy(s, intv[i]->bytes, intv[i]->length);
8502 s += intv[i]->length;
8503 Jim_DecrRefCount(interp, intv[i]);
8504 }
8505 objPtr->bytes[totlen] = '\0';
8506 /* Free the intv vector if not static. */
8507 if (tokens > JIM_EVAL_SINTV_LEN)
8508 Jim_Free(intv);
8509 *objPtrPtr = objPtr;
8510 return JIM_OK;
8511 err:
8512 i--;
8513 for (; i >= 0; i--)
8514 Jim_DecrRefCount(interp, intv[i]);
8515 if (tokens > JIM_EVAL_SINTV_LEN)
8516 Jim_Free(intv);
8517 return retcode;
8518 }
8519
8520 /* Helper of Jim_EvalObj() to perform argument expansion.
8521 * Basically this function append an argument to 'argv'
8522 * (and increments argc by reference accordingly), performing
8523 * expansion of the list object if 'expand' is non-zero, or
8524 * just adding objPtr to argv if 'expand' is zero. */
8525 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8526 int *argcPtr, int expand, Jim_Obj *objPtr)
8527 {
8528 if (!expand) {
8529 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8530 /* refcount of objPtr not incremented because
8531 * we are actually transfering a reference from
8532 * the old 'argv' to the expanded one. */
8533 (*argv)[*argcPtr] = objPtr;
8534 (*argcPtr)++;
8535 } else {
8536 int len, i;
8537
8538 Jim_ListLength(interp, objPtr, &len);
8539 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8540 for (i = 0; i < len; i++) {
8541 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8542 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8543 (*argcPtr)++;
8544 }
8545 /* The original object reference is no longer needed,
8546 * after the expansion it is no longer present on
8547 * the argument vector, but the single elements are
8548 * in its place. */
8549 Jim_DecrRefCount(interp, objPtr);
8550 }
8551 }
8552
8553 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8554 {
8555 int i, j = 0, len;
8556 ScriptObj *script;
8557 ScriptToken *token;
8558 int *cs; /* command structure array */
8559 int retcode = JIM_OK;
8560 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8561
8562 interp->errorFlag = 0;
8563
8564 /* If the object is of type "list" and there is no
8565 * string representation for this object, we can call
8566 * a specialized version of Jim_EvalObj() */
8567 if (scriptObjPtr->typePtr == &listObjType &&
8568 scriptObjPtr->internalRep.listValue.len &&
8569 scriptObjPtr->bytes == NULL) {
8570 Jim_IncrRefCount(scriptObjPtr);
8571 retcode = Jim_EvalObjVector(interp,
8572 scriptObjPtr->internalRep.listValue.len,
8573 scriptObjPtr->internalRep.listValue.ele);
8574 Jim_DecrRefCount(interp, scriptObjPtr);
8575 return retcode;
8576 }
8577
8578 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8579 script = Jim_GetScript(interp, scriptObjPtr);
8580 /* Now we have to make sure the internal repr will not be
8581 * freed on shimmering.
8582 *
8583 * Think for example to this:
8584 *
8585 * set x {llength $x; ... some more code ...}; eval $x
8586 *
8587 * In order to preserve the internal rep, we increment the
8588 * inUse field of the script internal rep structure. */
8589 script->inUse++;
8590
8591 token = script->token;
8592 len = script->len;
8593 cs = script->cmdStruct;
8594 i = 0; /* 'i' is the current token index. */
8595
8596 /* Reset the interpreter result. This is useful to
8597 * return the emtpy result in the case of empty program. */
8598 Jim_SetEmptyResult(interp);
8599
8600 /* Execute every command sequentially, returns on
8601 * error (i.e. if a command does not return JIM_OK) */
8602 while (i < len) {
8603 int expand = 0;
8604 int argc = *cs++; /* Get the number of arguments */
8605 Jim_Cmd *cmd;
8606
8607 /* Set the expand flag if needed. */
8608 if (argc == -1) {
8609 expand++;
8610 argc = *cs++;
8611 }
8612 /* Allocate the arguments vector */
8613 if (argc <= JIM_EVAL_SARGV_LEN)
8614 argv = sargv;
8615 else
8616 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8617 /* Populate the arguments objects. */
8618 for (j = 0; j < argc; j++) {
8619 int tokens = *cs++;
8620
8621 /* tokens is negative if expansion is needed.
8622 * for this argument. */
8623 if (tokens < 0) {
8624 tokens = (-tokens)-1;
8625 i++;
8626 }
8627 if (tokens == 1) {
8628 /* Fast path if the token does not
8629 * need interpolation */
8630 switch(token[i].type) {
8631 case JIM_TT_ESC:
8632 case JIM_TT_STR:
8633 argv[j] = token[i].objPtr;
8634 break;
8635 case JIM_TT_VAR:
8636 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8637 JIM_ERRMSG);
8638 if (!tmpObjPtr) {
8639 retcode = JIM_ERR;
8640 goto err;
8641 }
8642 argv[j] = tmpObjPtr;
8643 break;
8644 case JIM_TT_DICTSUGAR:
8645 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8646 if (!tmpObjPtr) {
8647 retcode = JIM_ERR;
8648 goto err;
8649 }
8650 argv[j] = tmpObjPtr;
8651 break;
8652 case JIM_TT_CMD:
8653 retcode = Jim_EvalObj(interp, token[i].objPtr);
8654 if (retcode != JIM_OK)
8655 goto err;
8656 argv[j] = Jim_GetResult(interp);
8657 break;
8658 default:
8659 Jim_Panic(interp,
8660 "default token type reached "
8661 "in Jim_EvalObj().");
8662 break;
8663 }
8664 Jim_IncrRefCount(argv[j]);
8665 i += 2;
8666 } else {
8667 /* For interpolation we call an helper
8668 * function doing the work for us. */
8669 if ((retcode = Jim_InterpolateTokens(interp,
8670 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8671 {
8672 goto err;
8673 }
8674 argv[j] = tmpObjPtr;
8675 Jim_IncrRefCount(argv[j]);
8676 i += tokens+1;
8677 }
8678 }
8679 /* Handle {expand} expansion */
8680 if (expand) {
8681 int *ecs = cs - argc;
8682 int eargc = 0;
8683 Jim_Obj **eargv = NULL;
8684
8685 for (j = 0; j < argc; j++) {
8686 Jim_ExpandArgument( interp, &eargv, &eargc,
8687 ecs[j] < 0, argv[j]);
8688 }
8689 if (argv != sargv)
8690 Jim_Free(argv);
8691 argc = eargc;
8692 argv = eargv;
8693 j = argc;
8694 if (argc == 0) {
8695 /* Nothing to do with zero args. */
8696 Jim_Free(eargv);
8697 continue;
8698 }
8699 }
8700 /* Lookup the command to call */
8701 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8702 if (cmd != NULL) {
8703 /* Call it -- Make sure result is an empty object. */
8704 Jim_SetEmptyResult(interp);
8705 if (cmd->cmdProc) {
8706 interp->cmdPrivData = cmd->privData;
8707 retcode = cmd->cmdProc(interp, argc, argv);
8708 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8709 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8710 retcode = JIM_ERR;
8711 }
8712 } else {
8713 retcode = JimCallProcedure(interp, cmd, argc, argv);
8714 if (retcode == JIM_ERR) {
8715 JimAppendStackTrace(interp,
8716 Jim_GetString(argv[0], NULL), script->fileName,
8717 token[i-argc*2].linenr);
8718 }
8719 }
8720 } else {
8721 /* Call [unknown] */
8722 retcode = JimUnknown(interp, argc, argv);
8723 if (retcode == JIM_ERR) {
8724 JimAppendStackTrace(interp,
8725 "", script->fileName,
8726 token[i-argc*2].linenr);
8727 }
8728 }
8729 if (retcode != JIM_OK) {
8730 i -= argc*2; /* point to the command name. */
8731 goto err;
8732 }
8733 /* Decrement the arguments count */
8734 for (j = 0; j < argc; j++) {
8735 Jim_DecrRefCount(interp, argv[j]);
8736 }
8737
8738 if (argv != sargv) {
8739 Jim_Free(argv);
8740 argv = NULL;
8741 }
8742 }
8743 /* Note that we don't have to decrement inUse, because the
8744 * following code transfers our use of the reference again to
8745 * the script object. */
8746 j = 0; /* on normal termination, the argv array is already
8747 Jim_DecrRefCount-ed. */
8748 err:
8749 /* Handle errors. */
8750 if (retcode == JIM_ERR && !interp->errorFlag) {
8751 interp->errorFlag = 1;
8752 JimSetErrorFileName(interp, script->fileName);
8753 JimSetErrorLineNumber(interp, token[i].linenr);
8754 JimResetStackTrace(interp);
8755 }
8756 Jim_FreeIntRep(interp, scriptObjPtr);
8757 scriptObjPtr->typePtr = &scriptObjType;
8758 Jim_SetIntRepPtr(scriptObjPtr, script);
8759 Jim_DecrRefCount(interp, scriptObjPtr);
8760 for (i = 0; i < j; i++) {
8761 Jim_DecrRefCount(interp, argv[i]);
8762 }
8763 if (argv != sargv)
8764 Jim_Free(argv);
8765 return retcode;
8766 }
8767
8768 /* Call a procedure implemented in Tcl.
8769 * It's possible to speed-up a lot this function, currently
8770 * the callframes are not cached, but allocated and
8771 * destroied every time. What is expecially costly is
8772 * to create/destroy the local vars hash table every time.
8773 *
8774 * This can be fixed just implementing callframes caching
8775 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8776 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8777 Jim_Obj *const *argv)
8778 {
8779 int i, retcode;
8780 Jim_CallFrame *callFramePtr;
8781 int num_args;
8782
8783 /* Check arity */
8784 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8785 argc > cmd->arityMax)) {
8786 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8787 Jim_AppendStrings(interp, objPtr,
8788 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8789 (cmd->arityMin > 1) ? " " : "",
8790 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8791 Jim_SetResult(interp, objPtr);
8792 return JIM_ERR;
8793 }
8794 /* Check if there are too nested calls */
8795 if (interp->numLevels == interp->maxNestingDepth) {
8796 Jim_SetResultString(interp,
8797 "Too many nested calls. Infinite recursion?", -1);
8798 return JIM_ERR;
8799 }
8800 /* Create a new callframe */
8801 callFramePtr = JimCreateCallFrame(interp);
8802 callFramePtr->parentCallFrame = interp->framePtr;
8803 callFramePtr->argv = argv;
8804 callFramePtr->argc = argc;
8805 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8806 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8807 callFramePtr->staticVars = cmd->staticVars;
8808 Jim_IncrRefCount(cmd->argListObjPtr);
8809 Jim_IncrRefCount(cmd->bodyObjPtr);
8810 interp->framePtr = callFramePtr;
8811 interp->numLevels ++;
8812
8813 /* Set arguments */
8814 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8815
8816 /* If last argument is 'args', don't set it here */
8817 if (cmd->arityMax == -1) {
8818 num_args--;
8819 }
8820
8821 for (i = 0; i < num_args; i++) {
8822 Jim_Obj *argObjPtr;
8823 Jim_Obj *nameObjPtr;
8824 Jim_Obj *valueObjPtr;
8825
8826 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8827 if (i + 1 >= cmd->arityMin) {
8828 /* The name is the first element of the list */
8829 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8830 }
8831 else {
8832 /* The element arg is the name */
8833 nameObjPtr = argObjPtr;
8834 }
8835
8836 if (i + 1 >= argc) {
8837 /* No more values, so use default */
8838 /* The value is the second element of the list */
8839 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8840 }
8841 else {
8842 valueObjPtr = argv[i+1];
8843 }
8844 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8845 }
8846 /* Set optional arguments */
8847 if (cmd->arityMax == -1) {
8848 Jim_Obj *listObjPtr, *objPtr;
8849
8850 i++;
8851 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8852 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8853 Jim_SetVariable(interp, objPtr, listObjPtr);
8854 }
8855 /* Eval the body */
8856 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8857
8858 /* Destroy the callframe */
8859 interp->numLevels --;
8860 interp->framePtr = interp->framePtr->parentCallFrame;
8861 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8862 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8863 } else {
8864 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8865 }
8866 /* Handle the JIM_EVAL return code */
8867 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8868 int savedLevel = interp->evalRetcodeLevel;
8869
8870 interp->evalRetcodeLevel = interp->numLevels;
8871 while (retcode == JIM_EVAL) {
8872 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8873 Jim_IncrRefCount(resultScriptObjPtr);
8874 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8875 Jim_DecrRefCount(interp, resultScriptObjPtr);
8876 }
8877 interp->evalRetcodeLevel = savedLevel;
8878 }
8879 /* Handle the JIM_RETURN return code */
8880 if (retcode == JIM_RETURN) {
8881 retcode = interp->returnCode;
8882 interp->returnCode = JIM_OK;
8883 }
8884 return retcode;
8885 }
8886
8887 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8888 {
8889 int retval;
8890 Jim_Obj *scriptObjPtr;
8891
8892 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8893 Jim_IncrRefCount(scriptObjPtr);
8894
8895
8896 if( filename ){
8897 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8898 }
8899
8900 retval = Jim_EvalObj(interp, scriptObjPtr);
8901 Jim_DecrRefCount(interp, scriptObjPtr);
8902 return retval;
8903 }
8904
8905 int Jim_Eval(Jim_Interp *interp, const char *script)
8906 {
8907 return Jim_Eval_Named( interp, script, NULL, 0 );
8908 }
8909
8910
8911
8912 /* Execute script in the scope of the global level */
8913 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8914 {
8915 Jim_CallFrame *savedFramePtr;
8916 int retval;
8917
8918 savedFramePtr = interp->framePtr;
8919 interp->framePtr = interp->topFramePtr;
8920 retval = Jim_Eval(interp, script);
8921 interp->framePtr = savedFramePtr;
8922 return retval;
8923 }
8924
8925 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8926 {
8927 Jim_CallFrame *savedFramePtr;
8928 int retval;
8929
8930 savedFramePtr = interp->framePtr;
8931 interp->framePtr = interp->topFramePtr;
8932 retval = Jim_EvalObj(interp, scriptObjPtr);
8933 interp->framePtr = savedFramePtr;
8934 /* Try to report the error (if any) via the bgerror proc */
8935 if (retval != JIM_OK) {
8936 Jim_Obj *objv[2];
8937
8938 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8939 objv[1] = Jim_GetResult(interp);
8940 Jim_IncrRefCount(objv[0]);
8941 Jim_IncrRefCount(objv[1]);
8942 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8943 /* Report the error to stderr. */
8944 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8945 Jim_PrintErrorMessage(interp);
8946 }
8947 Jim_DecrRefCount(interp, objv[0]);
8948 Jim_DecrRefCount(interp, objv[1]);
8949 }
8950 return retval;
8951 }
8952
8953 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8954 {
8955 char *prg = NULL;
8956 FILE *fp;
8957 int nread, totread, maxlen, buflen;
8958 int retval;
8959 Jim_Obj *scriptObjPtr;
8960
8961 if ((fp = fopen(filename, "r")) == NULL) {
8962 const int cwd_len=2048;
8963 char *cwd=malloc(cwd_len);
8964 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8965 if (!getcwd( cwd, cwd_len )) strcpy(cwd, "unknown");
8966 Jim_AppendStrings(interp, Jim_GetResult(interp),
8967 "Error loading script \"", filename, "\"",
8968 " cwd: ", cwd,
8969 " err: ", strerror(errno), NULL);
8970 free(cwd);
8971 return JIM_ERR;
8972 }
8973 buflen = 1024;
8974 maxlen = totread = 0;
8975 while (1) {
8976 if (maxlen < totread+buflen+1) {
8977 maxlen = totread+buflen+1;
8978 prg = Jim_Realloc(prg, maxlen);
8979 }
8980 /* do not use Jim_fread() - this is really a file */
8981 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8982 totread += nread;
8983 }
8984 prg[totread] = '\0';
8985 /* do not use Jim_fclose() - this is really a file */
8986 fclose(fp);
8987
8988 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8989 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8990 Jim_IncrRefCount(scriptObjPtr);
8991 retval = Jim_EvalObj(interp, scriptObjPtr);
8992 Jim_DecrRefCount(interp, scriptObjPtr);
8993 return retval;
8994 }
8995
8996 /* -----------------------------------------------------------------------------
8997 * Subst
8998 * ---------------------------------------------------------------------------*/
8999 static int JimParseSubstStr(struct JimParserCtx *pc)
9000 {
9001 pc->tstart = pc->p;
9002 pc->tline = pc->linenr;
9003 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9004 pc->p++; pc->len--;
9005 }
9006 pc->tend = pc->p-1;
9007 pc->tt = JIM_TT_ESC;
9008 return JIM_OK;
9009 }
9010
9011 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9012 {
9013 int retval;
9014
9015 if (pc->len == 0) {
9016 pc->tstart = pc->tend = pc->p;
9017 pc->tline = pc->linenr;
9018 pc->tt = JIM_TT_EOL;
9019 pc->eof = 1;
9020 return JIM_OK;
9021 }
9022 switch(*pc->p) {
9023 case '[':
9024 retval = JimParseCmd(pc);
9025 if (flags & JIM_SUBST_NOCMD) {
9026 pc->tstart--;
9027 pc->tend++;
9028 pc->tt = (flags & JIM_SUBST_NOESC) ?
9029 JIM_TT_STR : JIM_TT_ESC;
9030 }
9031 return retval;
9032 break;
9033 case '$':
9034 if (JimParseVar(pc) == JIM_ERR) {
9035 pc->tstart = pc->tend = pc->p++; pc->len--;
9036 pc->tline = pc->linenr;
9037 pc->tt = JIM_TT_STR;
9038 } else {
9039 if (flags & JIM_SUBST_NOVAR) {
9040 pc->tstart--;
9041 if (flags & JIM_SUBST_NOESC)
9042 pc->tt = JIM_TT_STR;
9043 else
9044 pc->tt = JIM_TT_ESC;
9045 if (*pc->tstart == '{') {
9046 pc->tstart--;
9047 if (*(pc->tend+1))
9048 pc->tend++;
9049 }
9050 }
9051 }
9052 break;
9053 default:
9054 retval = JimParseSubstStr(pc);
9055 if (flags & JIM_SUBST_NOESC)
9056 pc->tt = JIM_TT_STR;
9057 return retval;
9058 break;
9059 }
9060 return JIM_OK;
9061 }
9062
9063 /* The subst object type reuses most of the data structures and functions
9064 * of the script object. Script's data structures are a bit more complex
9065 * for what is needed for [subst]itution tasks, but the reuse helps to
9066 * deal with a single data structure at the cost of some more memory
9067 * usage for substitutions. */
9068 static Jim_ObjType substObjType = {
9069 "subst",
9070 FreeScriptInternalRep,
9071 DupScriptInternalRep,
9072 NULL,
9073 JIM_TYPE_REFERENCES,
9074 };
9075
9076 /* This method takes the string representation of an object
9077 * as a Tcl string where to perform [subst]itution, and generates
9078 * the pre-parsed internal representation. */
9079 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9080 {
9081 int scriptTextLen;
9082 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9083 struct JimParserCtx parser;
9084 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9085
9086 script->len = 0;
9087 script->csLen = 0;
9088 script->commands = 0;
9089 script->token = NULL;
9090 script->cmdStruct = NULL;
9091 script->inUse = 1;
9092 script->substFlags = flags;
9093 script->fileName = NULL;
9094
9095 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9096 while(1) {
9097 char *token;
9098 int len, type, linenr;
9099
9100 JimParseSubst(&parser, flags);
9101 if (JimParserEof(&parser)) break;
9102 token = JimParserGetToken(&parser, &len, &type, &linenr);
9103 ScriptObjAddToken(interp, script, token, len, type,
9104 NULL, linenr);
9105 }
9106 /* Free the old internal rep and set the new one. */
9107 Jim_FreeIntRep(interp, objPtr);
9108 Jim_SetIntRepPtr(objPtr, script);
9109 objPtr->typePtr = &scriptObjType;
9110 return JIM_OK;
9111 }
9112
9113 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9114 {
9115 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9116
9117 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9118 SetSubstFromAny(interp, objPtr, flags);
9119 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9120 }
9121
9122 /* Performs commands,variables,blackslashes substitution,
9123 * storing the result object (with refcount 0) into
9124 * resObjPtrPtr. */
9125 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9126 Jim_Obj **resObjPtrPtr, int flags)
9127 {
9128 ScriptObj *script;
9129 ScriptToken *token;
9130 int i, len, retcode = JIM_OK;
9131 Jim_Obj *resObjPtr, *savedResultObjPtr;
9132
9133 script = Jim_GetSubst(interp, substObjPtr, flags);
9134 #ifdef JIM_OPTIMIZATION
9135 /* Fast path for a very common case with array-alike syntax,
9136 * that's: $foo($bar) */
9137 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9138 Jim_Obj *varObjPtr = script->token[0].objPtr;
9139
9140 Jim_IncrRefCount(varObjPtr);
9141 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9142 if (resObjPtr == NULL) {
9143 Jim_DecrRefCount(interp, varObjPtr);
9144 return JIM_ERR;
9145 }
9146 Jim_DecrRefCount(interp, varObjPtr);
9147 *resObjPtrPtr = resObjPtr;
9148 return JIM_OK;
9149 }
9150 #endif
9151
9152 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9153 /* In order to preserve the internal rep, we increment the
9154 * inUse field of the script internal rep structure. */
9155 script->inUse++;
9156
9157 token = script->token;
9158 len = script->len;
9159
9160 /* Save the interp old result, to set it again before
9161 * to return. */
9162 savedResultObjPtr = interp->result;
9163 Jim_IncrRefCount(savedResultObjPtr);
9164
9165 /* Perform the substitution. Starts with an empty object
9166 * and adds every token (performing the appropriate
9167 * var/command/escape substitution). */
9168 resObjPtr = Jim_NewStringObj(interp, "", 0);
9169 for (i = 0; i < len; i++) {
9170 Jim_Obj *objPtr;
9171
9172 switch(token[i].type) {
9173 case JIM_TT_STR:
9174 case JIM_TT_ESC:
9175 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9176 break;
9177 case JIM_TT_VAR:
9178 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9179 if (objPtr == NULL) goto err;
9180 Jim_IncrRefCount(objPtr);
9181 Jim_AppendObj(interp, resObjPtr, objPtr);
9182 Jim_DecrRefCount(interp, objPtr);
9183 break;
9184 case JIM_TT_DICTSUGAR:
9185 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9186 if (!objPtr) {
9187 retcode = JIM_ERR;
9188 goto err;
9189 }
9190 break;
9191 case JIM_TT_CMD:
9192 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9193 goto err;
9194 Jim_AppendObj(interp, resObjPtr, interp->result);
9195 break;
9196 default:
9197 Jim_Panic(interp,
9198 "default token type (%d) reached "
9199 "in Jim_SubstObj().", token[i].type);
9200 break;
9201 }
9202 }
9203 ok:
9204 if (retcode == JIM_OK)
9205 Jim_SetResult(interp, savedResultObjPtr);
9206 Jim_DecrRefCount(interp, savedResultObjPtr);
9207 /* Note that we don't have to decrement inUse, because the
9208 * following code transfers our use of the reference again to
9209 * the script object. */
9210 Jim_FreeIntRep(interp, substObjPtr);
9211 substObjPtr->typePtr = &scriptObjType;
9212 Jim_SetIntRepPtr(substObjPtr, script);
9213 Jim_DecrRefCount(interp, substObjPtr);
9214 *resObjPtrPtr = resObjPtr;
9215 return retcode;
9216 err:
9217 Jim_FreeNewObj(interp, resObjPtr);
9218 retcode = JIM_ERR;
9219 goto ok;
9220 }
9221
9222 /* -----------------------------------------------------------------------------
9223 * API Input/Export functions
9224 * ---------------------------------------------------------------------------*/
9225
9226 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9227 {
9228 Jim_HashEntry *he;
9229
9230 he = Jim_FindHashEntry(&interp->stub, funcname);
9231 if (!he)
9232 return JIM_ERR;
9233 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9234 return JIM_OK;
9235 }
9236
9237 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9238 {
9239 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9240 }
9241
9242 #define JIM_REGISTER_API(name) \
9243 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9244
9245 void JimRegisterCoreApi(Jim_Interp *interp)
9246 {
9247 interp->getApiFuncPtr = Jim_GetApi;
9248 JIM_REGISTER_API(Alloc);
9249 JIM_REGISTER_API(Free);
9250 JIM_REGISTER_API(Eval);
9251 JIM_REGISTER_API(Eval_Named);
9252 JIM_REGISTER_API(EvalGlobal);
9253 JIM_REGISTER_API(EvalFile);
9254 JIM_REGISTER_API(EvalObj);
9255 JIM_REGISTER_API(EvalObjBackground);
9256 JIM_REGISTER_API(EvalObjVector);
9257 JIM_REGISTER_API(InitHashTable);
9258 JIM_REGISTER_API(ExpandHashTable);
9259 JIM_REGISTER_API(AddHashEntry);
9260 JIM_REGISTER_API(ReplaceHashEntry);
9261 JIM_REGISTER_API(DeleteHashEntry);
9262 JIM_REGISTER_API(FreeHashTable);
9263 JIM_REGISTER_API(FindHashEntry);
9264 JIM_REGISTER_API(ResizeHashTable);
9265 JIM_REGISTER_API(GetHashTableIterator);
9266 JIM_REGISTER_API(NextHashEntry);
9267 JIM_REGISTER_API(NewObj);
9268 JIM_REGISTER_API(FreeObj);
9269 JIM_REGISTER_API(InvalidateStringRep);
9270 JIM_REGISTER_API(InitStringRep);
9271 JIM_REGISTER_API(DuplicateObj);
9272 JIM_REGISTER_API(GetString);
9273 JIM_REGISTER_API(Length);
9274 JIM_REGISTER_API(InvalidateStringRep);
9275 JIM_REGISTER_API(NewStringObj);
9276 JIM_REGISTER_API(NewStringObjNoAlloc);
9277 JIM_REGISTER_API(AppendString);
9278 JIM_REGISTER_API(AppendString_sprintf);
9279 JIM_REGISTER_API(AppendObj);
9280 JIM_REGISTER_API(AppendStrings);
9281 JIM_REGISTER_API(StringEqObj);
9282 JIM_REGISTER_API(StringMatchObj);
9283 JIM_REGISTER_API(StringRangeObj);
9284 JIM_REGISTER_API(FormatString);
9285 JIM_REGISTER_API(CompareStringImmediate);
9286 JIM_REGISTER_API(NewReference);
9287 JIM_REGISTER_API(GetReference);
9288 JIM_REGISTER_API(SetFinalizer);
9289 JIM_REGISTER_API(GetFinalizer);
9290 JIM_REGISTER_API(CreateInterp);
9291 JIM_REGISTER_API(FreeInterp);
9292 JIM_REGISTER_API(GetExitCode);
9293 JIM_REGISTER_API(SetStdin);
9294 JIM_REGISTER_API(SetStdout);
9295 JIM_REGISTER_API(SetStderr);
9296 JIM_REGISTER_API(CreateCommand);
9297 JIM_REGISTER_API(CreateProcedure);
9298 JIM_REGISTER_API(DeleteCommand);
9299 JIM_REGISTER_API(RenameCommand);
9300 JIM_REGISTER_API(GetCommand);
9301 JIM_REGISTER_API(SetVariable);
9302 JIM_REGISTER_API(SetVariableStr);
9303 JIM_REGISTER_API(SetGlobalVariableStr);
9304 JIM_REGISTER_API(SetVariableStrWithStr);
9305 JIM_REGISTER_API(SetVariableLink);
9306 JIM_REGISTER_API(GetVariable);
9307 JIM_REGISTER_API(GetCallFrameByLevel);
9308 JIM_REGISTER_API(Collect);
9309 JIM_REGISTER_API(CollectIfNeeded);
9310 JIM_REGISTER_API(GetIndex);
9311 JIM_REGISTER_API(NewListObj);
9312 JIM_REGISTER_API(ListAppendElement);
9313 JIM_REGISTER_API(ListAppendList);
9314 JIM_REGISTER_API(ListLength);
9315 JIM_REGISTER_API(ListIndex);
9316 JIM_REGISTER_API(SetListIndex);
9317 JIM_REGISTER_API(ConcatObj);
9318 JIM_REGISTER_API(NewDictObj);
9319 JIM_REGISTER_API(DictKey);
9320 JIM_REGISTER_API(DictKeysVector);
9321 JIM_REGISTER_API(GetIndex);
9322 JIM_REGISTER_API(GetReturnCode);
9323 JIM_REGISTER_API(EvalExpression);
9324 JIM_REGISTER_API(GetBoolFromExpr);
9325 JIM_REGISTER_API(GetWide);
9326 JIM_REGISTER_API(GetLong);
9327 JIM_REGISTER_API(SetWide);
9328 JIM_REGISTER_API(NewIntObj);
9329 JIM_REGISTER_API(GetDouble);
9330 JIM_REGISTER_API(SetDouble);
9331 JIM_REGISTER_API(NewDoubleObj);
9332 JIM_REGISTER_API(WrongNumArgs);
9333 JIM_REGISTER_API(SetDictKeysVector);
9334 JIM_REGISTER_API(SubstObj);
9335 JIM_REGISTER_API(RegisterApi);
9336 JIM_REGISTER_API(PrintErrorMessage);
9337 JIM_REGISTER_API(InteractivePrompt);
9338 JIM_REGISTER_API(RegisterCoreCommands);
9339 JIM_REGISTER_API(GetSharedString);
9340 JIM_REGISTER_API(ReleaseSharedString);
9341 JIM_REGISTER_API(Panic);
9342 JIM_REGISTER_API(StrDup);
9343 JIM_REGISTER_API(UnsetVariable);
9344 JIM_REGISTER_API(GetVariableStr);
9345 JIM_REGISTER_API(GetGlobalVariable);
9346 JIM_REGISTER_API(GetGlobalVariableStr);
9347 JIM_REGISTER_API(GetAssocData);
9348 JIM_REGISTER_API(SetAssocData);
9349 JIM_REGISTER_API(DeleteAssocData);
9350 JIM_REGISTER_API(GetEnum);
9351 JIM_REGISTER_API(ScriptIsComplete);
9352 JIM_REGISTER_API(PackageRequire);
9353 JIM_REGISTER_API(PackageProvide);
9354 JIM_REGISTER_API(InitStack);
9355 JIM_REGISTER_API(FreeStack);
9356 JIM_REGISTER_API(StackLen);
9357 JIM_REGISTER_API(StackPush);
9358 JIM_REGISTER_API(StackPop);
9359 JIM_REGISTER_API(StackPeek);
9360 JIM_REGISTER_API(FreeStackElements);
9361 JIM_REGISTER_API(fprintf );
9362 JIM_REGISTER_API(vfprintf );
9363 JIM_REGISTER_API(fwrite );
9364 JIM_REGISTER_API(fread );
9365 JIM_REGISTER_API(fflush );
9366 JIM_REGISTER_API(fgets );
9367 JIM_REGISTER_API(GetNvp);
9368 JIM_REGISTER_API(Nvp_name2value);
9369 JIM_REGISTER_API(Nvp_name2value_simple);
9370 JIM_REGISTER_API(Nvp_name2value_obj);
9371 JIM_REGISTER_API(Nvp_name2value_nocase);
9372 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9373
9374 JIM_REGISTER_API(Nvp_value2name);
9375 JIM_REGISTER_API(Nvp_value2name_simple);
9376 JIM_REGISTER_API(Nvp_value2name_obj);
9377
9378 JIM_REGISTER_API(GetOpt_Setup);
9379 JIM_REGISTER_API(GetOpt_Debug);
9380 JIM_REGISTER_API(GetOpt_Obj);
9381 JIM_REGISTER_API(GetOpt_String);
9382 JIM_REGISTER_API(GetOpt_Double);
9383 JIM_REGISTER_API(GetOpt_Wide);
9384 JIM_REGISTER_API(GetOpt_Nvp);
9385 JIM_REGISTER_API(GetOpt_NvpUnknown);
9386 JIM_REGISTER_API(GetOpt_Enum);
9387
9388 JIM_REGISTER_API(Debug_ArgvString);
9389 JIM_REGISTER_API(SetResult_sprintf);
9390 JIM_REGISTER_API(SetResult_NvpUnknown);
9391
9392 }
9393
9394 /* -----------------------------------------------------------------------------
9395 * Core commands utility functions
9396 * ---------------------------------------------------------------------------*/
9397 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9398 const char *msg)
9399 {
9400 int i;
9401 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9402
9403 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9404 for (i = 0; i < argc; i++) {
9405 Jim_AppendObj(interp, objPtr, argv[i]);
9406 if (!(i+1 == argc && msg[0] == '\0'))
9407 Jim_AppendString(interp, objPtr, " ", 1);
9408 }
9409 Jim_AppendString(interp, objPtr, msg, -1);
9410 Jim_AppendString(interp, objPtr, "\"", 1);
9411 Jim_SetResult(interp, objPtr);
9412 }
9413
9414 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9415 {
9416 Jim_HashTableIterator *htiter;
9417 Jim_HashEntry *he;
9418 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9419 const char *pattern;
9420 int patternLen;
9421
9422 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9423 htiter = Jim_GetHashTableIterator(&interp->commands);
9424 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9425 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9426 strlen((const char*)he->key), 0))
9427 continue;
9428 Jim_ListAppendElement(interp, listObjPtr,
9429 Jim_NewStringObj(interp, he->key, -1));
9430 }
9431 Jim_FreeHashTableIterator(htiter);
9432 return listObjPtr;
9433 }
9434
9435 #define JIM_VARLIST_GLOBALS 0
9436 #define JIM_VARLIST_LOCALS 1
9437 #define JIM_VARLIST_VARS 2
9438
9439 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9440 int mode)
9441 {
9442 Jim_HashTableIterator *htiter;
9443 Jim_HashEntry *he;
9444 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9445 const char *pattern;
9446 int patternLen;
9447
9448 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9449 if (mode == JIM_VARLIST_GLOBALS) {
9450 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9451 } else {
9452 /* For [info locals], if we are at top level an emtpy list
9453 * is returned. I don't agree, but we aim at compatibility (SS) */
9454 if (mode == JIM_VARLIST_LOCALS &&
9455 interp->framePtr == interp->topFramePtr)
9456 return listObjPtr;
9457 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9458 }
9459 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9460 Jim_Var *varPtr = (Jim_Var*) he->val;
9461 if (mode == JIM_VARLIST_LOCALS) {
9462 if (varPtr->linkFramePtr != NULL)
9463 continue;
9464 }
9465 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9466 strlen((const char*)he->key), 0))
9467 continue;
9468 Jim_ListAppendElement(interp, listObjPtr,
9469 Jim_NewStringObj(interp, he->key, -1));
9470 }
9471 Jim_FreeHashTableIterator(htiter);
9472 return listObjPtr;
9473 }
9474
9475 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9476 Jim_Obj **objPtrPtr)
9477 {
9478 Jim_CallFrame *targetCallFrame;
9479
9480 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9481 != JIM_OK)
9482 return JIM_ERR;
9483 /* No proc call at toplevel callframe */
9484 if (targetCallFrame == interp->topFramePtr) {
9485 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9486 Jim_AppendStrings(interp, Jim_GetResult(interp),
9487 "bad level \"",
9488 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9489 return JIM_ERR;
9490 }
9491 *objPtrPtr = Jim_NewListObj(interp,
9492 targetCallFrame->argv,
9493 targetCallFrame->argc);
9494 return JIM_OK;
9495 }
9496
9497 /* -----------------------------------------------------------------------------
9498 * Core commands
9499 * ---------------------------------------------------------------------------*/
9500
9501 /* fake [puts] -- not the real puts, just for debugging. */
9502 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9503 Jim_Obj *const *argv)
9504 {
9505 const char *str;
9506 int len, nonewline = 0;
9507
9508 if (argc != 2 && argc != 3) {
9509 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9510 return JIM_ERR;
9511 }
9512 if (argc == 3) {
9513 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9514 {
9515 Jim_SetResultString(interp, "The second argument must "
9516 "be -nonewline", -1);
9517 return JIM_OK;
9518 } else {
9519 nonewline = 1;
9520 argv++;
9521 }
9522 }
9523 str = Jim_GetString(argv[1], &len);
9524 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9525 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9526 return JIM_OK;
9527 }
9528
9529 /* Helper for [+] and [*] */
9530 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9531 Jim_Obj *const *argv, int op)
9532 {
9533 jim_wide wideValue, res;
9534 double doubleValue, doubleRes;
9535 int i;
9536
9537 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9538
9539 for (i = 1; i < argc; i++) {
9540 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9541 goto trydouble;
9542 if (op == JIM_EXPROP_ADD)
9543 res += wideValue;
9544 else
9545 res *= wideValue;
9546 }
9547 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9548 return JIM_OK;
9549 trydouble:
9550 doubleRes = (double) res;
9551 for (;i < argc; i++) {
9552 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9553 return JIM_ERR;
9554 if (op == JIM_EXPROP_ADD)
9555 doubleRes += doubleValue;
9556 else
9557 doubleRes *= doubleValue;
9558 }
9559 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9560 return JIM_OK;
9561 }
9562
9563 /* Helper for [-] and [/] */
9564 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9565 Jim_Obj *const *argv, int op)
9566 {
9567 jim_wide wideValue, res = 0;
9568 double doubleValue, doubleRes = 0;
9569 int i = 2;
9570
9571 if (argc < 2) {
9572 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9573 return JIM_ERR;
9574 } else if (argc == 2) {
9575 /* The arity = 2 case is different. For [- x] returns -x,
9576 * while [/ x] returns 1/x. */
9577 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9578 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9579 JIM_OK)
9580 {
9581 return JIM_ERR;
9582 } else {
9583 if (op == JIM_EXPROP_SUB)
9584 doubleRes = -doubleValue;
9585 else
9586 doubleRes = 1.0/doubleValue;
9587 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9588 doubleRes));
9589 return JIM_OK;
9590 }
9591 }
9592 if (op == JIM_EXPROP_SUB) {
9593 res = -wideValue;
9594 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9595 } else {
9596 doubleRes = 1.0/wideValue;
9597 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9598 doubleRes));
9599 }
9600 return JIM_OK;
9601 } else {
9602 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9603 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9604 != JIM_OK) {
9605 return JIM_ERR;
9606 } else {
9607 goto trydouble;
9608 }
9609 }
9610 }
9611 for (i = 2; i < argc; i++) {
9612 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9613 doubleRes = (double) res;
9614 goto trydouble;
9615 }
9616 if (op == JIM_EXPROP_SUB)
9617 res -= wideValue;
9618 else
9619 res /= wideValue;
9620 }
9621 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9622 return JIM_OK;
9623 trydouble:
9624 for (;i < argc; i++) {
9625 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9626 return JIM_ERR;
9627 if (op == JIM_EXPROP_SUB)
9628 doubleRes -= doubleValue;
9629 else
9630 doubleRes /= doubleValue;
9631 }
9632 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9633 return JIM_OK;
9634 }
9635
9636
9637 /* [+] */
9638 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9639 Jim_Obj *const *argv)
9640 {
9641 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9642 }
9643
9644 /* [*] */
9645 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9646 Jim_Obj *const *argv)
9647 {
9648 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9649 }
9650
9651 /* [-] */
9652 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9653 Jim_Obj *const *argv)
9654 {
9655 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9656 }
9657
9658 /* [/] */
9659 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9660 Jim_Obj *const *argv)
9661 {
9662 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9663 }
9664
9665 /* [set] */
9666 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9667 Jim_Obj *const *argv)
9668 {
9669 if (argc != 2 && argc != 3) {
9670 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9671 return JIM_ERR;
9672 }
9673 if (argc == 2) {
9674 Jim_Obj *objPtr;
9675 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9676 if (!objPtr)
9677 return JIM_ERR;
9678 Jim_SetResult(interp, objPtr);
9679 return JIM_OK;
9680 }
9681 /* argc == 3 case. */
9682 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9683 return JIM_ERR;
9684 Jim_SetResult(interp, argv[2]);
9685 return JIM_OK;
9686 }
9687
9688 /* [unset] */
9689 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9690 Jim_Obj *const *argv)
9691 {
9692 int i;
9693
9694 if (argc < 2) {
9695 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9696 return JIM_ERR;
9697 }
9698 for (i = 1; i < argc; i++) {
9699 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9700 return JIM_ERR;
9701 }
9702 return JIM_OK;
9703 }
9704
9705 /* [incr] */
9706 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9707 Jim_Obj *const *argv)
9708 {
9709 jim_wide wideValue, increment = 1;
9710 Jim_Obj *intObjPtr;
9711
9712 if (argc != 2 && argc != 3) {
9713 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9714 return JIM_ERR;
9715 }
9716 if (argc == 3) {
9717 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9718 return JIM_ERR;
9719 }
9720 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9721 if (!intObjPtr) return JIM_ERR;
9722 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9723 return JIM_ERR;
9724 if (Jim_IsShared(intObjPtr)) {
9725 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9726 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9727 Jim_FreeNewObj(interp, intObjPtr);
9728 return JIM_ERR;
9729 }
9730 } else {
9731 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9732 /* The following step is required in order to invalidate the
9733 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9734 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9735 return JIM_ERR;
9736 }
9737 }
9738 Jim_SetResult(interp, intObjPtr);
9739 return JIM_OK;
9740 }
9741
9742 /* [while] */
9743 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9744 Jim_Obj *const *argv)
9745 {
9746 if (argc != 3) {
9747 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9748 return JIM_ERR;
9749 }
9750 /* Try to run a specialized version of while if the expression
9751 * is in one of the following forms:
9752 *
9753 * $a < CONST, $a < $b
9754 * $a <= CONST, $a <= $b
9755 * $a > CONST, $a > $b
9756 * $a >= CONST, $a >= $b
9757 * $a != CONST, $a != $b
9758 * $a == CONST, $a == $b
9759 * $a
9760 * !$a
9761 * CONST
9762 */
9763
9764 #ifdef JIM_OPTIMIZATION
9765 {
9766 ExprByteCode *expr;
9767 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9768 int exprLen, retval;
9769
9770 /* STEP 1 -- Check if there are the conditions to run the specialized
9771 * version of while */
9772
9773 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9774 if (expr->len <= 0 || expr->len > 3) goto noopt;
9775 switch(expr->len) {
9776 case 1:
9777 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9778 expr->opcode[0] != JIM_EXPROP_NUMBER)
9779 goto noopt;
9780 break;
9781 case 2:
9782 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9783 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9784 goto noopt;
9785 break;
9786 case 3:
9787 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9788 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9789 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9790 goto noopt;
9791 switch(expr->opcode[2]) {
9792 case JIM_EXPROP_LT:
9793 case JIM_EXPROP_LTE:
9794 case JIM_EXPROP_GT:
9795 case JIM_EXPROP_GTE:
9796 case JIM_EXPROP_NUMEQ:
9797 case JIM_EXPROP_NUMNE:
9798 /* nothing to do */
9799 break;
9800 default:
9801 goto noopt;
9802 }
9803 break;
9804 default:
9805 Jim_Panic(interp,
9806 "Unexpected default reached in Jim_WhileCoreCommand()");
9807 break;
9808 }
9809
9810 /* STEP 2 -- conditions meet. Initialization. Take different
9811 * branches for different expression lengths. */
9812 exprLen = expr->len;
9813
9814 if (exprLen == 1) {
9815 jim_wide wideValue;
9816
9817 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9818 varAObjPtr = expr->obj[0];
9819 Jim_IncrRefCount(varAObjPtr);
9820 } else {
9821 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9822 goto noopt;
9823 }
9824 while (1) {
9825 if (varAObjPtr) {
9826 if (!(objPtr =
9827 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9828 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9829 {
9830 Jim_DecrRefCount(interp, varAObjPtr);
9831 goto noopt;
9832 }
9833 }
9834 if (!wideValue) break;
9835 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9836 switch(retval) {
9837 case JIM_BREAK:
9838 if (varAObjPtr)
9839 Jim_DecrRefCount(interp, varAObjPtr);
9840 goto out;
9841 break;
9842 case JIM_CONTINUE:
9843 continue;
9844 break;
9845 default:
9846 if (varAObjPtr)
9847 Jim_DecrRefCount(interp, varAObjPtr);
9848 return retval;
9849 }
9850 }
9851 }
9852 if (varAObjPtr)
9853 Jim_DecrRefCount(interp, varAObjPtr);
9854 } else if (exprLen == 3) {
9855 jim_wide wideValueA, wideValueB, cmpRes = 0;
9856 int cmpType = expr->opcode[2];
9857
9858 varAObjPtr = expr->obj[0];
9859 Jim_IncrRefCount(varAObjPtr);
9860 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9861 varBObjPtr = expr->obj[1];
9862 Jim_IncrRefCount(varBObjPtr);
9863 } else {
9864 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9865 goto noopt;
9866 }
9867 while (1) {
9868 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9869 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9870 {
9871 Jim_DecrRefCount(interp, varAObjPtr);
9872 if (varBObjPtr)
9873 Jim_DecrRefCount(interp, varBObjPtr);
9874 goto noopt;
9875 }
9876 if (varBObjPtr) {
9877 if (!(objPtr =
9878 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9879 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9880 {
9881 Jim_DecrRefCount(interp, varAObjPtr);
9882 if (varBObjPtr)
9883 Jim_DecrRefCount(interp, varBObjPtr);
9884 goto noopt;
9885 }
9886 }
9887 switch(cmpType) {
9888 case JIM_EXPROP_LT:
9889 cmpRes = wideValueA < wideValueB; break;
9890 case JIM_EXPROP_LTE:
9891 cmpRes = wideValueA <= wideValueB; break;
9892 case JIM_EXPROP_GT:
9893 cmpRes = wideValueA > wideValueB; break;
9894 case JIM_EXPROP_GTE:
9895 cmpRes = wideValueA >= wideValueB; break;
9896 case JIM_EXPROP_NUMEQ:
9897 cmpRes = wideValueA == wideValueB; break;
9898 case JIM_EXPROP_NUMNE:
9899 cmpRes = wideValueA != wideValueB; break;
9900 }
9901 if (!cmpRes) break;
9902 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9903 switch(retval) {
9904 case JIM_BREAK:
9905 Jim_DecrRefCount(interp, varAObjPtr);
9906 if (varBObjPtr)
9907 Jim_DecrRefCount(interp, varBObjPtr);
9908 goto out;
9909 break;
9910 case JIM_CONTINUE:
9911 continue;
9912 break;
9913 default:
9914 Jim_DecrRefCount(interp, varAObjPtr);
9915 if (varBObjPtr)
9916 Jim_DecrRefCount(interp, varBObjPtr);
9917 return retval;
9918 }
9919 }
9920 }
9921 Jim_DecrRefCount(interp, varAObjPtr);
9922 if (varBObjPtr)
9923 Jim_DecrRefCount(interp, varBObjPtr);
9924 } else {
9925 /* TODO: case for len == 2 */
9926 goto noopt;
9927 }
9928 Jim_SetEmptyResult(interp);
9929 return JIM_OK;
9930 }
9931 noopt:
9932 #endif
9933
9934 /* The general purpose implementation of while starts here */
9935 while (1) {
9936 int boolean, retval;
9937
9938 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9939 &boolean)) != JIM_OK)
9940 return retval;
9941 if (!boolean) break;
9942 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9943 switch(retval) {
9944 case JIM_BREAK:
9945 goto out;
9946 break;
9947 case JIM_CONTINUE:
9948 continue;
9949 break;
9950 default:
9951 return retval;
9952 }
9953 }
9954 }
9955 out:
9956 Jim_SetEmptyResult(interp);
9957 return JIM_OK;
9958 }
9959
9960 /* [for] */
9961 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9962 Jim_Obj *const *argv)
9963 {
9964 int retval;
9965
9966 if (argc != 5) {
9967 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9968 return JIM_ERR;
9969 }
9970 /* Check if the for is on the form:
9971 * for {set i CONST} {$i < CONST} {incr i}
9972 * for {set i CONST} {$i < $j} {incr i}
9973 * for {set i CONST} {$i <= CONST} {incr i}
9974 * for {set i CONST} {$i <= $j} {incr i}
9975 * XXX: NOTE: if variable traces are implemented, this optimization
9976 * need to be modified to check for the proc epoch at every variable
9977 * update. */
9978 #ifdef JIM_OPTIMIZATION
9979 {
9980 ScriptObj *initScript, *incrScript;
9981 ExprByteCode *expr;
9982 jim_wide start, stop, currentVal;
9983 unsigned jim_wide procEpoch = interp->procEpoch;
9984 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9985 int cmpType;
9986 struct Jim_Cmd *cmdPtr;
9987
9988 /* Do it only if there aren't shared arguments */
9989 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9990 goto evalstart;
9991 initScript = Jim_GetScript(interp, argv[1]);
9992 expr = Jim_GetExpression(interp, argv[2]);
9993 incrScript = Jim_GetScript(interp, argv[3]);
9994
9995 /* Ensure proper lengths to start */
9996 if (initScript->len != 6) goto evalstart;
9997 if (incrScript->len != 4) goto evalstart;
9998 if (expr->len != 3) goto evalstart;
9999 /* Ensure proper token types. */
10000 if (initScript->token[2].type != JIM_TT_ESC ||
10001 initScript->token[4].type != JIM_TT_ESC ||
10002 incrScript->token[2].type != JIM_TT_ESC ||
10003 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10004 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10005 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10006 (expr->opcode[2] != JIM_EXPROP_LT &&
10007 expr->opcode[2] != JIM_EXPROP_LTE))
10008 goto evalstart;
10009 cmpType = expr->opcode[2];
10010 /* Initialization command must be [set] */
10011 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10012 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10013 goto evalstart;
10014 /* Update command must be incr */
10015 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10016 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10017 goto evalstart;
10018 /* set, incr, expression must be about the same variable */
10019 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10020 incrScript->token[2].objPtr, 0))
10021 goto evalstart;
10022 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10023 expr->obj[0], 0))
10024 goto evalstart;
10025 /* Check that the initialization and comparison are valid integers */
10026 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10027 goto evalstart;
10028 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10029 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10030 {
10031 goto evalstart;
10032 }
10033
10034 /* Initialization */
10035 varNamePtr = expr->obj[0];
10036 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10037 stopVarNamePtr = expr->obj[1];
10038 Jim_IncrRefCount(stopVarNamePtr);
10039 }
10040 Jim_IncrRefCount(varNamePtr);
10041
10042 /* --- OPTIMIZED FOR --- */
10043 /* Start to loop */
10044 objPtr = Jim_NewIntObj(interp, start);
10045 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10046 Jim_DecrRefCount(interp, varNamePtr);
10047 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10048 Jim_FreeNewObj(interp, objPtr);
10049 goto evalstart;
10050 }
10051 while (1) {
10052 /* === Check condition === */
10053 /* Common code: */
10054 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10055 if (objPtr == NULL ||
10056 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10057 {
10058 Jim_DecrRefCount(interp, varNamePtr);
10059 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10060 goto testcond;
10061 }
10062 /* Immediate or Variable? get the 'stop' value if the latter. */
10063 if (stopVarNamePtr) {
10064 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10065 if (objPtr == NULL ||
10066 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10067 {
10068 Jim_DecrRefCount(interp, varNamePtr);
10069 Jim_DecrRefCount(interp, stopVarNamePtr);
10070 goto testcond;
10071 }
10072 }
10073 if (cmpType == JIM_EXPROP_LT) {
10074 if (currentVal >= stop) break;
10075 } else {
10076 if (currentVal > stop) break;
10077 }
10078 /* Eval body */
10079 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10080 switch(retval) {
10081 case JIM_BREAK:
10082 if (stopVarNamePtr)
10083 Jim_DecrRefCount(interp, stopVarNamePtr);
10084 Jim_DecrRefCount(interp, varNamePtr);
10085 goto out;
10086 case JIM_CONTINUE:
10087 /* nothing to do */
10088 break;
10089 default:
10090 if (stopVarNamePtr)
10091 Jim_DecrRefCount(interp, stopVarNamePtr);
10092 Jim_DecrRefCount(interp, varNamePtr);
10093 return retval;
10094 }
10095 }
10096 /* If there was a change in procedures/command continue
10097 * with the usual [for] command implementation */
10098 if (procEpoch != interp->procEpoch) {
10099 if (stopVarNamePtr)
10100 Jim_DecrRefCount(interp, stopVarNamePtr);
10101 Jim_DecrRefCount(interp, varNamePtr);
10102 goto evalnext;
10103 }
10104 /* Increment */
10105 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10106 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10107 objPtr->internalRep.wideValue ++;
10108 Jim_InvalidateStringRep(objPtr);
10109 } else {
10110 Jim_Obj *auxObjPtr;
10111
10112 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10113 if (stopVarNamePtr)
10114 Jim_DecrRefCount(interp, stopVarNamePtr);
10115 Jim_DecrRefCount(interp, varNamePtr);
10116 goto evalnext;
10117 }
10118 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10119 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10120 if (stopVarNamePtr)
10121 Jim_DecrRefCount(interp, stopVarNamePtr);
10122 Jim_DecrRefCount(interp, varNamePtr);
10123 Jim_FreeNewObj(interp, auxObjPtr);
10124 goto evalnext;
10125 }
10126 }
10127 }
10128 if (stopVarNamePtr)
10129 Jim_DecrRefCount(interp, stopVarNamePtr);
10130 Jim_DecrRefCount(interp, varNamePtr);
10131 Jim_SetEmptyResult(interp);
10132 return JIM_OK;
10133 }
10134 #endif
10135 evalstart:
10136 /* Eval start */
10137 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10138 return retval;
10139 while (1) {
10140 int boolean;
10141 testcond:
10142 /* Test the condition */
10143 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10144 != JIM_OK)
10145 return retval;
10146 if (!boolean) break;
10147 /* Eval body */
10148 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10149 switch(retval) {
10150 case JIM_BREAK:
10151 goto out;
10152 break;
10153 case JIM_CONTINUE:
10154 /* Nothing to do */
10155 break;
10156 default:
10157 return retval;
10158 }
10159 }
10160 evalnext:
10161 /* Eval next */
10162 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10163 switch(retval) {
10164 case JIM_BREAK:
10165 goto out;
10166 break;
10167 case JIM_CONTINUE:
10168 continue;
10169 break;
10170 default:
10171 return retval;
10172 }
10173 }
10174 }
10175 out:
10176 Jim_SetEmptyResult(interp);
10177 return JIM_OK;
10178 }
10179
10180 /* foreach + lmap implementation. */
10181 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10182 Jim_Obj *const *argv, int doMap)
10183 {
10184 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10185 int nbrOfLoops = 0;
10186 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10187
10188 if (argc < 4 || argc % 2 != 0) {
10189 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10190 return JIM_ERR;
10191 }
10192 if (doMap) {
10193 mapRes = Jim_NewListObj(interp, NULL, 0);
10194 Jim_IncrRefCount(mapRes);
10195 }
10196 emptyStr = Jim_NewEmptyStringObj(interp);
10197 Jim_IncrRefCount(emptyStr);
10198 script = argv[argc-1]; /* Last argument is a script */
10199 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10200 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10201 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10202 /* Initialize iterators and remember max nbr elements each list */
10203 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10204 /* Remember lengths of all lists and calculate how much rounds to loop */
10205 for (i=0; i < nbrOfLists*2; i += 2) {
10206 div_t cnt;
10207 int count;
10208 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10209 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10210 if (listsEnd[i] == 0) {
10211 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10212 goto err;
10213 }
10214 cnt = div(listsEnd[i+1], listsEnd[i]);
10215 count = cnt.quot + (cnt.rem ? 1 : 0);
10216 if (count > nbrOfLoops)
10217 nbrOfLoops = count;
10218 }
10219 for (; nbrOfLoops-- > 0; ) {
10220 for (i=0; i < nbrOfLists; ++i) {
10221 int varIdx = 0, var = i * 2;
10222 while (varIdx < listsEnd[var]) {
10223 Jim_Obj *varName, *ele;
10224 int lst = i * 2 + 1;
10225 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10226 != JIM_OK)
10227 goto err;
10228 if (listsIdx[i] < listsEnd[lst]) {
10229 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10230 != JIM_OK)
10231 goto err;
10232 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10233 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10234 goto err;
10235 }
10236 ++listsIdx[i]; /* Remember next iterator of current list */
10237 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10238 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10239 goto err;
10240 }
10241 ++varIdx; /* Next variable */
10242 }
10243 }
10244 switch (result = Jim_EvalObj(interp, script)) {
10245 case JIM_OK:
10246 if (doMap)
10247 Jim_ListAppendElement(interp, mapRes, interp->result);
10248 break;
10249 case JIM_CONTINUE:
10250 break;
10251 case JIM_BREAK:
10252 goto out;
10253 break;
10254 default:
10255 goto err;
10256 }
10257 }
10258 out:
10259 result = JIM_OK;
10260 if (doMap)
10261 Jim_SetResult(interp, mapRes);
10262 else
10263 Jim_SetEmptyResult(interp);
10264 err:
10265 if (doMap)
10266 Jim_DecrRefCount(interp, mapRes);
10267 Jim_DecrRefCount(interp, emptyStr);
10268 Jim_Free(listsIdx);
10269 Jim_Free(listsEnd);
10270 return result;
10271 }
10272
10273 /* [foreach] */
10274 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10275 Jim_Obj *const *argv)
10276 {
10277 return JimForeachMapHelper(interp, argc, argv, 0);
10278 }
10279
10280 /* [lmap] */
10281 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10282 Jim_Obj *const *argv)
10283 {
10284 return JimForeachMapHelper(interp, argc, argv, 1);
10285 }
10286
10287 /* [if] */
10288 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10289 Jim_Obj *const *argv)
10290 {
10291 int boolean, retval, current = 1, falsebody = 0;
10292 if (argc >= 3) {
10293 while (1) {
10294 /* Far not enough arguments given! */
10295 if (current >= argc) goto err;
10296 if ((retval = Jim_GetBoolFromExpr(interp,
10297 argv[current++], &boolean))
10298 != JIM_OK)
10299 return retval;
10300 /* There lacks something, isn't it? */
10301 if (current >= argc) goto err;
10302 if (Jim_CompareStringImmediate(interp, argv[current],
10303 "then")) current++;
10304 /* Tsk tsk, no then-clause? */
10305 if (current >= argc) goto err;
10306 if (boolean)
10307 return Jim_EvalObj(interp, argv[current]);
10308 /* Ok: no else-clause follows */
10309 if (++current >= argc) {
10310 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10311 return JIM_OK;
10312 }
10313 falsebody = current++;
10314 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10315 "else")) {
10316 /* IIICKS - else-clause isn't last cmd? */
10317 if (current != argc-1) goto err;
10318 return Jim_EvalObj(interp, argv[current]);
10319 } else if (Jim_CompareStringImmediate(interp,
10320 argv[falsebody], "elseif"))
10321 /* Ok: elseif follows meaning all the stuff
10322 * again (how boring...) */
10323 continue;
10324 /* OOPS - else-clause is not last cmd?*/
10325 else if (falsebody != argc-1)
10326 goto err;
10327 return Jim_EvalObj(interp, argv[falsebody]);
10328 }
10329 return JIM_OK;
10330 }
10331 err:
10332 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10333 return JIM_ERR;
10334 }
10335
10336 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10337
10338 /* [switch] */
10339 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10340 Jim_Obj *const *argv)
10341 {
10342 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10343 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10344 Jim_Obj *script = 0;
10345 if (argc < 3) goto wrongnumargs;
10346 for (opt=1; opt < argc; ++opt) {
10347 const char *option = Jim_GetString(argv[opt], 0);
10348 if (*option != '-') break;
10349 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10350 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10351 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10352 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10353 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10354 if ((argc - opt) < 2) goto wrongnumargs;
10355 command = argv[++opt];
10356 } else {
10357 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10358 Jim_AppendStrings(interp, Jim_GetResult(interp),
10359 "bad option \"", option, "\": must be -exact, -glob, "
10360 "-regexp, -command procname or --", 0);
10361 goto err;
10362 }
10363 if ((argc - opt) < 2) goto wrongnumargs;
10364 }
10365 strObj = argv[opt++];
10366 patCount = argc - opt;
10367 if (patCount == 1) {
10368 Jim_Obj **vector;
10369 JimListGetElements(interp, argv[opt], &patCount, &vector);
10370 caseList = vector;
10371 } else
10372 caseList = &argv[opt];
10373 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10374 for (i=0; script == 0 && i < patCount; i += 2) {
10375 Jim_Obj *patObj = caseList[i];
10376 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10377 || i < (patCount-2)) {
10378 switch (matchOpt) {
10379 case SWITCH_EXACT:
10380 if (Jim_StringEqObj(strObj, patObj, 0))
10381 script = caseList[i+1];
10382 break;
10383 case SWITCH_GLOB:
10384 if (Jim_StringMatchObj(patObj, strObj, 0))
10385 script = caseList[i+1];
10386 break;
10387 case SWITCH_RE:
10388 command = Jim_NewStringObj(interp, "regexp", -1);
10389 /* Fall thru intentionally */
10390 case SWITCH_CMD: {
10391 Jim_Obj *parms[] = {command, patObj, strObj};
10392 int rc = Jim_EvalObjVector(interp, 3, parms);
10393 long matching;
10394 /* After the execution of a command we need to
10395 * make sure to reconvert the object into a list
10396 * again. Only for the single-list style [switch]. */
10397 if (argc-opt == 1) {
10398 Jim_Obj **vector;
10399 JimListGetElements(interp, argv[opt], &patCount,
10400 &vector);
10401 caseList = vector;
10402 }
10403 /* command is here already decref'd */
10404 if (rc != JIM_OK) {
10405 retcode = rc;
10406 goto err;
10407 }
10408 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10409 if (rc != JIM_OK) {
10410 retcode = rc;
10411 goto err;
10412 }
10413 if (matching)
10414 script = caseList[i+1];
10415 break;
10416 }
10417 default:
10418 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10419 Jim_AppendStrings(interp, Jim_GetResult(interp),
10420 "internal error: no such option implemented", 0);
10421 goto err;
10422 }
10423 } else {
10424 script = caseList[i+1];
10425 }
10426 }
10427 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10428 i += 2)
10429 script = caseList[i+1];
10430 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10431 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10432 Jim_AppendStrings(interp, Jim_GetResult(interp),
10433 "no body specified for pattern \"",
10434 Jim_GetString(caseList[i-2], 0), "\"", 0);
10435 goto err;
10436 }
10437 retcode = JIM_OK;
10438 Jim_SetEmptyResult(interp);
10439 if (script != 0)
10440 retcode = Jim_EvalObj(interp, script);
10441 return retcode;
10442 wrongnumargs:
10443 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10444 "pattern body ... ?default body? or "
10445 "{pattern body ?pattern body ...?}");
10446 err:
10447 return retcode;
10448 }
10449
10450 /* [list] */
10451 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10452 Jim_Obj *const *argv)
10453 {
10454 Jim_Obj *listObjPtr;
10455
10456 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10457 Jim_SetResult(interp, listObjPtr);
10458 return JIM_OK;
10459 }
10460
10461 /* [lindex] */
10462 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10463 Jim_Obj *const *argv)
10464 {
10465 Jim_Obj *objPtr, *listObjPtr;
10466 int i;
10467 int index;
10468
10469 if (argc < 3) {
10470 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10471 return JIM_ERR;
10472 }
10473 objPtr = argv[1];
10474 Jim_IncrRefCount(objPtr);
10475 for (i = 2; i < argc; i++) {
10476 listObjPtr = objPtr;
10477 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10478 Jim_DecrRefCount(interp, listObjPtr);
10479 return JIM_ERR;
10480 }
10481 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10482 JIM_NONE) != JIM_OK) {
10483 /* Returns an empty object if the index
10484 * is out of range. */
10485 Jim_DecrRefCount(interp, listObjPtr);
10486 Jim_SetEmptyResult(interp);
10487 return JIM_OK;
10488 }
10489 Jim_IncrRefCount(objPtr);
10490 Jim_DecrRefCount(interp, listObjPtr);
10491 }
10492 Jim_SetResult(interp, objPtr);
10493 Jim_DecrRefCount(interp, objPtr);
10494 return JIM_OK;
10495 }
10496
10497 /* [llength] */
10498 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10499 Jim_Obj *const *argv)
10500 {
10501 int len;
10502
10503 if (argc != 2) {
10504 Jim_WrongNumArgs(interp, 1, argv, "list");
10505 return JIM_ERR;
10506 }
10507 Jim_ListLength(interp, argv[1], &len);
10508 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10509 return JIM_OK;
10510 }
10511
10512 /* [lappend] */
10513 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10514 Jim_Obj *const *argv)
10515 {
10516 Jim_Obj *listObjPtr;
10517 int shared, i;
10518
10519 if (argc < 2) {
10520 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10521 return JIM_ERR;
10522 }
10523 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10524 if (!listObjPtr) {
10525 /* Create the list if it does not exists */
10526 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10527 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10528 Jim_FreeNewObj(interp, listObjPtr);
10529 return JIM_ERR;
10530 }
10531 }
10532 shared = Jim_IsShared(listObjPtr);
10533 if (shared)
10534 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10535 for (i = 2; i < argc; i++)
10536 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10537 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10538 if (shared)
10539 Jim_FreeNewObj(interp, listObjPtr);
10540 return JIM_ERR;
10541 }
10542 Jim_SetResult(interp, listObjPtr);
10543 return JIM_OK;
10544 }
10545
10546 /* [linsert] */
10547 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10548 Jim_Obj *const *argv)
10549 {
10550 int index, len;
10551 Jim_Obj *listPtr;
10552
10553 if (argc < 4) {
10554 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10555 "?element ...?");
10556 return JIM_ERR;
10557 }
10558 listPtr = argv[1];
10559 if (Jim_IsShared(listPtr))
10560 listPtr = Jim_DuplicateObj(interp, listPtr);
10561 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10562 goto err;
10563 Jim_ListLength(interp, listPtr, &len);
10564 if (index >= len)
10565 index = len;
10566 else if (index < 0)
10567 index = len + index + 1;
10568 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10569 Jim_SetResult(interp, listPtr);
10570 return JIM_OK;
10571 err:
10572 if (listPtr != argv[1]) {
10573 Jim_FreeNewObj(interp, listPtr);
10574 }
10575 return JIM_ERR;
10576 }
10577
10578 /* [lset] */
10579 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10580 Jim_Obj *const *argv)
10581 {
10582 if (argc < 3) {
10583 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10584 return JIM_ERR;
10585 } else if (argc == 3) {
10586 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10587 return JIM_ERR;
10588 Jim_SetResult(interp, argv[2]);
10589 return JIM_OK;
10590 }
10591 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10592 == JIM_ERR) return JIM_ERR;
10593 return JIM_OK;
10594 }
10595
10596 /* [lsort] */
10597 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10598 {
10599 const char *options[] = {
10600 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10601 };
10602 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10603 Jim_Obj *resObj;
10604 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10605 int decreasing = 0;
10606
10607 if (argc < 2) {
10608 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10609 return JIM_ERR;
10610 }
10611 for (i = 1; i < (argc-1); i++) {
10612 int option;
10613
10614 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10615 != JIM_OK)
10616 return JIM_ERR;
10617 switch(option) {
10618 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10619 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10620 case OPT_INCREASING: decreasing = 0; break;
10621 case OPT_DECREASING: decreasing = 1; break;
10622 }
10623 }
10624 if (decreasing) {
10625 switch(lsortType) {
10626 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10627 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10628 }
10629 }
10630 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10631 ListSortElements(interp, resObj, lsortType);
10632 Jim_SetResult(interp, resObj);
10633 return JIM_OK;
10634 }
10635
10636 /* [append] */
10637 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10638 Jim_Obj *const *argv)
10639 {
10640 Jim_Obj *stringObjPtr;
10641 int shared, i;
10642
10643 if (argc < 2) {
10644 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10645 return JIM_ERR;
10646 }
10647 if (argc == 2) {
10648 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10649 if (!stringObjPtr) return JIM_ERR;
10650 } else {
10651 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10652 if (!stringObjPtr) {
10653 /* Create the string if it does not exists */
10654 stringObjPtr = Jim_NewEmptyStringObj(interp);
10655 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10656 != JIM_OK) {
10657 Jim_FreeNewObj(interp, stringObjPtr);
10658 return JIM_ERR;
10659 }
10660 }
10661 }
10662 shared = Jim_IsShared(stringObjPtr);
10663 if (shared)
10664 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10665 for (i = 2; i < argc; i++)
10666 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10667 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10668 if (shared)
10669 Jim_FreeNewObj(interp, stringObjPtr);
10670 return JIM_ERR;
10671 }
10672 Jim_SetResult(interp, stringObjPtr);
10673 return JIM_OK;
10674 }
10675
10676 /* [debug] */
10677 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10678 Jim_Obj *const *argv)
10679 {
10680 const char *options[] = {
10681 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10682 "exprbc",
10683 NULL
10684 };
10685 enum {
10686 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10687 OPT_EXPRLEN, OPT_EXPRBC
10688 };
10689 int option;
10690
10691 if (argc < 2) {
10692 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10693 return JIM_ERR;
10694 }
10695 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10696 JIM_ERRMSG) != JIM_OK)
10697 return JIM_ERR;
10698 if (option == OPT_REFCOUNT) {
10699 if (argc != 3) {
10700 Jim_WrongNumArgs(interp, 2, argv, "object");
10701 return JIM_ERR;
10702 }
10703 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10704 return JIM_OK;
10705 } else if (option == OPT_OBJCOUNT) {
10706 int freeobj = 0, liveobj = 0;
10707 char buf[256];
10708 Jim_Obj *objPtr;
10709
10710 if (argc != 2) {
10711 Jim_WrongNumArgs(interp, 2, argv, "");
10712 return JIM_ERR;
10713 }
10714 /* Count the number of free objects. */
10715 objPtr = interp->freeList;
10716 while (objPtr) {
10717 freeobj++;
10718 objPtr = objPtr->nextObjPtr;
10719 }
10720 /* Count the number of live objects. */
10721 objPtr = interp->liveList;
10722 while (objPtr) {
10723 liveobj++;
10724 objPtr = objPtr->nextObjPtr;
10725 }
10726 /* Set the result string and return. */
10727 sprintf(buf, "free %d used %d", freeobj, liveobj);
10728 Jim_SetResultString(interp, buf, -1);
10729 return JIM_OK;
10730 } else if (option == OPT_OBJECTS) {
10731 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10732 /* Count the number of live objects. */
10733 objPtr = interp->liveList;
10734 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10735 while (objPtr) {
10736 char buf[128];
10737 const char *type = objPtr->typePtr ?
10738 objPtr->typePtr->name : "";
10739 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10740 sprintf(buf, "%p", objPtr);
10741 Jim_ListAppendElement(interp, subListObjPtr,
10742 Jim_NewStringObj(interp, buf, -1));
10743 Jim_ListAppendElement(interp, subListObjPtr,
10744 Jim_NewStringObj(interp, type, -1));
10745 Jim_ListAppendElement(interp, subListObjPtr,
10746 Jim_NewIntObj(interp, objPtr->refCount));
10747 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10748 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10749 objPtr = objPtr->nextObjPtr;
10750 }
10751 Jim_SetResult(interp, listObjPtr);
10752 return JIM_OK;
10753 } else if (option == OPT_INVSTR) {
10754 Jim_Obj *objPtr;
10755
10756 if (argc != 3) {
10757 Jim_WrongNumArgs(interp, 2, argv, "object");
10758 return JIM_ERR;
10759 }
10760 objPtr = argv[2];
10761 if (objPtr->typePtr != NULL)
10762 Jim_InvalidateStringRep(objPtr);
10763 Jim_SetEmptyResult(interp);
10764 return JIM_OK;
10765 } else if (option == OPT_SCRIPTLEN) {
10766 ScriptObj *script;
10767 if (argc != 3) {
10768 Jim_WrongNumArgs(interp, 2, argv, "script");
10769 return JIM_ERR;
10770 }
10771 script = Jim_GetScript(interp, argv[2]);
10772 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10773 return JIM_OK;
10774 } else if (option == OPT_EXPRLEN) {
10775 ExprByteCode *expr;
10776 if (argc != 3) {
10777 Jim_WrongNumArgs(interp, 2, argv, "expression");
10778 return JIM_ERR;
10779 }
10780 expr = Jim_GetExpression(interp, argv[2]);
10781 if (expr == NULL)
10782 return JIM_ERR;
10783 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10784 return JIM_OK;
10785 } else if (option == OPT_EXPRBC) {
10786 Jim_Obj *objPtr;
10787 ExprByteCode *expr;
10788 int i;
10789
10790 if (argc != 3) {
10791 Jim_WrongNumArgs(interp, 2, argv, "expression");
10792 return JIM_ERR;
10793 }
10794 expr = Jim_GetExpression(interp, argv[2]);
10795 if (expr == NULL)
10796 return JIM_ERR;
10797 objPtr = Jim_NewListObj(interp, NULL, 0);
10798 for (i = 0; i < expr->len; i++) {
10799 const char *type;
10800 Jim_ExprOperator *op;
10801
10802 switch(expr->opcode[i]) {
10803 case JIM_EXPROP_NUMBER: type = "number"; break;
10804 case JIM_EXPROP_COMMAND: type = "command"; break;
10805 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10806 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10807 case JIM_EXPROP_SUBST: type = "subst"; break;
10808 case JIM_EXPROP_STRING: type = "string"; break;
10809 default:
10810 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10811 if (op == NULL) {
10812 type = "private";
10813 } else {
10814 type = "operator";
10815 }
10816 break;
10817 }
10818 Jim_ListAppendElement(interp, objPtr,
10819 Jim_NewStringObj(interp, type, -1));
10820 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10821 }
10822 Jim_SetResult(interp, objPtr);
10823 return JIM_OK;
10824 } else {
10825 Jim_SetResultString(interp,
10826 "bad option. Valid options are refcount, "
10827 "objcount, objects, invstr", -1);
10828 return JIM_ERR;
10829 }
10830 return JIM_OK; /* unreached */
10831 }
10832
10833 /* [eval] */
10834 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10835 Jim_Obj *const *argv)
10836 {
10837 if (argc == 2) {
10838 return Jim_EvalObj(interp, argv[1]);
10839 } else if (argc > 2) {
10840 Jim_Obj *objPtr;
10841 int retcode;
10842
10843 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10844 Jim_IncrRefCount(objPtr);
10845 retcode = Jim_EvalObj(interp, objPtr);
10846 Jim_DecrRefCount(interp, objPtr);
10847 return retcode;
10848 } else {
10849 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10850 return JIM_ERR;
10851 }
10852 }
10853
10854 /* [uplevel] */
10855 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10856 Jim_Obj *const *argv)
10857 {
10858 if (argc >= 2) {
10859 int retcode, newLevel, oldLevel;
10860 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10861 Jim_Obj *objPtr;
10862 const char *str;
10863
10864 /* Save the old callframe pointer */
10865 savedCallFrame = interp->framePtr;
10866
10867 /* Lookup the target frame pointer */
10868 str = Jim_GetString(argv[1], NULL);
10869 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10870 {
10871 if (Jim_GetCallFrameByLevel(interp, argv[1],
10872 &targetCallFrame,
10873 &newLevel) != JIM_OK)
10874 return JIM_ERR;
10875 argc--;
10876 argv++;
10877 } else {
10878 if (Jim_GetCallFrameByLevel(interp, NULL,
10879 &targetCallFrame,
10880 &newLevel) != JIM_OK)
10881 return JIM_ERR;
10882 }
10883 if (argc < 2) {
10884 argc++;
10885 argv--;
10886 Jim_WrongNumArgs(interp, 1, argv,
10887 "?level? command ?arg ...?");
10888 return JIM_ERR;
10889 }
10890 /* Eval the code in the target callframe. */
10891 interp->framePtr = targetCallFrame;
10892 oldLevel = interp->numLevels;
10893 interp->numLevels = newLevel;
10894 if (argc == 2) {
10895 retcode = Jim_EvalObj(interp, argv[1]);
10896 } else {
10897 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10898 Jim_IncrRefCount(objPtr);
10899 retcode = Jim_EvalObj(interp, objPtr);
10900 Jim_DecrRefCount(interp, objPtr);
10901 }
10902 interp->numLevels = oldLevel;
10903 interp->framePtr = savedCallFrame;
10904 return retcode;
10905 } else {
10906 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10907 return JIM_ERR;
10908 }
10909 }
10910
10911 /* [expr] */
10912 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10913 Jim_Obj *const *argv)
10914 {
10915 Jim_Obj *exprResultPtr;
10916 int retcode;
10917
10918 if (argc == 2) {
10919 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10920 } else if (argc > 2) {
10921 Jim_Obj *objPtr;
10922
10923 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10924 Jim_IncrRefCount(objPtr);
10925 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10926 Jim_DecrRefCount(interp, objPtr);
10927 } else {
10928 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10929 return JIM_ERR;
10930 }
10931 if (retcode != JIM_OK) return retcode;
10932 Jim_SetResult(interp, exprResultPtr);
10933 Jim_DecrRefCount(interp, exprResultPtr);
10934 return JIM_OK;
10935 }
10936
10937 /* [break] */
10938 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10939 Jim_Obj *const *argv)
10940 {
10941 if (argc != 1) {
10942 Jim_WrongNumArgs(interp, 1, argv, "");
10943 return JIM_ERR;
10944 }
10945 return JIM_BREAK;
10946 }
10947
10948 /* [continue] */
10949 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10950 Jim_Obj *const *argv)
10951 {
10952 if (argc != 1) {
10953 Jim_WrongNumArgs(interp, 1, argv, "");
10954 return JIM_ERR;
10955 }
10956 return JIM_CONTINUE;
10957 }
10958
10959 /* [return] */
10960 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10961 Jim_Obj *const *argv)
10962 {
10963 if (argc == 1) {
10964 return JIM_RETURN;
10965 } else if (argc == 2) {
10966 Jim_SetResult(interp, argv[1]);
10967 interp->returnCode = JIM_OK;
10968 return JIM_RETURN;
10969 } else if (argc == 3 || argc == 4) {
10970 int returnCode;
10971 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10972 return JIM_ERR;
10973 interp->returnCode = returnCode;
10974 if (argc == 4)
10975 Jim_SetResult(interp, argv[3]);
10976 return JIM_RETURN;
10977 } else {
10978 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10979 return JIM_ERR;
10980 }
10981 return JIM_RETURN; /* unreached */
10982 }
10983
10984 /* [tailcall] */
10985 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10986 Jim_Obj *const *argv)
10987 {
10988 Jim_Obj *objPtr;
10989
10990 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10991 Jim_SetResult(interp, objPtr);
10992 return JIM_EVAL;
10993 }
10994
10995 /* [proc] */
10996 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10997 Jim_Obj *const *argv)
10998 {
10999 int argListLen;
11000 int arityMin, arityMax;
11001
11002 if (argc != 4 && argc != 5) {
11003 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11004 return JIM_ERR;
11005 }
11006 Jim_ListLength(interp, argv[2], &argListLen);
11007 arityMin = arityMax = argListLen+1;
11008
11009 if (argListLen) {
11010 const char *str;
11011 int len;
11012 Jim_Obj *argPtr;
11013
11014 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11015 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11016 str = Jim_GetString(argPtr, &len);
11017 if (len == 4 && memcmp(str, "args", 4) == 0) {
11018 arityMin--;
11019 arityMax = -1;
11020 }
11021
11022 /* Check for default arguments and reduce arityMin if necessary */
11023 while (arityMin > 1) {
11024 int len;
11025 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11026 Jim_ListLength(interp, argPtr, &len);
11027 if (len != 2) {
11028 /* No default argument */
11029 break;
11030 }
11031 arityMin--;
11032 }
11033 }
11034 if (argc == 4) {
11035 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11036 argv[2], NULL, argv[3], arityMin, arityMax);
11037 } else {
11038 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11039 argv[2], argv[3], argv[4], arityMin, arityMax);
11040 }
11041 }
11042
11043 /* [concat] */
11044 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11045 Jim_Obj *const *argv)
11046 {
11047 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11048 return JIM_OK;
11049 }
11050
11051 /* [upvar] */
11052 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11053 Jim_Obj *const *argv)
11054 {
11055 const char *str;
11056 int i;
11057 Jim_CallFrame *targetCallFrame;
11058
11059 /* Lookup the target frame pointer */
11060 str = Jim_GetString(argv[1], NULL);
11061 if (argc > 3 &&
11062 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11063 {
11064 if (Jim_GetCallFrameByLevel(interp, argv[1],
11065 &targetCallFrame, NULL) != JIM_OK)
11066 return JIM_ERR;
11067 argc--;
11068 argv++;
11069 } else {
11070 if (Jim_GetCallFrameByLevel(interp, NULL,
11071 &targetCallFrame, NULL) != JIM_OK)
11072 return JIM_ERR;
11073 }
11074 /* Check for arity */
11075 if (argc < 3 || ((argc-1)%2) != 0) {
11076 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11077 return JIM_ERR;
11078 }
11079 /* Now... for every other/local couple: */
11080 for (i = 1; i < argc; i += 2) {
11081 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11082 targetCallFrame) != JIM_OK) return JIM_ERR;
11083 }
11084 return JIM_OK;
11085 }
11086
11087 /* [global] */
11088 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11089 Jim_Obj *const *argv)
11090 {
11091 int i;
11092
11093 if (argc < 2) {
11094 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11095 return JIM_ERR;
11096 }
11097 /* Link every var to the toplevel having the same name */
11098 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11099 for (i = 1; i < argc; i++) {
11100 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11101 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11102 }
11103 return JIM_OK;
11104 }
11105
11106 /* does the [string map] operation. On error NULL is returned,
11107 * otherwise a new string object with the result, having refcount = 0,
11108 * is returned. */
11109 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11110 Jim_Obj *objPtr, int nocase)
11111 {
11112 int numMaps;
11113 const char **key, *str, *noMatchStart = NULL;
11114 Jim_Obj **value;
11115 int *keyLen, strLen, i;
11116 Jim_Obj *resultObjPtr;
11117
11118 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11119 if (numMaps % 2) {
11120 Jim_SetResultString(interp,
11121 "list must contain an even number of elements", -1);
11122 return NULL;
11123 }
11124 /* Initialization */
11125 numMaps /= 2;
11126 key = Jim_Alloc(sizeof(char*)*numMaps);
11127 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11128 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11129 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11130 for (i = 0; i < numMaps; i++) {
11131 Jim_Obj *eleObjPtr;
11132
11133 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11134 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11135 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11136 value[i] = eleObjPtr;
11137 }
11138 str = Jim_GetString(objPtr, &strLen);
11139 /* Map it */
11140 while(strLen) {
11141 for (i = 0; i < numMaps; i++) {
11142 if (strLen >= keyLen[i] && keyLen[i]) {
11143 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11144 nocase))
11145 {
11146 if (noMatchStart) {
11147 Jim_AppendString(interp, resultObjPtr,
11148 noMatchStart, str-noMatchStart);
11149 noMatchStart = NULL;
11150 }
11151 Jim_AppendObj(interp, resultObjPtr, value[i]);
11152 str += keyLen[i];
11153 strLen -= keyLen[i];
11154 break;
11155 }
11156 }
11157 }
11158 if (i == numMaps) { /* no match */
11159 if (noMatchStart == NULL)
11160 noMatchStart = str;
11161 str ++;
11162 strLen --;
11163 }
11164 }
11165 if (noMatchStart) {
11166 Jim_AppendString(interp, resultObjPtr,
11167 noMatchStart, str-noMatchStart);
11168 }
11169 Jim_Free((void*)key);
11170 Jim_Free(keyLen);
11171 Jim_Free(value);
11172 return resultObjPtr;
11173 }
11174
11175 /* [string] */
11176 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11177 Jim_Obj *const *argv)
11178 {
11179 int option;
11180 const char *options[] = {
11181 "length", "compare", "match", "equal", "range", "map", "repeat",
11182 "index", "first", "tolower", "toupper", NULL
11183 };
11184 enum {
11185 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11186 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11187 };
11188
11189 if (argc < 2) {
11190 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11191 return JIM_ERR;
11192 }
11193 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11194 JIM_ERRMSG) != JIM_OK)
11195 return JIM_ERR;
11196
11197 if (option == OPT_LENGTH) {
11198 int len;
11199
11200 if (argc != 3) {
11201 Jim_WrongNumArgs(interp, 2, argv, "string");
11202 return JIM_ERR;
11203 }
11204 Jim_GetString(argv[2], &len);
11205 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11206 return JIM_OK;
11207 } else if (option == OPT_COMPARE) {
11208 int nocase = 0;
11209 if ((argc != 4 && argc != 5) ||
11210 (argc == 5 && Jim_CompareStringImmediate(interp,
11211 argv[2], "-nocase") == 0)) {
11212 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11213 return JIM_ERR;
11214 }
11215 if (argc == 5) {
11216 nocase = 1;
11217 argv++;
11218 }
11219 Jim_SetResult(interp, Jim_NewIntObj(interp,
11220 Jim_StringCompareObj(argv[2],
11221 argv[3], nocase)));
11222 return JIM_OK;
11223 } else if (option == OPT_MATCH) {
11224 int nocase = 0;
11225 if ((argc != 4 && argc != 5) ||
11226 (argc == 5 && Jim_CompareStringImmediate(interp,
11227 argv[2], "-nocase") == 0)) {
11228 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11229 "string");
11230 return JIM_ERR;
11231 }
11232 if (argc == 5) {
11233 nocase = 1;
11234 argv++;
11235 }
11236 Jim_SetResult(interp,
11237 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11238 argv[3], nocase)));
11239 return JIM_OK;
11240 } else if (option == OPT_EQUAL) {
11241 if (argc != 4) {
11242 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11243 return JIM_ERR;
11244 }
11245 Jim_SetResult(interp,
11246 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11247 argv[3], 0)));
11248 return JIM_OK;
11249 } else if (option == OPT_RANGE) {
11250 Jim_Obj *objPtr;
11251
11252 if (argc != 5) {
11253 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11254 return JIM_ERR;
11255 }
11256 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11257 if (objPtr == NULL)
11258 return JIM_ERR;
11259 Jim_SetResult(interp, objPtr);
11260 return JIM_OK;
11261 } else if (option == OPT_MAP) {
11262 int nocase = 0;
11263 Jim_Obj *objPtr;
11264
11265 if ((argc != 4 && argc != 5) ||
11266 (argc == 5 && Jim_CompareStringImmediate(interp,
11267 argv[2], "-nocase") == 0)) {
11268 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11269 "string");
11270 return JIM_ERR;
11271 }
11272 if (argc == 5) {
11273 nocase = 1;
11274 argv++;
11275 }
11276 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11277 if (objPtr == NULL)
11278 return JIM_ERR;
11279 Jim_SetResult(interp, objPtr);
11280 return JIM_OK;
11281 } else if (option == OPT_REPEAT) {
11282 Jim_Obj *objPtr;
11283 jim_wide count;
11284
11285 if (argc != 4) {
11286 Jim_WrongNumArgs(interp, 2, argv, "string count");
11287 return JIM_ERR;
11288 }
11289 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11290 return JIM_ERR;
11291 objPtr = Jim_NewStringObj(interp, "", 0);
11292 while (count--) {
11293 Jim_AppendObj(interp, objPtr, argv[2]);
11294 }
11295 Jim_SetResult(interp, objPtr);
11296 return JIM_OK;
11297 } else if (option == OPT_INDEX) {
11298 int index, len;
11299 const char *str;
11300
11301 if (argc != 4) {
11302 Jim_WrongNumArgs(interp, 2, argv, "string index");
11303 return JIM_ERR;
11304 }
11305 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11306 return JIM_ERR;
11307 str = Jim_GetString(argv[2], &len);
11308 if (index != INT_MIN && index != INT_MAX)
11309 index = JimRelToAbsIndex(len, index);
11310 if (index < 0 || index >= len) {
11311 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11312 return JIM_OK;
11313 } else {
11314 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11315 return JIM_OK;
11316 }
11317 } else if (option == OPT_FIRST) {
11318 int index = 0, l1, l2;
11319 const char *s1, *s2;
11320
11321 if (argc != 4 && argc != 5) {
11322 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11323 return JIM_ERR;
11324 }
11325 s1 = Jim_GetString(argv[2], &l1);
11326 s2 = Jim_GetString(argv[3], &l2);
11327 if (argc == 5) {
11328 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11329 return JIM_ERR;
11330 index = JimRelToAbsIndex(l2, index);
11331 }
11332 Jim_SetResult(interp, Jim_NewIntObj(interp,
11333 JimStringFirst(s1, l1, s2, l2, index)));
11334 return JIM_OK;
11335 } else if (option == OPT_TOLOWER) {
11336 if (argc != 3) {
11337 Jim_WrongNumArgs(interp, 2, argv, "string");
11338 return JIM_ERR;
11339 }
11340 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11341 } else if (option == OPT_TOUPPER) {
11342 if (argc != 3) {
11343 Jim_WrongNumArgs(interp, 2, argv, "string");
11344 return JIM_ERR;
11345 }
11346 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11347 }
11348 return JIM_OK;
11349 }
11350
11351 /* [time] */
11352 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11353 Jim_Obj *const *argv)
11354 {
11355 long i, count = 1;
11356 jim_wide start, elapsed;
11357 char buf [256];
11358 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11359
11360 if (argc < 2) {
11361 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11362 return JIM_ERR;
11363 }
11364 if (argc == 3) {
11365 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11366 return JIM_ERR;
11367 }
11368 if (count < 0)
11369 return JIM_OK;
11370 i = count;
11371 start = JimClock();
11372 while (i-- > 0) {
11373 int retval;
11374
11375 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11376 return retval;
11377 }
11378 elapsed = JimClock() - start;
11379 sprintf(buf, fmt, elapsed/count);
11380 Jim_SetResultString(interp, buf, -1);
11381 return JIM_OK;
11382 }
11383
11384 /* [exit] */
11385 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11386 Jim_Obj *const *argv)
11387 {
11388 long exitCode = 0;
11389
11390 if (argc > 2) {
11391 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11392 return JIM_ERR;
11393 }
11394 if (argc == 2) {
11395 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11396 return JIM_ERR;
11397 }
11398 interp->exitCode = exitCode;
11399 return JIM_EXIT;
11400 }
11401
11402 /* [catch] */
11403 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11404 Jim_Obj *const *argv)
11405 {
11406 int exitCode = 0;
11407
11408 if (argc != 2 && argc != 3) {
11409 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11410 return JIM_ERR;
11411 }
11412 exitCode = Jim_EvalObj(interp, argv[1]);
11413 if (argc == 3) {
11414 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11415 != JIM_OK)
11416 return JIM_ERR;
11417 }
11418 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11419 return JIM_OK;
11420 }
11421
11422 /* [ref] */
11423 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11424 Jim_Obj *const *argv)
11425 {
11426 if (argc != 3 && argc != 4) {
11427 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11428 return JIM_ERR;
11429 }
11430 if (argc == 3) {
11431 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11432 } else {
11433 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11434 argv[3]));
11435 }
11436 return JIM_OK;
11437 }
11438
11439 /* [getref] */
11440 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11441 Jim_Obj *const *argv)
11442 {
11443 Jim_Reference *refPtr;
11444
11445 if (argc != 2) {
11446 Jim_WrongNumArgs(interp, 1, argv, "reference");
11447 return JIM_ERR;
11448 }
11449 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11450 return JIM_ERR;
11451 Jim_SetResult(interp, refPtr->objPtr);
11452 return JIM_OK;
11453 }
11454
11455 /* [setref] */
11456 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11457 Jim_Obj *const *argv)
11458 {
11459 Jim_Reference *refPtr;
11460
11461 if (argc != 3) {
11462 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11463 return JIM_ERR;
11464 }
11465 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11466 return JIM_ERR;
11467 Jim_IncrRefCount(argv[2]);
11468 Jim_DecrRefCount(interp, refPtr->objPtr);
11469 refPtr->objPtr = argv[2];
11470 Jim_SetResult(interp, argv[2]);
11471 return JIM_OK;
11472 }
11473
11474 /* [collect] */
11475 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11476 Jim_Obj *const *argv)
11477 {
11478 if (argc != 1) {
11479 Jim_WrongNumArgs(interp, 1, argv, "");
11480 return JIM_ERR;
11481 }
11482 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11483 return JIM_OK;
11484 }
11485
11486 /* [finalize] reference ?newValue? */
11487 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11488 Jim_Obj *const *argv)
11489 {
11490 if (argc != 2 && argc != 3) {
11491 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11492 return JIM_ERR;
11493 }
11494 if (argc == 2) {
11495 Jim_Obj *cmdNamePtr;
11496
11497 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11498 return JIM_ERR;
11499 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11500 Jim_SetResult(interp, cmdNamePtr);
11501 } else {
11502 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11503 return JIM_ERR;
11504 Jim_SetResult(interp, argv[2]);
11505 }
11506 return JIM_OK;
11507 }
11508
11509 /* TODO */
11510 /* [info references] (list of all the references/finalizers) */
11511
11512 /* [rename] */
11513 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11514 Jim_Obj *const *argv)
11515 {
11516 const char *oldName, *newName;
11517
11518 if (argc != 3) {
11519 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11520 return JIM_ERR;
11521 }
11522 oldName = Jim_GetString(argv[1], NULL);
11523 newName = Jim_GetString(argv[2], NULL);
11524 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11525 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11526 Jim_AppendStrings(interp, Jim_GetResult(interp),
11527 "can't rename \"", oldName, "\": ",
11528 "command doesn't exist", NULL);
11529 return JIM_ERR;
11530 }
11531 return JIM_OK;
11532 }
11533
11534 /* [dict] */
11535 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11536 Jim_Obj *const *argv)
11537 {
11538 int option;
11539 const char *options[] = {
11540 "create", "get", "set", "unset", "exists", NULL
11541 };
11542 enum {
11543 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11544 };
11545
11546 if (argc < 2) {
11547 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11548 return JIM_ERR;
11549 }
11550
11551 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11552 JIM_ERRMSG) != JIM_OK)
11553 return JIM_ERR;
11554
11555 if (option == OPT_CREATE) {
11556 Jim_Obj *objPtr;
11557
11558 if (argc % 2) {
11559 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11560 return JIM_ERR;
11561 }
11562 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11563 Jim_SetResult(interp, objPtr);
11564 return JIM_OK;
11565 } else if (option == OPT_GET) {
11566 Jim_Obj *objPtr;
11567
11568 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11569 JIM_ERRMSG) != JIM_OK)
11570 return JIM_ERR;
11571 Jim_SetResult(interp, objPtr);
11572 return JIM_OK;
11573 } else if (option == OPT_SET) {
11574 if (argc < 5) {
11575 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11576 return JIM_ERR;
11577 }
11578 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11579 argv[argc-1]);
11580 } else if (option == OPT_UNSET) {
11581 if (argc < 4) {
11582 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11583 return JIM_ERR;
11584 }
11585 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11586 NULL);
11587 } else if (option == OPT_EXIST) {
11588 Jim_Obj *objPtr;
11589 int exists;
11590
11591 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11592 JIM_ERRMSG) == JIM_OK)
11593 exists = 1;
11594 else
11595 exists = 0;
11596 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11597 return JIM_OK;
11598 } else {
11599 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11600 Jim_AppendStrings(interp, Jim_GetResult(interp),
11601 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11602 " must be create, get, set", NULL);
11603 return JIM_ERR;
11604 }
11605 return JIM_OK;
11606 }
11607
11608 /* [load] */
11609 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11610 Jim_Obj *const *argv)
11611 {
11612 if (argc < 2) {
11613 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11614 return JIM_ERR;
11615 }
11616 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11617 }
11618
11619 /* [subst] */
11620 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11621 Jim_Obj *const *argv)
11622 {
11623 int i, flags = 0;
11624 Jim_Obj *objPtr;
11625
11626 if (argc < 2) {
11627 Jim_WrongNumArgs(interp, 1, argv,
11628 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11629 return JIM_ERR;
11630 }
11631 i = argc-2;
11632 while(i--) {
11633 if (Jim_CompareStringImmediate(interp, argv[i+1],
11634 "-nobackslashes"))
11635 flags |= JIM_SUBST_NOESC;
11636 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11637 "-novariables"))
11638 flags |= JIM_SUBST_NOVAR;
11639 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11640 "-nocommands"))
11641 flags |= JIM_SUBST_NOCMD;
11642 else {
11643 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11644 Jim_AppendStrings(interp, Jim_GetResult(interp),
11645 "bad option \"", Jim_GetString(argv[i+1], NULL),
11646 "\": must be -nobackslashes, -nocommands, or "
11647 "-novariables", NULL);
11648 return JIM_ERR;
11649 }
11650 }
11651 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11652 return JIM_ERR;
11653 Jim_SetResult(interp, objPtr);
11654 return JIM_OK;
11655 }
11656
11657 /* [info] */
11658 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11659 Jim_Obj *const *argv)
11660 {
11661 int cmd, result = JIM_OK;
11662 static const char *commands[] = {
11663 "body", "commands", "exists", "globals", "level", "locals",
11664 "vars", "version", "complete", "args", "hostname", NULL
11665 };
11666 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11667 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11668
11669 if (argc < 2) {
11670 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11671 return JIM_ERR;
11672 }
11673 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11674 != JIM_OK) {
11675 return JIM_ERR;
11676 }
11677
11678 if (cmd == INFO_COMMANDS) {
11679 if (argc != 2 && argc != 3) {
11680 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11681 return JIM_ERR;
11682 }
11683 if (argc == 3)
11684 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11685 else
11686 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11687 } else if (cmd == INFO_EXISTS) {
11688 Jim_Obj *exists;
11689 if (argc != 3) {
11690 Jim_WrongNumArgs(interp, 2, argv, "varName");
11691 return JIM_ERR;
11692 }
11693 exists = Jim_GetVariable(interp, argv[2], 0);
11694 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11695 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11696 int mode;
11697 switch (cmd) {
11698 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11699 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11700 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11701 default: mode = 0; /* avoid warning */; break;
11702 }
11703 if (argc != 2 && argc != 3) {
11704 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11705 return JIM_ERR;
11706 }
11707 if (argc == 3)
11708 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11709 else
11710 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11711 } else if (cmd == INFO_LEVEL) {
11712 Jim_Obj *objPtr;
11713 switch (argc) {
11714 case 2:
11715 Jim_SetResult(interp,
11716 Jim_NewIntObj(interp, interp->numLevels));
11717 break;
11718 case 3:
11719 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11720 return JIM_ERR;
11721 Jim_SetResult(interp, objPtr);
11722 break;
11723 default:
11724 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11725 return JIM_ERR;
11726 }
11727 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11728 Jim_Cmd *cmdPtr;
11729
11730 if (argc != 3) {
11731 Jim_WrongNumArgs(interp, 2, argv, "procname");
11732 return JIM_ERR;
11733 }
11734 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11735 return JIM_ERR;
11736 if (cmdPtr->cmdProc != NULL) {
11737 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11738 Jim_AppendStrings(interp, Jim_GetResult(interp),
11739 "command \"", Jim_GetString(argv[2], NULL),
11740 "\" is not a procedure", NULL);
11741 return JIM_ERR;
11742 }
11743 if (cmd == INFO_BODY)
11744 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11745 else
11746 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11747 } else if (cmd == INFO_VERSION) {
11748 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11749 sprintf(buf, "%d.%d",
11750 JIM_VERSION / 100, JIM_VERSION % 100);
11751 Jim_SetResultString(interp, buf, -1);
11752 } else if (cmd == INFO_COMPLETE) {
11753 const char *s;
11754 int len;
11755
11756 if (argc != 3) {
11757 Jim_WrongNumArgs(interp, 2, argv, "script");
11758 return JIM_ERR;
11759 }
11760 s = Jim_GetString(argv[2], &len);
11761 Jim_SetResult(interp,
11762 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11763 } else if (cmd == INFO_HOSTNAME) {
11764 /* Redirect to os.hostname if it exists */
11765 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11766 result = Jim_EvalObjVector(interp, 1, &command);
11767 }
11768 return result;
11769 }
11770
11771 /* [split] */
11772 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11773 Jim_Obj *const *argv)
11774 {
11775 const char *str, *splitChars, *noMatchStart;
11776 int splitLen, strLen, i;
11777 Jim_Obj *resObjPtr;
11778
11779 if (argc != 2 && argc != 3) {
11780 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11781 return JIM_ERR;
11782 }
11783 /* Init */
11784 if (argc == 2) {
11785 splitChars = " \n\t\r";
11786 splitLen = 4;
11787 } else {
11788 splitChars = Jim_GetString(argv[2], &splitLen);
11789 }
11790 str = Jim_GetString(argv[1], &strLen);
11791 if (!strLen) return JIM_OK;
11792 noMatchStart = str;
11793 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11794 /* Split */
11795 if (splitLen) {
11796 while (strLen) {
11797 for (i = 0; i < splitLen; i++) {
11798 if (*str == splitChars[i]) {
11799 Jim_Obj *objPtr;
11800
11801 objPtr = Jim_NewStringObj(interp, noMatchStart,
11802 (str-noMatchStart));
11803 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11804 noMatchStart = str+1;
11805 break;
11806 }
11807 }
11808 str ++;
11809 strLen --;
11810 }
11811 Jim_ListAppendElement(interp, resObjPtr,
11812 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11813 } else {
11814 /* This handles the special case of splitchars eq {}. This
11815 * is trivial but we want to perform object sharing as Tcl does. */
11816 Jim_Obj *objCache[256];
11817 const unsigned char *u = (unsigned char*) str;
11818 memset(objCache, 0, sizeof(objCache));
11819 for (i = 0; i < strLen; i++) {
11820 int c = u[i];
11821
11822 if (objCache[c] == NULL)
11823 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11824 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11825 }
11826 }
11827 Jim_SetResult(interp, resObjPtr);
11828 return JIM_OK;
11829 }
11830
11831 /* [join] */
11832 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11833 Jim_Obj *const *argv)
11834 {
11835 const char *joinStr;
11836 int joinStrLen, i, listLen;
11837 Jim_Obj *resObjPtr;
11838
11839 if (argc != 2 && argc != 3) {
11840 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11841 return JIM_ERR;
11842 }
11843 /* Init */
11844 if (argc == 2) {
11845 joinStr = " ";
11846 joinStrLen = 1;
11847 } else {
11848 joinStr = Jim_GetString(argv[2], &joinStrLen);
11849 }
11850 Jim_ListLength(interp, argv[1], &listLen);
11851 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11852 /* Split */
11853 for (i = 0; i < listLen; i++) {
11854 Jim_Obj *objPtr;
11855
11856 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11857 Jim_AppendObj(interp, resObjPtr, objPtr);
11858 if (i+1 != listLen) {
11859 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11860 }
11861 }
11862 Jim_SetResult(interp, resObjPtr);
11863 return JIM_OK;
11864 }
11865
11866 /* [format] */
11867 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11868 Jim_Obj *const *argv)
11869 {
11870 Jim_Obj *objPtr;
11871
11872 if (argc < 2) {
11873 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11874 return JIM_ERR;
11875 }
11876 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11877 if (objPtr == NULL)
11878 return JIM_ERR;
11879 Jim_SetResult(interp, objPtr);
11880 return JIM_OK;
11881 }
11882
11883 /* [scan] */
11884 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11885 Jim_Obj *const *argv)
11886 {
11887 Jim_Obj *listPtr, **outVec;
11888 int outc, i, count = 0;
11889
11890 if (argc < 3) {
11891 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11892 return JIM_ERR;
11893 }
11894 if (argv[2]->typePtr != &scanFmtStringObjType)
11895 SetScanFmtFromAny(interp, argv[2]);
11896 if (FormatGetError(argv[2]) != 0) {
11897 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11898 return JIM_ERR;
11899 }
11900 if (argc > 3) {
11901 int maxPos = FormatGetMaxPos(argv[2]);
11902 int count = FormatGetCnvCount(argv[2]);
11903 if (maxPos > argc-3) {
11904 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11905 return JIM_ERR;
11906 } else if (count != 0 && count < argc-3) {
11907 Jim_SetResultString(interp, "variable is not assigned by any "
11908 "conversion specifiers", -1);
11909 return JIM_ERR;
11910 } else if (count > argc-3) {
11911 Jim_SetResultString(interp, "different numbers of variable names and "
11912 "field specifiers", -1);
11913 return JIM_ERR;
11914 }
11915 }
11916 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11917 if (listPtr == 0)
11918 return JIM_ERR;
11919 if (argc > 3) {
11920 int len = 0;
11921 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11922 Jim_ListLength(interp, listPtr, &len);
11923 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11924 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11925 return JIM_OK;
11926 }
11927 JimListGetElements(interp, listPtr, &outc, &outVec);
11928 for (i = 0; i < outc; ++i) {
11929 if (Jim_Length(outVec[i]) > 0) {
11930 ++count;
11931 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11932 goto err;
11933 }
11934 }
11935 Jim_FreeNewObj(interp, listPtr);
11936 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11937 } else {
11938 if (listPtr == (Jim_Obj*)EOF) {
11939 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11940 return JIM_OK;
11941 }
11942 Jim_SetResult(interp, listPtr);
11943 }
11944 return JIM_OK;
11945 err:
11946 Jim_FreeNewObj(interp, listPtr);
11947 return JIM_ERR;
11948 }
11949
11950 /* [error] */
11951 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11952 Jim_Obj *const *argv)
11953 {
11954 if (argc != 2) {
11955 Jim_WrongNumArgs(interp, 1, argv, "message");
11956 return JIM_ERR;
11957 }
11958 Jim_SetResult(interp, argv[1]);
11959 return JIM_ERR;
11960 }
11961
11962 /* [lrange] */
11963 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11964 Jim_Obj *const *argv)
11965 {
11966 Jim_Obj *objPtr;
11967
11968 if (argc != 4) {
11969 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11970 return JIM_ERR;
11971 }
11972 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11973 return JIM_ERR;
11974 Jim_SetResult(interp, objPtr);
11975 return JIM_OK;
11976 }
11977
11978 /* [env] */
11979 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11980 Jim_Obj *const *argv)
11981 {
11982 const char *key;
11983 char *val;
11984
11985 if (argc == 1) {
11986
11987 #if !defined(HAVE_UNISTD_H) || !defined(__GNU_LIBRARY__)
11988 extern char **environ;
11989 #endif
11990
11991 int i;
11992 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11993
11994 for (i = 0; environ[i]; i++) {
11995 const char *equals = strchr(environ[i], '=');
11996 if (equals) {
11997 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11998 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11999 }
12000 }
12001
12002 Jim_SetResult(interp, listObjPtr);
12003 return JIM_OK;
12004 }
12005
12006 if (argc != 2) {
12007 Jim_WrongNumArgs(interp, 1, argv, "varName");
12008 return JIM_ERR;
12009 }
12010 key = Jim_GetString(argv[1], NULL);
12011 val = getenv(key);
12012 if (val == NULL) {
12013 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12014 Jim_AppendStrings(interp, Jim_GetResult(interp),
12015 "environment variable \"",
12016 key, "\" does not exist", NULL);
12017 return JIM_ERR;
12018 }
12019 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12020 return JIM_OK;
12021 }
12022
12023 /* [source] */
12024 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12025 Jim_Obj *const *argv)
12026 {
12027 int retval;
12028
12029 if (argc != 2) {
12030 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12031 return JIM_ERR;
12032 }
12033 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12034 if (retval == JIM_ERR) {
12035 return JIM_ERR_ADDSTACK;
12036 }
12037 if (retval == JIM_RETURN)
12038 return JIM_OK;
12039 return retval;
12040 }
12041
12042 /* [lreverse] */
12043 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12044 Jim_Obj *const *argv)
12045 {
12046 Jim_Obj *revObjPtr, **ele;
12047 int len;
12048
12049 if (argc != 2) {
12050 Jim_WrongNumArgs(interp, 1, argv, "list");
12051 return JIM_ERR;
12052 }
12053 JimListGetElements(interp, argv[1], &len, &ele);
12054 len--;
12055 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12056 while (len >= 0)
12057 ListAppendElement(revObjPtr, ele[len--]);
12058 Jim_SetResult(interp, revObjPtr);
12059 return JIM_OK;
12060 }
12061
12062 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12063 {
12064 jim_wide len;
12065
12066 if (step == 0) return -1;
12067 if (start == end) return 0;
12068 else if (step > 0 && start > end) return -1;
12069 else if (step < 0 && end > start) return -1;
12070 len = end-start;
12071 if (len < 0) len = -len; /* abs(len) */
12072 if (step < 0) step = -step; /* abs(step) */
12073 len = 1 + ((len-1)/step);
12074 /* We can truncate safely to INT_MAX, the range command
12075 * will always return an error for a such long range
12076 * because Tcl lists can't be so long. */
12077 if (len > INT_MAX) len = INT_MAX;
12078 return (int)((len < 0) ? -1 : len);
12079 }
12080
12081 /* [range] */
12082 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12083 Jim_Obj *const *argv)
12084 {
12085 jim_wide start = 0, end, step = 1;
12086 int len, i;
12087 Jim_Obj *objPtr;
12088
12089 if (argc < 2 || argc > 4) {
12090 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12091 return JIM_ERR;
12092 }
12093 if (argc == 2) {
12094 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12095 return JIM_ERR;
12096 } else {
12097 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12098 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12099 return JIM_ERR;
12100 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12101 return JIM_ERR;
12102 }
12103 if ((len = JimRangeLen(start, end, step)) == -1) {
12104 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12105 return JIM_ERR;
12106 }
12107 objPtr = Jim_NewListObj(interp, NULL, 0);
12108 for (i = 0; i < len; i++)
12109 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12110 Jim_SetResult(interp, objPtr);
12111 return JIM_OK;
12112 }
12113
12114 /* [rand] */
12115 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12116 Jim_Obj *const *argv)
12117 {
12118 jim_wide min = 0, max, len, maxMul;
12119
12120 if (argc < 1 || argc > 3) {
12121 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12122 return JIM_ERR;
12123 }
12124 if (argc == 1) {
12125 max = JIM_WIDE_MAX;
12126 } else if (argc == 2) {
12127 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12128 return JIM_ERR;
12129 } else if (argc == 3) {
12130 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12131 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12132 return JIM_ERR;
12133 }
12134 len = max-min;
12135 if (len < 0) {
12136 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12137 return JIM_ERR;
12138 }
12139 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12140 while (1) {
12141 jim_wide r;
12142
12143 JimRandomBytes(interp, &r, sizeof(jim_wide));
12144 if (r < 0 || r >= maxMul) continue;
12145 r = (len == 0) ? 0 : r%len;
12146 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12147 return JIM_OK;
12148 }
12149 }
12150
12151 /* [package] */
12152 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12153 Jim_Obj *const *argv)
12154 {
12155 int option;
12156 const char *options[] = {
12157 "require", "provide", NULL
12158 };
12159 enum {OPT_REQUIRE, OPT_PROVIDE};
12160
12161 if (argc < 2) {
12162 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12163 return JIM_ERR;
12164 }
12165 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12166 JIM_ERRMSG) != JIM_OK)
12167 return JIM_ERR;
12168
12169 if (option == OPT_REQUIRE) {
12170 int exact = 0;
12171 const char *ver;
12172
12173 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12174 exact = 1;
12175 argv++;
12176 argc--;
12177 }
12178 if (argc != 3 && argc != 4) {
12179 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12180 return JIM_ERR;
12181 }
12182 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12183 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12184 JIM_ERRMSG);
12185 if (ver == NULL)
12186 return JIM_ERR_ADDSTACK;
12187 Jim_SetResultString(interp, ver, -1);
12188 } else if (option == OPT_PROVIDE) {
12189 if (argc != 4) {
12190 Jim_WrongNumArgs(interp, 2, argv, "package version");
12191 return JIM_ERR;
12192 }
12193 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12194 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12195 }
12196 return JIM_OK;
12197 }
12198
12199 static struct {
12200 const char *name;
12201 Jim_CmdProc cmdProc;
12202 } Jim_CoreCommandsTable[] = {
12203 {"set", Jim_SetCoreCommand},
12204 {"unset", Jim_UnsetCoreCommand},
12205 {"puts", Jim_PutsCoreCommand},
12206 {"+", Jim_AddCoreCommand},
12207 {"*", Jim_MulCoreCommand},
12208 {"-", Jim_SubCoreCommand},
12209 {"/", Jim_DivCoreCommand},
12210 {"incr", Jim_IncrCoreCommand},
12211 {"while", Jim_WhileCoreCommand},
12212 {"for", Jim_ForCoreCommand},
12213 {"foreach", Jim_ForeachCoreCommand},
12214 {"lmap", Jim_LmapCoreCommand},
12215 {"if", Jim_IfCoreCommand},
12216 {"switch", Jim_SwitchCoreCommand},
12217 {"list", Jim_ListCoreCommand},
12218 {"lindex", Jim_LindexCoreCommand},
12219 {"lset", Jim_LsetCoreCommand},
12220 {"llength", Jim_LlengthCoreCommand},
12221 {"lappend", Jim_LappendCoreCommand},
12222 {"linsert", Jim_LinsertCoreCommand},
12223 {"lsort", Jim_LsortCoreCommand},
12224 {"append", Jim_AppendCoreCommand},
12225 {"debug", Jim_DebugCoreCommand},
12226 {"eval", Jim_EvalCoreCommand},
12227 {"uplevel", Jim_UplevelCoreCommand},
12228 {"expr", Jim_ExprCoreCommand},
12229 {"break", Jim_BreakCoreCommand},
12230 {"continue", Jim_ContinueCoreCommand},
12231 {"proc", Jim_ProcCoreCommand},
12232 {"concat", Jim_ConcatCoreCommand},
12233 {"return", Jim_ReturnCoreCommand},
12234 {"upvar", Jim_UpvarCoreCommand},
12235 {"global", Jim_GlobalCoreCommand},
12236 {"string", Jim_StringCoreCommand},
12237 {"time", Jim_TimeCoreCommand},
12238 {"exit", Jim_ExitCoreCommand},
12239 {"catch", Jim_CatchCoreCommand},
12240 {"ref", Jim_RefCoreCommand},
12241 {"getref", Jim_GetrefCoreCommand},
12242 {"setref", Jim_SetrefCoreCommand},
12243 {"finalize", Jim_FinalizeCoreCommand},
12244 {"collect", Jim_CollectCoreCommand},
12245 {"rename", Jim_RenameCoreCommand},
12246 {"dict", Jim_DictCoreCommand},
12247 {"load", Jim_LoadCoreCommand},
12248 {"subst", Jim_SubstCoreCommand},
12249 {"info", Jim_InfoCoreCommand},
12250 {"split", Jim_SplitCoreCommand},
12251 {"join", Jim_JoinCoreCommand},
12252 {"format", Jim_FormatCoreCommand},
12253 {"scan", Jim_ScanCoreCommand},
12254 {"error", Jim_ErrorCoreCommand},
12255 {"lrange", Jim_LrangeCoreCommand},
12256 {"env", Jim_EnvCoreCommand},
12257 {"source", Jim_SourceCoreCommand},
12258 {"lreverse", Jim_LreverseCoreCommand},
12259 {"range", Jim_RangeCoreCommand},
12260 {"rand", Jim_RandCoreCommand},
12261 {"package", Jim_PackageCoreCommand},
12262 {"tailcall", Jim_TailcallCoreCommand},
12263 {NULL, NULL},
12264 };
12265
12266 /* Some Jim core command is actually a procedure written in Jim itself. */
12267 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12268 {
12269 Jim_Eval(interp, (char*)
12270 "proc lambda {arglist args} {\n"
12271 " set name [ref {} function lambdaFinalizer]\n"
12272 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12273 " return $name\n"
12274 "}\n"
12275 "proc lambdaFinalizer {name val} {\n"
12276 " rename $name {}\n"
12277 "}\n"
12278 );
12279 }
12280
12281 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12282 {
12283 int i = 0;
12284
12285 while(Jim_CoreCommandsTable[i].name != NULL) {
12286 Jim_CreateCommand(interp,
12287 Jim_CoreCommandsTable[i].name,
12288 Jim_CoreCommandsTable[i].cmdProc,
12289 NULL, NULL);
12290 i++;
12291 }
12292 Jim_RegisterCoreProcedures(interp);
12293 }
12294
12295 /* -----------------------------------------------------------------------------
12296 * Interactive prompt
12297 * ---------------------------------------------------------------------------*/
12298 void Jim_PrintErrorMessage(Jim_Interp *interp)
12299 {
12300 int len, i;
12301
12302 if (*interp->errorFileName) {
12303 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12304 interp->errorFileName, interp->errorLine);
12305 }
12306 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12307 Jim_GetString(interp->result, NULL));
12308 Jim_ListLength(interp, interp->stackTrace, &len);
12309 for (i = len-3; i >= 0; i-= 3) {
12310 Jim_Obj *objPtr;
12311 const char *proc, *file, *line;
12312
12313 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12314 proc = Jim_GetString(objPtr, NULL);
12315 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12316 JIM_NONE);
12317 file = Jim_GetString(objPtr, NULL);
12318 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12319 JIM_NONE);
12320 line = Jim_GetString(objPtr, NULL);
12321 if (*proc) {
12322 Jim_fprintf( interp, interp->cookie_stderr,
12323 "in procedure '%s' ", proc);
12324 }
12325 if (*file) {
12326 Jim_fprintf( interp, interp->cookie_stderr,
12327 "called at file \"%s\", line %s",
12328 file, line);
12329 }
12330 if (*file || *proc) {
12331 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12332 }
12333 }
12334 }
12335
12336 int Jim_InteractivePrompt(Jim_Interp *interp)
12337 {
12338 int retcode = JIM_OK;
12339 Jim_Obj *scriptObjPtr;
12340
12341 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12342 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12343 JIM_VERSION / 100, JIM_VERSION % 100);
12344 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12345 while (1) {
12346 char buf[1024];
12347 const char *result;
12348 const char *retcodestr[] = {
12349 "ok", "error", "return", "break", "continue", "eval", "exit"
12350 };
12351 int reslen;
12352
12353 if (retcode != 0) {
12354 if (retcode >= 2 && retcode <= 6)
12355 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12356 else
12357 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12358 } else
12359 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12360 Jim_fflush( interp, interp->cookie_stdout);
12361 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12362 Jim_IncrRefCount(scriptObjPtr);
12363 while(1) {
12364 const char *str;
12365 char state;
12366 int len;
12367
12368 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12369 Jim_DecrRefCount(interp, scriptObjPtr);
12370 goto out;
12371 }
12372 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12373 str = Jim_GetString(scriptObjPtr, &len);
12374 if (Jim_ScriptIsComplete(str, len, &state))
12375 break;
12376 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12377 Jim_fflush( interp, interp->cookie_stdout);
12378 }
12379 retcode = Jim_EvalObj(interp, scriptObjPtr);
12380 Jim_DecrRefCount(interp, scriptObjPtr);
12381 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12382 if (retcode == JIM_ERR) {
12383 Jim_PrintErrorMessage(interp);
12384 } else if (retcode == JIM_EXIT) {
12385 exit(Jim_GetExitCode(interp));
12386 } else {
12387 if (reslen) {
12388 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12389 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12390 }
12391 }
12392 }
12393 out:
12394 return 0;
12395 }
12396
12397 /* -----------------------------------------------------------------------------
12398 * Jim's idea of STDIO..
12399 * ---------------------------------------------------------------------------*/
12400
12401 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12402 {
12403 int r;
12404
12405 va_list ap;
12406 va_start(ap,fmt);
12407 r = Jim_vfprintf( interp, cookie, fmt,ap );
12408 va_end(ap);
12409 return r;
12410 }
12411
12412 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12413 {
12414 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12415 errno = ENOTSUP;
12416 return -1;
12417 }
12418 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12419 }
12420
12421 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12422 {
12423 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12424 errno = ENOTSUP;
12425 return 0;
12426 }
12427 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12428 }
12429
12430 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12431 {
12432 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12433 errno = ENOTSUP;
12434 return 0;
12435 }
12436 return (*(interp->cb_fread))( ptr, size, n, cookie);
12437 }
12438
12439 int Jim_fflush( Jim_Interp *interp, void *cookie )
12440 {
12441 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12442 /* pretend all is well */
12443 return 0;
12444 }
12445 return (*(interp->cb_fflush))( cookie );
12446 }
12447
12448 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12449 {
12450 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12451 errno = ENOTSUP;
12452 return NULL;
12453 }
12454 return (*(interp->cb_fgets))( s, size, cookie );
12455 }
12456 Jim_Nvp *
12457 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12458 {
12459 while( p->name ){
12460 if( 0 == strcmp( name, p->name ) ){
12461 break;
12462 }
12463 p++;
12464 }
12465 return ((Jim_Nvp *)(p));
12466 }
12467
12468 Jim_Nvp *
12469 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12470 {
12471 while( p->name ){
12472 if( 0 == strcasecmp( name, p->name ) ){
12473 break;
12474 }
12475 p++;
12476 }
12477 return ((Jim_Nvp *)(p));
12478 }
12479
12480 int
12481 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12482 const Jim_Nvp *p,
12483 Jim_Obj *o,
12484 Jim_Nvp **result )
12485 {
12486 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12487 }
12488
12489
12490 int
12491 Jim_Nvp_name2value( Jim_Interp *interp,
12492 const Jim_Nvp *_p,
12493 const char *name,
12494 Jim_Nvp **result)
12495 {
12496 const Jim_Nvp *p;
12497
12498 p = Jim_Nvp_name2value_simple( _p, name );
12499
12500 /* result */
12501 if( result ){
12502 *result = (Jim_Nvp *)(p);
12503 }
12504
12505 /* found? */
12506 if( p->name ){
12507 return JIM_OK;
12508 } else {
12509 return JIM_ERR;
12510 }
12511 }
12512
12513 int
12514 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12515 {
12516 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12517 }
12518
12519 int
12520 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12521 {
12522 const Jim_Nvp *p;
12523
12524 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12525
12526 if( puthere ){
12527 *puthere = (Jim_Nvp *)(p);
12528 }
12529 /* found */
12530 if( p->name ){
12531 return JIM_OK;
12532 } else {
12533 return JIM_ERR;
12534 }
12535 }
12536
12537
12538 int
12539 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12540 {
12541 int e;;
12542 jim_wide w;
12543
12544 e = Jim_GetWide( interp, o, &w );
12545 if( e != JIM_OK ){
12546 return e;
12547 }
12548
12549 return Jim_Nvp_value2name( interp, p, w, result );
12550 }
12551
12552 Jim_Nvp *
12553 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12554 {
12555 while( p->name ){
12556 if( value == p->value ){
12557 break;
12558 }
12559 p++;
12560 }
12561 return ((Jim_Nvp *)(p));
12562 }
12563
12564
12565 int
12566 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12567 {
12568 const Jim_Nvp *p;
12569
12570 p = Jim_Nvp_value2name_simple( _p, value );
12571
12572 if( result ){
12573 *result = (Jim_Nvp *)(p);
12574 }
12575
12576 if( p->name ){
12577 return JIM_OK;
12578 } else {
12579 return JIM_ERR;
12580 }
12581 }
12582
12583
12584 int
12585 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12586 {
12587 memset( p, 0, sizeof(*p) );
12588 p->interp = interp;
12589 p->argc = argc;
12590 p->argv = argv;
12591
12592 return JIM_OK;
12593 }
12594
12595 void
12596 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12597 {
12598 int x;
12599
12600 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12601 for( x = 0 ; x < p->argc ; x++ ){
12602 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12603 "%2d) %s\n",
12604 x,
12605 Jim_GetString( p->argv[x], NULL ) );
12606 }
12607 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12608 }
12609
12610
12611 int
12612 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12613 {
12614 Jim_Obj *o;
12615
12616 o = NULL; // failure
12617 if( goi->argc ){
12618 // success
12619 o = goi->argv[0];
12620 goi->argc -= 1;
12621 goi->argv += 1;
12622 }
12623 if( puthere ){
12624 *puthere = o;
12625 }
12626 if( o != NULL ){
12627 return JIM_OK;
12628 } else {
12629 return JIM_ERR;
12630 }
12631 }
12632
12633 int
12634 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12635 {
12636 int r;
12637 Jim_Obj *o;
12638 const char *cp;
12639
12640
12641 r = Jim_GetOpt_Obj( goi, &o );
12642 if( r == JIM_OK ){
12643 cp = Jim_GetString( o, len );
12644 if( puthere ){
12645 /* remove const */
12646 *puthere = (char *)(cp);
12647 }
12648 }
12649 return r;
12650 }
12651
12652 int
12653 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12654 {
12655 int r;
12656 Jim_Obj *o;
12657 double _safe;
12658
12659 if( puthere == NULL ){
12660 puthere = &_safe;
12661 }
12662
12663 r = Jim_GetOpt_Obj( goi, &o );
12664 if( r == JIM_OK ){
12665 r = Jim_GetDouble( goi->interp, o, puthere );
12666 if( r != JIM_OK ){
12667 Jim_SetResult_sprintf( goi->interp,
12668 "not a number: %s",
12669 Jim_GetString( o, NULL ) );
12670 }
12671 }
12672 return r;
12673 }
12674
12675 int
12676 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12677 {
12678 int r;
12679 Jim_Obj *o;
12680 jim_wide _safe;
12681
12682 if( puthere == NULL ){
12683 puthere = &_safe;
12684 }
12685
12686 r = Jim_GetOpt_Obj( goi, &o );
12687 if( r == JIM_OK ){
12688 r = Jim_GetWide( goi->interp, o, puthere );
12689 }
12690 return r;
12691 }
12692
12693 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12694 const Jim_Nvp *nvp,
12695 Jim_Nvp **puthere)
12696 {
12697 Jim_Nvp *_safe;
12698 Jim_Obj *o;
12699 int e;
12700
12701 if( puthere == NULL ){
12702 puthere = &_safe;
12703 }
12704
12705 e = Jim_GetOpt_Obj( goi, &o );
12706 if( e == JIM_OK ){
12707 e = Jim_Nvp_name2value_obj( goi->interp,
12708 nvp,
12709 o,
12710 puthere );
12711 }
12712
12713 return e;
12714 }
12715
12716 void
12717 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12718 const Jim_Nvp *nvptable,
12719 int hadprefix )
12720 {
12721 if( hadprefix ){
12722 Jim_SetResult_NvpUnknown( goi->interp,
12723 goi->argv[-2],
12724 goi->argv[-1],
12725 nvptable );
12726 } else {
12727 Jim_SetResult_NvpUnknown( goi->interp,
12728 NULL,
12729 goi->argv[-1],
12730 nvptable );
12731 }
12732 }
12733
12734
12735 int
12736 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12737 const char * const * lookup,
12738 int *puthere)
12739 {
12740 int _safe;
12741 Jim_Obj *o;
12742 int e;
12743
12744 if( puthere == NULL ){
12745 puthere = &_safe;
12746 }
12747 e = Jim_GetOpt_Obj( goi, &o );
12748 if( e == JIM_OK ){
12749 e = Jim_GetEnum( goi->interp,
12750 o,
12751 lookup,
12752 puthere,
12753 "option",
12754 JIM_ERRMSG );
12755 }
12756 return e;
12757 }
12758
12759
12760
12761 int
12762 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12763 {
12764 va_list ap;
12765 char *buf;
12766
12767 va_start(ap,fmt);
12768 buf = jim_vasprintf( fmt, ap );
12769 va_end(ap);
12770 if( buf ){
12771 Jim_SetResultString( interp, buf, -1 );
12772 jim_vasprintf_done(buf);
12773 }
12774 return JIM_OK;
12775 }
12776
12777
12778 void
12779 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12780 Jim_Obj *param_name,
12781 Jim_Obj *param_value,
12782 const Jim_Nvp *nvp )
12783 {
12784 if( param_name ){
12785 Jim_SetResult_sprintf( interp,
12786 "%s: Unknown: %s, try one of: ",
12787 Jim_GetString( param_name, NULL ),
12788 Jim_GetString( param_value, NULL ) );
12789 } else {
12790 Jim_SetResult_sprintf( interp,
12791 "Unknown param: %s, try one of: ",
12792 Jim_GetString( param_value, NULL ) );
12793 }
12794 while( nvp->name ){
12795 const char *a;
12796 const char *b;
12797
12798 if( (nvp+1)->name ){
12799 a = nvp->name;
12800 b = ", ";
12801 } else {
12802 a = "or ";
12803 b = nvp->name;
12804 }
12805 Jim_AppendStrings( interp,
12806 Jim_GetResult(interp),
12807 a, b, NULL );
12808 nvp++;
12809 }
12810 }
12811
12812
12813 static Jim_Obj *debug_string_obj;
12814
12815 const char *
12816 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12817 {
12818 int x;
12819
12820 if( debug_string_obj ){
12821 Jim_FreeObj( interp, debug_string_obj );
12822 }
12823
12824 debug_string_obj = Jim_NewEmptyStringObj( interp );
12825 for( x = 0 ; x < argc ; x++ ){
12826 Jim_AppendStrings( interp,
12827 debug_string_obj,
12828 Jim_GetString( argv[x], NULL ),
12829 " ",
12830 NULL );
12831 }
12832
12833 return Jim_GetString( debug_string_obj, NULL );
12834 }
12835
12836
12837
12838 /*
12839 * Local Variables: ***
12840 * c-basic-offset: 4 ***
12841 * tab-width: 4 ***
12842 * End: ***
12843 */

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)