a9838ab0d50b30ccb724976fa0f885791b9280d7
[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 *
11 * The FreeBSD license
12 *
13 * Redistribution and use in source and binary forms, with or without
14 * modification, are permitted provided that the following conditions
15 * are met:
16 *
17 * 1. Redistributions of source code must retain the above copyright
18 * notice, this list of conditions and the following disclaimer.
19 * 2. Redistributions in binary form must reproduce the above
20 * copyright notice, this list of conditions and the following
21 * disclaimer in the documentation and/or other materials
22 * provided with the distribution.
23 *
24 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
25 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
27 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
28 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
29 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
30 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
31 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
32 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
33 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
35 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 *
37 * The views and conclusions contained in the software and documentation
38 * are those of the authors and should not be interpreted as representing
39 * official policies, either expressed or implied, of the Jim Tcl Project.
40 **/
41 #define __JIM_CORE__
42 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
43
44 #ifdef __ECOS
45 #include <pkgconf/jimtcl.h>
46 #endif
47 #ifndef JIM_ANSIC
48 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
49 #endif /* JIM_ANSIC */
50
51 #include <stdio.h>
52 #include <stdlib.h>
53 #include <string.h>
54 #include <stdarg.h>
55 #include <ctype.h>
56 #include <limits.h>
57 #include <assert.h>
58 #include <errno.h>
59 #include <time.h>
60
61 #include "replacements.h"
62
63 /* Include the platform dependent libraries for
64 * dynamic loading of libraries. */
65 #ifdef JIM_DYNLIB
66 #if defined(_WIN32) || defined(WIN32)
67 #ifndef WIN32
68 #define WIN32 1
69 #endif
70 #ifndef STRICT
71 #define STRICT
72 #endif
73 #define WIN32_LEAN_AND_MEAN
74 #include <windows.h>
75 #if _MSC_VER >= 1000
76 #pragma warning(disable:4146)
77 #endif /* _MSC_VER */
78 #else
79 #include <dlfcn.h>
80 #endif /* WIN32 */
81 #endif /* JIM_DYNLIB */
82
83 #ifdef __ECOS
84 #include <cyg/jimtcl/jim.h>
85 #else
86 #include "jim.h"
87 #endif
88
89 #ifdef HAVE_BACKTRACE
90 #include <execinfo.h>
91 #endif
92
93 /* -----------------------------------------------------------------------------
94 * Global variables
95 * ---------------------------------------------------------------------------*/
96
97 /* A shared empty string for the objects string representation.
98 * Jim_InvalidateStringRep knows about it and don't try to free. */
99 static char *JimEmptyStringRep = (char*) "";
100
101 /* -----------------------------------------------------------------------------
102 * Required prototypes of not exported functions
103 * ---------------------------------------------------------------------------*/
104 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
105 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
106 static void JimRegisterCoreApi(Jim_Interp *interp);
107
108 static Jim_HashTableType JimVariablesHashTableType;
109
110 /* -----------------------------------------------------------------------------
111 * Utility functions
112 * ---------------------------------------------------------------------------*/
113
114 /*
115 * Convert a string to a jim_wide INTEGER.
116 * This function originates from BSD.
117 *
118 * Ignores `locale' stuff. Assumes that the upper and lower case
119 * alphabets and digits are each contiguous.
120 */
121 #ifdef HAVE_LONG_LONG
122 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
123 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
124 {
125 register const char *s;
126 register unsigned jim_wide acc;
127 register unsigned char c;
128 register unsigned jim_wide qbase, cutoff;
129 register int neg, any, cutlim;
130
131 /*
132 * Skip white space and pick up leading +/- sign if any.
133 * If base is 0, allow 0x for hex and 0 for octal, else
134 * assume decimal; if base is already 16, allow 0x.
135 */
136 s = nptr;
137 do {
138 c = *s++;
139 } while (isspace(c));
140 if (c == '-') {
141 neg = 1;
142 c = *s++;
143 } else {
144 neg = 0;
145 if (c == '+')
146 c = *s++;
147 }
148 if ((base == 0 || base == 16) &&
149 c == '0' && (*s == 'x' || *s == 'X')) {
150 c = s[1];
151 s += 2;
152 base = 16;
153 }
154 if (base == 0)
155 base = c == '0' ? 8 : 10;
156
157 /*
158 * Compute the cutoff value between legal numbers and illegal
159 * numbers. That is the largest legal value, divided by the
160 * base. An input number that is greater than this value, if
161 * followed by a legal input character, is too big. One that
162 * is equal to this value may be valid or not; the limit
163 * between valid and invalid numbers is then based on the last
164 * digit. For instance, if the range for quads is
165 * [-9223372036854775808..9223372036854775807] and the input base
166 * is 10, cutoff will be set to 922337203685477580 and cutlim to
167 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
168 * accumulated a value > 922337203685477580, or equal but the
169 * next digit is > 7 (or 8), the number is too big, and we will
170 * return a range error.
171 *
172 * Set any if any `digits' consumed; make it negative to indicate
173 * overflow.
174 */
175 qbase = (unsigned)base;
176 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
177 : LLONG_MAX;
178 cutlim = (int)(cutoff % qbase);
179 cutoff /= qbase;
180 for (acc = 0, any = 0;; c = *s++) {
181 if (!JimIsAscii(c))
182 break;
183 if (isdigit(c))
184 c -= '0';
185 else if (isalpha(c))
186 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
187 else
188 break;
189 if (c >= base)
190 break;
191 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
192 any = -1;
193 else {
194 any = 1;
195 acc *= qbase;
196 acc += c;
197 }
198 }
199 if (any < 0) {
200 acc = neg ? LLONG_MIN : LLONG_MAX;
201 errno = ERANGE;
202 } else if (neg)
203 acc = -acc;
204 if (endptr != 0)
205 *endptr = (char *)(any ? s - 1 : nptr);
206 return (acc);
207 }
208 #endif
209
210 /* Glob-style pattern matching. */
211 static int JimStringMatch(const char *pattern, int patternLen,
212 const char *string, int stringLen, int nocase)
213 {
214 while(patternLen) {
215 switch(pattern[0]) {
216 case '*':
217 while (pattern[1] == '*') {
218 pattern++;
219 patternLen--;
220 }
221 if (patternLen == 1)
222 return 1; /* match */
223 while(stringLen) {
224 if (JimStringMatch(pattern+1, patternLen-1,
225 string, stringLen, nocase))
226 return 1; /* match */
227 string++;
228 stringLen--;
229 }
230 return 0; /* no match */
231 break;
232 case '?':
233 if (stringLen == 0)
234 return 0; /* no match */
235 string++;
236 stringLen--;
237 break;
238 case '[':
239 {
240 int not, match;
241
242 pattern++;
243 patternLen--;
244 not = pattern[0] == '^';
245 if (not) {
246 pattern++;
247 patternLen--;
248 }
249 match = 0;
250 while(1) {
251 if (pattern[0] == '\\') {
252 pattern++;
253 patternLen--;
254 if (pattern[0] == string[0])
255 match = 1;
256 } else if (pattern[0] == ']') {
257 break;
258 } else if (patternLen == 0) {
259 pattern--;
260 patternLen++;
261 break;
262 } else if (pattern[1] == '-' && patternLen >= 3) {
263 int start = pattern[0];
264 int end = pattern[2];
265 int c = string[0];
266 if (start > end) {
267 int t = start;
268 start = end;
269 end = t;
270 }
271 if (nocase) {
272 start = tolower(start);
273 end = tolower(end);
274 c = tolower(c);
275 }
276 pattern += 2;
277 patternLen -= 2;
278 if (c >= start && c <= end)
279 match = 1;
280 } else {
281 if (!nocase) {
282 if (pattern[0] == string[0])
283 match = 1;
284 } else {
285 if (tolower((int)pattern[0]) == tolower((int)string[0]))
286 match = 1;
287 }
288 }
289 pattern++;
290 patternLen--;
291 }
292 if (not)
293 match = !match;
294 if (!match)
295 return 0; /* no match */
296 string++;
297 stringLen--;
298 break;
299 }
300 case '\\':
301 if (patternLen >= 2) {
302 pattern++;
303 patternLen--;
304 }
305 /* fall through */
306 default:
307 if (!nocase) {
308 if (pattern[0] != string[0])
309 return 0; /* no match */
310 } else {
311 if (tolower((int)pattern[0]) != tolower((int)string[0]))
312 return 0; /* no match */
313 }
314 string++;
315 stringLen--;
316 break;
317 }
318 pattern++;
319 patternLen--;
320 if (stringLen == 0) {
321 while(*pattern == '*') {
322 pattern++;
323 patternLen--;
324 }
325 break;
326 }
327 }
328 if (patternLen == 0 && stringLen == 0)
329 return 1;
330 return 0;
331 }
332
333 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
334 int nocase)
335 {
336 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
337
338 if (nocase == 0) {
339 while(l1 && l2) {
340 if (*u1 != *u2)
341 return (int)*u1-*u2;
342 u1++; u2++; l1--; l2--;
343 }
344 if (!l1 && !l2) return 0;
345 return l1-l2;
346 } else {
347 while(l1 && l2) {
348 if (tolower((int)*u1) != tolower((int)*u2))
349 return tolower((int)*u1)-tolower((int)*u2);
350 u1++; u2++; l1--; l2--;
351 }
352 if (!l1 && !l2) return 0;
353 return l1-l2;
354 }
355 }
356
357 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
358 * The index of the first occurrence of s1 in s2 is returned.
359 * If s1 is not found inside s2, -1 is returned. */
360 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
361 {
362 int i;
363
364 if (!l1 || !l2 || l1 > l2) return -1;
365 if (index < 0) index = 0;
366 s2 += index;
367 for (i = index; i <= l2-l1; i++) {
368 if (memcmp(s2, s1, l1) == 0)
369 return i;
370 s2++;
371 }
372 return -1;
373 }
374
375 int Jim_WideToString(char *buf, jim_wide wideValue)
376 {
377 const char *fmt = "%" JIM_WIDE_MODIFIER;
378 return sprintf(buf, fmt, wideValue);
379 }
380
381 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
382 {
383 char *endptr;
384
385 #ifdef HAVE_LONG_LONG
386 *widePtr = JimStrtoll(str, &endptr, base);
387 #else
388 *widePtr = strtol(str, &endptr, base);
389 #endif
390 if ((str[0] == '\0') || (str == endptr) )
391 return JIM_ERR;
392 if (endptr[0] != '\0') {
393 while(*endptr) {
394 if (!isspace((int)*endptr))
395 return JIM_ERR;
396 endptr++;
397 }
398 }
399 return JIM_OK;
400 }
401
402 int Jim_StringToIndex(const char *str, int *intPtr)
403 {
404 char *endptr;
405
406 *intPtr = strtol(str, &endptr, 10);
407 if ( (str[0] == '\0') || (str == endptr) )
408 return JIM_ERR;
409 if (endptr[0] != '\0') {
410 while(*endptr) {
411 if (!isspace((int)*endptr))
412 return JIM_ERR;
413 endptr++;
414 }
415 }
416 return JIM_OK;
417 }
418
419 /* The string representation of references has two features in order
420 * to make the GC faster. The first is that every reference starts
421 * with a non common character '~', in order to make the string matching
422 * fater. The second is that the reference string rep his 32 characters
423 * in length, this allows to avoid to check every object with a string
424 * repr < 32, and usually there are many of this objects. */
425
426 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
427
428 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
429 {
430 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
431 sprintf(buf, fmt, refPtr->tag, id);
432 return JIM_REFERENCE_SPACE;
433 }
434
435 int Jim_DoubleToString(char *buf, double doubleValue)
436 {
437 char *s;
438 int len;
439
440 len = sprintf(buf, "%.17g", doubleValue);
441 s = buf;
442 while(*s) {
443 if (*s == '.') return len;
444 s++;
445 }
446 /* Add a final ".0" if it's a number. But not
447 * for NaN or InF */
448 if (isdigit((int)buf[0])
449 || ((buf[0] == '-' || buf[0] == '+')
450 && isdigit((int)buf[1]))) {
451 s[0] = '.';
452 s[1] = '0';
453 s[2] = '\0';
454 return len+2;
455 }
456 return len;
457 }
458
459 int Jim_StringToDouble(const char *str, double *doublePtr)
460 {
461 char *endptr;
462
463 *doublePtr = strtod(str, &endptr);
464 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
465 return JIM_ERR;
466 return JIM_OK;
467 }
468
469 static jim_wide JimPowWide(jim_wide b, jim_wide e)
470 {
471 jim_wide i, res = 1;
472 if ((b==0 && e!=0) || (e<0)) return 0;
473 for(i=0; i<e; i++) {res *= b;}
474 return res;
475 }
476
477 /* -----------------------------------------------------------------------------
478 * Special functions
479 * ---------------------------------------------------------------------------*/
480
481 /* Note that 'interp' may be NULL if not available in the
482 * context of the panic. It's only useful to get the error
483 * file descriptor, it will default to stderr otherwise. */
484 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
485 {
486 va_list ap;
487
488 va_start(ap, fmt);
489 /*
490 * Send it here first.. Assuming STDIO still works
491 */
492 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
493 vfprintf(stderr, fmt, ap);
494 fprintf(stderr, JIM_NL JIM_NL);
495 va_end(ap);
496
497 #ifdef HAVE_BACKTRACE
498 {
499 void *array[40];
500 int size, i;
501 char **strings;
502
503 size = backtrace(array, 40);
504 strings = backtrace_symbols(array, size);
505 for (i = 0; i < size; i++)
506 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
507 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
508 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
509 }
510 #endif
511
512 /* This may actually crash... we do it last */
513 if( interp && interp->cookie_stderr ){
514 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
515 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
516 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
517 }
518 abort();
519 }
520
521 /* -----------------------------------------------------------------------------
522 * Memory allocation
523 * ---------------------------------------------------------------------------*/
524
525 /* Macro used for memory debugging.
526 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
527 * and similary for Jim_Realloc and Jim_Free */
528 #if 0
529 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
530 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
531 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
532 #endif
533
534 void *Jim_Alloc(int size)
535 {
536 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
537 if (size==0)
538 size=1;
539 void *p = malloc(size);
540 if (p == NULL)
541 Jim_Panic(NULL,"malloc: Out of memory");
542 return p;
543 }
544
545 void Jim_Free(void *ptr) {
546 free(ptr);
547 }
548
549 void *Jim_Realloc(void *ptr, int size)
550 {
551 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
552 if (size==0)
553 size=1;
554 void *p = realloc(ptr, size);
555 if (p == NULL)
556 Jim_Panic(NULL,"realloc: Out of memory");
557 return p;
558 }
559
560 char *Jim_StrDup(const char *s)
561 {
562 int l = strlen(s);
563 char *copy = Jim_Alloc(l+1);
564
565 memcpy(copy, s, l+1);
566 return copy;
567 }
568
569 char *Jim_StrDupLen(const char *s, int l)
570 {
571 char *copy = Jim_Alloc(l+1);
572
573 memcpy(copy, s, l+1);
574 copy[l] = 0; /* Just to be sure, original could be substring */
575 return copy;
576 }
577
578 /* -----------------------------------------------------------------------------
579 * Time related functions
580 * ---------------------------------------------------------------------------*/
581 /* Returns microseconds of CPU used since start. */
582 static jim_wide JimClock(void)
583 {
584 #if (defined WIN32) && !(defined JIM_ANSIC)
585 LARGE_INTEGER t, f;
586 QueryPerformanceFrequency(&f);
587 QueryPerformanceCounter(&t);
588 return (long)((t.QuadPart * 1000000) / f.QuadPart);
589 #else /* !WIN32 */
590 clock_t clocks = clock();
591
592 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
593 #endif /* WIN32 */
594 }
595
596 /* -----------------------------------------------------------------------------
597 * Hash Tables
598 * ---------------------------------------------------------------------------*/
599
600 /* -------------------------- private prototypes ---------------------------- */
601 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
602 static unsigned int JimHashTableNextPower(unsigned int size);
603 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
604
605 /* -------------------------- hash functions -------------------------------- */
606
607 /* Thomas Wang's 32 bit Mix Function */
608 unsigned int Jim_IntHashFunction(unsigned int key)
609 {
610 key += ~(key << 15);
611 key ^= (key >> 10);
612 key += (key << 3);
613 key ^= (key >> 6);
614 key += ~(key << 11);
615 key ^= (key >> 16);
616 return key;
617 }
618
619 /* Identity hash function for integer keys */
620 unsigned int Jim_IdentityHashFunction(unsigned int key)
621 {
622 return key;
623 }
624
625 /* Generic hash function (we are using to multiply by 9 and add the byte
626 * as Tcl) */
627 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
628 {
629 unsigned int h = 0;
630 while(len--)
631 h += (h<<3)+*buf++;
632 return h;
633 }
634
635 /* ----------------------------- API implementation ------------------------- */
636 /* reset an hashtable already initialized with ht_init().
637 * NOTE: This function should only called by ht_destroy(). */
638 static void JimResetHashTable(Jim_HashTable *ht)
639 {
640 ht->table = NULL;
641 ht->size = 0;
642 ht->sizemask = 0;
643 ht->used = 0;
644 ht->collisions = 0;
645 }
646
647 /* Initialize the hash table */
648 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
649 void *privDataPtr)
650 {
651 JimResetHashTable(ht);
652 ht->type = type;
653 ht->privdata = privDataPtr;
654 return JIM_OK;
655 }
656
657 /* Resize the table to the minimal size that contains all the elements,
658 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
659 int Jim_ResizeHashTable(Jim_HashTable *ht)
660 {
661 int minimal = ht->used;
662
663 if (minimal < JIM_HT_INITIAL_SIZE)
664 minimal = JIM_HT_INITIAL_SIZE;
665 return Jim_ExpandHashTable(ht, minimal);
666 }
667
668 /* Expand or create the hashtable */
669 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
670 {
671 Jim_HashTable n; /* the new hashtable */
672 unsigned int realsize = JimHashTableNextPower(size), i;
673
674 /* the size is invalid if it is smaller than the number of
675 * elements already inside the hashtable */
676 if (ht->used >= size)
677 return JIM_ERR;
678
679 Jim_InitHashTable(&n, ht->type, ht->privdata);
680 n.size = realsize;
681 n.sizemask = realsize-1;
682 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
683
684 /* Initialize all the pointers to NULL */
685 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
686
687 /* Copy all the elements from the old to the new table:
688 * note that if the old hash table is empty ht->size is zero,
689 * so Jim_ExpandHashTable just creates an hash table. */
690 n.used = ht->used;
691 for (i = 0; i < ht->size && ht->used > 0; i++) {
692 Jim_HashEntry *he, *nextHe;
693
694 if (ht->table[i] == NULL) continue;
695
696 /* For each hash entry on this slot... */
697 he = ht->table[i];
698 while(he) {
699 unsigned int h;
700
701 nextHe = he->next;
702 /* Get the new element index */
703 h = Jim_HashKey(ht, he->key) & n.sizemask;
704 he->next = n.table[h];
705 n.table[h] = he;
706 ht->used--;
707 /* Pass to the next element */
708 he = nextHe;
709 }
710 }
711 assert(ht->used == 0);
712 Jim_Free(ht->table);
713
714 /* Remap the new hashtable in the old */
715 *ht = n;
716 return JIM_OK;
717 }
718
719 /* Add an element to the target hash table */
720 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
721 {
722 int index;
723 Jim_HashEntry *entry;
724
725 /* Get the index of the new element, or -1 if
726 * the element already exists. */
727 if ((index = JimInsertHashEntry(ht, key)) == -1)
728 return JIM_ERR;
729
730 /* Allocates the memory and stores key */
731 entry = Jim_Alloc(sizeof(*entry));
732 entry->next = ht->table[index];
733 ht->table[index] = entry;
734
735 /* Set the hash entry fields. */
736 Jim_SetHashKey(ht, entry, key);
737 Jim_SetHashVal(ht, entry, val);
738 ht->used++;
739 return JIM_OK;
740 }
741
742 /* Add an element, discarding the old if the key already exists */
743 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
744 {
745 Jim_HashEntry *entry;
746
747 /* Try to add the element. If the key
748 * does not exists Jim_AddHashEntry will suceed. */
749 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
750 return JIM_OK;
751 /* It already exists, get the entry */
752 entry = Jim_FindHashEntry(ht, key);
753 /* Free the old value and set the new one */
754 Jim_FreeEntryVal(ht, entry);
755 Jim_SetHashVal(ht, entry, val);
756 return JIM_OK;
757 }
758
759 /* Search and remove an element */
760 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
761 {
762 unsigned int h;
763 Jim_HashEntry *he, *prevHe;
764
765 if (ht->size == 0)
766 return JIM_ERR;
767 h = Jim_HashKey(ht, key) & ht->sizemask;
768 he = ht->table[h];
769
770 prevHe = NULL;
771 while(he) {
772 if (Jim_CompareHashKeys(ht, key, he->key)) {
773 /* Unlink the element from the list */
774 if (prevHe)
775 prevHe->next = he->next;
776 else
777 ht->table[h] = he->next;
778 Jim_FreeEntryKey(ht, he);
779 Jim_FreeEntryVal(ht, he);
780 Jim_Free(he);
781 ht->used--;
782 return JIM_OK;
783 }
784 prevHe = he;
785 he = he->next;
786 }
787 return JIM_ERR; /* not found */
788 }
789
790 /* Destroy an entire hash table */
791 int Jim_FreeHashTable(Jim_HashTable *ht)
792 {
793 unsigned int i;
794
795 /* Free all the elements */
796 for (i = 0; i < ht->size && ht->used > 0; i++) {
797 Jim_HashEntry *he, *nextHe;
798
799 if ((he = ht->table[i]) == NULL) continue;
800 while(he) {
801 nextHe = he->next;
802 Jim_FreeEntryKey(ht, he);
803 Jim_FreeEntryVal(ht, he);
804 Jim_Free(he);
805 ht->used--;
806 he = nextHe;
807 }
808 }
809 /* Free the table and the allocated cache structure */
810 Jim_Free(ht->table);
811 /* Re-initialize the table */
812 JimResetHashTable(ht);
813 return JIM_OK; /* never fails */
814 }
815
816 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
817 {
818 Jim_HashEntry *he;
819 unsigned int h;
820
821 if (ht->size == 0) return NULL;
822 h = Jim_HashKey(ht, key) & ht->sizemask;
823 he = ht->table[h];
824 while(he) {
825 if (Jim_CompareHashKeys(ht, key, he->key))
826 return he;
827 he = he->next;
828 }
829 return NULL;
830 }
831
832 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
833 {
834 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
835
836 iter->ht = ht;
837 iter->index = -1;
838 iter->entry = NULL;
839 iter->nextEntry = NULL;
840 return iter;
841 }
842
843 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
844 {
845 while (1) {
846 if (iter->entry == NULL) {
847 iter->index++;
848 if (iter->index >=
849 (signed)iter->ht->size) break;
850 iter->entry = iter->ht->table[iter->index];
851 } else {
852 iter->entry = iter->nextEntry;
853 }
854 if (iter->entry) {
855 /* We need to save the 'next' here, the iterator user
856 * may delete the entry we are returning. */
857 iter->nextEntry = iter->entry->next;
858 return iter->entry;
859 }
860 }
861 return NULL;
862 }
863
864 /* ------------------------- private functions ------------------------------ */
865
866 /* Expand the hash table if needed */
867 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
868 {
869 /* If the hash table is empty expand it to the intial size,
870 * if the table is "full" dobule its size. */
871 if (ht->size == 0)
872 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
873 if (ht->size == ht->used)
874 return Jim_ExpandHashTable(ht, ht->size*2);
875 return JIM_OK;
876 }
877
878 /* Our hash table capability is a power of two */
879 static unsigned int JimHashTableNextPower(unsigned int size)
880 {
881 unsigned int i = JIM_HT_INITIAL_SIZE;
882
883 if (size >= 2147483648U)
884 return 2147483648U;
885 while(1) {
886 if (i >= size)
887 return i;
888 i *= 2;
889 }
890 }
891
892 /* Returns the index of a free slot that can be populated with
893 * an hash entry for the given 'key'.
894 * If the key already exists, -1 is returned. */
895 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
896 {
897 unsigned int h;
898 Jim_HashEntry *he;
899
900 /* Expand the hashtable if needed */
901 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
902 return -1;
903 /* Compute the key hash value */
904 h = Jim_HashKey(ht, key) & ht->sizemask;
905 /* Search if this slot does not already contain the given key */
906 he = ht->table[h];
907 while(he) {
908 if (Jim_CompareHashKeys(ht, key, he->key))
909 return -1;
910 he = he->next;
911 }
912 return h;
913 }
914
915 /* ----------------------- StringCopy Hash Table Type ------------------------*/
916
917 static unsigned int JimStringCopyHTHashFunction(const void *key)
918 {
919 return Jim_GenHashFunction(key, strlen(key));
920 }
921
922 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
923 {
924 int len = strlen(key);
925 char *copy = Jim_Alloc(len+1);
926 JIM_NOTUSED(privdata);
927
928 memcpy(copy, key, len);
929 copy[len] = '\0';
930 return copy;
931 }
932
933 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
934 {
935 int len = strlen(val);
936 char *copy = Jim_Alloc(len+1);
937 JIM_NOTUSED(privdata);
938
939 memcpy(copy, val, len);
940 copy[len] = '\0';
941 return copy;
942 }
943
944 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
945 const void *key2)
946 {
947 JIM_NOTUSED(privdata);
948
949 return strcmp(key1, key2) == 0;
950 }
951
952 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
953 {
954 JIM_NOTUSED(privdata);
955
956 Jim_Free((void*)key); /* ATTENTION: const cast */
957 }
958
959 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
960 {
961 JIM_NOTUSED(privdata);
962
963 Jim_Free((void*)val); /* ATTENTION: const cast */
964 }
965
966 static Jim_HashTableType JimStringCopyHashTableType = {
967 JimStringCopyHTHashFunction, /* hash function */
968 JimStringCopyHTKeyDup, /* key dup */
969 NULL, /* val dup */
970 JimStringCopyHTKeyCompare, /* key compare */
971 JimStringCopyHTKeyDestructor, /* key destructor */
972 NULL /* val destructor */
973 };
974
975 /* This is like StringCopy but does not auto-duplicate the key.
976 * It's used for intepreter's shared strings. */
977 static Jim_HashTableType JimSharedStringsHashTableType = {
978 JimStringCopyHTHashFunction, /* hash function */
979 NULL, /* key dup */
980 NULL, /* val dup */
981 JimStringCopyHTKeyCompare, /* key compare */
982 JimStringCopyHTKeyDestructor, /* key destructor */
983 NULL /* val destructor */
984 };
985
986 /* This is like StringCopy but also automatically handle dynamic
987 * allocated C strings as values. */
988 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
989 JimStringCopyHTHashFunction, /* hash function */
990 JimStringCopyHTKeyDup, /* key dup */
991 JimStringKeyValCopyHTValDup, /* val dup */
992 JimStringCopyHTKeyCompare, /* key compare */
993 JimStringCopyHTKeyDestructor, /* key destructor */
994 JimStringKeyValCopyHTValDestructor, /* val destructor */
995 };
996
997 typedef struct AssocDataValue {
998 Jim_InterpDeleteProc *delProc;
999 void *data;
1000 } AssocDataValue;
1001
1002 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1003 {
1004 AssocDataValue *assocPtr = (AssocDataValue *)data;
1005 if (assocPtr->delProc != NULL)
1006 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1007 Jim_Free(data);
1008 }
1009
1010 static Jim_HashTableType JimAssocDataHashTableType = {
1011 JimStringCopyHTHashFunction, /* hash function */
1012 JimStringCopyHTKeyDup, /* key dup */
1013 NULL, /* val dup */
1014 JimStringCopyHTKeyCompare, /* key compare */
1015 JimStringCopyHTKeyDestructor, /* key destructor */
1016 JimAssocDataHashTableValueDestructor /* val destructor */
1017 };
1018
1019 /* -----------------------------------------------------------------------------
1020 * Stack - This is a simple generic stack implementation. It is used for
1021 * example in the 'expr' expression compiler.
1022 * ---------------------------------------------------------------------------*/
1023 void Jim_InitStack(Jim_Stack *stack)
1024 {
1025 stack->len = 0;
1026 stack->maxlen = 0;
1027 stack->vector = NULL;
1028 }
1029
1030 void Jim_FreeStack(Jim_Stack *stack)
1031 {
1032 Jim_Free(stack->vector);
1033 }
1034
1035 int Jim_StackLen(Jim_Stack *stack)
1036 {
1037 return stack->len;
1038 }
1039
1040 void Jim_StackPush(Jim_Stack *stack, void *element) {
1041 int neededLen = stack->len+1;
1042 if (neededLen > stack->maxlen) {
1043 stack->maxlen = neededLen*2;
1044 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1045 }
1046 stack->vector[stack->len] = element;
1047 stack->len++;
1048 }
1049
1050 void *Jim_StackPop(Jim_Stack *stack)
1051 {
1052 if (stack->len == 0) return NULL;
1053 stack->len--;
1054 return stack->vector[stack->len];
1055 }
1056
1057 void *Jim_StackPeek(Jim_Stack *stack)
1058 {
1059 if (stack->len == 0) return NULL;
1060 return stack->vector[stack->len-1];
1061 }
1062
1063 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1064 {
1065 int i;
1066
1067 for (i = 0; i < stack->len; i++)
1068 freeFunc(stack->vector[i]);
1069 }
1070
1071 /* -----------------------------------------------------------------------------
1072 * Parser
1073 * ---------------------------------------------------------------------------*/
1074
1075 /* Token types */
1076 #define JIM_TT_NONE -1 /* No token returned */
1077 #define JIM_TT_STR 0 /* simple string */
1078 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1079 #define JIM_TT_VAR 2 /* var substitution */
1080 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1081 #define JIM_TT_CMD 4 /* command substitution */
1082 #define JIM_TT_SEP 5 /* word separator */
1083 #define JIM_TT_EOL 6 /* line separator */
1084
1085 /* Additional token types needed for expressions */
1086 #define JIM_TT_SUBEXPR_START 7
1087 #define JIM_TT_SUBEXPR_END 8
1088 #define JIM_TT_EXPR_NUMBER 9
1089 #define JIM_TT_EXPR_OPERATOR 10
1090
1091 /* Parser states */
1092 #define JIM_PS_DEF 0 /* Default state */
1093 #define JIM_PS_QUOTE 1 /* Inside "" */
1094
1095 /* Parser context structure. The same context is used both to parse
1096 * Tcl scripts and lists. */
1097 struct JimParserCtx {
1098 const char *prg; /* Program text */
1099 const char *p; /* Pointer to the point of the program we are parsing */
1100 int len; /* Left length of 'prg' */
1101 int linenr; /* Current line number */
1102 const char *tstart;
1103 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1104 int tline; /* Line number of the returned token */
1105 int tt; /* Token type */
1106 int eof; /* Non zero if EOF condition is true. */
1107 int state; /* Parser state */
1108 int comment; /* Non zero if the next chars may be a comment. */
1109 };
1110
1111 #define JimParserEof(c) ((c)->eof)
1112 #define JimParserTstart(c) ((c)->tstart)
1113 #define JimParserTend(c) ((c)->tend)
1114 #define JimParserTtype(c) ((c)->tt)
1115 #define JimParserTline(c) ((c)->tline)
1116
1117 static int JimParseScript(struct JimParserCtx *pc);
1118 static int JimParseSep(struct JimParserCtx *pc);
1119 static int JimParseEol(struct JimParserCtx *pc);
1120 static int JimParseCmd(struct JimParserCtx *pc);
1121 static int JimParseVar(struct JimParserCtx *pc);
1122 static int JimParseBrace(struct JimParserCtx *pc);
1123 static int JimParseStr(struct JimParserCtx *pc);
1124 static int JimParseComment(struct JimParserCtx *pc);
1125 static char *JimParserGetToken(struct JimParserCtx *pc,
1126 int *lenPtr, int *typePtr, int *linePtr);
1127
1128 /* Initialize a parser context.
1129 * 'prg' is a pointer to the program text, linenr is the line
1130 * number of the first line contained in the program. */
1131 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1132 int len, int linenr)
1133 {
1134 pc->prg = prg;
1135 pc->p = prg;
1136 pc->len = len;
1137 pc->tstart = NULL;
1138 pc->tend = NULL;
1139 pc->tline = 0;
1140 pc->tt = JIM_TT_NONE;
1141 pc->eof = 0;
1142 pc->state = JIM_PS_DEF;
1143 pc->linenr = linenr;
1144 pc->comment = 1;
1145 }
1146
1147 int JimParseScript(struct JimParserCtx *pc)
1148 {
1149 while(1) { /* the while is used to reiterate with continue if needed */
1150 if (!pc->len) {
1151 pc->tstart = pc->p;
1152 pc->tend = pc->p-1;
1153 pc->tline = pc->linenr;
1154 pc->tt = JIM_TT_EOL;
1155 pc->eof = 1;
1156 return JIM_OK;
1157 }
1158 switch(*(pc->p)) {
1159 case '\\':
1160 if (*(pc->p+1) == '\n')
1161 return JimParseSep(pc);
1162 else {
1163 pc->comment = 0;
1164 return JimParseStr(pc);
1165 }
1166 break;
1167 case ' ':
1168 case '\t':
1169 case '\r':
1170 if (pc->state == JIM_PS_DEF)
1171 return JimParseSep(pc);
1172 else {
1173 pc->comment = 0;
1174 return JimParseStr(pc);
1175 }
1176 break;
1177 case '\n':
1178 case ';':
1179 pc->comment = 1;
1180 if (pc->state == JIM_PS_DEF)
1181 return JimParseEol(pc);
1182 else
1183 return JimParseStr(pc);
1184 break;
1185 case '[':
1186 pc->comment = 0;
1187 return JimParseCmd(pc);
1188 break;
1189 case '$':
1190 pc->comment = 0;
1191 if (JimParseVar(pc) == JIM_ERR) {
1192 pc->tstart = pc->tend = pc->p++; pc->len--;
1193 pc->tline = pc->linenr;
1194 pc->tt = JIM_TT_STR;
1195 return JIM_OK;
1196 } else
1197 return JIM_OK;
1198 break;
1199 case '#':
1200 if (pc->comment) {
1201 JimParseComment(pc);
1202 continue;
1203 } else {
1204 return JimParseStr(pc);
1205 }
1206 default:
1207 pc->comment = 0;
1208 return JimParseStr(pc);
1209 break;
1210 }
1211 return JIM_OK;
1212 }
1213 }
1214
1215 int JimParseSep(struct JimParserCtx *pc)
1216 {
1217 pc->tstart = pc->p;
1218 pc->tline = pc->linenr;
1219 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1220 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1221 if (*pc->p == '\\') {
1222 pc->p++; pc->len--;
1223 pc->linenr++;
1224 }
1225 pc->p++; pc->len--;
1226 }
1227 pc->tend = pc->p-1;
1228 pc->tt = JIM_TT_SEP;
1229 return JIM_OK;
1230 }
1231
1232 int JimParseEol(struct JimParserCtx *pc)
1233 {
1234 pc->tstart = pc->p;
1235 pc->tline = pc->linenr;
1236 while (*pc->p == ' ' || *pc->p == '\n' ||
1237 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1238 if (*pc->p == '\n')
1239 pc->linenr++;
1240 pc->p++; pc->len--;
1241 }
1242 pc->tend = pc->p-1;
1243 pc->tt = JIM_TT_EOL;
1244 return JIM_OK;
1245 }
1246
1247 /* Todo. Don't stop if ']' appears inside {} or quoted.
1248 * Also should handle the case of puts [string length "]"] */
1249 int JimParseCmd(struct JimParserCtx *pc)
1250 {
1251 int level = 1;
1252 int blevel = 0;
1253
1254 pc->tstart = ++pc->p; pc->len--;
1255 pc->tline = pc->linenr;
1256 while (1) {
1257 if (pc->len == 0) {
1258 break;
1259 } else if (*pc->p == '[' && blevel == 0) {
1260 level++;
1261 } else if (*pc->p == ']' && blevel == 0) {
1262 level--;
1263 if (!level) break;
1264 } else if (*pc->p == '\\') {
1265 pc->p++; pc->len--;
1266 } else if (*pc->p == '{') {
1267 blevel++;
1268 } else if (*pc->p == '}') {
1269 if (blevel != 0)
1270 blevel--;
1271 } else if (*pc->p == '\n')
1272 pc->linenr++;
1273 pc->p++; pc->len--;
1274 }
1275 pc->tend = pc->p-1;
1276 pc->tt = JIM_TT_CMD;
1277 if (*pc->p == ']') {
1278 pc->p++; pc->len--;
1279 }
1280 return JIM_OK;
1281 }
1282
1283 int JimParseVar(struct JimParserCtx *pc)
1284 {
1285 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1286
1287 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1288 pc->tline = pc->linenr;
1289 if (*pc->p == '{') {
1290 pc->tstart = ++pc->p; pc->len--;
1291 brace = 1;
1292 }
1293 if (brace) {
1294 while (!stop) {
1295 if (*pc->p == '}' || pc->len == 0) {
1296 stop = 1;
1297 if (pc->len == 0)
1298 continue;
1299 }
1300 else if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++; pc->len--;
1303 }
1304 if (pc->len == 0)
1305 pc->tend = pc->p-1;
1306 else
1307 pc->tend = pc->p-2;
1308 } else {
1309 while (!stop) {
1310 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1311 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1312 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1313 stop = 1;
1314 else {
1315 pc->p++; pc->len--;
1316 }
1317 }
1318 /* Parse [dict get] syntax sugar. */
1319 if (*pc->p == '(') {
1320 while (*pc->p != ')' && pc->len) {
1321 pc->p++; pc->len--;
1322 if (*pc->p == '\\' && pc->len >= 2) {
1323 pc->p += 2; pc->len -= 2;
1324 }
1325 }
1326 if (*pc->p != '\0') {
1327 pc->p++; pc->len--;
1328 }
1329 ttype = JIM_TT_DICTSUGAR;
1330 }
1331 pc->tend = pc->p-1;
1332 }
1333 /* Check if we parsed just the '$' character.
1334 * That's not a variable so an error is returned
1335 * to tell the state machine to consider this '$' just
1336 * a string. */
1337 if (pc->tstart == pc->p) {
1338 pc->p--; pc->len++;
1339 return JIM_ERR;
1340 }
1341 pc->tt = ttype;
1342 return JIM_OK;
1343 }
1344
1345 int JimParseBrace(struct JimParserCtx *pc)
1346 {
1347 int level = 1;
1348
1349 pc->tstart = ++pc->p; pc->len--;
1350 pc->tline = pc->linenr;
1351 while (1) {
1352 if (*pc->p == '\\' && pc->len >= 2) {
1353 pc->p++; pc->len--;
1354 if (*pc->p == '\n')
1355 pc->linenr++;
1356 } else if (*pc->p == '{') {
1357 level++;
1358 } else if (pc->len == 0 || *pc->p == '}') {
1359 level--;
1360 if (pc->len == 0 || level == 0) {
1361 pc->tend = pc->p-1;
1362 if (pc->len != 0) {
1363 pc->p++; pc->len--;
1364 }
1365 pc->tt = JIM_TT_STR;
1366 return JIM_OK;
1367 }
1368 } else if (*pc->p == '\n') {
1369 pc->linenr++;
1370 }
1371 pc->p++; pc->len--;
1372 }
1373 return JIM_OK; /* unreached */
1374 }
1375
1376 int JimParseStr(struct JimParserCtx *pc)
1377 {
1378 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1379 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1380 if (newword && *pc->p == '{') {
1381 return JimParseBrace(pc);
1382 } else if (newword && *pc->p == '"') {
1383 pc->state = JIM_PS_QUOTE;
1384 pc->p++; pc->len--;
1385 }
1386 pc->tstart = pc->p;
1387 pc->tline = pc->linenr;
1388 while (1) {
1389 if (pc->len == 0) {
1390 pc->tend = pc->p-1;
1391 pc->tt = JIM_TT_ESC;
1392 return JIM_OK;
1393 }
1394 switch(*pc->p) {
1395 case '\\':
1396 if (pc->state == JIM_PS_DEF &&
1397 *(pc->p+1) == '\n') {
1398 pc->tend = pc->p-1;
1399 pc->tt = JIM_TT_ESC;
1400 return JIM_OK;
1401 }
1402 if (pc->len >= 2) {
1403 pc->p++; pc->len--;
1404 }
1405 break;
1406 case '$':
1407 case '[':
1408 pc->tend = pc->p-1;
1409 pc->tt = JIM_TT_ESC;
1410 return JIM_OK;
1411 case ' ':
1412 case '\t':
1413 case '\n':
1414 case '\r':
1415 case ';':
1416 if (pc->state == JIM_PS_DEF) {
1417 pc->tend = pc->p-1;
1418 pc->tt = JIM_TT_ESC;
1419 return JIM_OK;
1420 } else if (*pc->p == '\n') {
1421 pc->linenr++;
1422 }
1423 break;
1424 case '"':
1425 if (pc->state == JIM_PS_QUOTE) {
1426 pc->tend = pc->p-1;
1427 pc->tt = JIM_TT_ESC;
1428 pc->p++; pc->len--;
1429 pc->state = JIM_PS_DEF;
1430 return JIM_OK;
1431 }
1432 break;
1433 }
1434 pc->p++; pc->len--;
1435 }
1436 return JIM_OK; /* unreached */
1437 }
1438
1439 int JimParseComment(struct JimParserCtx *pc)
1440 {
1441 while (*pc->p) {
1442 if (*pc->p == '\n') {
1443 pc->linenr++;
1444 if (*(pc->p-1) != '\\') {
1445 pc->p++; pc->len--;
1446 return JIM_OK;
1447 }
1448 }
1449 pc->p++; pc->len--;
1450 }
1451 return JIM_OK;
1452 }
1453
1454 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1455 static int xdigitval(int c)
1456 {
1457 if (c >= '0' && c <= '9') return c-'0';
1458 if (c >= 'a' && c <= 'f') return c-'a'+10;
1459 if (c >= 'A' && c <= 'F') return c-'A'+10;
1460 return -1;
1461 }
1462
1463 static int odigitval(int c)
1464 {
1465 if (c >= '0' && c <= '7') return c-'0';
1466 return -1;
1467 }
1468
1469 /* Perform Tcl escape substitution of 's', storing the result
1470 * string into 'dest'. The escaped string is guaranteed to
1471 * be the same length or shorted than the source string.
1472 * Slen is the length of the string at 's', if it's -1 the string
1473 * length will be calculated by the function.
1474 *
1475 * The function returns the length of the resulting string. */
1476 static int JimEscape(char *dest, const char *s, int slen)
1477 {
1478 char *p = dest;
1479 int i, len;
1480
1481 if (slen == -1)
1482 slen = strlen(s);
1483
1484 for (i = 0; i < slen; i++) {
1485 switch(s[i]) {
1486 case '\\':
1487 switch(s[i+1]) {
1488 case 'a': *p++ = 0x7; i++; break;
1489 case 'b': *p++ = 0x8; i++; break;
1490 case 'f': *p++ = 0xc; i++; break;
1491 case 'n': *p++ = 0xa; i++; break;
1492 case 'r': *p++ = 0xd; i++; break;
1493 case 't': *p++ = 0x9; i++; break;
1494 case 'v': *p++ = 0xb; i++; break;
1495 case '\0': *p++ = '\\'; i++; break;
1496 case '\n': *p++ = ' '; i++; break;
1497 default:
1498 if (s[i+1] == 'x') {
1499 int val = 0;
1500 int c = xdigitval(s[i+2]);
1501 if (c == -1) {
1502 *p++ = 'x';
1503 i++;
1504 break;
1505 }
1506 val = c;
1507 c = xdigitval(s[i+3]);
1508 if (c == -1) {
1509 *p++ = val;
1510 i += 2;
1511 break;
1512 }
1513 val = (val*16)+c;
1514 *p++ = val;
1515 i += 3;
1516 break;
1517 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1518 {
1519 int val = 0;
1520 int c = odigitval(s[i+1]);
1521 val = c;
1522 c = odigitval(s[i+2]);
1523 if (c == -1) {
1524 *p++ = val;
1525 i ++;
1526 break;
1527 }
1528 val = (val*8)+c;
1529 c = odigitval(s[i+3]);
1530 if (c == -1) {
1531 *p++ = val;
1532 i += 2;
1533 break;
1534 }
1535 val = (val*8)+c;
1536 *p++ = val;
1537 i += 3;
1538 } else {
1539 *p++ = s[i+1];
1540 i++;
1541 }
1542 break;
1543 }
1544 break;
1545 default:
1546 *p++ = s[i];
1547 break;
1548 }
1549 }
1550 len = p-dest;
1551 *p++ = '\0';
1552 return len;
1553 }
1554
1555 /* Returns a dynamically allocated copy of the current token in the
1556 * parser context. The function perform conversion of escapes if
1557 * the token is of type JIM_TT_ESC.
1558 *
1559 * Note that after the conversion, tokens that are grouped with
1560 * braces in the source code, are always recognizable from the
1561 * identical string obtained in a different way from the type.
1562 *
1563 * For exmple the string:
1564 *
1565 * {expand}$a
1566 *
1567 * will return as first token "expand", of type JIM_TT_STR
1568 *
1569 * While the string:
1570 *
1571 * expand$a
1572 *
1573 * will return as first token "expand", of type JIM_TT_ESC
1574 */
1575 char *JimParserGetToken(struct JimParserCtx *pc,
1576 int *lenPtr, int *typePtr, int *linePtr)
1577 {
1578 const char *start, *end;
1579 char *token;
1580 int len;
1581
1582 start = JimParserTstart(pc);
1583 end = JimParserTend(pc);
1584 if (start > end) {
1585 if (lenPtr) *lenPtr = 0;
1586 if (typePtr) *typePtr = JimParserTtype(pc);
1587 if (linePtr) *linePtr = JimParserTline(pc);
1588 token = Jim_Alloc(1);
1589 token[0] = '\0';
1590 return token;
1591 }
1592 len = (end-start)+1;
1593 token = Jim_Alloc(len+1);
1594 if (JimParserTtype(pc) != JIM_TT_ESC) {
1595 /* No escape conversion needed? Just copy it. */
1596 memcpy(token, start, len);
1597 token[len] = '\0';
1598 } else {
1599 /* Else convert the escape chars. */
1600 len = JimEscape(token, start, len);
1601 }
1602 if (lenPtr) *lenPtr = len;
1603 if (typePtr) *typePtr = JimParserTtype(pc);
1604 if (linePtr) *linePtr = JimParserTline(pc);
1605 return token;
1606 }
1607
1608 /* The following functin is not really part of the parsing engine of Jim,
1609 * but it somewhat related. Given an string and its length, it tries
1610 * to guess if the script is complete or there are instead " " or { }
1611 * open and not completed. This is useful for interactive shells
1612 * implementation and for [info complete].
1613 *
1614 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1615 * '{' on scripts incomplete missing one or more '}' to be balanced.
1616 * '"' on scripts incomplete missing a '"' char.
1617 *
1618 * If the script is complete, 1 is returned, otherwise 0. */
1619 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1620 {
1621 int level = 0;
1622 int state = ' ';
1623
1624 while(len) {
1625 switch (*s) {
1626 case '\\':
1627 if (len > 1)
1628 s++;
1629 break;
1630 case '"':
1631 if (state == ' ') {
1632 state = '"';
1633 } else if (state == '"') {
1634 state = ' ';
1635 }
1636 break;
1637 case '{':
1638 if (state == '{') {
1639 level++;
1640 } else if (state == ' ') {
1641 state = '{';
1642 level++;
1643 }
1644 break;
1645 case '}':
1646 if (state == '{') {
1647 level--;
1648 if (level == 0)
1649 state = ' ';
1650 }
1651 break;
1652 }
1653 s++;
1654 len--;
1655 }
1656 if (stateCharPtr)
1657 *stateCharPtr = state;
1658 return state == ' ';
1659 }
1660
1661 /* -----------------------------------------------------------------------------
1662 * Tcl Lists parsing
1663 * ---------------------------------------------------------------------------*/
1664 static int JimParseListSep(struct JimParserCtx *pc);
1665 static int JimParseListStr(struct JimParserCtx *pc);
1666
1667 int JimParseList(struct JimParserCtx *pc)
1668 {
1669 if (pc->len == 0) {
1670 pc->tstart = pc->tend = pc->p;
1671 pc->tline = pc->linenr;
1672 pc->tt = JIM_TT_EOL;
1673 pc->eof = 1;
1674 return JIM_OK;
1675 }
1676 switch(*pc->p) {
1677 case ' ':
1678 case '\n':
1679 case '\t':
1680 case '\r':
1681 if (pc->state == JIM_PS_DEF)
1682 return JimParseListSep(pc);
1683 else
1684 return JimParseListStr(pc);
1685 break;
1686 default:
1687 return JimParseListStr(pc);
1688 break;
1689 }
1690 return JIM_OK;
1691 }
1692
1693 int JimParseListSep(struct JimParserCtx *pc)
1694 {
1695 pc->tstart = pc->p;
1696 pc->tline = pc->linenr;
1697 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1698 {
1699 pc->p++; pc->len--;
1700 }
1701 pc->tend = pc->p-1;
1702 pc->tt = JIM_TT_SEP;
1703 return JIM_OK;
1704 }
1705
1706 int JimParseListStr(struct JimParserCtx *pc)
1707 {
1708 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1709 pc->tt == JIM_TT_NONE);
1710 if (newword && *pc->p == '{') {
1711 return JimParseBrace(pc);
1712 } else if (newword && *pc->p == '"') {
1713 pc->state = JIM_PS_QUOTE;
1714 pc->p++; pc->len--;
1715 }
1716 pc->tstart = pc->p;
1717 pc->tline = pc->linenr;
1718 while (1) {
1719 if (pc->len == 0) {
1720 pc->tend = pc->p-1;
1721 pc->tt = JIM_TT_ESC;
1722 return JIM_OK;
1723 }
1724 switch(*pc->p) {
1725 case '\\':
1726 pc->p++; pc->len--;
1727 break;
1728 case ' ':
1729 case '\t':
1730 case '\n':
1731 case '\r':
1732 if (pc->state == JIM_PS_DEF) {
1733 pc->tend = pc->p-1;
1734 pc->tt = JIM_TT_ESC;
1735 return JIM_OK;
1736 } else if (*pc->p == '\n') {
1737 pc->linenr++;
1738 }
1739 break;
1740 case '"':
1741 if (pc->state == JIM_PS_QUOTE) {
1742 pc->tend = pc->p-1;
1743 pc->tt = JIM_TT_ESC;
1744 pc->p++; pc->len--;
1745 pc->state = JIM_PS_DEF;
1746 return JIM_OK;
1747 }
1748 break;
1749 }
1750 pc->p++; pc->len--;
1751 }
1752 return JIM_OK; /* unreached */
1753 }
1754
1755 /* -----------------------------------------------------------------------------
1756 * Jim_Obj related functions
1757 * ---------------------------------------------------------------------------*/
1758
1759 /* Return a new initialized object. */
1760 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1761 {
1762 Jim_Obj *objPtr;
1763
1764 /* -- Check if there are objects in the free list -- */
1765 if (interp->freeList != NULL) {
1766 /* -- Unlink the object from the free list -- */
1767 objPtr = interp->freeList;
1768 interp->freeList = objPtr->nextObjPtr;
1769 } else {
1770 /* -- No ready to use objects: allocate a new one -- */
1771 objPtr = Jim_Alloc(sizeof(*objPtr));
1772 }
1773
1774 /* Object is returned with refCount of 0. Every
1775 * kind of GC implemented should take care to don't try
1776 * to scan objects with refCount == 0. */
1777 objPtr->refCount = 0;
1778 /* All the other fields are left not initialized to save time.
1779 * The caller will probably want set they to the right
1780 * value anyway. */
1781
1782 /* -- Put the object into the live list -- */
1783 objPtr->prevObjPtr = NULL;
1784 objPtr->nextObjPtr = interp->liveList;
1785 if (interp->liveList)
1786 interp->liveList->prevObjPtr = objPtr;
1787 interp->liveList = objPtr;
1788
1789 return objPtr;
1790 }
1791
1792 /* Free an object. Actually objects are never freed, but
1793 * just moved to the free objects list, where they will be
1794 * reused by Jim_NewObj(). */
1795 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1796 {
1797 /* Check if the object was already freed, panic. */
1798 if (objPtr->refCount != 0) {
1799 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1800 objPtr->refCount);
1801 }
1802 /* Free the internal representation */
1803 Jim_FreeIntRep(interp, objPtr);
1804 /* Free the string representation */
1805 if (objPtr->bytes != NULL) {
1806 if (objPtr->bytes != JimEmptyStringRep)
1807 Jim_Free(objPtr->bytes);
1808 }
1809 /* Unlink the object from the live objects list */
1810 if (objPtr->prevObjPtr)
1811 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1812 if (objPtr->nextObjPtr)
1813 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1814 if (interp->liveList == objPtr)
1815 interp->liveList = objPtr->nextObjPtr;
1816 /* Link the object into the free objects list */
1817 objPtr->prevObjPtr = NULL;
1818 objPtr->nextObjPtr = interp->freeList;
1819 if (interp->freeList)
1820 interp->freeList->prevObjPtr = objPtr;
1821 interp->freeList = objPtr;
1822 objPtr->refCount = -1;
1823 }
1824
1825 /* Invalidate the string representation of an object. */
1826 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1827 {
1828 if (objPtr->bytes != NULL) {
1829 if (objPtr->bytes != JimEmptyStringRep)
1830 Jim_Free(objPtr->bytes);
1831 }
1832 objPtr->bytes = NULL;
1833 }
1834
1835 #define Jim_SetStringRep(o, b, l) \
1836 do { (o)->bytes = b; (o)->length = l; } while (0)
1837
1838 /* Set the initial string representation for an object.
1839 * Does not try to free an old one. */
1840 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1841 {
1842 if (length == 0) {
1843 objPtr->bytes = JimEmptyStringRep;
1844 objPtr->length = 0;
1845 } else {
1846 objPtr->bytes = Jim_Alloc(length+1);
1847 objPtr->length = length;
1848 memcpy(objPtr->bytes, bytes, length);
1849 objPtr->bytes[length] = '\0';
1850 }
1851 }
1852
1853 /* Duplicate an object. The returned object has refcount = 0. */
1854 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1855 {
1856 Jim_Obj *dupPtr;
1857
1858 dupPtr = Jim_NewObj(interp);
1859 if (objPtr->bytes == NULL) {
1860 /* Object does not have a valid string representation. */
1861 dupPtr->bytes = NULL;
1862 } else {
1863 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1864 }
1865 if (objPtr->typePtr != NULL) {
1866 if (objPtr->typePtr->dupIntRepProc == NULL) {
1867 dupPtr->internalRep = objPtr->internalRep;
1868 } else {
1869 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1870 }
1871 dupPtr->typePtr = objPtr->typePtr;
1872 } else {
1873 dupPtr->typePtr = NULL;
1874 }
1875 return dupPtr;
1876 }
1877
1878 /* Return the string representation for objPtr. If the object
1879 * string representation is invalid, calls the method to create
1880 * a new one starting from the internal representation of the object. */
1881 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1882 {
1883 if (objPtr->bytes == NULL) {
1884 /* Invalid string repr. Generate it. */
1885 if (objPtr->typePtr->updateStringProc == NULL) {
1886 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1887 objPtr->typePtr->name);
1888 }
1889 objPtr->typePtr->updateStringProc(objPtr);
1890 }
1891 if (lenPtr)
1892 *lenPtr = objPtr->length;
1893 return objPtr->bytes;
1894 }
1895
1896 /* Just returns the length of the object's string rep */
1897 int Jim_Length(Jim_Obj *objPtr)
1898 {
1899 int len;
1900
1901 Jim_GetString(objPtr, &len);
1902 return len;
1903 }
1904
1905 /* -----------------------------------------------------------------------------
1906 * String Object
1907 * ---------------------------------------------------------------------------*/
1908 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1909 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1910
1911 static Jim_ObjType stringObjType = {
1912 "string",
1913 NULL,
1914 DupStringInternalRep,
1915 NULL,
1916 JIM_TYPE_REFERENCES,
1917 };
1918
1919 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1920 {
1921 JIM_NOTUSED(interp);
1922
1923 /* This is a bit subtle: the only caller of this function
1924 * should be Jim_DuplicateObj(), that will copy the
1925 * string representaion. After the copy, the duplicated
1926 * object will not have more room in teh buffer than
1927 * srcPtr->length bytes. So we just set it to length. */
1928 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1929 }
1930
1931 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1932 {
1933 /* Get a fresh string representation. */
1934 (void) Jim_GetString(objPtr, NULL);
1935 /* Free any other internal representation. */
1936 Jim_FreeIntRep(interp, objPtr);
1937 /* Set it as string, i.e. just set the maxLength field. */
1938 objPtr->typePtr = &stringObjType;
1939 objPtr->internalRep.strValue.maxLength = objPtr->length;
1940 return JIM_OK;
1941 }
1942
1943 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1944 {
1945 Jim_Obj *objPtr = Jim_NewObj(interp);
1946
1947 if (len == -1)
1948 len = strlen(s);
1949 /* Alloc/Set the string rep. */
1950 if (len == 0) {
1951 objPtr->bytes = JimEmptyStringRep;
1952 objPtr->length = 0;
1953 } else {
1954 objPtr->bytes = Jim_Alloc(len+1);
1955 objPtr->length = len;
1956 memcpy(objPtr->bytes, s, len);
1957 objPtr->bytes[len] = '\0';
1958 }
1959
1960 /* No typePtr field for the vanilla string object. */
1961 objPtr->typePtr = NULL;
1962 return objPtr;
1963 }
1964
1965 /* This version does not try to duplicate the 's' pointer, but
1966 * use it directly. */
1967 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
1968 {
1969 Jim_Obj *objPtr = Jim_NewObj(interp);
1970
1971 if (len == -1)
1972 len = strlen(s);
1973 Jim_SetStringRep(objPtr, s, len);
1974 objPtr->typePtr = NULL;
1975 return objPtr;
1976 }
1977
1978 /* Low-level string append. Use it only against objects
1979 * of type "string". */
1980 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
1981 {
1982 int needlen;
1983
1984 if (len == -1)
1985 len = strlen(str);
1986 needlen = objPtr->length + len;
1987 if (objPtr->internalRep.strValue.maxLength < needlen ||
1988 objPtr->internalRep.strValue.maxLength == 0) {
1989 if (objPtr->bytes == JimEmptyStringRep) {
1990 objPtr->bytes = Jim_Alloc((needlen*2)+1);
1991 } else {
1992 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
1993 }
1994 objPtr->internalRep.strValue.maxLength = needlen*2;
1995 }
1996 memcpy(objPtr->bytes + objPtr->length, str, len);
1997 objPtr->bytes[objPtr->length+len] = '\0';
1998 objPtr->length += len;
1999 }
2000
2001 /* Low-level wrapper to append an object. */
2002 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2003 {
2004 int len;
2005 const char *str;
2006
2007 str = Jim_GetString(appendObjPtr, &len);
2008 StringAppendString(objPtr, str, len);
2009 }
2010
2011 /* Higher level API to append strings to objects. */
2012 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2013 int len)
2014 {
2015 if (Jim_IsShared(objPtr))
2016 Jim_Panic(interp,"Jim_AppendString called with shared object");
2017 if (objPtr->typePtr != &stringObjType)
2018 SetStringFromAny(interp, objPtr);
2019 StringAppendString(objPtr, str, len);
2020 }
2021
2022 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2023 Jim_Obj *appendObjPtr)
2024 {
2025 int len;
2026 const char *str;
2027
2028 str = Jim_GetString(appendObjPtr, &len);
2029 Jim_AppendString(interp, objPtr, str, len);
2030 }
2031
2032 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2033 {
2034 va_list ap;
2035
2036 if (objPtr->typePtr != &stringObjType)
2037 SetStringFromAny(interp, objPtr);
2038 va_start(ap, objPtr);
2039 while (1) {
2040 char *s = va_arg(ap, char*);
2041
2042 if (s == NULL) break;
2043 Jim_AppendString(interp, objPtr, s, -1);
2044 }
2045 va_end(ap);
2046 }
2047
2048 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2049 {
2050 const char *aStr, *bStr;
2051 int aLen, bLen, i;
2052
2053 if (aObjPtr == bObjPtr) return 1;
2054 aStr = Jim_GetString(aObjPtr, &aLen);
2055 bStr = Jim_GetString(bObjPtr, &bLen);
2056 if (aLen != bLen) return 0;
2057 if (nocase == 0)
2058 return memcmp(aStr, bStr, aLen) == 0;
2059 for (i = 0; i < aLen; i++) {
2060 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2061 return 0;
2062 }
2063 return 1;
2064 }
2065
2066 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2067 int nocase)
2068 {
2069 const char *pattern, *string;
2070 int patternLen, stringLen;
2071
2072 pattern = Jim_GetString(patternObjPtr, &patternLen);
2073 string = Jim_GetString(objPtr, &stringLen);
2074 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2075 }
2076
2077 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2078 Jim_Obj *secondObjPtr, int nocase)
2079 {
2080 const char *s1, *s2;
2081 int l1, l2;
2082
2083 s1 = Jim_GetString(firstObjPtr, &l1);
2084 s2 = Jim_GetString(secondObjPtr, &l2);
2085 return JimStringCompare(s1, l1, s2, l2, nocase);
2086 }
2087
2088 /* Convert a range, as returned by Jim_GetRange(), into
2089 * an absolute index into an object of the specified length.
2090 * This function may return negative values, or values
2091 * bigger or equal to the length of the list if the index
2092 * is out of range. */
2093 static int JimRelToAbsIndex(int len, int index)
2094 {
2095 if (index < 0)
2096 return len + index;
2097 return index;
2098 }
2099
2100 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2101 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2102 * for implementation of commands like [string range] and [lrange].
2103 *
2104 * The resulting range is guaranteed to address valid elements of
2105 * the structure. */
2106 static void JimRelToAbsRange(int len, int first, int last,
2107 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2108 {
2109 int rangeLen;
2110
2111 if (first > last) {
2112 rangeLen = 0;
2113 } else {
2114 rangeLen = last-first+1;
2115 if (rangeLen) {
2116 if (first < 0) {
2117 rangeLen += first;
2118 first = 0;
2119 }
2120 if (last >= len) {
2121 rangeLen -= (last-(len-1));
2122 last = len-1;
2123 }
2124 }
2125 }
2126 if (rangeLen < 0) rangeLen = 0;
2127
2128 *firstPtr = first;
2129 *lastPtr = last;
2130 *rangeLenPtr = rangeLen;
2131 }
2132
2133 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2134 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2135 {
2136 int first, last;
2137 const char *str;
2138 int len, rangeLen;
2139
2140 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2141 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2142 return NULL;
2143 str = Jim_GetString(strObjPtr, &len);
2144 first = JimRelToAbsIndex(len, first);
2145 last = JimRelToAbsIndex(len, last);
2146 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2147 return Jim_NewStringObj(interp, str+first, rangeLen);
2148 }
2149
2150 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2151 {
2152 char *buf = Jim_Alloc(strObjPtr->length+1);
2153 int i;
2154
2155 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2156 for (i = 0; i < strObjPtr->length; i++)
2157 buf[i] = tolower(buf[i]);
2158 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2159 }
2160
2161 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2162 {
2163 char *buf = Jim_Alloc(strObjPtr->length+1);
2164 int i;
2165
2166 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2167 for (i = 0; i < strObjPtr->length; i++)
2168 buf[i] = toupper(buf[i]);
2169 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2170 }
2171
2172 /* This is the core of the [format] command.
2173 * TODO: Lots of things work - via a hack
2174 * However, no format item can be >= JIM_MAX_FMT
2175 */
2176 #define JIM_MAX_FMT 2048
2177 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2178 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2179 {
2180 const char *fmt, *_fmt;
2181 int fmtLen;
2182 Jim_Obj *resObjPtr;
2183
2184
2185 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2186 _fmt = fmt;
2187 resObjPtr = Jim_NewStringObj(interp, "", 0);
2188 while (fmtLen) {
2189 const char *p = fmt;
2190 char spec[2], c;
2191 jim_wide wideValue;
2192 double doubleValue;
2193 /* we cheat and use Sprintf()! */
2194 char fmt_str[100];
2195 char *cp;
2196 int width;
2197 int ljust;
2198 int zpad;
2199 int spad;
2200 int altfm;
2201 int forceplus;
2202 int prec;
2203 int inprec;
2204 int haveprec;
2205 int accum;
2206
2207 while (*fmt != '%' && fmtLen) {
2208 fmt++; fmtLen--;
2209 }
2210 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2211 if (fmtLen == 0)
2212 break;
2213 fmt++; fmtLen--; /* skip '%' */
2214 zpad = 0;
2215 spad = 0;
2216 width = -1;
2217 ljust = 0;
2218 altfm = 0;
2219 forceplus = 0;
2220 inprec = 0;
2221 haveprec = 0;
2222 prec = -1; /* not found yet */
2223 next_fmt:
2224 if( fmtLen <= 0 ){
2225 break;
2226 }
2227 switch( *fmt ){
2228 /* terminals */
2229 case 'b': /* binary - not all printfs() do this */
2230 case 's': /* string */
2231 case 'i': /* integer */
2232 case 'd': /* decimal */
2233 case 'x': /* hex */
2234 case 'X': /* CAP hex */
2235 case 'c': /* char */
2236 case 'o': /* octal */
2237 case 'u': /* unsigned */
2238 case 'f': /* float */
2239 break;
2240
2241 /* non-terminals */
2242 case '0': /* zero pad */
2243 zpad = 1;
2244 *fmt++; fmtLen--;
2245 goto next_fmt;
2246 break;
2247 case '+':
2248 forceplus = 1;
2249 *fmt++; fmtLen--;
2250 goto next_fmt;
2251 break;
2252 case ' ': /* sign space */
2253 spad = 1;
2254 *fmt++; fmtLen--;
2255 goto next_fmt;
2256 break;
2257 case '-':
2258 ljust = 1;
2259 *fmt++; fmtLen--;
2260 goto next_fmt;
2261 break;
2262 case '#':
2263 altfm = 1;
2264 *fmt++; fmtLen--;
2265 goto next_fmt;
2266
2267 case '.':
2268 inprec = 1;
2269 *fmt++; fmtLen--;
2270 goto next_fmt;
2271 break;
2272 case '1':
2273 case '2':
2274 case '3':
2275 case '4':
2276 case '5':
2277 case '6':
2278 case '7':
2279 case '8':
2280 case '9':
2281 accum = 0;
2282 while( isdigit(*fmt) && (fmtLen > 0) ){
2283 accum = (accum * 10) + (*fmt - '0');
2284 fmt++; fmtLen--;
2285 }
2286 if( inprec ){
2287 haveprec = 1;
2288 prec = accum;
2289 } else {
2290 width = accum;
2291 }
2292 goto next_fmt;
2293 case '*':
2294 /* suck up the next item as an integer */
2295 *fmt++; fmtLen--;
2296 objc--;
2297 if( objc <= 0 ){
2298 goto not_enough_args;
2299 }
2300 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2301 Jim_FreeNewObj(interp, resObjPtr );
2302 return NULL;
2303 }
2304 if( inprec ){
2305 haveprec = 1;
2306 prec = wideValue;
2307 if( prec < 0 ){
2308 /* man 3 printf says */
2309 /* if prec is negative, it is zero */
2310 prec = 0;
2311 }
2312 } else {
2313 width = wideValue;
2314 if( width < 0 ){
2315 ljust = 1;
2316 width = -width;
2317 }
2318 }
2319 objv++;
2320 goto next_fmt;
2321 break;
2322 }
2323
2324
2325 if (*fmt != '%') {
2326 if (objc == 0) {
2327 not_enough_args:
2328 Jim_FreeNewObj(interp, resObjPtr);
2329 Jim_SetResultString(interp,
2330 "not enough arguments for all format specifiers", -1);
2331 return NULL;
2332 } else {
2333 objc--;
2334 }
2335 }
2336
2337 /*
2338 * Create the formatter
2339 * cause we cheat and use sprintf()
2340 */
2341 cp = fmt_str;
2342 *cp++ = '%';
2343 if( altfm ){
2344 *cp++ = '#';
2345 }
2346 if( forceplus ){
2347 *cp++ = '+';
2348 } else if( spad ){
2349 /* PLUS overrides */
2350 *cp++ = ' ';
2351 }
2352 if( ljust ){
2353 *cp++ = '-';
2354 }
2355 if( zpad ){
2356 *cp++ = '0';
2357 }
2358 if( width > 0 ){
2359 sprintf( cp, "%d", width );
2360 /* skip ahead */
2361 cp = strchr(cp,0);
2362 }
2363 /* did we find a period? */
2364 if( inprec ){
2365 /* then add it */
2366 *cp++ = '.';
2367 /* did something occur after the period? */
2368 if( haveprec ){
2369 sprintf( cp, "%d", prec );
2370 }
2371 cp = strchr(cp,0);
2372 }
2373 *cp = 0;
2374
2375 /* here we do the work */
2376 /* actually - we make sprintf() do it for us */
2377 switch(*fmt) {
2378 case 's':
2379 *cp++ = 's';
2380 *cp = 0;
2381 /* BUG: we do not handled embeded NULLs */
2382 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2383 break;
2384 case 'c':
2385 *cp++ = 'c';
2386 *cp = 0;
2387 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2388 Jim_FreeNewObj(interp, resObjPtr);
2389 return NULL;
2390 }
2391 c = (char) wideValue;
2392 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2393 break;
2394 case 'f':
2395 case 'F':
2396 case 'g':
2397 case 'G':
2398 case 'e':
2399 case 'E':
2400 *cp++ = *fmt;
2401 *cp = 0;
2402 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2403 Jim_FreeNewObj( interp, resObjPtr );
2404 return NULL;
2405 }
2406 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2407 break;
2408 case 'b':
2409 case 'd':
2410 case 'i':
2411 case 'u':
2412 case 'x':
2413 case 'X':
2414 /* jim widevaluse are 64bit */
2415 if( sizeof(jim_wide) == sizeof(long long) ){
2416 *cp++ = 'l';
2417 *cp++ = 'l';
2418 } else {
2419 *cp++ = 'l';
2420 }
2421 *cp++ = *fmt;
2422 *cp = 0;
2423 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2424 Jim_FreeNewObj(interp, resObjPtr);
2425 return NULL;
2426 }
2427 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2428 break;
2429 case '%':
2430 sprintf_buf[0] = '%';
2431 sprintf_buf[1] = 0;
2432 objv--; /* undo the objv++ below */
2433 break;
2434 default:
2435 spec[0] = *fmt; spec[1] = '\0';
2436 Jim_FreeNewObj(interp, resObjPtr);
2437 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2438 Jim_AppendStrings(interp, Jim_GetResult(interp),
2439 "bad field specifier \"", spec, "\"", NULL);
2440 return NULL;
2441 }
2442 /* force terminate */
2443 #if 0
2444 printf("FMT was: %s\n", fmt_str );
2445 printf("RES was: |%s|\n", sprintf_buf );
2446 #endif
2447
2448 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2449 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2450 /* next obj */
2451 objv++;
2452 fmt++;
2453 fmtLen--;
2454 }
2455 return resObjPtr;
2456 }
2457
2458 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2459 int objc, Jim_Obj *const *objv)
2460 {
2461 char *sprintf_buf=malloc(JIM_MAX_FMT);
2462 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2463 free(sprintf_buf);
2464 return t;
2465 }
2466
2467 /* -----------------------------------------------------------------------------
2468 * Compared String Object
2469 * ---------------------------------------------------------------------------*/
2470
2471 /* This is strange object that allows to compare a C literal string
2472 * with a Jim object in very short time if the same comparison is done
2473 * multiple times. For example every time the [if] command is executed,
2474 * Jim has to check if a given argument is "else". This comparions if
2475 * the code has no errors are true most of the times, so we can cache
2476 * inside the object the pointer of the string of the last matching
2477 * comparison. Because most C compilers perform literal sharing,
2478 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2479 * this works pretty well even if comparisons are at different places
2480 * inside the C code. */
2481
2482 static Jim_ObjType comparedStringObjType = {
2483 "compared-string",
2484 NULL,
2485 NULL,
2486 NULL,
2487 JIM_TYPE_REFERENCES,
2488 };
2489
2490 /* The only way this object is exposed to the API is via the following
2491 * function. Returns true if the string and the object string repr.
2492 * are the same, otherwise zero is returned.
2493 *
2494 * Note: this isn't binary safe, but it hardly needs to be.*/
2495 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2496 const char *str)
2497 {
2498 if (objPtr->typePtr == &comparedStringObjType &&
2499 objPtr->internalRep.ptr == str)
2500 return 1;
2501 else {
2502 const char *objStr = Jim_GetString(objPtr, NULL);
2503 if (strcmp(str, objStr) != 0) return 0;
2504 if (objPtr->typePtr != &comparedStringObjType) {
2505 Jim_FreeIntRep(interp, objPtr);
2506 objPtr->typePtr = &comparedStringObjType;
2507 }
2508 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2509 return 1;
2510 }
2511 }
2512
2513 int qsortCompareStringPointers(const void *a, const void *b)
2514 {
2515 char * const *sa = (char * const *)a;
2516 char * const *sb = (char * const *)b;
2517 return strcmp(*sa, *sb);
2518 }
2519
2520 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2521 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2522 {
2523 const char * const *entryPtr = NULL;
2524 char **tablePtrSorted;
2525 int i, count = 0;
2526
2527 *indexPtr = -1;
2528 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2529 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2530 *indexPtr = i;
2531 return JIM_OK;
2532 }
2533 count++; /* If nothing matches, this will reach the len of tablePtr */
2534 }
2535 if (flags & JIM_ERRMSG) {
2536 if (name == NULL)
2537 name = "option";
2538 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2539 Jim_AppendStrings(interp, Jim_GetResult(interp),
2540 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2541 NULL);
2542 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2543 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2544 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2545 for (i = 0; i < count; i++) {
2546 if (i+1 == count && count > 1)
2547 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2548 Jim_AppendString(interp, Jim_GetResult(interp),
2549 tablePtrSorted[i], -1);
2550 if (i+1 != count)
2551 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2552 }
2553 Jim_Free(tablePtrSorted);
2554 }
2555 return JIM_ERR;
2556 }
2557
2558 int Jim_GetNvp(Jim_Interp *interp,
2559 Jim_Obj *objPtr,
2560 const Jim_Nvp *nvp_table,
2561 const Jim_Nvp ** result)
2562 {
2563 Jim_Nvp *n;
2564 int e;
2565
2566 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2567 if( e == JIM_ERR ){
2568 return e;
2569 }
2570
2571 /* Success? found? */
2572 if( n->name ){
2573 /* remove const */
2574 *result = (Jim_Nvp *)n;
2575 return JIM_OK;
2576 } else {
2577 return JIM_ERR;
2578 }
2579 }
2580
2581 /* -----------------------------------------------------------------------------
2582 * Source Object
2583 *
2584 * This object is just a string from the language point of view, but
2585 * in the internal representation it contains the filename and line number
2586 * where this given token was read. This information is used by
2587 * Jim_EvalObj() if the object passed happens to be of type "source".
2588 *
2589 * This allows to propagate the information about line numbers and file
2590 * names and give error messages with absolute line numbers.
2591 *
2592 * Note that this object uses shared strings for filenames, and the
2593 * pointer to the filename together with the line number is taken into
2594 * the space for the "inline" internal represenation of the Jim_Object,
2595 * so there is almost memory zero-overhead.
2596 *
2597 * Also the object will be converted to something else if the given
2598 * token it represents in the source file is not something to be
2599 * evaluated (not a script), and will be specialized in some other way,
2600 * so the time overhead is alzo null.
2601 * ---------------------------------------------------------------------------*/
2602
2603 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2604 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2605
2606 static Jim_ObjType sourceObjType = {
2607 "source",
2608 FreeSourceInternalRep,
2609 DupSourceInternalRep,
2610 NULL,
2611 JIM_TYPE_REFERENCES,
2612 };
2613
2614 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2615 {
2616 Jim_ReleaseSharedString(interp,
2617 objPtr->internalRep.sourceValue.fileName);
2618 }
2619
2620 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2621 {
2622 dupPtr->internalRep.sourceValue.fileName =
2623 Jim_GetSharedString(interp,
2624 srcPtr->internalRep.sourceValue.fileName);
2625 dupPtr->internalRep.sourceValue.lineNumber =
2626 dupPtr->internalRep.sourceValue.lineNumber;
2627 dupPtr->typePtr = &sourceObjType;
2628 }
2629
2630 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2631 const char *fileName, int lineNumber)
2632 {
2633 if (Jim_IsShared(objPtr))
2634 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2635 if (objPtr->typePtr != NULL)
2636 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2637 objPtr->internalRep.sourceValue.fileName =
2638 Jim_GetSharedString(interp, fileName);
2639 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2640 objPtr->typePtr = &sourceObjType;
2641 }
2642
2643 /* -----------------------------------------------------------------------------
2644 * Script Object
2645 * ---------------------------------------------------------------------------*/
2646
2647 #define JIM_CMDSTRUCT_EXPAND -1
2648
2649 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2650 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2651 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2652
2653 static Jim_ObjType scriptObjType = {
2654 "script",
2655 FreeScriptInternalRep,
2656 DupScriptInternalRep,
2657 NULL,
2658 JIM_TYPE_REFERENCES,
2659 };
2660
2661 /* The ScriptToken structure represents every token into a scriptObj.
2662 * Every token contains an associated Jim_Obj that can be specialized
2663 * by commands operating on it. */
2664 typedef struct ScriptToken {
2665 int type;
2666 Jim_Obj *objPtr;
2667 int linenr;
2668 } ScriptToken;
2669
2670 /* This is the script object internal representation. An array of
2671 * ScriptToken structures, with an associated command structure array.
2672 * The command structure is a pre-computed representation of the
2673 * command length and arguments structure as a simple liner array
2674 * of integers.
2675 *
2676 * For example the script:
2677 *
2678 * puts hello
2679 * set $i $x$y [foo]BAR
2680 *
2681 * will produce a ScriptObj with the following Tokens:
2682 *
2683 * ESC puts
2684 * SEP
2685 * ESC hello
2686 * EOL
2687 * ESC set
2688 * EOL
2689 * VAR i
2690 * SEP
2691 * VAR x
2692 * VAR y
2693 * SEP
2694 * CMD foo
2695 * ESC BAR
2696 * EOL
2697 *
2698 * This is a description of the tokens, separators, and of lines.
2699 * The command structure instead represents the number of arguments
2700 * of every command, followed by the tokens of which every argument
2701 * is composed. So for the example script, the cmdstruct array will
2702 * contain:
2703 *
2704 * 2 1 1 4 1 1 2 2
2705 *
2706 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2707 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2708 * composed of single tokens (1 1) and the last two of double tokens
2709 * (2 2).
2710 *
2711 * The precomputation of the command structure makes Jim_Eval() faster,
2712 * and simpler because there aren't dynamic lengths / allocations.
2713 *
2714 * -- {expand} handling --
2715 *
2716 * Expand is handled in a special way. When a command
2717 * contains at least an argument with the {expand} prefix,
2718 * the command structure presents a -1 before the integer
2719 * describing the number of arguments. This is used in order
2720 * to send the command exection to a different path in case
2721 * of {expand} and guarantee a fast path for the more common
2722 * case. Also, the integers describing the number of tokens
2723 * are expressed with negative sign, to allow for fast check
2724 * of what's an {expand}-prefixed argument and what not.
2725 *
2726 * For example the command:
2727 *
2728 * list {expand}{1 2}
2729 *
2730 * Will produce the following cmdstruct array:
2731 *
2732 * -1 2 1 -2
2733 *
2734 * -- the substFlags field of the structure --
2735 *
2736 * The scriptObj structure is used to represent both "script" objects
2737 * and "subst" objects. In the second case, the cmdStruct related
2738 * fields are not used at all, but there is an additional field used
2739 * that is 'substFlags': this represents the flags used to turn
2740 * the string into the intenral representation used to perform the
2741 * substitution. If this flags are not what the application requires
2742 * the scriptObj is created again. For example the script:
2743 *
2744 * subst -nocommands $string
2745 * subst -novariables $string
2746 *
2747 * Will recreate the internal representation of the $string object
2748 * two times.
2749 */
2750 typedef struct ScriptObj {
2751 int len; /* Length as number of tokens. */
2752 int commands; /* number of top-level commands in script. */
2753 ScriptToken *token; /* Tokens array. */
2754 int *cmdStruct; /* commands structure */
2755 int csLen; /* length of the cmdStruct array. */
2756 int substFlags; /* flags used for the compilation of "subst" objects */
2757 int inUse; /* Used to share a ScriptObj. Currently
2758 only used by Jim_EvalObj() as protection against
2759 shimmering of the currently evaluated object. */
2760 char *fileName;
2761 } ScriptObj;
2762
2763 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2764 {
2765 int i;
2766 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2767
2768 script->inUse--;
2769 if (script->inUse != 0) return;
2770 for (i = 0; i < script->len; i++) {
2771 if (script->token[i].objPtr != NULL)
2772 Jim_DecrRefCount(interp, script->token[i].objPtr);
2773 }
2774 Jim_Free(script->token);
2775 Jim_Free(script->cmdStruct);
2776 Jim_Free(script->fileName);
2777 Jim_Free(script);
2778 }
2779
2780 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2781 {
2782 JIM_NOTUSED(interp);
2783 JIM_NOTUSED(srcPtr);
2784
2785 /* Just returns an simple string. */
2786 dupPtr->typePtr = NULL;
2787 }
2788
2789 /* Add a new token to the internal repr of a script object */
2790 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2791 char *strtoken, int len, int type, char *filename, int linenr)
2792 {
2793 int prevtype;
2794 struct ScriptToken *token;
2795
2796 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2797 script->token[script->len-1].type;
2798 /* Skip tokens without meaning, like words separators
2799 * following a word separator or an end of command and
2800 * so on. */
2801 if (prevtype == JIM_TT_EOL) {
2802 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2803 Jim_Free(strtoken);
2804 return;
2805 }
2806 } else if (prevtype == JIM_TT_SEP) {
2807 if (type == JIM_TT_SEP) {
2808 Jim_Free(strtoken);
2809 return;
2810 } else if (type == JIM_TT_EOL) {
2811 /* If an EOL is following by a SEP, drop the previous
2812 * separator. */
2813 script->len--;
2814 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2815 }
2816 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2817 type == JIM_TT_ESC && len == 0)
2818 {
2819 /* Don't add empty tokens used in interpolation */
2820 Jim_Free(strtoken);
2821 return;
2822 }
2823 /* Make space for a new istruction */
2824 script->len++;
2825 script->token = Jim_Realloc(script->token,
2826 sizeof(ScriptToken)*script->len);
2827 /* Initialize the new token */
2828 token = script->token+(script->len-1);
2829 token->type = type;
2830 /* Every object is intially as a string, but the
2831 * internal type may be specialized during execution of the
2832 * script. */
2833 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2834 /* To add source info to SEP and EOL tokens is useless because
2835 * they will never by called as arguments of Jim_EvalObj(). */
2836 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2837 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2838 Jim_IncrRefCount(token->objPtr);
2839 token->linenr = linenr;
2840 }
2841
2842 /* Add an integer into the command structure field of the script object. */
2843 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2844 {
2845 script->csLen++;
2846 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2847 sizeof(int)*script->csLen);
2848 script->cmdStruct[script->csLen-1] = val;
2849 }
2850
2851 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2852 * of objPtr. Search nested script objects recursively. */
2853 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2854 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2855 {
2856 int i;
2857
2858 for (i = 0; i < script->len; i++) {
2859 if (script->token[i].objPtr != objPtr &&
2860 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2861 return script->token[i].objPtr;
2862 }
2863 /* Enter recursively on scripts only if the object
2864 * is not the same as the one we are searching for
2865 * shared occurrences. */
2866 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2867 script->token[i].objPtr != objPtr) {
2868 Jim_Obj *foundObjPtr;
2869
2870 ScriptObj *subScript =
2871 script->token[i].objPtr->internalRep.ptr;
2872 /* Don't recursively enter the script we are trying
2873 * to make shared to avoid circular references. */
2874 if (subScript == scriptBarrier) continue;
2875 if (subScript != script) {
2876 foundObjPtr =
2877 ScriptSearchLiteral(interp, subScript,
2878 scriptBarrier, objPtr);
2879 if (foundObjPtr != NULL)
2880 return foundObjPtr;
2881 }
2882 }
2883 }
2884 return NULL;
2885 }
2886
2887 /* Share literals of a script recursively sharing sub-scripts literals. */
2888 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2889 ScriptObj *topLevelScript)
2890 {
2891 int i, j;
2892
2893 return;
2894 /* Try to share with toplevel object. */
2895 if (topLevelScript != NULL) {
2896 for (i = 0; i < script->len; i++) {
2897 Jim_Obj *foundObjPtr;
2898 char *str = script->token[i].objPtr->bytes;
2899
2900 if (script->token[i].objPtr->refCount != 1) continue;
2901 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2902 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2903 foundObjPtr = ScriptSearchLiteral(interp,
2904 topLevelScript,
2905 script, /* barrier */
2906 script->token[i].objPtr);
2907 if (foundObjPtr != NULL) {
2908 Jim_IncrRefCount(foundObjPtr);
2909 Jim_DecrRefCount(interp,
2910 script->token[i].objPtr);
2911 script->token[i].objPtr = foundObjPtr;
2912 }
2913 }
2914 }
2915 /* Try to share locally */
2916 for (i = 0; i < script->len; i++) {
2917 char *str = script->token[i].objPtr->bytes;
2918
2919 if (script->token[i].objPtr->refCount != 1) continue;
2920 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2921 for (j = 0; j < script->len; j++) {
2922 if (script->token[i].objPtr !=
2923 script->token[j].objPtr &&
2924 Jim_StringEqObj(script->token[i].objPtr,
2925 script->token[j].objPtr, 0))
2926 {
2927 Jim_IncrRefCount(script->token[j].objPtr);
2928 Jim_DecrRefCount(interp,
2929 script->token[i].objPtr);
2930 script->token[i].objPtr =
2931 script->token[j].objPtr;
2932 }
2933 }
2934 }
2935 }
2936
2937 /* This method takes the string representation of an object
2938 * as a Tcl script, and generates the pre-parsed internal representation
2939 * of the script. */
2940 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2941 {
2942 int scriptTextLen;
2943 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
2944 struct JimParserCtx parser;
2945 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
2946 ScriptToken *token;
2947 int args, tokens, start, end, i;
2948 int initialLineNumber;
2949 int propagateSourceInfo = 0;
2950
2951 script->len = 0;
2952 script->csLen = 0;
2953 script->commands = 0;
2954 script->token = NULL;
2955 script->cmdStruct = NULL;
2956 script->inUse = 1;
2957 /* Try to get information about filename / line number */
2958 if (objPtr->typePtr == &sourceObjType) {
2959 script->fileName =
2960 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
2961 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
2962 propagateSourceInfo = 1;
2963 } else {
2964 script->fileName = Jim_StrDup("?");
2965 initialLineNumber = 1;
2966 }
2967
2968 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
2969 while(!JimParserEof(&parser)) {
2970 char *token;
2971 int len, type, linenr;
2972
2973 JimParseScript(&parser);
2974 token = JimParserGetToken(&parser, &len, &type, &linenr);
2975 ScriptObjAddToken(interp, script, token, len, type,
2976 propagateSourceInfo ? script->fileName : NULL,
2977 linenr);
2978 }
2979 token = script->token;
2980
2981 /* Compute the command structure array
2982 * (see the ScriptObj struct definition for more info) */
2983 start = 0; /* Current command start token index */
2984 end = -1; /* Current command end token index */
2985 while (1) {
2986 int expand = 0; /* expand flag. set to 1 on {expand} form. */
2987 int interpolation = 0; /* set to 1 if there is at least one
2988 argument of the command obtained via
2989 interpolation of more tokens. */
2990 /* Search for the end of command, while
2991 * count the number of args. */
2992 start = ++end;
2993 if (start >= script->len) break;
2994 args = 1; /* Number of args in current command */
2995 while (token[end].type != JIM_TT_EOL) {
2996 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
2997 token[end-1].type == JIM_TT_EOL)
2998 {
2999 if (token[end].type == JIM_TT_STR &&
3000 token[end+1].type != JIM_TT_SEP &&
3001 token[end+1].type != JIM_TT_EOL &&
3002 (!strcmp(token[end].objPtr->bytes, "expand") ||
3003 !strcmp(token[end].objPtr->bytes, "*")))
3004 expand++;
3005 }
3006 if (token[end].type == JIM_TT_SEP)
3007 args++;
3008 end++;
3009 }
3010 interpolation = !((end-start+1) == args*2);
3011 /* Add the 'number of arguments' info into cmdstruct.
3012 * Negative value if there is list expansion involved. */
3013 if (expand)
3014 ScriptObjAddInt(script, -1);
3015 ScriptObjAddInt(script, args);
3016 /* Now add info about the number of tokens. */
3017 tokens = 0; /* Number of tokens in current argument. */
3018 expand = 0;
3019 for (i = start; i <= end; i++) {
3020 if (token[i].type == JIM_TT_SEP ||
3021 token[i].type == JIM_TT_EOL)
3022 {
3023 if (tokens == 1 && expand)
3024 expand = 0;
3025 ScriptObjAddInt(script,
3026 expand ? -tokens : tokens);
3027
3028 expand = 0;
3029 tokens = 0;
3030 continue;
3031 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3032 (!strcmp(token[i].objPtr->bytes, "expand") ||
3033 !strcmp(token[i].objPtr->bytes, "*")))
3034 {
3035 expand++;
3036 }
3037 tokens++;
3038 }
3039 }
3040 /* Perform literal sharing, but only for objects that appear
3041 * to be scripts written as literals inside the source code,
3042 * and not computed at runtime. Literal sharing is a costly
3043 * operation that should be done only against objects that
3044 * are likely to require compilation only the first time, and
3045 * then are executed multiple times. */
3046 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3047 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3048 if (bodyObjPtr->typePtr == &scriptObjType) {
3049 ScriptObj *bodyScript =
3050 bodyObjPtr->internalRep.ptr;
3051 ScriptShareLiterals(interp, script, bodyScript);
3052 }
3053 } else if (propagateSourceInfo) {
3054 ScriptShareLiterals(interp, script, NULL);
3055 }
3056 /* Free the old internal rep and set the new one. */
3057 Jim_FreeIntRep(interp, objPtr);
3058 Jim_SetIntRepPtr(objPtr, script);
3059 objPtr->typePtr = &scriptObjType;
3060 return JIM_OK;
3061 }
3062
3063 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3064 {
3065 if (objPtr->typePtr != &scriptObjType) {
3066 SetScriptFromAny(interp, objPtr);
3067 }
3068 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3069 }
3070
3071 /* -----------------------------------------------------------------------------
3072 * Commands
3073 * ---------------------------------------------------------------------------*/
3074
3075 /* Commands HashTable Type.
3076 *
3077 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3078 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3079 {
3080 Jim_Cmd *cmdPtr = (void*) val;
3081
3082 if (cmdPtr->cmdProc == NULL) {
3083 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3084 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3085 if (cmdPtr->staticVars) {
3086 Jim_FreeHashTable(cmdPtr->staticVars);
3087 Jim_Free(cmdPtr->staticVars);
3088 }
3089 } else if (cmdPtr->delProc != NULL) {
3090 /* If it was a C coded command, call the delProc if any */
3091 cmdPtr->delProc(interp, cmdPtr->privData);
3092 }
3093 Jim_Free(val);
3094 }
3095
3096 static Jim_HashTableType JimCommandsHashTableType = {
3097 JimStringCopyHTHashFunction, /* hash function */
3098 JimStringCopyHTKeyDup, /* key dup */
3099 NULL, /* val dup */
3100 JimStringCopyHTKeyCompare, /* key compare */
3101 JimStringCopyHTKeyDestructor, /* key destructor */
3102 Jim_CommandsHT_ValDestructor /* val destructor */
3103 };
3104
3105 /* ------------------------- Commands related functions --------------------- */
3106
3107 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3108 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3109 {
3110 Jim_HashEntry *he;
3111 Jim_Cmd *cmdPtr;
3112
3113 he = Jim_FindHashEntry(&interp->commands, cmdName);
3114 if (he == NULL) { /* New command to create */
3115 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3116 cmdPtr->cmdProc = cmdProc;
3117 cmdPtr->privData = privData;
3118 cmdPtr->delProc = delProc;
3119 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3120 } else {
3121 Jim_InterpIncrProcEpoch(interp);
3122 /* Free the arglist/body objects if it was a Tcl procedure */
3123 cmdPtr = he->val;
3124 if (cmdPtr->cmdProc == NULL) {
3125 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3126 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3127 if (cmdPtr->staticVars) {
3128 Jim_FreeHashTable(cmdPtr->staticVars);
3129 Jim_Free(cmdPtr->staticVars);
3130 }
3131 cmdPtr->staticVars = NULL;
3132 } else if (cmdPtr->delProc != NULL) {
3133 /* If it was a C coded command, call the delProc if any */
3134 cmdPtr->delProc(interp, cmdPtr->privData);
3135 }
3136 cmdPtr->cmdProc = cmdProc;
3137 cmdPtr->privData = privData;
3138 }
3139 /* There is no need to increment the 'proc epoch' because
3140 * creation of a new procedure can never affect existing
3141 * cached commands. We don't do negative caching. */
3142 return JIM_OK;
3143 }
3144
3145 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3146 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3147 int arityMin, int arityMax)
3148 {
3149 Jim_Cmd *cmdPtr;
3150
3151 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3152 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3153 cmdPtr->argListObjPtr = argListObjPtr;
3154 cmdPtr->bodyObjPtr = bodyObjPtr;
3155 Jim_IncrRefCount(argListObjPtr);
3156 Jim_IncrRefCount(bodyObjPtr);
3157 cmdPtr->arityMin = arityMin;
3158 cmdPtr->arityMax = arityMax;
3159 cmdPtr->staticVars = NULL;
3160
3161 /* Create the statics hash table. */
3162 if (staticsListObjPtr) {
3163 int len, i;
3164
3165 Jim_ListLength(interp, staticsListObjPtr, &len);
3166 if (len != 0) {
3167 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3168 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3169 interp);
3170 for (i = 0; i < len; i++) {
3171 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3172 Jim_Var *varPtr;
3173 int subLen;
3174
3175 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3176 /* Check if it's composed of two elements. */
3177 Jim_ListLength(interp, objPtr, &subLen);
3178 if (subLen == 1 || subLen == 2) {
3179 /* Try to get the variable value from the current
3180 * environment. */
3181 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3182 if (subLen == 1) {
3183 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3184 JIM_NONE);
3185 if (initObjPtr == NULL) {
3186 Jim_SetResult(interp,
3187 Jim_NewEmptyStringObj(interp));
3188 Jim_AppendStrings(interp, Jim_GetResult(interp),
3189 "variable for initialization of static \"",
3190 Jim_GetString(nameObjPtr, NULL),
3191 "\" not found in the local context",
3192 NULL);
3193 goto err;
3194 }
3195 } else {
3196 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3197 }
3198 varPtr = Jim_Alloc(sizeof(*varPtr));
3199 varPtr->objPtr = initObjPtr;
3200 Jim_IncrRefCount(initObjPtr);
3201 varPtr->linkFramePtr = NULL;
3202 if (Jim_AddHashEntry(cmdPtr->staticVars,
3203 Jim_GetString(nameObjPtr, NULL),
3204 varPtr) != JIM_OK)
3205 {
3206 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3207 Jim_AppendStrings(interp, Jim_GetResult(interp),
3208 "static variable name \"",
3209 Jim_GetString(objPtr, NULL), "\"",
3210 " duplicated in statics list", NULL);
3211 Jim_DecrRefCount(interp, initObjPtr);
3212 Jim_Free(varPtr);
3213 goto err;
3214 }
3215 } else {
3216 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3217 Jim_AppendStrings(interp, Jim_GetResult(interp),
3218 "too many fields in static specifier \"",
3219 objPtr, "\"", NULL);
3220 goto err;
3221 }
3222 }
3223 }
3224 }
3225
3226 /* Add the new command */
3227
3228 /* it may already exist, so we try to delete the old one */
3229 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3230 /* There was an old procedure with the same name, this requires
3231 * a 'proc epoch' update. */
3232 Jim_InterpIncrProcEpoch(interp);
3233 }
3234 /* If a procedure with the same name didn't existed there is no need
3235 * to increment the 'proc epoch' because creation of a new procedure
3236 * can never affect existing cached commands. We don't do
3237 * negative caching. */
3238 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3239 return JIM_OK;
3240
3241 err:
3242 Jim_FreeHashTable(cmdPtr->staticVars);
3243 Jim_Free(cmdPtr->staticVars);
3244 Jim_DecrRefCount(interp, argListObjPtr);
3245 Jim_DecrRefCount(interp, bodyObjPtr);
3246 Jim_Free(cmdPtr);
3247 return JIM_ERR;
3248 }
3249
3250 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3251 {
3252 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3253 return JIM_ERR;
3254 Jim_InterpIncrProcEpoch(interp);
3255 return JIM_OK;
3256 }
3257
3258 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3259 const char *newName)
3260 {
3261 Jim_Cmd *cmdPtr;
3262 Jim_HashEntry *he;
3263 Jim_Cmd *copyCmdPtr;
3264
3265 if (newName[0] == '\0') /* Delete! */
3266 return Jim_DeleteCommand(interp, oldName);
3267 /* Rename */
3268 he = Jim_FindHashEntry(&interp->commands, oldName);
3269 if (he == NULL)
3270 return JIM_ERR; /* Invalid command name */
3271 cmdPtr = he->val;
3272 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3273 *copyCmdPtr = *cmdPtr;
3274 /* In order to avoid that a procedure will get arglist/body/statics
3275 * freed by the hash table methods, fake a C-coded command
3276 * setting cmdPtr->cmdProc as not NULL */
3277 cmdPtr->cmdProc = (void*)1;
3278 /* Also make sure delProc is NULL. */
3279 cmdPtr->delProc = NULL;
3280 /* Destroy the old command, and make sure the new is freed
3281 * as well. */
3282 Jim_DeleteHashEntry(&interp->commands, oldName);
3283 Jim_DeleteHashEntry(&interp->commands, newName);
3284 /* Now the new command. We are sure it can't fail because
3285 * the target name was already freed. */
3286 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3287 /* Increment the epoch */
3288 Jim_InterpIncrProcEpoch(interp);
3289 return JIM_OK;
3290 }
3291
3292 /* -----------------------------------------------------------------------------
3293 * Command object
3294 * ---------------------------------------------------------------------------*/
3295
3296 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3297
3298 static Jim_ObjType commandObjType = {
3299 "command",
3300 NULL,
3301 NULL,
3302 NULL,
3303 JIM_TYPE_REFERENCES,
3304 };
3305
3306 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3307 {
3308 Jim_HashEntry *he;
3309 const char *cmdName;
3310
3311 /* Get the string representation */
3312 cmdName = Jim_GetString(objPtr, NULL);
3313 /* Lookup this name into the commands hash table */
3314 he = Jim_FindHashEntry(&interp->commands, cmdName);
3315 if (he == NULL)
3316 return JIM_ERR;
3317
3318 /* Free the old internal repr and set the new one. */
3319 Jim_FreeIntRep(interp, objPtr);
3320 objPtr->typePtr = &commandObjType;
3321 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3322 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3323 return JIM_OK;
3324 }
3325
3326 /* This function returns the command structure for the command name
3327 * stored in objPtr. It tries to specialize the objPtr to contain
3328 * a cached info instead to perform the lookup into the hash table
3329 * every time. The information cached may not be uptodate, in such
3330 * a case the lookup is performed and the cache updated. */
3331 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3332 {
3333 if ((objPtr->typePtr != &commandObjType ||
3334 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3335 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3336 if (flags & JIM_ERRMSG) {
3337 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3338 Jim_AppendStrings(interp, Jim_GetResult(interp),
3339 "invalid command name \"", objPtr->bytes, "\"",
3340 NULL);
3341 }
3342 return NULL;
3343 }
3344 return objPtr->internalRep.cmdValue.cmdPtr;
3345 }
3346
3347 /* -----------------------------------------------------------------------------
3348 * Variables
3349 * ---------------------------------------------------------------------------*/
3350
3351 /* Variables HashTable Type.
3352 *
3353 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3354 static void JimVariablesHTValDestructor(void *interp, void *val)
3355 {
3356 Jim_Var *varPtr = (void*) val;
3357
3358 Jim_DecrRefCount(interp, varPtr->objPtr);
3359 Jim_Free(val);
3360 }
3361
3362 static Jim_HashTableType JimVariablesHashTableType = {
3363 JimStringCopyHTHashFunction, /* hash function */
3364 JimStringCopyHTKeyDup, /* key dup */
3365 NULL, /* val dup */
3366 JimStringCopyHTKeyCompare, /* key compare */
3367 JimStringCopyHTKeyDestructor, /* key destructor */
3368 JimVariablesHTValDestructor /* val destructor */
3369 };
3370
3371 /* -----------------------------------------------------------------------------
3372 * Variable object
3373 * ---------------------------------------------------------------------------*/
3374
3375 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3376
3377 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3378
3379 static Jim_ObjType variableObjType = {
3380 "variable",
3381 NULL,
3382 NULL,
3383 NULL,
3384 JIM_TYPE_REFERENCES,
3385 };
3386
3387 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3388 * is in the form "varname(key)". */
3389 static int Jim_NameIsDictSugar(const char *str, int len)
3390 {
3391 if (len == -1)
3392 len = strlen(str);
3393 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3394 return 1;
3395 return 0;
3396 }
3397
3398 /* This method should be called only by the variable API.
3399 * It returns JIM_OK on success (variable already exists),
3400 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3401 * a variable name, but syntax glue for [dict] i.e. the last
3402 * character is ')' */
3403 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3404 {
3405 Jim_HashEntry *he;
3406 const char *varName;
3407 int len;
3408
3409 /* Check if the object is already an uptodate variable */
3410 if (objPtr->typePtr == &variableObjType &&
3411 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3412 return JIM_OK; /* nothing to do */
3413 /* Get the string representation */
3414 varName = Jim_GetString(objPtr, &len);
3415 /* Make sure it's not syntax glue to get/set dict. */
3416 if (Jim_NameIsDictSugar(varName, len))
3417 return JIM_DICT_SUGAR;
3418 /* Lookup this name into the variables hash table */
3419 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3420 if (he == NULL) {
3421 /* Try with static vars. */
3422 if (interp->framePtr->staticVars == NULL)
3423 return JIM_ERR;
3424 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3425 return JIM_ERR;
3426 }
3427 /* Free the old internal repr and set the new one. */
3428 Jim_FreeIntRep(interp, objPtr);
3429 objPtr->typePtr = &variableObjType;
3430 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3431 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3432 return JIM_OK;
3433 }
3434
3435 /* -------------------- Variables related functions ------------------------- */
3436 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3437 Jim_Obj *valObjPtr);
3438 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3439
3440 /* For now that's dummy. Variables lookup should be optimized
3441 * in many ways, with caching of lookups, and possibly with
3442 * a table of pre-allocated vars in every CallFrame for local vars.
3443 * All the caching should also have an 'epoch' mechanism similar
3444 * to the one used by Tcl for procedures lookup caching. */
3445
3446 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3447 {
3448 const char *name;
3449 Jim_Var *var;
3450 int err;
3451
3452 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3453 /* Check for [dict] syntax sugar. */
3454 if (err == JIM_DICT_SUGAR)
3455 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3456 /* New variable to create */
3457 name = Jim_GetString(nameObjPtr, NULL);
3458
3459 var = Jim_Alloc(sizeof(*var));
3460 var->objPtr = valObjPtr;
3461 Jim_IncrRefCount(valObjPtr);
3462 var->linkFramePtr = NULL;
3463 /* Insert the new variable */
3464 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3465 /* Make the object int rep a variable */
3466 Jim_FreeIntRep(interp, nameObjPtr);
3467 nameObjPtr->typePtr = &variableObjType;
3468 nameObjPtr->internalRep.varValue.callFrameId =
3469 interp->framePtr->id;
3470 nameObjPtr->internalRep.varValue.varPtr = var;
3471 } else {
3472 var = nameObjPtr->internalRep.varValue.varPtr;
3473 if (var->linkFramePtr == NULL) {
3474 Jim_IncrRefCount(valObjPtr);
3475 Jim_DecrRefCount(interp, var->objPtr);
3476 var->objPtr = valObjPtr;
3477 } else { /* Else handle the link */
3478 Jim_CallFrame *savedCallFrame;
3479
3480 savedCallFrame = interp->framePtr;
3481 interp->framePtr = var->linkFramePtr;
3482 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3483 interp->framePtr = savedCallFrame;
3484 if (err != JIM_OK)
3485 return err;
3486 }
3487 }
3488 return JIM_OK;
3489 }
3490
3491 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3492 {
3493 Jim_Obj *nameObjPtr;
3494 int result;
3495
3496 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3497 Jim_IncrRefCount(nameObjPtr);
3498 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3499 Jim_DecrRefCount(interp, nameObjPtr);
3500 return result;
3501 }
3502
3503 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3504 {
3505 Jim_CallFrame *savedFramePtr;
3506 int result;
3507
3508 savedFramePtr = interp->framePtr;
3509 interp->framePtr = interp->topFramePtr;
3510 result = Jim_SetVariableStr(interp, name, objPtr);
3511 interp->framePtr = savedFramePtr;
3512 return result;
3513 }
3514
3515 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3516 {
3517 Jim_Obj *nameObjPtr, *valObjPtr;
3518 int result;
3519
3520 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3521 valObjPtr = Jim_NewStringObj(interp, val, -1);
3522 Jim_IncrRefCount(nameObjPtr);
3523 Jim_IncrRefCount(valObjPtr);
3524 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3525 Jim_DecrRefCount(interp, nameObjPtr);
3526 Jim_DecrRefCount(interp, valObjPtr);
3527 return result;
3528 }
3529
3530 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3531 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3532 {
3533 const char *varName;
3534 int len;
3535
3536 /* Check for cycles. */
3537 if (interp->framePtr == targetCallFrame) {
3538 Jim_Obj *objPtr = targetNameObjPtr;
3539 Jim_Var *varPtr;
3540 /* Cycles are only possible with 'uplevel 0' */
3541 while(1) {
3542 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3543 Jim_SetResultString(interp,
3544 "can't upvar from variable to itself", -1);
3545 return JIM_ERR;
3546 }
3547 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3548 break;
3549 varPtr = objPtr->internalRep.varValue.varPtr;
3550 if (varPtr->linkFramePtr != targetCallFrame) break;
3551 objPtr = varPtr->objPtr;
3552 }
3553 }
3554 varName = Jim_GetString(nameObjPtr, &len);
3555 if (Jim_NameIsDictSugar(varName, len)) {
3556 Jim_SetResultString(interp,
3557 "Dict key syntax invalid as link source", -1);
3558 return JIM_ERR;
3559 }
3560 /* Perform the binding */
3561 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3562 /* We are now sure 'nameObjPtr' type is variableObjType */
3563 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3564 return JIM_OK;
3565 }
3566
3567 /* Return the Jim_Obj pointer associated with a variable name,
3568 * or NULL if the variable was not found in the current context.
3569 * The same optimization discussed in the comment to the
3570 * 'SetVariable' function should apply here. */
3571 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3572 {
3573 int err;
3574
3575 /* All the rest is handled here */
3576 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3577 /* Check for [dict] syntax sugar. */
3578 if (err == JIM_DICT_SUGAR)
3579 return JimDictSugarGet(interp, nameObjPtr);
3580 if (flags & JIM_ERRMSG) {
3581 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3582 Jim_AppendStrings(interp, Jim_GetResult(interp),
3583 "can't read \"", nameObjPtr->bytes,
3584 "\": no such variable", NULL);
3585 }
3586 return NULL;
3587 } else {
3588 Jim_Var *varPtr;
3589 Jim_Obj *objPtr;
3590 Jim_CallFrame *savedCallFrame;
3591
3592 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3593 if (varPtr->linkFramePtr == NULL)
3594 return varPtr->objPtr;
3595 /* The variable is a link? Resolve it. */
3596 savedCallFrame = interp->framePtr;
3597 interp->framePtr = varPtr->linkFramePtr;
3598 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3599 if (objPtr == NULL && flags & JIM_ERRMSG) {
3600 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3601 Jim_AppendStrings(interp, Jim_GetResult(interp),
3602 "can't read \"", nameObjPtr->bytes,
3603 "\": no such variable", NULL);
3604 }
3605 interp->framePtr = savedCallFrame;
3606 return objPtr;
3607 }
3608 }
3609
3610 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3611 int flags)
3612 {
3613 Jim_CallFrame *savedFramePtr;
3614 Jim_Obj *objPtr;
3615
3616 savedFramePtr = interp->framePtr;
3617 interp->framePtr = interp->topFramePtr;
3618 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3619 interp->framePtr = savedFramePtr;
3620
3621 return objPtr;
3622 }
3623
3624 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3625 {
3626 Jim_Obj *nameObjPtr, *varObjPtr;
3627
3628 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3629 Jim_IncrRefCount(nameObjPtr);
3630 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3631 Jim_DecrRefCount(interp, nameObjPtr);
3632 return varObjPtr;
3633 }
3634
3635 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3636 int flags)
3637 {
3638 Jim_CallFrame *savedFramePtr;
3639 Jim_Obj *objPtr;
3640
3641 savedFramePtr = interp->framePtr;
3642 interp->framePtr = interp->topFramePtr;
3643 objPtr = Jim_GetVariableStr(interp, name, flags);
3644 interp->framePtr = savedFramePtr;
3645
3646 return objPtr;
3647 }
3648
3649 /* Unset a variable.
3650 * Note: On success unset invalidates all the variable objects created
3651 * in the current call frame incrementing. */
3652 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3653 {
3654 const char *name;
3655 Jim_Var *varPtr;
3656 int err;
3657
3658 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3659 /* Check for [dict] syntax sugar. */
3660 if (err == JIM_DICT_SUGAR)
3661 return JimDictSugarSet(interp, nameObjPtr, NULL);
3662 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3663 Jim_AppendStrings(interp, Jim_GetResult(interp),
3664 "can't unset \"", nameObjPtr->bytes,
3665 "\": no such variable", NULL);
3666 return JIM_ERR; /* var not found */
3667 }
3668 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3669 /* If it's a link call UnsetVariable recursively */
3670 if (varPtr->linkFramePtr) {
3671 int retval;
3672
3673 Jim_CallFrame *savedCallFrame;
3674
3675 savedCallFrame = interp->framePtr;
3676 interp->framePtr = varPtr->linkFramePtr;
3677 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3678 interp->framePtr = savedCallFrame;
3679 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3680 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3681 Jim_AppendStrings(interp, Jim_GetResult(interp),
3682 "can't unset \"", nameObjPtr->bytes,
3683 "\": no such variable", NULL);
3684 }
3685 return retval;
3686 } else {
3687 name = Jim_GetString(nameObjPtr, NULL);
3688 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3689 != JIM_OK) return JIM_ERR;
3690 /* Change the callframe id, invalidating var lookup caching */
3691 JimChangeCallFrameId(interp, interp->framePtr);
3692 return JIM_OK;
3693 }
3694 }
3695
3696 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3697
3698 /* Given a variable name for [dict] operation syntax sugar,
3699 * this function returns two objects, the first with the name
3700 * of the variable to set, and the second with the rispective key.
3701 * For example "foo(bar)" will return objects with string repr. of
3702 * "foo" and "bar".
3703 *
3704 * The returned objects have refcount = 1. The function can't fail. */
3705 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3706 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3707 {
3708 const char *str, *p;
3709 char *t;
3710 int len, keyLen, nameLen;
3711 Jim_Obj *varObjPtr, *keyObjPtr;
3712
3713 str = Jim_GetString(objPtr, &len);
3714 p = strchr(str, '(');
3715 p++;
3716 keyLen = len-((p-str)+1);
3717 nameLen = (p-str)-1;
3718 /* Create the objects with the variable name and key. */
3719 t = Jim_Alloc(nameLen+1);
3720 memcpy(t, str, nameLen);
3721 t[nameLen] = '\0';
3722 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3723
3724 t = Jim_Alloc(keyLen+1);
3725 memcpy(t, p, keyLen);
3726 t[keyLen] = '\0';
3727 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3728
3729 Jim_IncrRefCount(varObjPtr);
3730 Jim_IncrRefCount(keyObjPtr);
3731 *varPtrPtr = varObjPtr;
3732 *keyPtrPtr = keyObjPtr;
3733 }
3734
3735 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3736 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3737 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3738 Jim_Obj *valObjPtr)
3739 {
3740 Jim_Obj *varObjPtr, *keyObjPtr;
3741 int err = JIM_OK;
3742
3743 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3744 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3745 valObjPtr);
3746 Jim_DecrRefCount(interp, varObjPtr);
3747 Jim_DecrRefCount(interp, keyObjPtr);
3748 return err;
3749 }
3750
3751 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3752 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3753 {
3754 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3755
3756 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3757 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3758 if (!dictObjPtr) {
3759 resObjPtr = NULL;
3760 goto err;
3761 }
3762 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3763 != JIM_OK) {
3764 resObjPtr = NULL;
3765 }
3766 err:
3767 Jim_DecrRefCount(interp, varObjPtr);
3768 Jim_DecrRefCount(interp, keyObjPtr);
3769 return resObjPtr;
3770 }
3771
3772 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3773
3774 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3775 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3776 Jim_Obj *dupPtr);
3777
3778 static Jim_ObjType dictSubstObjType = {
3779 "dict-substitution",
3780 FreeDictSubstInternalRep,
3781 DupDictSubstInternalRep,
3782 NULL,
3783 JIM_TYPE_NONE,
3784 };
3785
3786 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3787 {
3788 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3789 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3790 }
3791
3792 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3793 Jim_Obj *dupPtr)
3794 {
3795 JIM_NOTUSED(interp);
3796
3797 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3798 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3799 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3800 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3801 dupPtr->typePtr = &dictSubstObjType;
3802 }
3803
3804 /* This function is used to expand [dict get] sugar in the form
3805 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3806 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3807 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3808 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3809 * the [dict]ionary contained in variable VARNAME. */
3810 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3811 {
3812 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3813 Jim_Obj *substKeyObjPtr = NULL;
3814
3815 if (objPtr->typePtr != &dictSubstObjType) {
3816 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3817 Jim_FreeIntRep(interp, objPtr);
3818 objPtr->typePtr = &dictSubstObjType;
3819 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3820 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3821 }
3822 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3823 &substKeyObjPtr, JIM_NONE)
3824 != JIM_OK) {
3825 substKeyObjPtr = NULL;
3826 goto err;
3827 }
3828 Jim_IncrRefCount(substKeyObjPtr);
3829 dictObjPtr = Jim_GetVariable(interp,
3830 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3831 if (!dictObjPtr) {
3832 resObjPtr = NULL;
3833 goto err;
3834 }
3835 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3836 != JIM_OK) {
3837 resObjPtr = NULL;
3838 goto err;
3839 }
3840 err:
3841 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3842 return resObjPtr;
3843 }
3844
3845 /* -----------------------------------------------------------------------------
3846 * CallFrame
3847 * ---------------------------------------------------------------------------*/
3848
3849 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3850 {
3851 Jim_CallFrame *cf;
3852 if (interp->freeFramesList) {
3853 cf = interp->freeFramesList;
3854 interp->freeFramesList = cf->nextFramePtr;
3855 } else {
3856 cf = Jim_Alloc(sizeof(*cf));
3857 cf->vars.table = NULL;
3858 }
3859
3860 cf->id = interp->callFrameEpoch++;
3861 cf->parentCallFrame = NULL;
3862 cf->argv = NULL;
3863 cf->argc = 0;
3864 cf->procArgsObjPtr = NULL;
3865 cf->procBodyObjPtr = NULL;
3866 cf->nextFramePtr = NULL;
3867 cf->staticVars = NULL;
3868 if (cf->vars.table == NULL)
3869 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3870 return cf;
3871 }
3872
3873 /* Used to invalidate every caching related to callframe stability. */
3874 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3875 {
3876 cf->id = interp->callFrameEpoch++;
3877 }
3878
3879 #define JIM_FCF_NONE 0 /* no flags */
3880 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3881 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3882 int flags)
3883 {
3884 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3885 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3886 if (!(flags & JIM_FCF_NOHT))
3887 Jim_FreeHashTable(&cf->vars);
3888 else {
3889 int i;
3890 Jim_HashEntry **table = cf->vars.table, *he;
3891
3892 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3893 he = table[i];
3894 while (he != NULL) {
3895 Jim_HashEntry *nextEntry = he->next;
3896 Jim_Var *varPtr = (void*) he->val;
3897
3898 Jim_DecrRefCount(interp, varPtr->objPtr);
3899 Jim_Free(he->val);
3900 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3901 Jim_Free(he);
3902 table[i] = NULL;
3903 he = nextEntry;
3904 }
3905 }
3906 cf->vars.used = 0;
3907 }
3908 cf->nextFramePtr = interp->freeFramesList;
3909 interp->freeFramesList = cf;
3910 }
3911
3912 /* -----------------------------------------------------------------------------
3913 * References
3914 * ---------------------------------------------------------------------------*/
3915
3916 /* References HashTable Type.
3917 *
3918 * Keys are jim_wide integers, dynamically allocated for now but in the
3919 * future it's worth to cache this 8 bytes objects. Values are poitners
3920 * to Jim_References. */
3921 static void JimReferencesHTValDestructor(void *interp, void *val)
3922 {
3923 Jim_Reference *refPtr = (void*) val;
3924
3925 Jim_DecrRefCount(interp, refPtr->objPtr);
3926 if (refPtr->finalizerCmdNamePtr != NULL) {
3927 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
3928 }
3929 Jim_Free(val);
3930 }
3931
3932 unsigned int JimReferencesHTHashFunction(const void *key)
3933 {
3934 /* Only the least significant bits are used. */
3935 const jim_wide *widePtr = key;
3936 unsigned int intValue = (unsigned int) *widePtr;
3937 return Jim_IntHashFunction(intValue);
3938 }
3939
3940 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
3941 {
3942 /* Only the least significant bits are used. */
3943 const jim_wide *widePtr = key;
3944 unsigned int intValue = (unsigned int) *widePtr;
3945 return intValue; /* identity function. */
3946 }
3947
3948 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
3949 {
3950 void *copy = Jim_Alloc(sizeof(jim_wide));
3951 JIM_NOTUSED(privdata);
3952
3953 memcpy(copy, key, sizeof(jim_wide));
3954 return copy;
3955 }
3956
3957 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
3958 const void *key2)
3959 {
3960 JIM_NOTUSED(privdata);
3961
3962 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
3963 }
3964
3965 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
3966 {
3967 JIM_NOTUSED(privdata);
3968
3969 Jim_Free((void*)key);
3970 }
3971
3972 static Jim_HashTableType JimReferencesHashTableType = {
3973 JimReferencesHTHashFunction, /* hash function */
3974 JimReferencesHTKeyDup, /* key dup */
3975 NULL, /* val dup */
3976 JimReferencesHTKeyCompare, /* key compare */
3977 JimReferencesHTKeyDestructor, /* key destructor */
3978 JimReferencesHTValDestructor /* val destructor */
3979 };
3980
3981 /* -----------------------------------------------------------------------------
3982 * Reference object type and References API
3983 * ---------------------------------------------------------------------------*/
3984
3985 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
3986
3987 static Jim_ObjType referenceObjType = {
3988 "reference",
3989 NULL,
3990 NULL,
3991 UpdateStringOfReference,
3992 JIM_TYPE_REFERENCES,
3993 };
3994
3995 void UpdateStringOfReference(struct Jim_Obj *objPtr)
3996 {
3997 int len;
3998 char buf[JIM_REFERENCE_SPACE+1];
3999 Jim_Reference *refPtr;
4000
4001 refPtr = objPtr->internalRep.refValue.refPtr;
4002 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4003 objPtr->bytes = Jim_Alloc(len+1);
4004 memcpy(objPtr->bytes, buf, len+1);
4005 objPtr->length = len;
4006 }
4007
4008 /* returns true if 'c' is a valid reference tag character.
4009 * i.e. inside the range [_a-zA-Z0-9] */
4010 static int isrefchar(int c)
4011 {
4012 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4013 (c >= '0' && c <= '9')) return 1;
4014 return 0;
4015 }
4016
4017 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4018 {
4019 jim_wide wideValue;
4020 int i, len;
4021 const char *str, *start, *end;
4022 char refId[21];
4023 Jim_Reference *refPtr;
4024 Jim_HashEntry *he;
4025
4026 /* Get the string representation */
4027 str = Jim_GetString(objPtr, &len);
4028 /* Check if it looks like a reference */
4029 if (len < JIM_REFERENCE_SPACE) goto badformat;
4030 /* Trim spaces */
4031 start = str;
4032 end = str+len-1;
4033 while (*start == ' ') start++;
4034 while (*end == ' ' && end > start) end--;
4035 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4036 /* <reference.<1234567>.%020> */
4037 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4038 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4039 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4040 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4041 if (!isrefchar(start[12+i])) goto badformat;
4042 }
4043 /* Extract info from the refernece. */
4044 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4045 refId[20] = '\0';
4046 /* Try to convert the ID into a jim_wide */
4047 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4048 /* Check if the reference really exists! */
4049 he = Jim_FindHashEntry(&interp->references, &wideValue);
4050 if (he == NULL) {
4051 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4052 Jim_AppendStrings(interp, Jim_GetResult(interp),
4053 "Invalid reference ID \"", str, "\"", NULL);
4054 return JIM_ERR;
4055 }
4056 refPtr = he->val;
4057 /* Free the old internal repr and set the new one. */
4058 Jim_FreeIntRep(interp, objPtr);
4059 objPtr->typePtr = &referenceObjType;
4060 objPtr->internalRep.refValue.id = wideValue;
4061 objPtr->internalRep.refValue.refPtr = refPtr;
4062 return JIM_OK;
4063
4064 badformat:
4065 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4066 Jim_AppendStrings(interp, Jim_GetResult(interp),
4067 "expected reference but got \"", str, "\"", NULL);
4068 return JIM_ERR;
4069 }
4070
4071 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4072 * as finalizer command (or NULL if there is no finalizer).
4073 * The returned reference object has refcount = 0. */
4074 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4075 Jim_Obj *cmdNamePtr)
4076 {
4077 struct Jim_Reference *refPtr;
4078 jim_wide wideValue = interp->referenceNextId;
4079 Jim_Obj *refObjPtr;
4080 const char *tag;
4081 int tagLen, i;
4082
4083 /* Perform the Garbage Collection if needed. */
4084 Jim_CollectIfNeeded(interp);
4085
4086 refPtr = Jim_Alloc(sizeof(*refPtr));
4087 refPtr->objPtr = objPtr;
4088 Jim_IncrRefCount(objPtr);
4089 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4090 if (cmdNamePtr)
4091 Jim_IncrRefCount(cmdNamePtr);
4092 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4093 refObjPtr = Jim_NewObj(interp);
4094 refObjPtr->typePtr = &referenceObjType;
4095 refObjPtr->bytes = NULL;
4096 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4097 refObjPtr->internalRep.refValue.refPtr = refPtr;
4098 interp->referenceNextId++;
4099 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4100 * that does not pass the 'isrefchar' test is replaced with '_' */
4101 tag = Jim_GetString(tagPtr, &tagLen);
4102 if (tagLen > JIM_REFERENCE_TAGLEN)
4103 tagLen = JIM_REFERENCE_TAGLEN;
4104 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4105 if (i < tagLen)
4106 refPtr->tag[i] = tag[i];
4107 else
4108 refPtr->tag[i] = '_';
4109 }
4110 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4111 return refObjPtr;
4112 }
4113
4114 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4115 {
4116 if (objPtr->typePtr != &referenceObjType &&
4117 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4118 return NULL;
4119 return objPtr->internalRep.refValue.refPtr;
4120 }
4121
4122 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4123 {
4124 Jim_Reference *refPtr;
4125
4126 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4127 return JIM_ERR;
4128 Jim_IncrRefCount(cmdNamePtr);
4129 if (refPtr->finalizerCmdNamePtr)
4130 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4131 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4132 return JIM_OK;
4133 }
4134
4135 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4136 {
4137 Jim_Reference *refPtr;
4138
4139 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4140 return JIM_ERR;
4141 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4142 return JIM_OK;
4143 }
4144
4145 /* -----------------------------------------------------------------------------
4146 * References Garbage Collection
4147 * ---------------------------------------------------------------------------*/
4148
4149 /* This the hash table type for the "MARK" phase of the GC */
4150 static Jim_HashTableType JimRefMarkHashTableType = {
4151 JimReferencesHTHashFunction, /* hash function */
4152 JimReferencesHTKeyDup, /* key dup */
4153 NULL, /* val dup */
4154 JimReferencesHTKeyCompare, /* key compare */
4155 JimReferencesHTKeyDestructor, /* key destructor */
4156 NULL /* val destructor */
4157 };
4158
4159 /* #define JIM_DEBUG_GC 1 */
4160
4161 /* Performs the garbage collection. */
4162 int Jim_Collect(Jim_Interp *interp)
4163 {
4164 Jim_HashTable marks;
4165 Jim_HashTableIterator *htiter;
4166 Jim_HashEntry *he;
4167 Jim_Obj *objPtr;
4168 int collected = 0;
4169
4170 /* Avoid recursive calls */
4171 if (interp->lastCollectId == -1) {
4172 /* Jim_Collect() already running. Return just now. */
4173 return 0;
4174 }
4175 interp->lastCollectId = -1;
4176
4177 /* Mark all the references found into the 'mark' hash table.
4178 * The references are searched in every live object that
4179 * is of a type that can contain references. */
4180 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4181 objPtr = interp->liveList;
4182 while(objPtr) {
4183 if (objPtr->typePtr == NULL ||
4184 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4185 const char *str, *p;
4186 int len;
4187
4188 /* If the object is of type reference, to get the
4189 * Id is simple... */
4190 if (objPtr->typePtr == &referenceObjType) {
4191 Jim_AddHashEntry(&marks,
4192 &objPtr->internalRep.refValue.id, NULL);
4193 #ifdef JIM_DEBUG_GC
4194 Jim_fprintf(interp,interp->cookie_stdout,
4195 "MARK (reference): %d refcount: %d" JIM_NL,
4196 (int) objPtr->internalRep.refValue.id,
4197 objPtr->refCount);
4198 #endif
4199 objPtr = objPtr->nextObjPtr;
4200 continue;
4201 }
4202 /* Get the string repr of the object we want
4203 * to scan for references. */
4204 p = str = Jim_GetString(objPtr, &len);
4205 /* Skip objects too little to contain references. */
4206 if (len < JIM_REFERENCE_SPACE) {
4207 objPtr = objPtr->nextObjPtr;
4208 continue;
4209 }
4210 /* Extract references from the object string repr. */
4211 while(1) {
4212 int i;
4213 jim_wide id;
4214 char buf[21];
4215
4216 if ((p = strstr(p, "<reference.<")) == NULL)
4217 break;
4218 /* Check if it's a valid reference. */
4219 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4220 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4221 for (i = 21; i <= 40; i++)
4222 if (!isdigit((int)p[i]))
4223 break;
4224 /* Get the ID */
4225 memcpy(buf, p+21, 20);
4226 buf[20] = '\0';
4227 Jim_StringToWide(buf, &id, 10);
4228
4229 /* Ok, a reference for the given ID
4230 * was found. Mark it. */
4231 Jim_AddHashEntry(&marks, &id, NULL);
4232 #ifdef JIM_DEBUG_GC
4233 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4234 #endif
4235 p += JIM_REFERENCE_SPACE;
4236 }
4237 }
4238 objPtr = objPtr->nextObjPtr;
4239 }
4240
4241 /* Run the references hash table to destroy every reference that
4242 * is not referenced outside (not present in the mark HT). */
4243 htiter = Jim_GetHashTableIterator(&interp->references);
4244 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4245 const jim_wide *refId;
4246 Jim_Reference *refPtr;
4247
4248 refId = he->key;
4249 /* Check if in the mark phase we encountered
4250 * this reference. */
4251 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4252 #ifdef JIM_DEBUG_GC
4253 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4254 #endif
4255 collected++;
4256 /* Drop the reference, but call the
4257 * finalizer first if registered. */
4258 refPtr = he->val;
4259 if (refPtr->finalizerCmdNamePtr) {
4260 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4261 Jim_Obj *objv[3], *oldResult;
4262
4263 JimFormatReference(refstr, refPtr, *refId);
4264
4265 objv[0] = refPtr->finalizerCmdNamePtr;
4266 objv[1] = Jim_NewStringObjNoAlloc(interp,
4267 refstr, 32);
4268 objv[2] = refPtr->objPtr;
4269 Jim_IncrRefCount(objv[0]);
4270 Jim_IncrRefCount(objv[1]);
4271 Jim_IncrRefCount(objv[2]);
4272
4273 /* Drop the reference itself */
4274 Jim_DeleteHashEntry(&interp->references, refId);
4275
4276 /* Call the finalizer. Errors ignored. */
4277 oldResult = interp->result;
4278 Jim_IncrRefCount(oldResult);
4279 Jim_EvalObjVector(interp, 3, objv);
4280 Jim_SetResult(interp, oldResult);
4281 Jim_DecrRefCount(interp, oldResult);
4282
4283 Jim_DecrRefCount(interp, objv[0]);
4284 Jim_DecrRefCount(interp, objv[1]);
4285 Jim_DecrRefCount(interp, objv[2]);
4286 } else {
4287 Jim_DeleteHashEntry(&interp->references, refId);
4288 }
4289 }
4290 }
4291 Jim_FreeHashTableIterator(htiter);
4292 Jim_FreeHashTable(&marks);
4293 interp->lastCollectId = interp->referenceNextId;
4294 interp->lastCollectTime = time(NULL);
4295 return collected;
4296 }
4297
4298 #define JIM_COLLECT_ID_PERIOD 5000
4299 #define JIM_COLLECT_TIME_PERIOD 300
4300
4301 void Jim_CollectIfNeeded(Jim_Interp *interp)
4302 {
4303 jim_wide elapsedId;
4304 int elapsedTime;
4305
4306 elapsedId = interp->referenceNextId - interp->lastCollectId;
4307 elapsedTime = time(NULL) - interp->lastCollectTime;
4308
4309
4310 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4311 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4312 Jim_Collect(interp);
4313 }
4314 }
4315
4316 /* -----------------------------------------------------------------------------
4317 * Interpreter related functions
4318 * ---------------------------------------------------------------------------*/
4319
4320 Jim_Interp *Jim_CreateInterp(void)
4321 {
4322 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4323 Jim_Obj *pathPtr;
4324
4325 i->errorLine = 0;
4326 i->errorFileName = Jim_StrDup("");
4327 i->numLevels = 0;
4328 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4329 i->returnCode = JIM_OK;
4330 i->exitCode = 0;
4331 i->procEpoch = 0;
4332 i->callFrameEpoch = 0;
4333 i->liveList = i->freeList = NULL;
4334 i->scriptFileName = Jim_StrDup("");
4335 i->referenceNextId = 0;
4336 i->lastCollectId = 0;
4337 i->lastCollectTime = time(NULL);
4338 i->freeFramesList = NULL;
4339 i->prngState = NULL;
4340 i->evalRetcodeLevel = -1;
4341 i->cookie_stdin = stdin;
4342 i->cookie_stdout = stdout;
4343 i->cookie_stderr = stderr;
4344 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4345 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4346 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4347 i->cb_fflush = ((int (*)( void *))(fflush));
4348 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4349
4350 /* Note that we can create objects only after the
4351 * interpreter liveList and freeList pointers are
4352 * initialized to NULL. */
4353 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4354 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4355 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4356 NULL);
4357 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4358 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4359 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4360 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4361 i->emptyObj = Jim_NewEmptyStringObj(i);
4362 i->result = i->emptyObj;
4363 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4364 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4365 Jim_IncrRefCount(i->emptyObj);
4366 Jim_IncrRefCount(i->result);
4367 Jim_IncrRefCount(i->stackTrace);
4368 Jim_IncrRefCount(i->unknown);
4369
4370 /* Initialize key variables every interpreter should contain */
4371 pathPtr = Jim_NewStringObj(i, "./", -1);
4372 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4373 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4374
4375 /* Export the core API to extensions */
4376 JimRegisterCoreApi(i);
4377 return i;
4378 }
4379
4380 /* This is the only function Jim exports directly without
4381 * to use the STUB system. It is only used by embedders
4382 * in order to get an interpreter with the Jim API pointers
4383 * registered. */
4384 Jim_Interp *ExportedJimCreateInterp(void)
4385 {
4386 return Jim_CreateInterp();
4387 }
4388
4389 void Jim_FreeInterp(Jim_Interp *i)
4390 {
4391 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4392 Jim_Obj *objPtr, *nextObjPtr;
4393
4394 Jim_DecrRefCount(i, i->emptyObj);
4395 Jim_DecrRefCount(i, i->result);
4396 Jim_DecrRefCount(i, i->stackTrace);
4397 Jim_DecrRefCount(i, i->unknown);
4398 Jim_Free((void*)i->errorFileName);
4399 Jim_Free((void*)i->scriptFileName);
4400 Jim_FreeHashTable(&i->commands);
4401 Jim_FreeHashTable(&i->references);
4402 Jim_FreeHashTable(&i->stub);
4403 Jim_FreeHashTable(&i->assocData);
4404 Jim_FreeHashTable(&i->packages);
4405 Jim_Free(i->prngState);
4406 /* Free the call frames list */
4407 while(cf) {
4408 prevcf = cf->parentCallFrame;
4409 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4410 cf = prevcf;
4411 }
4412 /* Check that the live object list is empty, otherwise
4413 * there is a memory leak. */
4414 if (i->liveList != NULL) {
4415 Jim_Obj *objPtr = i->liveList;
4416
4417 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4418 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4419 while(objPtr) {
4420 const char *type = objPtr->typePtr ?
4421 objPtr->typePtr->name : "";
4422 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4423 objPtr, type,
4424 objPtr->bytes ? objPtr->bytes
4425 : "(null)", objPtr->refCount);
4426 if (objPtr->typePtr == &sourceObjType) {
4427 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4428 objPtr->internalRep.sourceValue.fileName,
4429 objPtr->internalRep.sourceValue.lineNumber);
4430 }
4431 objPtr = objPtr->nextObjPtr;
4432 }
4433 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4434 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4435 }
4436 /* Free all the freed objects. */
4437 objPtr = i->freeList;
4438 while (objPtr) {
4439 nextObjPtr = objPtr->nextObjPtr;
4440 Jim_Free(objPtr);
4441 objPtr = nextObjPtr;
4442 }
4443 /* Free cached CallFrame structures */
4444 cf = i->freeFramesList;
4445 while(cf) {
4446 nextcf = cf->nextFramePtr;
4447 if (cf->vars.table != NULL)
4448 Jim_Free(cf->vars.table);
4449 Jim_Free(cf);
4450 cf = nextcf;
4451 }
4452 /* Free the sharedString hash table. Make sure to free it
4453 * after every other Jim_Object was freed. */
4454 Jim_FreeHashTable(&i->sharedStrings);
4455 /* Free the interpreter structure. */
4456 Jim_Free(i);
4457 }
4458
4459 /* Store the call frame relative to the level represented by
4460 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4461 * level is assumed to be '1'.
4462 *
4463 * If a newLevelptr int pointer is specified, the function stores
4464 * the absolute level integer value of the new target callframe into
4465 * *newLevelPtr. (this is used to adjust interp->numLevels
4466 * in the implementation of [uplevel], so that [info level] will
4467 * return a correct information).
4468 *
4469 * This function accepts the 'level' argument in the form
4470 * of the commands [uplevel] and [upvar].
4471 *
4472 * For a function accepting a relative integer as level suitable
4473 * for implementation of [info level ?level?] check the
4474 * GetCallFrameByInteger() function. */
4475 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4476 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4477 {
4478 long level;
4479 const char *str;
4480 Jim_CallFrame *framePtr;
4481
4482 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4483 if (levelObjPtr) {
4484 str = Jim_GetString(levelObjPtr, NULL);
4485 if (str[0] == '#') {
4486 char *endptr;
4487 /* speedup for the toplevel (level #0) */
4488 if (str[1] == '0' && str[2] == '\0') {
4489 if (newLevelPtr) *newLevelPtr = 0;
4490 *framePtrPtr = interp->topFramePtr;
4491 return JIM_OK;
4492 }
4493
4494 level = strtol(str+1, &endptr, 0);
4495 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4496 goto badlevel;
4497 /* An 'absolute' level is converted into the
4498 * 'number of levels to go back' format. */
4499 level = interp->numLevels - level;
4500 if (level < 0) goto badlevel;
4501 } else {
4502 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4503 goto badlevel;
4504 }
4505 } else {
4506 str = "1"; /* Needed to format the error message. */
4507 level = 1;
4508 }
4509 /* Lookup */
4510 framePtr = interp->framePtr;
4511 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4512 while (level--) {
4513 framePtr = framePtr->parentCallFrame;
4514 if (framePtr == NULL) goto badlevel;
4515 }
4516 *framePtrPtr = framePtr;
4517 return JIM_OK;
4518 badlevel:
4519 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4520 Jim_AppendStrings(interp, Jim_GetResult(interp),
4521 "bad level \"", str, "\"", NULL);
4522 return JIM_ERR;
4523 }
4524
4525 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4526 * as a relative integer like in the [info level ?level?] command. */
4527 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4528 Jim_CallFrame **framePtrPtr)
4529 {
4530 jim_wide level;
4531 jim_wide relLevel; /* level relative to the current one. */
4532 Jim_CallFrame *framePtr;
4533
4534 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4535 goto badlevel;
4536 if (level > 0) {
4537 /* An 'absolute' level is converted into the
4538 * 'number of levels to go back' format. */
4539 relLevel = interp->numLevels - level;
4540 } else {
4541 relLevel = -level;
4542 }
4543 /* Lookup */
4544 framePtr = interp->framePtr;
4545 while (relLevel--) {
4546 framePtr = framePtr->parentCallFrame;
4547 if (framePtr == NULL) goto badlevel;
4548 }
4549 *framePtrPtr = framePtr;
4550 return JIM_OK;
4551 badlevel:
4552 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4553 Jim_AppendStrings(interp, Jim_GetResult(interp),
4554 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4555 return JIM_ERR;
4556 }
4557
4558 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4559 {
4560 Jim_Free((void*)interp->errorFileName);
4561 interp->errorFileName = Jim_StrDup(filename);
4562 }
4563
4564 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4565 {
4566 interp->errorLine = linenr;
4567 }
4568
4569 static void JimResetStackTrace(Jim_Interp *interp)
4570 {
4571 Jim_DecrRefCount(interp, interp->stackTrace);
4572 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4573 Jim_IncrRefCount(interp->stackTrace);
4574 }
4575
4576 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4577 const char *filename, int linenr)
4578 {
4579 if (Jim_IsShared(interp->stackTrace)) {
4580 interp->stackTrace =
4581 Jim_DuplicateObj(interp, interp->stackTrace);
4582 Jim_IncrRefCount(interp->stackTrace);
4583 }
4584 Jim_ListAppendElement(interp, interp->stackTrace,
4585 Jim_NewStringObj(interp, procname, -1));
4586 Jim_ListAppendElement(interp, interp->stackTrace,
4587 Jim_NewStringObj(interp, filename, -1));
4588 Jim_ListAppendElement(interp, interp->stackTrace,
4589 Jim_NewIntObj(interp, linenr));
4590 }
4591
4592 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4593 {
4594 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4595 assocEntryPtr->delProc = delProc;
4596 assocEntryPtr->data = data;
4597 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4598 }
4599
4600 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4601 {
4602 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4603 if (entryPtr != NULL) {
4604 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4605 return assocEntryPtr->data;
4606 }
4607 return NULL;
4608 }
4609
4610 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4611 {
4612 return Jim_DeleteHashEntry(&interp->assocData, key);
4613 }
4614
4615 int Jim_GetExitCode(Jim_Interp *interp) {
4616 return interp->exitCode;
4617 }
4618
4619 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4620 {
4621 if (fp != NULL) interp->cookie_stdin = fp;
4622 return interp->cookie_stdin;
4623 }
4624
4625 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4626 {
4627 if (fp != NULL) interp->cookie_stdout = fp;
4628 return interp->cookie_stdout;
4629 }
4630
4631 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4632 {
4633 if (fp != NULL) interp->cookie_stderr = fp;
4634 return interp->cookie_stderr;
4635 }
4636
4637 /* -----------------------------------------------------------------------------
4638 * Shared strings.
4639 * Every interpreter has an hash table where to put shared dynamically
4640 * allocate strings that are likely to be used a lot of times.
4641 * For example, in the 'source' object type, there is a pointer to
4642 * the filename associated with that object. Every script has a lot
4643 * of this objects with the identical file name, so it is wise to share
4644 * this info.
4645 *
4646 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4647 * returns the pointer to the shared string. Every time a reference
4648 * to the string is no longer used, the user should call
4649 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4650 * a given string, it is removed from the hash table.
4651 * ---------------------------------------------------------------------------*/
4652 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4653 {
4654 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4655
4656 if (he == NULL) {
4657 char *strCopy = Jim_StrDup(str);
4658
4659 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4660 return strCopy;
4661 } else {
4662 long refCount = (long) he->val;
4663
4664 refCount++;
4665 he->val = (void*) refCount;
4666 return he->key;
4667 }
4668 }
4669
4670 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4671 {
4672 long refCount;
4673 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4674
4675 if (he == NULL)
4676 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4677 "unknown shared string '%s'", str);
4678 refCount = (long) he->val;
4679 refCount--;
4680 if (refCount == 0) {
4681 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4682 } else {
4683 he->val = (void*) refCount;
4684 }
4685 }
4686
4687 /* -----------------------------------------------------------------------------
4688 * Integer object
4689 * ---------------------------------------------------------------------------*/
4690 #define JIM_INTEGER_SPACE 24
4691
4692 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4693 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4694
4695 static Jim_ObjType intObjType = {
4696 "int",
4697 NULL,
4698 NULL,
4699 UpdateStringOfInt,
4700 JIM_TYPE_NONE,
4701 };
4702
4703 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4704 {
4705 int len;
4706 char buf[JIM_INTEGER_SPACE+1];
4707
4708 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4709 objPtr->bytes = Jim_Alloc(len+1);
4710 memcpy(objPtr->bytes, buf, len+1);
4711 objPtr->length = len;
4712 }
4713
4714 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4715 {
4716 jim_wide wideValue;
4717 const char *str;
4718
4719 /* Get the string representation */
4720 str = Jim_GetString(objPtr, NULL);
4721 /* Try to convert into a jim_wide */
4722 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4723 if (flags & JIM_ERRMSG) {
4724 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4725 Jim_AppendStrings(interp, Jim_GetResult(interp),
4726 "expected integer but got \"", str, "\"", NULL);
4727 }
4728 return JIM_ERR;
4729 }
4730 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4731 errno == ERANGE) {
4732 Jim_SetResultString(interp,
4733 "Integer value too big to be represented", -1);
4734 return JIM_ERR;
4735 }
4736 /* Free the old internal repr and set the new one. */
4737 Jim_FreeIntRep(interp, objPtr);
4738 objPtr->typePtr = &intObjType;
4739 objPtr->internalRep.wideValue = wideValue;
4740 return JIM_OK;
4741 }
4742
4743 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4744 {
4745 if (objPtr->typePtr != &intObjType &&
4746 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4747 return JIM_ERR;
4748 *widePtr = objPtr->internalRep.wideValue;
4749 return JIM_OK;
4750 }
4751
4752 /* Get a wide but does not set an error if the format is bad. */
4753 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4754 jim_wide *widePtr)
4755 {
4756 if (objPtr->typePtr != &intObjType &&
4757 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4758 return JIM_ERR;
4759 *widePtr = objPtr->internalRep.wideValue;
4760 return JIM_OK;
4761 }
4762
4763 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4764 {
4765 jim_wide wideValue;
4766 int retval;
4767
4768 retval = Jim_GetWide(interp, objPtr, &wideValue);
4769 if (retval == JIM_OK) {
4770 *longPtr = (long) wideValue;
4771 return JIM_OK;
4772 }
4773 return JIM_ERR;
4774 }
4775
4776 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4777 {
4778 if (Jim_IsShared(objPtr))
4779 Jim_Panic(interp,"Jim_SetWide called with shared object");
4780 if (objPtr->typePtr != &intObjType) {
4781 Jim_FreeIntRep(interp, objPtr);
4782 objPtr->typePtr = &intObjType;
4783 }
4784 Jim_InvalidateStringRep(objPtr);
4785 objPtr->internalRep.wideValue = wideValue;
4786 }
4787
4788 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4789 {
4790 Jim_Obj *objPtr;
4791
4792 objPtr = Jim_NewObj(interp);
4793 objPtr->typePtr = &intObjType;
4794 objPtr->bytes = NULL;
4795 objPtr->internalRep.wideValue = wideValue;
4796 return objPtr;
4797 }
4798
4799 /* -----------------------------------------------------------------------------
4800 * Double object
4801 * ---------------------------------------------------------------------------*/
4802 #define JIM_DOUBLE_SPACE 30
4803
4804 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4805 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4806
4807 static Jim_ObjType doubleObjType = {
4808 "double",
4809 NULL,
4810 NULL,
4811 UpdateStringOfDouble,
4812 JIM_TYPE_NONE,
4813 };
4814
4815 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4816 {
4817 int len;
4818 char buf[JIM_DOUBLE_SPACE+1];
4819
4820 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4821 objPtr->bytes = Jim_Alloc(len+1);
4822 memcpy(objPtr->bytes, buf, len+1);
4823 objPtr->length = len;
4824 }
4825
4826 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4827 {
4828 double doubleValue;
4829 const char *str;
4830
4831 /* Get the string representation */
4832 str = Jim_GetString(objPtr, NULL);
4833 /* Try to convert into a double */
4834 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4835 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4836 Jim_AppendStrings(interp, Jim_GetResult(interp),
4837 "expected number but got '", str, "'", NULL);
4838 return JIM_ERR;
4839 }
4840 /* Free the old internal repr and set the new one. */
4841 Jim_FreeIntRep(interp, objPtr);
4842 objPtr->typePtr = &doubleObjType;
4843 objPtr->internalRep.doubleValue = doubleValue;
4844 return JIM_OK;
4845 }
4846
4847 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4848 {
4849 if (objPtr->typePtr != &doubleObjType &&
4850 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4851 return JIM_ERR;
4852 *doublePtr = objPtr->internalRep.doubleValue;
4853 return JIM_OK;
4854 }
4855
4856 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4857 {
4858 if (Jim_IsShared(objPtr))
4859 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4860 if (objPtr->typePtr != &doubleObjType) {
4861 Jim_FreeIntRep(interp, objPtr);
4862 objPtr->typePtr = &doubleObjType;
4863 }
4864 Jim_InvalidateStringRep(objPtr);
4865 objPtr->internalRep.doubleValue = doubleValue;
4866 }
4867
4868 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4869 {
4870 Jim_Obj *objPtr;
4871
4872 objPtr = Jim_NewObj(interp);
4873 objPtr->typePtr = &doubleObjType;
4874 objPtr->bytes = NULL;
4875 objPtr->internalRep.doubleValue = doubleValue;
4876 return objPtr;
4877 }
4878
4879 /* -----------------------------------------------------------------------------
4880 * List object
4881 * ---------------------------------------------------------------------------*/
4882 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4883 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4884 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4885 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4886 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4887
4888 /* Note that while the elements of the list may contain references,
4889 * the list object itself can't. This basically means that the
4890 * list object string representation as a whole can't contain references
4891 * that are not presents in the single elements. */
4892 static Jim_ObjType listObjType = {
4893 "list",
4894 FreeListInternalRep,
4895 DupListInternalRep,
4896 UpdateStringOfList,
4897 JIM_TYPE_NONE,
4898 };
4899
4900 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4901 {
4902 int i;
4903
4904 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4905 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4906 }
4907 Jim_Free(objPtr->internalRep.listValue.ele);
4908 }
4909
4910 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4911 {
4912 int i;
4913 JIM_NOTUSED(interp);
4914
4915 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4916 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4917 dupPtr->internalRep.listValue.ele =
4918 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4919 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4920 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4921 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4922 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4923 }
4924 dupPtr->typePtr = &listObjType;
4925 }
4926
4927 /* The following function checks if a given string can be encoded
4928 * into a list element without any kind of quoting, surrounded by braces,
4929 * or using escapes to quote. */
4930 #define JIM_ELESTR_SIMPLE 0
4931 #define JIM_ELESTR_BRACE 1
4932 #define JIM_ELESTR_QUOTE 2
4933 static int ListElementQuotingType(const char *s, int len)
4934 {
4935 int i, level, trySimple = 1;
4936
4937 /* Try with the SIMPLE case */
4938 if (len == 0) return JIM_ELESTR_BRACE;
4939 if (s[0] == '"' || s[0] == '{') {
4940 trySimple = 0;
4941 goto testbrace;
4942 }
4943 for (i = 0; i < len; i++) {
4944 switch(s[i]) {
4945 case ' ':
4946 case '$':
4947 case '"':
4948 case '[':
4949 case ']':
4950 case ';':
4951 case '\\':
4952 case '\r':
4953 case '\n':
4954 case '\t':
4955 case '\f':
4956 case '\v':
4957 trySimple = 0;
4958 case '{':
4959 case '}':
4960 goto testbrace;
4961 }
4962 }
4963 return JIM_ELESTR_SIMPLE;
4964
4965 testbrace:
4966 /* Test if it's possible to do with braces */
4967 if (s[len-1] == '\\' ||
4968 s[len-1] == ']') return JIM_ELESTR_QUOTE;
4969 level = 0;
4970 for (i = 0; i < len; i++) {
4971 switch(s[i]) {
4972 case '{': level++; break;
4973 case '}': level--;
4974 if (level < 0) return JIM_ELESTR_QUOTE;
4975 break;
4976 case '\\':
4977 if (s[i+1] == '\n')
4978 return JIM_ELESTR_QUOTE;
4979 else
4980 if (s[i+1] != '\0') i++;
4981 break;
4982 }
4983 }
4984 if (level == 0) {
4985 if (!trySimple) return JIM_ELESTR_BRACE;
4986 for (i = 0; i < len; i++) {
4987 switch(s[i]) {
4988 case ' ':
4989 case '$':
4990 case '"':
4991 case '[':
4992 case ']':
4993 case ';':
4994 case '\\':
4995 case '\r':
4996 case '\n':
4997 case '\t':
4998 case '\f':
4999 case '\v':
5000 return JIM_ELESTR_BRACE;
5001 break;
5002 }
5003 }
5004 return JIM_ELESTR_SIMPLE;
5005 }
5006 return JIM_ELESTR_QUOTE;
5007 }
5008
5009 /* Returns the malloc-ed representation of a string
5010 * using backslash to quote special chars. */
5011 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5012 {
5013 char *q = Jim_Alloc(len*2+1), *p;
5014
5015 p = q;
5016 while(*s) {
5017 switch (*s) {
5018 case ' ':
5019 case '$':
5020 case '"':
5021 case '[':
5022 case ']':
5023 case '{':
5024 case '}':
5025 case ';':
5026 case '\\':
5027 *p++ = '\\';
5028 *p++ = *s++;
5029 break;
5030 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5031 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5032 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5033 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5034 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5035 default:
5036 *p++ = *s++;
5037 break;
5038 }
5039 }
5040 *p = '\0';
5041 *qlenPtr = p-q;
5042 return q;
5043 }
5044
5045 void UpdateStringOfList(struct Jim_Obj *objPtr)
5046 {
5047 int i, bufLen, realLength;
5048 const char *strRep;
5049 char *p;
5050 int *quotingType;
5051 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5052
5053 /* (Over) Estimate the space needed. */
5054 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5055 bufLen = 0;
5056 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5057 int len;
5058
5059 strRep = Jim_GetString(ele[i], &len);
5060 quotingType[i] = ListElementQuotingType(strRep, len);
5061 switch (quotingType[i]) {
5062 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5063 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5064 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5065 }
5066 bufLen++; /* elements separator. */
5067 }
5068 bufLen++;
5069
5070 /* Generate the string rep. */
5071 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5072 realLength = 0;
5073 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5074 int len, qlen;
5075 const char *strRep = Jim_GetString(ele[i], &len);
5076 char *q;
5077
5078 switch(quotingType[i]) {
5079 case JIM_ELESTR_SIMPLE:
5080 memcpy(p, strRep, len);
5081 p += len;
5082 realLength += len;
5083 break;
5084 case JIM_ELESTR_BRACE:
5085 *p++ = '{';
5086 memcpy(p, strRep, len);
5087 p += len;
5088 *p++ = '}';
5089 realLength += len+2;
5090 break;
5091 case JIM_ELESTR_QUOTE:
5092 q = BackslashQuoteString(strRep, len, &qlen);
5093 memcpy(p, q, qlen);
5094 Jim_Free(q);
5095 p += qlen;
5096 realLength += qlen;
5097 break;
5098 }
5099 /* Add a separating space */
5100 if (i+1 != objPtr->internalRep.listValue.len) {
5101 *p++ = ' ';
5102 realLength ++;
5103 }
5104 }
5105 *p = '\0'; /* nul term. */
5106 objPtr->length = realLength;
5107 Jim_Free(quotingType);
5108 }
5109
5110 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5111 {
5112 struct JimParserCtx parser;
5113 const char *str;
5114 int strLen;
5115
5116 /* Get the string representation */
5117 str = Jim_GetString(objPtr, &strLen);
5118
5119 /* Free the old internal repr just now and initialize the
5120 * new one just now. The string->list conversion can't fail. */
5121 Jim_FreeIntRep(interp, objPtr);
5122 objPtr->typePtr = &listObjType;
5123 objPtr->internalRep.listValue.len = 0;
5124 objPtr->internalRep.listValue.maxLen = 0;
5125 objPtr->internalRep.listValue.ele = NULL;
5126
5127 /* Convert into a list */
5128 JimParserInit(&parser, str, strLen, 1);
5129 while(!JimParserEof(&parser)) {
5130 char *token;
5131 int tokenLen, type;
5132 Jim_Obj *elementPtr;
5133
5134 JimParseList(&parser);
5135 if (JimParserTtype(&parser) != JIM_TT_STR &&
5136 JimParserTtype(&parser) != JIM_TT_ESC)
5137 continue;
5138 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5139 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5140 ListAppendElement(objPtr, elementPtr);
5141 }
5142 return JIM_OK;
5143 }
5144
5145 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5146 int len)
5147 {
5148 Jim_Obj *objPtr;
5149 int i;
5150
5151 objPtr = Jim_NewObj(interp);
5152 objPtr->typePtr = &listObjType;
5153 objPtr->bytes = NULL;
5154 objPtr->internalRep.listValue.ele = NULL;
5155 objPtr->internalRep.listValue.len = 0;
5156 objPtr->internalRep.listValue.maxLen = 0;
5157 for (i = 0; i < len; i++) {
5158 ListAppendElement(objPtr, elements[i]);
5159 }
5160 return objPtr;
5161 }
5162
5163 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5164 * length of the vector. Note that the user of this function should make
5165 * sure that the list object can't shimmer while the vector returned
5166 * is in use, this vector is the one stored inside the internal representation
5167 * of the list object. This function is not exported, extensions should
5168 * always access to the List object elements using Jim_ListIndex(). */
5169 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5170 Jim_Obj ***listVec)
5171 {
5172 Jim_ListLength(interp, listObj, argc);
5173 assert(listObj->typePtr == &listObjType);
5174 *listVec = listObj->internalRep.listValue.ele;
5175 }
5176
5177 /* ListSortElements type values */
5178 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5179 JIM_LSORT_NOCASE_DECR};
5180
5181 /* Sort the internal rep of a list. */
5182 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5183 {
5184 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5185 }
5186
5187 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5188 {
5189 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5190 }
5191
5192 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5193 {
5194 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5195 }
5196
5197 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5198 {
5199 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5200 }
5201
5202 /* Sort a list *in place*. MUST be called with non-shared objects. */
5203 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5204 {
5205 typedef int (qsort_comparator)(const void *, const void *);
5206 int (*fn)(Jim_Obj**, Jim_Obj**);
5207 Jim_Obj **vector;
5208 int len;
5209
5210 if (Jim_IsShared(listObjPtr))
5211 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5212 if (listObjPtr->typePtr != &listObjType)
5213 SetListFromAny(interp, listObjPtr);
5214
5215 vector = listObjPtr->internalRep.listValue.ele;
5216 len = listObjPtr->internalRep.listValue.len;
5217 switch (type) {
5218 case JIM_LSORT_ASCII: fn = ListSortString; break;
5219 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5220 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5221 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5222 default:
5223 fn = NULL; /* avoid warning */
5224 Jim_Panic(interp,"ListSort called with invalid sort type");
5225 }
5226 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5227 Jim_InvalidateStringRep(listObjPtr);
5228 }
5229
5230 /* This is the low-level function to append an element to a list.
5231 * The higher-level Jim_ListAppendElement() performs shared object
5232 * check and invalidate the string repr. This version is used
5233 * in the internals of the List Object and is not exported.
5234 *
5235 * NOTE: this function can be called only against objects
5236 * with internal type of List. */
5237 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5238 {
5239 int requiredLen = listPtr->internalRep.listValue.len + 1;
5240
5241 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5242 int maxLen = requiredLen * 2;
5243
5244 listPtr->internalRep.listValue.ele =
5245 Jim_Realloc(listPtr->internalRep.listValue.ele,
5246 sizeof(Jim_Obj*)*maxLen);
5247 listPtr->internalRep.listValue.maxLen = maxLen;
5248 }
5249 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5250 objPtr;
5251 listPtr->internalRep.listValue.len ++;
5252 Jim_IncrRefCount(objPtr);
5253 }
5254
5255 /* This is the low-level function to insert elements into a list.
5256 * The higher-level Jim_ListInsertElements() performs shared object
5257 * check and invalidate the string repr. This version is used
5258 * in the internals of the List Object and is not exported.
5259 *
5260 * NOTE: this function can be called only against objects
5261 * with internal type of List. */
5262 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5263 Jim_Obj *const *elemVec)
5264 {
5265 int currentLen = listPtr->internalRep.listValue.len;
5266 int requiredLen = currentLen + elemc;
5267 int i;
5268 Jim_Obj **point;
5269
5270 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5271 int maxLen = requiredLen * 2;
5272
5273 listPtr->internalRep.listValue.ele =
5274 Jim_Realloc(listPtr->internalRep.listValue.ele,
5275 sizeof(Jim_Obj*)*maxLen);
5276 listPtr->internalRep.listValue.maxLen = maxLen;
5277 }
5278 point = listPtr->internalRep.listValue.ele + index;
5279 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5280 for (i=0; i < elemc; ++i) {
5281 point[i] = elemVec[i];
5282 Jim_IncrRefCount(point[i]);
5283 }
5284 listPtr->internalRep.listValue.len += elemc;
5285 }
5286
5287 /* Appends every element of appendListPtr into listPtr.
5288 * Both have to be of the list type. */
5289 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5290 {
5291 int i, oldLen = listPtr->internalRep.listValue.len;
5292 int appendLen = appendListPtr->internalRep.listValue.len;
5293 int requiredLen = oldLen + appendLen;
5294
5295 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5296 int maxLen = requiredLen * 2;
5297
5298 listPtr->internalRep.listValue.ele =
5299 Jim_Realloc(listPtr->internalRep.listValue.ele,
5300 sizeof(Jim_Obj*)*maxLen);
5301 listPtr->internalRep.listValue.maxLen = maxLen;
5302 }
5303 for (i = 0; i < appendLen; i++) {
5304 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5305 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5306 Jim_IncrRefCount(objPtr);
5307 }
5308 listPtr->internalRep.listValue.len += appendLen;
5309 }
5310
5311 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5312 {
5313 if (Jim_IsShared(listPtr))
5314 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5315 if (listPtr->typePtr != &listObjType)
5316 SetListFromAny(interp, listPtr);
5317 Jim_InvalidateStringRep(listPtr);
5318 ListAppendElement(listPtr, objPtr);
5319 }
5320
5321 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5322 {
5323 if (Jim_IsShared(listPtr))
5324 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5325 if (listPtr->typePtr != &listObjType)
5326 SetListFromAny(interp, listPtr);
5327 Jim_InvalidateStringRep(listPtr);
5328 ListAppendList(listPtr, appendListPtr);
5329 }
5330
5331 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5332 {
5333 if (listPtr->typePtr != &listObjType)
5334 SetListFromAny(interp, listPtr);
5335 *intPtr = listPtr->internalRep.listValue.len;
5336 }
5337
5338 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5339 int objc, Jim_Obj *const *objVec)
5340 {
5341 if (Jim_IsShared(listPtr))
5342 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5343 if (listPtr->typePtr != &listObjType)
5344 SetListFromAny(interp, listPtr);
5345 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5346 index = listPtr->internalRep.listValue.len;
5347 else if (index < 0 )
5348 index = 0;
5349 Jim_InvalidateStringRep(listPtr);
5350 ListInsertElements(listPtr, index, objc, objVec);
5351 }
5352
5353 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5354 Jim_Obj **objPtrPtr, int flags)
5355 {
5356 if (listPtr->typePtr != &listObjType)
5357 SetListFromAny(interp, listPtr);
5358 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5359 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5360 if (flags & JIM_ERRMSG) {
5361 Jim_SetResultString(interp,
5362 "list index out of range", -1);
5363 }
5364 return JIM_ERR;
5365 }
5366 if (index < 0)
5367 index = listPtr->internalRep.listValue.len+index;
5368 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5369 return JIM_OK;
5370 }
5371
5372 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5373 Jim_Obj *newObjPtr, int flags)
5374 {
5375 if (listPtr->typePtr != &listObjType)
5376 SetListFromAny(interp, listPtr);
5377 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5378 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5379 if (flags & JIM_ERRMSG) {
5380 Jim_SetResultString(interp,
5381 "list index out of range", -1);
5382 }
5383 return JIM_ERR;
5384 }
5385 if (index < 0)
5386 index = listPtr->internalRep.listValue.len+index;
5387 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5388 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5389 Jim_IncrRefCount(newObjPtr);
5390 return JIM_OK;
5391 }
5392
5393 /* Modify the list stored into the variable named 'varNamePtr'
5394 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5395 * with the new element 'newObjptr'. */
5396 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5397 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5398 {
5399 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5400 int shared, i, index;
5401
5402 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5403 if (objPtr == NULL)
5404 return JIM_ERR;
5405 if ((shared = Jim_IsShared(objPtr)))
5406 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5407 for (i = 0; i < indexc-1; i++) {
5408 listObjPtr = objPtr;
5409 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5410 goto err;
5411 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5412 JIM_ERRMSG) != JIM_OK) {
5413 goto err;
5414 }
5415 if (Jim_IsShared(objPtr)) {
5416 objPtr = Jim_DuplicateObj(interp, objPtr);
5417 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5418 }
5419 Jim_InvalidateStringRep(listObjPtr);
5420 }
5421 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5422 goto err;
5423 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5424 goto err;
5425 Jim_InvalidateStringRep(objPtr);
5426 Jim_InvalidateStringRep(varObjPtr);
5427 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5428 goto err;
5429 Jim_SetResult(interp, varObjPtr);
5430 return JIM_OK;
5431 err:
5432 if (shared) {
5433 Jim_FreeNewObj(interp, varObjPtr);
5434 }
5435 return JIM_ERR;
5436 }
5437
5438 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5439 {
5440 int i;
5441
5442 /* If all the objects in objv are lists without string rep.
5443 * it's possible to return a list as result, that's the
5444 * concatenation of all the lists. */
5445 for (i = 0; i < objc; i++) {
5446 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5447 break;
5448 }
5449 if (i == objc) {
5450 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5451 for (i = 0; i < objc; i++)
5452 Jim_ListAppendList(interp, objPtr, objv[i]);
5453 return objPtr;
5454 } else {
5455 /* Else... we have to glue strings together */
5456 int len = 0, objLen;
5457 char *bytes, *p;
5458
5459 /* Compute the length */
5460 for (i = 0; i < objc; i++) {
5461 Jim_GetString(objv[i], &objLen);
5462 len += objLen;
5463 }
5464 if (objc) len += objc-1;
5465 /* Create the string rep, and a stinrg object holding it. */
5466 p = bytes = Jim_Alloc(len+1);
5467 for (i = 0; i < objc; i++) {
5468 const char *s = Jim_GetString(objv[i], &objLen);
5469 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5470 {
5471 s++; objLen--; len--;
5472 }
5473 while (objLen && (s[objLen-1] == ' ' ||
5474 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5475 objLen--; len--;
5476 }
5477 memcpy(p, s, objLen);
5478 p += objLen;
5479 if (objLen && i+1 != objc) {
5480 *p++ = ' ';
5481 } else if (i+1 != objc) {
5482 /* Drop the space calcuated for this
5483 * element that is instead null. */
5484 len--;
5485 }
5486 }
5487 *p = '\0';
5488 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5489 }
5490 }
5491
5492 /* Returns a list composed of the elements in the specified range.
5493 * first and start are directly accepted as Jim_Objects and
5494 * processed for the end?-index? case. */
5495 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5496 {
5497 int first, last;
5498 int len, rangeLen;
5499
5500 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5501 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5502 return NULL;
5503 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5504 first = JimRelToAbsIndex(len, first);
5505 last = JimRelToAbsIndex(len, last);
5506 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5507 return Jim_NewListObj(interp,
5508 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5509 }
5510
5511 /* -----------------------------------------------------------------------------
5512 * Dict object
5513 * ---------------------------------------------------------------------------*/
5514 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5515 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5516 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5517 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5518
5519 /* Dict HashTable Type.
5520 *
5521 * Keys and Values are Jim objects. */
5522
5523 unsigned int JimObjectHTHashFunction(const void *key)
5524 {
5525 const char *str;
5526 Jim_Obj *objPtr = (Jim_Obj*) key;
5527 int len, h;
5528
5529 str = Jim_GetString(objPtr, &len);
5530 h = Jim_GenHashFunction((unsigned char*)str, len);
5531 return h;
5532 }
5533
5534 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5535 {
5536 JIM_NOTUSED(privdata);
5537
5538 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5539 }
5540
5541 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5542 {
5543 Jim_Obj *objPtr = val;
5544
5545 Jim_DecrRefCount(interp, objPtr);
5546 }
5547
5548 static Jim_HashTableType JimDictHashTableType = {
5549 JimObjectHTHashFunction, /* hash function */
5550 NULL, /* key dup */
5551 NULL, /* val dup */
5552 JimObjectHTKeyCompare, /* key compare */
5553 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5554 JimObjectHTKeyValDestructor, /* key destructor */
5555 JimObjectHTKeyValDestructor /* val destructor */
5556 };
5557
5558 /* Note that while the elements of the dict may contain references,
5559 * the list object itself can't. This basically means that the
5560 * dict object string representation as a whole can't contain references
5561 * that are not presents in the single elements. */
5562 static Jim_ObjType dictObjType = {
5563 "dict",
5564 FreeDictInternalRep,
5565 DupDictInternalRep,
5566 UpdateStringOfDict,
5567 JIM_TYPE_NONE,
5568 };
5569
5570 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5571 {
5572 JIM_NOTUSED(interp);
5573
5574 Jim_FreeHashTable(objPtr->internalRep.ptr);
5575 Jim_Free(objPtr->internalRep.ptr);
5576 }
5577
5578 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5579 {
5580 Jim_HashTable *ht, *dupHt;
5581 Jim_HashTableIterator *htiter;
5582 Jim_HashEntry *he;
5583
5584 /* Create a new hash table */
5585 ht = srcPtr->internalRep.ptr;
5586 dupHt = Jim_Alloc(sizeof(*dupHt));
5587 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5588 if (ht->size != 0)
5589 Jim_ExpandHashTable(dupHt, ht->size);
5590 /* Copy every element from the source to the dup hash table */
5591 htiter = Jim_GetHashTableIterator(ht);
5592 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5593 const Jim_Obj *keyObjPtr = he->key;
5594 Jim_Obj *valObjPtr = he->val;
5595
5596 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5597 Jim_IncrRefCount(valObjPtr);
5598 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5599 }
5600 Jim_FreeHashTableIterator(htiter);
5601
5602 dupPtr->internalRep.ptr = dupHt;
5603 dupPtr->typePtr = &dictObjType;
5604 }
5605
5606 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5607 {
5608 int i, bufLen, realLength;
5609 const char *strRep;
5610 char *p;
5611 int *quotingType, objc;
5612 Jim_HashTable *ht;
5613 Jim_HashTableIterator *htiter;
5614 Jim_HashEntry *he;
5615 Jim_Obj **objv;
5616
5617 /* Trun the hash table into a flat vector of Jim_Objects. */
5618 ht = objPtr->internalRep.ptr;
5619 objc = ht->used*2;
5620 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5621 htiter = Jim_GetHashTableIterator(ht);
5622 i = 0;
5623 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5624 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5625 objv[i++] = he->val;
5626 }
5627 Jim_FreeHashTableIterator(htiter);
5628 /* (Over) Estimate the space needed. */
5629 quotingType = Jim_Alloc(sizeof(int)*objc);
5630 bufLen = 0;
5631 for (i = 0; i < objc; i++) {
5632 int len;
5633
5634 strRep = Jim_GetString(objv[i], &len);
5635 quotingType[i] = ListElementQuotingType(strRep, len);
5636 switch (quotingType[i]) {
5637 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5638 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5639 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5640 }
5641 bufLen++; /* elements separator. */
5642 }
5643 bufLen++;
5644
5645 /* Generate the string rep. */
5646 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5647 realLength = 0;
5648 for (i = 0; i < objc; i++) {
5649 int len, qlen;
5650 const char *strRep = Jim_GetString(objv[i], &len);
5651 char *q;
5652
5653 switch(quotingType[i]) {
5654 case JIM_ELESTR_SIMPLE:
5655 memcpy(p, strRep, len);
5656 p += len;
5657 realLength += len;
5658 break;
5659 case JIM_ELESTR_BRACE:
5660 *p++ = '{';
5661 memcpy(p, strRep, len);
5662 p += len;
5663 *p++ = '}';
5664 realLength += len+2;
5665 break;
5666 case JIM_ELESTR_QUOTE:
5667 q = BackslashQuoteString(strRep, len, &qlen);
5668 memcpy(p, q, qlen);
5669 Jim_Free(q);
5670 p += qlen;
5671 realLength += qlen;
5672 break;
5673 }
5674 /* Add a separating space */
5675 if (i+1 != objc) {
5676 *p++ = ' ';
5677 realLength ++;
5678 }
5679 }
5680 *p = '\0'; /* nul term. */
5681 objPtr->length = realLength;
5682 Jim_Free(quotingType);
5683 Jim_Free(objv);
5684 }
5685
5686 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5687 {
5688 struct JimParserCtx parser;
5689 Jim_HashTable *ht;
5690 Jim_Obj *objv[2];
5691 const char *str;
5692 int i, strLen;
5693
5694 /* Get the string representation */
5695 str = Jim_GetString(objPtr, &strLen);
5696
5697 /* Free the old internal repr just now and initialize the
5698 * new one just now. The string->list conversion can't fail. */
5699 Jim_FreeIntRep(interp, objPtr);
5700 ht = Jim_Alloc(sizeof(*ht));
5701 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5702 objPtr->typePtr = &dictObjType;
5703 objPtr->internalRep.ptr = ht;
5704
5705 /* Convert into a dict */
5706 JimParserInit(&parser, str, strLen, 1);
5707 i = 0;
5708 while(!JimParserEof(&parser)) {
5709 char *token;
5710 int tokenLen, type;
5711
5712 JimParseList(&parser);
5713 if (JimParserTtype(&parser) != JIM_TT_STR &&
5714 JimParserTtype(&parser) != JIM_TT_ESC)
5715 continue;
5716 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5717 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5718 if (i == 2) {
5719 i = 0;
5720 Jim_IncrRefCount(objv[0]);
5721 Jim_IncrRefCount(objv[1]);
5722 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5723 Jim_HashEntry *he;
5724 he = Jim_FindHashEntry(ht, objv[0]);
5725 Jim_DecrRefCount(interp, objv[0]);
5726 /* ATTENTION: const cast */
5727 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5728 he->val = objv[1];
5729 }
5730 }
5731 }
5732 if (i) {
5733 Jim_FreeNewObj(interp, objv[0]);
5734 objPtr->typePtr = NULL;
5735 Jim_FreeHashTable(ht);
5736 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5737 return JIM_ERR;
5738 }
5739 return JIM_OK;
5740 }
5741
5742 /* Dict object API */
5743
5744 /* Add an element to a dict. objPtr must be of the "dict" type.
5745 * The higer-level exported function is Jim_DictAddElement().
5746 * If an element with the specified key already exists, the value
5747 * associated is replaced with the new one.
5748 *
5749 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5750 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5751 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5752 {
5753 Jim_HashTable *ht = objPtr->internalRep.ptr;
5754
5755 if (valueObjPtr == NULL) { /* unset */
5756 Jim_DeleteHashEntry(ht, keyObjPtr);
5757 return;
5758 }
5759 Jim_IncrRefCount(keyObjPtr);
5760 Jim_IncrRefCount(valueObjPtr);
5761 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5762 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5763 Jim_DecrRefCount(interp, keyObjPtr);
5764 /* ATTENTION: const cast */
5765 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5766 he->val = valueObjPtr;
5767 }
5768 }
5769
5770 /* Add an element, higher-level interface for DictAddElement().
5771 * If valueObjPtr == NULL, the key is removed if it exists. */
5772 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5773 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5774 {
5775 if (Jim_IsShared(objPtr))
5776 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5777 if (objPtr->typePtr != &dictObjType) {
5778 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5779 return JIM_ERR;
5780 }
5781 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5782 Jim_InvalidateStringRep(objPtr);
5783 return JIM_OK;
5784 }
5785
5786 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5787 {
5788 Jim_Obj *objPtr;
5789 int i;
5790
5791 if (len % 2)
5792 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5793
5794 objPtr = Jim_NewObj(interp);
5795 objPtr->typePtr = &dictObjType;
5796 objPtr->bytes = NULL;
5797 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5798 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5799 for (i = 0; i < len; i += 2)
5800 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5801 return objPtr;
5802 }
5803
5804 /* Return the value associated to the specified dict key */
5805 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5806 Jim_Obj **objPtrPtr, int flags)
5807 {
5808 Jim_HashEntry *he;
5809 Jim_HashTable *ht;
5810
5811 if (dictPtr->typePtr != &dictObjType) {
5812 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5813 return JIM_ERR;
5814 }
5815 ht = dictPtr->internalRep.ptr;
5816 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5817 if (flags & JIM_ERRMSG) {
5818 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5819 Jim_AppendStrings(interp, Jim_GetResult(interp),
5820 "key \"", Jim_GetString(keyPtr, NULL),
5821 "\" not found in dictionary", NULL);
5822 }
5823 return JIM_ERR;
5824 }
5825 *objPtrPtr = he->val;
5826 return JIM_OK;
5827 }
5828
5829 /* Return the value associated to the specified dict keys */
5830 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5831 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5832 {
5833 Jim_Obj *objPtr;
5834 int i;
5835
5836 if (keyc == 0) {
5837 *objPtrPtr = dictPtr;
5838 return JIM_OK;
5839 }
5840
5841 for (i = 0; i < keyc; i++) {
5842 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5843 != JIM_OK)
5844 return JIM_ERR;
5845 dictPtr = objPtr;
5846 }
5847 *objPtrPtr = objPtr;
5848 return JIM_OK;
5849 }
5850
5851 /* Modify the dict stored into the variable named 'varNamePtr'
5852 * setting the element specified by the 'keyc' keys objects in 'keyv',
5853 * with the new value of the element 'newObjPtr'.
5854 *
5855 * If newObjPtr == NULL the operation is to remove the given key
5856 * from the dictionary. */
5857 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5858 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5859 {
5860 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5861 int shared, i;
5862
5863 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5864 if (objPtr == NULL) {
5865 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5866 return JIM_ERR;
5867 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5868 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5869 Jim_FreeNewObj(interp, varObjPtr);
5870 return JIM_ERR;
5871 }
5872 }
5873 if ((shared = Jim_IsShared(objPtr)))
5874 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5875 for (i = 0; i < keyc-1; i++) {
5876 dictObjPtr = objPtr;
5877
5878 /* Check if it's a valid dictionary */
5879 if (dictObjPtr->typePtr != &dictObjType) {
5880 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5881 goto err;
5882 }
5883 /* Check if the given key exists. */
5884 Jim_InvalidateStringRep(dictObjPtr);
5885 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5886 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5887 {
5888 /* This key exists at the current level.
5889 * Make sure it's not shared!. */
5890 if (Jim_IsShared(objPtr)) {
5891 objPtr = Jim_DuplicateObj(interp, objPtr);
5892 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5893 }
5894 } else {
5895 /* Key not found. If it's an [unset] operation
5896 * this is an error. Only the last key may not
5897 * exist. */
5898 if (newObjPtr == NULL)
5899 goto err;
5900 /* Otherwise set an empty dictionary
5901 * as key's value. */
5902 objPtr = Jim_NewDictObj(interp, NULL, 0);
5903 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5904 }
5905 }
5906 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5907 != JIM_OK)
5908 goto err;
5909 Jim_InvalidateStringRep(objPtr);
5910 Jim_InvalidateStringRep(varObjPtr);
5911 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5912 goto err;
5913 Jim_SetResult(interp, varObjPtr);
5914 return JIM_OK;
5915 err:
5916 if (shared) {
5917 Jim_FreeNewObj(interp, varObjPtr);
5918 }
5919 return JIM_ERR;
5920 }
5921
5922 /* -----------------------------------------------------------------------------
5923 * Index object
5924 * ---------------------------------------------------------------------------*/
5925 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
5926 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5927
5928 static Jim_ObjType indexObjType = {
5929 "index",
5930 NULL,
5931 NULL,
5932 UpdateStringOfIndex,
5933 JIM_TYPE_NONE,
5934 };
5935
5936 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
5937 {
5938 int len;
5939 char buf[JIM_INTEGER_SPACE+1];
5940
5941 if (objPtr->internalRep.indexValue >= 0)
5942 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
5943 else if (objPtr->internalRep.indexValue == -1)
5944 len = sprintf(buf, "end");
5945 else {
5946 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
5947 }
5948 objPtr->bytes = Jim_Alloc(len+1);
5949 memcpy(objPtr->bytes, buf, len+1);
5950 objPtr->length = len;
5951 }
5952
5953 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5954 {
5955 int index, end = 0;
5956 const char *str;
5957
5958 /* Get the string representation */
5959 str = Jim_GetString(objPtr, NULL);
5960 /* Try to convert into an index */
5961 if (!strcmp(str, "end")) {
5962 index = 0;
5963 end = 1;
5964 } else {
5965 if (!strncmp(str, "end-", 4)) {
5966 str += 4;
5967 end = 1;
5968 }
5969 if (Jim_StringToIndex(str, &index) != JIM_OK) {
5970 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5971 Jim_AppendStrings(interp, Jim_GetResult(interp),
5972 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
5973 "must be integer or end?-integer?", NULL);
5974 return JIM_ERR;
5975 }
5976 }
5977 if (end) {
5978 if (index < 0)
5979 index = INT_MAX;
5980 else
5981 index = -(index+1);
5982 } else if (!end && index < 0)
5983 index = -INT_MAX;
5984 /* Free the old internal repr and set the new one. */
5985 Jim_FreeIntRep(interp, objPtr);
5986 objPtr->typePtr = &indexObjType;
5987 objPtr->internalRep.indexValue = index;
5988 return JIM_OK;
5989 }
5990
5991 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
5992 {
5993 /* Avoid shimmering if the object is an integer. */
5994 if (objPtr->typePtr == &intObjType) {
5995 jim_wide val = objPtr->internalRep.wideValue;
5996 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
5997 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
5998 return JIM_OK;
5999 }
6000 }
6001 if (objPtr->typePtr != &indexObjType &&
6002 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6003 return JIM_ERR;
6004 *indexPtr = objPtr->internalRep.indexValue;
6005 return JIM_OK;
6006 }
6007
6008 /* -----------------------------------------------------------------------------
6009 * Return Code Object.
6010 * ---------------------------------------------------------------------------*/
6011
6012 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6013
6014 static Jim_ObjType returnCodeObjType = {
6015 "return-code",
6016 NULL,
6017 NULL,
6018 NULL,
6019 JIM_TYPE_NONE,
6020 };
6021
6022 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6023 {
6024 const char *str;
6025 int strLen, returnCode;
6026 jim_wide wideValue;
6027
6028 /* Get the string representation */
6029 str = Jim_GetString(objPtr, &strLen);
6030 /* Try to convert into an integer */
6031 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6032 returnCode = (int) wideValue;
6033 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6034 returnCode = JIM_OK;
6035 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6036 returnCode = JIM_ERR;
6037 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6038 returnCode = JIM_RETURN;
6039 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6040 returnCode = JIM_BREAK;
6041 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6042 returnCode = JIM_CONTINUE;
6043 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6044 returnCode = JIM_EVAL;
6045 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6046 returnCode = JIM_EXIT;
6047 else {
6048 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6049 Jim_AppendStrings(interp, Jim_GetResult(interp),
6050 "expected return code but got '", str, "'",
6051 NULL);
6052 return JIM_ERR;
6053 }
6054 /* Free the old internal repr and set the new one. */
6055 Jim_FreeIntRep(interp, objPtr);
6056 objPtr->typePtr = &returnCodeObjType;
6057 objPtr->internalRep.returnCode = returnCode;
6058 return JIM_OK;
6059 }
6060
6061 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6062 {
6063 if (objPtr->typePtr != &returnCodeObjType &&
6064 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6065 return JIM_ERR;
6066 *intPtr = objPtr->internalRep.returnCode;
6067 return JIM_OK;
6068 }
6069
6070 /* -----------------------------------------------------------------------------
6071 * Expression Parsing
6072 * ---------------------------------------------------------------------------*/
6073 static int JimParseExprOperator(struct JimParserCtx *pc);
6074 static int JimParseExprNumber(struct JimParserCtx *pc);
6075 static int JimParseExprIrrational(struct JimParserCtx *pc);
6076
6077 /* Exrp's Stack machine operators opcodes. */
6078
6079 /* Binary operators (numbers) */
6080 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6081 #define JIM_EXPROP_MUL 0
6082 #define JIM_EXPROP_DIV 1
6083 #define JIM_EXPROP_MOD 2
6084 #define JIM_EXPROP_SUB 3
6085 #define JIM_EXPROP_ADD 4
6086 #define JIM_EXPROP_LSHIFT 5
6087 #define JIM_EXPROP_RSHIFT 6
6088 #define JIM_EXPROP_ROTL 7
6089 #define JIM_EXPROP_ROTR 8
6090 #define JIM_EXPROP_LT 9
6091 #define JIM_EXPROP_GT 10
6092 #define JIM_EXPROP_LTE 11
6093 #define JIM_EXPROP_GTE 12
6094 #define JIM_EXPROP_NUMEQ 13
6095 #define JIM_EXPROP_NUMNE 14
6096 #define JIM_EXPROP_BITAND 15
6097 #define JIM_EXPROP_BITXOR 16
6098 #define JIM_EXPROP_BITOR 17
6099 #define JIM_EXPROP_LOGICAND 18
6100 #define JIM_EXPROP_LOGICOR 19
6101 #define JIM_EXPROP_LOGICAND_LEFT 20
6102 #define JIM_EXPROP_LOGICOR_LEFT 21
6103 #define JIM_EXPROP_POW 22
6104 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6105
6106 /* Binary operators (strings) */
6107 #define JIM_EXPROP_STREQ 23
6108 #define JIM_EXPROP_STRNE 24
6109
6110 /* Unary operators (numbers) */
6111 #define JIM_EXPROP_NOT 25
6112 #define JIM_EXPROP_BITNOT 26
6113 #define JIM_EXPROP_UNARYMINUS 27
6114 #define JIM_EXPROP_UNARYPLUS 28
6115 #define JIM_EXPROP_LOGICAND_RIGHT 29
6116 #define JIM_EXPROP_LOGICOR_RIGHT 30
6117
6118 /* Ternary operators */
6119 #define JIM_EXPROP_TERNARY 31
6120
6121 /* Operands */
6122 #define JIM_EXPROP_NUMBER 32
6123 #define JIM_EXPROP_COMMAND 33
6124 #define JIM_EXPROP_VARIABLE 34
6125 #define JIM_EXPROP_DICTSUGAR 35
6126 #define JIM_EXPROP_SUBST 36
6127 #define JIM_EXPROP_STRING 37
6128
6129 /* Operators table */
6130 typedef struct Jim_ExprOperator {
6131 const char *name;
6132 int precedence;
6133 int arity;
6134 int opcode;
6135 } Jim_ExprOperator;
6136
6137 /* name - precedence - arity - opcode */
6138 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6139 {"!", 300, 1, JIM_EXPROP_NOT},
6140 {"~", 300, 1, JIM_EXPROP_BITNOT},
6141 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6142 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6143
6144 {"**", 250, 2, JIM_EXPROP_POW},
6145
6146 {"*", 200, 2, JIM_EXPROP_MUL},
6147 {"/", 200, 2, JIM_EXPROP_DIV},
6148 {"%", 200, 2, JIM_EXPROP_MOD},
6149
6150 {"-", 100, 2, JIM_EXPROP_SUB},
6151 {"+", 100, 2, JIM_EXPROP_ADD},
6152
6153 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6154 {">>>", 90, 3, JIM_EXPROP_ROTR},
6155 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6156 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6157
6158 {"<", 80, 2, JIM_EXPROP_LT},
6159 {">", 80, 2, JIM_EXPROP_GT},
6160 {"<=", 80, 2, JIM_EXPROP_LTE},
6161 {">=", 80, 2, JIM_EXPROP_GTE},
6162
6163 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6164 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6165
6166 {"eq", 60, 2, JIM_EXPROP_STREQ},
6167 {"ne", 60, 2, JIM_EXPROP_STRNE},
6168
6169 {"&", 50, 2, JIM_EXPROP_BITAND},
6170 {"^", 49, 2, JIM_EXPROP_BITXOR},
6171 {"|", 48, 2, JIM_EXPROP_BITOR},
6172
6173 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6174 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6175
6176 {"?", 5, 3, JIM_EXPROP_TERNARY},
6177 /* private operators */
6178 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6179 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6180 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6181 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6182 };
6183
6184 #define JIM_EXPR_OPERATORS_NUM \
6185 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6186
6187 int JimParseExpression(struct JimParserCtx *pc)
6188 {
6189 /* Discard spaces and quoted newline */
6190 while(*(pc->p) == ' ' ||
6191 *(pc->p) == '\t' ||
6192 *(pc->p) == '\r' ||
6193 *(pc->p) == '\n' ||
6194 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6195 pc->p++; pc->len--;
6196 }
6197
6198 if (pc->len == 0) {
6199 pc->tstart = pc->tend = pc->p;
6200 pc->tline = pc->linenr;
6201 pc->tt = JIM_TT_EOL;
6202 pc->eof = 1;
6203 return JIM_OK;
6204 }
6205 switch(*(pc->p)) {
6206 case '(':
6207 pc->tstart = pc->tend = pc->p;
6208 pc->tline = pc->linenr;
6209 pc->tt = JIM_TT_SUBEXPR_START;
6210 pc->p++; pc->len--;
6211 break;
6212 case ')':
6213 pc->tstart = pc->tend = pc->p;
6214 pc->tline = pc->linenr;
6215 pc->tt = JIM_TT_SUBEXPR_END;
6216 pc->p++; pc->len--;
6217 break;
6218 case '[':
6219 return JimParseCmd(pc);
6220 break;
6221 case '$':
6222 if (JimParseVar(pc) == JIM_ERR)
6223 return JimParseExprOperator(pc);
6224 else
6225 return JIM_OK;
6226 break;
6227 case '-':
6228 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6229 isdigit((int)*(pc->p+1)))
6230 return JimParseExprNumber(pc);
6231 else
6232 return JimParseExprOperator(pc);
6233 break;
6234 case '0': case '1': case '2': case '3': case '4':
6235 case '5': case '6': case '7': case '8': case '9': case '.':
6236 return JimParseExprNumber(pc);
6237 break;
6238 case '"':
6239 case '{':
6240 /* Here it's possible to reuse the List String parsing. */
6241 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6242 return JimParseListStr(pc);
6243 break;
6244 case 'N': case 'I':
6245 case 'n': case 'i':
6246 if (JimParseExprIrrational(pc) == JIM_ERR)
6247 return JimParseExprOperator(pc);
6248 break;
6249 default:
6250 return JimParseExprOperator(pc);
6251 break;
6252 }
6253 return JIM_OK;
6254 }
6255
6256 int JimParseExprNumber(struct JimParserCtx *pc)
6257 {
6258 int allowdot = 1;
6259 int allowhex = 0;
6260
6261 pc->tstart = pc->p;
6262 pc->tline = pc->linenr;
6263 if (*pc->p == '-') {
6264 pc->p++; pc->len--;
6265 }
6266 while ( isdigit((int)*pc->p)
6267 || (allowhex && isxdigit((int)*pc->p) )
6268 || (allowdot && *pc->p == '.')
6269 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6270 (*pc->p == 'x' || *pc->p == 'X'))
6271 )
6272 {
6273 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6274 allowhex = 1;
6275 allowdot = 0;
6276 }
6277 if (*pc->p == '.')
6278 allowdot = 0;
6279 pc->p++; pc->len--;
6280 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6281 pc->p += 2; pc->len -= 2;
6282 }
6283 }
6284 pc->tend = pc->p-1;
6285 pc->tt = JIM_TT_EXPR_NUMBER;
6286 return JIM_OK;
6287 }
6288
6289 int JimParseExprIrrational(struct JimParserCtx *pc)
6290 {
6291 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6292 const char **token;
6293 for (token = Tokens; *token != NULL; token++) {
6294 int len = strlen(*token);
6295 if (strncmp(*token, pc->p, len) == 0) {
6296 pc->tstart = pc->p;
6297 pc->tend = pc->p + len - 1;
6298 pc->p += len; pc->len -= len;
6299 pc->tline = pc->linenr;
6300 pc->tt = JIM_TT_EXPR_NUMBER;
6301 return JIM_OK;
6302 }
6303 }
6304 return JIM_ERR;
6305 }
6306
6307 int JimParseExprOperator(struct JimParserCtx *pc)
6308 {
6309 int i;
6310 int bestIdx = -1, bestLen = 0;
6311
6312 /* Try to get the longest match. */
6313 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6314 const char *opname;
6315 int oplen;
6316
6317 opname = Jim_ExprOperators[i].name;
6318 if (opname == NULL) continue;
6319 oplen = strlen(opname);
6320
6321 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6322 bestIdx = i;
6323 bestLen = oplen;
6324 }
6325 }
6326 if (bestIdx == -1) return JIM_ERR;
6327 pc->tstart = pc->p;
6328 pc->tend = pc->p + bestLen - 1;
6329 pc->p += bestLen; pc->len -= bestLen;
6330 pc->tline = pc->linenr;
6331 pc->tt = JIM_TT_EXPR_OPERATOR;
6332 return JIM_OK;
6333 }
6334
6335 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6336 {
6337 int i;
6338 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6339 if (Jim_ExprOperators[i].name &&
6340 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6341 return &Jim_ExprOperators[i];
6342 return NULL;
6343 }
6344
6345 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6346 {
6347 int i;
6348 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6349 if (Jim_ExprOperators[i].opcode == opcode)
6350 return &Jim_ExprOperators[i];
6351 return NULL;
6352 }
6353
6354 /* -----------------------------------------------------------------------------
6355 * Expression Object
6356 * ---------------------------------------------------------------------------*/
6357 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6358 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6359 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6360
6361 static Jim_ObjType exprObjType = {
6362 "expression",
6363 FreeExprInternalRep,
6364 DupExprInternalRep,
6365 NULL,
6366 JIM_TYPE_REFERENCES,
6367 };
6368
6369 /* Expr bytecode structure */
6370 typedef struct ExprByteCode {
6371 int *opcode; /* Integer array of opcodes. */
6372 Jim_Obj **obj; /* Array of associated Jim Objects. */
6373 int len; /* Bytecode length */
6374 int inUse; /* Used for sharing. */
6375 } ExprByteCode;
6376
6377 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6378 {
6379 int i;
6380 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6381
6382 expr->inUse--;
6383 if (expr->inUse != 0) return;
6384 for (i = 0; i < expr->len; i++)
6385 Jim_DecrRefCount(interp, expr->obj[i]);
6386 Jim_Free(expr->opcode);
6387 Jim_Free(expr->obj);
6388 Jim_Free(expr);
6389 }
6390
6391 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6392 {
6393 JIM_NOTUSED(interp);
6394 JIM_NOTUSED(srcPtr);
6395
6396 /* Just returns an simple string. */
6397 dupPtr->typePtr = NULL;
6398 }
6399
6400 /* Add a new instruction to an expression bytecode structure. */
6401 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6402 int opcode, char *str, int len)
6403 {
6404 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6405 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6406 expr->opcode[expr->len] = opcode;
6407 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6408 Jim_IncrRefCount(expr->obj[expr->len]);
6409 expr->len++;
6410 }
6411
6412 /* Check if an expr program looks correct. */
6413 static int ExprCheckCorrectness(ExprByteCode *expr)
6414 {
6415 int i;
6416 int stacklen = 0;
6417
6418 /* Try to check if there are stack underflows,
6419 * and make sure at the end of the program there is
6420 * a single result on the stack. */
6421 for (i = 0; i < expr->len; i++) {
6422 switch(expr->opcode[i]) {
6423 case JIM_EXPROP_NUMBER:
6424 case JIM_EXPROP_STRING:
6425 case JIM_EXPROP_SUBST:
6426 case JIM_EXPROP_VARIABLE:
6427 case JIM_EXPROP_DICTSUGAR:
6428 case JIM_EXPROP_COMMAND:
6429 stacklen++;
6430 break;
6431 case JIM_EXPROP_NOT:
6432 case JIM_EXPROP_BITNOT:
6433 case JIM_EXPROP_UNARYMINUS:
6434 case JIM_EXPROP_UNARYPLUS:
6435 /* Unary operations */
6436 if (stacklen < 1) return JIM_ERR;
6437 break;
6438 case JIM_EXPROP_ADD:
6439 case JIM_EXPROP_SUB:
6440 case JIM_EXPROP_MUL:
6441 case JIM_EXPROP_DIV:
6442 case JIM_EXPROP_MOD:
6443 case JIM_EXPROP_LT:
6444 case JIM_EXPROP_GT:
6445 case JIM_EXPROP_LTE:
6446 case JIM_EXPROP_GTE:
6447 case JIM_EXPROP_ROTL:
6448 case JIM_EXPROP_ROTR:
6449 case JIM_EXPROP_LSHIFT:
6450 case JIM_EXPROP_RSHIFT:
6451 case JIM_EXPROP_NUMEQ:
6452 case JIM_EXPROP_NUMNE:
6453 case JIM_EXPROP_STREQ:
6454 case JIM_EXPROP_STRNE:
6455 case JIM_EXPROP_BITAND:
6456 case JIM_EXPROP_BITXOR:
6457 case JIM_EXPROP_BITOR:
6458 case JIM_EXPROP_LOGICAND:
6459 case JIM_EXPROP_LOGICOR:
6460 case JIM_EXPROP_POW:
6461 /* binary operations */
6462 if (stacklen < 2) return JIM_ERR;
6463 stacklen--;
6464 break;
6465 default:
6466 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6467 break;
6468 }
6469 }
6470 if (stacklen != 1) return JIM_ERR;
6471 return JIM_OK;
6472 }
6473
6474 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6475 ScriptObj *topLevelScript)
6476 {
6477 int i;
6478
6479 return;
6480 for (i = 0; i < expr->len; i++) {
6481 Jim_Obj *foundObjPtr;
6482
6483 if (expr->obj[i] == NULL) continue;
6484 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6485 NULL, expr->obj[i]);
6486 if (foundObjPtr != NULL) {
6487 Jim_IncrRefCount(foundObjPtr);
6488 Jim_DecrRefCount(interp, expr->obj[i]);
6489 expr->obj[i] = foundObjPtr;
6490 }
6491 }
6492 }
6493
6494 /* This procedure converts every occurrence of || and && opereators
6495 * in lazy unary versions.
6496 *
6497 * a b || is converted into:
6498 *
6499 * a <offset> |L b |R
6500 *
6501 * a b && is converted into:
6502 *
6503 * a <offset> &L b &R
6504 *
6505 * "|L" checks if 'a' is true:
6506 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6507 * the opcode just after |R.
6508 * 2) if it is false does nothing.
6509 * "|R" checks if 'b' is true:
6510 * 1) if it is true pushes 1, otherwise pushes 0.
6511 *
6512 * "&L" checks if 'a' is true:
6513 * 1) if it is true does nothing.
6514 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6515 * the opcode just after &R
6516 * "&R" checks if 'a' is true:
6517 * if it is true pushes 1, otherwise pushes 0.
6518 */
6519 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6520 {
6521 while (1) {
6522 int index = -1, leftindex, arity, i, offset;
6523 Jim_ExprOperator *op;
6524
6525 /* Search for || or && */
6526 for (i = 0; i < expr->len; i++) {
6527 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6528 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6529 index = i;
6530 break;
6531 }
6532 }
6533 if (index == -1) return;
6534 /* Search for the end of the first operator */
6535 leftindex = index-1;
6536 arity = 1;
6537 while(arity) {
6538 switch(expr->opcode[leftindex]) {
6539 case JIM_EXPROP_NUMBER:
6540 case JIM_EXPROP_COMMAND:
6541 case JIM_EXPROP_VARIABLE:
6542 case JIM_EXPROP_DICTSUGAR:
6543 case JIM_EXPROP_SUBST:
6544 case JIM_EXPROP_STRING:
6545 break;
6546 default:
6547 op = JimExprOperatorInfoByOpcode(expr->opcode[i]);
6548 if (op == NULL) {
6549 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6550 }
6551 arity += op->arity;
6552 break;
6553 }
6554 arity--;
6555 leftindex--;
6556 }
6557 leftindex++;
6558 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6559 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6560 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6561 sizeof(int)*(expr->len-leftindex));
6562 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6563 sizeof(Jim_Obj*)*(expr->len-leftindex));
6564 expr->len += 2;
6565 index += 2;
6566 offset = (index-leftindex)-1;
6567 Jim_DecrRefCount(interp, expr->obj[index]);
6568 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6569 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6570 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6571 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6572 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6573 } else {
6574 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6575 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6576 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6577 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6578 }
6579 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6580 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6581 Jim_IncrRefCount(expr->obj[index]);
6582 Jim_IncrRefCount(expr->obj[leftindex]);
6583 Jim_IncrRefCount(expr->obj[leftindex+1]);
6584 }
6585 }
6586
6587 /* This method takes the string representation of an expression
6588 * and generates a program for the Expr's stack-based VM. */
6589 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6590 {
6591 int exprTextLen;
6592 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6593 struct JimParserCtx parser;
6594 int i, shareLiterals;
6595 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6596 Jim_Stack stack;
6597 Jim_ExprOperator *op;
6598
6599 /* Perform literal sharing with the current procedure
6600 * running only if this expression appears to be not generated
6601 * at runtime. */
6602 shareLiterals = objPtr->typePtr == &sourceObjType;
6603
6604 expr->opcode = NULL;
6605 expr->obj = NULL;
6606 expr->len = 0;
6607 expr->inUse = 1;
6608
6609 Jim_InitStack(&stack);
6610 JimParserInit(&parser, exprText, exprTextLen, 1);
6611 while(!JimParserEof(&parser)) {
6612 char *token;
6613 int len, type;
6614
6615 if (JimParseExpression(&parser) != JIM_OK) {
6616 Jim_SetResultString(interp, "Syntax error in expression", -1);
6617 goto err;
6618 }
6619 token = JimParserGetToken(&parser, &len, &type, NULL);
6620 if (type == JIM_TT_EOL) {
6621 Jim_Free(token);
6622 break;
6623 }
6624 switch(type) {
6625 case JIM_TT_STR:
6626 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6627 break;
6628 case JIM_TT_ESC:
6629 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6630 break;
6631 case JIM_TT_VAR:
6632 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6633 break;
6634 case JIM_TT_DICTSUGAR:
6635 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6636 break;
6637 case JIM_TT_CMD:
6638 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6639 break;
6640 case JIM_TT_EXPR_NUMBER:
6641 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6642 break;
6643 case JIM_TT_EXPR_OPERATOR:
6644 op = JimExprOperatorInfo(token);
6645 while(1) {
6646 Jim_ExprOperator *stackTopOp;
6647
6648 if (Jim_StackPeek(&stack) != NULL) {
6649 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6650 } else {
6651 stackTopOp = NULL;
6652 }
6653 if (Jim_StackLen(&stack) && op->arity != 1 &&
6654 stackTopOp && stackTopOp->precedence >= op->precedence)
6655 {
6656 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6657 Jim_StackPeek(&stack), -1);
6658 Jim_StackPop(&stack);
6659 } else {
6660 break;
6661 }
6662 }
6663 Jim_StackPush(&stack, token);
6664 break;
6665 case JIM_TT_SUBEXPR_START:
6666 Jim_StackPush(&stack, Jim_StrDup("("));
6667 Jim_Free(token);
6668 break;
6669 case JIM_TT_SUBEXPR_END:
6670 {
6671 int found = 0;
6672 while(Jim_StackLen(&stack)) {
6673 char *opstr = Jim_StackPop(&stack);
6674 if (!strcmp(opstr, "(")) {
6675 Jim_Free(opstr);
6676 found = 1;
6677 break;
6678 }
6679 op = JimExprOperatorInfo(opstr);
6680 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6681 }
6682 if (!found) {
6683 Jim_SetResultString(interp,
6684 "Unexpected close parenthesis", -1);
6685 goto err;
6686 }
6687 }
6688 Jim_Free(token);
6689 break;
6690 default:
6691 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6692 break;
6693 }
6694 }
6695 while (Jim_StackLen(&stack)) {
6696 char *opstr = Jim_StackPop(&stack);
6697 op = JimExprOperatorInfo(opstr);
6698 if (op == NULL && !strcmp(opstr, "(")) {
6699 Jim_Free(opstr);
6700 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6701 goto err;
6702 }
6703 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6704 }
6705 /* Check program correctness. */
6706 if (ExprCheckCorrectness(expr) != JIM_OK) {
6707 Jim_SetResultString(interp, "Invalid expression", -1);
6708 goto err;
6709 }
6710
6711 /* Free the stack used for the compilation. */
6712 Jim_FreeStackElements(&stack, Jim_Free);
6713 Jim_FreeStack(&stack);
6714
6715 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6716 ExprMakeLazy(interp, expr);
6717
6718 /* Perform literal sharing */
6719 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6720 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6721 if (bodyObjPtr->typePtr == &scriptObjType) {
6722 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6723 ExprShareLiterals(interp, expr, bodyScript);
6724 }
6725 }
6726
6727 /* Free the old internal rep and set the new one. */
6728 Jim_FreeIntRep(interp, objPtr);
6729 Jim_SetIntRepPtr(objPtr, expr);
6730 objPtr->typePtr = &exprObjType;
6731 return JIM_OK;
6732
6733 err: /* we jump here on syntax/compile errors. */
6734 Jim_FreeStackElements(&stack, Jim_Free);
6735 Jim_FreeStack(&stack);
6736 Jim_Free(expr->opcode);
6737 for (i = 0; i < expr->len; i++) {
6738 Jim_DecrRefCount(interp,expr->obj[i]);
6739 }
6740 Jim_Free(expr->obj);
6741 Jim_Free(expr);
6742 return JIM_ERR;
6743 }
6744
6745 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6746 {
6747 if (objPtr->typePtr != &exprObjType) {
6748 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6749 return NULL;
6750 }
6751 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6752 }
6753
6754 /* -----------------------------------------------------------------------------
6755 * Expressions evaluation.
6756 * Jim uses a specialized stack-based virtual machine for expressions,
6757 * that takes advantage of the fact that expr's operators
6758 * can't be redefined.
6759 *
6760 * Jim_EvalExpression() uses the bytecode compiled by
6761 * SetExprFromAny() method of the "expression" object.
6762 *
6763 * On success a Tcl Object containing the result of the evaluation
6764 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6765 * returned.
6766 * On error the function returns a retcode != to JIM_OK and set a suitable
6767 * error on the interp.
6768 * ---------------------------------------------------------------------------*/
6769 #define JIM_EE_STATICSTACK_LEN 10
6770
6771 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6772 Jim_Obj **exprResultPtrPtr)
6773 {
6774 ExprByteCode *expr;
6775 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6776 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6777
6778 Jim_IncrRefCount(exprObjPtr);
6779 expr = Jim_GetExpression(interp, exprObjPtr);
6780 if (!expr) {
6781 Jim_DecrRefCount(interp, exprObjPtr);
6782 return JIM_ERR; /* error in expression. */
6783 }
6784 /* In order to avoid that the internal repr gets freed due to
6785 * shimmering of the exprObjPtr's object, we make the internal rep
6786 * shared. */
6787 expr->inUse++;
6788
6789 /* The stack-based expr VM itself */
6790
6791 /* Stack allocation. Expr programs have the feature that
6792 * a program of length N can't require a stack longer than
6793 * N. */
6794 if (expr->len > JIM_EE_STATICSTACK_LEN)
6795 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6796 else
6797 stack = staticStack;
6798
6799 /* Execute every istruction */
6800 for (i = 0; i < expr->len; i++) {
6801 Jim_Obj *A, *B, *objPtr;
6802 jim_wide wA, wB, wC;
6803 double dA, dB, dC;
6804 const char *sA, *sB;
6805 int Alen, Blen, retcode;
6806 int opcode = expr->opcode[i];
6807
6808 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6809 stack[stacklen++] = expr->obj[i];
6810 Jim_IncrRefCount(expr->obj[i]);
6811 } else if (opcode == JIM_EXPROP_VARIABLE) {
6812 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6813 if (objPtr == NULL) {
6814 error = 1;
6815 goto err;
6816 }
6817 stack[stacklen++] = objPtr;
6818 Jim_IncrRefCount(objPtr);
6819 } else if (opcode == JIM_EXPROP_SUBST) {
6820 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6821 &objPtr, JIM_NONE)) != JIM_OK)
6822 {
6823 error = 1;
6824 errRetCode = retcode;
6825 goto err;
6826 }
6827 stack[stacklen++] = objPtr;
6828 Jim_IncrRefCount(objPtr);
6829 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6830 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6831 if (objPtr == NULL) {
6832 error = 1;
6833 goto err;
6834 }
6835 stack[stacklen++] = objPtr;
6836 Jim_IncrRefCount(objPtr);
6837 } else if (opcode == JIM_EXPROP_COMMAND) {
6838 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6839 error = 1;
6840 errRetCode = retcode;
6841 goto err;
6842 }
6843 stack[stacklen++] = interp->result;
6844 Jim_IncrRefCount(interp->result);
6845 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6846 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6847 {
6848 /* Note that there isn't to increment the
6849 * refcount of objects. the references are moved
6850 * from stack to A and B. */
6851 B = stack[--stacklen];
6852 A = stack[--stacklen];
6853
6854 /* --- Integer --- */
6855 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6856 (B->typePtr == &doubleObjType && !B->bytes) ||
6857 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6858 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6859 goto trydouble;
6860 }
6861 Jim_DecrRefCount(interp, A);
6862 Jim_DecrRefCount(interp, B);
6863 switch(expr->opcode[i]) {
6864 case JIM_EXPROP_ADD: wC = wA+wB; break;
6865 case JIM_EXPROP_SUB: wC = wA-wB; break;
6866 case JIM_EXPROP_MUL: wC = wA*wB; break;
6867 case JIM_EXPROP_LT: wC = wA<wB; break;
6868 case JIM_EXPROP_GT: wC = wA>wB; break;
6869 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6870 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6871 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6872 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6873 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6874 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6875 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6876 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6877 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6878 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6879 case JIM_EXPROP_LOGICAND_LEFT:
6880 if (wA == 0) {
6881 i += (int)wB;
6882 wC = 0;
6883 } else {
6884 continue;
6885 }
6886 break;
6887 case JIM_EXPROP_LOGICOR_LEFT:
6888 if (wA != 0) {
6889 i += (int)wB;
6890 wC = 1;
6891 } else {
6892 continue;
6893 }
6894 break;
6895 case JIM_EXPROP_DIV:
6896 if (wB == 0) goto divbyzero;
6897 wC = wA/wB;
6898 break;
6899 case JIM_EXPROP_MOD:
6900 if (wB == 0) goto divbyzero;
6901 wC = wA%wB;
6902 break;
6903 case JIM_EXPROP_ROTL: {
6904 /* uint32_t would be better. But not everyone has inttypes.h?*/
6905 unsigned long uA = (unsigned long)wA;
6906 #ifdef _MSC_VER
6907 wC = _rotl(uA,(unsigned long)wB);
6908 #else
6909 const unsigned int S = sizeof(unsigned long) * 8;
6910 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6911 #endif
6912 break;
6913 }
6914 case JIM_EXPROP_ROTR: {
6915 unsigned long uA = (unsigned long)wA;
6916 #ifdef _MSC_VER
6917 wC = _rotr(uA,(unsigned long)wB);
6918 #else
6919 const unsigned int S = sizeof(unsigned long) * 8;
6920 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
6921 #endif
6922 break;
6923 }
6924
6925 default:
6926 wC = 0; /* avoid gcc warning */
6927 break;
6928 }
6929 stack[stacklen] = Jim_NewIntObj(interp, wC);
6930 Jim_IncrRefCount(stack[stacklen]);
6931 stacklen++;
6932 continue;
6933 trydouble:
6934 /* --- Double --- */
6935 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
6936 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
6937 Jim_DecrRefCount(interp, A);
6938 Jim_DecrRefCount(interp, B);
6939 error = 1;
6940 goto err;
6941 }
6942 Jim_DecrRefCount(interp, A);
6943 Jim_DecrRefCount(interp, B);
6944 switch(expr->opcode[i]) {
6945 case JIM_EXPROP_ROTL:
6946 case JIM_EXPROP_ROTR:
6947 case JIM_EXPROP_LSHIFT:
6948 case JIM_EXPROP_RSHIFT:
6949 case JIM_EXPROP_BITAND:
6950 case JIM_EXPROP_BITXOR:
6951 case JIM_EXPROP_BITOR:
6952 case JIM_EXPROP_MOD:
6953 case JIM_EXPROP_POW:
6954 Jim_SetResultString(interp,
6955 "Got floating-point value where integer was expected", -1);
6956 error = 1;
6957 goto err;
6958 break;
6959 case JIM_EXPROP_ADD: dC = dA+dB; break;
6960 case JIM_EXPROP_SUB: dC = dA-dB; break;
6961 case JIM_EXPROP_MUL: dC = dA*dB; break;
6962 case JIM_EXPROP_LT: dC = dA<dB; break;
6963 case JIM_EXPROP_GT: dC = dA>dB; break;
6964 case JIM_EXPROP_LTE: dC = dA<=dB; break;
6965 case JIM_EXPROP_GTE: dC = dA>=dB; break;
6966 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
6967 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
6968 case JIM_EXPROP_LOGICAND_LEFT:
6969 if (dA == 0) {
6970 i += (int)dB;
6971 dC = 0;
6972 } else {
6973 continue;
6974 }
6975 break;
6976 case JIM_EXPROP_LOGICOR_LEFT:
6977 if (dA != 0) {
6978 i += (int)dB;
6979 dC = 1;
6980 } else {
6981 continue;
6982 }
6983 break;
6984 case JIM_EXPROP_DIV:
6985 if (dB == 0) goto divbyzero;
6986 dC = dA/dB;
6987 break;
6988 default:
6989 dC = 0; /* avoid gcc warning */
6990 break;
6991 }
6992 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
6993 Jim_IncrRefCount(stack[stacklen]);
6994 stacklen++;
6995 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
6996 B = stack[--stacklen];
6997 A = stack[--stacklen];
6998 sA = Jim_GetString(A, &Alen);
6999 sB = Jim_GetString(B, &Blen);
7000 switch(expr->opcode[i]) {
7001 case JIM_EXPROP_STREQ:
7002 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7003 wC = 1;
7004 else
7005 wC = 0;
7006 break;
7007 case JIM_EXPROP_STRNE:
7008 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7009 wC = 1;
7010 else
7011 wC = 0;
7012 break;
7013 default:
7014 wC = 0; /* avoid gcc warning */
7015 break;
7016 }
7017 Jim_DecrRefCount(interp, A);
7018 Jim_DecrRefCount(interp, B);
7019 stack[stacklen] = Jim_NewIntObj(interp, wC);
7020 Jim_IncrRefCount(stack[stacklen]);
7021 stacklen++;
7022 } else if (opcode == JIM_EXPROP_NOT ||
7023 opcode == JIM_EXPROP_BITNOT ||
7024 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7025 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7026 /* Note that there isn't to increment the
7027 * refcount of objects. the references are moved
7028 * from stack to A and B. */
7029 A = stack[--stacklen];
7030
7031 /* --- Integer --- */
7032 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7033 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7034 goto trydouble_unary;
7035 }
7036 Jim_DecrRefCount(interp, A);
7037 switch(expr->opcode[i]) {
7038 case JIM_EXPROP_NOT: wC = !wA; break;
7039 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7040 case JIM_EXPROP_LOGICAND_RIGHT:
7041 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7042 default:
7043 wC = 0; /* avoid gcc warning */
7044 break;
7045 }
7046 stack[stacklen] = Jim_NewIntObj(interp, wC);
7047 Jim_IncrRefCount(stack[stacklen]);
7048 stacklen++;
7049 continue;
7050 trydouble_unary:
7051 /* --- Double --- */
7052 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7053 Jim_DecrRefCount(interp, A);
7054 error = 1;
7055 goto err;
7056 }
7057 Jim_DecrRefCount(interp, A);
7058 switch(expr->opcode[i]) {
7059 case JIM_EXPROP_NOT: dC = !dA; break;
7060 case JIM_EXPROP_LOGICAND_RIGHT:
7061 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7062 case JIM_EXPROP_BITNOT:
7063 Jim_SetResultString(interp,
7064 "Got floating-point value where integer was expected", -1);
7065 error = 1;
7066 goto err;
7067 break;
7068 default:
7069 dC = 0; /* avoid gcc warning */
7070 break;
7071 }
7072 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7073 Jim_IncrRefCount(stack[stacklen]);
7074 stacklen++;
7075 } else {
7076 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7077 }
7078 }
7079 err:
7080 /* There is no need to decerement the inUse field because
7081 * this reference is transfered back into the exprObjPtr. */
7082 Jim_FreeIntRep(interp, exprObjPtr);
7083 exprObjPtr->typePtr = &exprObjType;
7084 Jim_SetIntRepPtr(exprObjPtr, expr);
7085 Jim_DecrRefCount(interp, exprObjPtr);
7086 if (!error) {
7087 *exprResultPtrPtr = stack[0];
7088 Jim_IncrRefCount(stack[0]);
7089 errRetCode = JIM_OK;
7090 }
7091 for (i = 0; i < stacklen; i++) {
7092 Jim_DecrRefCount(interp, stack[i]);
7093 }
7094 if (stack != staticStack)
7095 Jim_Free(stack);
7096 return errRetCode;
7097 divbyzero:
7098 error = 1;
7099 Jim_SetResultString(interp, "Division by zero", -1);
7100 goto err;
7101 }
7102
7103 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7104 {
7105 int retcode;
7106 jim_wide wideValue;
7107 double doubleValue;
7108 Jim_Obj *exprResultPtr;
7109
7110 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7111 if (retcode != JIM_OK)
7112 return retcode;
7113 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7114 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7115 {
7116 Jim_DecrRefCount(interp, exprResultPtr);
7117 return JIM_ERR;
7118 } else {
7119 Jim_DecrRefCount(interp, exprResultPtr);
7120 *boolPtr = doubleValue != 0;
7121 return JIM_OK;
7122 }
7123 }
7124 Jim_DecrRefCount(interp, exprResultPtr);
7125 *boolPtr = wideValue != 0;
7126 return JIM_OK;
7127 }
7128
7129 /* -----------------------------------------------------------------------------
7130 * ScanFormat String Object
7131 * ---------------------------------------------------------------------------*/
7132
7133 /* This Jim_Obj will held a parsed representation of a format string passed to
7134 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7135 * to be parsed in its entirely first and then, if correct, can be used for
7136 * scanning. To avoid endless re-parsing, the parsed representation will be
7137 * stored in an internal representation and re-used for performance reason. */
7138
7139 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7140 * scanformat string. This part will later be used to extract information
7141 * out from the string to be parsed by Jim_ScanString */
7142
7143 typedef struct ScanFmtPartDescr {
7144 char type; /* Type of conversion (e.g. c, d, f) */
7145 char modifier; /* Modify type (e.g. l - long, h - short */
7146 size_t width; /* Maximal width of input to be converted */
7147 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7148 char *arg; /* Specification of a CHARSET conversion */
7149 char *prefix; /* Prefix to be scanned literally before conversion */
7150 } ScanFmtPartDescr;
7151
7152 /* The ScanFmtStringObj will held the internal representation of a scanformat
7153 * string parsed and separated in part descriptions. Furthermore it contains
7154 * the original string representation of the scanformat string to allow for
7155 * fast update of the Jim_Obj's string representation part.
7156 *
7157 * As add-on the internal object representation add some scratch pad area
7158 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7159 * memory for purpose of string scanning.
7160 *
7161 * The error member points to a static allocated string in case of a mal-
7162 * formed scanformat string or it contains '0' (NULL) in case of a valid
7163 * parse representation.
7164 *
7165 * The whole memory of the internal representation is allocated as a single
7166 * area of memory that will be internally separated. So freeing and duplicating
7167 * of such an object is cheap */
7168
7169 typedef struct ScanFmtStringObj {
7170 jim_wide size; /* Size of internal repr in bytes */
7171 char *stringRep; /* Original string representation */
7172 size_t count; /* Number of ScanFmtPartDescr contained */
7173 size_t convCount; /* Number of conversions that will assign */
7174 size_t maxPos; /* Max position index if XPG3 is used */
7175 const char *error; /* Ptr to error text (NULL if no error */
7176 char *scratch; /* Some scratch pad used by Jim_ScanString */
7177 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7178 } ScanFmtStringObj;
7179
7180
7181 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7182 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7183 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7184
7185 static Jim_ObjType scanFmtStringObjType = {
7186 "scanformatstring",
7187 FreeScanFmtInternalRep,
7188 DupScanFmtInternalRep,
7189 UpdateStringOfScanFmt,
7190 JIM_TYPE_NONE,
7191 };
7192
7193 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7194 {
7195 JIM_NOTUSED(interp);
7196 Jim_Free((char*)objPtr->internalRep.ptr);
7197 objPtr->internalRep.ptr = 0;
7198 }
7199
7200 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7201 {
7202 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7203 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7204
7205 JIM_NOTUSED(interp);
7206 memcpy(newVec, srcPtr->internalRep.ptr, size);
7207 dupPtr->internalRep.ptr = newVec;
7208 dupPtr->typePtr = &scanFmtStringObjType;
7209 }
7210
7211 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7212 {
7213 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7214
7215 objPtr->bytes = Jim_StrDup(bytes);
7216 objPtr->length = strlen(bytes);
7217 }
7218
7219 /* SetScanFmtFromAny will parse a given string and create the internal
7220 * representation of the format specification. In case of an error
7221 * the error data member of the internal representation will be set
7222 * to an descriptive error text and the function will be left with
7223 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7224 * specification */
7225
7226 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7227 {
7228 ScanFmtStringObj *fmtObj;
7229 char *buffer;
7230 int maxCount, i, approxSize, lastPos = -1;
7231 const char *fmt = objPtr->bytes;
7232 int maxFmtLen = objPtr->length;
7233 const char *fmtEnd = fmt + maxFmtLen;
7234 int curr;
7235
7236 Jim_FreeIntRep(interp, objPtr);
7237 /* Count how many conversions could take place maximally */
7238 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7239 if (fmt[i] == '%')
7240 ++maxCount;
7241 /* Calculate an approximation of the memory necessary */
7242 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7243 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7244 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7245 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7246 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7247 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7248 + 1; /* safety byte */
7249 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7250 memset(fmtObj, 0, approxSize);
7251 fmtObj->size = approxSize;
7252 fmtObj->maxPos = 0;
7253 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7254 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7255 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7256 buffer = fmtObj->stringRep + maxFmtLen + 1;
7257 objPtr->internalRep.ptr = fmtObj;
7258 objPtr->typePtr = &scanFmtStringObjType;
7259 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7260 int width=0, skip;
7261 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7262 fmtObj->count++;
7263 descr->width = 0; /* Assume width unspecified */
7264 /* Overread and store any "literal" prefix */
7265 if (*fmt != '%' || fmt[1] == '%') {
7266 descr->type = 0;
7267 descr->prefix = &buffer[i];
7268 for (; fmt < fmtEnd; ++fmt) {
7269 if (*fmt == '%') {
7270 if (fmt[1] != '%') break;
7271 ++fmt;
7272 }
7273 buffer[i++] = *fmt;
7274 }
7275 buffer[i++] = 0;
7276 }
7277 /* Skip the conversion introducing '%' sign */
7278 ++fmt;
7279 /* End reached due to non-conversion literal only? */
7280 if (fmt >= fmtEnd)
7281 goto done;
7282 descr->pos = 0; /* Assume "natural" positioning */
7283 if (*fmt == '*') {
7284 descr->pos = -1; /* Okay, conversion will not be assigned */
7285 ++fmt;
7286 } else
7287 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7288 /* Check if next token is a number (could be width or pos */
7289 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7290 fmt += skip;
7291 /* Was the number a XPG3 position specifier? */
7292 if (descr->pos != -1 && *fmt == '$') {
7293 int prev;
7294 ++fmt;
7295 descr->pos = width;
7296 width = 0;
7297 /* Look if "natural" postioning and XPG3 one was mixed */
7298 if ((lastPos == 0 && descr->pos > 0)
7299 || (lastPos > 0 && descr->pos == 0)) {
7300 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7301 return JIM_ERR;
7302 }
7303 /* Look if this position was already used */
7304 for (prev=0; prev < curr; ++prev) {
7305 if (fmtObj->descr[prev].pos == -1) continue;
7306 if (fmtObj->descr[prev].pos == descr->pos) {
7307 fmtObj->error = "same \"%n$\" conversion specifier "
7308 "used more than once";
7309 return JIM_ERR;
7310 }
7311 }
7312 /* Try to find a width after the XPG3 specifier */
7313 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7314 descr->width = width;
7315 fmt += skip;
7316 }
7317 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7318 fmtObj->maxPos = descr->pos;
7319 } else {
7320 /* Number was not a XPG3, so it has to be a width */
7321 descr->width = width;
7322 }
7323 }
7324 /* If positioning mode was undetermined yet, fix this */
7325 if (lastPos == -1)
7326 lastPos = descr->pos;
7327 /* Handle CHARSET conversion type ... */
7328 if (*fmt == '[') {
7329 int swapped = 1, beg = i, end, j;
7330 descr->type = '[';
7331 descr->arg = &buffer[i];
7332 ++fmt;
7333 if (*fmt == '^') buffer[i++] = *fmt++;
7334 if (*fmt == ']') buffer[i++] = *fmt++;
7335 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7336 if (*fmt != ']') {
7337 fmtObj->error = "unmatched [ in format string";
7338 return JIM_ERR;
7339 }
7340 end = i;
7341 buffer[i++] = 0;
7342 /* In case a range fence was given "backwards", swap it */
7343 while (swapped) {
7344 swapped = 0;
7345 for (j=beg+1; j < end-1; ++j) {
7346 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7347 char tmp = buffer[j-1];
7348 buffer[j-1] = buffer[j+1];
7349 buffer[j+1] = tmp;
7350 swapped = 1;
7351 }
7352 }
7353 }
7354 } else {
7355 /* Remember any valid modifier if given */
7356 if (strchr("hlL", *fmt) != 0)
7357 descr->modifier = tolower((int)*fmt++);
7358
7359 descr->type = *fmt;
7360 if (strchr("efgcsndoxui", *fmt) == 0) {
7361 fmtObj->error = "bad scan conversion character";
7362 return JIM_ERR;
7363 } else if (*fmt == 'c' && descr->width != 0) {
7364 fmtObj->error = "field width may not be specified in %c "
7365 "conversion";
7366 return JIM_ERR;
7367 } else if (*fmt == 'u' && descr->modifier == 'l') {
7368 fmtObj->error = "unsigned wide not supported";
7369 return JIM_ERR;
7370 }
7371 }
7372 curr++;
7373 }
7374 done:
7375 if (fmtObj->convCount == 0) {
7376 fmtObj->error = "no any conversion specifier given";
7377 return JIM_ERR;
7378 }
7379 return JIM_OK;
7380 }
7381
7382 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7383
7384 #define FormatGetCnvCount(_fo_) \
7385 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7386 #define FormatGetMaxPos(_fo_) \
7387 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7388 #define FormatGetError(_fo_) \
7389 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7390
7391 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7392 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7393 * bitvector implementation in Jim? */
7394
7395 static int JimTestBit(const char *bitvec, char ch)
7396 {
7397 div_t pos = div(ch-1, 8);
7398 return bitvec[pos.quot] & (1 << pos.rem);
7399 }
7400
7401 static void JimSetBit(char *bitvec, char ch)
7402 {
7403 div_t pos = div(ch-1, 8);
7404 bitvec[pos.quot] |= (1 << pos.rem);
7405 }
7406
7407 #if 0 /* currently not used */
7408 static void JimClearBit(char *bitvec, char ch)
7409 {
7410 div_t pos = div(ch-1, 8);
7411 bitvec[pos.quot] &= ~(1 << pos.rem);
7412 }
7413 #endif
7414
7415 /* JimScanAString is used to scan an unspecified string that ends with
7416 * next WS, or a string that is specified via a charset. The charset
7417 * is currently implemented in a way to only allow for usage with
7418 * ASCII. Whenever we will switch to UNICODE, another idea has to
7419 * be born :-/
7420 *
7421 * FIXME: Works only with ASCII */
7422
7423 static Jim_Obj *
7424 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7425 {
7426 size_t i;
7427 Jim_Obj *result;
7428 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7429 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7430
7431 /* First init charset to nothing or all, depending if a specified
7432 * or an unspecified string has to be parsed */
7433 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7434 if (sdescr) {
7435 /* There was a set description given, that means we are parsing
7436 * a specified string. So we have to build a corresponding
7437 * charset reflecting the description */
7438 int notFlag = 0;
7439 /* Should the set be negated at the end? */
7440 if (*sdescr == '^') {
7441 notFlag = 1;
7442 ++sdescr;
7443 }
7444 /* Here '-' is meant literally and not to define a range */
7445 if (*sdescr == '-') {
7446 JimSetBit(charset, '-');
7447 ++sdescr;
7448 }
7449 while (*sdescr) {
7450 if (sdescr[1] == '-' && sdescr[2] != 0) {
7451 /* Handle range definitions */
7452 int i;
7453 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7454 JimSetBit(charset, (char)i);
7455 sdescr += 3;
7456 } else {
7457 /* Handle verbatim character definitions */
7458 JimSetBit(charset, *sdescr++);
7459 }
7460 }
7461 /* Negate the charset if there was a NOT given */
7462 for (i=0; notFlag && i < sizeof(charset); ++i)
7463 charset[i] = ~charset[i];
7464 }
7465 /* And after all the mess above, the real work begin ... */
7466 while (str && *str) {
7467 if (!sdescr && isspace((int)*str))
7468 break; /* EOS via WS if unspecified */
7469 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7470 else break; /* EOS via mismatch if specified scanning */
7471 }
7472 *buffer = 0; /* Close the string properly ... */
7473 result = Jim_NewStringObj(interp, anchor, -1);
7474 Jim_Free(anchor); /* ... and free it afer usage */
7475 return result;
7476 }
7477
7478 /* ScanOneEntry will scan one entry out of the string passed as argument.
7479 * It use the sscanf() function for this task. After extracting and
7480 * converting of the value, the count of scanned characters will be
7481 * returned of -1 in case of no conversion tool place and string was
7482 * already scanned thru */
7483
7484 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7485 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7486 {
7487 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7488 ? sizeof(jim_wide) \
7489 : sizeof(double))
7490 char buffer[MAX_SIZE];
7491 char *value = buffer;
7492 const char *tok;
7493 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7494 size_t sLen = strlen(&str[pos]), scanned = 0;
7495 size_t anchor = pos;
7496 int i;
7497
7498 /* First pessimiticly assume, we will not scan anything :-) */
7499 *valObjPtr = 0;
7500 if (descr->prefix) {
7501 /* There was a prefix given before the conversion, skip it and adjust
7502 * the string-to-be-parsed accordingly */
7503 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7504 /* If prefix require, skip WS */
7505 if (isspace((int)descr->prefix[i]))
7506 while (str[pos] && isspace((int)str[pos])) ++pos;
7507 else if (descr->prefix[i] != str[pos])
7508 break; /* Prefix do not match here, leave the loop */
7509 else
7510 ++pos; /* Prefix matched so far, next round */
7511 }
7512 if (str[pos] == 0)
7513 return -1; /* All of str consumed: EOF condition */
7514 else if (descr->prefix[i] != 0)
7515 return 0; /* Not whole prefix consumed, no conversion possible */
7516 }
7517 /* For all but following conversion, skip leading WS */
7518 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7519 while (isspace((int)str[pos])) ++pos;
7520 /* Determine how much skipped/scanned so far */
7521 scanned = pos - anchor;
7522 if (descr->type == 'n') {
7523 /* Return pseudo conversion means: how much scanned so far? */
7524 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7525 } else if (str[pos] == 0) {
7526 /* Cannot scan anything, as str is totally consumed */
7527 return -1;
7528 } else {
7529 /* Processing of conversions follows ... */
7530 if (descr->width > 0) {
7531 /* Do not try to scan as fas as possible but only the given width.
7532 * To ensure this, we copy the part that should be scanned. */
7533 size_t tLen = descr->width > sLen ? sLen : descr->width;
7534 tok = Jim_StrDupLen(&str[pos], tLen);
7535 } else {
7536 /* As no width was given, simply refer to the original string */
7537 tok = &str[pos];
7538 }
7539 switch (descr->type) {
7540 case 'c':
7541 *valObjPtr = Jim_NewIntObj(interp, *tok);
7542 scanned += 1;
7543 break;
7544 case 'd': case 'o': case 'x': case 'u': case 'i': {
7545 char *endp; /* Position where the number finished */
7546 int base = descr->type == 'o' ? 8
7547 : descr->type == 'x' ? 16
7548 : descr->type == 'i' ? 0
7549 : 10;
7550
7551 do {
7552 /* Try to scan a number with the given base */
7553 if (descr->modifier == 'l')
7554 #ifdef HAVE_LONG_LONG
7555 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7556 #else
7557 *(jim_wide*)value = strtol(tok, &endp, base);
7558 #endif
7559 else
7560 if (descr->type == 'u')
7561 *(long*)value = strtoul(tok, &endp, base);
7562 else
7563 *(long*)value = strtol(tok, &endp, base);
7564 /* If scanning failed, and base was undetermined, simply
7565 * put it to 10 and try once more. This should catch the
7566 * case where %i begin to parse a number prefix (e.g.
7567 * '0x' but no further digits follows. This will be
7568 * handled as a ZERO followed by a char 'x' by Tcl */
7569 if (endp == tok && base == 0) base = 10;
7570 else break;
7571 } while (1);
7572 if (endp != tok) {
7573 /* There was some number sucessfully scanned! */
7574 if (descr->modifier == 'l')
7575 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7576 else
7577 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7578 /* Adjust the number-of-chars scanned so far */
7579 scanned += endp - tok;
7580 } else {
7581 /* Nothing was scanned. We have to determine if this
7582 * happened due to e.g. prefix mismatch or input str
7583 * exhausted */
7584 scanned = *tok ? 0 : -1;
7585 }
7586 break;
7587 }
7588 case 's': case '[': {
7589 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7590 scanned += Jim_Length(*valObjPtr);
7591 break;
7592 }
7593 case 'e': case 'f': case 'g': {
7594 char *endp;
7595
7596 *(double*)value = strtod(tok, &endp);
7597 if (endp != tok) {
7598 /* There was some number sucessfully scanned! */
7599 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7600 /* Adjust the number-of-chars scanned so far */
7601 scanned += endp - tok;
7602 } else {
7603 /* Nothing was scanned. We have to determine if this
7604 * happened due to e.g. prefix mismatch or input str
7605 * exhausted */
7606 scanned = *tok ? 0 : -1;
7607 }
7608 break;
7609 }
7610 }
7611 /* If a substring was allocated (due to pre-defined width) do not
7612 * forget to free it */
7613 if (tok != &str[pos])
7614 Jim_Free((char*)tok);
7615 }
7616 return scanned;
7617 }
7618
7619 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7620 * string and returns all converted (and not ignored) values in a list back
7621 * to the caller. If an error occured, a NULL pointer will be returned */
7622
7623 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7624 Jim_Obj *fmtObjPtr, int flags)
7625 {
7626 size_t i, pos;
7627 int scanned = 1;
7628 const char *str = Jim_GetString(strObjPtr, 0);
7629 Jim_Obj *resultList = 0;
7630 Jim_Obj **resultVec;
7631 int resultc;
7632 Jim_Obj *emptyStr = 0;
7633 ScanFmtStringObj *fmtObj;
7634
7635 /* If format specification is not an object, convert it! */
7636 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7637 SetScanFmtFromAny(interp, fmtObjPtr);
7638 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7639 /* Check if format specification was valid */
7640 if (fmtObj->error != 0) {
7641 if (flags & JIM_ERRMSG)
7642 Jim_SetResultString(interp, fmtObj->error, -1);
7643 return 0;
7644 }
7645 /* Allocate a new "shared" empty string for all unassigned conversions */
7646 emptyStr = Jim_NewEmptyStringObj(interp);
7647 Jim_IncrRefCount(emptyStr);
7648 /* Create a list and fill it with empty strings up to max specified XPG3 */
7649 resultList = Jim_NewListObj(interp, 0, 0);
7650 if (fmtObj->maxPos > 0) {
7651 for (i=0; i < fmtObj->maxPos; ++i)
7652 Jim_ListAppendElement(interp, resultList, emptyStr);
7653 JimListGetElements(interp, resultList, &resultc, &resultVec);
7654 }
7655 /* Now handle every partial format description */
7656 for (i=0, pos=0; i < fmtObj->count; ++i) {
7657 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7658 Jim_Obj *value = 0;
7659 /* Only last type may be "literal" w/o conversion - skip it! */
7660 if (descr->type == 0) continue;
7661 /* As long as any conversion could be done, we will proceed */
7662 if (scanned > 0)
7663 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7664 /* In case our first try results in EOF, we will leave */
7665 if (scanned == -1 && i == 0)
7666 goto eof;
7667 /* Advance next pos-to-be-scanned for the amount scanned already */
7668 pos += scanned;
7669 /* value == 0 means no conversion took place so take empty string */
7670 if (value == 0)
7671 value = Jim_NewEmptyStringObj(interp);
7672 /* If value is a non-assignable one, skip it */
7673 if (descr->pos == -1) {
7674 Jim_FreeNewObj(interp, value);
7675 } else if (descr->pos == 0)
7676 /* Otherwise append it to the result list if no XPG3 was given */
7677 Jim_ListAppendElement(interp, resultList, value);
7678 else if (resultVec[descr->pos-1] == emptyStr) {
7679 /* But due to given XPG3, put the value into the corr. slot */
7680 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7681 Jim_IncrRefCount(value);
7682 resultVec[descr->pos-1] = value;
7683 } else {
7684 /* Otherwise, the slot was already used - free obj and ERROR */
7685 Jim_FreeNewObj(interp, value);
7686 goto err;
7687 }
7688 }
7689 Jim_DecrRefCount(interp, emptyStr);
7690 return resultList;
7691 eof:
7692 Jim_DecrRefCount(interp, emptyStr);
7693 Jim_FreeNewObj(interp, resultList);
7694 return (Jim_Obj*)EOF;
7695 err:
7696 Jim_DecrRefCount(interp, emptyStr);
7697 Jim_FreeNewObj(interp, resultList);
7698 return 0;
7699 }
7700
7701 /* -----------------------------------------------------------------------------
7702 * Pseudo Random Number Generation
7703 * ---------------------------------------------------------------------------*/
7704 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7705 int seedLen);
7706
7707 /* Initialize the sbox with the numbers from 0 to 255 */
7708 static void JimPrngInit(Jim_Interp *interp)
7709 {
7710 int i;
7711 unsigned int seed[256];
7712
7713 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7714 for (i = 0; i < 256; i++)
7715 seed[i] = (rand() ^ time(NULL) ^ clock());
7716 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7717 }
7718
7719 /* Generates N bytes of random data */
7720 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7721 {
7722 Jim_PrngState *prng;
7723 unsigned char *destByte = (unsigned char*) dest;
7724 unsigned int si, sj, x;
7725
7726 /* initialization, only needed the first time */
7727 if (interp->prngState == NULL)
7728 JimPrngInit(interp);
7729 prng = interp->prngState;
7730 /* generates 'len' bytes of pseudo-random numbers */
7731 for (x = 0; x < len; x++) {
7732 prng->i = (prng->i+1) & 0xff;
7733 si = prng->sbox[prng->i];
7734 prng->j = (prng->j + si) & 0xff;
7735 sj = prng->sbox[prng->j];
7736 prng->sbox[prng->i] = sj;
7737 prng->sbox[prng->j] = si;
7738 *destByte++ = prng->sbox[(si+sj)&0xff];
7739 }
7740 }
7741
7742 /* Re-seed the generator with user-provided bytes */
7743 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7744 int seedLen)
7745 {
7746 int i;
7747 unsigned char buf[256];
7748 Jim_PrngState *prng;
7749
7750 /* initialization, only needed the first time */
7751 if (interp->prngState == NULL)
7752 JimPrngInit(interp);
7753 prng = interp->prngState;
7754
7755 /* Set the sbox[i] with i */
7756 for (i = 0; i < 256; i++)
7757 prng->sbox[i] = i;
7758 /* Now use the seed to perform a random permutation of the sbox */
7759 for (i = 0; i < seedLen; i++) {
7760 unsigned char t;
7761
7762 t = prng->sbox[i&0xFF];
7763 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7764 prng->sbox[seed[i]] = t;
7765 }
7766 prng->i = prng->j = 0;
7767 /* discard the first 256 bytes of stream. */
7768 JimRandomBytes(interp, buf, 256);
7769 }
7770
7771 /* -----------------------------------------------------------------------------
7772 * Dynamic libraries support (WIN32 not supported)
7773 * ---------------------------------------------------------------------------*/
7774
7775 #ifdef JIM_DYNLIB
7776 #ifdef WIN32
7777 #define RTLD_LAZY 0
7778 void * dlopen(const char *path, int mode)
7779 {
7780 JIM_NOTUSED(mode);
7781
7782 return (void *)LoadLibraryA(path);
7783 }
7784 int dlclose(void *handle)
7785 {
7786 FreeLibrary((HANDLE)handle);
7787 return 0;
7788 }
7789 void *dlsym(void *handle, const char *symbol)
7790 {
7791 return GetProcAddress((HMODULE)handle, symbol);
7792 }
7793 static char win32_dlerror_string[121];
7794 const char *dlerror(void)
7795 {
7796 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7797 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7798 return win32_dlerror_string;
7799 }
7800 #endif /* WIN32 */
7801
7802 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7803 {
7804 Jim_Obj *libPathObjPtr;
7805 int prefixc, i;
7806 void *handle;
7807 int (*onload)(Jim_Interp *interp);
7808
7809 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7810 if (libPathObjPtr == NULL) {
7811 prefixc = 0;
7812 libPathObjPtr = NULL;
7813 } else {
7814 Jim_IncrRefCount(libPathObjPtr);
7815 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7816 }
7817
7818 for (i = -1; i < prefixc; i++) {
7819 if (i < 0) {
7820 handle = dlopen(pathName, RTLD_LAZY);
7821 } else {
7822 FILE *fp;
7823 char buf[JIM_PATH_LEN];
7824 const char *prefix;
7825 int prefixlen;
7826 Jim_Obj *prefixObjPtr;
7827
7828 buf[0] = '\0';
7829 if (Jim_ListIndex(interp, libPathObjPtr, i,
7830 &prefixObjPtr, JIM_NONE) != JIM_OK)
7831 continue;
7832 prefix = Jim_GetString(prefixObjPtr, NULL);
7833 prefixlen = strlen(prefix);
7834 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7835 continue;
7836 if (prefixlen && prefix[prefixlen-1] == '/')
7837 sprintf(buf, "%s%s", prefix, pathName);
7838 else
7839 sprintf(buf, "%s/%s", prefix, pathName);
7840 printf("opening '%s'\n", buf);
7841 fp = fopen(buf, "r");
7842 if (fp == NULL)
7843 continue;
7844 fclose(fp);
7845 handle = dlopen(buf, RTLD_LAZY);
7846 printf("got handle %p\n", handle);
7847 }
7848 if (handle == NULL) {
7849 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7850 Jim_AppendStrings(interp, Jim_GetResult(interp),
7851 "error loading extension \"", pathName,
7852 "\": ", dlerror(), NULL);
7853 if (i < 0)
7854 continue;
7855 goto err;
7856 }
7857 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7858 Jim_SetResultString(interp,
7859 "No Jim_OnLoad symbol found on extension", -1);
7860 goto err;
7861 }
7862 if (onload(interp) == JIM_ERR) {
7863 dlclose(handle);
7864 goto err;
7865 }
7866 Jim_SetEmptyResult(interp);
7867 if (libPathObjPtr != NULL)
7868 Jim_DecrRefCount(interp, libPathObjPtr);
7869 return JIM_OK;
7870 }
7871 err:
7872 if (libPathObjPtr != NULL)
7873 Jim_DecrRefCount(interp, libPathObjPtr);
7874 return JIM_ERR;
7875 }
7876 #else /* JIM_DYNLIB */
7877 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7878 {
7879 JIM_NOTUSED(interp);
7880 JIM_NOTUSED(pathName);
7881
7882 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7883 return JIM_ERR;
7884 }
7885 #endif/* JIM_DYNLIB */
7886
7887 /* -----------------------------------------------------------------------------
7888 * Packages handling
7889 * ---------------------------------------------------------------------------*/
7890
7891 #define JIM_PKG_ANY_VERSION -1
7892
7893 /* Convert a string of the type "1.2" into an integer.
7894 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7895 * to the integer with value 102 */
7896 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7897 int *intPtr, int flags)
7898 {
7899 char *copy;
7900 jim_wide major, minor;
7901 char *majorStr, *minorStr, *p;
7902
7903 if (v[0] == '\0') {
7904 *intPtr = JIM_PKG_ANY_VERSION;
7905 return JIM_OK;
7906 }
7907
7908 copy = Jim_StrDup(v);
7909 p = strchr(copy, '.');
7910 if (p == NULL) goto badfmt;
7911 *p = '\0';
7912 majorStr = copy;
7913 minorStr = p+1;
7914
7915 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
7916 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
7917 goto badfmt;
7918 *intPtr = (int)(major*100+minor);
7919 Jim_Free(copy);
7920 return JIM_OK;
7921
7922 badfmt:
7923 Jim_Free(copy);
7924 if (flags & JIM_ERRMSG) {
7925 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7926 Jim_AppendStrings(interp, Jim_GetResult(interp),
7927 "invalid package version '", v, "'", NULL);
7928 }
7929 return JIM_ERR;
7930 }
7931
7932 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
7933 static int JimPackageMatchVersion(int needed, int actual, int flags)
7934 {
7935 if (needed == JIM_PKG_ANY_VERSION) return 1;
7936 if (flags & JIM_MATCHVER_EXACT) {
7937 return needed == actual;
7938 } else {
7939 return needed/100 == actual/100 && (needed <= actual);
7940 }
7941 }
7942
7943 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
7944 int flags)
7945 {
7946 int intVersion;
7947 /* Check if the version format is ok */
7948 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
7949 return JIM_ERR;
7950 /* If the package was already provided returns an error. */
7951 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
7952 if (flags & JIM_ERRMSG) {
7953 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7954 Jim_AppendStrings(interp, Jim_GetResult(interp),
7955 "package '", name, "' was already provided", NULL);
7956 }
7957 return JIM_ERR;
7958 }
7959 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
7960 return JIM_OK;
7961 }
7962
7963 #ifndef JIM_ANSIC
7964
7965 #ifndef WIN32
7966 # include <sys/types.h>
7967 # include <dirent.h>
7968 #else
7969 # include <io.h>
7970 /* Posix dirent.h compatiblity layer for WIN32.
7971 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
7972 * Copyright Salvatore Sanfilippo ,2005.
7973 *
7974 * Permission to use, copy, modify, and distribute this software and its
7975 * documentation for any purpose is hereby granted without fee, provided
7976 * that this copyright and permissions notice appear in all copies and
7977 * derivatives.
7978 *
7979 * This software is supplied "as is" without express or implied warranty.
7980 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
7981 */
7982
7983 struct dirent {
7984 char *d_name;
7985 };
7986
7987 typedef struct DIR {
7988 long handle; /* -1 for failed rewind */
7989 struct _finddata_t info;
7990 struct dirent result; /* d_name null iff first time */
7991 char *name; /* null-terminated char string */
7992 } DIR;
7993
7994 DIR *opendir(const char *name)
7995 {
7996 DIR *dir = 0;
7997
7998 if(name && name[0]) {
7999 size_t base_length = strlen(name);
8000 const char *all = /* search pattern must end with suitable wildcard */
8001 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8002
8003 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8004 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8005 {
8006 strcat(strcpy(dir->name, name), all);
8007
8008 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8009 dir->result.d_name = 0;
8010 else { /* rollback */
8011 Jim_Free(dir->name);
8012 Jim_Free(dir);
8013 dir = 0;
8014 }
8015 } else { /* rollback */
8016 Jim_Free(dir);
8017 dir = 0;
8018 errno = ENOMEM;
8019 }
8020 } else {
8021 errno = EINVAL;
8022 }
8023 return dir;
8024 }
8025
8026 int closedir(DIR *dir)
8027 {
8028 int result = -1;
8029
8030 if(dir) {
8031 if(dir->handle != -1)
8032 result = _findclose(dir->handle);
8033 Jim_Free(dir->name);
8034 Jim_Free(dir);
8035 }
8036 if(result == -1) /* map all errors to EBADF */
8037 errno = EBADF;
8038 return result;
8039 }
8040
8041 struct dirent *readdir(DIR *dir)
8042 {
8043 struct dirent *result = 0;
8044
8045 if(dir && dir->handle != -1) {
8046 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8047 result = &dir->result;
8048 result->d_name = dir->info.name;
8049 }
8050 } else {
8051 errno = EBADF;
8052 }
8053 return result;
8054 }
8055
8056 #endif /* WIN32 */
8057
8058 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8059 int prefixc, const char *pkgName, int pkgVer, int flags)
8060 {
8061 int bestVer = -1, i;
8062 int pkgNameLen = strlen(pkgName);
8063 char *bestPackage = NULL;
8064 struct dirent *de;
8065
8066 for (i = 0; i < prefixc; i++) {
8067 DIR *dir;
8068 char buf[JIM_PATH_LEN];
8069 int prefixLen;
8070
8071 if (prefixes[i] == NULL) continue;
8072 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8073 buf[JIM_PATH_LEN-1] = '\0';
8074 prefixLen = strlen(buf);
8075 if (prefixLen && buf[prefixLen-1] == '/')
8076 buf[prefixLen-1] = '\0';
8077
8078 if ((dir = opendir(buf)) == NULL) continue;
8079 while ((de = readdir(dir)) != NULL) {
8080 char *fileName = de->d_name;
8081 int fileNameLen = strlen(fileName);
8082
8083 if (strncmp(fileName, "jim-", 4) == 0 &&
8084 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8085 *(fileName+4+pkgNameLen) == '-' &&
8086 fileNameLen > 4 && /* note that this is not really useful */
8087 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8088 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8089 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8090 {
8091 char ver[6]; /* xx.yy<nulterm> */
8092 char *p = strrchr(fileName, '.');
8093 int verLen, fileVer;
8094
8095 verLen = p - (fileName+4+pkgNameLen+1);
8096 if (verLen < 3 || verLen > 5) continue;
8097 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8098 ver[verLen] = '\0';
8099 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8100 != JIM_OK) continue;
8101 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8102 (bestVer == -1 || bestVer < fileVer))
8103 {
8104 bestVer = fileVer;
8105 Jim_Free(bestPackage);
8106 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8107 sprintf(bestPackage, "%s/%s", buf, fileName);
8108 }
8109 }
8110 }
8111 closedir(dir);
8112 }
8113 return bestPackage;
8114 }
8115
8116 #else /* JIM_ANSIC */
8117
8118 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8119 int prefixc, const char *pkgName, int pkgVer, int flags)
8120 {
8121 JIM_NOTUSED(interp);
8122 JIM_NOTUSED(prefixes);
8123 JIM_NOTUSED(prefixc);
8124 JIM_NOTUSED(pkgName);
8125 JIM_NOTUSED(pkgVer);
8126 JIM_NOTUSED(flags);
8127 return NULL;
8128 }
8129
8130 #endif /* JIM_ANSIC */
8131
8132 /* Search for a suitable package under every dir specified by jim_libpath
8133 * and load it if possible. If a suitable package was loaded with success
8134 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8135 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8136 int flags)
8137 {
8138 Jim_Obj *libPathObjPtr;
8139 char **prefixes, *best;
8140 int prefixc, i, retCode = JIM_OK;
8141
8142 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8143 if (libPathObjPtr == NULL) {
8144 prefixc = 0;
8145 libPathObjPtr = NULL;
8146 } else {
8147 Jim_IncrRefCount(libPathObjPtr);
8148 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8149 }
8150
8151 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8152 for (i = 0; i < prefixc; i++) {
8153 Jim_Obj *prefixObjPtr;
8154 if (Jim_ListIndex(interp, libPathObjPtr, i,
8155 &prefixObjPtr, JIM_NONE) != JIM_OK)
8156 {
8157 prefixes[i] = NULL;
8158 continue;
8159 }
8160 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8161 }
8162 /* Scan every directory to find the "best" package. */
8163 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8164 if (best != NULL) {
8165 char *p = strrchr(best, '.');
8166 /* Try to load/source it */
8167 if (p && strcmp(p, ".tcl") == 0) {
8168 retCode = Jim_EvalFile(interp, best);
8169 } else {
8170 retCode = Jim_LoadLibrary(interp, best);
8171 }
8172 } else {
8173 retCode = JIM_ERR;
8174 }
8175 Jim_Free(best);
8176 for (i = 0; i < prefixc; i++)
8177 Jim_Free(prefixes[i]);
8178 Jim_Free(prefixes);
8179 if (libPathObjPtr)
8180 Jim_DecrRefCount(interp, libPathObjPtr);
8181 return retCode;
8182 }
8183
8184 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8185 const char *ver, int flags)
8186 {
8187 Jim_HashEntry *he;
8188 int requiredVer;
8189
8190 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8191 return NULL;
8192 he = Jim_FindHashEntry(&interp->packages, name);
8193 if (he == NULL) {
8194 /* Try to load the package. */
8195 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8196 he = Jim_FindHashEntry(&interp->packages, name);
8197 if (he == NULL) {
8198 return "?";
8199 }
8200 return he->val;
8201 }
8202 /* No way... return an error. */
8203 if (flags & JIM_ERRMSG) {
8204 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8205 Jim_AppendStrings(interp, Jim_GetResult(interp),
8206 "Can't find package '", name, "'", NULL);
8207 }
8208 return NULL;
8209 } else {
8210 int actualVer;
8211 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8212 != JIM_OK)
8213 {
8214 return NULL;
8215 }
8216 /* Check if version matches. */
8217 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8218 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8219 Jim_AppendStrings(interp, Jim_GetResult(interp),
8220 "Package '", name, "' already loaded, but with version ",
8221 he->val, NULL);
8222 return NULL;
8223 }
8224 return he->val;
8225 }
8226 }
8227
8228 /* -----------------------------------------------------------------------------
8229 * Eval
8230 * ---------------------------------------------------------------------------*/
8231 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8232 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8233
8234 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8235 Jim_Obj *const *argv);
8236
8237 /* Handle calls to the [unknown] command */
8238 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8239 {
8240 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8241 int retCode;
8242
8243 /* If the [unknown] command does not exists returns
8244 * just now */
8245 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8246 return JIM_ERR;
8247
8248 /* The object interp->unknown just contains
8249 * the "unknown" string, it is used in order to
8250 * avoid to lookup the unknown command every time
8251 * but instread to cache the result. */
8252 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8253 v = sv;
8254 else
8255 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8256 /* Make a copy of the arguments vector, but shifted on
8257 * the right of one position. The command name of the
8258 * command will be instead the first argument of the
8259 * [unknonw] call. */
8260 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8261 v[0] = interp->unknown;
8262 /* Call it */
8263 retCode = Jim_EvalObjVector(interp, argc+1, v);
8264 /* Clean up */
8265 if (v != sv)
8266 Jim_Free(v);
8267 return retCode;
8268 }
8269
8270 /* Eval the object vector 'objv' composed of 'objc' elements.
8271 * Every element is used as single argument.
8272 * Jim_EvalObj() will call this function every time its object
8273 * argument is of "list" type, with no string representation.
8274 *
8275 * This is possible because the string representation of a
8276 * list object generated by the UpdateStringOfList is made
8277 * in a way that ensures that every list element is a different
8278 * command argument. */
8279 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8280 {
8281 int i, retcode;
8282 Jim_Cmd *cmdPtr;
8283
8284 /* Incr refcount of arguments. */
8285 for (i = 0; i < objc; i++)
8286 Jim_IncrRefCount(objv[i]);
8287 /* Command lookup */
8288 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8289 if (cmdPtr == NULL) {
8290 retcode = JimUnknown(interp, objc, objv);
8291 } else {
8292 /* Call it -- Make sure result is an empty object. */
8293 Jim_SetEmptyResult(interp);
8294 if (cmdPtr->cmdProc) {
8295 interp->cmdPrivData = cmdPtr->privData;
8296 retcode = cmdPtr->cmdProc(interp, objc, objv);
8297 } else {
8298 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8299 if (retcode == JIM_ERR) {
8300 JimAppendStackTrace(interp,
8301 Jim_GetString(objv[0], NULL), "?", 1);
8302 }
8303 }
8304 }
8305 /* Decr refcount of arguments and return the retcode */
8306 for (i = 0; i < objc; i++)
8307 Jim_DecrRefCount(interp, objv[i]);
8308 return retcode;
8309 }
8310
8311 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8312 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8313 * The returned object has refcount = 0. */
8314 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8315 int tokens, Jim_Obj **objPtrPtr)
8316 {
8317 int totlen = 0, i, retcode;
8318 Jim_Obj **intv;
8319 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8320 Jim_Obj *objPtr;
8321 char *s;
8322
8323 if (tokens <= JIM_EVAL_SINTV_LEN)
8324 intv = sintv;
8325 else
8326 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8327 tokens);
8328 /* Compute every token forming the argument
8329 * in the intv objects vector. */
8330 for (i = 0; i < tokens; i++) {
8331 switch(token[i].type) {
8332 case JIM_TT_ESC:
8333 case JIM_TT_STR:
8334 intv[i] = token[i].objPtr;
8335 break;
8336 case JIM_TT_VAR:
8337 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8338 if (!intv[i]) {
8339 retcode = JIM_ERR;
8340 goto err;
8341 }
8342 break;
8343 case JIM_TT_DICTSUGAR:
8344 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8345 if (!intv[i]) {
8346 retcode = JIM_ERR;
8347 goto err;
8348 }
8349 break;
8350 case JIM_TT_CMD:
8351 retcode = Jim_EvalObj(interp, token[i].objPtr);
8352 if (retcode != JIM_OK)
8353 goto err;
8354 intv[i] = Jim_GetResult(interp);
8355 break;
8356 default:
8357 Jim_Panic(interp,
8358 "default token type reached "
8359 "in Jim_InterpolateTokens().");
8360 break;
8361 }
8362 Jim_IncrRefCount(intv[i]);
8363 /* Make sure there is a valid
8364 * string rep, and add the string
8365 * length to the total legnth. */
8366 Jim_GetString(intv[i], NULL);
8367 totlen += intv[i]->length;
8368 }
8369 /* Concatenate every token in an unique
8370 * object. */
8371 objPtr = Jim_NewStringObjNoAlloc(interp,
8372 NULL, 0);
8373 s = objPtr->bytes = Jim_Alloc(totlen+1);
8374 objPtr->length = totlen;
8375 for (i = 0; i < tokens; i++) {
8376 memcpy(s, intv[i]->bytes, intv[i]->length);
8377 s += intv[i]->length;
8378 Jim_DecrRefCount(interp, intv[i]);
8379 }
8380 objPtr->bytes[totlen] = '\0';
8381 /* Free the intv vector if not static. */
8382 if (tokens > JIM_EVAL_SINTV_LEN)
8383 Jim_Free(intv);
8384 *objPtrPtr = objPtr;
8385 return JIM_OK;
8386 err:
8387 i--;
8388 for (; i >= 0; i--)
8389 Jim_DecrRefCount(interp, intv[i]);
8390 if (tokens > JIM_EVAL_SINTV_LEN)
8391 Jim_Free(intv);
8392 return retcode;
8393 }
8394
8395 /* Helper of Jim_EvalObj() to perform argument expansion.
8396 * Basically this function append an argument to 'argv'
8397 * (and increments argc by reference accordingly), performing
8398 * expansion of the list object if 'expand' is non-zero, or
8399 * just adding objPtr to argv if 'expand' is zero. */
8400 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8401 int *argcPtr, int expand, Jim_Obj *objPtr)
8402 {
8403 if (!expand) {
8404 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8405 /* refcount of objPtr not incremented because
8406 * we are actually transfering a reference from
8407 * the old 'argv' to the expanded one. */
8408 (*argv)[*argcPtr] = objPtr;
8409 (*argcPtr)++;
8410 } else {
8411 int len, i;
8412
8413 Jim_ListLength(interp, objPtr, &len);
8414 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8415 for (i = 0; i < len; i++) {
8416 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8417 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8418 (*argcPtr)++;
8419 }
8420 /* The original object reference is no longer needed,
8421 * after the expansion it is no longer present on
8422 * the argument vector, but the single elements are
8423 * in its place. */
8424 Jim_DecrRefCount(interp, objPtr);
8425 }
8426 }
8427
8428 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8429 {
8430 int i, j = 0, len;
8431 ScriptObj *script;
8432 ScriptToken *token;
8433 int *cs; /* command structure array */
8434 int retcode = JIM_OK;
8435 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8436
8437 interp->errorFlag = 0;
8438
8439 /* If the object is of type "list" and there is no
8440 * string representation for this object, we can call
8441 * a specialized version of Jim_EvalObj() */
8442 if (scriptObjPtr->typePtr == &listObjType &&
8443 scriptObjPtr->internalRep.listValue.len &&
8444 scriptObjPtr->bytes == NULL) {
8445 Jim_IncrRefCount(scriptObjPtr);
8446 retcode = Jim_EvalObjVector(interp,
8447 scriptObjPtr->internalRep.listValue.len,
8448 scriptObjPtr->internalRep.listValue.ele);
8449 Jim_DecrRefCount(interp, scriptObjPtr);
8450 return retcode;
8451 }
8452
8453 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8454 script = Jim_GetScript(interp, scriptObjPtr);
8455 /* Now we have to make sure the internal repr will not be
8456 * freed on shimmering.
8457 *
8458 * Think for example to this:
8459 *
8460 * set x {llength $x; ... some more code ...}; eval $x
8461 *
8462 * In order to preserve the internal rep, we increment the
8463 * inUse field of the script internal rep structure. */
8464 script->inUse++;
8465
8466 token = script->token;
8467 len = script->len;
8468 cs = script->cmdStruct;
8469 i = 0; /* 'i' is the current token index. */
8470
8471 /* Reset the interpreter result. This is useful to
8472 * return the emtpy result in the case of empty program. */
8473 Jim_SetEmptyResult(interp);
8474
8475 /* Execute every command sequentially, returns on
8476 * error (i.e. if a command does not return JIM_OK) */
8477 while (i < len) {
8478 int expand = 0;
8479 int argc = *cs++; /* Get the number of arguments */
8480 Jim_Cmd *cmd;
8481
8482 /* Set the expand flag if needed. */
8483 if (argc == -1) {
8484 expand++;
8485 argc = *cs++;
8486 }
8487 /* Allocate the arguments vector */
8488 if (argc <= JIM_EVAL_SARGV_LEN)
8489 argv = sargv;
8490 else
8491 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8492 /* Populate the arguments objects. */
8493 for (j = 0; j < argc; j++) {
8494 int tokens = *cs++;
8495
8496 /* tokens is negative if expansion is needed.
8497 * for this argument. */
8498 if (tokens < 0) {
8499 tokens = (-tokens)-1;
8500 i++;
8501 }
8502 if (tokens == 1) {
8503 /* Fast path if the token does not
8504 * need interpolation */
8505 switch(token[i].type) {
8506 case JIM_TT_ESC:
8507 case JIM_TT_STR:
8508 argv[j] = token[i].objPtr;
8509 break;
8510 case JIM_TT_VAR:
8511 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8512 JIM_ERRMSG);
8513 if (!tmpObjPtr) {
8514 retcode = JIM_ERR;
8515 goto err;
8516 }
8517 argv[j] = tmpObjPtr;
8518 break;
8519 case JIM_TT_DICTSUGAR:
8520 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8521 if (!tmpObjPtr) {
8522 retcode = JIM_ERR;
8523 goto err;
8524 }
8525 argv[j] = tmpObjPtr;
8526 break;
8527 case JIM_TT_CMD:
8528 retcode = Jim_EvalObj(interp, token[i].objPtr);
8529 if (retcode != JIM_OK)
8530 goto err;
8531 argv[j] = Jim_GetResult(interp);
8532 break;
8533 default:
8534 Jim_Panic(interp,
8535 "default token type reached "
8536 "in Jim_EvalObj().");
8537 break;
8538 }
8539 Jim_IncrRefCount(argv[j]);
8540 i += 2;
8541 } else {
8542 /* For interpolation we call an helper
8543 * function doing the work for us. */
8544 if ((retcode = Jim_InterpolateTokens(interp,
8545 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8546 {
8547 goto err;
8548 }
8549 argv[j] = tmpObjPtr;
8550 Jim_IncrRefCount(argv[j]);
8551 i += tokens+1;
8552 }
8553 }
8554 /* Handle {expand} expansion */
8555 if (expand) {
8556 int *ecs = cs - argc;
8557 int eargc = 0;
8558 Jim_Obj **eargv = NULL;
8559
8560 for (j = 0; j < argc; j++) {
8561 Jim_ExpandArgument( interp, &eargv, &eargc,
8562 ecs[j] < 0, argv[j]);
8563 }
8564 if (argv != sargv)
8565 Jim_Free(argv);
8566 argc = eargc;
8567 argv = eargv;
8568 j = argc;
8569 if (argc == 0) {
8570 /* Nothing to do with zero args. */
8571 Jim_Free(eargv);
8572 continue;
8573 }
8574 }
8575 /* Lookup the command to call */
8576 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8577 if (cmd != NULL) {
8578 /* Call it -- Make sure result is an empty object. */
8579 Jim_SetEmptyResult(interp);
8580 if (cmd->cmdProc) {
8581 interp->cmdPrivData = cmd->privData;
8582 retcode = cmd->cmdProc(interp, argc, argv);
8583 } else {
8584 retcode = JimCallProcedure(interp, cmd, argc, argv);
8585 if (retcode == JIM_ERR) {
8586 JimAppendStackTrace(interp,
8587 Jim_GetString(argv[0], NULL), script->fileName,
8588 token[i-argc*2].linenr);
8589 }
8590 }
8591 } else {
8592 /* Call [unknown] */
8593 retcode = JimUnknown(interp, argc, argv);
8594 if (retcode == JIM_ERR) {
8595 JimAppendStackTrace(interp,
8596 Jim_GetString(argv[0], NULL), script->fileName,
8597 token[i-argc*2].linenr);
8598 }
8599 }
8600 if (retcode != JIM_OK) {
8601 i -= argc*2; /* point to the command name. */
8602 goto err;
8603 }
8604 /* Decrement the arguments count */
8605 for (j = 0; j < argc; j++) {
8606 Jim_DecrRefCount(interp, argv[j]);
8607 }
8608
8609 if (argv != sargv) {
8610 Jim_Free(argv);
8611 argv = NULL;
8612 }
8613 }
8614 /* Note that we don't have to decrement inUse, because the
8615 * following code transfers our use of the reference again to
8616 * the script object. */
8617 j = 0; /* on normal termination, the argv array is already
8618 Jim_DecrRefCount-ed. */
8619 err:
8620 /* Handle errors. */
8621 if (retcode == JIM_ERR && !interp->errorFlag) {
8622 interp->errorFlag = 1;
8623 JimSetErrorFileName(interp, script->fileName);
8624 JimSetErrorLineNumber(interp, token[i].linenr);
8625 JimResetStackTrace(interp);
8626 }
8627 Jim_FreeIntRep(interp, scriptObjPtr);
8628 scriptObjPtr->typePtr = &scriptObjType;
8629 Jim_SetIntRepPtr(scriptObjPtr, script);
8630 Jim_DecrRefCount(interp, scriptObjPtr);
8631 for (i = 0; i < j; i++) {
8632 Jim_DecrRefCount(interp, argv[i]);
8633 }
8634 if (argv != sargv)
8635 Jim_Free(argv);
8636 return retcode;
8637 }
8638
8639 /* Call a procedure implemented in Tcl.
8640 * It's possible to speed-up a lot this function, currently
8641 * the callframes are not cached, but allocated and
8642 * destroied every time. What is expecially costly is
8643 * to create/destroy the local vars hash table every time.
8644 *
8645 * This can be fixed just implementing callframes caching
8646 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8647 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8648 Jim_Obj *const *argv)
8649 {
8650 int i, retcode;
8651 Jim_CallFrame *callFramePtr;
8652
8653 /* Check arity */
8654 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8655 argc > cmd->arityMax)) {
8656 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8657 Jim_AppendStrings(interp, objPtr,
8658 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8659 (cmd->arityMin > 1) ? " " : "",
8660 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8661 Jim_SetResult(interp, objPtr);
8662 return JIM_ERR;
8663 }
8664 /* Check if there are too nested calls */
8665 if (interp->numLevels == interp->maxNestingDepth) {
8666 Jim_SetResultString(interp,
8667 "Too many nested calls. Infinite recursion?", -1);
8668 return JIM_ERR;
8669 }
8670 /* Create a new callframe */
8671 callFramePtr = JimCreateCallFrame(interp);
8672 callFramePtr->parentCallFrame = interp->framePtr;
8673 callFramePtr->argv = argv;
8674 callFramePtr->argc = argc;
8675 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8676 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8677 callFramePtr->staticVars = cmd->staticVars;
8678 Jim_IncrRefCount(cmd->argListObjPtr);
8679 Jim_IncrRefCount(cmd->bodyObjPtr);
8680 interp->framePtr = callFramePtr;
8681 interp->numLevels ++;
8682 /* Set arguments */
8683 for (i = 0; i < cmd->arityMin-1; i++) {
8684 Jim_Obj *objPtr;
8685
8686 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8687 Jim_SetVariable(interp, objPtr, argv[i+1]);
8688 }
8689 if (cmd->arityMax == -1) {
8690 Jim_Obj *listObjPtr, *objPtr;
8691
8692 listObjPtr = Jim_NewListObj(interp, argv+cmd->arityMin,
8693 argc-cmd->arityMin);
8694 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8695 Jim_SetVariable(interp, objPtr, listObjPtr);
8696 }
8697 /* Eval the body */
8698 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8699
8700 /* Destroy the callframe */
8701 interp->numLevels --;
8702 interp->framePtr = interp->framePtr->parentCallFrame;
8703 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8704 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8705 } else {
8706 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8707 }
8708 /* Handle the JIM_EVAL return code */
8709 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8710 int savedLevel = interp->evalRetcodeLevel;
8711
8712 interp->evalRetcodeLevel = interp->numLevels;
8713 while (retcode == JIM_EVAL) {
8714 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8715 Jim_IncrRefCount(resultScriptObjPtr);
8716 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8717 Jim_DecrRefCount(interp, resultScriptObjPtr);
8718 }
8719 interp->evalRetcodeLevel = savedLevel;
8720 }
8721 /* Handle the JIM_RETURN return code */
8722 if (retcode == JIM_RETURN) {
8723 retcode = interp->returnCode;
8724 interp->returnCode = JIM_OK;
8725 }
8726 return retcode;
8727 }
8728
8729 int Jim_Eval(Jim_Interp *interp, const char *script)
8730 {
8731 Jim_Obj *scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8732 int retval;
8733
8734 Jim_IncrRefCount(scriptObjPtr);
8735 retval = Jim_EvalObj(interp, scriptObjPtr);
8736 Jim_DecrRefCount(interp, scriptObjPtr);
8737 return retval;
8738 }
8739
8740 /* Execute script in the scope of the global level */
8741 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8742 {
8743 Jim_CallFrame *savedFramePtr;
8744 int retval;
8745
8746 savedFramePtr = interp->framePtr;
8747 interp->framePtr = interp->topFramePtr;
8748 retval = Jim_Eval(interp, script);
8749 interp->framePtr = savedFramePtr;
8750 return retval;
8751 }
8752
8753 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8754 {
8755 Jim_CallFrame *savedFramePtr;
8756 int retval;
8757
8758 savedFramePtr = interp->framePtr;
8759 interp->framePtr = interp->topFramePtr;
8760 retval = Jim_EvalObj(interp, scriptObjPtr);
8761 interp->framePtr = savedFramePtr;
8762 /* Try to report the error (if any) via the bgerror proc */
8763 if (retval != JIM_OK) {
8764 Jim_Obj *objv[2];
8765
8766 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8767 objv[1] = Jim_GetResult(interp);
8768 Jim_IncrRefCount(objv[0]);
8769 Jim_IncrRefCount(objv[1]);
8770 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8771 /* Report the error to stderr. */
8772 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8773 Jim_PrintErrorMessage(interp);
8774 }
8775 Jim_DecrRefCount(interp, objv[0]);
8776 Jim_DecrRefCount(interp, objv[1]);
8777 }
8778 return retval;
8779 }
8780
8781 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8782 {
8783 char *prg = NULL;
8784 FILE *fp;
8785 int nread, totread, maxlen, buflen;
8786 int retval;
8787 Jim_Obj *scriptObjPtr;
8788
8789 if ((fp = fopen(filename, "r")) == NULL) {
8790 const int cwd_len=2048;
8791 char *cwd=malloc(cwd_len);
8792 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8793 getcwd( cwd, cwd_len );
8794 Jim_AppendStrings(interp, Jim_GetResult(interp),
8795 "Error loading script \"", filename, "\"",
8796 " cwd: ", cwd,
8797 " err: ", strerror(errno), NULL);
8798 free(cwd);
8799 return JIM_ERR;
8800 }
8801 buflen = 1024;
8802 maxlen = totread = 0;
8803 while (1) {
8804 if (maxlen < totread+buflen+1) {
8805 maxlen = totread+buflen+1;
8806 prg = Jim_Realloc(prg, maxlen);
8807 }
8808 /* do not use Jim_fread() - this is really a file */
8809 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8810 totread += nread;
8811 }
8812 prg[totread] = '\0';
8813 /* do not use Jim_fclose() - this is really a file */
8814 fclose(fp);
8815
8816 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8817 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8818 Jim_IncrRefCount(scriptObjPtr);
8819 retval = Jim_EvalObj(interp, scriptObjPtr);
8820 Jim_DecrRefCount(interp, scriptObjPtr);
8821 return retval;
8822 }
8823
8824 /* -----------------------------------------------------------------------------
8825 * Subst
8826 * ---------------------------------------------------------------------------*/
8827 static int JimParseSubstStr(struct JimParserCtx *pc)
8828 {
8829 pc->tstart = pc->p;
8830 pc->tline = pc->linenr;
8831 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8832 pc->p++; pc->len--;
8833 }
8834 pc->tend = pc->p-1;
8835 pc->tt = JIM_TT_ESC;
8836 return JIM_OK;
8837 }
8838
8839 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8840 {
8841 int retval;
8842
8843 if (pc->len == 0) {
8844 pc->tstart = pc->tend = pc->p;
8845 pc->tline = pc->linenr;
8846 pc->tt = JIM_TT_EOL;
8847 pc->eof = 1;
8848 return JIM_OK;
8849 }
8850 switch(*pc->p) {
8851 case '[':
8852 retval = JimParseCmd(pc);
8853 if (flags & JIM_SUBST_NOCMD) {
8854 pc->tstart--;
8855 pc->tend++;
8856 pc->tt = (flags & JIM_SUBST_NOESC) ?
8857 JIM_TT_STR : JIM_TT_ESC;
8858 }
8859 return retval;
8860 break;
8861 case '$':
8862 if (JimParseVar(pc) == JIM_ERR) {
8863 pc->tstart = pc->tend = pc->p++; pc->len--;
8864 pc->tline = pc->linenr;
8865 pc->tt = JIM_TT_STR;
8866 } else {
8867 if (flags & JIM_SUBST_NOVAR) {
8868 pc->tstart--;
8869 if (flags & JIM_SUBST_NOESC)
8870 pc->tt = JIM_TT_STR;
8871 else
8872 pc->tt = JIM_TT_ESC;
8873 if (*pc->tstart == '{') {
8874 pc->tstart--;
8875 if (*(pc->tend+1))
8876 pc->tend++;
8877 }
8878 }
8879 }
8880 break;
8881 default:
8882 retval = JimParseSubstStr(pc);
8883 if (flags & JIM_SUBST_NOESC)
8884 pc->tt = JIM_TT_STR;
8885 return retval;
8886 break;
8887 }
8888 return JIM_OK;
8889 }
8890
8891 /* The subst object type reuses most of the data structures and functions
8892 * of the script object. Script's data structures are a bit more complex
8893 * for what is needed for [subst]itution tasks, but the reuse helps to
8894 * deal with a single data structure at the cost of some more memory
8895 * usage for substitutions. */
8896 static Jim_ObjType substObjType = {
8897 "subst",
8898 FreeScriptInternalRep,
8899 DupScriptInternalRep,
8900 NULL,
8901 JIM_TYPE_REFERENCES,
8902 };
8903
8904 /* This method takes the string representation of an object
8905 * as a Tcl string where to perform [subst]itution, and generates
8906 * the pre-parsed internal representation. */
8907 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
8908 {
8909 int scriptTextLen;
8910 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
8911 struct JimParserCtx parser;
8912 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
8913
8914 script->len = 0;
8915 script->csLen = 0;
8916 script->commands = 0;
8917 script->token = NULL;
8918 script->cmdStruct = NULL;
8919 script->inUse = 1;
8920 script->substFlags = flags;
8921 script->fileName = NULL;
8922
8923 JimParserInit(&parser, scriptText, scriptTextLen, 1);
8924 while(1) {
8925 char *token;
8926 int len, type, linenr;
8927
8928 JimParseSubst(&parser, flags);
8929 if (JimParserEof(&parser)) break;
8930 token = JimParserGetToken(&parser, &len, &type, &linenr);
8931 ScriptObjAddToken(interp, script, token, len, type,
8932 NULL, linenr);
8933 }
8934 /* Free the old internal rep and set the new one. */
8935 Jim_FreeIntRep(interp, objPtr);
8936 Jim_SetIntRepPtr(objPtr, script);
8937 objPtr->typePtr = &scriptObjType;
8938 return JIM_OK;
8939 }
8940
8941 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
8942 {
8943 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
8944
8945 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
8946 SetSubstFromAny(interp, objPtr, flags);
8947 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
8948 }
8949
8950 /* Performs commands,variables,blackslashes substitution,
8951 * storing the result object (with refcount 0) into
8952 * resObjPtrPtr. */
8953 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
8954 Jim_Obj **resObjPtrPtr, int flags)
8955 {
8956 ScriptObj *script;
8957 ScriptToken *token;
8958 int i, len, retcode = JIM_OK;
8959 Jim_Obj *resObjPtr, *savedResultObjPtr;
8960
8961 script = Jim_GetSubst(interp, substObjPtr, flags);
8962 #ifdef JIM_OPTIMIZATION
8963 /* Fast path for a very common case with array-alike syntax,
8964 * that's: $foo($bar) */
8965 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
8966 Jim_Obj *varObjPtr = script->token[0].objPtr;
8967
8968 Jim_IncrRefCount(varObjPtr);
8969 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
8970 if (resObjPtr == NULL) {
8971 Jim_DecrRefCount(interp, varObjPtr);
8972 return JIM_ERR;
8973 }
8974 Jim_DecrRefCount(interp, varObjPtr);
8975 *resObjPtrPtr = resObjPtr;
8976 return JIM_OK;
8977 }
8978 #endif
8979
8980 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
8981 /* In order to preserve the internal rep, we increment the
8982 * inUse field of the script internal rep structure. */
8983 script->inUse++;
8984
8985 token = script->token;
8986 len = script->len;
8987
8988 /* Save the interp old result, to set it again before
8989 * to return. */
8990 savedResultObjPtr = interp->result;
8991 Jim_IncrRefCount(savedResultObjPtr);
8992
8993 /* Perform the substitution. Starts with an empty object
8994 * and adds every token (performing the appropriate
8995 * var/command/escape substitution). */
8996 resObjPtr = Jim_NewStringObj(interp, "", 0);
8997 for (i = 0; i < len; i++) {
8998 Jim_Obj *objPtr;
8999
9000 switch(token[i].type) {
9001 case JIM_TT_STR:
9002 case JIM_TT_ESC:
9003 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9004 break;
9005 case JIM_TT_VAR:
9006 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9007 if (objPtr == NULL) goto err;
9008 Jim_IncrRefCount(objPtr);
9009 Jim_AppendObj(interp, resObjPtr, objPtr);
9010 Jim_DecrRefCount(interp, objPtr);
9011 break;
9012 case JIM_TT_DICTSUGAR:
9013 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9014 if (!objPtr) {
9015 retcode = JIM_ERR;
9016 goto err;
9017 }
9018 break;
9019 case JIM_TT_CMD:
9020 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9021 goto err;
9022 Jim_AppendObj(interp, resObjPtr, interp->result);
9023 break;
9024 default:
9025 Jim_Panic(interp,
9026 "default token type (%d) reached "
9027 "in Jim_SubstObj().", token[i].type);
9028 break;
9029 }
9030 }
9031 ok:
9032 if (retcode == JIM_OK)
9033 Jim_SetResult(interp, savedResultObjPtr);
9034 Jim_DecrRefCount(interp, savedResultObjPtr);
9035 /* Note that we don't have to decrement inUse, because the
9036 * following code transfers our use of the reference again to
9037 * the script object. */
9038 Jim_FreeIntRep(interp, substObjPtr);
9039 substObjPtr->typePtr = &scriptObjType;
9040 Jim_SetIntRepPtr(substObjPtr, script);
9041 Jim_DecrRefCount(interp, substObjPtr);
9042 *resObjPtrPtr = resObjPtr;
9043 return retcode;
9044 err:
9045 Jim_FreeNewObj(interp, resObjPtr);
9046 retcode = JIM_ERR;
9047 goto ok;
9048 }
9049
9050 /* -----------------------------------------------------------------------------
9051 * API Input/Export functions
9052 * ---------------------------------------------------------------------------*/
9053
9054 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9055 {
9056 Jim_HashEntry *he;
9057
9058 he = Jim_FindHashEntry(&interp->stub, funcname);
9059 if (!he)
9060 return JIM_ERR;
9061 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9062 return JIM_OK;
9063 }
9064
9065 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9066 {
9067 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9068 }
9069
9070 #define JIM_REGISTER_API(name) \
9071 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9072
9073 void JimRegisterCoreApi(Jim_Interp *interp)
9074 {
9075 interp->getApiFuncPtr = Jim_GetApi;
9076 JIM_REGISTER_API(Alloc);
9077 JIM_REGISTER_API(Free);
9078 JIM_REGISTER_API(Eval);
9079 JIM_REGISTER_API(EvalGlobal);
9080 JIM_REGISTER_API(EvalFile);
9081 JIM_REGISTER_API(EvalObj);
9082 JIM_REGISTER_API(EvalObjBackground);
9083 JIM_REGISTER_API(EvalObjVector);
9084 JIM_REGISTER_API(InitHashTable);
9085 JIM_REGISTER_API(ExpandHashTable);
9086 JIM_REGISTER_API(AddHashEntry);
9087 JIM_REGISTER_API(ReplaceHashEntry);
9088 JIM_REGISTER_API(DeleteHashEntry);
9089 JIM_REGISTER_API(FreeHashTable);
9090 JIM_REGISTER_API(FindHashEntry);
9091 JIM_REGISTER_API(ResizeHashTable);
9092 JIM_REGISTER_API(GetHashTableIterator);
9093 JIM_REGISTER_API(NextHashEntry);
9094 JIM_REGISTER_API(NewObj);
9095 JIM_REGISTER_API(FreeObj);
9096 JIM_REGISTER_API(InvalidateStringRep);
9097 JIM_REGISTER_API(InitStringRep);
9098 JIM_REGISTER_API(DuplicateObj);
9099 JIM_REGISTER_API(GetString);
9100 JIM_REGISTER_API(Length);
9101 JIM_REGISTER_API(InvalidateStringRep);
9102 JIM_REGISTER_API(NewStringObj);
9103 JIM_REGISTER_API(NewStringObjNoAlloc);
9104 JIM_REGISTER_API(AppendString);
9105 JIM_REGISTER_API(AppendObj);
9106 JIM_REGISTER_API(AppendStrings);
9107 JIM_REGISTER_API(StringEqObj);
9108 JIM_REGISTER_API(StringMatchObj);
9109 JIM_REGISTER_API(StringRangeObj);
9110 JIM_REGISTER_API(FormatString);
9111 JIM_REGISTER_API(CompareStringImmediate);
9112 JIM_REGISTER_API(NewReference);
9113 JIM_REGISTER_API(GetReference);
9114 JIM_REGISTER_API(SetFinalizer);
9115 JIM_REGISTER_API(GetFinalizer);
9116 JIM_REGISTER_API(CreateInterp);
9117 JIM_REGISTER_API(FreeInterp);
9118 JIM_REGISTER_API(GetExitCode);
9119 JIM_REGISTER_API(SetStdin);
9120 JIM_REGISTER_API(SetStdout);
9121 JIM_REGISTER_API(SetStderr);
9122 JIM_REGISTER_API(CreateCommand);
9123 JIM_REGISTER_API(CreateProcedure);
9124 JIM_REGISTER_API(DeleteCommand);
9125 JIM_REGISTER_API(RenameCommand);
9126 JIM_REGISTER_API(GetCommand);
9127 JIM_REGISTER_API(SetVariable);
9128 JIM_REGISTER_API(SetVariableStr);
9129 JIM_REGISTER_API(SetGlobalVariableStr);
9130 JIM_REGISTER_API(SetVariableStrWithStr);
9131 JIM_REGISTER_API(SetVariableLink);
9132 JIM_REGISTER_API(GetVariable);
9133 JIM_REGISTER_API(GetCallFrameByLevel);
9134 JIM_REGISTER_API(Collect);
9135 JIM_REGISTER_API(CollectIfNeeded);
9136 JIM_REGISTER_API(GetIndex);
9137 JIM_REGISTER_API(NewListObj);
9138 JIM_REGISTER_API(ListAppendElement);
9139 JIM_REGISTER_API(ListAppendList);
9140 JIM_REGISTER_API(ListLength);
9141 JIM_REGISTER_API(ListIndex);
9142 JIM_REGISTER_API(SetListIndex);
9143 JIM_REGISTER_API(ConcatObj);
9144 JIM_REGISTER_API(NewDictObj);
9145 JIM_REGISTER_API(DictKey);
9146 JIM_REGISTER_API(DictKeysVector);
9147 JIM_REGISTER_API(GetIndex);
9148 JIM_REGISTER_API(GetReturnCode);
9149 JIM_REGISTER_API(EvalExpression);
9150 JIM_REGISTER_API(GetBoolFromExpr);
9151 JIM_REGISTER_API(GetWide);
9152 JIM_REGISTER_API(GetLong);
9153 JIM_REGISTER_API(SetWide);
9154 JIM_REGISTER_API(NewIntObj);
9155 JIM_REGISTER_API(GetDouble);
9156 JIM_REGISTER_API(SetDouble);
9157 JIM_REGISTER_API(NewDoubleObj);
9158 JIM_REGISTER_API(WrongNumArgs);
9159 JIM_REGISTER_API(SetDictKeysVector);
9160 JIM_REGISTER_API(SubstObj);
9161 JIM_REGISTER_API(RegisterApi);
9162 JIM_REGISTER_API(PrintErrorMessage);
9163 JIM_REGISTER_API(InteractivePrompt);
9164 JIM_REGISTER_API(RegisterCoreCommands);
9165 JIM_REGISTER_API(GetSharedString);
9166 JIM_REGISTER_API(ReleaseSharedString);
9167 JIM_REGISTER_API(Panic);
9168 JIM_REGISTER_API(StrDup);
9169 JIM_REGISTER_API(UnsetVariable);
9170 JIM_REGISTER_API(GetVariableStr);
9171 JIM_REGISTER_API(GetGlobalVariable);
9172 JIM_REGISTER_API(GetGlobalVariableStr);
9173 JIM_REGISTER_API(GetAssocData);
9174 JIM_REGISTER_API(SetAssocData);
9175 JIM_REGISTER_API(DeleteAssocData);
9176 JIM_REGISTER_API(GetEnum);
9177 JIM_REGISTER_API(ScriptIsComplete);
9178 JIM_REGISTER_API(PackageRequire);
9179 JIM_REGISTER_API(PackageProvide);
9180 JIM_REGISTER_API(InitStack);
9181 JIM_REGISTER_API(FreeStack);
9182 JIM_REGISTER_API(StackLen);
9183 JIM_REGISTER_API(StackPush);
9184 JIM_REGISTER_API(StackPop);
9185 JIM_REGISTER_API(StackPeek);
9186 JIM_REGISTER_API(FreeStackElements);
9187 JIM_REGISTER_API(fprintf );
9188 JIM_REGISTER_API(vfprintf );
9189 JIM_REGISTER_API(fwrite );
9190 JIM_REGISTER_API(fread );
9191 JIM_REGISTER_API(fflush );
9192 JIM_REGISTER_API(fgets );
9193 JIM_REGISTER_API(GetNvp);
9194 JIM_REGISTER_API(Nvp_name2value);
9195 JIM_REGISTER_API(Nvp_name2value_simple);
9196 JIM_REGISTER_API(Nvp_name2value_obj);
9197 JIM_REGISTER_API(Nvp_name2value_nocase);
9198 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9199
9200 JIM_REGISTER_API(Nvp_value2name);
9201 JIM_REGISTER_API(Nvp_value2name_simple);
9202 JIM_REGISTER_API(Nvp_value2name_obj);
9203
9204 JIM_REGISTER_API(GetOpt_Setup);
9205 JIM_REGISTER_API(GetOpt_Debug);
9206 JIM_REGISTER_API(GetOpt_Obj);
9207 JIM_REGISTER_API(GetOpt_String);
9208 JIM_REGISTER_API(GetOpt_Double);
9209 JIM_REGISTER_API(GetOpt_Wide);
9210 JIM_REGISTER_API(GetOpt_Nvp);
9211 JIM_REGISTER_API(GetOpt_NvpUnknown);
9212 JIM_REGISTER_API(GetOpt_Enum);
9213
9214 JIM_REGISTER_API(Debug_ArgvString);
9215 JIM_REGISTER_API(SetResult_sprintf);
9216 JIM_REGISTER_API(SetResult_NvpUnknown);
9217
9218 }
9219
9220 /* -----------------------------------------------------------------------------
9221 * Core commands utility functions
9222 * ---------------------------------------------------------------------------*/
9223 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9224 const char *msg)
9225 {
9226 int i;
9227 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9228
9229 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9230 for (i = 0; i < argc; i++) {
9231 Jim_AppendObj(interp, objPtr, argv[i]);
9232 if (!(i+1 == argc && msg[0] == '\0'))
9233 Jim_AppendString(interp, objPtr, " ", 1);
9234 }
9235 Jim_AppendString(interp, objPtr, msg, -1);
9236 Jim_AppendString(interp, objPtr, "\"", 1);
9237 Jim_SetResult(interp, objPtr);
9238 }
9239
9240 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9241 {
9242 Jim_HashTableIterator *htiter;
9243 Jim_HashEntry *he;
9244 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9245 const char *pattern;
9246 int patternLen;
9247
9248 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9249 htiter = Jim_GetHashTableIterator(&interp->commands);
9250 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9251 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9252 strlen((const char*)he->key), 0))
9253 continue;
9254 Jim_ListAppendElement(interp, listObjPtr,
9255 Jim_NewStringObj(interp, he->key, -1));
9256 }
9257 Jim_FreeHashTableIterator(htiter);
9258 return listObjPtr;
9259 }
9260
9261 #define JIM_VARLIST_GLOBALS 0
9262 #define JIM_VARLIST_LOCALS 1
9263 #define JIM_VARLIST_VARS 2
9264
9265 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9266 int mode)
9267 {
9268 Jim_HashTableIterator *htiter;
9269 Jim_HashEntry *he;
9270 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9271 const char *pattern;
9272 int patternLen;
9273
9274 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9275 if (mode == JIM_VARLIST_GLOBALS) {
9276 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9277 } else {
9278 /* For [info locals], if we are at top level an emtpy list
9279 * is returned. I don't agree, but we aim at compatibility (SS) */
9280 if (mode == JIM_VARLIST_LOCALS &&
9281 interp->framePtr == interp->topFramePtr)
9282 return listObjPtr;
9283 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9284 }
9285 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9286 Jim_Var *varPtr = (Jim_Var*) he->val;
9287 if (mode == JIM_VARLIST_LOCALS) {
9288 if (varPtr->linkFramePtr != NULL)
9289 continue;
9290 }
9291 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9292 strlen((const char*)he->key), 0))
9293 continue;
9294 Jim_ListAppendElement(interp, listObjPtr,
9295 Jim_NewStringObj(interp, he->key, -1));
9296 }
9297 Jim_FreeHashTableIterator(htiter);
9298 return listObjPtr;
9299 }
9300
9301 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9302 Jim_Obj **objPtrPtr)
9303 {
9304 Jim_CallFrame *targetCallFrame;
9305
9306 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9307 != JIM_OK)
9308 return JIM_ERR;
9309 /* No proc call at toplevel callframe */
9310 if (targetCallFrame == interp->topFramePtr) {
9311 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9312 Jim_AppendStrings(interp, Jim_GetResult(interp),
9313 "bad level \"",
9314 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9315 return JIM_ERR;
9316 }
9317 *objPtrPtr = Jim_NewListObj(interp,
9318 targetCallFrame->argv,
9319 targetCallFrame->argc);
9320 return JIM_OK;
9321 }
9322
9323 /* -----------------------------------------------------------------------------
9324 * Core commands
9325 * ---------------------------------------------------------------------------*/
9326
9327 /* fake [puts] -- not the real puts, just for debugging. */
9328 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9329 Jim_Obj *const *argv)
9330 {
9331 const char *str;
9332 int len, nonewline = 0;
9333
9334 if (argc != 2 && argc != 3) {
9335 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9336 return JIM_ERR;
9337 }
9338 if (argc == 3) {
9339 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9340 {
9341 Jim_SetResultString(interp, "The second argument must "
9342 "be -nonewline", -1);
9343 return JIM_OK;
9344 } else {
9345 nonewline = 1;
9346 argv++;
9347 }
9348 }
9349 str = Jim_GetString(argv[1], &len);
9350 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9351 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9352 return JIM_OK;
9353 }
9354
9355 /* Helper for [+] and [*] */
9356 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9357 Jim_Obj *const *argv, int op)
9358 {
9359 jim_wide wideValue, res;
9360 double doubleValue, doubleRes;
9361 int i;
9362
9363 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9364
9365 for (i = 1; i < argc; i++) {
9366 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9367 goto trydouble;
9368 if (op == JIM_EXPROP_ADD)
9369 res += wideValue;
9370 else
9371 res *= wideValue;
9372 }
9373 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9374 return JIM_OK;
9375 trydouble:
9376 doubleRes = (double) res;
9377 for (;i < argc; i++) {
9378 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9379 return JIM_ERR;
9380 if (op == JIM_EXPROP_ADD)
9381 doubleRes += doubleValue;
9382 else
9383 doubleRes *= doubleValue;
9384 }
9385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9386 return JIM_OK;
9387 }
9388
9389 /* Helper for [-] and [/] */
9390 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9391 Jim_Obj *const *argv, int op)
9392 {
9393 jim_wide wideValue, res = 0;
9394 double doubleValue, doubleRes = 0;
9395 int i = 2;
9396
9397 if (argc < 2) {
9398 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9399 return JIM_ERR;
9400 } else if (argc == 2) {
9401 /* The arity = 2 case is different. For [- x] returns -x,
9402 * while [/ x] returns 1/x. */
9403 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9404 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9405 JIM_OK)
9406 {
9407 return JIM_ERR;
9408 } else {
9409 if (op == JIM_EXPROP_SUB)
9410 doubleRes = -doubleValue;
9411 else
9412 doubleRes = 1.0/doubleValue;
9413 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9414 doubleRes));
9415 return JIM_OK;
9416 }
9417 }
9418 if (op == JIM_EXPROP_SUB) {
9419 res = -wideValue;
9420 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9421 } else {
9422 doubleRes = 1.0/wideValue;
9423 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9424 doubleRes));
9425 }
9426 return JIM_OK;
9427 } else {
9428 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9429 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9430 != JIM_OK) {
9431 return JIM_ERR;
9432 } else {
9433 goto trydouble;
9434 }
9435 }
9436 }
9437 for (i = 2; i < argc; i++) {
9438 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9439 doubleRes = (double) res;
9440 goto trydouble;
9441 }
9442 if (op == JIM_EXPROP_SUB)
9443 res -= wideValue;
9444 else
9445 res /= wideValue;
9446 }
9447 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9448 return JIM_OK;
9449 trydouble:
9450 for (;i < argc; i++) {
9451 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9452 return JIM_ERR;
9453 if (op == JIM_EXPROP_SUB)
9454 doubleRes -= doubleValue;
9455 else
9456 doubleRes /= doubleValue;
9457 }
9458 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9459 return JIM_OK;
9460 }
9461
9462
9463 /* [+] */
9464 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9465 Jim_Obj *const *argv)
9466 {
9467 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9468 }
9469
9470 /* [*] */
9471 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9472 Jim_Obj *const *argv)
9473 {
9474 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9475 }
9476
9477 /* [-] */
9478 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9479 Jim_Obj *const *argv)
9480 {
9481 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9482 }
9483
9484 /* [/] */
9485 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9486 Jim_Obj *const *argv)
9487 {
9488 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9489 }
9490
9491 /* [set] */
9492 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9493 Jim_Obj *const *argv)
9494 {
9495 if (argc != 2 && argc != 3) {
9496 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9497 return JIM_ERR;
9498 }
9499 if (argc == 2) {
9500 Jim_Obj *objPtr;
9501 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9502 if (!objPtr)
9503 return JIM_ERR;
9504 Jim_SetResult(interp, objPtr);
9505 return JIM_OK;
9506 }
9507 /* argc == 3 case. */
9508 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9509 return JIM_ERR;
9510 Jim_SetResult(interp, argv[2]);
9511 return JIM_OK;
9512 }
9513
9514 /* [unset] */
9515 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9516 Jim_Obj *const *argv)
9517 {
9518 int i;
9519
9520 if (argc < 2) {
9521 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9522 return JIM_ERR;
9523 }
9524 for (i = 1; i < argc; i++) {
9525 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9526 return JIM_ERR;
9527 }
9528 return JIM_OK;
9529 }
9530
9531 /* [incr] */
9532 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9533 Jim_Obj *const *argv)
9534 {
9535 jim_wide wideValue, increment = 1;
9536 Jim_Obj *intObjPtr;
9537
9538 if (argc != 2 && argc != 3) {
9539 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9540 return JIM_ERR;
9541 }
9542 if (argc == 3) {
9543 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9544 return JIM_ERR;
9545 }
9546 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9547 if (!intObjPtr) return JIM_ERR;
9548 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9549 return JIM_ERR;
9550 if (Jim_IsShared(intObjPtr)) {
9551 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9552 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9553 Jim_FreeNewObj(interp, intObjPtr);
9554 return JIM_ERR;
9555 }
9556 } else {
9557 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9558 /* The following step is required in order to invalidate the
9559 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9560 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9561 return JIM_ERR;
9562 }
9563 }
9564 Jim_SetResult(interp, intObjPtr);
9565 return JIM_OK;
9566 }
9567
9568 /* [while] */
9569 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9570 Jim_Obj *const *argv)
9571 {
9572 if (argc != 3) {
9573 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9574 return JIM_ERR;
9575 }
9576 /* Try to run a specialized version of while if the expression
9577 * is in one of the following forms:
9578 *
9579 * $a < CONST, $a < $b
9580 * $a <= CONST, $a <= $b
9581 * $a > CONST, $a > $b
9582 * $a >= CONST, $a >= $b
9583 * $a != CONST, $a != $b
9584 * $a == CONST, $a == $b
9585 * $a
9586 * !$a
9587 * CONST
9588 */
9589
9590 #ifdef JIM_OPTIMIZATION
9591 {
9592 ExprByteCode *expr;
9593 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9594 int exprLen, retval;
9595
9596 /* STEP 1 -- Check if there are the conditions to run the specialized
9597 * version of while */
9598
9599 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9600 if (expr->len <= 0 || expr->len > 3) goto noopt;
9601 switch(expr->len) {
9602 case 1:
9603 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9604 expr->opcode[0] != JIM_EXPROP_NUMBER)
9605 goto noopt;
9606 break;
9607 case 2:
9608 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9609 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9610 goto noopt;
9611 break;
9612 case 3:
9613 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9614 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9615 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9616 goto noopt;
9617 switch(expr->opcode[2]) {
9618 case JIM_EXPROP_LT:
9619 case JIM_EXPROP_LTE:
9620 case JIM_EXPROP_GT:
9621 case JIM_EXPROP_GTE:
9622 case JIM_EXPROP_NUMEQ:
9623 case JIM_EXPROP_NUMNE:
9624 /* nothing to do */
9625 break;
9626 default:
9627 goto noopt;
9628 }
9629 break;
9630 default:
9631 Jim_Panic(interp,
9632 "Unexpected default reached in Jim_WhileCoreCommand()");
9633 break;
9634 }
9635
9636 /* STEP 2 -- conditions meet. Initialization. Take different
9637 * branches for different expression lengths. */
9638 exprLen = expr->len;
9639
9640 if (exprLen == 1) {
9641 jim_wide wideValue;
9642
9643 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9644 varAObjPtr = expr->obj[0];
9645 Jim_IncrRefCount(varAObjPtr);
9646 } else {
9647 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9648 goto noopt;
9649 }
9650 while (1) {
9651 if (varAObjPtr) {
9652 if (!(objPtr =
9653 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9654 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9655 {
9656 Jim_DecrRefCount(interp, varAObjPtr);
9657 goto noopt;
9658 }
9659 }
9660 if (!wideValue) break;
9661 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9662 switch(retval) {
9663 case JIM_BREAK:
9664 if (varAObjPtr)
9665 Jim_DecrRefCount(interp, varAObjPtr);
9666 goto out;
9667 break;
9668 case JIM_CONTINUE:
9669 continue;
9670 break;
9671 default:
9672 if (varAObjPtr)
9673 Jim_DecrRefCount(interp, varAObjPtr);
9674 return retval;
9675 }
9676 }
9677 }
9678 if (varAObjPtr)
9679 Jim_DecrRefCount(interp, varAObjPtr);
9680 } else if (exprLen == 3) {
9681 jim_wide wideValueA, wideValueB, cmpRes = 0;
9682 int cmpType = expr->opcode[2];
9683
9684 varAObjPtr = expr->obj[0];
9685 Jim_IncrRefCount(varAObjPtr);
9686 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9687 varBObjPtr = expr->obj[1];
9688 Jim_IncrRefCount(varBObjPtr);
9689 } else {
9690 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9691 goto noopt;
9692 }
9693 while (1) {
9694 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9695 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9696 {
9697 Jim_DecrRefCount(interp, varAObjPtr);
9698 if (varBObjPtr)
9699 Jim_DecrRefCount(interp, varBObjPtr);
9700 goto noopt;
9701 }
9702 if (varBObjPtr) {
9703 if (!(objPtr =
9704 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9705 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9706 {
9707 Jim_DecrRefCount(interp, varAObjPtr);
9708 if (varBObjPtr)
9709 Jim_DecrRefCount(interp, varBObjPtr);
9710 goto noopt;
9711 }
9712 }
9713 switch(cmpType) {
9714 case JIM_EXPROP_LT:
9715 cmpRes = wideValueA < wideValueB; break;
9716 case JIM_EXPROP_LTE:
9717 cmpRes = wideValueA <= wideValueB; break;
9718 case JIM_EXPROP_GT:
9719 cmpRes = wideValueA > wideValueB; break;
9720 case JIM_EXPROP_GTE:
9721 cmpRes = wideValueA >= wideValueB; break;
9722 case JIM_EXPROP_NUMEQ:
9723 cmpRes = wideValueA == wideValueB; break;
9724 case JIM_EXPROP_NUMNE:
9725 cmpRes = wideValueA != wideValueB; break;
9726 }
9727 if (!cmpRes) break;
9728 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9729 switch(retval) {
9730 case JIM_BREAK:
9731 Jim_DecrRefCount(interp, varAObjPtr);
9732 if (varBObjPtr)
9733 Jim_DecrRefCount(interp, varBObjPtr);
9734 goto out;
9735 break;
9736 case JIM_CONTINUE:
9737 continue;
9738 break;
9739 default:
9740 Jim_DecrRefCount(interp, varAObjPtr);
9741 if (varBObjPtr)
9742 Jim_DecrRefCount(interp, varBObjPtr);
9743 return retval;
9744 }
9745 }
9746 }
9747 Jim_DecrRefCount(interp, varAObjPtr);
9748 if (varBObjPtr)
9749 Jim_DecrRefCount(interp, varBObjPtr);
9750 } else {
9751 /* TODO: case for len == 2 */
9752 goto noopt;
9753 }
9754 Jim_SetEmptyResult(interp);
9755 return JIM_OK;
9756 }
9757 noopt:
9758 #endif
9759
9760 /* The general purpose implementation of while starts here */
9761 while (1) {
9762 int boolean, retval;
9763
9764 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9765 &boolean)) != JIM_OK)
9766 return retval;
9767 if (!boolean) break;
9768 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9769 switch(retval) {
9770 case JIM_BREAK:
9771 goto out;
9772 break;
9773 case JIM_CONTINUE:
9774 continue;
9775 break;
9776 default:
9777 return retval;
9778 }
9779 }
9780 }
9781 out:
9782 Jim_SetEmptyResult(interp);
9783 return JIM_OK;
9784 }
9785
9786 /* [for] */
9787 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9788 Jim_Obj *const *argv)
9789 {
9790 int retval;
9791
9792 if (argc != 5) {
9793 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9794 return JIM_ERR;
9795 }
9796 /* Check if the for is on the form:
9797 * for {set i CONST} {$i < CONST} {incr i}
9798 * for {set i CONST} {$i < $j} {incr i}
9799 * for {set i CONST} {$i <= CONST} {incr i}
9800 * for {set i CONST} {$i <= $j} {incr i}
9801 * XXX: NOTE: if variable traces are implemented, this optimization
9802 * need to be modified to check for the proc epoch at every variable
9803 * update. */
9804 #ifdef JIM_OPTIMIZATION
9805 {
9806 ScriptObj *initScript, *incrScript;
9807 ExprByteCode *expr;
9808 jim_wide start, stop, currentVal;
9809 unsigned jim_wide procEpoch = interp->procEpoch;
9810 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9811 int cmpType;
9812 struct Jim_Cmd *cmdPtr;
9813
9814 /* Do it only if there aren't shared arguments */
9815 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9816 goto evalstart;
9817 initScript = Jim_GetScript(interp, argv[1]);
9818 expr = Jim_GetExpression(interp, argv[2]);
9819 incrScript = Jim_GetScript(interp, argv[3]);
9820
9821 /* Ensure proper lengths to start */
9822 if (initScript->len != 6) goto evalstart;
9823 if (incrScript->len != 4) goto evalstart;
9824 if (expr->len != 3) goto evalstart;
9825 /* Ensure proper token types. */
9826 if (initScript->token[2].type != JIM_TT_ESC ||
9827 initScript->token[4].type != JIM_TT_ESC ||
9828 incrScript->token[2].type != JIM_TT_ESC ||
9829 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9830 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9831 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9832 (expr->opcode[2] != JIM_EXPROP_LT &&
9833 expr->opcode[2] != JIM_EXPROP_LTE))
9834 goto evalstart;
9835 cmpType = expr->opcode[2];
9836 /* Initialization command must be [set] */
9837 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9838 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
9839 goto evalstart;
9840 /* Update command must be incr */
9841 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
9842 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
9843 goto evalstart;
9844 /* set, incr, expression must be about the same variable */
9845 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9846 incrScript->token[2].objPtr, 0))
9847 goto evalstart;
9848 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9849 expr->obj[0], 0))
9850 goto evalstart;
9851 /* Check that the initialization and comparison are valid integers */
9852 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
9853 goto evalstart;
9854 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
9855 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
9856 {
9857 goto evalstart;
9858 }
9859
9860 /* Initialization */
9861 varNamePtr = expr->obj[0];
9862 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9863 stopVarNamePtr = expr->obj[1];
9864 Jim_IncrRefCount(stopVarNamePtr);
9865 }
9866 Jim_IncrRefCount(varNamePtr);
9867
9868 /* --- OPTIMIZED FOR --- */
9869 /* Start to loop */
9870 objPtr = Jim_NewIntObj(interp, start);
9871 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
9872 Jim_DecrRefCount(interp, varNamePtr);
9873 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9874 Jim_FreeNewObj(interp, objPtr);
9875 goto evalstart;
9876 }
9877 while (1) {
9878 /* === Check condition === */
9879 /* Common code: */
9880 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
9881 if (objPtr == NULL ||
9882 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
9883 {
9884 Jim_DecrRefCount(interp, varNamePtr);
9885 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9886 goto testcond;
9887 }
9888 /* Immediate or Variable? get the 'stop' value if the latter. */
9889 if (stopVarNamePtr) {
9890 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
9891 if (objPtr == NULL ||
9892 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
9893 {
9894 Jim_DecrRefCount(interp, varNamePtr);
9895 Jim_DecrRefCount(interp, stopVarNamePtr);
9896 goto testcond;
9897 }
9898 }
9899 if (cmpType == JIM_EXPROP_LT) {
9900 if (currentVal >= stop) break;
9901 } else {
9902 if (currentVal > stop) break;
9903 }
9904 /* Eval body */
9905 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9906 switch(retval) {
9907 case JIM_BREAK:
9908 if (stopVarNamePtr)
9909 Jim_DecrRefCount(interp, stopVarNamePtr);
9910 Jim_DecrRefCount(interp, varNamePtr);
9911 goto out;
9912 case JIM_CONTINUE:
9913 /* nothing to do */
9914 break;
9915 default:
9916 if (stopVarNamePtr)
9917 Jim_DecrRefCount(interp, stopVarNamePtr);
9918 Jim_DecrRefCount(interp, varNamePtr);
9919 return retval;
9920 }
9921 }
9922 /* If there was a change in procedures/command continue
9923 * with the usual [for] command implementation */
9924 if (procEpoch != interp->procEpoch) {
9925 if (stopVarNamePtr)
9926 Jim_DecrRefCount(interp, stopVarNamePtr);
9927 Jim_DecrRefCount(interp, varNamePtr);
9928 goto evalnext;
9929 }
9930 /* Increment */
9931 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
9932 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
9933 objPtr->internalRep.wideValue ++;
9934 Jim_InvalidateStringRep(objPtr);
9935 } else {
9936 Jim_Obj *auxObjPtr;
9937
9938 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
9939 if (stopVarNamePtr)
9940 Jim_DecrRefCount(interp, stopVarNamePtr);
9941 Jim_DecrRefCount(interp, varNamePtr);
9942 goto evalnext;
9943 }
9944 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
9945 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
9946 if (stopVarNamePtr)
9947 Jim_DecrRefCount(interp, stopVarNamePtr);
9948 Jim_DecrRefCount(interp, varNamePtr);
9949 Jim_FreeNewObj(interp, auxObjPtr);
9950 goto evalnext;
9951 }
9952 }
9953 }
9954 if (stopVarNamePtr)
9955 Jim_DecrRefCount(interp, stopVarNamePtr);
9956 Jim_DecrRefCount(interp, varNamePtr);
9957 Jim_SetEmptyResult(interp);
9958 return JIM_OK;
9959 }
9960 #endif
9961 evalstart:
9962 /* Eval start */
9963 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
9964 return retval;
9965 while (1) {
9966 int boolean;
9967 testcond:
9968 /* Test the condition */
9969 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
9970 != JIM_OK)
9971 return retval;
9972 if (!boolean) break;
9973 /* Eval body */
9974 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9975 switch(retval) {
9976 case JIM_BREAK:
9977 goto out;
9978 break;
9979 case JIM_CONTINUE:
9980 /* Nothing to do */
9981 break;
9982 default:
9983 return retval;
9984 }
9985 }
9986 evalnext:
9987 /* Eval next */
9988 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
9989 switch(retval) {
9990 case JIM_BREAK:
9991 goto out;
9992 break;
9993 case JIM_CONTINUE:
9994 continue;
9995 break;
9996 default:
9997 return retval;
9998 }
9999 }
10000 }
10001 out:
10002 Jim_SetEmptyResult(interp);
10003 return JIM_OK;
10004 }
10005
10006 /* foreach + lmap implementation. */
10007 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10008 Jim_Obj *const *argv, int doMap)
10009 {
10010 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10011 int nbrOfLoops = 0;
10012 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10013
10014 if (argc < 4 || argc % 2 != 0) {
10015 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10016 return JIM_ERR;
10017 }
10018 if (doMap) {
10019 mapRes = Jim_NewListObj(interp, NULL, 0);
10020 Jim_IncrRefCount(mapRes);
10021 }
10022 emptyStr = Jim_NewEmptyStringObj(interp);
10023 Jim_IncrRefCount(emptyStr);
10024 script = argv[argc-1]; /* Last argument is a script */
10025 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10026 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10027 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10028 /* Initialize iterators and remember max nbr elements each list */
10029 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10030 /* Remember lengths of all lists and calculate how much rounds to loop */
10031 for (i=0; i < nbrOfLists*2; i += 2) {
10032 div_t cnt;
10033 int count;
10034 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10035 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10036 if (listsEnd[i] == 0) {
10037 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10038 goto err;
10039 }
10040 cnt = div(listsEnd[i+1], listsEnd[i]);
10041 count = cnt.quot + (cnt.rem ? 1 : 0);
10042 if (count > nbrOfLoops)
10043 nbrOfLoops = count;
10044 }
10045 for (; nbrOfLoops-- > 0; ) {
10046 for (i=0; i < nbrOfLists; ++i) {
10047 int varIdx = 0, var = i * 2;
10048 while (varIdx < listsEnd[var]) {
10049 Jim_Obj *varName, *ele;
10050 int lst = i * 2 + 1;
10051 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10052 != JIM_OK)
10053 goto err;
10054 if (listsIdx[i] < listsEnd[lst]) {
10055 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10056 != JIM_OK)
10057 goto err;
10058 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10059 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10060 goto err;
10061 }
10062 ++listsIdx[i]; /* Remember next iterator of current list */
10063 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10064 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10065 goto err;
10066 }
10067 ++varIdx; /* Next variable */
10068 }
10069 }
10070 switch (result = Jim_EvalObj(interp, script)) {
10071 case JIM_OK:
10072 if (doMap)
10073 Jim_ListAppendElement(interp, mapRes, interp->result);
10074 break;
10075 case JIM_CONTINUE:
10076 break;
10077 case JIM_BREAK:
10078 goto out;
10079 break;
10080 default:
10081 goto err;
10082 }
10083 }
10084 out:
10085 result = JIM_OK;
10086 if (doMap)
10087 Jim_SetResult(interp, mapRes);
10088 else
10089 Jim_SetEmptyResult(interp);
10090 err:
10091 if (doMap)
10092 Jim_DecrRefCount(interp, mapRes);
10093 Jim_DecrRefCount(interp, emptyStr);
10094 Jim_Free(listsIdx);
10095 Jim_Free(listsEnd);
10096 return result;
10097 }
10098
10099 /* [foreach] */
10100 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10101 Jim_Obj *const *argv)
10102 {
10103 return JimForeachMapHelper(interp, argc, argv, 0);
10104 }
10105
10106 /* [lmap] */
10107 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10108 Jim_Obj *const *argv)
10109 {
10110 return JimForeachMapHelper(interp, argc, argv, 1);
10111 }
10112
10113 /* [if] */
10114 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10115 Jim_Obj *const *argv)
10116 {
10117 int boolean, retval, current = 1, falsebody = 0;
10118 if (argc >= 3) {
10119 while (1) {
10120 /* Far not enough arguments given! */
10121 if (current >= argc) goto err;
10122 if ((retval = Jim_GetBoolFromExpr(interp,
10123 argv[current++], &boolean))
10124 != JIM_OK)
10125 return retval;
10126 /* There lacks something, isn't it? */
10127 if (current >= argc) goto err;
10128 if (Jim_CompareStringImmediate(interp, argv[current],
10129 "then")) current++;
10130 /* Tsk tsk, no then-clause? */
10131 if (current >= argc) goto err;
10132 if (boolean)
10133 return Jim_EvalObj(interp, argv[current]);
10134 /* Ok: no else-clause follows */
10135 if (++current >= argc) {
10136 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10137 return JIM_OK;
10138 }
10139 falsebody = current++;
10140 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10141 "else")) {
10142 /* IIICKS - else-clause isn't last cmd? */
10143 if (current != argc-1) goto err;
10144 return Jim_EvalObj(interp, argv[current]);
10145 } else if (Jim_CompareStringImmediate(interp,
10146 argv[falsebody], "elseif"))
10147 /* Ok: elseif follows meaning all the stuff
10148 * again (how boring...) */
10149 continue;
10150 /* OOPS - else-clause is not last cmd?*/
10151 else if (falsebody != argc-1)
10152 goto err;
10153 return Jim_EvalObj(interp, argv[falsebody]);
10154 }
10155 return JIM_OK;
10156 }
10157 err:
10158 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10159 return JIM_ERR;
10160 }
10161
10162 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10163
10164 /* [switch] */
10165 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10166 Jim_Obj *const *argv)
10167 {
10168 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10169 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10170 Jim_Obj *script = 0;
10171 if (argc < 3) goto wrongnumargs;
10172 for (opt=1; opt < argc; ++opt) {
10173 const char *option = Jim_GetString(argv[opt], 0);
10174 if (*option != '-') break;
10175 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10176 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10177 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10178 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10179 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10180 if ((argc - opt) < 2) goto wrongnumargs;
10181 command = argv[++opt];
10182 } else {
10183 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10184 Jim_AppendStrings(interp, Jim_GetResult(interp),
10185 "bad option \"", option, "\": must be -exact, -glob, "
10186 "-regexp, -command procname or --", 0);
10187 goto err;
10188 }
10189 if ((argc - opt) < 2) goto wrongnumargs;
10190 }
10191 strObj = argv[opt++];
10192 patCount = argc - opt;
10193 if (patCount == 1) {
10194 Jim_Obj **vector;
10195 JimListGetElements(interp, argv[opt], &patCount, &vector);
10196 caseList = vector;
10197 } else
10198 caseList = &argv[opt];
10199 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10200 for (i=0; script == 0 && i < patCount; i += 2) {
10201 Jim_Obj *patObj = caseList[i];
10202 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10203 || i < (patCount-2)) {
10204 switch (matchOpt) {
10205 case SWITCH_EXACT:
10206 if (Jim_StringEqObj(strObj, patObj, 0))
10207 script = caseList[i+1];
10208 break;
10209 case SWITCH_GLOB:
10210 if (Jim_StringMatchObj(patObj, strObj, 0))
10211 script = caseList[i+1];
10212 break;
10213 case SWITCH_RE:
10214 command = Jim_NewStringObj(interp, "regexp", -1);
10215 /* Fall thru intentionally */
10216 case SWITCH_CMD: {
10217 Jim_Obj *parms[] = {command, patObj, strObj};
10218 int rc = Jim_EvalObjVector(interp, 3, parms);
10219 long matching;
10220 /* After the execution of a command we need to
10221 * make sure to reconvert the object into a list
10222 * again. Only for the single-list style [switch]. */
10223 if (argc-opt == 1) {
10224 Jim_Obj **vector;
10225 JimListGetElements(interp, argv[opt], &patCount,
10226 &vector);
10227 caseList = vector;
10228 }
10229 /* command is here already decref'd */
10230 if (rc != JIM_OK) {
10231 retcode = rc;
10232 goto err;
10233 }
10234 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10235 if (rc != JIM_OK) {
10236 retcode = rc;
10237 goto err;
10238 }
10239 if (matching)
10240 script = caseList[i+1];
10241 break;
10242 }
10243 default:
10244 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10245 Jim_AppendStrings(interp, Jim_GetResult(interp),
10246 "internal error: no such option implemented", 0);
10247 goto err;
10248 }
10249 } else {
10250 script = caseList[i+1];
10251 }
10252 }
10253 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10254 i += 2)
10255 script = caseList[i+1];
10256 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10257 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10258 Jim_AppendStrings(interp, Jim_GetResult(interp),
10259 "no body specified for pattern \"",
10260 Jim_GetString(caseList[i-2], 0), "\"", 0);
10261 goto err;
10262 }
10263 retcode = JIM_OK;
10264 Jim_SetEmptyResult(interp);
10265 if (script != 0)
10266 retcode = Jim_EvalObj(interp, script);
10267 return retcode;
10268 wrongnumargs:
10269 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10270 "pattern body ... ?default body? or "
10271 "{pattern body ?pattern body ...?}");
10272 err:
10273 return retcode;
10274 }
10275
10276 /* [list] */
10277 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10278 Jim_Obj *const *argv)
10279 {
10280 Jim_Obj *listObjPtr;
10281
10282 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10283 Jim_SetResult(interp, listObjPtr);
10284 return JIM_OK;
10285 }
10286
10287 /* [lindex] */
10288 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10289 Jim_Obj *const *argv)
10290 {
10291 Jim_Obj *objPtr, *listObjPtr;
10292 int i;
10293 int index;
10294
10295 if (argc < 3) {
10296 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10297 return JIM_ERR;
10298 }
10299 objPtr = argv[1];
10300 Jim_IncrRefCount(objPtr);
10301 for (i = 2; i < argc; i++) {
10302 listObjPtr = objPtr;
10303 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10304 Jim_DecrRefCount(interp, listObjPtr);
10305 return JIM_ERR;
10306 }
10307 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10308 JIM_NONE) != JIM_OK) {
10309 /* Returns an empty object if the index
10310 * is out of range. */
10311 Jim_DecrRefCount(interp, listObjPtr);
10312 Jim_SetEmptyResult(interp);
10313 return JIM_OK;
10314 }
10315 Jim_IncrRefCount(objPtr);
10316 Jim_DecrRefCount(interp, listObjPtr);
10317 }
10318 Jim_SetResult(interp, objPtr);
10319 Jim_DecrRefCount(interp, objPtr);
10320 return JIM_OK;
10321 }
10322
10323 /* [llength] */
10324 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10325 Jim_Obj *const *argv)
10326 {
10327 int len;
10328
10329 if (argc != 2) {
10330 Jim_WrongNumArgs(interp, 1, argv, "list");
10331 return JIM_ERR;
10332 }
10333 Jim_ListLength(interp, argv[1], &len);
10334 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10335 return JIM_OK;
10336 }
10337
10338 /* [lappend] */
10339 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10340 Jim_Obj *const *argv)
10341 {
10342 Jim_Obj *listObjPtr;
10343 int shared, i;
10344
10345 if (argc < 2) {
10346 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10347 return JIM_ERR;
10348 }
10349 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10350 if (!listObjPtr) {
10351 /* Create the list if it does not exists */
10352 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10353 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10354 Jim_FreeNewObj(interp, listObjPtr);
10355 return JIM_ERR;
10356 }
10357 }
10358 shared = Jim_IsShared(listObjPtr);
10359 if (shared)
10360 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10361 for (i = 2; i < argc; i++)
10362 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10363 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10364 if (shared)
10365 Jim_FreeNewObj(interp, listObjPtr);
10366 return JIM_ERR;
10367 }
10368 Jim_SetResult(interp, listObjPtr);
10369 return JIM_OK;
10370 }
10371
10372 /* [linsert] */
10373 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10374 Jim_Obj *const *argv)
10375 {
10376 int index, len;
10377 Jim_Obj *listPtr;
10378
10379 if (argc < 4) {
10380 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10381 "?element ...?");
10382 return JIM_ERR;
10383 }
10384 listPtr = argv[1];
10385 if (Jim_IsShared(listPtr))
10386 listPtr = Jim_DuplicateObj(interp, listPtr);
10387 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10388 goto err;
10389 Jim_ListLength(interp, listPtr, &len);
10390 if (index >= len)
10391 index = len;
10392 else if (index < 0)
10393 index = len + index + 1;
10394 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10395 Jim_SetResult(interp, listPtr);
10396 return JIM_OK;
10397 err:
10398 if (listPtr != argv[1]) {
10399 Jim_FreeNewObj(interp, listPtr);
10400 }
10401 return JIM_ERR;
10402 }
10403
10404 /* [lset] */
10405 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10406 Jim_Obj *const *argv)
10407 {
10408 if (argc < 3) {
10409 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10410 return JIM_ERR;
10411 } else if (argc == 3) {
10412 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10413 return JIM_ERR;
10414 Jim_SetResult(interp, argv[2]);
10415 return JIM_OK;
10416 }
10417 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10418 == JIM_ERR) return JIM_ERR;
10419 return JIM_OK;
10420 }
10421
10422 /* [lsort] */
10423 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10424 {
10425 const char *options[] = {
10426 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10427 };
10428 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10429 Jim_Obj *resObj;
10430 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10431 int decreasing = 0;
10432
10433 if (argc < 2) {
10434 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10435 return JIM_ERR;
10436 }
10437 for (i = 1; i < (argc-1); i++) {
10438 int option;
10439
10440 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10441 != JIM_OK)
10442 return JIM_ERR;
10443 switch(option) {
10444 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10445 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10446 case OPT_INCREASING: decreasing = 0; break;
10447 case OPT_DECREASING: decreasing = 1; break;
10448 }
10449 }
10450 if (decreasing) {
10451 switch(lsortType) {
10452 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10453 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10454 }
10455 }
10456 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10457 ListSortElements(interp, resObj, lsortType);
10458 Jim_SetResult(interp, resObj);
10459 return JIM_OK;
10460 }
10461
10462 /* [append] */
10463 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10464 Jim_Obj *const *argv)
10465 {
10466 Jim_Obj *stringObjPtr;
10467 int shared, i;
10468
10469 if (argc < 2) {
10470 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10471 return JIM_ERR;
10472 }
10473 if (argc == 2) {
10474 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10475 if (!stringObjPtr) return JIM_ERR;
10476 } else {
10477 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10478 if (!stringObjPtr) {
10479 /* Create the string if it does not exists */
10480 stringObjPtr = Jim_NewEmptyStringObj(interp);
10481 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10482 != JIM_OK) {
10483 Jim_FreeNewObj(interp, stringObjPtr);
10484 return JIM_ERR;
10485 }
10486 }
10487 }
10488 shared = Jim_IsShared(stringObjPtr);
10489 if (shared)
10490 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10491 for (i = 2; i < argc; i++)
10492 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10493 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10494 if (shared)
10495 Jim_FreeNewObj(interp, stringObjPtr);
10496 return JIM_ERR;
10497 }
10498 Jim_SetResult(interp, stringObjPtr);
10499 return JIM_OK;
10500 }
10501
10502 /* [debug] */
10503 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10504 Jim_Obj *const *argv)
10505 {
10506 const char *options[] = {
10507 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10508 "exprbc",
10509 NULL
10510 };
10511 enum {
10512 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10513 OPT_EXPRLEN, OPT_EXPRBC
10514 };
10515 int option;
10516
10517 if (argc < 2) {
10518 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10519 return JIM_ERR;
10520 }
10521 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10522 JIM_ERRMSG) != JIM_OK)
10523 return JIM_ERR;
10524 if (option == OPT_REFCOUNT) {
10525 if (argc != 3) {
10526 Jim_WrongNumArgs(interp, 2, argv, "object");
10527 return JIM_ERR;
10528 }
10529 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10530 return JIM_OK;
10531 } else if (option == OPT_OBJCOUNT) {
10532 int freeobj = 0, liveobj = 0;
10533 char buf[256];
10534 Jim_Obj *objPtr;
10535
10536 if (argc != 2) {
10537 Jim_WrongNumArgs(interp, 2, argv, "");
10538 return JIM_ERR;
10539 }
10540 /* Count the number of free objects. */
10541 objPtr = interp->freeList;
10542 while (objPtr) {
10543 freeobj++;
10544 objPtr = objPtr->nextObjPtr;
10545 }
10546 /* Count the number of live objects. */
10547 objPtr = interp->liveList;
10548 while (objPtr) {
10549 liveobj++;
10550 objPtr = objPtr->nextObjPtr;
10551 }
10552 /* Set the result string and return. */
10553 sprintf(buf, "free %d used %d", freeobj, liveobj);
10554 Jim_SetResultString(interp, buf, -1);
10555 return JIM_OK;
10556 } else if (option == OPT_OBJECTS) {
10557 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10558 /* Count the number of live objects. */
10559 objPtr = interp->liveList;
10560 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10561 while (objPtr) {
10562 char buf[128];
10563 const char *type = objPtr->typePtr ?
10564 objPtr->typePtr->name : "";
10565 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10566 sprintf(buf, "%p", objPtr);
10567 Jim_ListAppendElement(interp, subListObjPtr,
10568 Jim_NewStringObj(interp, buf, -1));
10569 Jim_ListAppendElement(interp, subListObjPtr,
10570 Jim_NewStringObj(interp, type, -1));
10571 Jim_ListAppendElement(interp, subListObjPtr,
10572 Jim_NewIntObj(interp, objPtr->refCount));
10573 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10574 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10575 objPtr = objPtr->nextObjPtr;
10576 }
10577 Jim_SetResult(interp, listObjPtr);
10578 return JIM_OK;
10579 } else if (option == OPT_INVSTR) {
10580 Jim_Obj *objPtr;
10581
10582 if (argc != 3) {
10583 Jim_WrongNumArgs(interp, 2, argv, "object");
10584 return JIM_ERR;
10585 }
10586 objPtr = argv[2];
10587 if (objPtr->typePtr != NULL)
10588 Jim_InvalidateStringRep(objPtr);
10589 Jim_SetEmptyResult(interp);
10590 return JIM_OK;
10591 } else if (option == OPT_SCRIPTLEN) {
10592 ScriptObj *script;
10593 if (argc != 3) {
10594 Jim_WrongNumArgs(interp, 2, argv, "script");
10595 return JIM_ERR;
10596 }
10597 script = Jim_GetScript(interp, argv[2]);
10598 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10599 return JIM_OK;
10600 } else if (option == OPT_EXPRLEN) {
10601 ExprByteCode *expr;
10602 if (argc != 3) {
10603 Jim_WrongNumArgs(interp, 2, argv, "expression");
10604 return JIM_ERR;
10605 }
10606 expr = Jim_GetExpression(interp, argv[2]);
10607 if (expr == NULL)
10608 return JIM_ERR;
10609 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10610 return JIM_OK;
10611 } else if (option == OPT_EXPRBC) {
10612 Jim_Obj *objPtr;
10613 ExprByteCode *expr;
10614 int i;
10615
10616 if (argc != 3) {
10617 Jim_WrongNumArgs(interp, 2, argv, "expression");
10618 return JIM_ERR;
10619 }
10620 expr = Jim_GetExpression(interp, argv[2]);
10621 if (expr == NULL)
10622 return JIM_ERR;
10623 objPtr = Jim_NewListObj(interp, NULL, 0);
10624 for (i = 0; i < expr->len; i++) {
10625 const char *type;
10626 Jim_ExprOperator *op;
10627
10628 switch(expr->opcode[i]) {
10629 case JIM_EXPROP_NUMBER: type = "number"; break;
10630 case JIM_EXPROP_COMMAND: type = "command"; break;
10631 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10632 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10633 case JIM_EXPROP_SUBST: type = "subst"; break;
10634 case JIM_EXPROP_STRING: type = "string"; break;
10635 default:
10636 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10637 if (op == NULL) {
10638 type = "private";
10639 } else {
10640 type = "operator";
10641 }
10642 break;
10643 }
10644 Jim_ListAppendElement(interp, objPtr,
10645 Jim_NewStringObj(interp, type, -1));
10646 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10647 }
10648 Jim_SetResult(interp, objPtr);
10649 return JIM_OK;
10650 } else {
10651 Jim_SetResultString(interp,
10652 "bad option. Valid options are refcount, "
10653 "objcount, objects, invstr", -1);
10654 return JIM_ERR;
10655 }
10656 return JIM_OK; /* unreached */
10657 }
10658
10659 /* [eval] */
10660 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10661 Jim_Obj *const *argv)
10662 {
10663 if (argc == 2) {
10664 return Jim_EvalObj(interp, argv[1]);
10665 } else if (argc > 2) {
10666 Jim_Obj *objPtr;
10667 int retcode;
10668
10669 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10670 Jim_IncrRefCount(objPtr);
10671 retcode = Jim_EvalObj(interp, objPtr);
10672 Jim_DecrRefCount(interp, objPtr);
10673 return retcode;
10674 } else {
10675 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10676 return JIM_ERR;
10677 }
10678 }
10679
10680 /* [uplevel] */
10681 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10682 Jim_Obj *const *argv)
10683 {
10684 if (argc >= 2) {
10685 int retcode, newLevel, oldLevel;
10686 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10687 Jim_Obj *objPtr;
10688 const char *str;
10689
10690 /* Save the old callframe pointer */
10691 savedCallFrame = interp->framePtr;
10692
10693 /* Lookup the target frame pointer */
10694 str = Jim_GetString(argv[1], NULL);
10695 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10696 {
10697 if (Jim_GetCallFrameByLevel(interp, argv[1],
10698 &targetCallFrame,
10699 &newLevel) != JIM_OK)
10700 return JIM_ERR;
10701 argc--;
10702 argv++;
10703 } else {
10704 if (Jim_GetCallFrameByLevel(interp, NULL,
10705 &targetCallFrame,
10706 &newLevel) != JIM_OK)
10707 return JIM_ERR;
10708 }
10709 if (argc < 2) {
10710 argc++;
10711 argv--;
10712 Jim_WrongNumArgs(interp, 1, argv,
10713 "?level? command ?arg ...?");
10714 return JIM_ERR;
10715 }
10716 /* Eval the code in the target callframe. */
10717 interp->framePtr = targetCallFrame;
10718 oldLevel = interp->numLevels;
10719 interp->numLevels = newLevel;
10720 if (argc == 2) {
10721 retcode = Jim_EvalObj(interp, argv[1]);
10722 } else {
10723 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10724 Jim_IncrRefCount(objPtr);
10725 retcode = Jim_EvalObj(interp, objPtr);
10726 Jim_DecrRefCount(interp, objPtr);
10727 }
10728 interp->numLevels = oldLevel;
10729 interp->framePtr = savedCallFrame;
10730 return retcode;
10731 } else {
10732 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10733 return JIM_ERR;
10734 }
10735 }
10736
10737 /* [expr] */
10738 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10739 Jim_Obj *const *argv)
10740 {
10741 Jim_Obj *exprResultPtr;
10742 int retcode;
10743
10744 if (argc == 2) {
10745 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10746 } else if (argc > 2) {
10747 Jim_Obj *objPtr;
10748
10749 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10750 Jim_IncrRefCount(objPtr);
10751 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10752 Jim_DecrRefCount(interp, objPtr);
10753 } else {
10754 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10755 return JIM_ERR;
10756 }
10757 if (retcode != JIM_OK) return retcode;
10758 Jim_SetResult(interp, exprResultPtr);
10759 Jim_DecrRefCount(interp, exprResultPtr);
10760 return JIM_OK;
10761 }
10762
10763 /* [break] */
10764 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10765 Jim_Obj *const *argv)
10766 {
10767 if (argc != 1) {
10768 Jim_WrongNumArgs(interp, 1, argv, "");
10769 return JIM_ERR;
10770 }
10771 return JIM_BREAK;
10772 }
10773
10774 /* [continue] */
10775 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10776 Jim_Obj *const *argv)
10777 {
10778 if (argc != 1) {
10779 Jim_WrongNumArgs(interp, 1, argv, "");
10780 return JIM_ERR;
10781 }
10782 return JIM_CONTINUE;
10783 }
10784
10785 /* [return] */
10786 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10787 Jim_Obj *const *argv)
10788 {
10789 if (argc == 1) {
10790 return JIM_RETURN;
10791 } else if (argc == 2) {
10792 Jim_SetResult(interp, argv[1]);
10793 interp->returnCode = JIM_OK;
10794 return JIM_RETURN;
10795 } else if (argc == 3 || argc == 4) {
10796 int returnCode;
10797 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10798 return JIM_ERR;
10799 interp->returnCode = returnCode;
10800 if (argc == 4)
10801 Jim_SetResult(interp, argv[3]);
10802 return JIM_RETURN;
10803 } else {
10804 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10805 return JIM_ERR;
10806 }
10807 return JIM_RETURN; /* unreached */
10808 }
10809
10810 /* [tailcall] */
10811 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10812 Jim_Obj *const *argv)
10813 {
10814 Jim_Obj *objPtr;
10815
10816 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10817 Jim_SetResult(interp, objPtr);
10818 return JIM_EVAL;
10819 }
10820
10821 /* [proc] */
10822 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10823 Jim_Obj *const *argv)
10824 {
10825 int argListLen;
10826 int arityMin, arityMax;
10827
10828 if (argc != 4 && argc != 5) {
10829 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10830 return JIM_ERR;
10831 }
10832 Jim_ListLength(interp, argv[2], &argListLen);
10833 arityMin = arityMax = argListLen+1;
10834 if (argListLen) {
10835 const char *str;
10836 int len;
10837 Jim_Obj *lastArgPtr;
10838
10839 Jim_ListIndex(interp, argv[2], argListLen-1, &lastArgPtr, JIM_NONE);
10840 str = Jim_GetString(lastArgPtr, &len);
10841 if (len == 4 && memcmp(str, "args", 4) == 0) {
10842 arityMin--;
10843 arityMax = -1;
10844 }
10845 }
10846 if (argc == 4) {
10847 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10848 argv[2], NULL, argv[3], arityMin, arityMax);
10849 } else {
10850 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10851 argv[2], argv[3], argv[4], arityMin, arityMax);
10852 }
10853 }
10854
10855 /* [concat] */
10856 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
10857 Jim_Obj *const *argv)
10858 {
10859 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
10860 return JIM_OK;
10861 }
10862
10863 /* [upvar] */
10864 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
10865 Jim_Obj *const *argv)
10866 {
10867 const char *str;
10868 int i;
10869 Jim_CallFrame *targetCallFrame;
10870
10871 /* Lookup the target frame pointer */
10872 str = Jim_GetString(argv[1], NULL);
10873 if (argc > 3 &&
10874 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
10875 {
10876 if (Jim_GetCallFrameByLevel(interp, argv[1],
10877 &targetCallFrame, NULL) != JIM_OK)
10878 return JIM_ERR;
10879 argc--;
10880 argv++;
10881 } else {
10882 if (Jim_GetCallFrameByLevel(interp, NULL,
10883 &targetCallFrame, NULL) != JIM_OK)
10884 return JIM_ERR;
10885 }
10886 /* Check for arity */
10887 if (argc < 3 || ((argc-1)%2) != 0) {
10888 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
10889 return JIM_ERR;
10890 }
10891 /* Now... for every other/local couple: */
10892 for (i = 1; i < argc; i += 2) {
10893 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
10894 targetCallFrame) != JIM_OK) return JIM_ERR;
10895 }
10896 return JIM_OK;
10897 }
10898
10899 /* [global] */
10900 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
10901 Jim_Obj *const *argv)
10902 {
10903 int i;
10904
10905 if (argc < 2) {
10906 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
10907 return JIM_ERR;
10908 }
10909 /* Link every var to the toplevel having the same name */
10910 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
10911 for (i = 1; i < argc; i++) {
10912 if (Jim_SetVariableLink(interp, argv[i], argv[i],
10913 interp->topFramePtr) != JIM_OK) return JIM_ERR;
10914 }
10915 return JIM_OK;
10916 }
10917
10918 /* does the [string map] operation. On error NULL is returned,
10919 * otherwise a new string object with the result, having refcount = 0,
10920 * is returned. */
10921 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
10922 Jim_Obj *objPtr, int nocase)
10923 {
10924 int numMaps;
10925 const char **key, *str, *noMatchStart = NULL;
10926 Jim_Obj **value;
10927 int *keyLen, strLen, i;
10928 Jim_Obj *resultObjPtr;
10929
10930 Jim_ListLength(interp, mapListObjPtr, &numMaps);
10931 if (numMaps % 2) {
10932 Jim_SetResultString(interp,
10933 "list must contain an even number of elements", -1);
10934 return NULL;
10935 }
10936 /* Initialization */
10937 numMaps /= 2;
10938 key = Jim_Alloc(sizeof(char*)*numMaps);
10939 keyLen = Jim_Alloc(sizeof(int)*numMaps);
10940 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
10941 resultObjPtr = Jim_NewStringObj(interp, "", 0);
10942 for (i = 0; i < numMaps; i++) {
10943 Jim_Obj *eleObjPtr;
10944
10945 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
10946 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
10947 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
10948 value[i] = eleObjPtr;
10949 }
10950 str = Jim_GetString(objPtr, &strLen);
10951 /* Map it */
10952 while(strLen) {
10953 for (i = 0; i < numMaps; i++) {
10954 if (strLen >= keyLen[i] && keyLen[i]) {
10955 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
10956 nocase))
10957 {
10958 if (noMatchStart) {
10959 Jim_AppendString(interp, resultObjPtr,
10960 noMatchStart, str-noMatchStart);
10961 noMatchStart = NULL;
10962 }
10963 Jim_AppendObj(interp, resultObjPtr, value[i]);
10964 str += keyLen[i];
10965 strLen -= keyLen[i];
10966 break;
10967 }
10968 }
10969 }
10970 if (i == numMaps) { /* no match */
10971 if (noMatchStart == NULL)
10972 noMatchStart = str;
10973 str ++;
10974 strLen --;
10975 }
10976 }
10977 if (noMatchStart) {
10978 Jim_AppendString(interp, resultObjPtr,
10979 noMatchStart, str-noMatchStart);
10980 }
10981 Jim_Free((void*)key);
10982 Jim_Free(keyLen);
10983 Jim_Free(value);
10984 return resultObjPtr;
10985 }
10986
10987 /* [string] */
10988 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
10989 Jim_Obj *const *argv)
10990 {
10991 int option;
10992 const char *options[] = {
10993 "length", "compare", "match", "equal", "range", "map", "repeat",
10994 "index", "first", "tolower", "toupper", NULL
10995 };
10996 enum {
10997 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
10998 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
10999 };
11000
11001 if (argc < 2) {
11002 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11003 return JIM_ERR;
11004 }
11005 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11006 JIM_ERRMSG) != JIM_OK)
11007 return JIM_ERR;
11008
11009 if (option == OPT_LENGTH) {
11010 int len;
11011
11012 if (argc != 3) {
11013 Jim_WrongNumArgs(interp, 2, argv, "string");
11014 return JIM_ERR;
11015 }
11016 Jim_GetString(argv[2], &len);
11017 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11018 return JIM_OK;
11019 } else if (option == OPT_COMPARE) {
11020 int nocase = 0;
11021 if ((argc != 4 && argc != 5) ||
11022 (argc == 5 && Jim_CompareStringImmediate(interp,
11023 argv[2], "-nocase") == 0)) {
11024 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11025 return JIM_ERR;
11026 }
11027 if (argc == 5) {
11028 nocase = 1;
11029 argv++;
11030 }
11031 Jim_SetResult(interp, Jim_NewIntObj(interp,
11032 Jim_StringCompareObj(argv[2],
11033 argv[3], nocase)));
11034 return JIM_OK;
11035 } else if (option == OPT_MATCH) {
11036 int nocase = 0;
11037 if ((argc != 4 && argc != 5) ||
11038 (argc == 5 && Jim_CompareStringImmediate(interp,
11039 argv[2], "-nocase") == 0)) {
11040 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11041 "string");
11042 return JIM_ERR;
11043 }
11044 if (argc == 5) {
11045 nocase = 1;
11046 argv++;
11047 }
11048 Jim_SetResult(interp,
11049 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11050 argv[3], nocase)));
11051 return JIM_OK;
11052 } else if (option == OPT_EQUAL) {
11053 if (argc != 4) {
11054 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11055 return JIM_ERR;
11056 }
11057 Jim_SetResult(interp,
11058 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11059 argv[3], 0)));
11060 return JIM_OK;
11061 } else if (option == OPT_RANGE) {
11062 Jim_Obj *objPtr;
11063
11064 if (argc != 5) {
11065 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11066 return JIM_ERR;
11067 }
11068 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11069 if (objPtr == NULL)
11070 return JIM_ERR;
11071 Jim_SetResult(interp, objPtr);
11072 return JIM_OK;
11073 } else if (option == OPT_MAP) {
11074 int nocase = 0;
11075 Jim_Obj *objPtr;
11076
11077 if ((argc != 4 && argc != 5) ||
11078 (argc == 5 && Jim_CompareStringImmediate(interp,
11079 argv[2], "-nocase") == 0)) {
11080 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11081 "string");
11082 return JIM_ERR;
11083 }
11084 if (argc == 5) {
11085 nocase = 1;
11086 argv++;
11087 }
11088 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11089 if (objPtr == NULL)
11090 return JIM_ERR;
11091 Jim_SetResult(interp, objPtr);
11092 return JIM_OK;
11093 } else if (option == OPT_REPEAT) {
11094 Jim_Obj *objPtr;
11095 jim_wide count;
11096
11097 if (argc != 4) {
11098 Jim_WrongNumArgs(interp, 2, argv, "string count");
11099 return JIM_ERR;
11100 }
11101 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11102 return JIM_ERR;
11103 objPtr = Jim_NewStringObj(interp, "", 0);
11104 while (count--) {
11105 Jim_AppendObj(interp, objPtr, argv[2]);
11106 }
11107 Jim_SetResult(interp, objPtr);
11108 return JIM_OK;
11109 } else if (option == OPT_INDEX) {
11110 int index, len;
11111 const char *str;
11112
11113 if (argc != 4) {
11114 Jim_WrongNumArgs(interp, 2, argv, "string index");
11115 return JIM_ERR;
11116 }
11117 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11118 return JIM_ERR;
11119 str = Jim_GetString(argv[2], &len);
11120 if (index != INT_MIN && index != INT_MAX)
11121 index = JimRelToAbsIndex(len, index);
11122 if (index < 0 || index >= len) {
11123 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11124 return JIM_OK;
11125 } else {
11126 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11127 return JIM_OK;
11128 }
11129 } else if (option == OPT_FIRST) {
11130 int index = 0, l1, l2;
11131 const char *s1, *s2;
11132
11133 if (argc != 4 && argc != 5) {
11134 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11135 return JIM_ERR;
11136 }
11137 s1 = Jim_GetString(argv[2], &l1);
11138 s2 = Jim_GetString(argv[3], &l2);
11139 if (argc == 5) {
11140 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11141 return JIM_ERR;
11142 index = JimRelToAbsIndex(l2, index);
11143 }
11144 Jim_SetResult(interp, Jim_NewIntObj(interp,
11145 JimStringFirst(s1, l1, s2, l2, index)));
11146 return JIM_OK;
11147 } else if (option == OPT_TOLOWER) {
11148 if (argc != 3) {
11149 Jim_WrongNumArgs(interp, 2, argv, "string");
11150 return JIM_ERR;
11151 }
11152 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11153 } else if (option == OPT_TOUPPER) {
11154 if (argc != 3) {
11155 Jim_WrongNumArgs(interp, 2, argv, "string");
11156 return JIM_ERR;
11157 }
11158 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11159 }
11160 return JIM_OK;
11161 }
11162
11163 /* [time] */
11164 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11165 Jim_Obj *const *argv)
11166 {
11167 long i, count = 1;
11168 jim_wide start, elapsed;
11169 char buf [256];
11170 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11171
11172 if (argc < 2) {
11173 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11174 return JIM_ERR;
11175 }
11176 if (argc == 3) {
11177 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11178 return JIM_ERR;
11179 }
11180 if (count < 0)
11181 return JIM_OK;
11182 i = count;
11183 start = JimClock();
11184 while (i-- > 0) {
11185 int retval;
11186
11187 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11188 return retval;
11189 }
11190 elapsed = JimClock() - start;
11191 sprintf(buf, fmt, elapsed/count);
11192 Jim_SetResultString(interp, buf, -1);
11193 return JIM_OK;
11194 }
11195
11196 /* [exit] */
11197 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11198 Jim_Obj *const *argv)
11199 {
11200 long exitCode = 0;
11201
11202 if (argc > 2) {
11203 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11204 return JIM_ERR;
11205 }
11206 if (argc == 2) {
11207 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11208 return JIM_ERR;
11209 }
11210 interp->exitCode = exitCode;
11211 return JIM_EXIT;
11212 }
11213
11214 /* [catch] */
11215 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11216 Jim_Obj *const *argv)
11217 {
11218 int exitCode = 0;
11219
11220 if (argc != 2 && argc != 3) {
11221 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11222 return JIM_ERR;
11223 }
11224 exitCode = Jim_EvalObj(interp, argv[1]);
11225 if (argc == 3) {
11226 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11227 != JIM_OK)
11228 return JIM_ERR;
11229 }
11230 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11231 return JIM_OK;
11232 }
11233
11234 /* [ref] */
11235 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11236 Jim_Obj *const *argv)
11237 {
11238 if (argc != 3 && argc != 4) {
11239 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11240 return JIM_ERR;
11241 }
11242 if (argc == 3) {
11243 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11244 } else {
11245 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11246 argv[3]));
11247 }
11248 return JIM_OK;
11249 }
11250
11251 /* [getref] */
11252 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11253 Jim_Obj *const *argv)
11254 {
11255 Jim_Reference *refPtr;
11256
11257 if (argc != 2) {
11258 Jim_WrongNumArgs(interp, 1, argv, "reference");
11259 return JIM_ERR;
11260 }
11261 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11262 return JIM_ERR;
11263 Jim_SetResult(interp, refPtr->objPtr);
11264 return JIM_OK;
11265 }
11266
11267 /* [setref] */
11268 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11269 Jim_Obj *const *argv)
11270 {
11271 Jim_Reference *refPtr;
11272
11273 if (argc != 3) {
11274 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11275 return JIM_ERR;
11276 }
11277 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11278 return JIM_ERR;
11279 Jim_IncrRefCount(argv[2]);
11280 Jim_DecrRefCount(interp, refPtr->objPtr);
11281 refPtr->objPtr = argv[2];
11282 Jim_SetResult(interp, argv[2]);
11283 return JIM_OK;
11284 }
11285
11286 /* [collect] */
11287 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11288 Jim_Obj *const *argv)
11289 {
11290 if (argc != 1) {
11291 Jim_WrongNumArgs(interp, 1, argv, "");
11292 return JIM_ERR;
11293 }
11294 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11295 return JIM_OK;
11296 }
11297
11298 /* [finalize] reference ?newValue? */
11299 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11300 Jim_Obj *const *argv)
11301 {
11302 if (argc != 2 && argc != 3) {
11303 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11304 return JIM_ERR;
11305 }
11306 if (argc == 2) {
11307 Jim_Obj *cmdNamePtr;
11308
11309 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11310 return JIM_ERR;
11311 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11312 Jim_SetResult(interp, cmdNamePtr);
11313 } else {
11314 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11315 return JIM_ERR;
11316 Jim_SetResult(interp, argv[2]);
11317 }
11318 return JIM_OK;
11319 }
11320
11321 /* TODO */
11322 /* [info references] (list of all the references/finalizers) */
11323
11324 /* [rename] */
11325 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11326 Jim_Obj *const *argv)
11327 {
11328 const char *oldName, *newName;
11329
11330 if (argc != 3) {
11331 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11332 return JIM_ERR;
11333 }
11334 oldName = Jim_GetString(argv[1], NULL);
11335 newName = Jim_GetString(argv[2], NULL);
11336 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11337 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11338 Jim_AppendStrings(interp, Jim_GetResult(interp),
11339 "can't rename \"", oldName, "\": ",
11340 "command doesn't exist", NULL);
11341 return JIM_ERR;
11342 }
11343 return JIM_OK;
11344 }
11345
11346 /* [dict] */
11347 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11348 Jim_Obj *const *argv)
11349 {
11350 int option;
11351 const char *options[] = {
11352 "create", "get", "set", "unset", "exists", NULL
11353 };
11354 enum {
11355 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11356 };
11357
11358 if (argc < 2) {
11359 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11360 return JIM_ERR;
11361 }
11362
11363 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11364 JIM_ERRMSG) != JIM_OK)
11365 return JIM_ERR;
11366
11367 if (option == OPT_CREATE) {
11368 Jim_Obj *objPtr;
11369
11370 if (argc % 2) {
11371 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11372 return JIM_ERR;
11373 }
11374 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11375 Jim_SetResult(interp, objPtr);
11376 return JIM_OK;
11377 } else if (option == OPT_GET) {
11378 Jim_Obj *objPtr;
11379
11380 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11381 JIM_ERRMSG) != JIM_OK)
11382 return JIM_ERR;
11383 Jim_SetResult(interp, objPtr);
11384 return JIM_OK;
11385 } else if (option == OPT_SET) {
11386 if (argc < 5) {
11387 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11388 return JIM_ERR;
11389 }
11390 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11391 argv[argc-1]);
11392 } else if (option == OPT_UNSET) {
11393 if (argc < 4) {
11394 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11395 return JIM_ERR;
11396 }
11397 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11398 NULL);
11399 } else if (option == OPT_EXIST) {
11400 Jim_Obj *objPtr;
11401 int exists;
11402
11403 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11404 JIM_ERRMSG) == JIM_OK)
11405 exists = 1;
11406 else
11407 exists = 0;
11408 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11409 return JIM_OK;
11410 } else {
11411 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11412 Jim_AppendStrings(interp, Jim_GetResult(interp),
11413 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11414 " must be create, get, set", NULL);
11415 return JIM_ERR;
11416 }
11417 return JIM_OK;
11418 }
11419
11420 /* [load] */
11421 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11422 Jim_Obj *const *argv)
11423 {
11424 if (argc < 2) {
11425 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11426 return JIM_ERR;
11427 }
11428 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11429 }
11430
11431 /* [subst] */
11432 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11433 Jim_Obj *const *argv)
11434 {
11435 int i, flags = 0;
11436 Jim_Obj *objPtr;
11437
11438 if (argc < 2) {
11439 Jim_WrongNumArgs(interp, 1, argv,
11440 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11441 return JIM_ERR;
11442 }
11443 i = argc-2;
11444 while(i--) {
11445 if (Jim_CompareStringImmediate(interp, argv[i+1],
11446 "-nobackslashes"))
11447 flags |= JIM_SUBST_NOESC;
11448 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11449 "-novariables"))
11450 flags |= JIM_SUBST_NOVAR;
11451 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11452 "-nocommands"))
11453 flags |= JIM_SUBST_NOCMD;
11454 else {
11455 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11456 Jim_AppendStrings(interp, Jim_GetResult(interp),
11457 "bad option \"", Jim_GetString(argv[i+1], NULL),
11458 "\": must be -nobackslashes, -nocommands, or "
11459 "-novariables", NULL);
11460 return JIM_ERR;
11461 }
11462 }
11463 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11464 return JIM_ERR;
11465 Jim_SetResult(interp, objPtr);
11466 return JIM_OK;
11467 }
11468
11469 /* [info] */
11470 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11471 Jim_Obj *const *argv)
11472 {
11473 int cmd, result = JIM_OK;
11474 static const char *commands[] = {
11475 "body", "commands", "exists", "globals", "level", "locals",
11476 "vars", "version", "complete", "args", NULL
11477 };
11478 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11479 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS};
11480
11481 if (argc < 2) {
11482 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11483 return JIM_ERR;
11484 }
11485 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11486 != JIM_OK) {
11487 return JIM_ERR;
11488 }
11489
11490 if (cmd == INFO_COMMANDS) {
11491 if (argc != 2 && argc != 3) {
11492 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11493 return JIM_ERR;
11494 }
11495 if (argc == 3)
11496 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11497 else
11498 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11499 } else if (cmd == INFO_EXISTS) {
11500 Jim_Obj *exists;
11501 if (argc != 3) {
11502 Jim_WrongNumArgs(interp, 2, argv, "varName");
11503 return JIM_ERR;
11504 }
11505 exists = Jim_GetVariable(interp, argv[2], 0);
11506 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11507 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11508 int mode;
11509 switch (cmd) {
11510 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11511 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11512 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11513 default: mode = 0; /* avoid warning */; break;
11514 }
11515 if (argc != 2 && argc != 3) {
11516 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11517 return JIM_ERR;
11518 }
11519 if (argc == 3)
11520 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11521 else
11522 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11523 } else if (cmd == INFO_LEVEL) {
11524 Jim_Obj *objPtr;
11525 switch (argc) {
11526 case 2:
11527 Jim_SetResult(interp,
11528 Jim_NewIntObj(interp, interp->numLevels));
11529 break;
11530 case 3:
11531 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11532 return JIM_ERR;
11533 Jim_SetResult(interp, objPtr);
11534 break;
11535 default:
11536 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11537 return JIM_ERR;
11538 }
11539 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11540 Jim_Cmd *cmdPtr;
11541
11542 if (argc != 3) {
11543 Jim_WrongNumArgs(interp, 2, argv, "procname");
11544 return JIM_ERR;
11545 }
11546 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11547 return JIM_ERR;
11548 if (cmdPtr->cmdProc != NULL) {
11549 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11550 Jim_AppendStrings(interp, Jim_GetResult(interp),
11551 "command \"", Jim_GetString(argv[2], NULL),
11552 "\" is not a procedure", NULL);
11553 return JIM_ERR;
11554 }
11555 if (cmd == INFO_BODY)
11556 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11557 else
11558 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11559 } else if (cmd == INFO_VERSION) {
11560 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11561 sprintf(buf, "%d.%d",
11562 JIM_VERSION / 100, JIM_VERSION % 100);
11563 Jim_SetResultString(interp, buf, -1);
11564 } else if (cmd == INFO_COMPLETE) {
11565 const char *s;
11566 int len;
11567
11568 if (argc != 3) {
11569 Jim_WrongNumArgs(interp, 2, argv, "script");
11570 return JIM_ERR;
11571 }
11572 s = Jim_GetString(argv[2], &len);
11573 Jim_SetResult(interp,
11574 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11575 }
11576 return result;
11577 }
11578
11579 /* [split] */
11580 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11581 Jim_Obj *const *argv)
11582 {
11583 const char *str, *splitChars, *noMatchStart;
11584 int splitLen, strLen, i;
11585 Jim_Obj *resObjPtr;
11586
11587 if (argc != 2 && argc != 3) {
11588 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11589 return JIM_ERR;
11590 }
11591 /* Init */
11592 if (argc == 2) {
11593 splitChars = " \n\t\r";
11594 splitLen = 4;
11595 } else {
11596 splitChars = Jim_GetString(argv[2], &splitLen);
11597 }
11598 str = Jim_GetString(argv[1], &strLen);
11599 if (!strLen) return JIM_OK;
11600 noMatchStart = str;
11601 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11602 /* Split */
11603 if (splitLen) {
11604 while (strLen) {
11605 for (i = 0; i < splitLen; i++) {
11606 if (*str == splitChars[i]) {
11607 Jim_Obj *objPtr;
11608
11609 objPtr = Jim_NewStringObj(interp, noMatchStart,
11610 (str-noMatchStart));
11611 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11612 noMatchStart = str+1;
11613 break;
11614 }
11615 }
11616 str ++;
11617 strLen --;
11618 }
11619 Jim_ListAppendElement(interp, resObjPtr,
11620 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11621 } else {
11622 /* This handles the special case of splitchars eq {}. This
11623 * is trivial but we want to perform object sharing as Tcl does. */
11624 Jim_Obj *objCache[256];
11625 const unsigned char *u = (unsigned char*) str;
11626 memset(objCache, 0, sizeof(objCache));
11627 for (i = 0; i < strLen; i++) {
11628 int c = u[i];
11629
11630 if (objCache[c] == NULL)
11631 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11632 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11633 }
11634 }
11635 Jim_SetResult(interp, resObjPtr);
11636 return JIM_OK;
11637 }
11638
11639 /* [join] */
11640 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11641 Jim_Obj *const *argv)
11642 {
11643 const char *joinStr;
11644 int joinStrLen, i, listLen;
11645 Jim_Obj *resObjPtr;
11646
11647 if (argc != 2 && argc != 3) {
11648 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11649 return JIM_ERR;
11650 }
11651 /* Init */
11652 if (argc == 2) {
11653 joinStr = " ";
11654 joinStrLen = 1;
11655 } else {
11656 joinStr = Jim_GetString(argv[2], &joinStrLen);
11657 }
11658 Jim_ListLength(interp, argv[1], &listLen);
11659 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11660 /* Split */
11661 for (i = 0; i < listLen; i++) {
11662 Jim_Obj *objPtr;
11663
11664 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11665 Jim_AppendObj(interp, resObjPtr, objPtr);
11666 if (i+1 != listLen) {
11667 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11668 }
11669 }
11670 Jim_SetResult(interp, resObjPtr);
11671 return JIM_OK;
11672 }
11673
11674 /* [format] */
11675 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11676 Jim_Obj *const *argv)
11677 {
11678 Jim_Obj *objPtr;
11679
11680 if (argc < 2) {
11681 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11682 return JIM_ERR;
11683 }
11684 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11685 if (objPtr == NULL)
11686 return JIM_ERR;
11687 Jim_SetResult(interp, objPtr);
11688 return JIM_OK;
11689 }
11690
11691 /* [scan] */
11692 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11693 Jim_Obj *const *argv)
11694 {
11695 Jim_Obj *listPtr, **outVec;
11696 int outc, i, count = 0;
11697
11698 if (argc < 3) {
11699 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11700 return JIM_ERR;
11701 }
11702 if (argv[2]->typePtr != &scanFmtStringObjType)
11703 SetScanFmtFromAny(interp, argv[2]);
11704 if (FormatGetError(argv[2]) != 0) {
11705 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11706 return JIM_ERR;
11707 }
11708 if (argc > 3) {
11709 int maxPos = FormatGetMaxPos(argv[2]);
11710 int count = FormatGetCnvCount(argv[2]);
11711 if (maxPos > argc-3) {
11712 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11713 return JIM_ERR;
11714 } else if (count != 0 && count < argc-3) {
11715 Jim_SetResultString(interp, "variable is not assigned by any "
11716 "conversion specifiers", -1);
11717 return JIM_ERR;
11718 } else if (count > argc-3) {
11719 Jim_SetResultString(interp, "different numbers of variable names and "
11720 "field specifiers", -1);
11721 return JIM_ERR;
11722 }
11723 }
11724 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11725 if (listPtr == 0)
11726 return JIM_ERR;
11727 if (argc > 3) {
11728 int len = 0;
11729 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11730 Jim_ListLength(interp, listPtr, &len);
11731 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11732 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11733 return JIM_OK;
11734 }
11735 JimListGetElements(interp, listPtr, &outc, &outVec);
11736 for (i = 0; i < outc; ++i) {
11737 if (Jim_Length(outVec[i]) > 0) {
11738 ++count;
11739 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11740 goto err;
11741 }
11742 }
11743 Jim_FreeNewObj(interp, listPtr);
11744 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11745 } else {
11746 if (listPtr == (Jim_Obj*)EOF) {
11747 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11748 return JIM_OK;
11749 }
11750 Jim_SetResult(interp, listPtr);
11751 }
11752 return JIM_OK;
11753 err:
11754 Jim_FreeNewObj(interp, listPtr);
11755 return JIM_ERR;
11756 }
11757
11758 /* [error] */
11759 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11760 Jim_Obj *const *argv)
11761 {
11762 if (argc != 2) {
11763 Jim_WrongNumArgs(interp, 1, argv, "message");
11764 return JIM_ERR;
11765 }
11766 Jim_SetResult(interp, argv[1]);
11767 return JIM_ERR;
11768 }
11769
11770 /* [lrange] */
11771 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11772 Jim_Obj *const *argv)
11773 {
11774 Jim_Obj *objPtr;
11775
11776 if (argc != 4) {
11777 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11778 return JIM_ERR;
11779 }
11780 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11781 return JIM_ERR;
11782 Jim_SetResult(interp, objPtr);
11783 return JIM_OK;
11784 }
11785
11786 /* [env] */
11787 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11788 Jim_Obj *const *argv)
11789 {
11790 const char *key;
11791 char *val;
11792
11793 if (argc != 2) {
11794 Jim_WrongNumArgs(interp, 1, argv, "varName");
11795 return JIM_ERR;
11796 }
11797 key = Jim_GetString(argv[1], NULL);
11798 val = getenv(key);
11799 if (val == NULL) {
11800 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11801 Jim_AppendStrings(interp, Jim_GetResult(interp),
11802 "environment variable \"",
11803 key, "\" does not exist", NULL);
11804 return JIM_ERR;
11805 }
11806 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
11807 return JIM_OK;
11808 }
11809
11810 /* [source] */
11811 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
11812 Jim_Obj *const *argv)
11813 {
11814 int retval;
11815
11816 if (argc != 2) {
11817 Jim_WrongNumArgs(interp, 1, argv, "fileName");
11818 return JIM_ERR;
11819 }
11820 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
11821 if (retval == JIM_RETURN)
11822 return JIM_OK;
11823 return retval;
11824 }
11825
11826 /* [lreverse] */
11827 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
11828 Jim_Obj *const *argv)
11829 {
11830 Jim_Obj *revObjPtr, **ele;
11831 int len;
11832
11833 if (argc != 2) {
11834 Jim_WrongNumArgs(interp, 1, argv, "list");
11835 return JIM_ERR;
11836 }
11837 JimListGetElements(interp, argv[1], &len, &ele);
11838 len--;
11839 revObjPtr = Jim_NewListObj(interp, NULL, 0);
11840 while (len >= 0)
11841 ListAppendElement(revObjPtr, ele[len--]);
11842 Jim_SetResult(interp, revObjPtr);
11843 return JIM_OK;
11844 }
11845
11846 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
11847 {
11848 jim_wide len;
11849
11850 if (step == 0) return -1;
11851 if (start == end) return 0;
11852 else if (step > 0 && start > end) return -1;
11853 else if (step < 0 && end > start) return -1;
11854 len = end-start;
11855 if (len < 0) len = -len; /* abs(len) */
11856 if (step < 0) step = -step; /* abs(step) */
11857 len = 1 + ((len-1)/step);
11858 /* We can truncate safely to INT_MAX, the range command
11859 * will always return an error for a such long range
11860 * because Tcl lists can't be so long. */
11861 if (len > INT_MAX) len = INT_MAX;
11862 return (int)((len < 0) ? -1 : len);
11863 }
11864
11865 /* [range] */
11866 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
11867 Jim_Obj *const *argv)
11868 {
11869 jim_wide start = 0, end, step = 1;
11870 int len, i;
11871 Jim_Obj *objPtr;
11872
11873 if (argc < 2 || argc > 4) {
11874 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
11875 return JIM_ERR;
11876 }
11877 if (argc == 2) {
11878 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
11879 return JIM_ERR;
11880 } else {
11881 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
11882 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
11883 return JIM_ERR;
11884 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
11885 return JIM_ERR;
11886 }
11887 if ((len = JimRangeLen(start, end, step)) == -1) {
11888 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
11889 return JIM_ERR;
11890 }
11891 objPtr = Jim_NewListObj(interp, NULL, 0);
11892 for (i = 0; i < len; i++)
11893 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
11894 Jim_SetResult(interp, objPtr);
11895 return JIM_OK;
11896 }
11897
11898 /* [rand] */
11899 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
11900 Jim_Obj *const *argv)
11901 {
11902 jim_wide min = 0, max, len, maxMul;
11903
11904 if (argc < 1 || argc > 3) {
11905 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
11906 return JIM_ERR;
11907 }
11908 if (argc == 1) {
11909 max = JIM_WIDE_MAX;
11910 } else if (argc == 2) {
11911 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
11912 return JIM_ERR;
11913 } else if (argc == 3) {
11914 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
11915 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
11916 return JIM_ERR;
11917 }
11918 len = max-min;
11919 if (len < 0) {
11920 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
11921 return JIM_ERR;
11922 }
11923 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
11924 while (1) {
11925 jim_wide r;
11926
11927 JimRandomBytes(interp, &r, sizeof(jim_wide));
11928 if (r < 0 || r >= maxMul) continue;
11929 r = (len == 0) ? 0 : r%len;
11930 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
11931 return JIM_OK;
11932 }
11933 }
11934
11935 /* [package] */
11936 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
11937 Jim_Obj *const *argv)
11938 {
11939 int option;
11940 const char *options[] = {
11941 "require", "provide", NULL
11942 };
11943 enum {OPT_REQUIRE, OPT_PROVIDE};
11944
11945 if (argc < 2) {
11946 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11947 return JIM_ERR;
11948 }
11949 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11950 JIM_ERRMSG) != JIM_OK)
11951 return JIM_ERR;
11952
11953 if (option == OPT_REQUIRE) {
11954 int exact = 0;
11955 const char *ver;
11956
11957 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
11958 exact = 1;
11959 argv++;
11960 argc--;
11961 }
11962 if (argc != 3 && argc != 4) {
11963 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
11964 return JIM_ERR;
11965 }
11966 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
11967 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
11968 JIM_ERRMSG);
11969 if (ver == NULL)
11970 return JIM_ERR;
11971 Jim_SetResultString(interp, ver, -1);
11972 } else if (option == OPT_PROVIDE) {
11973 if (argc != 4) {
11974 Jim_WrongNumArgs(interp, 2, argv, "package version");
11975 return JIM_ERR;
11976 }
11977 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
11978 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
11979 }
11980 return JIM_OK;
11981 }
11982
11983 static struct {
11984 const char *name;
11985 Jim_CmdProc cmdProc;
11986 } Jim_CoreCommandsTable[] = {
11987 {"set", Jim_SetCoreCommand},
11988 {"unset", Jim_UnsetCoreCommand},
11989 {"puts", Jim_PutsCoreCommand},
11990 {"+", Jim_AddCoreCommand},
11991 {"*", Jim_MulCoreCommand},
11992 {"-", Jim_SubCoreCommand},
11993 {"/", Jim_DivCoreCommand},
11994 {"incr", Jim_IncrCoreCommand},
11995 {"while", Jim_WhileCoreCommand},
11996 {"for", Jim_ForCoreCommand},
11997 {"foreach", Jim_ForeachCoreCommand},
11998 {"lmap", Jim_LmapCoreCommand},
11999 {"if", Jim_IfCoreCommand},
12000 {"switch", Jim_SwitchCoreCommand},
12001 {"list", Jim_ListCoreCommand},
12002 {"lindex", Jim_LindexCoreCommand},
12003 {"lset", Jim_LsetCoreCommand},
12004 {"llength", Jim_LlengthCoreCommand},
12005 {"lappend", Jim_LappendCoreCommand},
12006 {"linsert", Jim_LinsertCoreCommand},
12007 {"lsort", Jim_LsortCoreCommand},
12008 {"append", Jim_AppendCoreCommand},
12009 {"debug", Jim_DebugCoreCommand},
12010 {"eval", Jim_EvalCoreCommand},
12011 {"uplevel", Jim_UplevelCoreCommand},
12012 {"expr", Jim_ExprCoreCommand},
12013 {"break", Jim_BreakCoreCommand},
12014 {"continue", Jim_ContinueCoreCommand},
12015 {"proc", Jim_ProcCoreCommand},
12016 {"concat", Jim_ConcatCoreCommand},
12017 {"return", Jim_ReturnCoreCommand},
12018 {"upvar", Jim_UpvarCoreCommand},
12019 {"global", Jim_GlobalCoreCommand},
12020 {"string", Jim_StringCoreCommand},
12021 {"time", Jim_TimeCoreCommand},
12022 {"exit", Jim_ExitCoreCommand},
12023 {"catch", Jim_CatchCoreCommand},
12024 {"ref", Jim_RefCoreCommand},
12025 {"getref", Jim_GetrefCoreCommand},
12026 {"setref", Jim_SetrefCoreCommand},
12027 {"finalize", Jim_FinalizeCoreCommand},
12028 {"collect", Jim_CollectCoreCommand},
12029 {"rename", Jim_RenameCoreCommand},
12030 {"dict", Jim_DictCoreCommand},
12031 {"load", Jim_LoadCoreCommand},
12032 {"subst", Jim_SubstCoreCommand},
12033 {"info", Jim_InfoCoreCommand},
12034 {"split", Jim_SplitCoreCommand},
12035 {"join", Jim_JoinCoreCommand},
12036 {"format", Jim_FormatCoreCommand},
12037 {"scan", Jim_ScanCoreCommand},
12038 {"error", Jim_ErrorCoreCommand},
12039 {"lrange", Jim_LrangeCoreCommand},
12040 {"env", Jim_EnvCoreCommand},
12041 {"source", Jim_SourceCoreCommand},
12042 {"lreverse", Jim_LreverseCoreCommand},
12043 {"range", Jim_RangeCoreCommand},
12044 {"rand", Jim_RandCoreCommand},
12045 {"package", Jim_PackageCoreCommand},
12046 {"tailcall", Jim_TailcallCoreCommand},
12047 {NULL, NULL},
12048 };
12049
12050 /* Some Jim core command is actually a procedure written in Jim itself. */
12051 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12052 {
12053 Jim_Eval(interp, (char*)
12054 "proc lambda {arglist args} {\n"
12055 " set name [ref {} function lambdaFinalizer]\n"
12056 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12057 " return $name\n"
12058 "}\n"
12059 "proc lambdaFinalizer {name val} {\n"
12060 " rename $name {}\n"
12061 "}\n"
12062 );
12063 }
12064
12065 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12066 {
12067 int i = 0;
12068
12069 while(Jim_CoreCommandsTable[i].name != NULL) {
12070 Jim_CreateCommand(interp,
12071 Jim_CoreCommandsTable[i].name,
12072 Jim_CoreCommandsTable[i].cmdProc,
12073 NULL, NULL);
12074 i++;
12075 }
12076 Jim_RegisterCoreProcedures(interp);
12077 }
12078
12079 /* -----------------------------------------------------------------------------
12080 * Interactive prompt
12081 * ---------------------------------------------------------------------------*/
12082 void Jim_PrintErrorMessage(Jim_Interp *interp)
12083 {
12084 int len, i;
12085
12086 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL,
12087 interp->errorFileName, interp->errorLine);
12088 Jim_fprintf(interp,interp->cookie_stderr, " %s" JIM_NL,
12089 Jim_GetString(interp->result, NULL));
12090 Jim_ListLength(interp, interp->stackTrace, &len);
12091 for (i = len-3; i >= 0; i-= 3) {
12092 Jim_Obj *objPtr;
12093 const char *proc, *file, *line;
12094
12095 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12096 proc = Jim_GetString(objPtr, NULL);
12097 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12098 JIM_NONE);
12099 file = Jim_GetString(objPtr, NULL);
12100 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12101 JIM_NONE);
12102 line = Jim_GetString(objPtr, NULL);
12103 Jim_fprintf( interp, interp->cookie_stderr,
12104 "In procedure '%s' called at file \"%s\", line %s" JIM_NL,
12105 proc, file, line);
12106 }
12107 }
12108
12109 int Jim_InteractivePrompt(Jim_Interp *interp)
12110 {
12111 int retcode = JIM_OK;
12112 Jim_Obj *scriptObjPtr;
12113
12114 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12115 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12116 JIM_VERSION / 100, JIM_VERSION % 100);
12117 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12118 while (1) {
12119 char buf[1024];
12120 const char *result;
12121 const char *retcodestr[] = {
12122 "ok", "error", "return", "break", "continue", "eval", "exit"
12123 };
12124 int reslen;
12125
12126 if (retcode != 0) {
12127 if (retcode >= 2 && retcode <= 6)
12128 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12129 else
12130 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12131 } else
12132 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12133 Jim_fflush( interp, interp->cookie_stdout);
12134 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12135 Jim_IncrRefCount(scriptObjPtr);
12136 while(1) {
12137 const char *str;
12138 char state;
12139 int len;
12140
12141 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12142 Jim_DecrRefCount(interp, scriptObjPtr);
12143 goto out;
12144 }
12145 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12146 str = Jim_GetString(scriptObjPtr, &len);
12147 if (Jim_ScriptIsComplete(str, len, &state))
12148 break;
12149 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12150 Jim_fflush( interp, interp->cookie_stdout);
12151 }
12152 retcode = Jim_EvalObj(interp, scriptObjPtr);
12153 Jim_DecrRefCount(interp, scriptObjPtr);
12154 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12155 if (retcode == JIM_ERR) {
12156 Jim_PrintErrorMessage(interp);
12157 } else if (retcode == JIM_EXIT) {
12158 exit(Jim_GetExitCode(interp));
12159 } else {
12160 if (reslen) {
12161 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12162 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12163 }
12164 }
12165 }
12166 out:
12167 return 0;
12168 }
12169
12170 /* -----------------------------------------------------------------------------
12171 * Jim's idea of STDIO..
12172 * ---------------------------------------------------------------------------*/
12173
12174 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12175 {
12176 int r;
12177
12178 va_list ap;
12179 va_start(ap,fmt);
12180 r = Jim_vfprintf( interp, cookie, fmt,ap );
12181 va_end(ap);
12182 return r;
12183 }
12184
12185 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12186 {
12187 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12188 errno = ENOTSUP;
12189 return -1;
12190 }
12191 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12192 }
12193
12194 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12195 {
12196 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12197 errno = ENOTSUP;
12198 return 0;
12199 }
12200 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12201 }
12202
12203 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12204 {
12205 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12206 errno = ENOTSUP;
12207 return 0;
12208 }
12209 return (*(interp->cb_fread))( ptr, size, n, cookie);
12210 }
12211
12212 int Jim_fflush( Jim_Interp *interp, void *cookie )
12213 {
12214 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12215 /* pretend all is well */
12216 return 0;
12217 }
12218 return (*(interp->cb_fflush))( cookie );
12219 }
12220
12221 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12222 {
12223 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12224 errno = ENOTSUP;
12225 return NULL;
12226 }
12227 return (*(interp->cb_fgets))( s, size, cookie );
12228 }
12229
12230 Jim_Nvp *
12231 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12232 {
12233 while( p->name ){
12234 if( 0 == strcmp( name, p->name ) ){
12235 break;
12236 }
12237 p++;
12238 }
12239 return ((Jim_Nvp *)(p));
12240 }
12241
12242 Jim_Nvp *
12243 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12244 {
12245 while( p->name ){
12246 if( 0 == strcasecmp( name, p->name ) ){
12247 break;
12248 }
12249 p++;
12250 }
12251 return ((Jim_Nvp *)(p));
12252 }
12253
12254 int
12255 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12256 const Jim_Nvp *p,
12257 Jim_Obj *o,
12258 Jim_Nvp **result )
12259 {
12260 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12261 }
12262
12263
12264 int
12265 Jim_Nvp_name2value( Jim_Interp *interp,
12266 const Jim_Nvp *_p,
12267 const char *name,
12268 Jim_Nvp **result)
12269 {
12270 const Jim_Nvp *p;
12271
12272 p = Jim_Nvp_name2value_simple( _p, name );
12273
12274 /* result */
12275 if( result ){
12276 *result = (Jim_Nvp *)(p);
12277 }
12278
12279 /* found? */
12280 if( p->name ){
12281 return JIM_OK;
12282 } else {
12283 return JIM_ERR;
12284 }
12285 }
12286
12287 int
12288 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12289 {
12290 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12291 }
12292
12293 int
12294 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12295 {
12296 const Jim_Nvp *p;
12297
12298 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12299
12300 if( puthere ){
12301 *puthere = (Jim_Nvp *)(p);
12302 }
12303 /* found */
12304 if( p->name ){
12305 return JIM_OK;
12306 } else {
12307 return JIM_ERR;
12308 }
12309 }
12310
12311
12312 int
12313 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12314 {
12315 int e;;
12316 jim_wide w;
12317
12318 e = Jim_GetWide( interp, o, &w );
12319 if( e != JIM_OK ){
12320 return e;
12321 }
12322
12323 return Jim_Nvp_value2name( interp, p, w, result );
12324 }
12325
12326 Jim_Nvp *
12327 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12328 {
12329 while( p->name ){
12330 if( value == p->value ){
12331 break;
12332 }
12333 p++;
12334 }
12335 return ((Jim_Nvp *)(p));
12336 }
12337
12338
12339 int
12340 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12341 {
12342 const Jim_Nvp *p;
12343
12344 p = Jim_Nvp_value2name_simple( _p, value );
12345
12346 if( result ){
12347 *result = (Jim_Nvp *)(p);
12348 }
12349
12350 if( p->name ){
12351 return JIM_OK;
12352 } else {
12353 return JIM_ERR;
12354 }
12355 }
12356
12357
12358 int
12359 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12360 {
12361 memset( p, 0, sizeof(*p) );
12362 p->interp = interp;
12363 p->argc = argc;
12364 p->argv = argv;
12365
12366 return JIM_OK;
12367 }
12368
12369 void
12370 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12371 {
12372 int x;
12373
12374 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12375 for( x = 0 ; x < p->argc ; x++ ){
12376 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12377 "%2d) %s\n",
12378 x,
12379 Jim_GetString( p->argv[x], NULL ) );
12380 }
12381 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12382 }
12383
12384
12385 int
12386 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12387 {
12388 Jim_Obj *o;
12389
12390 o = NULL; // failure
12391 if( goi->argc ){
12392 // success
12393 o = goi->argv[0];
12394 goi->argc -= 1;
12395 goi->argv += 1;
12396 }
12397 if( puthere ){
12398 *puthere = o;
12399 }
12400 if( o != NULL ){
12401 return JIM_OK;
12402 } else {
12403 return JIM_ERR;
12404 }
12405 }
12406
12407 int
12408 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12409 {
12410 int r;
12411 Jim_Obj *o;
12412 const char *cp;
12413
12414
12415 r = Jim_GetOpt_Obj( goi, &o );
12416 if( r == JIM_OK ){
12417 cp = Jim_GetString( o, len );
12418 if( puthere ){
12419 /* remove const */
12420 *puthere = (char *)(cp);
12421 }
12422 }
12423 return r;
12424 }
12425
12426 int
12427 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12428 {
12429 int r;
12430 Jim_Obj *o;
12431 double _safe;
12432
12433 if( puthere == NULL ){
12434 puthere = &_safe;
12435 }
12436
12437 r = Jim_GetOpt_Obj( goi, &o );
12438 if( r == JIM_OK ){
12439 r = Jim_GetDouble( goi->interp, o, puthere );
12440 if( r != JIM_OK ){
12441 Jim_SetResult_sprintf( goi->interp,
12442 "not a number: %s",
12443 Jim_GetString( o, NULL ) );
12444 }
12445 }
12446 return r;
12447 }
12448
12449 int
12450 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12451 {
12452 int r;
12453 Jim_Obj *o;
12454 jim_wide _safe;
12455
12456 if( puthere == NULL ){
12457 puthere = &_safe;
12458 }
12459
12460 r = Jim_GetOpt_Obj( goi, &o );
12461 if( r == JIM_OK ){
12462 r = Jim_GetWide( goi->interp, o, puthere );
12463 }
12464 return r;
12465 }
12466
12467 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12468 const Jim_Nvp *nvp,
12469 Jim_Nvp **puthere)
12470 {
12471 Jim_Nvp *_safe;
12472 Jim_Obj *o;
12473 int e;
12474
12475 if( puthere == NULL ){
12476 puthere = &_safe;
12477 }
12478
12479 e = Jim_GetOpt_Obj( goi, &o );
12480 if( e == JIM_OK ){
12481 e = Jim_Nvp_name2value_obj( goi->interp,
12482 nvp,
12483 o,
12484 puthere );
12485 }
12486
12487 return e;
12488 }
12489
12490 void
12491 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12492 const Jim_Nvp *nvptable,
12493 int hadprefix )
12494 {
12495 if( hadprefix ){
12496 Jim_SetResult_NvpUnknown( goi->interp,
12497 goi->argv[-2],
12498 goi->argv[-1],
12499 nvptable );
12500 } else {
12501 Jim_SetResult_NvpUnknown( goi->interp,
12502 NULL,
12503 goi->argv[-1],
12504 nvptable );
12505 }
12506 }
12507
12508
12509 int
12510 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12511 const char * const * lookup,
12512 int *puthere)
12513 {
12514 int _safe;
12515 Jim_Obj *o;
12516 int e;
12517
12518 if( puthere == NULL ){
12519 puthere = &_safe;
12520 }
12521 e = Jim_GetOpt_Obj( goi, &o );
12522 if( e == JIM_OK ){
12523 e = Jim_GetEnum( goi->interp,
12524 o,
12525 lookup,
12526 puthere,
12527 "option",
12528 JIM_ERRMSG );
12529 }
12530 return e;
12531 }
12532
12533
12534
12535 int
12536 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12537 {
12538 va_list ap;
12539 #ifndef HAVE_VASPRINTF
12540 /* yucky way */
12541 char buf[2048];
12542
12543 va_start(ap,fmt);
12544 vsnprintf( buf, sizeof(buf), fmt, ap );
12545 va_end(ap);
12546 /* garentee termination */
12547 buf[2047] = 0;
12548 Jim_SetResultString( interp, buf, -1 );
12549
12550 #else
12551 char *buf;
12552 va_start(ap,fmt);
12553 vasprintf( &buf, fmt, ap );
12554 va_end(ap);
12555 if( buf ){
12556 Jim_SetResultString( interp, buf, -1 );
12557 free(buf);
12558 }
12559 #endif
12560 return JIM_OK;
12561 }
12562
12563
12564 void
12565 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12566 Jim_Obj *param_name,
12567 Jim_Obj *param_value,
12568 const Jim_Nvp *nvp )
12569 {
12570 if( param_name ){
12571 Jim_SetResult_sprintf( interp,
12572 "%s: Unknown: %s, try one of: ",
12573 Jim_GetString( param_name, NULL ),
12574 Jim_GetString( param_value, NULL ) );
12575 } else {
12576 Jim_SetResult_sprintf( interp,
12577 "Unknown param: %s, try one of: ",
12578 Jim_GetString( param_value, NULL ) );
12579 }
12580 while( nvp->name ){
12581 const char *a;
12582 const char *b;
12583
12584 if( (nvp+1)->name ){
12585 a = nvp->name;
12586 b = ", ";
12587 } else {
12588 a = "or ";
12589 b = nvp->name;
12590 }
12591 Jim_AppendStrings( interp,
12592 Jim_GetResult(interp),
12593 a, b, NULL );
12594 nvp++;
12595 }
12596 }
12597
12598
12599 static Jim_Obj *debug_string_obj;
12600
12601 const char *
12602 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12603 {
12604 int x;
12605
12606 if( debug_string_obj ){
12607 Jim_FreeObj( interp, debug_string_obj );
12608 }
12609
12610 debug_string_obj = Jim_NewEmptyStringObj( interp );
12611 for( x = 0 ; x < argc ; x++ ){
12612 Jim_AppendStrings( interp,
12613 debug_string_obj,
12614 Jim_GetString( argv[x], NULL ),
12615 " ",
12616 NULL );
12617 }
12618
12619 return Jim_GetString( debug_string_obj, NULL );
12620 }
12621
12622
12623
12624 /*
12625 * Local Variables: ***
12626 * c-basic-offset: 4 ***
12627 * tab-width: 4 ***
12628 * End: ***
12629 */

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)