jim license cleanup
[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 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2177 int objc, Jim_Obj *const *objv)
2178 {
2179 const char *fmt, *_fmt;
2180 int fmtLen;
2181 Jim_Obj *resObjPtr;
2182
2183
2184 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2185 _fmt = fmt;
2186 resObjPtr = Jim_NewStringObj(interp, "", 0);
2187 while (fmtLen) {
2188 const char *p = fmt;
2189 char spec[2], c;
2190 jim_wide wideValue;
2191 double doubleValue;
2192 /* we cheat and use Sprintf()! */
2193 #define JIM_MAX_FMT 2048
2194 char sprintf_buf[JIM_MAX_FMT];
2195 char fmt_str[100];
2196 char *cp;
2197 int width;
2198 int ljust;
2199 int zpad;
2200 int spad;
2201 int altfm;
2202 int forceplus;
2203 int prec;
2204 int inprec;
2205 int haveprec;
2206 int accum;
2207
2208 while (*fmt != '%' && fmtLen) {
2209 fmt++; fmtLen--;
2210 }
2211 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2212 if (fmtLen == 0)
2213 break;
2214 fmt++; fmtLen--; /* skip '%' */
2215 zpad = 0;
2216 spad = 0;
2217 width = -1;
2218 ljust = 0;
2219 altfm = 0;
2220 forceplus = 0;
2221 inprec = 0;
2222 haveprec = 0;
2223 prec = -1; /* not found yet */
2224 next_fmt:
2225 if( fmtLen <= 0 ){
2226 break;
2227 }
2228 switch( *fmt ){
2229 /* terminals */
2230 case 'b': /* binary - not all printfs() do this */
2231 case 's': /* string */
2232 case 'i': /* integer */
2233 case 'd': /* decimal */
2234 case 'x': /* hex */
2235 case 'X': /* CAP hex */
2236 case 'c': /* char */
2237 case 'o': /* octal */
2238 case 'u': /* unsigned */
2239 case 'f': /* float */
2240 break;
2241
2242 /* non-terminals */
2243 case '0': /* zero pad */
2244 zpad = 1;
2245 *fmt++; fmtLen--;
2246 goto next_fmt;
2247 break;
2248 case '+':
2249 forceplus = 1;
2250 *fmt++; fmtLen--;
2251 goto next_fmt;
2252 break;
2253 case ' ': /* sign space */
2254 spad = 1;
2255 *fmt++; fmtLen--;
2256 goto next_fmt;
2257 break;
2258 case '-':
2259 ljust = 1;
2260 *fmt++; fmtLen--;
2261 goto next_fmt;
2262 break;
2263 case '#':
2264 altfm = 1;
2265 *fmt++; fmtLen--;
2266 goto next_fmt;
2267
2268 case '.':
2269 inprec = 1;
2270 *fmt++; fmtLen--;
2271 goto next_fmt;
2272 break;
2273 case '1':
2274 case '2':
2275 case '3':
2276 case '4':
2277 case '5':
2278 case '6':
2279 case '7':
2280 case '8':
2281 case '9':
2282 accum = 0;
2283 while( isdigit(*fmt) && (fmtLen > 0) ){
2284 accum = (accum * 10) + (*fmt - '0');
2285 fmt++; fmtLen--;
2286 }
2287 if( inprec ){
2288 haveprec = 1;
2289 prec = accum;
2290 } else {
2291 width = accum;
2292 }
2293 goto next_fmt;
2294 case '*':
2295 /* suck up the next item as an integer */
2296 *fmt++; fmtLen--;
2297 objc--;
2298 if( objc <= 0 ){
2299 goto not_enough_args;
2300 }
2301 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2302 Jim_FreeNewObj(interp, resObjPtr );
2303 return NULL;
2304 }
2305 if( inprec ){
2306 haveprec = 1;
2307 prec = wideValue;
2308 if( prec < 0 ){
2309 /* man 3 printf says */
2310 /* if prec is negative, it is zero */
2311 prec = 0;
2312 }
2313 } else {
2314 width = wideValue;
2315 if( width < 0 ){
2316 ljust = 1;
2317 width = -width;
2318 }
2319 }
2320 objv++;
2321 goto next_fmt;
2322 break;
2323 }
2324
2325
2326 if (*fmt != '%') {
2327 if (objc == 0) {
2328 not_enough_args:
2329 Jim_FreeNewObj(interp, resObjPtr);
2330 Jim_SetResultString(interp,
2331 "not enough arguments for all format specifiers", -1);
2332 return NULL;
2333 } else {
2334 objc--;
2335 }
2336 }
2337
2338 /*
2339 * Create the formatter
2340 * cause we cheat and use sprintf()
2341 */
2342 cp = fmt_str;
2343 *cp++ = '%';
2344 if( altfm ){
2345 *cp++ = '#';
2346 }
2347 if( forceplus ){
2348 *cp++ = '+';
2349 } else if( spad ){
2350 /* PLUS overrides */
2351 *cp++ = ' ';
2352 }
2353 if( ljust ){
2354 *cp++ = '-';
2355 }
2356 if( zpad ){
2357 *cp++ = '0';
2358 }
2359 if( width > 0 ){
2360 sprintf( cp, "%d", width );
2361 /* skip ahead */
2362 cp = strchr(cp,0);
2363 }
2364 /* did we find a period? */
2365 if( inprec ){
2366 /* then add it */
2367 *cp++ = '.';
2368 /* did something occur after the period? */
2369 if( haveprec ){
2370 sprintf( cp, "%d", prec );
2371 }
2372 cp = strchr(cp,0);
2373 }
2374 *cp = 0;
2375
2376 /* here we do the work */
2377 /* actually - we make sprintf() do it for us */
2378 switch(*fmt) {
2379 case 's':
2380 *cp++ = 's';
2381 *cp = 0;
2382 /* BUG: we do not handled embeded NULLs */
2383 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2384 break;
2385 case 'c':
2386 *cp++ = 'c';
2387 *cp = 0;
2388 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2389 Jim_FreeNewObj(interp, resObjPtr);
2390 return NULL;
2391 }
2392 c = (char) wideValue;
2393 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2394 break;
2395 case 'f':
2396 case 'F':
2397 case 'g':
2398 case 'G':
2399 case 'e':
2400 case 'E':
2401 *cp++ = *fmt;
2402 *cp = 0;
2403 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2404 Jim_FreeNewObj( interp, resObjPtr );
2405 return NULL;
2406 }
2407 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2408 break;
2409 case 'b':
2410 case 'd':
2411 case 'i':
2412 case 'u':
2413 case 'x':
2414 case 'X':
2415 /* jim widevaluse are 64bit */
2416 if( sizeof(jim_wide) == sizeof(long long) ){
2417 *cp++ = 'l';
2418 *cp++ = 'l';
2419 } else {
2420 *cp++ = 'l';
2421 }
2422 *cp++ = *fmt;
2423 *cp = 0;
2424 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2425 Jim_FreeNewObj(interp, resObjPtr);
2426 return NULL;
2427 }
2428 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2429 break;
2430 case '%':
2431 sprintf_buf[0] = '%';
2432 sprintf_buf[1] = 0;
2433 objv--; /* undo the objv++ below */
2434 break;
2435 default:
2436 spec[0] = *fmt; spec[1] = '\0';
2437 Jim_FreeNewObj(interp, resObjPtr);
2438 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2439 Jim_AppendStrings(interp, Jim_GetResult(interp),
2440 "bad field specifier \"", spec, "\"", NULL);
2441 return NULL;
2442 }
2443 /* force terminate */
2444 #if 0
2445 printf("FMT was: %s\n", fmt_str );
2446 printf("RES was: |%s|\n", sprintf_buf );
2447 #endif
2448
2449 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2450 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2451 /* next obj */
2452 objv++;
2453 fmt++;
2454 fmtLen--;
2455 }
2456 return resObjPtr;
2457 }
2458
2459 /* -----------------------------------------------------------------------------
2460 * Compared String Object
2461 * ---------------------------------------------------------------------------*/
2462
2463 /* This is strange object that allows to compare a C literal string
2464 * with a Jim object in very short time if the same comparison is done
2465 * multiple times. For example every time the [if] command is executed,
2466 * Jim has to check if a given argument is "else". This comparions if
2467 * the code has no errors are true most of the times, so we can cache
2468 * inside the object the pointer of the string of the last matching
2469 * comparison. Because most C compilers perform literal sharing,
2470 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2471 * this works pretty well even if comparisons are at different places
2472 * inside the C code. */
2473
2474 static Jim_ObjType comparedStringObjType = {
2475 "compared-string",
2476 NULL,
2477 NULL,
2478 NULL,
2479 JIM_TYPE_REFERENCES,
2480 };
2481
2482 /* The only way this object is exposed to the API is via the following
2483 * function. Returns true if the string and the object string repr.
2484 * are the same, otherwise zero is returned.
2485 *
2486 * Note: this isn't binary safe, but it hardly needs to be.*/
2487 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2488 const char *str)
2489 {
2490 if (objPtr->typePtr == &comparedStringObjType &&
2491 objPtr->internalRep.ptr == str)
2492 return 1;
2493 else {
2494 const char *objStr = Jim_GetString(objPtr, NULL);
2495 if (strcmp(str, objStr) != 0) return 0;
2496 if (objPtr->typePtr != &comparedStringObjType) {
2497 Jim_FreeIntRep(interp, objPtr);
2498 objPtr->typePtr = &comparedStringObjType;
2499 }
2500 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2501 return 1;
2502 }
2503 }
2504
2505 int qsortCompareStringPointers(const void *a, const void *b)
2506 {
2507 char * const *sa = (char * const *)a;
2508 char * const *sb = (char * const *)b;
2509 return strcmp(*sa, *sb);
2510 }
2511
2512 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2513 const char **tablePtr, int *indexPtr, const char *name, int flags)
2514 {
2515 const char **entryPtr = NULL;
2516 char **tablePtrSorted;
2517 int i, count = 0;
2518
2519 *indexPtr = -1;
2520 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2521 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2522 *indexPtr = i;
2523 return JIM_OK;
2524 }
2525 count++; /* If nothing matches, this will reach the len of tablePtr */
2526 }
2527 if (flags & JIM_ERRMSG) {
2528 if (name == NULL)
2529 name = "option";
2530 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2531 Jim_AppendStrings(interp, Jim_GetResult(interp),
2532 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2533 NULL);
2534 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2535 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2536 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2537 for (i = 0; i < count; i++) {
2538 if (i+1 == count && count > 1)
2539 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2540 Jim_AppendString(interp, Jim_GetResult(interp),
2541 tablePtrSorted[i], -1);
2542 if (i+1 != count)
2543 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2544 }
2545 Jim_Free(tablePtrSorted);
2546 }
2547 return JIM_ERR;
2548 }
2549
2550 /* -----------------------------------------------------------------------------
2551 * Source Object
2552 *
2553 * This object is just a string from the language point of view, but
2554 * in the internal representation it contains the filename and line number
2555 * where this given token was read. This information is used by
2556 * Jim_EvalObj() if the object passed happens to be of type "source".
2557 *
2558 * This allows to propagate the information about line numbers and file
2559 * names and give error messages with absolute line numbers.
2560 *
2561 * Note that this object uses shared strings for filenames, and the
2562 * pointer to the filename together with the line number is taken into
2563 * the space for the "inline" internal represenation of the Jim_Object,
2564 * so there is almost memory zero-overhead.
2565 *
2566 * Also the object will be converted to something else if the given
2567 * token it represents in the source file is not something to be
2568 * evaluated (not a script), and will be specialized in some other way,
2569 * so the time overhead is alzo null.
2570 * ---------------------------------------------------------------------------*/
2571
2572 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2573 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2574
2575 static Jim_ObjType sourceObjType = {
2576 "source",
2577 FreeSourceInternalRep,
2578 DupSourceInternalRep,
2579 NULL,
2580 JIM_TYPE_REFERENCES,
2581 };
2582
2583 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2584 {
2585 Jim_ReleaseSharedString(interp,
2586 objPtr->internalRep.sourceValue.fileName);
2587 }
2588
2589 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2590 {
2591 dupPtr->internalRep.sourceValue.fileName =
2592 Jim_GetSharedString(interp,
2593 srcPtr->internalRep.sourceValue.fileName);
2594 dupPtr->internalRep.sourceValue.lineNumber =
2595 dupPtr->internalRep.sourceValue.lineNumber;
2596 dupPtr->typePtr = &sourceObjType;
2597 }
2598
2599 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2600 const char *fileName, int lineNumber)
2601 {
2602 if (Jim_IsShared(objPtr))
2603 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2604 if (objPtr->typePtr != NULL)
2605 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2606 objPtr->internalRep.sourceValue.fileName =
2607 Jim_GetSharedString(interp, fileName);
2608 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2609 objPtr->typePtr = &sourceObjType;
2610 }
2611
2612 /* -----------------------------------------------------------------------------
2613 * Script Object
2614 * ---------------------------------------------------------------------------*/
2615
2616 #define JIM_CMDSTRUCT_EXPAND -1
2617
2618 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2619 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2620 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2621
2622 static Jim_ObjType scriptObjType = {
2623 "script",
2624 FreeScriptInternalRep,
2625 DupScriptInternalRep,
2626 NULL,
2627 JIM_TYPE_REFERENCES,
2628 };
2629
2630 /* The ScriptToken structure represents every token into a scriptObj.
2631 * Every token contains an associated Jim_Obj that can be specialized
2632 * by commands operating on it. */
2633 typedef struct ScriptToken {
2634 int type;
2635 Jim_Obj *objPtr;
2636 int linenr;
2637 } ScriptToken;
2638
2639 /* This is the script object internal representation. An array of
2640 * ScriptToken structures, with an associated command structure array.
2641 * The command structure is a pre-computed representation of the
2642 * command length and arguments structure as a simple liner array
2643 * of integers.
2644 *
2645 * For example the script:
2646 *
2647 * puts hello
2648 * set $i $x$y [foo]BAR
2649 *
2650 * will produce a ScriptObj with the following Tokens:
2651 *
2652 * ESC puts
2653 * SEP
2654 * ESC hello
2655 * EOL
2656 * ESC set
2657 * EOL
2658 * VAR i
2659 * SEP
2660 * VAR x
2661 * VAR y
2662 * SEP
2663 * CMD foo
2664 * ESC BAR
2665 * EOL
2666 *
2667 * This is a description of the tokens, separators, and of lines.
2668 * The command structure instead represents the number of arguments
2669 * of every command, followed by the tokens of which every argument
2670 * is composed. So for the example script, the cmdstruct array will
2671 * contain:
2672 *
2673 * 2 1 1 4 1 1 2 2
2674 *
2675 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2676 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2677 * composed of single tokens (1 1) and the last two of double tokens
2678 * (2 2).
2679 *
2680 * The precomputation of the command structure makes Jim_Eval() faster,
2681 * and simpler because there aren't dynamic lengths / allocations.
2682 *
2683 * -- {expand} handling --
2684 *
2685 * Expand is handled in a special way. When a command
2686 * contains at least an argument with the {expand} prefix,
2687 * the command structure presents a -1 before the integer
2688 * describing the number of arguments. This is used in order
2689 * to send the command exection to a different path in case
2690 * of {expand} and guarantee a fast path for the more common
2691 * case. Also, the integers describing the number of tokens
2692 * are expressed with negative sign, to allow for fast check
2693 * of what's an {expand}-prefixed argument and what not.
2694 *
2695 * For example the command:
2696 *
2697 * list {expand}{1 2}
2698 *
2699 * Will produce the following cmdstruct array:
2700 *
2701 * -1 2 1 -2
2702 *
2703 * -- the substFlags field of the structure --
2704 *
2705 * The scriptObj structure is used to represent both "script" objects
2706 * and "subst" objects. In the second case, the cmdStruct related
2707 * fields are not used at all, but there is an additional field used
2708 * that is 'substFlags': this represents the flags used to turn
2709 * the string into the intenral representation used to perform the
2710 * substitution. If this flags are not what the application requires
2711 * the scriptObj is created again. For example the script:
2712 *
2713 * subst -nocommands $string
2714 * subst -novariables $string
2715 *
2716 * Will recreate the internal representation of the $string object
2717 * two times.
2718 */
2719 typedef struct ScriptObj {
2720 int len; /* Length as number of tokens. */
2721 int commands; /* number of top-level commands in script. */
2722 ScriptToken *token; /* Tokens array. */
2723 int *cmdStruct; /* commands structure */
2724 int csLen; /* length of the cmdStruct array. */
2725 int substFlags; /* flags used for the compilation of "subst" objects */
2726 int inUse; /* Used to share a ScriptObj. Currently
2727 only used by Jim_EvalObj() as protection against
2728 shimmering of the currently evaluated object. */
2729 char *fileName;
2730 } ScriptObj;
2731
2732 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2733 {
2734 int i;
2735 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2736
2737 script->inUse--;
2738 if (script->inUse != 0) return;
2739 for (i = 0; i < script->len; i++) {
2740 if (script->token[i].objPtr != NULL)
2741 Jim_DecrRefCount(interp, script->token[i].objPtr);
2742 }
2743 Jim_Free(script->token);
2744 Jim_Free(script->cmdStruct);
2745 Jim_Free(script->fileName);
2746 Jim_Free(script);
2747 }
2748
2749 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2750 {
2751 JIM_NOTUSED(interp);
2752 JIM_NOTUSED(srcPtr);
2753
2754 /* Just returns an simple string. */
2755 dupPtr->typePtr = NULL;
2756 }
2757
2758 /* Add a new token to the internal repr of a script object */
2759 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2760 char *strtoken, int len, int type, char *filename, int linenr)
2761 {
2762 int prevtype;
2763 struct ScriptToken *token;
2764
2765 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2766 script->token[script->len-1].type;
2767 /* Skip tokens without meaning, like words separators
2768 * following a word separator or an end of command and
2769 * so on. */
2770 if (prevtype == JIM_TT_EOL) {
2771 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2772 Jim_Free(strtoken);
2773 return;
2774 }
2775 } else if (prevtype == JIM_TT_SEP) {
2776 if (type == JIM_TT_SEP) {
2777 Jim_Free(strtoken);
2778 return;
2779 } else if (type == JIM_TT_EOL) {
2780 /* If an EOL is following by a SEP, drop the previous
2781 * separator. */
2782 script->len--;
2783 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2784 }
2785 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2786 type == JIM_TT_ESC && len == 0)
2787 {
2788 /* Don't add empty tokens used in interpolation */
2789 Jim_Free(strtoken);
2790 return;
2791 }
2792 /* Make space for a new istruction */
2793 script->len++;
2794 script->token = Jim_Realloc(script->token,
2795 sizeof(ScriptToken)*script->len);
2796 /* Initialize the new token */
2797 token = script->token+(script->len-1);
2798 token->type = type;
2799 /* Every object is intially as a string, but the
2800 * internal type may be specialized during execution of the
2801 * script. */
2802 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2803 /* To add source info to SEP and EOL tokens is useless because
2804 * they will never by called as arguments of Jim_EvalObj(). */
2805 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2806 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2807 Jim_IncrRefCount(token->objPtr);
2808 token->linenr = linenr;
2809 }
2810
2811 /* Add an integer into the command structure field of the script object. */
2812 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2813 {
2814 script->csLen++;
2815 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2816 sizeof(int)*script->csLen);
2817 script->cmdStruct[script->csLen-1] = val;
2818 }
2819
2820 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2821 * of objPtr. Search nested script objects recursively. */
2822 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2823 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2824 {
2825 int i;
2826
2827 for (i = 0; i < script->len; i++) {
2828 if (script->token[i].objPtr != objPtr &&
2829 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2830 return script->token[i].objPtr;
2831 }
2832 /* Enter recursively on scripts only if the object
2833 * is not the same as the one we are searching for
2834 * shared occurrences. */
2835 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2836 script->token[i].objPtr != objPtr) {
2837 Jim_Obj *foundObjPtr;
2838
2839 ScriptObj *subScript =
2840 script->token[i].objPtr->internalRep.ptr;
2841 /* Don't recursively enter the script we are trying
2842 * to make shared to avoid circular references. */
2843 if (subScript == scriptBarrier) continue;
2844 if (subScript != script) {
2845 foundObjPtr =
2846 ScriptSearchLiteral(interp, subScript,
2847 scriptBarrier, objPtr);
2848 if (foundObjPtr != NULL)
2849 return foundObjPtr;
2850 }
2851 }
2852 }
2853 return NULL;
2854 }
2855
2856 /* Share literals of a script recursively sharing sub-scripts literals. */
2857 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2858 ScriptObj *topLevelScript)
2859 {
2860 int i, j;
2861
2862 return;
2863 /* Try to share with toplevel object. */
2864 if (topLevelScript != NULL) {
2865 for (i = 0; i < script->len; i++) {
2866 Jim_Obj *foundObjPtr;
2867 char *str = script->token[i].objPtr->bytes;
2868
2869 if (script->token[i].objPtr->refCount != 1) continue;
2870 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2871 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2872 foundObjPtr = ScriptSearchLiteral(interp,
2873 topLevelScript,
2874 script, /* barrier */
2875 script->token[i].objPtr);
2876 if (foundObjPtr != NULL) {
2877 Jim_IncrRefCount(foundObjPtr);
2878 Jim_DecrRefCount(interp,
2879 script->token[i].objPtr);
2880 script->token[i].objPtr = foundObjPtr;
2881 }
2882 }
2883 }
2884 /* Try to share locally */
2885 for (i = 0; i < script->len; i++) {
2886 char *str = script->token[i].objPtr->bytes;
2887
2888 if (script->token[i].objPtr->refCount != 1) continue;
2889 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2890 for (j = 0; j < script->len; j++) {
2891 if (script->token[i].objPtr !=
2892 script->token[j].objPtr &&
2893 Jim_StringEqObj(script->token[i].objPtr,
2894 script->token[j].objPtr, 0))
2895 {
2896 Jim_IncrRefCount(script->token[j].objPtr);
2897 Jim_DecrRefCount(interp,
2898 script->token[i].objPtr);
2899 script->token[i].objPtr =
2900 script->token[j].objPtr;
2901 }
2902 }
2903 }
2904 }
2905
2906 /* This method takes the string representation of an object
2907 * as a Tcl script, and generates the pre-parsed internal representation
2908 * of the script. */
2909 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
2910 {
2911 int scriptTextLen;
2912 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
2913 struct JimParserCtx parser;
2914 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
2915 ScriptToken *token;
2916 int args, tokens, start, end, i;
2917 int initialLineNumber;
2918 int propagateSourceInfo = 0;
2919
2920 script->len = 0;
2921 script->csLen = 0;
2922 script->commands = 0;
2923 script->token = NULL;
2924 script->cmdStruct = NULL;
2925 script->inUse = 1;
2926 /* Try to get information about filename / line number */
2927 if (objPtr->typePtr == &sourceObjType) {
2928 script->fileName =
2929 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
2930 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
2931 propagateSourceInfo = 1;
2932 } else {
2933 script->fileName = Jim_StrDup("?");
2934 initialLineNumber = 1;
2935 }
2936
2937 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
2938 while(!JimParserEof(&parser)) {
2939 char *token;
2940 int len, type, linenr;
2941
2942 JimParseScript(&parser);
2943 token = JimParserGetToken(&parser, &len, &type, &linenr);
2944 ScriptObjAddToken(interp, script, token, len, type,
2945 propagateSourceInfo ? script->fileName : NULL,
2946 linenr);
2947 }
2948 token = script->token;
2949
2950 /* Compute the command structure array
2951 * (see the ScriptObj struct definition for more info) */
2952 start = 0; /* Current command start token index */
2953 end = -1; /* Current command end token index */
2954 while (1) {
2955 int expand = 0; /* expand flag. set to 1 on {expand} form. */
2956 int interpolation = 0; /* set to 1 if there is at least one
2957 argument of the command obtained via
2958 interpolation of more tokens. */
2959 /* Search for the end of command, while
2960 * count the number of args. */
2961 start = ++end;
2962 if (start >= script->len) break;
2963 args = 1; /* Number of args in current command */
2964 while (token[end].type != JIM_TT_EOL) {
2965 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
2966 token[end-1].type == JIM_TT_EOL)
2967 {
2968 if (token[end].type == JIM_TT_STR &&
2969 token[end+1].type != JIM_TT_SEP &&
2970 token[end+1].type != JIM_TT_EOL &&
2971 (!strcmp(token[end].objPtr->bytes, "expand") ||
2972 !strcmp(token[end].objPtr->bytes, "*")))
2973 expand++;
2974 }
2975 if (token[end].type == JIM_TT_SEP)
2976 args++;
2977 end++;
2978 }
2979 interpolation = !((end-start+1) == args*2);
2980 /* Add the 'number of arguments' info into cmdstruct.
2981 * Negative value if there is list expansion involved. */
2982 if (expand)
2983 ScriptObjAddInt(script, -1);
2984 ScriptObjAddInt(script, args);
2985 /* Now add info about the number of tokens. */
2986 tokens = 0; /* Number of tokens in current argument. */
2987 expand = 0;
2988 for (i = start; i <= end; i++) {
2989 if (token[i].type == JIM_TT_SEP ||
2990 token[i].type == JIM_TT_EOL)
2991 {
2992 if (tokens == 1 && expand)
2993 expand = 0;
2994 ScriptObjAddInt(script,
2995 expand ? -tokens : tokens);
2996
2997 expand = 0;
2998 tokens = 0;
2999 continue;
3000 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3001 (!strcmp(token[i].objPtr->bytes, "expand") ||
3002 !strcmp(token[i].objPtr->bytes, "*")))
3003 {
3004 expand++;
3005 }
3006 tokens++;
3007 }
3008 }
3009 /* Perform literal sharing, but only for objects that appear
3010 * to be scripts written as literals inside the source code,
3011 * and not computed at runtime. Literal sharing is a costly
3012 * operation that should be done only against objects that
3013 * are likely to require compilation only the first time, and
3014 * then are executed multiple times. */
3015 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3016 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3017 if (bodyObjPtr->typePtr == &scriptObjType) {
3018 ScriptObj *bodyScript =
3019 bodyObjPtr->internalRep.ptr;
3020 ScriptShareLiterals(interp, script, bodyScript);
3021 }
3022 } else if (propagateSourceInfo) {
3023 ScriptShareLiterals(interp, script, NULL);
3024 }
3025 /* Free the old internal rep and set the new one. */
3026 Jim_FreeIntRep(interp, objPtr);
3027 Jim_SetIntRepPtr(objPtr, script);
3028 objPtr->typePtr = &scriptObjType;
3029 return JIM_OK;
3030 }
3031
3032 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3033 {
3034 if (objPtr->typePtr != &scriptObjType) {
3035 SetScriptFromAny(interp, objPtr);
3036 }
3037 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3038 }
3039
3040 /* -----------------------------------------------------------------------------
3041 * Commands
3042 * ---------------------------------------------------------------------------*/
3043
3044 /* Commands HashTable Type.
3045 *
3046 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3047 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3048 {
3049 Jim_Cmd *cmdPtr = (void*) val;
3050
3051 if (cmdPtr->cmdProc == NULL) {
3052 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3053 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3054 if (cmdPtr->staticVars) {
3055 Jim_FreeHashTable(cmdPtr->staticVars);
3056 Jim_Free(cmdPtr->staticVars);
3057 }
3058 } else if (cmdPtr->delProc != NULL) {
3059 /* If it was a C coded command, call the delProc if any */
3060 cmdPtr->delProc(interp, cmdPtr->privData);
3061 }
3062 Jim_Free(val);
3063 }
3064
3065 static Jim_HashTableType JimCommandsHashTableType = {
3066 JimStringCopyHTHashFunction, /* hash function */
3067 JimStringCopyHTKeyDup, /* key dup */
3068 NULL, /* val dup */
3069 JimStringCopyHTKeyCompare, /* key compare */
3070 JimStringCopyHTKeyDestructor, /* key destructor */
3071 Jim_CommandsHT_ValDestructor /* val destructor */
3072 };
3073
3074 /* ------------------------- Commands related functions --------------------- */
3075
3076 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3077 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3078 {
3079 Jim_HashEntry *he;
3080 Jim_Cmd *cmdPtr;
3081
3082 he = Jim_FindHashEntry(&interp->commands, cmdName);
3083 if (he == NULL) { /* New command to create */
3084 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3085 cmdPtr->cmdProc = cmdProc;
3086 cmdPtr->privData = privData;
3087 cmdPtr->delProc = delProc;
3088 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3089 } else {
3090 Jim_InterpIncrProcEpoch(interp);
3091 /* Free the arglist/body objects if it was a Tcl procedure */
3092 cmdPtr = he->val;
3093 if (cmdPtr->cmdProc == NULL) {
3094 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3095 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3096 if (cmdPtr->staticVars) {
3097 Jim_FreeHashTable(cmdPtr->staticVars);
3098 Jim_Free(cmdPtr->staticVars);
3099 }
3100 cmdPtr->staticVars = NULL;
3101 } else if (cmdPtr->delProc != NULL) {
3102 /* If it was a C coded command, call the delProc if any */
3103 cmdPtr->delProc(interp, cmdPtr->privData);
3104 }
3105 cmdPtr->cmdProc = cmdProc;
3106 cmdPtr->privData = privData;
3107 }
3108 /* There is no need to increment the 'proc epoch' because
3109 * creation of a new procedure can never affect existing
3110 * cached commands. We don't do negative caching. */
3111 return JIM_OK;
3112 }
3113
3114 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3115 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3116 int arityMin, int arityMax)
3117 {
3118 Jim_Cmd *cmdPtr;
3119
3120 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3121 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3122 cmdPtr->argListObjPtr = argListObjPtr;
3123 cmdPtr->bodyObjPtr = bodyObjPtr;
3124 Jim_IncrRefCount(argListObjPtr);
3125 Jim_IncrRefCount(bodyObjPtr);
3126 cmdPtr->arityMin = arityMin;
3127 cmdPtr->arityMax = arityMax;
3128 cmdPtr->staticVars = NULL;
3129
3130 /* Create the statics hash table. */
3131 if (staticsListObjPtr) {
3132 int len, i;
3133
3134 Jim_ListLength(interp, staticsListObjPtr, &len);
3135 if (len != 0) {
3136 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3137 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3138 interp);
3139 for (i = 0; i < len; i++) {
3140 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3141 Jim_Var *varPtr;
3142 int subLen;
3143
3144 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3145 /* Check if it's composed of two elements. */
3146 Jim_ListLength(interp, objPtr, &subLen);
3147 if (subLen == 1 || subLen == 2) {
3148 /* Try to get the variable value from the current
3149 * environment. */
3150 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3151 if (subLen == 1) {
3152 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3153 JIM_NONE);
3154 if (initObjPtr == NULL) {
3155 Jim_SetResult(interp,
3156 Jim_NewEmptyStringObj(interp));
3157 Jim_AppendStrings(interp, Jim_GetResult(interp),
3158 "variable for initialization of static \"",
3159 Jim_GetString(nameObjPtr, NULL),
3160 "\" not found in the local context",
3161 NULL);
3162 goto err;
3163 }
3164 } else {
3165 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3166 }
3167 varPtr = Jim_Alloc(sizeof(*varPtr));
3168 varPtr->objPtr = initObjPtr;
3169 Jim_IncrRefCount(initObjPtr);
3170 varPtr->linkFramePtr = NULL;
3171 if (Jim_AddHashEntry(cmdPtr->staticVars,
3172 Jim_GetString(nameObjPtr, NULL),
3173 varPtr) != JIM_OK)
3174 {
3175 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3176 Jim_AppendStrings(interp, Jim_GetResult(interp),
3177 "static variable name \"",
3178 Jim_GetString(objPtr, NULL), "\"",
3179 " duplicated in statics list", NULL);
3180 Jim_DecrRefCount(interp, initObjPtr);
3181 Jim_Free(varPtr);
3182 goto err;
3183 }
3184 } else {
3185 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3186 Jim_AppendStrings(interp, Jim_GetResult(interp),
3187 "too many fields in static specifier \"",
3188 objPtr, "\"", NULL);
3189 goto err;
3190 }
3191 }
3192 }
3193 }
3194
3195 /* Add the new command */
3196
3197 /* it may already exist, so we try to delete the old one */
3198 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3199 /* There was an old procedure with the same name, this requires
3200 * a 'proc epoch' update. */
3201 Jim_InterpIncrProcEpoch(interp);
3202 }
3203 /* If a procedure with the same name didn't existed there is no need
3204 * to increment the 'proc epoch' because creation of a new procedure
3205 * can never affect existing cached commands. We don't do
3206 * negative caching. */
3207 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3208 return JIM_OK;
3209
3210 err:
3211 Jim_FreeHashTable(cmdPtr->staticVars);
3212 Jim_Free(cmdPtr->staticVars);
3213 Jim_DecrRefCount(interp, argListObjPtr);
3214 Jim_DecrRefCount(interp, bodyObjPtr);
3215 Jim_Free(cmdPtr);
3216 return JIM_ERR;
3217 }
3218
3219 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3220 {
3221 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3222 return JIM_ERR;
3223 Jim_InterpIncrProcEpoch(interp);
3224 return JIM_OK;
3225 }
3226
3227 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3228 const char *newName)
3229 {
3230 Jim_Cmd *cmdPtr;
3231 Jim_HashEntry *he;
3232 Jim_Cmd *copyCmdPtr;
3233
3234 if (newName[0] == '\0') /* Delete! */
3235 return Jim_DeleteCommand(interp, oldName);
3236 /* Rename */
3237 he = Jim_FindHashEntry(&interp->commands, oldName);
3238 if (he == NULL)
3239 return JIM_ERR; /* Invalid command name */
3240 cmdPtr = he->val;
3241 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3242 *copyCmdPtr = *cmdPtr;
3243 /* In order to avoid that a procedure will get arglist/body/statics
3244 * freed by the hash table methods, fake a C-coded command
3245 * setting cmdPtr->cmdProc as not NULL */
3246 cmdPtr->cmdProc = (void*)1;
3247 /* Also make sure delProc is NULL. */
3248 cmdPtr->delProc = NULL;
3249 /* Destroy the old command, and make sure the new is freed
3250 * as well. */
3251 Jim_DeleteHashEntry(&interp->commands, oldName);
3252 Jim_DeleteHashEntry(&interp->commands, newName);
3253 /* Now the new command. We are sure it can't fail because
3254 * the target name was already freed. */
3255 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3256 /* Increment the epoch */
3257 Jim_InterpIncrProcEpoch(interp);
3258 return JIM_OK;
3259 }
3260
3261 /* -----------------------------------------------------------------------------
3262 * Command object
3263 * ---------------------------------------------------------------------------*/
3264
3265 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3266
3267 static Jim_ObjType commandObjType = {
3268 "command",
3269 NULL,
3270 NULL,
3271 NULL,
3272 JIM_TYPE_REFERENCES,
3273 };
3274
3275 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3276 {
3277 Jim_HashEntry *he;
3278 const char *cmdName;
3279
3280 /* Get the string representation */
3281 cmdName = Jim_GetString(objPtr, NULL);
3282 /* Lookup this name into the commands hash table */
3283 he = Jim_FindHashEntry(&interp->commands, cmdName);
3284 if (he == NULL)
3285 return JIM_ERR;
3286
3287 /* Free the old internal repr and set the new one. */
3288 Jim_FreeIntRep(interp, objPtr);
3289 objPtr->typePtr = &commandObjType;
3290 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3291 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3292 return JIM_OK;
3293 }
3294
3295 /* This function returns the command structure for the command name
3296 * stored in objPtr. It tries to specialize the objPtr to contain
3297 * a cached info instead to perform the lookup into the hash table
3298 * every time. The information cached may not be uptodate, in such
3299 * a case the lookup is performed and the cache updated. */
3300 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3301 {
3302 if ((objPtr->typePtr != &commandObjType ||
3303 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3304 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3305 if (flags & JIM_ERRMSG) {
3306 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3307 Jim_AppendStrings(interp, Jim_GetResult(interp),
3308 "invalid command name \"", objPtr->bytes, "\"",
3309 NULL);
3310 }
3311 return NULL;
3312 }
3313 return objPtr->internalRep.cmdValue.cmdPtr;
3314 }
3315
3316 /* -----------------------------------------------------------------------------
3317 * Variables
3318 * ---------------------------------------------------------------------------*/
3319
3320 /* Variables HashTable Type.
3321 *
3322 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3323 static void JimVariablesHTValDestructor(void *interp, void *val)
3324 {
3325 Jim_Var *varPtr = (void*) val;
3326
3327 Jim_DecrRefCount(interp, varPtr->objPtr);
3328 Jim_Free(val);
3329 }
3330
3331 static Jim_HashTableType JimVariablesHashTableType = {
3332 JimStringCopyHTHashFunction, /* hash function */
3333 JimStringCopyHTKeyDup, /* key dup */
3334 NULL, /* val dup */
3335 JimStringCopyHTKeyCompare, /* key compare */
3336 JimStringCopyHTKeyDestructor, /* key destructor */
3337 JimVariablesHTValDestructor /* val destructor */
3338 };
3339
3340 /* -----------------------------------------------------------------------------
3341 * Variable object
3342 * ---------------------------------------------------------------------------*/
3343
3344 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3345
3346 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3347
3348 static Jim_ObjType variableObjType = {
3349 "variable",
3350 NULL,
3351 NULL,
3352 NULL,
3353 JIM_TYPE_REFERENCES,
3354 };
3355
3356 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3357 * is in the form "varname(key)". */
3358 static int Jim_NameIsDictSugar(const char *str, int len)
3359 {
3360 if (len == -1)
3361 len = strlen(str);
3362 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3363 return 1;
3364 return 0;
3365 }
3366
3367 /* This method should be called only by the variable API.
3368 * It returns JIM_OK on success (variable already exists),
3369 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3370 * a variable name, but syntax glue for [dict] i.e. the last
3371 * character is ')' */
3372 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3373 {
3374 Jim_HashEntry *he;
3375 const char *varName;
3376 int len;
3377
3378 /* Check if the object is already an uptodate variable */
3379 if (objPtr->typePtr == &variableObjType &&
3380 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3381 return JIM_OK; /* nothing to do */
3382 /* Get the string representation */
3383 varName = Jim_GetString(objPtr, &len);
3384 /* Make sure it's not syntax glue to get/set dict. */
3385 if (Jim_NameIsDictSugar(varName, len))
3386 return JIM_DICT_SUGAR;
3387 /* Lookup this name into the variables hash table */
3388 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3389 if (he == NULL) {
3390 /* Try with static vars. */
3391 if (interp->framePtr->staticVars == NULL)
3392 return JIM_ERR;
3393 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3394 return JIM_ERR;
3395 }
3396 /* Free the old internal repr and set the new one. */
3397 Jim_FreeIntRep(interp, objPtr);
3398 objPtr->typePtr = &variableObjType;
3399 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3400 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3401 return JIM_OK;
3402 }
3403
3404 /* -------------------- Variables related functions ------------------------- */
3405 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3406 Jim_Obj *valObjPtr);
3407 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3408
3409 /* For now that's dummy. Variables lookup should be optimized
3410 * in many ways, with caching of lookups, and possibly with
3411 * a table of pre-allocated vars in every CallFrame for local vars.
3412 * All the caching should also have an 'epoch' mechanism similar
3413 * to the one used by Tcl for procedures lookup caching. */
3414
3415 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3416 {
3417 const char *name;
3418 Jim_Var *var;
3419 int err;
3420
3421 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3422 /* Check for [dict] syntax sugar. */
3423 if (err == JIM_DICT_SUGAR)
3424 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3425 /* New variable to create */
3426 name = Jim_GetString(nameObjPtr, NULL);
3427
3428 var = Jim_Alloc(sizeof(*var));
3429 var->objPtr = valObjPtr;
3430 Jim_IncrRefCount(valObjPtr);
3431 var->linkFramePtr = NULL;
3432 /* Insert the new variable */
3433 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3434 /* Make the object int rep a variable */
3435 Jim_FreeIntRep(interp, nameObjPtr);
3436 nameObjPtr->typePtr = &variableObjType;
3437 nameObjPtr->internalRep.varValue.callFrameId =
3438 interp->framePtr->id;
3439 nameObjPtr->internalRep.varValue.varPtr = var;
3440 } else {
3441 var = nameObjPtr->internalRep.varValue.varPtr;
3442 if (var->linkFramePtr == NULL) {
3443 Jim_IncrRefCount(valObjPtr);
3444 Jim_DecrRefCount(interp, var->objPtr);
3445 var->objPtr = valObjPtr;
3446 } else { /* Else handle the link */
3447 Jim_CallFrame *savedCallFrame;
3448
3449 savedCallFrame = interp->framePtr;
3450 interp->framePtr = var->linkFramePtr;
3451 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3452 interp->framePtr = savedCallFrame;
3453 if (err != JIM_OK)
3454 return err;
3455 }
3456 }
3457 return JIM_OK;
3458 }
3459
3460 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3461 {
3462 Jim_Obj *nameObjPtr;
3463 int result;
3464
3465 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3466 Jim_IncrRefCount(nameObjPtr);
3467 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3468 Jim_DecrRefCount(interp, nameObjPtr);
3469 return result;
3470 }
3471
3472 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3473 {
3474 Jim_CallFrame *savedFramePtr;
3475 int result;
3476
3477 savedFramePtr = interp->framePtr;
3478 interp->framePtr = interp->topFramePtr;
3479 result = Jim_SetVariableStr(interp, name, objPtr);
3480 interp->framePtr = savedFramePtr;
3481 return result;
3482 }
3483
3484 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3485 {
3486 Jim_Obj *nameObjPtr, *valObjPtr;
3487 int result;
3488
3489 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3490 valObjPtr = Jim_NewStringObj(interp, val, -1);
3491 Jim_IncrRefCount(nameObjPtr);
3492 Jim_IncrRefCount(valObjPtr);
3493 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3494 Jim_DecrRefCount(interp, nameObjPtr);
3495 Jim_DecrRefCount(interp, valObjPtr);
3496 return result;
3497 }
3498
3499 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3500 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3501 {
3502 const char *varName;
3503 int len;
3504
3505 /* Check for cycles. */
3506 if (interp->framePtr == targetCallFrame) {
3507 Jim_Obj *objPtr = targetNameObjPtr;
3508 Jim_Var *varPtr;
3509 /* Cycles are only possible with 'uplevel 0' */
3510 while(1) {
3511 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3512 Jim_SetResultString(interp,
3513 "can't upvar from variable to itself", -1);
3514 return JIM_ERR;
3515 }
3516 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3517 break;
3518 varPtr = objPtr->internalRep.varValue.varPtr;
3519 if (varPtr->linkFramePtr != targetCallFrame) break;
3520 objPtr = varPtr->objPtr;
3521 }
3522 }
3523 varName = Jim_GetString(nameObjPtr, &len);
3524 if (Jim_NameIsDictSugar(varName, len)) {
3525 Jim_SetResultString(interp,
3526 "Dict key syntax invalid as link source", -1);
3527 return JIM_ERR;
3528 }
3529 /* Perform the binding */
3530 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3531 /* We are now sure 'nameObjPtr' type is variableObjType */
3532 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3533 return JIM_OK;
3534 }
3535
3536 /* Return the Jim_Obj pointer associated with a variable name,
3537 * or NULL if the variable was not found in the current context.
3538 * The same optimization discussed in the comment to the
3539 * 'SetVariable' function should apply here. */
3540 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3541 {
3542 int err;
3543
3544 /* All the rest is handled here */
3545 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3546 /* Check for [dict] syntax sugar. */
3547 if (err == JIM_DICT_SUGAR)
3548 return JimDictSugarGet(interp, nameObjPtr);
3549 if (flags & JIM_ERRMSG) {
3550 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3551 Jim_AppendStrings(interp, Jim_GetResult(interp),
3552 "can't read \"", nameObjPtr->bytes,
3553 "\": no such variable", NULL);
3554 }
3555 return NULL;
3556 } else {
3557 Jim_Var *varPtr;
3558 Jim_Obj *objPtr;
3559 Jim_CallFrame *savedCallFrame;
3560
3561 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3562 if (varPtr->linkFramePtr == NULL)
3563 return varPtr->objPtr;
3564 /* The variable is a link? Resolve it. */
3565 savedCallFrame = interp->framePtr;
3566 interp->framePtr = varPtr->linkFramePtr;
3567 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3568 if (objPtr == NULL && flags & JIM_ERRMSG) {
3569 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3570 Jim_AppendStrings(interp, Jim_GetResult(interp),
3571 "can't read \"", nameObjPtr->bytes,
3572 "\": no such variable", NULL);
3573 }
3574 interp->framePtr = savedCallFrame;
3575 return objPtr;
3576 }
3577 }
3578
3579 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3580 int flags)
3581 {
3582 Jim_CallFrame *savedFramePtr;
3583 Jim_Obj *objPtr;
3584
3585 savedFramePtr = interp->framePtr;
3586 interp->framePtr = interp->topFramePtr;
3587 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3588 interp->framePtr = savedFramePtr;
3589
3590 return objPtr;
3591 }
3592
3593 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3594 {
3595 Jim_Obj *nameObjPtr, *varObjPtr;
3596
3597 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3598 Jim_IncrRefCount(nameObjPtr);
3599 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3600 Jim_DecrRefCount(interp, nameObjPtr);
3601 return varObjPtr;
3602 }
3603
3604 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3605 int flags)
3606 {
3607 Jim_CallFrame *savedFramePtr;
3608 Jim_Obj *objPtr;
3609
3610 savedFramePtr = interp->framePtr;
3611 interp->framePtr = interp->topFramePtr;
3612 objPtr = Jim_GetVariableStr(interp, name, flags);
3613 interp->framePtr = savedFramePtr;
3614
3615 return objPtr;
3616 }
3617
3618 /* Unset a variable.
3619 * Note: On success unset invalidates all the variable objects created
3620 * in the current call frame incrementing. */
3621 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3622 {
3623 const char *name;
3624 Jim_Var *varPtr;
3625 int err;
3626
3627 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3628 /* Check for [dict] syntax sugar. */
3629 if (err == JIM_DICT_SUGAR)
3630 return JimDictSugarSet(interp, nameObjPtr, NULL);
3631 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3632 Jim_AppendStrings(interp, Jim_GetResult(interp),
3633 "can't unset \"", nameObjPtr->bytes,
3634 "\": no such variable", NULL);
3635 return JIM_ERR; /* var not found */
3636 }
3637 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3638 /* If it's a link call UnsetVariable recursively */
3639 if (varPtr->linkFramePtr) {
3640 int retval;
3641
3642 Jim_CallFrame *savedCallFrame;
3643
3644 savedCallFrame = interp->framePtr;
3645 interp->framePtr = varPtr->linkFramePtr;
3646 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3647 interp->framePtr = savedCallFrame;
3648 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3649 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3650 Jim_AppendStrings(interp, Jim_GetResult(interp),
3651 "can't unset \"", nameObjPtr->bytes,
3652 "\": no such variable", NULL);
3653 }
3654 return retval;
3655 } else {
3656 name = Jim_GetString(nameObjPtr, NULL);
3657 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3658 != JIM_OK) return JIM_ERR;
3659 /* Change the callframe id, invalidating var lookup caching */
3660 JimChangeCallFrameId(interp, interp->framePtr);
3661 return JIM_OK;
3662 }
3663 }
3664
3665 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3666
3667 /* Given a variable name for [dict] operation syntax sugar,
3668 * this function returns two objects, the first with the name
3669 * of the variable to set, and the second with the rispective key.
3670 * For example "foo(bar)" will return objects with string repr. of
3671 * "foo" and "bar".
3672 *
3673 * The returned objects have refcount = 1. The function can't fail. */
3674 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3675 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3676 {
3677 const char *str, *p;
3678 char *t;
3679 int len, keyLen, nameLen;
3680 Jim_Obj *varObjPtr, *keyObjPtr;
3681
3682 str = Jim_GetString(objPtr, &len);
3683 p = strchr(str, '(');
3684 p++;
3685 keyLen = len-((p-str)+1);
3686 nameLen = (p-str)-1;
3687 /* Create the objects with the variable name and key. */
3688 t = Jim_Alloc(nameLen+1);
3689 memcpy(t, str, nameLen);
3690 t[nameLen] = '\0';
3691 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3692
3693 t = Jim_Alloc(keyLen+1);
3694 memcpy(t, p, keyLen);
3695 t[keyLen] = '\0';
3696 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3697
3698 Jim_IncrRefCount(varObjPtr);
3699 Jim_IncrRefCount(keyObjPtr);
3700 *varPtrPtr = varObjPtr;
3701 *keyPtrPtr = keyObjPtr;
3702 }
3703
3704 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3705 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3706 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3707 Jim_Obj *valObjPtr)
3708 {
3709 Jim_Obj *varObjPtr, *keyObjPtr;
3710 int err = JIM_OK;
3711
3712 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3713 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3714 valObjPtr);
3715 Jim_DecrRefCount(interp, varObjPtr);
3716 Jim_DecrRefCount(interp, keyObjPtr);
3717 return err;
3718 }
3719
3720 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3721 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3722 {
3723 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3724
3725 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3726 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3727 if (!dictObjPtr) {
3728 resObjPtr = NULL;
3729 goto err;
3730 }
3731 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3732 != JIM_OK) {
3733 resObjPtr = NULL;
3734 }
3735 err:
3736 Jim_DecrRefCount(interp, varObjPtr);
3737 Jim_DecrRefCount(interp, keyObjPtr);
3738 return resObjPtr;
3739 }
3740
3741 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3742
3743 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3744 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3745 Jim_Obj *dupPtr);
3746
3747 static Jim_ObjType dictSubstObjType = {
3748 "dict-substitution",
3749 FreeDictSubstInternalRep,
3750 DupDictSubstInternalRep,
3751 NULL,
3752 JIM_TYPE_NONE,
3753 };
3754
3755 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3756 {
3757 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3758 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3759 }
3760
3761 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3762 Jim_Obj *dupPtr)
3763 {
3764 JIM_NOTUSED(interp);
3765
3766 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3767 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3768 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3769 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3770 dupPtr->typePtr = &dictSubstObjType;
3771 }
3772
3773 /* This function is used to expand [dict get] sugar in the form
3774 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3775 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3776 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3777 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3778 * the [dict]ionary contained in variable VARNAME. */
3779 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3780 {
3781 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3782 Jim_Obj *substKeyObjPtr = NULL;
3783
3784 if (objPtr->typePtr != &dictSubstObjType) {
3785 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3786 Jim_FreeIntRep(interp, objPtr);
3787 objPtr->typePtr = &dictSubstObjType;
3788 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3789 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3790 }
3791 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3792 &substKeyObjPtr, JIM_NONE)
3793 != JIM_OK) {
3794 substKeyObjPtr = NULL;
3795 goto err;
3796 }
3797 Jim_IncrRefCount(substKeyObjPtr);
3798 dictObjPtr = Jim_GetVariable(interp,
3799 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3800 if (!dictObjPtr) {
3801 resObjPtr = NULL;
3802 goto err;
3803 }
3804 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3805 != JIM_OK) {
3806 resObjPtr = NULL;
3807 goto err;
3808 }
3809 err:
3810 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3811 return resObjPtr;
3812 }
3813
3814 /* -----------------------------------------------------------------------------
3815 * CallFrame
3816 * ---------------------------------------------------------------------------*/
3817
3818 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3819 {
3820 Jim_CallFrame *cf;
3821 if (interp->freeFramesList) {
3822 cf = interp->freeFramesList;
3823 interp->freeFramesList = cf->nextFramePtr;
3824 } else {
3825 cf = Jim_Alloc(sizeof(*cf));
3826 cf->vars.table = NULL;
3827 }
3828
3829 cf->id = interp->callFrameEpoch++;
3830 cf->parentCallFrame = NULL;
3831 cf->argv = NULL;
3832 cf->argc = 0;
3833 cf->procArgsObjPtr = NULL;
3834 cf->procBodyObjPtr = NULL;
3835 cf->nextFramePtr = NULL;
3836 cf->staticVars = NULL;
3837 if (cf->vars.table == NULL)
3838 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3839 return cf;
3840 }
3841
3842 /* Used to invalidate every caching related to callframe stability. */
3843 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3844 {
3845 cf->id = interp->callFrameEpoch++;
3846 }
3847
3848 #define JIM_FCF_NONE 0 /* no flags */
3849 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3850 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3851 int flags)
3852 {
3853 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3854 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3855 if (!(flags & JIM_FCF_NOHT))
3856 Jim_FreeHashTable(&cf->vars);
3857 else {
3858 int i;
3859 Jim_HashEntry **table = cf->vars.table, *he;
3860
3861 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3862 he = table[i];
3863 while (he != NULL) {
3864 Jim_HashEntry *nextEntry = he->next;
3865 Jim_Var *varPtr = (void*) he->val;
3866
3867 Jim_DecrRefCount(interp, varPtr->objPtr);
3868 Jim_Free(he->val);
3869 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3870 Jim_Free(he);
3871 table[i] = NULL;
3872 he = nextEntry;
3873 }
3874 }
3875 cf->vars.used = 0;
3876 }
3877 cf->nextFramePtr = interp->freeFramesList;
3878 interp->freeFramesList = cf;
3879 }
3880
3881 /* -----------------------------------------------------------------------------
3882 * References
3883 * ---------------------------------------------------------------------------*/
3884
3885 /* References HashTable Type.
3886 *
3887 * Keys are jim_wide integers, dynamically allocated for now but in the
3888 * future it's worth to cache this 8 bytes objects. Values are poitners
3889 * to Jim_References. */
3890 static void JimReferencesHTValDestructor(void *interp, void *val)
3891 {
3892 Jim_Reference *refPtr = (void*) val;
3893
3894 Jim_DecrRefCount(interp, refPtr->objPtr);
3895 if (refPtr->finalizerCmdNamePtr != NULL) {
3896 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
3897 }
3898 Jim_Free(val);
3899 }
3900
3901 unsigned int JimReferencesHTHashFunction(const void *key)
3902 {
3903 /* Only the least significant bits are used. */
3904 const jim_wide *widePtr = key;
3905 unsigned int intValue = (unsigned int) *widePtr;
3906 return Jim_IntHashFunction(intValue);
3907 }
3908
3909 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
3910 {
3911 /* Only the least significant bits are used. */
3912 const jim_wide *widePtr = key;
3913 unsigned int intValue = (unsigned int) *widePtr;
3914 return intValue; /* identity function. */
3915 }
3916
3917 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
3918 {
3919 void *copy = Jim_Alloc(sizeof(jim_wide));
3920 JIM_NOTUSED(privdata);
3921
3922 memcpy(copy, key, sizeof(jim_wide));
3923 return copy;
3924 }
3925
3926 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
3927 const void *key2)
3928 {
3929 JIM_NOTUSED(privdata);
3930
3931 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
3932 }
3933
3934 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
3935 {
3936 JIM_NOTUSED(privdata);
3937
3938 Jim_Free((void*)key);
3939 }
3940
3941 static Jim_HashTableType JimReferencesHashTableType = {
3942 JimReferencesHTHashFunction, /* hash function */
3943 JimReferencesHTKeyDup, /* key dup */
3944 NULL, /* val dup */
3945 JimReferencesHTKeyCompare, /* key compare */
3946 JimReferencesHTKeyDestructor, /* key destructor */
3947 JimReferencesHTValDestructor /* val destructor */
3948 };
3949
3950 /* -----------------------------------------------------------------------------
3951 * Reference object type and References API
3952 * ---------------------------------------------------------------------------*/
3953
3954 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
3955
3956 static Jim_ObjType referenceObjType = {
3957 "reference",
3958 NULL,
3959 NULL,
3960 UpdateStringOfReference,
3961 JIM_TYPE_REFERENCES,
3962 };
3963
3964 void UpdateStringOfReference(struct Jim_Obj *objPtr)
3965 {
3966 int len;
3967 char buf[JIM_REFERENCE_SPACE+1];
3968 Jim_Reference *refPtr;
3969
3970 refPtr = objPtr->internalRep.refValue.refPtr;
3971 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
3972 objPtr->bytes = Jim_Alloc(len+1);
3973 memcpy(objPtr->bytes, buf, len+1);
3974 objPtr->length = len;
3975 }
3976
3977 /* returns true if 'c' is a valid reference tag character.
3978 * i.e. inside the range [_a-zA-Z0-9] */
3979 static int isrefchar(int c)
3980 {
3981 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
3982 (c >= '0' && c <= '9')) return 1;
3983 return 0;
3984 }
3985
3986 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3987 {
3988 jim_wide wideValue;
3989 int i, len;
3990 const char *str, *start, *end;
3991 char refId[21];
3992 Jim_Reference *refPtr;
3993 Jim_HashEntry *he;
3994
3995 /* Get the string representation */
3996 str = Jim_GetString(objPtr, &len);
3997 /* Check if it looks like a reference */
3998 if (len < JIM_REFERENCE_SPACE) goto badformat;
3999 /* Trim spaces */
4000 start = str;
4001 end = str+len-1;
4002 while (*start == ' ') start++;
4003 while (*end == ' ' && end > start) end--;
4004 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4005 /* <reference.<1234567>.%020> */
4006 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4007 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4008 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4009 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4010 if (!isrefchar(start[12+i])) goto badformat;
4011 }
4012 /* Extract info from the refernece. */
4013 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4014 refId[20] = '\0';
4015 /* Try to convert the ID into a jim_wide */
4016 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4017 /* Check if the reference really exists! */
4018 he = Jim_FindHashEntry(&interp->references, &wideValue);
4019 if (he == NULL) {
4020 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4021 Jim_AppendStrings(interp, Jim_GetResult(interp),
4022 "Invalid reference ID \"", str, "\"", NULL);
4023 return JIM_ERR;
4024 }
4025 refPtr = he->val;
4026 /* Free the old internal repr and set the new one. */
4027 Jim_FreeIntRep(interp, objPtr);
4028 objPtr->typePtr = &referenceObjType;
4029 objPtr->internalRep.refValue.id = wideValue;
4030 objPtr->internalRep.refValue.refPtr = refPtr;
4031 return JIM_OK;
4032
4033 badformat:
4034 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4035 Jim_AppendStrings(interp, Jim_GetResult(interp),
4036 "expected reference but got \"", str, "\"", NULL);
4037 return JIM_ERR;
4038 }
4039
4040 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4041 * as finalizer command (or NULL if there is no finalizer).
4042 * The returned reference object has refcount = 0. */
4043 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4044 Jim_Obj *cmdNamePtr)
4045 {
4046 struct Jim_Reference *refPtr;
4047 jim_wide wideValue = interp->referenceNextId;
4048 Jim_Obj *refObjPtr;
4049 const char *tag;
4050 int tagLen, i;
4051
4052 /* Perform the Garbage Collection if needed. */
4053 Jim_CollectIfNeeded(interp);
4054
4055 refPtr = Jim_Alloc(sizeof(*refPtr));
4056 refPtr->objPtr = objPtr;
4057 Jim_IncrRefCount(objPtr);
4058 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4059 if (cmdNamePtr)
4060 Jim_IncrRefCount(cmdNamePtr);
4061 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4062 refObjPtr = Jim_NewObj(interp);
4063 refObjPtr->typePtr = &referenceObjType;
4064 refObjPtr->bytes = NULL;
4065 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4066 refObjPtr->internalRep.refValue.refPtr = refPtr;
4067 interp->referenceNextId++;
4068 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4069 * that does not pass the 'isrefchar' test is replaced with '_' */
4070 tag = Jim_GetString(tagPtr, &tagLen);
4071 if (tagLen > JIM_REFERENCE_TAGLEN)
4072 tagLen = JIM_REFERENCE_TAGLEN;
4073 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4074 if (i < tagLen)
4075 refPtr->tag[i] = tag[i];
4076 else
4077 refPtr->tag[i] = '_';
4078 }
4079 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4080 return refObjPtr;
4081 }
4082
4083 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4084 {
4085 if (objPtr->typePtr != &referenceObjType &&
4086 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4087 return NULL;
4088 return objPtr->internalRep.refValue.refPtr;
4089 }
4090
4091 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4092 {
4093 Jim_Reference *refPtr;
4094
4095 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4096 return JIM_ERR;
4097 Jim_IncrRefCount(cmdNamePtr);
4098 if (refPtr->finalizerCmdNamePtr)
4099 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4100 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4101 return JIM_OK;
4102 }
4103
4104 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4105 {
4106 Jim_Reference *refPtr;
4107
4108 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4109 return JIM_ERR;
4110 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4111 return JIM_OK;
4112 }
4113
4114 /* -----------------------------------------------------------------------------
4115 * References Garbage Collection
4116 * ---------------------------------------------------------------------------*/
4117
4118 /* This the hash table type for the "MARK" phase of the GC */
4119 static Jim_HashTableType JimRefMarkHashTableType = {
4120 JimReferencesHTHashFunction, /* hash function */
4121 JimReferencesHTKeyDup, /* key dup */
4122 NULL, /* val dup */
4123 JimReferencesHTKeyCompare, /* key compare */
4124 JimReferencesHTKeyDestructor, /* key destructor */
4125 NULL /* val destructor */
4126 };
4127
4128 /* #define JIM_DEBUG_GC 1 */
4129
4130 /* Performs the garbage collection. */
4131 int Jim_Collect(Jim_Interp *interp)
4132 {
4133 Jim_HashTable marks;
4134 Jim_HashTableIterator *htiter;
4135 Jim_HashEntry *he;
4136 Jim_Obj *objPtr;
4137 int collected = 0;
4138
4139 /* Avoid recursive calls */
4140 if (interp->lastCollectId == -1) {
4141 /* Jim_Collect() already running. Return just now. */
4142 return 0;
4143 }
4144 interp->lastCollectId = -1;
4145
4146 /* Mark all the references found into the 'mark' hash table.
4147 * The references are searched in every live object that
4148 * is of a type that can contain references. */
4149 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4150 objPtr = interp->liveList;
4151 while(objPtr) {
4152 if (objPtr->typePtr == NULL ||
4153 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4154 const char *str, *p;
4155 int len;
4156
4157 /* If the object is of type reference, to get the
4158 * Id is simple... */
4159 if (objPtr->typePtr == &referenceObjType) {
4160 Jim_AddHashEntry(&marks,
4161 &objPtr->internalRep.refValue.id, NULL);
4162 #ifdef JIM_DEBUG_GC
4163 Jim_fprintf(interp,interp->cookie_stdout,
4164 "MARK (reference): %d refcount: %d" JIM_NL,
4165 (int) objPtr->internalRep.refValue.id,
4166 objPtr->refCount);
4167 #endif
4168 objPtr = objPtr->nextObjPtr;
4169 continue;
4170 }
4171 /* Get the string repr of the object we want
4172 * to scan for references. */
4173 p = str = Jim_GetString(objPtr, &len);
4174 /* Skip objects too little to contain references. */
4175 if (len < JIM_REFERENCE_SPACE) {
4176 objPtr = objPtr->nextObjPtr;
4177 continue;
4178 }
4179 /* Extract references from the object string repr. */
4180 while(1) {
4181 int i;
4182 jim_wide id;
4183 char buf[21];
4184
4185 if ((p = strstr(p, "<reference.<")) == NULL)
4186 break;
4187 /* Check if it's a valid reference. */
4188 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4189 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4190 for (i = 21; i <= 40; i++)
4191 if (!isdigit((int)p[i]))
4192 break;
4193 /* Get the ID */
4194 memcpy(buf, p+21, 20);
4195 buf[20] = '\0';
4196 Jim_StringToWide(buf, &id, 10);
4197
4198 /* Ok, a reference for the given ID
4199 * was found. Mark it. */
4200 Jim_AddHashEntry(&marks, &id, NULL);
4201 #ifdef JIM_DEBUG_GC
4202 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4203 #endif
4204 p += JIM_REFERENCE_SPACE;
4205 }
4206 }
4207 objPtr = objPtr->nextObjPtr;
4208 }
4209
4210 /* Run the references hash table to destroy every reference that
4211 * is not referenced outside (not present in the mark HT). */
4212 htiter = Jim_GetHashTableIterator(&interp->references);
4213 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4214 const jim_wide *refId;
4215 Jim_Reference *refPtr;
4216
4217 refId = he->key;
4218 /* Check if in the mark phase we encountered
4219 * this reference. */
4220 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4221 #ifdef JIM_DEBUG_GC
4222 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4223 #endif
4224 collected++;
4225 /* Drop the reference, but call the
4226 * finalizer first if registered. */
4227 refPtr = he->val;
4228 if (refPtr->finalizerCmdNamePtr) {
4229 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4230 Jim_Obj *objv[3], *oldResult;
4231
4232 JimFormatReference(refstr, refPtr, *refId);
4233
4234 objv[0] = refPtr->finalizerCmdNamePtr;
4235 objv[1] = Jim_NewStringObjNoAlloc(interp,
4236 refstr, 32);
4237 objv[2] = refPtr->objPtr;
4238 Jim_IncrRefCount(objv[0]);
4239 Jim_IncrRefCount(objv[1]);
4240 Jim_IncrRefCount(objv[2]);
4241
4242 /* Drop the reference itself */
4243 Jim_DeleteHashEntry(&interp->references, refId);
4244
4245 /* Call the finalizer. Errors ignored. */
4246 oldResult = interp->result;
4247 Jim_IncrRefCount(oldResult);
4248 Jim_EvalObjVector(interp, 3, objv);
4249 Jim_SetResult(interp, oldResult);
4250 Jim_DecrRefCount(interp, oldResult);
4251
4252 Jim_DecrRefCount(interp, objv[0]);
4253 Jim_DecrRefCount(interp, objv[1]);
4254 Jim_DecrRefCount(interp, objv[2]);
4255 } else {
4256 Jim_DeleteHashEntry(&interp->references, refId);
4257 }
4258 }
4259 }
4260 Jim_FreeHashTableIterator(htiter);
4261 Jim_FreeHashTable(&marks);
4262 interp->lastCollectId = interp->referenceNextId;
4263 interp->lastCollectTime = time(NULL);
4264 return collected;
4265 }
4266
4267 #define JIM_COLLECT_ID_PERIOD 5000
4268 #define JIM_COLLECT_TIME_PERIOD 300
4269
4270 void Jim_CollectIfNeeded(Jim_Interp *interp)
4271 {
4272 jim_wide elapsedId;
4273 int elapsedTime;
4274
4275 elapsedId = interp->referenceNextId - interp->lastCollectId;
4276 elapsedTime = time(NULL) - interp->lastCollectTime;
4277
4278
4279 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4280 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4281 Jim_Collect(interp);
4282 }
4283 }
4284
4285 /* -----------------------------------------------------------------------------
4286 * Interpreter related functions
4287 * ---------------------------------------------------------------------------*/
4288
4289 Jim_Interp *Jim_CreateInterp(void)
4290 {
4291 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4292 Jim_Obj *pathPtr;
4293
4294 i->errorLine = 0;
4295 i->errorFileName = Jim_StrDup("");
4296 i->numLevels = 0;
4297 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4298 i->returnCode = JIM_OK;
4299 i->exitCode = 0;
4300 i->procEpoch = 0;
4301 i->callFrameEpoch = 0;
4302 i->liveList = i->freeList = NULL;
4303 i->scriptFileName = Jim_StrDup("");
4304 i->referenceNextId = 0;
4305 i->lastCollectId = 0;
4306 i->lastCollectTime = time(NULL);
4307 i->freeFramesList = NULL;
4308 i->prngState = NULL;
4309 i->evalRetcodeLevel = -1;
4310 i->cookie_stdin = stdin;
4311 i->cookie_stdout = stdout;
4312 i->cookie_stderr = stderr;
4313 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4314 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4315 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4316 i->cb_fflush = ((int (*)( void *))(fflush));
4317 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4318
4319 /* Note that we can create objects only after the
4320 * interpreter liveList and freeList pointers are
4321 * initialized to NULL. */
4322 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4323 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4324 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4325 NULL);
4326 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4327 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4328 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4329 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4330 i->emptyObj = Jim_NewEmptyStringObj(i);
4331 i->result = i->emptyObj;
4332 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4333 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4334 Jim_IncrRefCount(i->emptyObj);
4335 Jim_IncrRefCount(i->result);
4336 Jim_IncrRefCount(i->stackTrace);
4337 Jim_IncrRefCount(i->unknown);
4338
4339 /* Initialize key variables every interpreter should contain */
4340 pathPtr = Jim_NewStringObj(i, "./", -1);
4341 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4342 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4343
4344 /* Export the core API to extensions */
4345 JimRegisterCoreApi(i);
4346 return i;
4347 }
4348
4349 /* This is the only function Jim exports directly without
4350 * to use the STUB system. It is only used by embedders
4351 * in order to get an interpreter with the Jim API pointers
4352 * registered. */
4353 Jim_Interp *ExportedJimCreateInterp(void)
4354 {
4355 return Jim_CreateInterp();
4356 }
4357
4358 void Jim_FreeInterp(Jim_Interp *i)
4359 {
4360 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4361 Jim_Obj *objPtr, *nextObjPtr;
4362
4363 Jim_DecrRefCount(i, i->emptyObj);
4364 Jim_DecrRefCount(i, i->result);
4365 Jim_DecrRefCount(i, i->stackTrace);
4366 Jim_DecrRefCount(i, i->unknown);
4367 Jim_Free((void*)i->errorFileName);
4368 Jim_Free((void*)i->scriptFileName);
4369 Jim_FreeHashTable(&i->commands);
4370 Jim_FreeHashTable(&i->references);
4371 Jim_FreeHashTable(&i->stub);
4372 Jim_FreeHashTable(&i->assocData);
4373 Jim_FreeHashTable(&i->packages);
4374 Jim_Free(i->prngState);
4375 /* Free the call frames list */
4376 while(cf) {
4377 prevcf = cf->parentCallFrame;
4378 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4379 cf = prevcf;
4380 }
4381 /* Check that the live object list is empty, otherwise
4382 * there is a memory leak. */
4383 if (i->liveList != NULL) {
4384 Jim_Obj *objPtr = i->liveList;
4385
4386 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4387 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4388 while(objPtr) {
4389 const char *type = objPtr->typePtr ?
4390 objPtr->typePtr->name : "";
4391 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4392 objPtr, type,
4393 objPtr->bytes ? objPtr->bytes
4394 : "(null)", objPtr->refCount);
4395 if (objPtr->typePtr == &sourceObjType) {
4396 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4397 objPtr->internalRep.sourceValue.fileName,
4398 objPtr->internalRep.sourceValue.lineNumber);
4399 }
4400 objPtr = objPtr->nextObjPtr;
4401 }
4402 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4403 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4404 }
4405 /* Free all the freed objects. */
4406 objPtr = i->freeList;
4407 while (objPtr) {
4408 nextObjPtr = objPtr->nextObjPtr;
4409 Jim_Free(objPtr);
4410 objPtr = nextObjPtr;
4411 }
4412 /* Free cached CallFrame structures */
4413 cf = i->freeFramesList;
4414 while(cf) {
4415 nextcf = cf->nextFramePtr;
4416 if (cf->vars.table != NULL)
4417 Jim_Free(cf->vars.table);
4418 Jim_Free(cf);
4419 cf = nextcf;
4420 }
4421 /* Free the sharedString hash table. Make sure to free it
4422 * after every other Jim_Object was freed. */
4423 Jim_FreeHashTable(&i->sharedStrings);
4424 /* Free the interpreter structure. */
4425 Jim_Free(i);
4426 }
4427
4428 /* Store the call frame relative to the level represented by
4429 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4430 * level is assumed to be '1'.
4431 *
4432 * If a newLevelptr int pointer is specified, the function stores
4433 * the absolute level integer value of the new target callframe into
4434 * *newLevelPtr. (this is used to adjust interp->numLevels
4435 * in the implementation of [uplevel], so that [info level] will
4436 * return a correct information).
4437 *
4438 * This function accepts the 'level' argument in the form
4439 * of the commands [uplevel] and [upvar].
4440 *
4441 * For a function accepting a relative integer as level suitable
4442 * for implementation of [info level ?level?] check the
4443 * GetCallFrameByInteger() function. */
4444 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4445 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4446 {
4447 long level;
4448 const char *str;
4449 Jim_CallFrame *framePtr;
4450
4451 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4452 if (levelObjPtr) {
4453 str = Jim_GetString(levelObjPtr, NULL);
4454 if (str[0] == '#') {
4455 char *endptr;
4456 /* speedup for the toplevel (level #0) */
4457 if (str[1] == '0' && str[2] == '\0') {
4458 if (newLevelPtr) *newLevelPtr = 0;
4459 *framePtrPtr = interp->topFramePtr;
4460 return JIM_OK;
4461 }
4462
4463 level = strtol(str+1, &endptr, 0);
4464 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4465 goto badlevel;
4466 /* An 'absolute' level is converted into the
4467 * 'number of levels to go back' format. */
4468 level = interp->numLevels - level;
4469 if (level < 0) goto badlevel;
4470 } else {
4471 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4472 goto badlevel;
4473 }
4474 } else {
4475 str = "1"; /* Needed to format the error message. */
4476 level = 1;
4477 }
4478 /* Lookup */
4479 framePtr = interp->framePtr;
4480 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4481 while (level--) {
4482 framePtr = framePtr->parentCallFrame;
4483 if (framePtr == NULL) goto badlevel;
4484 }
4485 *framePtrPtr = framePtr;
4486 return JIM_OK;
4487 badlevel:
4488 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4489 Jim_AppendStrings(interp, Jim_GetResult(interp),
4490 "bad level \"", str, "\"", NULL);
4491 return JIM_ERR;
4492 }
4493
4494 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4495 * as a relative integer like in the [info level ?level?] command. */
4496 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4497 Jim_CallFrame **framePtrPtr)
4498 {
4499 jim_wide level;
4500 jim_wide relLevel; /* level relative to the current one. */
4501 Jim_CallFrame *framePtr;
4502
4503 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4504 goto badlevel;
4505 if (level > 0) {
4506 /* An 'absolute' level is converted into the
4507 * 'number of levels to go back' format. */
4508 relLevel = interp->numLevels - level;
4509 } else {
4510 relLevel = -level;
4511 }
4512 /* Lookup */
4513 framePtr = interp->framePtr;
4514 while (relLevel--) {
4515 framePtr = framePtr->parentCallFrame;
4516 if (framePtr == NULL) goto badlevel;
4517 }
4518 *framePtrPtr = framePtr;
4519 return JIM_OK;
4520 badlevel:
4521 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4522 Jim_AppendStrings(interp, Jim_GetResult(interp),
4523 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4524 return JIM_ERR;
4525 }
4526
4527 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4528 {
4529 Jim_Free((void*)interp->errorFileName);
4530 interp->errorFileName = Jim_StrDup(filename);
4531 }
4532
4533 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4534 {
4535 interp->errorLine = linenr;
4536 }
4537
4538 static void JimResetStackTrace(Jim_Interp *interp)
4539 {
4540 Jim_DecrRefCount(interp, interp->stackTrace);
4541 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4542 Jim_IncrRefCount(interp->stackTrace);
4543 }
4544
4545 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4546 const char *filename, int linenr)
4547 {
4548 if (Jim_IsShared(interp->stackTrace)) {
4549 interp->stackTrace =
4550 Jim_DuplicateObj(interp, interp->stackTrace);
4551 Jim_IncrRefCount(interp->stackTrace);
4552 }
4553 Jim_ListAppendElement(interp, interp->stackTrace,
4554 Jim_NewStringObj(interp, procname, -1));
4555 Jim_ListAppendElement(interp, interp->stackTrace,
4556 Jim_NewStringObj(interp, filename, -1));
4557 Jim_ListAppendElement(interp, interp->stackTrace,
4558 Jim_NewIntObj(interp, linenr));
4559 }
4560
4561 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4562 {
4563 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4564 assocEntryPtr->delProc = delProc;
4565 assocEntryPtr->data = data;
4566 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4567 }
4568
4569 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4570 {
4571 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4572 if (entryPtr != NULL) {
4573 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4574 return assocEntryPtr->data;
4575 }
4576 return NULL;
4577 }
4578
4579 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4580 {
4581 return Jim_DeleteHashEntry(&interp->assocData, key);
4582 }
4583
4584 int Jim_GetExitCode(Jim_Interp *interp) {
4585 return interp->exitCode;
4586 }
4587
4588 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4589 {
4590 if (fp != NULL) interp->cookie_stdin = fp;
4591 return interp->cookie_stdin;
4592 }
4593
4594 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4595 {
4596 if (fp != NULL) interp->cookie_stdout = fp;
4597 return interp->cookie_stdout;
4598 }
4599
4600 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4601 {
4602 if (fp != NULL) interp->cookie_stderr = fp;
4603 return interp->cookie_stderr;
4604 }
4605
4606 /* -----------------------------------------------------------------------------
4607 * Shared strings.
4608 * Every interpreter has an hash table where to put shared dynamically
4609 * allocate strings that are likely to be used a lot of times.
4610 * For example, in the 'source' object type, there is a pointer to
4611 * the filename associated with that object. Every script has a lot
4612 * of this objects with the identical file name, so it is wise to share
4613 * this info.
4614 *
4615 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4616 * returns the pointer to the shared string. Every time a reference
4617 * to the string is no longer used, the user should call
4618 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4619 * a given string, it is removed from the hash table.
4620 * ---------------------------------------------------------------------------*/
4621 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4622 {
4623 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4624
4625 if (he == NULL) {
4626 char *strCopy = Jim_StrDup(str);
4627
4628 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4629 return strCopy;
4630 } else {
4631 long refCount = (long) he->val;
4632
4633 refCount++;
4634 he->val = (void*) refCount;
4635 return he->key;
4636 }
4637 }
4638
4639 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4640 {
4641 long refCount;
4642 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4643
4644 if (he == NULL)
4645 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4646 "unknown shared string '%s'", str);
4647 refCount = (long) he->val;
4648 refCount--;
4649 if (refCount == 0) {
4650 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4651 } else {
4652 he->val = (void*) refCount;
4653 }
4654 }
4655
4656 /* -----------------------------------------------------------------------------
4657 * Integer object
4658 * ---------------------------------------------------------------------------*/
4659 #define JIM_INTEGER_SPACE 24
4660
4661 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4662 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4663
4664 static Jim_ObjType intObjType = {
4665 "int",
4666 NULL,
4667 NULL,
4668 UpdateStringOfInt,
4669 JIM_TYPE_NONE,
4670 };
4671
4672 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4673 {
4674 int len;
4675 char buf[JIM_INTEGER_SPACE+1];
4676
4677 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4678 objPtr->bytes = Jim_Alloc(len+1);
4679 memcpy(objPtr->bytes, buf, len+1);
4680 objPtr->length = len;
4681 }
4682
4683 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4684 {
4685 jim_wide wideValue;
4686 const char *str;
4687
4688 /* Get the string representation */
4689 str = Jim_GetString(objPtr, NULL);
4690 /* Try to convert into a jim_wide */
4691 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4692 if (flags & JIM_ERRMSG) {
4693 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4694 Jim_AppendStrings(interp, Jim_GetResult(interp),
4695 "expected integer but got \"", str, "\"", NULL);
4696 }
4697 return JIM_ERR;
4698 }
4699 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4700 errno == ERANGE) {
4701 Jim_SetResultString(interp,
4702 "Integer value too big to be represented", -1);
4703 return JIM_ERR;
4704 }
4705 /* Free the old internal repr and set the new one. */
4706 Jim_FreeIntRep(interp, objPtr);
4707 objPtr->typePtr = &intObjType;
4708 objPtr->internalRep.wideValue = wideValue;
4709 return JIM_OK;
4710 }
4711
4712 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4713 {
4714 if (objPtr->typePtr != &intObjType &&
4715 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4716 return JIM_ERR;
4717 *widePtr = objPtr->internalRep.wideValue;
4718 return JIM_OK;
4719 }
4720
4721 /* Get a wide but does not set an error if the format is bad. */
4722 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4723 jim_wide *widePtr)
4724 {
4725 if (objPtr->typePtr != &intObjType &&
4726 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4727 return JIM_ERR;
4728 *widePtr = objPtr->internalRep.wideValue;
4729 return JIM_OK;
4730 }
4731
4732 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4733 {
4734 jim_wide wideValue;
4735 int retval;
4736
4737 retval = Jim_GetWide(interp, objPtr, &wideValue);
4738 if (retval == JIM_OK) {
4739 *longPtr = (long) wideValue;
4740 return JIM_OK;
4741 }
4742 return JIM_ERR;
4743 }
4744
4745 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4746 {
4747 if (Jim_IsShared(objPtr))
4748 Jim_Panic(interp,"Jim_SetWide called with shared object");
4749 if (objPtr->typePtr != &intObjType) {
4750 Jim_FreeIntRep(interp, objPtr);
4751 objPtr->typePtr = &intObjType;
4752 }
4753 Jim_InvalidateStringRep(objPtr);
4754 objPtr->internalRep.wideValue = wideValue;
4755 }
4756
4757 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4758 {
4759 Jim_Obj *objPtr;
4760
4761 objPtr = Jim_NewObj(interp);
4762 objPtr->typePtr = &intObjType;
4763 objPtr->bytes = NULL;
4764 objPtr->internalRep.wideValue = wideValue;
4765 return objPtr;
4766 }
4767
4768 /* -----------------------------------------------------------------------------
4769 * Double object
4770 * ---------------------------------------------------------------------------*/
4771 #define JIM_DOUBLE_SPACE 30
4772
4773 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4774 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4775
4776 static Jim_ObjType doubleObjType = {
4777 "double",
4778 NULL,
4779 NULL,
4780 UpdateStringOfDouble,
4781 JIM_TYPE_NONE,
4782 };
4783
4784 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4785 {
4786 int len;
4787 char buf[JIM_DOUBLE_SPACE+1];
4788
4789 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4790 objPtr->bytes = Jim_Alloc(len+1);
4791 memcpy(objPtr->bytes, buf, len+1);
4792 objPtr->length = len;
4793 }
4794
4795 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4796 {
4797 double doubleValue;
4798 const char *str;
4799
4800 /* Get the string representation */
4801 str = Jim_GetString(objPtr, NULL);
4802 /* Try to convert into a double */
4803 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4804 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4805 Jim_AppendStrings(interp, Jim_GetResult(interp),
4806 "expected number but got '", str, "'", NULL);
4807 return JIM_ERR;
4808 }
4809 /* Free the old internal repr and set the new one. */
4810 Jim_FreeIntRep(interp, objPtr);
4811 objPtr->typePtr = &doubleObjType;
4812 objPtr->internalRep.doubleValue = doubleValue;
4813 return JIM_OK;
4814 }
4815
4816 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4817 {
4818 if (objPtr->typePtr != &doubleObjType &&
4819 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4820 return JIM_ERR;
4821 *doublePtr = objPtr->internalRep.doubleValue;
4822 return JIM_OK;
4823 }
4824
4825 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4826 {
4827 if (Jim_IsShared(objPtr))
4828 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4829 if (objPtr->typePtr != &doubleObjType) {
4830 Jim_FreeIntRep(interp, objPtr);
4831 objPtr->typePtr = &doubleObjType;
4832 }
4833 Jim_InvalidateStringRep(objPtr);
4834 objPtr->internalRep.doubleValue = doubleValue;
4835 }
4836
4837 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4838 {
4839 Jim_Obj *objPtr;
4840
4841 objPtr = Jim_NewObj(interp);
4842 objPtr->typePtr = &doubleObjType;
4843 objPtr->bytes = NULL;
4844 objPtr->internalRep.doubleValue = doubleValue;
4845 return objPtr;
4846 }
4847
4848 /* -----------------------------------------------------------------------------
4849 * List object
4850 * ---------------------------------------------------------------------------*/
4851 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4852 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4853 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4854 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4855 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4856
4857 /* Note that while the elements of the list may contain references,
4858 * the list object itself can't. This basically means that the
4859 * list object string representation as a whole can't contain references
4860 * that are not presents in the single elements. */
4861 static Jim_ObjType listObjType = {
4862 "list",
4863 FreeListInternalRep,
4864 DupListInternalRep,
4865 UpdateStringOfList,
4866 JIM_TYPE_NONE,
4867 };
4868
4869 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4870 {
4871 int i;
4872
4873 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4874 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4875 }
4876 Jim_Free(objPtr->internalRep.listValue.ele);
4877 }
4878
4879 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4880 {
4881 int i;
4882 JIM_NOTUSED(interp);
4883
4884 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
4885 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
4886 dupPtr->internalRep.listValue.ele =
4887 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
4888 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
4889 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
4890 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
4891 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
4892 }
4893 dupPtr->typePtr = &listObjType;
4894 }
4895
4896 /* The following function checks if a given string can be encoded
4897 * into a list element without any kind of quoting, surrounded by braces,
4898 * or using escapes to quote. */
4899 #define JIM_ELESTR_SIMPLE 0
4900 #define JIM_ELESTR_BRACE 1
4901 #define JIM_ELESTR_QUOTE 2
4902 static int ListElementQuotingType(const char *s, int len)
4903 {
4904 int i, level, trySimple = 1;
4905
4906 /* Try with the SIMPLE case */
4907 if (len == 0) return JIM_ELESTR_BRACE;
4908 if (s[0] == '"' || s[0] == '{') {
4909 trySimple = 0;
4910 goto testbrace;
4911 }
4912 for (i = 0; i < len; i++) {
4913 switch(s[i]) {
4914 case ' ':
4915 case '$':
4916 case '"':
4917 case '[':
4918 case ']':
4919 case ';':
4920 case '\\':
4921 case '\r':
4922 case '\n':
4923 case '\t':
4924 case '\f':
4925 case '\v':
4926 trySimple = 0;
4927 case '{':
4928 case '}':
4929 goto testbrace;
4930 }
4931 }
4932 return JIM_ELESTR_SIMPLE;
4933
4934 testbrace:
4935 /* Test if it's possible to do with braces */
4936 if (s[len-1] == '\\' ||
4937 s[len-1] == ']') return JIM_ELESTR_QUOTE;
4938 level = 0;
4939 for (i = 0; i < len; i++) {
4940 switch(s[i]) {
4941 case '{': level++; break;
4942 case '}': level--;
4943 if (level < 0) return JIM_ELESTR_QUOTE;
4944 break;
4945 case '\\':
4946 if (s[i+1] == '\n')
4947 return JIM_ELESTR_QUOTE;
4948 else
4949 if (s[i+1] != '\0') i++;
4950 break;
4951 }
4952 }
4953 if (level == 0) {
4954 if (!trySimple) return JIM_ELESTR_BRACE;
4955 for (i = 0; i < len; i++) {
4956 switch(s[i]) {
4957 case ' ':
4958 case '$':
4959 case '"':
4960 case '[':
4961 case ']':
4962 case ';':
4963 case '\\':
4964 case '\r':
4965 case '\n':
4966 case '\t':
4967 case '\f':
4968 case '\v':
4969 return JIM_ELESTR_BRACE;
4970 break;
4971 }
4972 }
4973 return JIM_ELESTR_SIMPLE;
4974 }
4975 return JIM_ELESTR_QUOTE;
4976 }
4977
4978 /* Returns the malloc-ed representation of a string
4979 * using backslash to quote special chars. */
4980 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
4981 {
4982 char *q = Jim_Alloc(len*2+1), *p;
4983
4984 p = q;
4985 while(*s) {
4986 switch (*s) {
4987 case ' ':
4988 case '$':
4989 case '"':
4990 case '[':
4991 case ']':
4992 case '{':
4993 case '}':
4994 case ';':
4995 case '\\':
4996 *p++ = '\\';
4997 *p++ = *s++;
4998 break;
4999 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5000 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5001 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5002 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5003 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5004 default:
5005 *p++ = *s++;
5006 break;
5007 }
5008 }
5009 *p = '\0';
5010 *qlenPtr = p-q;
5011 return q;
5012 }
5013
5014 void UpdateStringOfList(struct Jim_Obj *objPtr)
5015 {
5016 int i, bufLen, realLength;
5017 const char *strRep;
5018 char *p;
5019 int *quotingType;
5020 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5021
5022 /* (Over) Estimate the space needed. */
5023 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5024 bufLen = 0;
5025 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5026 int len;
5027
5028 strRep = Jim_GetString(ele[i], &len);
5029 quotingType[i] = ListElementQuotingType(strRep, len);
5030 switch (quotingType[i]) {
5031 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5032 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5033 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5034 }
5035 bufLen++; /* elements separator. */
5036 }
5037 bufLen++;
5038
5039 /* Generate the string rep. */
5040 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5041 realLength = 0;
5042 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5043 int len, qlen;
5044 const char *strRep = Jim_GetString(ele[i], &len);
5045 char *q;
5046
5047 switch(quotingType[i]) {
5048 case JIM_ELESTR_SIMPLE:
5049 memcpy(p, strRep, len);
5050 p += len;
5051 realLength += len;
5052 break;
5053 case JIM_ELESTR_BRACE:
5054 *p++ = '{';
5055 memcpy(p, strRep, len);
5056 p += len;
5057 *p++ = '}';
5058 realLength += len+2;
5059 break;
5060 case JIM_ELESTR_QUOTE:
5061 q = BackslashQuoteString(strRep, len, &qlen);
5062 memcpy(p, q, qlen);
5063 Jim_Free(q);
5064 p += qlen;
5065 realLength += qlen;
5066 break;
5067 }
5068 /* Add a separating space */
5069 if (i+1 != objPtr->internalRep.listValue.len) {
5070 *p++ = ' ';
5071 realLength ++;
5072 }
5073 }
5074 *p = '\0'; /* nul term. */
5075 objPtr->length = realLength;
5076 Jim_Free(quotingType);
5077 }
5078
5079 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5080 {
5081 struct JimParserCtx parser;
5082 const char *str;
5083 int strLen;
5084
5085 /* Get the string representation */
5086 str = Jim_GetString(objPtr, &strLen);
5087
5088 /* Free the old internal repr just now and initialize the
5089 * new one just now. The string->list conversion can't fail. */
5090 Jim_FreeIntRep(interp, objPtr);
5091 objPtr->typePtr = &listObjType;
5092 objPtr->internalRep.listValue.len = 0;
5093 objPtr->internalRep.listValue.maxLen = 0;
5094 objPtr->internalRep.listValue.ele = NULL;
5095
5096 /* Convert into a list */
5097 JimParserInit(&parser, str, strLen, 1);
5098 while(!JimParserEof(&parser)) {
5099 char *token;
5100 int tokenLen, type;
5101 Jim_Obj *elementPtr;
5102
5103 JimParseList(&parser);
5104 if (JimParserTtype(&parser) != JIM_TT_STR &&
5105 JimParserTtype(&parser) != JIM_TT_ESC)
5106 continue;
5107 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5108 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5109 ListAppendElement(objPtr, elementPtr);
5110 }
5111 return JIM_OK;
5112 }
5113
5114 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5115 int len)
5116 {
5117 Jim_Obj *objPtr;
5118 int i;
5119
5120 objPtr = Jim_NewObj(interp);
5121 objPtr->typePtr = &listObjType;
5122 objPtr->bytes = NULL;
5123 objPtr->internalRep.listValue.ele = NULL;
5124 objPtr->internalRep.listValue.len = 0;
5125 objPtr->internalRep.listValue.maxLen = 0;
5126 for (i = 0; i < len; i++) {
5127 ListAppendElement(objPtr, elements[i]);
5128 }
5129 return objPtr;
5130 }
5131
5132 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5133 * length of the vector. Note that the user of this function should make
5134 * sure that the list object can't shimmer while the vector returned
5135 * is in use, this vector is the one stored inside the internal representation
5136 * of the list object. This function is not exported, extensions should
5137 * always access to the List object elements using Jim_ListIndex(). */
5138 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5139 Jim_Obj ***listVec)
5140 {
5141 Jim_ListLength(interp, listObj, argc);
5142 assert(listObj->typePtr == &listObjType);
5143 *listVec = listObj->internalRep.listValue.ele;
5144 }
5145
5146 /* ListSortElements type values */
5147 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5148 JIM_LSORT_NOCASE_DECR};
5149
5150 /* Sort the internal rep of a list. */
5151 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5152 {
5153 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5154 }
5155
5156 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5157 {
5158 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5159 }
5160
5161 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5162 {
5163 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5164 }
5165
5166 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5167 {
5168 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5169 }
5170
5171 /* Sort a list *in place*. MUST be called with non-shared objects. */
5172 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5173 {
5174 typedef int (qsort_comparator)(const void *, const void *);
5175 int (*fn)(Jim_Obj**, Jim_Obj**);
5176 Jim_Obj **vector;
5177 int len;
5178
5179 if (Jim_IsShared(listObjPtr))
5180 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5181 if (listObjPtr->typePtr != &listObjType)
5182 SetListFromAny(interp, listObjPtr);
5183
5184 vector = listObjPtr->internalRep.listValue.ele;
5185 len = listObjPtr->internalRep.listValue.len;
5186 switch (type) {
5187 case JIM_LSORT_ASCII: fn = ListSortString; break;
5188 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5189 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5190 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5191 default:
5192 fn = NULL; /* avoid warning */
5193 Jim_Panic(interp,"ListSort called with invalid sort type");
5194 }
5195 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5196 Jim_InvalidateStringRep(listObjPtr);
5197 }
5198
5199 /* This is the low-level function to append an element to a list.
5200 * The higher-level Jim_ListAppendElement() performs shared object
5201 * check and invalidate the string repr. This version is used
5202 * in the internals of the List Object and is not exported.
5203 *
5204 * NOTE: this function can be called only against objects
5205 * with internal type of List. */
5206 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5207 {
5208 int requiredLen = listPtr->internalRep.listValue.len + 1;
5209
5210 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5211 int maxLen = requiredLen * 2;
5212
5213 listPtr->internalRep.listValue.ele =
5214 Jim_Realloc(listPtr->internalRep.listValue.ele,
5215 sizeof(Jim_Obj*)*maxLen);
5216 listPtr->internalRep.listValue.maxLen = maxLen;
5217 }
5218 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5219 objPtr;
5220 listPtr->internalRep.listValue.len ++;
5221 Jim_IncrRefCount(objPtr);
5222 }
5223
5224 /* This is the low-level function to insert elements into a list.
5225 * The higher-level Jim_ListInsertElements() performs shared object
5226 * check and invalidate the string repr. This version is used
5227 * in the internals of the List Object and is not exported.
5228 *
5229 * NOTE: this function can be called only against objects
5230 * with internal type of List. */
5231 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5232 Jim_Obj *const *elemVec)
5233 {
5234 int currentLen = listPtr->internalRep.listValue.len;
5235 int requiredLen = currentLen + elemc;
5236 int i;
5237 Jim_Obj **point;
5238
5239 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5240 int maxLen = requiredLen * 2;
5241
5242 listPtr->internalRep.listValue.ele =
5243 Jim_Realloc(listPtr->internalRep.listValue.ele,
5244 sizeof(Jim_Obj*)*maxLen);
5245 listPtr->internalRep.listValue.maxLen = maxLen;
5246 }
5247 point = listPtr->internalRep.listValue.ele + index;
5248 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5249 for (i=0; i < elemc; ++i) {
5250 point[i] = elemVec[i];
5251 Jim_IncrRefCount(point[i]);
5252 }
5253 listPtr->internalRep.listValue.len += elemc;
5254 }
5255
5256 /* Appends every element of appendListPtr into listPtr.
5257 * Both have to be of the list type. */
5258 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5259 {
5260 int i, oldLen = listPtr->internalRep.listValue.len;
5261 int appendLen = appendListPtr->internalRep.listValue.len;
5262 int requiredLen = oldLen + appendLen;
5263
5264 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5265 int maxLen = requiredLen * 2;
5266
5267 listPtr->internalRep.listValue.ele =
5268 Jim_Realloc(listPtr->internalRep.listValue.ele,
5269 sizeof(Jim_Obj*)*maxLen);
5270 listPtr->internalRep.listValue.maxLen = maxLen;
5271 }
5272 for (i = 0; i < appendLen; i++) {
5273 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5274 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5275 Jim_IncrRefCount(objPtr);
5276 }
5277 listPtr->internalRep.listValue.len += appendLen;
5278 }
5279
5280 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5281 {
5282 if (Jim_IsShared(listPtr))
5283 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5284 if (listPtr->typePtr != &listObjType)
5285 SetListFromAny(interp, listPtr);
5286 Jim_InvalidateStringRep(listPtr);
5287 ListAppendElement(listPtr, objPtr);
5288 }
5289
5290 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5291 {
5292 if (Jim_IsShared(listPtr))
5293 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5294 if (listPtr->typePtr != &listObjType)
5295 SetListFromAny(interp, listPtr);
5296 Jim_InvalidateStringRep(listPtr);
5297 ListAppendList(listPtr, appendListPtr);
5298 }
5299
5300 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5301 {
5302 if (listPtr->typePtr != &listObjType)
5303 SetListFromAny(interp, listPtr);
5304 *intPtr = listPtr->internalRep.listValue.len;
5305 }
5306
5307 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5308 int objc, Jim_Obj *const *objVec)
5309 {
5310 if (Jim_IsShared(listPtr))
5311 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5312 if (listPtr->typePtr != &listObjType)
5313 SetListFromAny(interp, listPtr);
5314 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5315 index = listPtr->internalRep.listValue.len;
5316 else if (index < 0 )
5317 index = 0;
5318 Jim_InvalidateStringRep(listPtr);
5319 ListInsertElements(listPtr, index, objc, objVec);
5320 }
5321
5322 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5323 Jim_Obj **objPtrPtr, int flags)
5324 {
5325 if (listPtr->typePtr != &listObjType)
5326 SetListFromAny(interp, listPtr);
5327 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5328 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5329 if (flags & JIM_ERRMSG) {
5330 Jim_SetResultString(interp,
5331 "list index out of range", -1);
5332 }
5333 return JIM_ERR;
5334 }
5335 if (index < 0)
5336 index = listPtr->internalRep.listValue.len+index;
5337 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5338 return JIM_OK;
5339 }
5340
5341 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5342 Jim_Obj *newObjPtr, int flags)
5343 {
5344 if (listPtr->typePtr != &listObjType)
5345 SetListFromAny(interp, listPtr);
5346 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5347 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5348 if (flags & JIM_ERRMSG) {
5349 Jim_SetResultString(interp,
5350 "list index out of range", -1);
5351 }
5352 return JIM_ERR;
5353 }
5354 if (index < 0)
5355 index = listPtr->internalRep.listValue.len+index;
5356 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5357 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5358 Jim_IncrRefCount(newObjPtr);
5359 return JIM_OK;
5360 }
5361
5362 /* Modify the list stored into the variable named 'varNamePtr'
5363 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5364 * with the new element 'newObjptr'. */
5365 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5366 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5367 {
5368 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5369 int shared, i, index;
5370
5371 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5372 if (objPtr == NULL)
5373 return JIM_ERR;
5374 if ((shared = Jim_IsShared(objPtr)))
5375 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5376 for (i = 0; i < indexc-1; i++) {
5377 listObjPtr = objPtr;
5378 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5379 goto err;
5380 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5381 JIM_ERRMSG) != JIM_OK) {
5382 goto err;
5383 }
5384 if (Jim_IsShared(objPtr)) {
5385 objPtr = Jim_DuplicateObj(interp, objPtr);
5386 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5387 }
5388 Jim_InvalidateStringRep(listObjPtr);
5389 }
5390 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5391 goto err;
5392 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5393 goto err;
5394 Jim_InvalidateStringRep(objPtr);
5395 Jim_InvalidateStringRep(varObjPtr);
5396 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5397 goto err;
5398 Jim_SetResult(interp, varObjPtr);
5399 return JIM_OK;
5400 err:
5401 if (shared) {
5402 Jim_FreeNewObj(interp, varObjPtr);
5403 }
5404 return JIM_ERR;
5405 }
5406
5407 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5408 {
5409 int i;
5410
5411 /* If all the objects in objv are lists without string rep.
5412 * it's possible to return a list as result, that's the
5413 * concatenation of all the lists. */
5414 for (i = 0; i < objc; i++) {
5415 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5416 break;
5417 }
5418 if (i == objc) {
5419 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5420 for (i = 0; i < objc; i++)
5421 Jim_ListAppendList(interp, objPtr, objv[i]);
5422 return objPtr;
5423 } else {
5424 /* Else... we have to glue strings together */
5425 int len = 0, objLen;
5426 char *bytes, *p;
5427
5428 /* Compute the length */
5429 for (i = 0; i < objc; i++) {
5430 Jim_GetString(objv[i], &objLen);
5431 len += objLen;
5432 }
5433 if (objc) len += objc-1;
5434 /* Create the string rep, and a stinrg object holding it. */
5435 p = bytes = Jim_Alloc(len+1);
5436 for (i = 0; i < objc; i++) {
5437 const char *s = Jim_GetString(objv[i], &objLen);
5438 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5439 {
5440 s++; objLen--; len--;
5441 }
5442 while (objLen && (s[objLen-1] == ' ' ||
5443 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5444 objLen--; len--;
5445 }
5446 memcpy(p, s, objLen);
5447 p += objLen;
5448 if (objLen && i+1 != objc) {
5449 *p++ = ' ';
5450 } else if (i+1 != objc) {
5451 /* Drop the space calcuated for this
5452 * element that is instead null. */
5453 len--;
5454 }
5455 }
5456 *p = '\0';
5457 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5458 }
5459 }
5460
5461 /* Returns a list composed of the elements in the specified range.
5462 * first and start are directly accepted as Jim_Objects and
5463 * processed for the end?-index? case. */
5464 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5465 {
5466 int first, last;
5467 int len, rangeLen;
5468
5469 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5470 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5471 return NULL;
5472 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5473 first = JimRelToAbsIndex(len, first);
5474 last = JimRelToAbsIndex(len, last);
5475 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5476 return Jim_NewListObj(interp,
5477 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5478 }
5479
5480 /* -----------------------------------------------------------------------------
5481 * Dict object
5482 * ---------------------------------------------------------------------------*/
5483 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5484 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5485 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5486 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5487
5488 /* Dict HashTable Type.
5489 *
5490 * Keys and Values are Jim objects. */
5491
5492 unsigned int JimObjectHTHashFunction(const void *key)
5493 {
5494 const char *str;
5495 Jim_Obj *objPtr = (Jim_Obj*) key;
5496 int len, h;
5497
5498 str = Jim_GetString(objPtr, &len);
5499 h = Jim_GenHashFunction((unsigned char*)str, len);
5500 return h;
5501 }
5502
5503 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5504 {
5505 JIM_NOTUSED(privdata);
5506
5507 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5508 }
5509
5510 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5511 {
5512 Jim_Obj *objPtr = val;
5513
5514 Jim_DecrRefCount(interp, objPtr);
5515 }
5516
5517 static Jim_HashTableType JimDictHashTableType = {
5518 JimObjectHTHashFunction, /* hash function */
5519 NULL, /* key dup */
5520 NULL, /* val dup */
5521 JimObjectHTKeyCompare, /* key compare */
5522 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5523 JimObjectHTKeyValDestructor, /* key destructor */
5524 JimObjectHTKeyValDestructor /* val destructor */
5525 };
5526
5527 /* Note that while the elements of the dict may contain references,
5528 * the list object itself can't. This basically means that the
5529 * dict object string representation as a whole can't contain references
5530 * that are not presents in the single elements. */
5531 static Jim_ObjType dictObjType = {
5532 "dict",
5533 FreeDictInternalRep,
5534 DupDictInternalRep,
5535 UpdateStringOfDict,
5536 JIM_TYPE_NONE,
5537 };
5538
5539 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5540 {
5541 JIM_NOTUSED(interp);
5542
5543 Jim_FreeHashTable(objPtr->internalRep.ptr);
5544 Jim_Free(objPtr->internalRep.ptr);
5545 }
5546
5547 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5548 {
5549 Jim_HashTable *ht, *dupHt;
5550 Jim_HashTableIterator *htiter;
5551 Jim_HashEntry *he;
5552
5553 /* Create a new hash table */
5554 ht = srcPtr->internalRep.ptr;
5555 dupHt = Jim_Alloc(sizeof(*dupHt));
5556 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5557 if (ht->size != 0)
5558 Jim_ExpandHashTable(dupHt, ht->size);
5559 /* Copy every element from the source to the dup hash table */
5560 htiter = Jim_GetHashTableIterator(ht);
5561 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5562 const Jim_Obj *keyObjPtr = he->key;
5563 Jim_Obj *valObjPtr = he->val;
5564
5565 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5566 Jim_IncrRefCount(valObjPtr);
5567 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5568 }
5569 Jim_FreeHashTableIterator(htiter);
5570
5571 dupPtr->internalRep.ptr = dupHt;
5572 dupPtr->typePtr = &dictObjType;
5573 }
5574
5575 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5576 {
5577 int i, bufLen, realLength;
5578 const char *strRep;
5579 char *p;
5580 int *quotingType, objc;
5581 Jim_HashTable *ht;
5582 Jim_HashTableIterator *htiter;
5583 Jim_HashEntry *he;
5584 Jim_Obj **objv;
5585
5586 /* Trun the hash table into a flat vector of Jim_Objects. */
5587 ht = objPtr->internalRep.ptr;
5588 objc = ht->used*2;
5589 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5590 htiter = Jim_GetHashTableIterator(ht);
5591 i = 0;
5592 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5593 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5594 objv[i++] = he->val;
5595 }
5596 Jim_FreeHashTableIterator(htiter);
5597 /* (Over) Estimate the space needed. */
5598 quotingType = Jim_Alloc(sizeof(int)*objc);
5599 bufLen = 0;
5600 for (i = 0; i < objc; i++) {
5601 int len;
5602
5603 strRep = Jim_GetString(objv[i], &len);
5604 quotingType[i] = ListElementQuotingType(strRep, len);
5605 switch (quotingType[i]) {
5606 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5607 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5608 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5609 }
5610 bufLen++; /* elements separator. */
5611 }
5612 bufLen++;
5613
5614 /* Generate the string rep. */
5615 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5616 realLength = 0;
5617 for (i = 0; i < objc; i++) {
5618 int len, qlen;
5619 const char *strRep = Jim_GetString(objv[i], &len);
5620 char *q;
5621
5622 switch(quotingType[i]) {
5623 case JIM_ELESTR_SIMPLE:
5624 memcpy(p, strRep, len);
5625 p += len;
5626 realLength += len;
5627 break;
5628 case JIM_ELESTR_BRACE:
5629 *p++ = '{';
5630 memcpy(p, strRep, len);
5631 p += len;
5632 *p++ = '}';
5633 realLength += len+2;
5634 break;
5635 case JIM_ELESTR_QUOTE:
5636 q = BackslashQuoteString(strRep, len, &qlen);
5637 memcpy(p, q, qlen);
5638 Jim_Free(q);
5639 p += qlen;
5640 realLength += qlen;
5641 break;
5642 }
5643 /* Add a separating space */
5644 if (i+1 != objc) {
5645 *p++ = ' ';
5646 realLength ++;
5647 }
5648 }
5649 *p = '\0'; /* nul term. */
5650 objPtr->length = realLength;
5651 Jim_Free(quotingType);
5652 Jim_Free(objv);
5653 }
5654
5655 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5656 {
5657 struct JimParserCtx parser;
5658 Jim_HashTable *ht;
5659 Jim_Obj *objv[2];
5660 const char *str;
5661 int i, strLen;
5662
5663 /* Get the string representation */
5664 str = Jim_GetString(objPtr, &strLen);
5665
5666 /* Free the old internal repr just now and initialize the
5667 * new one just now. The string->list conversion can't fail. */
5668 Jim_FreeIntRep(interp, objPtr);
5669 ht = Jim_Alloc(sizeof(*ht));
5670 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5671 objPtr->typePtr = &dictObjType;
5672 objPtr->internalRep.ptr = ht;
5673
5674 /* Convert into a dict */
5675 JimParserInit(&parser, str, strLen, 1);
5676 i = 0;
5677 while(!JimParserEof(&parser)) {
5678 char *token;
5679 int tokenLen, type;
5680
5681 JimParseList(&parser);
5682 if (JimParserTtype(&parser) != JIM_TT_STR &&
5683 JimParserTtype(&parser) != JIM_TT_ESC)
5684 continue;
5685 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5686 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5687 if (i == 2) {
5688 i = 0;
5689 Jim_IncrRefCount(objv[0]);
5690 Jim_IncrRefCount(objv[1]);
5691 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5692 Jim_HashEntry *he;
5693 he = Jim_FindHashEntry(ht, objv[0]);
5694 Jim_DecrRefCount(interp, objv[0]);
5695 /* ATTENTION: const cast */
5696 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5697 he->val = objv[1];
5698 }
5699 }
5700 }
5701 if (i) {
5702 Jim_FreeNewObj(interp, objv[0]);
5703 objPtr->typePtr = NULL;
5704 Jim_FreeHashTable(ht);
5705 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5706 return JIM_ERR;
5707 }
5708 return JIM_OK;
5709 }
5710
5711 /* Dict object API */
5712
5713 /* Add an element to a dict. objPtr must be of the "dict" type.
5714 * The higer-level exported function is Jim_DictAddElement().
5715 * If an element with the specified key already exists, the value
5716 * associated is replaced with the new one.
5717 *
5718 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5719 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5720 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5721 {
5722 Jim_HashTable *ht = objPtr->internalRep.ptr;
5723
5724 if (valueObjPtr == NULL) { /* unset */
5725 Jim_DeleteHashEntry(ht, keyObjPtr);
5726 return;
5727 }
5728 Jim_IncrRefCount(keyObjPtr);
5729 Jim_IncrRefCount(valueObjPtr);
5730 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5731 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5732 Jim_DecrRefCount(interp, keyObjPtr);
5733 /* ATTENTION: const cast */
5734 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5735 he->val = valueObjPtr;
5736 }
5737 }
5738
5739 /* Add an element, higher-level interface for DictAddElement().
5740 * If valueObjPtr == NULL, the key is removed if it exists. */
5741 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5742 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5743 {
5744 if (Jim_IsShared(objPtr))
5745 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5746 if (objPtr->typePtr != &dictObjType) {
5747 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5748 return JIM_ERR;
5749 }
5750 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5751 Jim_InvalidateStringRep(objPtr);
5752 return JIM_OK;
5753 }
5754
5755 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5756 {
5757 Jim_Obj *objPtr;
5758 int i;
5759
5760 if (len % 2)
5761 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5762
5763 objPtr = Jim_NewObj(interp);
5764 objPtr->typePtr = &dictObjType;
5765 objPtr->bytes = NULL;
5766 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5767 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5768 for (i = 0; i < len; i += 2)
5769 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5770 return objPtr;
5771 }
5772
5773 /* Return the value associated to the specified dict key */
5774 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5775 Jim_Obj **objPtrPtr, int flags)
5776 {
5777 Jim_HashEntry *he;
5778 Jim_HashTable *ht;
5779
5780 if (dictPtr->typePtr != &dictObjType) {
5781 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5782 return JIM_ERR;
5783 }
5784 ht = dictPtr->internalRep.ptr;
5785 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5786 if (flags & JIM_ERRMSG) {
5787 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5788 Jim_AppendStrings(interp, Jim_GetResult(interp),
5789 "key \"", Jim_GetString(keyPtr, NULL),
5790 "\" not found in dictionary", NULL);
5791 }
5792 return JIM_ERR;
5793 }
5794 *objPtrPtr = he->val;
5795 return JIM_OK;
5796 }
5797
5798 /* Return the value associated to the specified dict keys */
5799 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5800 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5801 {
5802 Jim_Obj *objPtr;
5803 int i;
5804
5805 if (keyc == 0) {
5806 *objPtrPtr = dictPtr;
5807 return JIM_OK;
5808 }
5809
5810 for (i = 0; i < keyc; i++) {
5811 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5812 != JIM_OK)
5813 return JIM_ERR;
5814 dictPtr = objPtr;
5815 }
5816 *objPtrPtr = objPtr;
5817 return JIM_OK;
5818 }
5819
5820 /* Modify the dict stored into the variable named 'varNamePtr'
5821 * setting the element specified by the 'keyc' keys objects in 'keyv',
5822 * with the new value of the element 'newObjPtr'.
5823 *
5824 * If newObjPtr == NULL the operation is to remove the given key
5825 * from the dictionary. */
5826 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5827 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5828 {
5829 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5830 int shared, i;
5831
5832 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5833 if (objPtr == NULL) {
5834 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5835 return JIM_ERR;
5836 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5837 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5838 Jim_FreeNewObj(interp, varObjPtr);
5839 return JIM_ERR;
5840 }
5841 }
5842 if ((shared = Jim_IsShared(objPtr)))
5843 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5844 for (i = 0; i < keyc-1; i++) {
5845 dictObjPtr = objPtr;
5846
5847 /* Check if it's a valid dictionary */
5848 if (dictObjPtr->typePtr != &dictObjType) {
5849 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5850 goto err;
5851 }
5852 /* Check if the given key exists. */
5853 Jim_InvalidateStringRep(dictObjPtr);
5854 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5855 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5856 {
5857 /* This key exists at the current level.
5858 * Make sure it's not shared!. */
5859 if (Jim_IsShared(objPtr)) {
5860 objPtr = Jim_DuplicateObj(interp, objPtr);
5861 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5862 }
5863 } else {
5864 /* Key not found. If it's an [unset] operation
5865 * this is an error. Only the last key may not
5866 * exist. */
5867 if (newObjPtr == NULL)
5868 goto err;
5869 /* Otherwise set an empty dictionary
5870 * as key's value. */
5871 objPtr = Jim_NewDictObj(interp, NULL, 0);
5872 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5873 }
5874 }
5875 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5876 != JIM_OK)
5877 goto err;
5878 Jim_InvalidateStringRep(objPtr);
5879 Jim_InvalidateStringRep(varObjPtr);
5880 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5881 goto err;
5882 Jim_SetResult(interp, varObjPtr);
5883 return JIM_OK;
5884 err:
5885 if (shared) {
5886 Jim_FreeNewObj(interp, varObjPtr);
5887 }
5888 return JIM_ERR;
5889 }
5890
5891 /* -----------------------------------------------------------------------------
5892 * Index object
5893 * ---------------------------------------------------------------------------*/
5894 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
5895 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5896
5897 static Jim_ObjType indexObjType = {
5898 "index",
5899 NULL,
5900 NULL,
5901 UpdateStringOfIndex,
5902 JIM_TYPE_NONE,
5903 };
5904
5905 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
5906 {
5907 int len;
5908 char buf[JIM_INTEGER_SPACE+1];
5909
5910 if (objPtr->internalRep.indexValue >= 0)
5911 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
5912 else if (objPtr->internalRep.indexValue == -1)
5913 len = sprintf(buf, "end");
5914 else {
5915 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
5916 }
5917 objPtr->bytes = Jim_Alloc(len+1);
5918 memcpy(objPtr->bytes, buf, len+1);
5919 objPtr->length = len;
5920 }
5921
5922 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5923 {
5924 int index, end = 0;
5925 const char *str;
5926
5927 /* Get the string representation */
5928 str = Jim_GetString(objPtr, NULL);
5929 /* Try to convert into an index */
5930 if (!strcmp(str, "end")) {
5931 index = 0;
5932 end = 1;
5933 } else {
5934 if (!strncmp(str, "end-", 4)) {
5935 str += 4;
5936 end = 1;
5937 }
5938 if (Jim_StringToIndex(str, &index) != JIM_OK) {
5939 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5940 Jim_AppendStrings(interp, Jim_GetResult(interp),
5941 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
5942 "must be integer or end?-integer?", NULL);
5943 return JIM_ERR;
5944 }
5945 }
5946 if (end) {
5947 if (index < 0)
5948 index = INT_MAX;
5949 else
5950 index = -(index+1);
5951 } else if (!end && index < 0)
5952 index = -INT_MAX;
5953 /* Free the old internal repr and set the new one. */
5954 Jim_FreeIntRep(interp, objPtr);
5955 objPtr->typePtr = &indexObjType;
5956 objPtr->internalRep.indexValue = index;
5957 return JIM_OK;
5958 }
5959
5960 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
5961 {
5962 /* Avoid shimmering if the object is an integer. */
5963 if (objPtr->typePtr == &intObjType) {
5964 jim_wide val = objPtr->internalRep.wideValue;
5965 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
5966 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
5967 return JIM_OK;
5968 }
5969 }
5970 if (objPtr->typePtr != &indexObjType &&
5971 SetIndexFromAny(interp, objPtr) == JIM_ERR)
5972 return JIM_ERR;
5973 *indexPtr = objPtr->internalRep.indexValue;
5974 return JIM_OK;
5975 }
5976
5977 /* -----------------------------------------------------------------------------
5978 * Return Code Object.
5979 * ---------------------------------------------------------------------------*/
5980
5981 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5982
5983 static Jim_ObjType returnCodeObjType = {
5984 "return-code",
5985 NULL,
5986 NULL,
5987 NULL,
5988 JIM_TYPE_NONE,
5989 };
5990
5991 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5992 {
5993 const char *str;
5994 int strLen, returnCode;
5995 jim_wide wideValue;
5996
5997 /* Get the string representation */
5998 str = Jim_GetString(objPtr, &strLen);
5999 /* Try to convert into an integer */
6000 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6001 returnCode = (int) wideValue;
6002 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6003 returnCode = JIM_OK;
6004 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6005 returnCode = JIM_ERR;
6006 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6007 returnCode = JIM_RETURN;
6008 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6009 returnCode = JIM_BREAK;
6010 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6011 returnCode = JIM_CONTINUE;
6012 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6013 returnCode = JIM_EVAL;
6014 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6015 returnCode = JIM_EXIT;
6016 else {
6017 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6018 Jim_AppendStrings(interp, Jim_GetResult(interp),
6019 "expected return code but got '", str, "'",
6020 NULL);
6021 return JIM_ERR;
6022 }
6023 /* Free the old internal repr and set the new one. */
6024 Jim_FreeIntRep(interp, objPtr);
6025 objPtr->typePtr = &returnCodeObjType;
6026 objPtr->internalRep.returnCode = returnCode;
6027 return JIM_OK;
6028 }
6029
6030 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6031 {
6032 if (objPtr->typePtr != &returnCodeObjType &&
6033 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6034 return JIM_ERR;
6035 *intPtr = objPtr->internalRep.returnCode;
6036 return JIM_OK;
6037 }
6038
6039 /* -----------------------------------------------------------------------------
6040 * Expression Parsing
6041 * ---------------------------------------------------------------------------*/
6042 static int JimParseExprOperator(struct JimParserCtx *pc);
6043 static int JimParseExprNumber(struct JimParserCtx *pc);
6044 static int JimParseExprIrrational(struct JimParserCtx *pc);
6045
6046 /* Exrp's Stack machine operators opcodes. */
6047
6048 /* Binary operators (numbers) */
6049 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6050 #define JIM_EXPROP_MUL 0
6051 #define JIM_EXPROP_DIV 1
6052 #define JIM_EXPROP_MOD 2
6053 #define JIM_EXPROP_SUB 3
6054 #define JIM_EXPROP_ADD 4
6055 #define JIM_EXPROP_LSHIFT 5
6056 #define JIM_EXPROP_RSHIFT 6
6057 #define JIM_EXPROP_ROTL 7
6058 #define JIM_EXPROP_ROTR 8
6059 #define JIM_EXPROP_LT 9
6060 #define JIM_EXPROP_GT 10
6061 #define JIM_EXPROP_LTE 11
6062 #define JIM_EXPROP_GTE 12
6063 #define JIM_EXPROP_NUMEQ 13
6064 #define JIM_EXPROP_NUMNE 14
6065 #define JIM_EXPROP_BITAND 15
6066 #define JIM_EXPROP_BITXOR 16
6067 #define JIM_EXPROP_BITOR 17
6068 #define JIM_EXPROP_LOGICAND 18
6069 #define JIM_EXPROP_LOGICOR 19
6070 #define JIM_EXPROP_LOGICAND_LEFT 20
6071 #define JIM_EXPROP_LOGICOR_LEFT 21
6072 #define JIM_EXPROP_POW 22
6073 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6074
6075 /* Binary operators (strings) */
6076 #define JIM_EXPROP_STREQ 23
6077 #define JIM_EXPROP_STRNE 24
6078
6079 /* Unary operators (numbers) */
6080 #define JIM_EXPROP_NOT 25
6081 #define JIM_EXPROP_BITNOT 26
6082 #define JIM_EXPROP_UNARYMINUS 27
6083 #define JIM_EXPROP_UNARYPLUS 28
6084 #define JIM_EXPROP_LOGICAND_RIGHT 29
6085 #define JIM_EXPROP_LOGICOR_RIGHT 30
6086
6087 /* Ternary operators */
6088 #define JIM_EXPROP_TERNARY 31
6089
6090 /* Operands */
6091 #define JIM_EXPROP_NUMBER 32
6092 #define JIM_EXPROP_COMMAND 33
6093 #define JIM_EXPROP_VARIABLE 34
6094 #define JIM_EXPROP_DICTSUGAR 35
6095 #define JIM_EXPROP_SUBST 36
6096 #define JIM_EXPROP_STRING 37
6097
6098 /* Operators table */
6099 typedef struct Jim_ExprOperator {
6100 const char *name;
6101 int precedence;
6102 int arity;
6103 int opcode;
6104 } Jim_ExprOperator;
6105
6106 /* name - precedence - arity - opcode */
6107 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6108 {"!", 300, 1, JIM_EXPROP_NOT},
6109 {"~", 300, 1, JIM_EXPROP_BITNOT},
6110 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6111 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6112
6113 {"**", 250, 2, JIM_EXPROP_POW},
6114
6115 {"*", 200, 2, JIM_EXPROP_MUL},
6116 {"/", 200, 2, JIM_EXPROP_DIV},
6117 {"%", 200, 2, JIM_EXPROP_MOD},
6118
6119 {"-", 100, 2, JIM_EXPROP_SUB},
6120 {"+", 100, 2, JIM_EXPROP_ADD},
6121
6122 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6123 {">>>", 90, 3, JIM_EXPROP_ROTR},
6124 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6125 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6126
6127 {"<", 80, 2, JIM_EXPROP_LT},
6128 {">", 80, 2, JIM_EXPROP_GT},
6129 {"<=", 80, 2, JIM_EXPROP_LTE},
6130 {">=", 80, 2, JIM_EXPROP_GTE},
6131
6132 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6133 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6134
6135 {"eq", 60, 2, JIM_EXPROP_STREQ},
6136 {"ne", 60, 2, JIM_EXPROP_STRNE},
6137
6138 {"&", 50, 2, JIM_EXPROP_BITAND},
6139 {"^", 49, 2, JIM_EXPROP_BITXOR},
6140 {"|", 48, 2, JIM_EXPROP_BITOR},
6141
6142 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6143 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6144
6145 {"?", 5, 3, JIM_EXPROP_TERNARY},
6146 /* private operators */
6147 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6148 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6149 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6150 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6151 };
6152
6153 #define JIM_EXPR_OPERATORS_NUM \
6154 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6155
6156 int JimParseExpression(struct JimParserCtx *pc)
6157 {
6158 /* Discard spaces and quoted newline */
6159 while(*(pc->p) == ' ' ||
6160 *(pc->p) == '\t' ||
6161 *(pc->p) == '\r' ||
6162 *(pc->p) == '\n' ||
6163 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6164 pc->p++; pc->len--;
6165 }
6166
6167 if (pc->len == 0) {
6168 pc->tstart = pc->tend = pc->p;
6169 pc->tline = pc->linenr;
6170 pc->tt = JIM_TT_EOL;
6171 pc->eof = 1;
6172 return JIM_OK;
6173 }
6174 switch(*(pc->p)) {
6175 case '(':
6176 pc->tstart = pc->tend = pc->p;
6177 pc->tline = pc->linenr;
6178 pc->tt = JIM_TT_SUBEXPR_START;
6179 pc->p++; pc->len--;
6180 break;
6181 case ')':
6182 pc->tstart = pc->tend = pc->p;
6183 pc->tline = pc->linenr;
6184 pc->tt = JIM_TT_SUBEXPR_END;
6185 pc->p++; pc->len--;
6186 break;
6187 case '[':
6188 return JimParseCmd(pc);
6189 break;
6190 case '$':
6191 if (JimParseVar(pc) == JIM_ERR)
6192 return JimParseExprOperator(pc);
6193 else
6194 return JIM_OK;
6195 break;
6196 case '-':
6197 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6198 isdigit((int)*(pc->p+1)))
6199 return JimParseExprNumber(pc);
6200 else
6201 return JimParseExprOperator(pc);
6202 break;
6203 case '0': case '1': case '2': case '3': case '4':
6204 case '5': case '6': case '7': case '8': case '9': case '.':
6205 return JimParseExprNumber(pc);
6206 break;
6207 case '"':
6208 case '{':
6209 /* Here it's possible to reuse the List String parsing. */
6210 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6211 return JimParseListStr(pc);
6212 break;
6213 case 'N': case 'I':
6214 case 'n': case 'i':
6215 if (JimParseExprIrrational(pc) == JIM_ERR)
6216 return JimParseExprOperator(pc);
6217 break;
6218 default:
6219 return JimParseExprOperator(pc);
6220 break;
6221 }
6222 return JIM_OK;
6223 }
6224
6225 int JimParseExprNumber(struct JimParserCtx *pc)
6226 {
6227 int allowdot = 1;
6228 int allowhex = 0;
6229
6230 pc->tstart = pc->p;
6231 pc->tline = pc->linenr;
6232 if (*pc->p == '-') {
6233 pc->p++; pc->len--;
6234 }
6235 while ( isdigit((int)*pc->p)
6236 || (allowhex && isxdigit((int)*pc->p) )
6237 || (allowdot && *pc->p == '.')
6238 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6239 (*pc->p == 'x' || *pc->p == 'X'))
6240 )
6241 {
6242 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6243 allowhex = 1;
6244 allowdot = 0;
6245 }
6246 if (*pc->p == '.')
6247 allowdot = 0;
6248 pc->p++; pc->len--;
6249 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6250 pc->p += 2; pc->len -= 2;
6251 }
6252 }
6253 pc->tend = pc->p-1;
6254 pc->tt = JIM_TT_EXPR_NUMBER;
6255 return JIM_OK;
6256 }
6257
6258 int JimParseExprIrrational(struct JimParserCtx *pc)
6259 {
6260 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6261 const char **token;
6262 for (token = Tokens; *token != NULL; token++) {
6263 int len = strlen(*token);
6264 if (strncmp(*token, pc->p, len) == 0) {
6265 pc->tstart = pc->p;
6266 pc->tend = pc->p + len - 1;
6267 pc->p += len; pc->len -= len;
6268 pc->tline = pc->linenr;
6269 pc->tt = JIM_TT_EXPR_NUMBER;
6270 return JIM_OK;
6271 }
6272 }
6273 return JIM_ERR;
6274 }
6275
6276 int JimParseExprOperator(struct JimParserCtx *pc)
6277 {
6278 int i;
6279 int bestIdx = -1, bestLen = 0;
6280
6281 /* Try to get the longest match. */
6282 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6283 const char *opname;
6284 int oplen;
6285
6286 opname = Jim_ExprOperators[i].name;
6287 if (opname == NULL) continue;
6288 oplen = strlen(opname);
6289
6290 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6291 bestIdx = i;
6292 bestLen = oplen;
6293 }
6294 }
6295 if (bestIdx == -1) return JIM_ERR;
6296 pc->tstart = pc->p;
6297 pc->tend = pc->p + bestLen - 1;
6298 pc->p += bestLen; pc->len -= bestLen;
6299 pc->tline = pc->linenr;
6300 pc->tt = JIM_TT_EXPR_OPERATOR;
6301 return JIM_OK;
6302 }
6303
6304 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6305 {
6306 int i;
6307 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6308 if (Jim_ExprOperators[i].name &&
6309 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6310 return &Jim_ExprOperators[i];
6311 return NULL;
6312 }
6313
6314 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6315 {
6316 int i;
6317 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6318 if (Jim_ExprOperators[i].opcode == opcode)
6319 return &Jim_ExprOperators[i];
6320 return NULL;
6321 }
6322
6323 /* -----------------------------------------------------------------------------
6324 * Expression Object
6325 * ---------------------------------------------------------------------------*/
6326 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6327 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6328 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6329
6330 static Jim_ObjType exprObjType = {
6331 "expression",
6332 FreeExprInternalRep,
6333 DupExprInternalRep,
6334 NULL,
6335 JIM_TYPE_REFERENCES,
6336 };
6337
6338 /* Expr bytecode structure */
6339 typedef struct ExprByteCode {
6340 int *opcode; /* Integer array of opcodes. */
6341 Jim_Obj **obj; /* Array of associated Jim Objects. */
6342 int len; /* Bytecode length */
6343 int inUse; /* Used for sharing. */
6344 } ExprByteCode;
6345
6346 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6347 {
6348 int i;
6349 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6350
6351 expr->inUse--;
6352 if (expr->inUse != 0) return;
6353 for (i = 0; i < expr->len; i++)
6354 Jim_DecrRefCount(interp, expr->obj[i]);
6355 Jim_Free(expr->opcode);
6356 Jim_Free(expr->obj);
6357 Jim_Free(expr);
6358 }
6359
6360 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6361 {
6362 JIM_NOTUSED(interp);
6363 JIM_NOTUSED(srcPtr);
6364
6365 /* Just returns an simple string. */
6366 dupPtr->typePtr = NULL;
6367 }
6368
6369 /* Add a new instruction to an expression bytecode structure. */
6370 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6371 int opcode, char *str, int len)
6372 {
6373 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6374 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6375 expr->opcode[expr->len] = opcode;
6376 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6377 Jim_IncrRefCount(expr->obj[expr->len]);
6378 expr->len++;
6379 }
6380
6381 /* Check if an expr program looks correct. */
6382 static int ExprCheckCorrectness(ExprByteCode *expr)
6383 {
6384 int i;
6385 int stacklen = 0;
6386
6387 /* Try to check if there are stack underflows,
6388 * and make sure at the end of the program there is
6389 * a single result on the stack. */
6390 for (i = 0; i < expr->len; i++) {
6391 switch(expr->opcode[i]) {
6392 case JIM_EXPROP_NUMBER:
6393 case JIM_EXPROP_STRING:
6394 case JIM_EXPROP_SUBST:
6395 case JIM_EXPROP_VARIABLE:
6396 case JIM_EXPROP_DICTSUGAR:
6397 case JIM_EXPROP_COMMAND:
6398 stacklen++;
6399 break;
6400 case JIM_EXPROP_NOT:
6401 case JIM_EXPROP_BITNOT:
6402 case JIM_EXPROP_UNARYMINUS:
6403 case JIM_EXPROP_UNARYPLUS:
6404 /* Unary operations */
6405 if (stacklen < 1) return JIM_ERR;
6406 break;
6407 case JIM_EXPROP_ADD:
6408 case JIM_EXPROP_SUB:
6409 case JIM_EXPROP_MUL:
6410 case JIM_EXPROP_DIV:
6411 case JIM_EXPROP_MOD:
6412 case JIM_EXPROP_LT:
6413 case JIM_EXPROP_GT:
6414 case JIM_EXPROP_LTE:
6415 case JIM_EXPROP_GTE:
6416 case JIM_EXPROP_ROTL:
6417 case JIM_EXPROP_ROTR:
6418 case JIM_EXPROP_LSHIFT:
6419 case JIM_EXPROP_RSHIFT:
6420 case JIM_EXPROP_NUMEQ:
6421 case JIM_EXPROP_NUMNE:
6422 case JIM_EXPROP_STREQ:
6423 case JIM_EXPROP_STRNE:
6424 case JIM_EXPROP_BITAND:
6425 case JIM_EXPROP_BITXOR:
6426 case JIM_EXPROP_BITOR:
6427 case JIM_EXPROP_LOGICAND:
6428 case JIM_EXPROP_LOGICOR:
6429 case JIM_EXPROP_POW:
6430 /* binary operations */
6431 if (stacklen < 2) return JIM_ERR;
6432 stacklen--;
6433 break;
6434 default:
6435 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6436 break;
6437 }
6438 }
6439 if (stacklen != 1) return JIM_ERR;
6440 return JIM_OK;
6441 }
6442
6443 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6444 ScriptObj *topLevelScript)
6445 {
6446 int i;
6447
6448 return;
6449 for (i = 0; i < expr->len; i++) {
6450 Jim_Obj *foundObjPtr;
6451
6452 if (expr->obj[i] == NULL) continue;
6453 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6454 NULL, expr->obj[i]);
6455 if (foundObjPtr != NULL) {
6456 Jim_IncrRefCount(foundObjPtr);
6457 Jim_DecrRefCount(interp, expr->obj[i]);
6458 expr->obj[i] = foundObjPtr;
6459 }
6460 }
6461 }
6462
6463 /* This procedure converts every occurrence of || and && opereators
6464 * in lazy unary versions.
6465 *
6466 * a b || is converted into:
6467 *
6468 * a <offset> |L b |R
6469 *
6470 * a b && is converted into:
6471 *
6472 * a <offset> &L b &R
6473 *
6474 * "|L" checks if 'a' is true:
6475 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6476 * the opcode just after |R.
6477 * 2) if it is false does nothing.
6478 * "|R" checks if 'b' is true:
6479 * 1) if it is true pushes 1, otherwise pushes 0.
6480 *
6481 * "&L" checks if 'a' is true:
6482 * 1) if it is true does nothing.
6483 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6484 * the opcode just after &R
6485 * "&R" checks if 'a' is true:
6486 * if it is true pushes 1, otherwise pushes 0.
6487 */
6488 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6489 {
6490 while (1) {
6491 int index = -1, leftindex, arity, i, offset;
6492 Jim_ExprOperator *op;
6493
6494 /* Search for || or && */
6495 for (i = 0; i < expr->len; i++) {
6496 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6497 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6498 index = i;
6499 break;
6500 }
6501 }
6502 if (index == -1) return;
6503 /* Search for the end of the first operator */
6504 leftindex = index-1;
6505 arity = 1;
6506 while(arity) {
6507 switch(expr->opcode[leftindex]) {
6508 case JIM_EXPROP_NUMBER:
6509 case JIM_EXPROP_COMMAND:
6510 case JIM_EXPROP_VARIABLE:
6511 case JIM_EXPROP_DICTSUGAR:
6512 case JIM_EXPROP_SUBST:
6513 case JIM_EXPROP_STRING:
6514 break;
6515 default:
6516 op = JimExprOperatorInfoByOpcode(expr->opcode[i]);
6517 if (op == NULL) {
6518 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6519 }
6520 arity += op->arity;
6521 break;
6522 }
6523 arity--;
6524 leftindex--;
6525 }
6526 leftindex++;
6527 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6528 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6529 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6530 sizeof(int)*(expr->len-leftindex));
6531 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6532 sizeof(Jim_Obj*)*(expr->len-leftindex));
6533 expr->len += 2;
6534 index += 2;
6535 offset = (index-leftindex)-1;
6536 Jim_DecrRefCount(interp, expr->obj[index]);
6537 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6538 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6539 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6540 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6541 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6542 } else {
6543 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6544 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6545 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6546 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6547 }
6548 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6549 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6550 Jim_IncrRefCount(expr->obj[index]);
6551 Jim_IncrRefCount(expr->obj[leftindex]);
6552 Jim_IncrRefCount(expr->obj[leftindex+1]);
6553 }
6554 }
6555
6556 /* This method takes the string representation of an expression
6557 * and generates a program for the Expr's stack-based VM. */
6558 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6559 {
6560 int exprTextLen;
6561 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6562 struct JimParserCtx parser;
6563 int i, shareLiterals;
6564 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6565 Jim_Stack stack;
6566 Jim_ExprOperator *op;
6567
6568 /* Perform literal sharing with the current procedure
6569 * running only if this expression appears to be not generated
6570 * at runtime. */
6571 shareLiterals = objPtr->typePtr == &sourceObjType;
6572
6573 expr->opcode = NULL;
6574 expr->obj = NULL;
6575 expr->len = 0;
6576 expr->inUse = 1;
6577
6578 Jim_InitStack(&stack);
6579 JimParserInit(&parser, exprText, exprTextLen, 1);
6580 while(!JimParserEof(&parser)) {
6581 char *token;
6582 int len, type;
6583
6584 if (JimParseExpression(&parser) != JIM_OK) {
6585 Jim_SetResultString(interp, "Syntax error in expression", -1);
6586 goto err;
6587 }
6588 token = JimParserGetToken(&parser, &len, &type, NULL);
6589 if (type == JIM_TT_EOL) {
6590 Jim_Free(token);
6591 break;
6592 }
6593 switch(type) {
6594 case JIM_TT_STR:
6595 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6596 break;
6597 case JIM_TT_ESC:
6598 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6599 break;
6600 case JIM_TT_VAR:
6601 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6602 break;
6603 case JIM_TT_DICTSUGAR:
6604 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6605 break;
6606 case JIM_TT_CMD:
6607 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6608 break;
6609 case JIM_TT_EXPR_NUMBER:
6610 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6611 break;
6612 case JIM_TT_EXPR_OPERATOR:
6613 op = JimExprOperatorInfo(token);
6614 while(1) {
6615 Jim_ExprOperator *stackTopOp;
6616
6617 if (Jim_StackPeek(&stack) != NULL) {
6618 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6619 } else {
6620 stackTopOp = NULL;
6621 }
6622 if (Jim_StackLen(&stack) && op->arity != 1 &&
6623 stackTopOp && stackTopOp->precedence >= op->precedence)
6624 {
6625 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6626 Jim_StackPeek(&stack), -1);
6627 Jim_StackPop(&stack);
6628 } else {
6629 break;
6630 }
6631 }
6632 Jim_StackPush(&stack, token);
6633 break;
6634 case JIM_TT_SUBEXPR_START:
6635 Jim_StackPush(&stack, Jim_StrDup("("));
6636 Jim_Free(token);
6637 break;
6638 case JIM_TT_SUBEXPR_END:
6639 {
6640 int found = 0;
6641 while(Jim_StackLen(&stack)) {
6642 char *opstr = Jim_StackPop(&stack);
6643 if (!strcmp(opstr, "(")) {
6644 Jim_Free(opstr);
6645 found = 1;
6646 break;
6647 }
6648 op = JimExprOperatorInfo(opstr);
6649 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6650 }
6651 if (!found) {
6652 Jim_SetResultString(interp,
6653 "Unexpected close parenthesis", -1);
6654 goto err;
6655 }
6656 }
6657 Jim_Free(token);
6658 break;
6659 default:
6660 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6661 break;
6662 }
6663 }
6664 while (Jim_StackLen(&stack)) {
6665 char *opstr = Jim_StackPop(&stack);
6666 op = JimExprOperatorInfo(opstr);
6667 if (op == NULL && !strcmp(opstr, "(")) {
6668 Jim_Free(opstr);
6669 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6670 goto err;
6671 }
6672 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6673 }
6674 /* Check program correctness. */
6675 if (ExprCheckCorrectness(expr) != JIM_OK) {
6676 Jim_SetResultString(interp, "Invalid expression", -1);
6677 goto err;
6678 }
6679
6680 /* Free the stack used for the compilation. */
6681 Jim_FreeStackElements(&stack, Jim_Free);
6682 Jim_FreeStack(&stack);
6683
6684 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6685 ExprMakeLazy(interp, expr);
6686
6687 /* Perform literal sharing */
6688 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6689 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6690 if (bodyObjPtr->typePtr == &scriptObjType) {
6691 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6692 ExprShareLiterals(interp, expr, bodyScript);
6693 }
6694 }
6695
6696 /* Free the old internal rep and set the new one. */
6697 Jim_FreeIntRep(interp, objPtr);
6698 Jim_SetIntRepPtr(objPtr, expr);
6699 objPtr->typePtr = &exprObjType;
6700 return JIM_OK;
6701
6702 err: /* we jump here on syntax/compile errors. */
6703 Jim_FreeStackElements(&stack, Jim_Free);
6704 Jim_FreeStack(&stack);
6705 Jim_Free(expr->opcode);
6706 for (i = 0; i < expr->len; i++) {
6707 Jim_DecrRefCount(interp,expr->obj[i]);
6708 }
6709 Jim_Free(expr->obj);
6710 Jim_Free(expr);
6711 return JIM_ERR;
6712 }
6713
6714 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6715 {
6716 if (objPtr->typePtr != &exprObjType) {
6717 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6718 return NULL;
6719 }
6720 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6721 }
6722
6723 /* -----------------------------------------------------------------------------
6724 * Expressions evaluation.
6725 * Jim uses a specialized stack-based virtual machine for expressions,
6726 * that takes advantage of the fact that expr's operators
6727 * can't be redefined.
6728 *
6729 * Jim_EvalExpression() uses the bytecode compiled by
6730 * SetExprFromAny() method of the "expression" object.
6731 *
6732 * On success a Tcl Object containing the result of the evaluation
6733 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6734 * returned.
6735 * On error the function returns a retcode != to JIM_OK and set a suitable
6736 * error on the interp.
6737 * ---------------------------------------------------------------------------*/
6738 #define JIM_EE_STATICSTACK_LEN 10
6739
6740 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6741 Jim_Obj **exprResultPtrPtr)
6742 {
6743 ExprByteCode *expr;
6744 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6745 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6746
6747 Jim_IncrRefCount(exprObjPtr);
6748 expr = Jim_GetExpression(interp, exprObjPtr);
6749 if (!expr) {
6750 Jim_DecrRefCount(interp, exprObjPtr);
6751 return JIM_ERR; /* error in expression. */
6752 }
6753 /* In order to avoid that the internal repr gets freed due to
6754 * shimmering of the exprObjPtr's object, we make the internal rep
6755 * shared. */
6756 expr->inUse++;
6757
6758 /* The stack-based expr VM itself */
6759
6760 /* Stack allocation. Expr programs have the feature that
6761 * a program of length N can't require a stack longer than
6762 * N. */
6763 if (expr->len > JIM_EE_STATICSTACK_LEN)
6764 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6765 else
6766 stack = staticStack;
6767
6768 /* Execute every istruction */
6769 for (i = 0; i < expr->len; i++) {
6770 Jim_Obj *A, *B, *objPtr;
6771 jim_wide wA, wB, wC;
6772 double dA, dB, dC;
6773 const char *sA, *sB;
6774 int Alen, Blen, retcode;
6775 int opcode = expr->opcode[i];
6776
6777 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6778 stack[stacklen++] = expr->obj[i];
6779 Jim_IncrRefCount(expr->obj[i]);
6780 } else if (opcode == JIM_EXPROP_VARIABLE) {
6781 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6782 if (objPtr == NULL) {
6783 error = 1;
6784 goto err;
6785 }
6786 stack[stacklen++] = objPtr;
6787 Jim_IncrRefCount(objPtr);
6788 } else if (opcode == JIM_EXPROP_SUBST) {
6789 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6790 &objPtr, JIM_NONE)) != JIM_OK)
6791 {
6792 error = 1;
6793 errRetCode = retcode;
6794 goto err;
6795 }
6796 stack[stacklen++] = objPtr;
6797 Jim_IncrRefCount(objPtr);
6798 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6799 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6800 if (objPtr == NULL) {
6801 error = 1;
6802 goto err;
6803 }
6804 stack[stacklen++] = objPtr;
6805 Jim_IncrRefCount(objPtr);
6806 } else if (opcode == JIM_EXPROP_COMMAND) {
6807 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6808 error = 1;
6809 errRetCode = retcode;
6810 goto err;
6811 }
6812 stack[stacklen++] = interp->result;
6813 Jim_IncrRefCount(interp->result);
6814 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6815 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6816 {
6817 /* Note that there isn't to increment the
6818 * refcount of objects. the references are moved
6819 * from stack to A and B. */
6820 B = stack[--stacklen];
6821 A = stack[--stacklen];
6822
6823 /* --- Integer --- */
6824 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6825 (B->typePtr == &doubleObjType && !B->bytes) ||
6826 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6827 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6828 goto trydouble;
6829 }
6830 Jim_DecrRefCount(interp, A);
6831 Jim_DecrRefCount(interp, B);
6832 switch(expr->opcode[i]) {
6833 case JIM_EXPROP_ADD: wC = wA+wB; break;
6834 case JIM_EXPROP_SUB: wC = wA-wB; break;
6835 case JIM_EXPROP_MUL: wC = wA*wB; break;
6836 case JIM_EXPROP_LT: wC = wA<wB; break;
6837 case JIM_EXPROP_GT: wC = wA>wB; break;
6838 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6839 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6840 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6841 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6842 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6843 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6844 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6845 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6846 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6847 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6848 case JIM_EXPROP_LOGICAND_LEFT:
6849 if (wA == 0) {
6850 i += (int)wB;
6851 wC = 0;
6852 } else {
6853 continue;
6854 }
6855 break;
6856 case JIM_EXPROP_LOGICOR_LEFT:
6857 if (wA != 0) {
6858 i += (int)wB;
6859 wC = 1;
6860 } else {
6861 continue;
6862 }
6863 break;
6864 case JIM_EXPROP_DIV:
6865 if (wB == 0) goto divbyzero;
6866 wC = wA/wB;
6867 break;
6868 case JIM_EXPROP_MOD:
6869 if (wB == 0) goto divbyzero;
6870 wC = wA%wB;
6871 break;
6872 case JIM_EXPROP_ROTL: {
6873 /* uint32_t would be better. But not everyone has inttypes.h?*/
6874 unsigned long uA = (unsigned long)wA;
6875 #ifdef _MSC_VER
6876 wC = _rotl(uA,(unsigned long)wB);
6877 #else
6878 const unsigned int S = sizeof(unsigned long) * 8;
6879 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6880 #endif
6881 break;
6882 }
6883 case JIM_EXPROP_ROTR: {
6884 unsigned long uA = (unsigned long)wA;
6885 #ifdef _MSC_VER
6886 wC = _rotr(uA,(unsigned long)wB);
6887 #else
6888 const unsigned int S = sizeof(unsigned long) * 8;
6889 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
6890 #endif
6891 break;
6892 }
6893
6894 default:
6895 wC = 0; /* avoid gcc warning */
6896 break;
6897 }
6898 stack[stacklen] = Jim_NewIntObj(interp, wC);
6899 Jim_IncrRefCount(stack[stacklen]);
6900 stacklen++;
6901 continue;
6902 trydouble:
6903 /* --- Double --- */
6904 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
6905 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
6906 Jim_DecrRefCount(interp, A);
6907 Jim_DecrRefCount(interp, B);
6908 error = 1;
6909 goto err;
6910 }
6911 Jim_DecrRefCount(interp, A);
6912 Jim_DecrRefCount(interp, B);
6913 switch(expr->opcode[i]) {
6914 case JIM_EXPROP_ROTL:
6915 case JIM_EXPROP_ROTR:
6916 case JIM_EXPROP_LSHIFT:
6917 case JIM_EXPROP_RSHIFT:
6918 case JIM_EXPROP_BITAND:
6919 case JIM_EXPROP_BITXOR:
6920 case JIM_EXPROP_BITOR:
6921 case JIM_EXPROP_MOD:
6922 case JIM_EXPROP_POW:
6923 Jim_SetResultString(interp,
6924 "Got floating-point value where integer was expected", -1);
6925 error = 1;
6926 goto err;
6927 break;
6928 case JIM_EXPROP_ADD: dC = dA+dB; break;
6929 case JIM_EXPROP_SUB: dC = dA-dB; break;
6930 case JIM_EXPROP_MUL: dC = dA*dB; break;
6931 case JIM_EXPROP_LT: dC = dA<dB; break;
6932 case JIM_EXPROP_GT: dC = dA>dB; break;
6933 case JIM_EXPROP_LTE: dC = dA<=dB; break;
6934 case JIM_EXPROP_GTE: dC = dA>=dB; break;
6935 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
6936 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
6937 case JIM_EXPROP_LOGICAND_LEFT:
6938 if (dA == 0) {
6939 i += (int)dB;
6940 dC = 0;
6941 } else {
6942 continue;
6943 }
6944 break;
6945 case JIM_EXPROP_LOGICOR_LEFT:
6946 if (dA != 0) {
6947 i += (int)dB;
6948 dC = 1;
6949 } else {
6950 continue;
6951 }
6952 break;
6953 case JIM_EXPROP_DIV:
6954 if (dB == 0) goto divbyzero;
6955 dC = dA/dB;
6956 break;
6957 default:
6958 dC = 0; /* avoid gcc warning */
6959 break;
6960 }
6961 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
6962 Jim_IncrRefCount(stack[stacklen]);
6963 stacklen++;
6964 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
6965 B = stack[--stacklen];
6966 A = stack[--stacklen];
6967 sA = Jim_GetString(A, &Alen);
6968 sB = Jim_GetString(B, &Blen);
6969 switch(expr->opcode[i]) {
6970 case JIM_EXPROP_STREQ:
6971 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
6972 wC = 1;
6973 else
6974 wC = 0;
6975 break;
6976 case JIM_EXPROP_STRNE:
6977 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
6978 wC = 1;
6979 else
6980 wC = 0;
6981 break;
6982 default:
6983 wC = 0; /* avoid gcc warning */
6984 break;
6985 }
6986 Jim_DecrRefCount(interp, A);
6987 Jim_DecrRefCount(interp, B);
6988 stack[stacklen] = Jim_NewIntObj(interp, wC);
6989 Jim_IncrRefCount(stack[stacklen]);
6990 stacklen++;
6991 } else if (opcode == JIM_EXPROP_NOT ||
6992 opcode == JIM_EXPROP_BITNOT ||
6993 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
6994 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
6995 /* Note that there isn't to increment the
6996 * refcount of objects. the references are moved
6997 * from stack to A and B. */
6998 A = stack[--stacklen];
6999
7000 /* --- Integer --- */
7001 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7002 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7003 goto trydouble_unary;
7004 }
7005 Jim_DecrRefCount(interp, A);
7006 switch(expr->opcode[i]) {
7007 case JIM_EXPROP_NOT: wC = !wA; break;
7008 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7009 case JIM_EXPROP_LOGICAND_RIGHT:
7010 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7011 default:
7012 wC = 0; /* avoid gcc warning */
7013 break;
7014 }
7015 stack[stacklen] = Jim_NewIntObj(interp, wC);
7016 Jim_IncrRefCount(stack[stacklen]);
7017 stacklen++;
7018 continue;
7019 trydouble_unary:
7020 /* --- Double --- */
7021 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7022 Jim_DecrRefCount(interp, A);
7023 error = 1;
7024 goto err;
7025 }
7026 Jim_DecrRefCount(interp, A);
7027 switch(expr->opcode[i]) {
7028 case JIM_EXPROP_NOT: dC = !dA; break;
7029 case JIM_EXPROP_LOGICAND_RIGHT:
7030 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7031 case JIM_EXPROP_BITNOT:
7032 Jim_SetResultString(interp,
7033 "Got floating-point value where integer was expected", -1);
7034 error = 1;
7035 goto err;
7036 break;
7037 default:
7038 dC = 0; /* avoid gcc warning */
7039 break;
7040 }
7041 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7042 Jim_IncrRefCount(stack[stacklen]);
7043 stacklen++;
7044 } else {
7045 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7046 }
7047 }
7048 err:
7049 /* There is no need to decerement the inUse field because
7050 * this reference is transfered back into the exprObjPtr. */
7051 Jim_FreeIntRep(interp, exprObjPtr);
7052 exprObjPtr->typePtr = &exprObjType;
7053 Jim_SetIntRepPtr(exprObjPtr, expr);
7054 Jim_DecrRefCount(interp, exprObjPtr);
7055 if (!error) {
7056 *exprResultPtrPtr = stack[0];
7057 Jim_IncrRefCount(stack[0]);
7058 errRetCode = JIM_OK;
7059 }
7060 for (i = 0; i < stacklen; i++) {
7061 Jim_DecrRefCount(interp, stack[i]);
7062 }
7063 if (stack != staticStack)
7064 Jim_Free(stack);
7065 return errRetCode;
7066 divbyzero:
7067 error = 1;
7068 Jim_SetResultString(interp, "Division by zero", -1);
7069 goto err;
7070 }
7071
7072 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7073 {
7074 int retcode;
7075 jim_wide wideValue;
7076 double doubleValue;
7077 Jim_Obj *exprResultPtr;
7078
7079 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7080 if (retcode != JIM_OK)
7081 return retcode;
7082 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7083 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7084 {
7085 Jim_DecrRefCount(interp, exprResultPtr);
7086 return JIM_ERR;
7087 } else {
7088 Jim_DecrRefCount(interp, exprResultPtr);
7089 *boolPtr = doubleValue != 0;
7090 return JIM_OK;
7091 }
7092 }
7093 Jim_DecrRefCount(interp, exprResultPtr);
7094 *boolPtr = wideValue != 0;
7095 return JIM_OK;
7096 }
7097
7098 /* -----------------------------------------------------------------------------
7099 * ScanFormat String Object
7100 * ---------------------------------------------------------------------------*/
7101
7102 /* This Jim_Obj will held a parsed representation of a format string passed to
7103 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7104 * to be parsed in its entirely first and then, if correct, can be used for
7105 * scanning. To avoid endless re-parsing, the parsed representation will be
7106 * stored in an internal representation and re-used for performance reason. */
7107
7108 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7109 * scanformat string. This part will later be used to extract information
7110 * out from the string to be parsed by Jim_ScanString */
7111
7112 typedef struct ScanFmtPartDescr {
7113 char type; /* Type of conversion (e.g. c, d, f) */
7114 char modifier; /* Modify type (e.g. l - long, h - short */
7115 size_t width; /* Maximal width of input to be converted */
7116 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7117 char *arg; /* Specification of a CHARSET conversion */
7118 char *prefix; /* Prefix to be scanned literally before conversion */
7119 } ScanFmtPartDescr;
7120
7121 /* The ScanFmtStringObj will held the internal representation of a scanformat
7122 * string parsed and separated in part descriptions. Furthermore it contains
7123 * the original string representation of the scanformat string to allow for
7124 * fast update of the Jim_Obj's string representation part.
7125 *
7126 * As add-on the internal object representation add some scratch pad area
7127 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7128 * memory for purpose of string scanning.
7129 *
7130 * The error member points to a static allocated string in case of a mal-
7131 * formed scanformat string or it contains '0' (NULL) in case of a valid
7132 * parse representation.
7133 *
7134 * The whole memory of the internal representation is allocated as a single
7135 * area of memory that will be internally separated. So freeing and duplicating
7136 * of such an object is cheap */
7137
7138 typedef struct ScanFmtStringObj {
7139 jim_wide size; /* Size of internal repr in bytes */
7140 char *stringRep; /* Original string representation */
7141 size_t count; /* Number of ScanFmtPartDescr contained */
7142 size_t convCount; /* Number of conversions that will assign */
7143 size_t maxPos; /* Max position index if XPG3 is used */
7144 const char *error; /* Ptr to error text (NULL if no error */
7145 char *scratch; /* Some scratch pad used by Jim_ScanString */
7146 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7147 } ScanFmtStringObj;
7148
7149
7150 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7151 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7152 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7153
7154 static Jim_ObjType scanFmtStringObjType = {
7155 "scanformatstring",
7156 FreeScanFmtInternalRep,
7157 DupScanFmtInternalRep,
7158 UpdateStringOfScanFmt,
7159 JIM_TYPE_NONE,
7160 };
7161
7162 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7163 {
7164 JIM_NOTUSED(interp);
7165 Jim_Free((char*)objPtr->internalRep.ptr);
7166 objPtr->internalRep.ptr = 0;
7167 }
7168
7169 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7170 {
7171 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7172 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7173
7174 JIM_NOTUSED(interp);
7175 memcpy(newVec, srcPtr->internalRep.ptr, size);
7176 dupPtr->internalRep.ptr = newVec;
7177 dupPtr->typePtr = &scanFmtStringObjType;
7178 }
7179
7180 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7181 {
7182 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7183
7184 objPtr->bytes = Jim_StrDup(bytes);
7185 objPtr->length = strlen(bytes);
7186 }
7187
7188 /* SetScanFmtFromAny will parse a given string and create the internal
7189 * representation of the format specification. In case of an error
7190 * the error data member of the internal representation will be set
7191 * to an descriptive error text and the function will be left with
7192 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7193 * specification */
7194
7195 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7196 {
7197 ScanFmtStringObj *fmtObj;
7198 char *buffer;
7199 int maxCount, i, approxSize, lastPos = -1;
7200 const char *fmt = objPtr->bytes;
7201 int maxFmtLen = objPtr->length;
7202 const char *fmtEnd = fmt + maxFmtLen;
7203 int curr;
7204
7205 Jim_FreeIntRep(interp, objPtr);
7206 /* Count how many conversions could take place maximally */
7207 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7208 if (fmt[i] == '%')
7209 ++maxCount;
7210 /* Calculate an approximation of the memory necessary */
7211 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7212 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7213 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7214 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7215 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7216 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7217 + 1; /* safety byte */
7218 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7219 memset(fmtObj, 0, approxSize);
7220 fmtObj->size = approxSize;
7221 fmtObj->maxPos = 0;
7222 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7223 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7224 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7225 buffer = fmtObj->stringRep + maxFmtLen + 1;
7226 objPtr->internalRep.ptr = fmtObj;
7227 objPtr->typePtr = &scanFmtStringObjType;
7228 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7229 int width=0, skip;
7230 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7231 fmtObj->count++;
7232 descr->width = 0; /* Assume width unspecified */
7233 /* Overread and store any "literal" prefix */
7234 if (*fmt != '%' || fmt[1] == '%') {
7235 descr->type = 0;
7236 descr->prefix = &buffer[i];
7237 for (; fmt < fmtEnd; ++fmt) {
7238 if (*fmt == '%') {
7239 if (fmt[1] != '%') break;
7240 ++fmt;
7241 }
7242 buffer[i++] = *fmt;
7243 }
7244 buffer[i++] = 0;
7245 }
7246 /* Skip the conversion introducing '%' sign */
7247 ++fmt;
7248 /* End reached due to non-conversion literal only? */
7249 if (fmt >= fmtEnd)
7250 goto done;
7251 descr->pos = 0; /* Assume "natural" positioning */
7252 if (*fmt == '*') {
7253 descr->pos = -1; /* Okay, conversion will not be assigned */
7254 ++fmt;
7255 } else
7256 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7257 /* Check if next token is a number (could be width or pos */
7258 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7259 fmt += skip;
7260 /* Was the number a XPG3 position specifier? */
7261 if (descr->pos != -1 && *fmt == '$') {
7262 int prev;
7263 ++fmt;
7264 descr->pos = width;
7265 width = 0;
7266 /* Look if "natural" postioning and XPG3 one was mixed */
7267 if ((lastPos == 0 && descr->pos > 0)
7268 || (lastPos > 0 && descr->pos == 0)) {
7269 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7270 return JIM_ERR;
7271 }
7272 /* Look if this position was already used */
7273 for (prev=0; prev < curr; ++prev) {
7274 if (fmtObj->descr[prev].pos == -1) continue;
7275 if (fmtObj->descr[prev].pos == descr->pos) {
7276 fmtObj->error = "same \"%n$\" conversion specifier "
7277 "used more than once";
7278 return JIM_ERR;
7279 }
7280 }
7281 /* Try to find a width after the XPG3 specifier */
7282 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7283 descr->width = width;
7284 fmt += skip;
7285 }
7286 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7287 fmtObj->maxPos = descr->pos;
7288 } else {
7289 /* Number was not a XPG3, so it has to be a width */
7290 descr->width = width;
7291 }
7292 }
7293 /* If positioning mode was undetermined yet, fix this */
7294 if (lastPos == -1)
7295 lastPos = descr->pos;
7296 /* Handle CHARSET conversion type ... */
7297 if (*fmt == '[') {
7298 int swapped = 1, beg = i, end, j;
7299 descr->type = '[';
7300 descr->arg = &buffer[i];
7301 ++fmt;
7302 if (*fmt == '^') buffer[i++] = *fmt++;
7303 if (*fmt == ']') buffer[i++] = *fmt++;
7304 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7305 if (*fmt != ']') {
7306 fmtObj->error = "unmatched [ in format string";
7307 return JIM_ERR;
7308 }
7309 end = i;
7310 buffer[i++] = 0;
7311 /* In case a range fence was given "backwards", swap it */
7312 while (swapped) {
7313 swapped = 0;
7314 for (j=beg+1; j < end-1; ++j) {
7315 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7316 char tmp = buffer[j-1];
7317 buffer[j-1] = buffer[j+1];
7318 buffer[j+1] = tmp;
7319 swapped = 1;
7320 }
7321 }
7322 }
7323 } else {
7324 /* Remember any valid modifier if given */
7325 if (strchr("hlL", *fmt) != 0)
7326 descr->modifier = tolower((int)*fmt++);
7327
7328 descr->type = *fmt;
7329 if (strchr("efgcsndoxui", *fmt) == 0) {
7330 fmtObj->error = "bad scan conversion character";
7331 return JIM_ERR;
7332 } else if (*fmt == 'c' && descr->width != 0) {
7333 fmtObj->error = "field width may not be specified in %c "
7334 "conversion";
7335 return JIM_ERR;
7336 } else if (*fmt == 'u' && descr->modifier == 'l') {
7337 fmtObj->error = "unsigned wide not supported";
7338 return JIM_ERR;
7339 }
7340 }
7341 curr++;
7342 }
7343 done:
7344 if (fmtObj->convCount == 0) {
7345 fmtObj->error = "no any conversion specifier given";
7346 return JIM_ERR;
7347 }
7348 return JIM_OK;
7349 }
7350
7351 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7352
7353 #define FormatGetCnvCount(_fo_) \
7354 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7355 #define FormatGetMaxPos(_fo_) \
7356 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7357 #define FormatGetError(_fo_) \
7358 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7359
7360 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7361 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7362 * bitvector implementation in Jim? */
7363
7364 static int JimTestBit(const char *bitvec, char ch)
7365 {
7366 div_t pos = div(ch-1, 8);
7367 return bitvec[pos.quot] & (1 << pos.rem);
7368 }
7369
7370 static void JimSetBit(char *bitvec, char ch)
7371 {
7372 div_t pos = div(ch-1, 8);
7373 bitvec[pos.quot] |= (1 << pos.rem);
7374 }
7375
7376 #if 0 /* currently not used */
7377 static void JimClearBit(char *bitvec, char ch)
7378 {
7379 div_t pos = div(ch-1, 8);
7380 bitvec[pos.quot] &= ~(1 << pos.rem);
7381 }
7382 #endif
7383
7384 /* JimScanAString is used to scan an unspecified string that ends with
7385 * next WS, or a string that is specified via a charset. The charset
7386 * is currently implemented in a way to only allow for usage with
7387 * ASCII. Whenever we will switch to UNICODE, another idea has to
7388 * be born :-/
7389 *
7390 * FIXME: Works only with ASCII */
7391
7392 static Jim_Obj *
7393 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7394 {
7395 size_t i;
7396 Jim_Obj *result;
7397 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7398 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7399
7400 /* First init charset to nothing or all, depending if a specified
7401 * or an unspecified string has to be parsed */
7402 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7403 if (sdescr) {
7404 /* There was a set description given, that means we are parsing
7405 * a specified string. So we have to build a corresponding
7406 * charset reflecting the description */
7407 int notFlag = 0;
7408 /* Should the set be negated at the end? */
7409 if (*sdescr == '^') {
7410 notFlag = 1;
7411 ++sdescr;
7412 }
7413 /* Here '-' is meant literally and not to define a range */
7414 if (*sdescr == '-') {
7415 JimSetBit(charset, '-');
7416 ++sdescr;
7417 }
7418 while (*sdescr) {
7419 if (sdescr[1] == '-' && sdescr[2] != 0) {
7420 /* Handle range definitions */
7421 int i;
7422 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7423 JimSetBit(charset, (char)i);
7424 sdescr += 3;
7425 } else {
7426 /* Handle verbatim character definitions */
7427 JimSetBit(charset, *sdescr++);
7428 }
7429 }
7430 /* Negate the charset if there was a NOT given */
7431 for (i=0; notFlag && i < sizeof(charset); ++i)
7432 charset[i] = ~charset[i];
7433 }
7434 /* And after all the mess above, the real work begin ... */
7435 while (str && *str) {
7436 if (!sdescr && isspace((int)*str))
7437 break; /* EOS via WS if unspecified */
7438 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7439 else break; /* EOS via mismatch if specified scanning */
7440 }
7441 *buffer = 0; /* Close the string properly ... */
7442 result = Jim_NewStringObj(interp, anchor, -1);
7443 Jim_Free(anchor); /* ... and free it afer usage */
7444 return result;
7445 }
7446
7447 /* ScanOneEntry will scan one entry out of the string passed as argument.
7448 * It use the sscanf() function for this task. After extracting and
7449 * converting of the value, the count of scanned characters will be
7450 * returned of -1 in case of no conversion tool place and string was
7451 * already scanned thru */
7452
7453 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7454 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7455 {
7456 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7457 ? sizeof(jim_wide) \
7458 : sizeof(double))
7459 char buffer[MAX_SIZE];
7460 char *value = buffer;
7461 const char *tok;
7462 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7463 size_t sLen = strlen(&str[pos]), scanned = 0;
7464 size_t anchor = pos;
7465 int i;
7466
7467 /* First pessimiticly assume, we will not scan anything :-) */
7468 *valObjPtr = 0;
7469 if (descr->prefix) {
7470 /* There was a prefix given before the conversion, skip it and adjust
7471 * the string-to-be-parsed accordingly */
7472 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7473 /* If prefix require, skip WS */
7474 if (isspace((int)descr->prefix[i]))
7475 while (str[pos] && isspace((int)str[pos])) ++pos;
7476 else if (descr->prefix[i] != str[pos])
7477 break; /* Prefix do not match here, leave the loop */
7478 else
7479 ++pos; /* Prefix matched so far, next round */
7480 }
7481 if (str[pos] == 0)
7482 return -1; /* All of str consumed: EOF condition */
7483 else if (descr->prefix[i] != 0)
7484 return 0; /* Not whole prefix consumed, no conversion possible */
7485 }
7486 /* For all but following conversion, skip leading WS */
7487 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7488 while (isspace((int)str[pos])) ++pos;
7489 /* Determine how much skipped/scanned so far */
7490 scanned = pos - anchor;
7491 if (descr->type == 'n') {
7492 /* Return pseudo conversion means: how much scanned so far? */
7493 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7494 } else if (str[pos] == 0) {
7495 /* Cannot scan anything, as str is totally consumed */
7496 return -1;
7497 } else {
7498 /* Processing of conversions follows ... */
7499 if (descr->width > 0) {
7500 /* Do not try to scan as fas as possible but only the given width.
7501 * To ensure this, we copy the part that should be scanned. */
7502 size_t tLen = descr->width > sLen ? sLen : descr->width;
7503 tok = Jim_StrDupLen(&str[pos], tLen);
7504 } else {
7505 /* As no width was given, simply refer to the original string */
7506 tok = &str[pos];
7507 }
7508 switch (descr->type) {
7509 case 'c':
7510 *valObjPtr = Jim_NewIntObj(interp, *tok);
7511 scanned += 1;
7512 break;
7513 case 'd': case 'o': case 'x': case 'u': case 'i': {
7514 char *endp; /* Position where the number finished */
7515 int base = descr->type == 'o' ? 8
7516 : descr->type == 'x' ? 16
7517 : descr->type == 'i' ? 0
7518 : 10;
7519
7520 do {
7521 /* Try to scan a number with the given base */
7522 if (descr->modifier == 'l')
7523 #ifdef HAVE_LONG_LONG
7524 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7525 #else
7526 *(jim_wide*)value = strtol(tok, &endp, base);
7527 #endif
7528 else
7529 if (descr->type == 'u')
7530 *(long*)value = strtoul(tok, &endp, base);
7531 else
7532 *(long*)value = strtol(tok, &endp, base);
7533 /* If scanning failed, and base was undetermined, simply
7534 * put it to 10 and try once more. This should catch the
7535 * case where %i begin to parse a number prefix (e.g.
7536 * '0x' but no further digits follows. This will be
7537 * handled as a ZERO followed by a char 'x' by Tcl */
7538 if (endp == tok && base == 0) base = 10;
7539 else break;
7540 } while (1);
7541 if (endp != tok) {
7542 /* There was some number sucessfully scanned! */
7543 if (descr->modifier == 'l')
7544 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7545 else
7546 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7547 /* Adjust the number-of-chars scanned so far */
7548 scanned += endp - tok;
7549 } else {
7550 /* Nothing was scanned. We have to determine if this
7551 * happened due to e.g. prefix mismatch or input str
7552 * exhausted */
7553 scanned = *tok ? 0 : -1;
7554 }
7555 break;
7556 }
7557 case 's': case '[': {
7558 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7559 scanned += Jim_Length(*valObjPtr);
7560 break;
7561 }
7562 case 'e': case 'f': case 'g': {
7563 char *endp;
7564
7565 *(double*)value = strtod(tok, &endp);
7566 if (endp != tok) {
7567 /* There was some number sucessfully scanned! */
7568 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7569 /* Adjust the number-of-chars scanned so far */
7570 scanned += endp - tok;
7571 } else {
7572 /* Nothing was scanned. We have to determine if this
7573 * happened due to e.g. prefix mismatch or input str
7574 * exhausted */
7575 scanned = *tok ? 0 : -1;
7576 }
7577 break;
7578 }
7579 }
7580 /* If a substring was allocated (due to pre-defined width) do not
7581 * forget to free it */
7582 if (tok != &str[pos])
7583 Jim_Free((char*)tok);
7584 }
7585 return scanned;
7586 }
7587
7588 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7589 * string and returns all converted (and not ignored) values in a list back
7590 * to the caller. If an error occured, a NULL pointer will be returned */
7591
7592 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7593 Jim_Obj *fmtObjPtr, int flags)
7594 {
7595 size_t i, pos;
7596 int scanned = 1;
7597 const char *str = Jim_GetString(strObjPtr, 0);
7598 Jim_Obj *resultList = 0;
7599 Jim_Obj **resultVec;
7600 int resultc;
7601 Jim_Obj *emptyStr = 0;
7602 ScanFmtStringObj *fmtObj;
7603
7604 /* If format specification is not an object, convert it! */
7605 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7606 SetScanFmtFromAny(interp, fmtObjPtr);
7607 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7608 /* Check if format specification was valid */
7609 if (fmtObj->error != 0) {
7610 if (flags & JIM_ERRMSG)
7611 Jim_SetResultString(interp, fmtObj->error, -1);
7612 return 0;
7613 }
7614 /* Allocate a new "shared" empty string for all unassigned conversions */
7615 emptyStr = Jim_NewEmptyStringObj(interp);
7616 Jim_IncrRefCount(emptyStr);
7617 /* Create a list and fill it with empty strings up to max specified XPG3 */
7618 resultList = Jim_NewListObj(interp, 0, 0);
7619 if (fmtObj->maxPos > 0) {
7620 for (i=0; i < fmtObj->maxPos; ++i)
7621 Jim_ListAppendElement(interp, resultList, emptyStr);
7622 JimListGetElements(interp, resultList, &resultc, &resultVec);
7623 }
7624 /* Now handle every partial format description */
7625 for (i=0, pos=0; i < fmtObj->count; ++i) {
7626 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7627 Jim_Obj *value = 0;
7628 /* Only last type may be "literal" w/o conversion - skip it! */
7629 if (descr->type == 0) continue;
7630 /* As long as any conversion could be done, we will proceed */
7631 if (scanned > 0)
7632 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7633 /* In case our first try results in EOF, we will leave */
7634 if (scanned == -1 && i == 0)
7635 goto eof;
7636 /* Advance next pos-to-be-scanned for the amount scanned already */
7637 pos += scanned;
7638 /* value == 0 means no conversion took place so take empty string */
7639 if (value == 0)
7640 value = Jim_NewEmptyStringObj(interp);
7641 /* If value is a non-assignable one, skip it */
7642 if (descr->pos == -1) {
7643 Jim_FreeNewObj(interp, value);
7644 } else if (descr->pos == 0)
7645 /* Otherwise append it to the result list if no XPG3 was given */
7646 Jim_ListAppendElement(interp, resultList, value);
7647 else if (resultVec[descr->pos-1] == emptyStr) {
7648 /* But due to given XPG3, put the value into the corr. slot */
7649 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7650 Jim_IncrRefCount(value);
7651 resultVec[descr->pos-1] = value;
7652 } else {
7653 /* Otherwise, the slot was already used - free obj and ERROR */
7654 Jim_FreeNewObj(interp, value);
7655 goto err;
7656 }
7657 }
7658 Jim_DecrRefCount(interp, emptyStr);
7659 return resultList;
7660 eof:
7661 Jim_DecrRefCount(interp, emptyStr);
7662 Jim_FreeNewObj(interp, resultList);
7663 return (Jim_Obj*)EOF;
7664 err:
7665 Jim_DecrRefCount(interp, emptyStr);
7666 Jim_FreeNewObj(interp, resultList);
7667 return 0;
7668 }
7669
7670 /* -----------------------------------------------------------------------------
7671 * Pseudo Random Number Generation
7672 * ---------------------------------------------------------------------------*/
7673 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7674 int seedLen);
7675
7676 /* Initialize the sbox with the numbers from 0 to 255 */
7677 static void JimPrngInit(Jim_Interp *interp)
7678 {
7679 int i;
7680 unsigned int seed[256];
7681
7682 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7683 for (i = 0; i < 256; i++)
7684 seed[i] = (rand() ^ time(NULL) ^ clock());
7685 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7686 }
7687
7688 /* Generates N bytes of random data */
7689 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7690 {
7691 Jim_PrngState *prng;
7692 unsigned char *destByte = (unsigned char*) dest;
7693 unsigned int si, sj, x;
7694
7695 /* initialization, only needed the first time */
7696 if (interp->prngState == NULL)
7697 JimPrngInit(interp);
7698 prng = interp->prngState;
7699 /* generates 'len' bytes of pseudo-random numbers */
7700 for (x = 0; x < len; x++) {
7701 prng->i = (prng->i+1) & 0xff;
7702 si = prng->sbox[prng->i];
7703 prng->j = (prng->j + si) & 0xff;
7704 sj = prng->sbox[prng->j];
7705 prng->sbox[prng->i] = sj;
7706 prng->sbox[prng->j] = si;
7707 *destByte++ = prng->sbox[(si+sj)&0xff];
7708 }
7709 }
7710
7711 /* Re-seed the generator with user-provided bytes */
7712 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7713 int seedLen)
7714 {
7715 int i;
7716 unsigned char buf[256];
7717 Jim_PrngState *prng;
7718
7719 /* initialization, only needed the first time */
7720 if (interp->prngState == NULL)
7721 JimPrngInit(interp);
7722 prng = interp->prngState;
7723
7724 /* Set the sbox[i] with i */
7725 for (i = 0; i < 256; i++)
7726 prng->sbox[i] = i;
7727 /* Now use the seed to perform a random permutation of the sbox */
7728 for (i = 0; i < seedLen; i++) {
7729 unsigned char t;
7730
7731 t = prng->sbox[i&0xFF];
7732 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7733 prng->sbox[seed[i]] = t;
7734 }
7735 prng->i = prng->j = 0;
7736 /* discard the first 256 bytes of stream. */
7737 JimRandomBytes(interp, buf, 256);
7738 }
7739
7740 /* -----------------------------------------------------------------------------
7741 * Dynamic libraries support (WIN32 not supported)
7742 * ---------------------------------------------------------------------------*/
7743
7744 #ifdef JIM_DYNLIB
7745 #ifdef WIN32
7746 #define RTLD_LAZY 0
7747 void * dlopen(const char *path, int mode)
7748 {
7749 JIM_NOTUSED(mode);
7750
7751 return (void *)LoadLibraryA(path);
7752 }
7753 int dlclose(void *handle)
7754 {
7755 FreeLibrary((HANDLE)handle);
7756 return 0;
7757 }
7758 void *dlsym(void *handle, const char *symbol)
7759 {
7760 return GetProcAddress((HMODULE)handle, symbol);
7761 }
7762 static char win32_dlerror_string[121];
7763 const char *dlerror()
7764 {
7765 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7766 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7767 return win32_dlerror_string;
7768 }
7769 #endif /* WIN32 */
7770
7771 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7772 {
7773 Jim_Obj *libPathObjPtr;
7774 int prefixc, i;
7775 void *handle;
7776 int (*onload)(Jim_Interp *interp);
7777
7778 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7779 if (libPathObjPtr == NULL) {
7780 prefixc = 0;
7781 libPathObjPtr = NULL;
7782 } else {
7783 Jim_IncrRefCount(libPathObjPtr);
7784 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7785 }
7786
7787 for (i = -1; i < prefixc; i++) {
7788 if (i < 0) {
7789 handle = dlopen(pathName, RTLD_LAZY);
7790 } else {
7791 FILE *fp;
7792 char buf[JIM_PATH_LEN];
7793 const char *prefix;
7794 int prefixlen;
7795 Jim_Obj *prefixObjPtr;
7796
7797 buf[0] = '\0';
7798 if (Jim_ListIndex(interp, libPathObjPtr, i,
7799 &prefixObjPtr, JIM_NONE) != JIM_OK)
7800 continue;
7801 prefix = Jim_GetString(prefixObjPtr, NULL);
7802 prefixlen = strlen(prefix);
7803 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7804 continue;
7805 if (prefixlen && prefix[prefixlen-1] == '/')
7806 sprintf(buf, "%s%s", prefix, pathName);
7807 else
7808 sprintf(buf, "%s/%s", prefix, pathName);
7809 printf("opening '%s'\n", buf);
7810 fp = fopen(buf, "r");
7811 if (fp == NULL)
7812 continue;
7813 fclose(fp);
7814 handle = dlopen(buf, RTLD_LAZY);
7815 printf("got handle %p\n", handle);
7816 }
7817 if (handle == NULL) {
7818 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7819 Jim_AppendStrings(interp, Jim_GetResult(interp),
7820 "error loading extension \"", pathName,
7821 "\": ", dlerror(), NULL);
7822 if (i < 0)
7823 continue;
7824 goto err;
7825 }
7826 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7827 Jim_SetResultString(interp,
7828 "No Jim_OnLoad symbol found on extension", -1);
7829 goto err;
7830 }
7831 if (onload(interp) == JIM_ERR) {
7832 dlclose(handle);
7833 goto err;
7834 }
7835 Jim_SetEmptyResult(interp);
7836 if (libPathObjPtr != NULL)
7837 Jim_DecrRefCount(interp, libPathObjPtr);
7838 return JIM_OK;
7839 }
7840 err:
7841 if (libPathObjPtr != NULL)
7842 Jim_DecrRefCount(interp, libPathObjPtr);
7843 return JIM_ERR;
7844 }
7845 #else /* JIM_DYNLIB */
7846 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7847 {
7848 JIM_NOTUSED(interp);
7849 JIM_NOTUSED(pathName);
7850
7851 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7852 return JIM_ERR;
7853 }
7854 #endif/* JIM_DYNLIB */
7855
7856 /* -----------------------------------------------------------------------------
7857 * Packages handling
7858 * ---------------------------------------------------------------------------*/
7859
7860 #define JIM_PKG_ANY_VERSION -1
7861
7862 /* Convert a string of the type "1.2" into an integer.
7863 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7864 * to the integer with value 102 */
7865 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7866 int *intPtr, int flags)
7867 {
7868 char *copy;
7869 jim_wide major, minor;
7870 char *majorStr, *minorStr, *p;
7871
7872 if (v[0] == '\0') {
7873 *intPtr = JIM_PKG_ANY_VERSION;
7874 return JIM_OK;
7875 }
7876
7877 copy = Jim_StrDup(v);
7878 p = strchr(copy, '.');
7879 if (p == NULL) goto badfmt;
7880 *p = '\0';
7881 majorStr = copy;
7882 minorStr = p+1;
7883
7884 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
7885 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
7886 goto badfmt;
7887 *intPtr = (int)(major*100+minor);
7888 Jim_Free(copy);
7889 return JIM_OK;
7890
7891 badfmt:
7892 Jim_Free(copy);
7893 if (flags & JIM_ERRMSG) {
7894 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7895 Jim_AppendStrings(interp, Jim_GetResult(interp),
7896 "invalid package version '", v, "'", NULL);
7897 }
7898 return JIM_ERR;
7899 }
7900
7901 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
7902 static int JimPackageMatchVersion(int needed, int actual, int flags)
7903 {
7904 if (needed == JIM_PKG_ANY_VERSION) return 1;
7905 if (flags & JIM_MATCHVER_EXACT) {
7906 return needed == actual;
7907 } else {
7908 return needed/100 == actual/100 && (needed <= actual);
7909 }
7910 }
7911
7912 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
7913 int flags)
7914 {
7915 int intVersion;
7916 /* Check if the version format is ok */
7917 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
7918 return JIM_ERR;
7919 /* If the package was already provided returns an error. */
7920 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
7921 if (flags & JIM_ERRMSG) {
7922 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7923 Jim_AppendStrings(interp, Jim_GetResult(interp),
7924 "package '", name, "' was already provided", NULL);
7925 }
7926 return JIM_ERR;
7927 }
7928 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
7929 return JIM_OK;
7930 }
7931
7932 #ifndef JIM_ANSIC
7933
7934 #ifndef WIN32
7935 # include <sys/types.h>
7936 # include <dirent.h>
7937 #else
7938 # include <io.h>
7939 /* Posix dirent.h compatiblity layer for WIN32.
7940 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
7941 * Copyright Salvatore Sanfilippo ,2005.
7942 *
7943 * Permission to use, copy, modify, and distribute this software and its
7944 * documentation for any purpose is hereby granted without fee, provided
7945 * that this copyright and permissions notice appear in all copies and
7946 * derivatives.
7947 *
7948 * This software is supplied "as is" without express or implied warranty.
7949 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
7950 */
7951
7952 struct dirent {
7953 char *d_name;
7954 };
7955
7956 typedef struct DIR {
7957 long handle; /* -1 for failed rewind */
7958 struct _finddata_t info;
7959 struct dirent result; /* d_name null iff first time */
7960 char *name; /* null-terminated char string */
7961 } DIR;
7962
7963 DIR *opendir(const char *name)
7964 {
7965 DIR *dir = 0;
7966
7967 if(name && name[0]) {
7968 size_t base_length = strlen(name);
7969 const char *all = /* search pattern must end with suitable wildcard */
7970 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
7971
7972 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
7973 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
7974 {
7975 strcat(strcpy(dir->name, name), all);
7976
7977 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
7978 dir->result.d_name = 0;
7979 else { /* rollback */
7980 Jim_Free(dir->name);
7981 Jim_Free(dir);
7982 dir = 0;
7983 }
7984 } else { /* rollback */
7985 Jim_Free(dir);
7986 dir = 0;
7987 errno = ENOMEM;
7988 }
7989 } else {
7990 errno = EINVAL;
7991 }
7992 return dir;
7993 }
7994
7995 int closedir(DIR *dir)
7996 {
7997 int result = -1;
7998
7999 if(dir) {
8000 if(dir->handle != -1)
8001 result = _findclose(dir->handle);
8002 Jim_Free(dir->name);
8003 Jim_Free(dir);
8004 }
8005 if(result == -1) /* map all errors to EBADF */
8006 errno = EBADF;
8007 return result;
8008 }
8009
8010 struct dirent *readdir(DIR *dir)
8011 {
8012 struct dirent *result = 0;
8013
8014 if(dir && dir->handle != -1) {
8015 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8016 result = &dir->result;
8017 result->d_name = dir->info.name;
8018 }
8019 } else {
8020 errno = EBADF;
8021 }
8022 return result;
8023 }
8024
8025 #endif /* WIN32 */
8026
8027 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8028 int prefixc, const char *pkgName, int pkgVer, int flags)
8029 {
8030 int bestVer = -1, i;
8031 int pkgNameLen = strlen(pkgName);
8032 char *bestPackage = NULL;
8033 struct dirent *de;
8034
8035 for (i = 0; i < prefixc; i++) {
8036 DIR *dir;
8037 char buf[JIM_PATH_LEN];
8038 int prefixLen;
8039
8040 if (prefixes[i] == NULL) continue;
8041 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8042 buf[JIM_PATH_LEN-1] = '\0';
8043 prefixLen = strlen(buf);
8044 if (prefixLen && buf[prefixLen-1] == '/')
8045 buf[prefixLen-1] = '\0';
8046
8047 if ((dir = opendir(buf)) == NULL) continue;
8048 while ((de = readdir(dir)) != NULL) {
8049 char *fileName = de->d_name;
8050 int fileNameLen = strlen(fileName);
8051
8052 if (strncmp(fileName, "jim-", 4) == 0 &&
8053 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8054 *(fileName+4+pkgNameLen) == '-' &&
8055 fileNameLen > 4 && /* note that this is not really useful */
8056 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8057 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8058 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8059 {
8060 char ver[6]; /* xx.yy<nulterm> */
8061 char *p = strrchr(fileName, '.');
8062 int verLen, fileVer;
8063
8064 verLen = p - (fileName+4+pkgNameLen+1);
8065 if (verLen < 3 || verLen > 5) continue;
8066 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8067 ver[verLen] = '\0';
8068 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8069 != JIM_OK) continue;
8070 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8071 (bestVer == -1 || bestVer < fileVer))
8072 {
8073 bestVer = fileVer;
8074 Jim_Free(bestPackage);
8075 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8076 sprintf(bestPackage, "%s/%s", buf, fileName);
8077 }
8078 }
8079 }
8080 closedir(dir);
8081 }
8082 return bestPackage;
8083 }
8084
8085 #else /* JIM_ANSIC */
8086
8087 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8088 int prefixc, const char *pkgName, int pkgVer, int flags)
8089 {
8090 JIM_NOTUSED(interp);
8091 JIM_NOTUSED(prefixes);
8092 JIM_NOTUSED(prefixc);
8093 JIM_NOTUSED(pkgName);
8094 JIM_NOTUSED(pkgVer);
8095 JIM_NOTUSED(flags);
8096 return NULL;
8097 }
8098
8099 #endif /* JIM_ANSIC */
8100
8101 /* Search for a suitable package under every dir specified by jim_libpath
8102 * and load it if possible. If a suitable package was loaded with success
8103 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8104 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8105 int flags)
8106 {
8107 Jim_Obj *libPathObjPtr;
8108 char **prefixes, *best;
8109 int prefixc, i, retCode = JIM_OK;
8110
8111 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8112 if (libPathObjPtr == NULL) {
8113 prefixc = 0;
8114 libPathObjPtr = NULL;
8115 } else {
8116 Jim_IncrRefCount(libPathObjPtr);
8117 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8118 }
8119
8120 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8121 for (i = 0; i < prefixc; i++) {
8122 Jim_Obj *prefixObjPtr;
8123 if (Jim_ListIndex(interp, libPathObjPtr, i,
8124 &prefixObjPtr, JIM_NONE) != JIM_OK)
8125 {
8126 prefixes[i] = NULL;
8127 continue;
8128 }
8129 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8130 }
8131 /* Scan every directory to find the "best" package. */
8132 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8133 if (best != NULL) {
8134 char *p = strrchr(best, '.');
8135 /* Try to load/source it */
8136 if (p && strcmp(p, ".tcl") == 0) {
8137 retCode = Jim_EvalFile(interp, best);
8138 } else {
8139 retCode = Jim_LoadLibrary(interp, best);
8140 }
8141 } else {
8142 retCode = JIM_ERR;
8143 }
8144 Jim_Free(best);
8145 for (i = 0; i < prefixc; i++)
8146 Jim_Free(prefixes[i]);
8147 Jim_Free(prefixes);
8148 if (libPathObjPtr)
8149 Jim_DecrRefCount(interp, libPathObjPtr);
8150 return retCode;
8151 }
8152
8153 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8154 const char *ver, int flags)
8155 {
8156 Jim_HashEntry *he;
8157 int requiredVer;
8158
8159 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8160 return NULL;
8161 he = Jim_FindHashEntry(&interp->packages, name);
8162 if (he == NULL) {
8163 /* Try to load the package. */
8164 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8165 he = Jim_FindHashEntry(&interp->packages, name);
8166 if (he == NULL) {
8167 return "?";
8168 }
8169 return he->val;
8170 }
8171 /* No way... return an error. */
8172 if (flags & JIM_ERRMSG) {
8173 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8174 Jim_AppendStrings(interp, Jim_GetResult(interp),
8175 "Can't find package '", name, "'", NULL);
8176 }
8177 return NULL;
8178 } else {
8179 int actualVer;
8180 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8181 != JIM_OK)
8182 {
8183 return NULL;
8184 }
8185 /* Check if version matches. */
8186 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8187 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8188 Jim_AppendStrings(interp, Jim_GetResult(interp),
8189 "Package '", name, "' already loaded, but with version ",
8190 he->val, NULL);
8191 return NULL;
8192 }
8193 return he->val;
8194 }
8195 }
8196
8197 /* -----------------------------------------------------------------------------
8198 * Eval
8199 * ---------------------------------------------------------------------------*/
8200 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8201 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8202
8203 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8204 Jim_Obj *const *argv);
8205
8206 /* Handle calls to the [unknown] command */
8207 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8208 {
8209 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8210 int retCode;
8211
8212 /* If the [unknown] command does not exists returns
8213 * just now */
8214 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8215 return JIM_ERR;
8216
8217 /* The object interp->unknown just contains
8218 * the "unknown" string, it is used in order to
8219 * avoid to lookup the unknown command every time
8220 * but instread to cache the result. */
8221 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8222 v = sv;
8223 else
8224 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8225 /* Make a copy of the arguments vector, but shifted on
8226 * the right of one position. The command name of the
8227 * command will be instead the first argument of the
8228 * [unknonw] call. */
8229 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8230 v[0] = interp->unknown;
8231 /* Call it */
8232 retCode = Jim_EvalObjVector(interp, argc+1, v);
8233 /* Clean up */
8234 if (v != sv)
8235 Jim_Free(v);
8236 return retCode;
8237 }
8238
8239 /* Eval the object vector 'objv' composed of 'objc' elements.
8240 * Every element is used as single argument.
8241 * Jim_EvalObj() will call this function every time its object
8242 * argument is of "list" type, with no string representation.
8243 *
8244 * This is possible because the string representation of a
8245 * list object generated by the UpdateStringOfList is made
8246 * in a way that ensures that every list element is a different
8247 * command argument. */
8248 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8249 {
8250 int i, retcode;
8251 Jim_Cmd *cmdPtr;
8252
8253 /* Incr refcount of arguments. */
8254 for (i = 0; i < objc; i++)
8255 Jim_IncrRefCount(objv[i]);
8256 /* Command lookup */
8257 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8258 if (cmdPtr == NULL) {
8259 retcode = JimUnknown(interp, objc, objv);
8260 } else {
8261 /* Call it -- Make sure result is an empty object. */
8262 Jim_SetEmptyResult(interp);
8263 if (cmdPtr->cmdProc) {
8264 interp->cmdPrivData = cmdPtr->privData;
8265 retcode = cmdPtr->cmdProc(interp, objc, objv);
8266 } else {
8267 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8268 if (retcode == JIM_ERR) {
8269 JimAppendStackTrace(interp,
8270 Jim_GetString(objv[0], NULL), "?", 1);
8271 }
8272 }
8273 }
8274 /* Decr refcount of arguments and return the retcode */
8275 for (i = 0; i < objc; i++)
8276 Jim_DecrRefCount(interp, objv[i]);
8277 return retcode;
8278 }
8279
8280 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8281 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8282 * The returned object has refcount = 0. */
8283 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8284 int tokens, Jim_Obj **objPtrPtr)
8285 {
8286 int totlen = 0, i, retcode;
8287 Jim_Obj **intv;
8288 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8289 Jim_Obj *objPtr;
8290 char *s;
8291
8292 if (tokens <= JIM_EVAL_SINTV_LEN)
8293 intv = sintv;
8294 else
8295 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8296 tokens);
8297 /* Compute every token forming the argument
8298 * in the intv objects vector. */
8299 for (i = 0; i < tokens; i++) {
8300 switch(token[i].type) {
8301 case JIM_TT_ESC:
8302 case JIM_TT_STR:
8303 intv[i] = token[i].objPtr;
8304 break;
8305 case JIM_TT_VAR:
8306 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8307 if (!intv[i]) {
8308 retcode = JIM_ERR;
8309 goto err;
8310 }
8311 break;
8312 case JIM_TT_DICTSUGAR:
8313 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8314 if (!intv[i]) {
8315 retcode = JIM_ERR;
8316 goto err;
8317 }
8318 break;
8319 case JIM_TT_CMD:
8320 retcode = Jim_EvalObj(interp, token[i].objPtr);
8321 if (retcode != JIM_OK)
8322 goto err;
8323 intv[i] = Jim_GetResult(interp);
8324 break;
8325 default:
8326 Jim_Panic(interp,
8327 "default token type reached "
8328 "in Jim_InterpolateTokens().");
8329 break;
8330 }
8331 Jim_IncrRefCount(intv[i]);
8332 /* Make sure there is a valid
8333 * string rep, and add the string
8334 * length to the total legnth. */
8335 Jim_GetString(intv[i], NULL);
8336 totlen += intv[i]->length;
8337 }
8338 /* Concatenate every token in an unique
8339 * object. */
8340 objPtr = Jim_NewStringObjNoAlloc(interp,
8341 NULL, 0);
8342 s = objPtr->bytes = Jim_Alloc(totlen+1);
8343 objPtr->length = totlen;
8344 for (i = 0; i < tokens; i++) {
8345 memcpy(s, intv[i]->bytes, intv[i]->length);
8346 s += intv[i]->length;
8347 Jim_DecrRefCount(interp, intv[i]);
8348 }
8349 objPtr->bytes[totlen] = '\0';
8350 /* Free the intv vector if not static. */
8351 if (tokens > JIM_EVAL_SINTV_LEN)
8352 Jim_Free(intv);
8353 *objPtrPtr = objPtr;
8354 return JIM_OK;
8355 err:
8356 i--;
8357 for (; i >= 0; i--)
8358 Jim_DecrRefCount(interp, intv[i]);
8359 if (tokens > JIM_EVAL_SINTV_LEN)
8360 Jim_Free(intv);
8361 return retcode;
8362 }
8363
8364 /* Helper of Jim_EvalObj() to perform argument expansion.
8365 * Basically this function append an argument to 'argv'
8366 * (and increments argc by reference accordingly), performing
8367 * expansion of the list object if 'expand' is non-zero, or
8368 * just adding objPtr to argv if 'expand' is zero. */
8369 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8370 int *argcPtr, int expand, Jim_Obj *objPtr)
8371 {
8372 if (!expand) {
8373 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8374 /* refcount of objPtr not incremented because
8375 * we are actually transfering a reference from
8376 * the old 'argv' to the expanded one. */
8377 (*argv)[*argcPtr] = objPtr;
8378 (*argcPtr)++;
8379 } else {
8380 int len, i;
8381
8382 Jim_ListLength(interp, objPtr, &len);
8383 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8384 for (i = 0; i < len; i++) {
8385 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8386 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8387 (*argcPtr)++;
8388 }
8389 /* The original object reference is no longer needed,
8390 * after the expansion it is no longer present on
8391 * the argument vector, but the single elements are
8392 * in its place. */
8393 Jim_DecrRefCount(interp, objPtr);
8394 }
8395 }
8396
8397 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8398 {
8399 int i, j = 0, len;
8400 ScriptObj *script;
8401 ScriptToken *token;
8402 int *cs; /* command structure array */
8403 int retcode = JIM_OK;
8404 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8405
8406 interp->errorFlag = 0;
8407
8408 /* If the object is of type "list" and there is no
8409 * string representation for this object, we can call
8410 * a specialized version of Jim_EvalObj() */
8411 if (scriptObjPtr->typePtr == &listObjType &&
8412 scriptObjPtr->internalRep.listValue.len &&
8413 scriptObjPtr->bytes == NULL) {
8414 Jim_IncrRefCount(scriptObjPtr);
8415 retcode = Jim_EvalObjVector(interp,
8416 scriptObjPtr->internalRep.listValue.len,
8417 scriptObjPtr->internalRep.listValue.ele);
8418 Jim_DecrRefCount(interp, scriptObjPtr);
8419 return retcode;
8420 }
8421
8422 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8423 script = Jim_GetScript(interp, scriptObjPtr);
8424 /* Now we have to make sure the internal repr will not be
8425 * freed on shimmering.
8426 *
8427 * Think for example to this:
8428 *
8429 * set x {llength $x; ... some more code ...}; eval $x
8430 *
8431 * In order to preserve the internal rep, we increment the
8432 * inUse field of the script internal rep structure. */
8433 script->inUse++;
8434
8435 token = script->token;
8436 len = script->len;
8437 cs = script->cmdStruct;
8438 i = 0; /* 'i' is the current token index. */
8439
8440 /* Reset the interpreter result. This is useful to
8441 * return the emtpy result in the case of empty program. */
8442 Jim_SetEmptyResult(interp);
8443
8444 /* Execute every command sequentially, returns on
8445 * error (i.e. if a command does not return JIM_OK) */
8446 while (i < len) {
8447 int expand = 0;
8448 int argc = *cs++; /* Get the number of arguments */
8449 Jim_Cmd *cmd;
8450
8451 /* Set the expand flag if needed. */
8452 if (argc == -1) {
8453 expand++;
8454 argc = *cs++;
8455 }
8456 /* Allocate the arguments vector */
8457 if (argc <= JIM_EVAL_SARGV_LEN)
8458 argv = sargv;
8459 else
8460 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8461 /* Populate the arguments objects. */
8462 for (j = 0; j < argc; j++) {
8463 int tokens = *cs++;
8464
8465 /* tokens is negative if expansion is needed.
8466 * for this argument. */
8467 if (tokens < 0) {
8468 tokens = (-tokens)-1;
8469 i++;
8470 }
8471 if (tokens == 1) {
8472 /* Fast path if the token does not
8473 * need interpolation */
8474 switch(token[i].type) {
8475 case JIM_TT_ESC:
8476 case JIM_TT_STR:
8477 argv[j] = token[i].objPtr;
8478 break;
8479 case JIM_TT_VAR:
8480 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8481 JIM_ERRMSG);
8482 if (!tmpObjPtr) {
8483 retcode = JIM_ERR;
8484 goto err;
8485 }
8486 argv[j] = tmpObjPtr;
8487 break;
8488 case JIM_TT_DICTSUGAR:
8489 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8490 if (!tmpObjPtr) {
8491 retcode = JIM_ERR;
8492 goto err;
8493 }
8494 argv[j] = tmpObjPtr;
8495 break;
8496 case JIM_TT_CMD:
8497 retcode = Jim_EvalObj(interp, token[i].objPtr);
8498 if (retcode != JIM_OK)
8499 goto err;
8500 argv[j] = Jim_GetResult(interp);
8501 break;
8502 default:
8503 Jim_Panic(interp,
8504 "default token type reached "
8505 "in Jim_EvalObj().");
8506 break;
8507 }
8508 Jim_IncrRefCount(argv[j]);
8509 i += 2;
8510 } else {
8511 /* For interpolation we call an helper
8512 * function doing the work for us. */
8513 if ((retcode = Jim_InterpolateTokens(interp,
8514 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8515 {
8516 goto err;
8517 }
8518 argv[j] = tmpObjPtr;
8519 Jim_IncrRefCount(argv[j]);
8520 i += tokens+1;
8521 }
8522 }
8523 /* Handle {expand} expansion */
8524 if (expand) {
8525 int *ecs = cs - argc;
8526 int eargc = 0;
8527 Jim_Obj **eargv = NULL;
8528
8529 for (j = 0; j < argc; j++) {
8530 Jim_ExpandArgument( interp, &eargv, &eargc,
8531 ecs[j] < 0, argv[j]);
8532 }
8533 if (argv != sargv)
8534 Jim_Free(argv);
8535 argc = eargc;
8536 argv = eargv;
8537 j = argc;
8538 if (argc == 0) {
8539 /* Nothing to do with zero args. */
8540 Jim_Free(eargv);
8541 continue;
8542 }
8543 }
8544 /* Lookup the command to call */
8545 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8546 if (cmd != NULL) {
8547 /* Call it -- Make sure result is an empty object. */
8548 Jim_SetEmptyResult(interp);
8549 if (cmd->cmdProc) {
8550 interp->cmdPrivData = cmd->privData;
8551 retcode = cmd->cmdProc(interp, argc, argv);
8552 } else {
8553 retcode = JimCallProcedure(interp, cmd, argc, argv);
8554 if (retcode == JIM_ERR) {
8555 JimAppendStackTrace(interp,
8556 Jim_GetString(argv[0], NULL), script->fileName,
8557 token[i-argc*2].linenr);
8558 }
8559 }
8560 } else {
8561 /* Call [unknown] */
8562 retcode = JimUnknown(interp, argc, argv);
8563 if (retcode == JIM_ERR) {
8564 JimAppendStackTrace(interp,
8565 Jim_GetString(argv[0], NULL), script->fileName,
8566 token[i-argc*2].linenr);
8567 }
8568 }
8569 if (retcode != JIM_OK) {
8570 i -= argc*2; /* point to the command name. */
8571 goto err;
8572 }
8573 /* Decrement the arguments count */
8574 for (j = 0; j < argc; j++) {
8575 Jim_DecrRefCount(interp, argv[j]);
8576 }
8577
8578 if (argv != sargv) {
8579 Jim_Free(argv);
8580 argv = NULL;
8581 }
8582 }
8583 /* Note that we don't have to decrement inUse, because the
8584 * following code transfers our use of the reference again to
8585 * the script object. */
8586 j = 0; /* on normal termination, the argv array is already
8587 Jim_DecrRefCount-ed. */
8588 err:
8589 /* Handle errors. */
8590 if (retcode == JIM_ERR && !interp->errorFlag) {
8591 interp->errorFlag = 1;
8592 JimSetErrorFileName(interp, script->fileName);
8593 JimSetErrorLineNumber(interp, token[i].linenr);
8594 JimResetStackTrace(interp);
8595 }
8596 Jim_FreeIntRep(interp, scriptObjPtr);
8597 scriptObjPtr->typePtr = &scriptObjType;
8598 Jim_SetIntRepPtr(scriptObjPtr, script);
8599 Jim_DecrRefCount(interp, scriptObjPtr);
8600 for (i = 0; i < j; i++) {
8601 Jim_DecrRefCount(interp, argv[i]);
8602 }
8603 if (argv != sargv)
8604 Jim_Free(argv);
8605 return retcode;
8606 }
8607
8608 /* Call a procedure implemented in Tcl.
8609 * It's possible to speed-up a lot this function, currently
8610 * the callframes are not cached, but allocated and
8611 * destroied every time. What is expecially costly is
8612 * to create/destroy the local vars hash table every time.
8613 *
8614 * This can be fixed just implementing callframes caching
8615 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8616 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8617 Jim_Obj *const *argv)
8618 {
8619 int i, retcode;
8620 Jim_CallFrame *callFramePtr;
8621
8622 /* Check arity */
8623 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8624 argc > cmd->arityMax)) {
8625 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8626 Jim_AppendStrings(interp, objPtr,
8627 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8628 (cmd->arityMin > 1) ? " " : "",
8629 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8630 Jim_SetResult(interp, objPtr);
8631 return JIM_ERR;
8632 }
8633 /* Check if there are too nested calls */
8634 if (interp->numLevels == interp->maxNestingDepth) {
8635 Jim_SetResultString(interp,
8636 "Too many nested calls. Infinite recursion?", -1);
8637 return JIM_ERR;
8638 }
8639 /* Create a new callframe */
8640 callFramePtr = JimCreateCallFrame(interp);
8641 callFramePtr->parentCallFrame = interp->framePtr;
8642 callFramePtr->argv = argv;
8643 callFramePtr->argc = argc;
8644 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8645 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8646 callFramePtr->staticVars = cmd->staticVars;
8647 Jim_IncrRefCount(cmd->argListObjPtr);
8648 Jim_IncrRefCount(cmd->bodyObjPtr);
8649 interp->framePtr = callFramePtr;
8650 interp->numLevels ++;
8651 /* Set arguments */
8652 for (i = 0; i < cmd->arityMin-1; i++) {
8653 Jim_Obj *objPtr;
8654
8655 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8656 Jim_SetVariable(interp, objPtr, argv[i+1]);
8657 }
8658 if (cmd->arityMax == -1) {
8659 Jim_Obj *listObjPtr, *objPtr;
8660
8661 listObjPtr = Jim_NewListObj(interp, argv+cmd->arityMin,
8662 argc-cmd->arityMin);
8663 Jim_ListIndex(interp, cmd->argListObjPtr, i, &objPtr, JIM_NONE);
8664 Jim_SetVariable(interp, objPtr, listObjPtr);
8665 }
8666 /* Eval the body */
8667 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8668
8669 /* Destroy the callframe */
8670 interp->numLevels --;
8671 interp->framePtr = interp->framePtr->parentCallFrame;
8672 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8673 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8674 } else {
8675 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8676 }
8677 /* Handle the JIM_EVAL return code */
8678 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8679 int savedLevel = interp->evalRetcodeLevel;
8680
8681 interp->evalRetcodeLevel = interp->numLevels;
8682 while (retcode == JIM_EVAL) {
8683 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8684 Jim_IncrRefCount(resultScriptObjPtr);
8685 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8686 Jim_DecrRefCount(interp, resultScriptObjPtr);
8687 }
8688 interp->evalRetcodeLevel = savedLevel;
8689 }
8690 /* Handle the JIM_RETURN return code */
8691 if (retcode == JIM_RETURN) {
8692 retcode = interp->returnCode;
8693 interp->returnCode = JIM_OK;
8694 }
8695 return retcode;
8696 }
8697
8698 int Jim_Eval(Jim_Interp *interp, const char *script)
8699 {
8700 Jim_Obj *scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8701 int retval;
8702
8703 Jim_IncrRefCount(scriptObjPtr);
8704 retval = Jim_EvalObj(interp, scriptObjPtr);
8705 Jim_DecrRefCount(interp, scriptObjPtr);
8706 return retval;
8707 }
8708
8709 /* Execute script in the scope of the global level */
8710 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8711 {
8712 Jim_CallFrame *savedFramePtr;
8713 int retval;
8714
8715 savedFramePtr = interp->framePtr;
8716 interp->framePtr = interp->topFramePtr;
8717 retval = Jim_Eval(interp, script);
8718 interp->framePtr = savedFramePtr;
8719 return retval;
8720 }
8721
8722 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8723 {
8724 Jim_CallFrame *savedFramePtr;
8725 int retval;
8726
8727 savedFramePtr = interp->framePtr;
8728 interp->framePtr = interp->topFramePtr;
8729 retval = Jim_EvalObj(interp, scriptObjPtr);
8730 interp->framePtr = savedFramePtr;
8731 /* Try to report the error (if any) via the bgerror proc */
8732 if (retval != JIM_OK) {
8733 Jim_Obj *objv[2];
8734
8735 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8736 objv[1] = Jim_GetResult(interp);
8737 Jim_IncrRefCount(objv[0]);
8738 Jim_IncrRefCount(objv[1]);
8739 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8740 /* Report the error to stderr. */
8741 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8742 Jim_PrintErrorMessage(interp);
8743 }
8744 Jim_DecrRefCount(interp, objv[0]);
8745 Jim_DecrRefCount(interp, objv[1]);
8746 }
8747 return retval;
8748 }
8749
8750 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8751 {
8752 char *prg = NULL;
8753 FILE *fp;
8754 int nread, totread, maxlen, buflen;
8755 int retval;
8756 Jim_Obj *scriptObjPtr;
8757 char cwd[ 2048 ];
8758
8759 if ((fp = fopen(filename, "r")) == NULL) {
8760 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8761 getcwd( cwd, sizeof(cwd) );
8762 Jim_AppendStrings(interp, Jim_GetResult(interp),
8763 "Error loading script \"", filename, "\"",
8764 " cwd: ", cwd,
8765 " err: ", strerror(errno), NULL);
8766 return JIM_ERR;
8767 }
8768 buflen = 1024;
8769 maxlen = totread = 0;
8770 while (1) {
8771 if (maxlen < totread+buflen+1) {
8772 maxlen = totread+buflen+1;
8773 prg = Jim_Realloc(prg, maxlen);
8774 }
8775 /* do not use Jim_fread() - this is really a file */
8776 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8777 totread += nread;
8778 }
8779 prg[totread] = '\0';
8780 /* do not use Jim_fclose() - this is really a file */
8781 fclose(fp);
8782
8783 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8784 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8785 Jim_IncrRefCount(scriptObjPtr);
8786 retval = Jim_EvalObj(interp, scriptObjPtr);
8787 Jim_DecrRefCount(interp, scriptObjPtr);
8788 return retval;
8789 }
8790
8791 /* -----------------------------------------------------------------------------
8792 * Subst
8793 * ---------------------------------------------------------------------------*/
8794 static int JimParseSubstStr(struct JimParserCtx *pc)
8795 {
8796 pc->tstart = pc->p;
8797 pc->tline = pc->linenr;
8798 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8799 pc->p++; pc->len--;
8800 }
8801 pc->tend = pc->p-1;
8802 pc->tt = JIM_TT_ESC;
8803 return JIM_OK;
8804 }
8805
8806 static int JimParseSubst(struct JimParserCtx *pc, int flags)
8807 {
8808 int retval;
8809
8810 if (pc->len == 0) {
8811 pc->tstart = pc->tend = pc->p;
8812 pc->tline = pc->linenr;
8813 pc->tt = JIM_TT_EOL;
8814 pc->eof = 1;
8815 return JIM_OK;
8816 }
8817 switch(*pc->p) {
8818 case '[':
8819 retval = JimParseCmd(pc);
8820 if (flags & JIM_SUBST_NOCMD) {
8821 pc->tstart--;
8822 pc->tend++;
8823 pc->tt = (flags & JIM_SUBST_NOESC) ?
8824 JIM_TT_STR : JIM_TT_ESC;
8825 }
8826 return retval;
8827 break;
8828 case '$':
8829 if (JimParseVar(pc) == JIM_ERR) {
8830 pc->tstart = pc->tend = pc->p++; pc->len--;
8831 pc->tline = pc->linenr;
8832 pc->tt = JIM_TT_STR;
8833 } else {
8834 if (flags & JIM_SUBST_NOVAR) {
8835 pc->tstart--;
8836 if (flags & JIM_SUBST_NOESC)
8837 pc->tt = JIM_TT_STR;
8838 else
8839 pc->tt = JIM_TT_ESC;
8840 if (*pc->tstart == '{') {
8841 pc->tstart--;
8842 if (*(pc->tend+1))
8843 pc->tend++;
8844 }
8845 }
8846 }
8847 break;
8848 default:
8849 retval = JimParseSubstStr(pc);
8850 if (flags & JIM_SUBST_NOESC)
8851 pc->tt = JIM_TT_STR;
8852 return retval;
8853 break;
8854 }
8855 return JIM_OK;
8856 }
8857
8858 /* The subst object type reuses most of the data structures and functions
8859 * of the script object. Script's data structures are a bit more complex
8860 * for what is needed for [subst]itution tasks, but the reuse helps to
8861 * deal with a single data structure at the cost of some more memory
8862 * usage for substitutions. */
8863 static Jim_ObjType substObjType = {
8864 "subst",
8865 FreeScriptInternalRep,
8866 DupScriptInternalRep,
8867 NULL,
8868 JIM_TYPE_REFERENCES,
8869 };
8870
8871 /* This method takes the string representation of an object
8872 * as a Tcl string where to perform [subst]itution, and generates
8873 * the pre-parsed internal representation. */
8874 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
8875 {
8876 int scriptTextLen;
8877 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
8878 struct JimParserCtx parser;
8879 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
8880
8881 script->len = 0;
8882 script->csLen = 0;
8883 script->commands = 0;
8884 script->token = NULL;
8885 script->cmdStruct = NULL;
8886 script->inUse = 1;
8887 script->substFlags = flags;
8888 script->fileName = NULL;
8889
8890 JimParserInit(&parser, scriptText, scriptTextLen, 1);
8891 while(1) {
8892 char *token;
8893 int len, type, linenr;
8894
8895 JimParseSubst(&parser, flags);
8896 if (JimParserEof(&parser)) break;
8897 token = JimParserGetToken(&parser, &len, &type, &linenr);
8898 ScriptObjAddToken(interp, script, token, len, type,
8899 NULL, linenr);
8900 }
8901 /* Free the old internal rep and set the new one. */
8902 Jim_FreeIntRep(interp, objPtr);
8903 Jim_SetIntRepPtr(objPtr, script);
8904 objPtr->typePtr = &scriptObjType;
8905 return JIM_OK;
8906 }
8907
8908 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
8909 {
8910 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
8911
8912 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
8913 SetSubstFromAny(interp, objPtr, flags);
8914 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
8915 }
8916
8917 /* Performs commands,variables,blackslashes substitution,
8918 * storing the result object (with refcount 0) into
8919 * resObjPtrPtr. */
8920 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
8921 Jim_Obj **resObjPtrPtr, int flags)
8922 {
8923 ScriptObj *script;
8924 ScriptToken *token;
8925 int i, len, retcode = JIM_OK;
8926 Jim_Obj *resObjPtr, *savedResultObjPtr;
8927
8928 script = Jim_GetSubst(interp, substObjPtr, flags);
8929 #ifdef JIM_OPTIMIZATION
8930 /* Fast path for a very common case with array-alike syntax,
8931 * that's: $foo($bar) */
8932 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
8933 Jim_Obj *varObjPtr = script->token[0].objPtr;
8934
8935 Jim_IncrRefCount(varObjPtr);
8936 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
8937 if (resObjPtr == NULL) {
8938 Jim_DecrRefCount(interp, varObjPtr);
8939 return JIM_ERR;
8940 }
8941 Jim_DecrRefCount(interp, varObjPtr);
8942 *resObjPtrPtr = resObjPtr;
8943 return JIM_OK;
8944 }
8945 #endif
8946
8947 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
8948 /* In order to preserve the internal rep, we increment the
8949 * inUse field of the script internal rep structure. */
8950 script->inUse++;
8951
8952 token = script->token;
8953 len = script->len;
8954
8955 /* Save the interp old result, to set it again before
8956 * to return. */
8957 savedResultObjPtr = interp->result;
8958 Jim_IncrRefCount(savedResultObjPtr);
8959
8960 /* Perform the substitution. Starts with an empty object
8961 * and adds every token (performing the appropriate
8962 * var/command/escape substitution). */
8963 resObjPtr = Jim_NewStringObj(interp, "", 0);
8964 for (i = 0; i < len; i++) {
8965 Jim_Obj *objPtr;
8966
8967 switch(token[i].type) {
8968 case JIM_TT_STR:
8969 case JIM_TT_ESC:
8970 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
8971 break;
8972 case JIM_TT_VAR:
8973 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8974 if (objPtr == NULL) goto err;
8975 Jim_IncrRefCount(objPtr);
8976 Jim_AppendObj(interp, resObjPtr, objPtr);
8977 Jim_DecrRefCount(interp, objPtr);
8978 break;
8979 case JIM_TT_DICTSUGAR:
8980 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8981 if (!objPtr) {
8982 retcode = JIM_ERR;
8983 goto err;
8984 }
8985 break;
8986 case JIM_TT_CMD:
8987 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
8988 goto err;
8989 Jim_AppendObj(interp, resObjPtr, interp->result);
8990 break;
8991 default:
8992 Jim_Panic(interp,
8993 "default token type (%d) reached "
8994 "in Jim_SubstObj().", token[i].type);
8995 break;
8996 }
8997 }
8998 ok:
8999 if (retcode == JIM_OK)
9000 Jim_SetResult(interp, savedResultObjPtr);
9001 Jim_DecrRefCount(interp, savedResultObjPtr);
9002 /* Note that we don't have to decrement inUse, because the
9003 * following code transfers our use of the reference again to
9004 * the script object. */
9005 Jim_FreeIntRep(interp, substObjPtr);
9006 substObjPtr->typePtr = &scriptObjType;
9007 Jim_SetIntRepPtr(substObjPtr, script);
9008 Jim_DecrRefCount(interp, substObjPtr);
9009 *resObjPtrPtr = resObjPtr;
9010 return retcode;
9011 err:
9012 Jim_FreeNewObj(interp, resObjPtr);
9013 retcode = JIM_ERR;
9014 goto ok;
9015 }
9016
9017 /* -----------------------------------------------------------------------------
9018 * API Input/Export functions
9019 * ---------------------------------------------------------------------------*/
9020
9021 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9022 {
9023 Jim_HashEntry *he;
9024
9025 he = Jim_FindHashEntry(&interp->stub, funcname);
9026 if (!he)
9027 return JIM_ERR;
9028 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9029 return JIM_OK;
9030 }
9031
9032 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9033 {
9034 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9035 }
9036
9037 #define JIM_REGISTER_API(name) \
9038 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9039
9040 void JimRegisterCoreApi(Jim_Interp *interp)
9041 {
9042 interp->getApiFuncPtr = Jim_GetApi;
9043 JIM_REGISTER_API(Alloc);
9044 JIM_REGISTER_API(Free);
9045 JIM_REGISTER_API(Eval);
9046 JIM_REGISTER_API(EvalGlobal);
9047 JIM_REGISTER_API(EvalFile);
9048 JIM_REGISTER_API(EvalObj);
9049 JIM_REGISTER_API(EvalObjBackground);
9050 JIM_REGISTER_API(EvalObjVector);
9051 JIM_REGISTER_API(InitHashTable);
9052 JIM_REGISTER_API(ExpandHashTable);
9053 JIM_REGISTER_API(AddHashEntry);
9054 JIM_REGISTER_API(ReplaceHashEntry);
9055 JIM_REGISTER_API(DeleteHashEntry);
9056 JIM_REGISTER_API(FreeHashTable);
9057 JIM_REGISTER_API(FindHashEntry);
9058 JIM_REGISTER_API(ResizeHashTable);
9059 JIM_REGISTER_API(GetHashTableIterator);
9060 JIM_REGISTER_API(NextHashEntry);
9061 JIM_REGISTER_API(NewObj);
9062 JIM_REGISTER_API(FreeObj);
9063 JIM_REGISTER_API(InvalidateStringRep);
9064 JIM_REGISTER_API(InitStringRep);
9065 JIM_REGISTER_API(DuplicateObj);
9066 JIM_REGISTER_API(GetString);
9067 JIM_REGISTER_API(Length);
9068 JIM_REGISTER_API(InvalidateStringRep);
9069 JIM_REGISTER_API(NewStringObj);
9070 JIM_REGISTER_API(NewStringObjNoAlloc);
9071 JIM_REGISTER_API(AppendString);
9072 JIM_REGISTER_API(AppendObj);
9073 JIM_REGISTER_API(AppendStrings);
9074 JIM_REGISTER_API(StringEqObj);
9075 JIM_REGISTER_API(StringMatchObj);
9076 JIM_REGISTER_API(StringRangeObj);
9077 JIM_REGISTER_API(FormatString);
9078 JIM_REGISTER_API(CompareStringImmediate);
9079 JIM_REGISTER_API(NewReference);
9080 JIM_REGISTER_API(GetReference);
9081 JIM_REGISTER_API(SetFinalizer);
9082 JIM_REGISTER_API(GetFinalizer);
9083 JIM_REGISTER_API(CreateInterp);
9084 JIM_REGISTER_API(FreeInterp);
9085 JIM_REGISTER_API(GetExitCode);
9086 JIM_REGISTER_API(SetStdin);
9087 JIM_REGISTER_API(SetStdout);
9088 JIM_REGISTER_API(SetStderr);
9089 JIM_REGISTER_API(CreateCommand);
9090 JIM_REGISTER_API(CreateProcedure);
9091 JIM_REGISTER_API(DeleteCommand);
9092 JIM_REGISTER_API(RenameCommand);
9093 JIM_REGISTER_API(GetCommand);
9094 JIM_REGISTER_API(SetVariable);
9095 JIM_REGISTER_API(SetVariableStr);
9096 JIM_REGISTER_API(SetGlobalVariableStr);
9097 JIM_REGISTER_API(SetVariableStrWithStr);
9098 JIM_REGISTER_API(SetVariableLink);
9099 JIM_REGISTER_API(GetVariable);
9100 JIM_REGISTER_API(GetCallFrameByLevel);
9101 JIM_REGISTER_API(Collect);
9102 JIM_REGISTER_API(CollectIfNeeded);
9103 JIM_REGISTER_API(GetIndex);
9104 JIM_REGISTER_API(NewListObj);
9105 JIM_REGISTER_API(ListAppendElement);
9106 JIM_REGISTER_API(ListAppendList);
9107 JIM_REGISTER_API(ListLength);
9108 JIM_REGISTER_API(ListIndex);
9109 JIM_REGISTER_API(SetListIndex);
9110 JIM_REGISTER_API(ConcatObj);
9111 JIM_REGISTER_API(NewDictObj);
9112 JIM_REGISTER_API(DictKey);
9113 JIM_REGISTER_API(DictKeysVector);
9114 JIM_REGISTER_API(GetIndex);
9115 JIM_REGISTER_API(GetReturnCode);
9116 JIM_REGISTER_API(EvalExpression);
9117 JIM_REGISTER_API(GetBoolFromExpr);
9118 JIM_REGISTER_API(GetWide);
9119 JIM_REGISTER_API(GetLong);
9120 JIM_REGISTER_API(SetWide);
9121 JIM_REGISTER_API(NewIntObj);
9122 JIM_REGISTER_API(GetDouble);
9123 JIM_REGISTER_API(SetDouble);
9124 JIM_REGISTER_API(NewDoubleObj);
9125 JIM_REGISTER_API(WrongNumArgs);
9126 JIM_REGISTER_API(SetDictKeysVector);
9127 JIM_REGISTER_API(SubstObj);
9128 JIM_REGISTER_API(RegisterApi);
9129 JIM_REGISTER_API(PrintErrorMessage);
9130 JIM_REGISTER_API(InteractivePrompt);
9131 JIM_REGISTER_API(RegisterCoreCommands);
9132 JIM_REGISTER_API(GetSharedString);
9133 JIM_REGISTER_API(ReleaseSharedString);
9134 JIM_REGISTER_API(Panic);
9135 JIM_REGISTER_API(StrDup);
9136 JIM_REGISTER_API(UnsetVariable);
9137 JIM_REGISTER_API(GetVariableStr);
9138 JIM_REGISTER_API(GetGlobalVariable);
9139 JIM_REGISTER_API(GetGlobalVariableStr);
9140 JIM_REGISTER_API(GetAssocData);
9141 JIM_REGISTER_API(SetAssocData);
9142 JIM_REGISTER_API(DeleteAssocData);
9143 JIM_REGISTER_API(GetEnum);
9144 JIM_REGISTER_API(ScriptIsComplete);
9145 JIM_REGISTER_API(PackageRequire);
9146 JIM_REGISTER_API(PackageProvide);
9147 JIM_REGISTER_API(InitStack);
9148 JIM_REGISTER_API(FreeStack);
9149 JIM_REGISTER_API(StackLen);
9150 JIM_REGISTER_API(StackPush);
9151 JIM_REGISTER_API(StackPop);
9152 JIM_REGISTER_API(StackPeek);
9153 JIM_REGISTER_API(FreeStackElements);
9154 }
9155
9156 /* -----------------------------------------------------------------------------
9157 * Core commands utility functions
9158 * ---------------------------------------------------------------------------*/
9159 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9160 const char *msg)
9161 {
9162 int i;
9163 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9164
9165 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9166 for (i = 0; i < argc; i++) {
9167 Jim_AppendObj(interp, objPtr, argv[i]);
9168 if (!(i+1 == argc && msg[0] == '\0'))
9169 Jim_AppendString(interp, objPtr, " ", 1);
9170 }
9171 Jim_AppendString(interp, objPtr, msg, -1);
9172 Jim_AppendString(interp, objPtr, "\"", 1);
9173 Jim_SetResult(interp, objPtr);
9174 }
9175
9176 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9177 {
9178 Jim_HashTableIterator *htiter;
9179 Jim_HashEntry *he;
9180 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9181 const char *pattern;
9182 int patternLen;
9183
9184 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9185 htiter = Jim_GetHashTableIterator(&interp->commands);
9186 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9187 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9188 strlen((const char*)he->key), 0))
9189 continue;
9190 Jim_ListAppendElement(interp, listObjPtr,
9191 Jim_NewStringObj(interp, he->key, -1));
9192 }
9193 Jim_FreeHashTableIterator(htiter);
9194 return listObjPtr;
9195 }
9196
9197 #define JIM_VARLIST_GLOBALS 0
9198 #define JIM_VARLIST_LOCALS 1
9199 #define JIM_VARLIST_VARS 2
9200
9201 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9202 int mode)
9203 {
9204 Jim_HashTableIterator *htiter;
9205 Jim_HashEntry *he;
9206 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9207 const char *pattern;
9208 int patternLen;
9209
9210 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9211 if (mode == JIM_VARLIST_GLOBALS) {
9212 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9213 } else {
9214 /* For [info locals], if we are at top level an emtpy list
9215 * is returned. I don't agree, but we aim at compatibility (SS) */
9216 if (mode == JIM_VARLIST_LOCALS &&
9217 interp->framePtr == interp->topFramePtr)
9218 return listObjPtr;
9219 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9220 }
9221 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9222 Jim_Var *varPtr = (Jim_Var*) he->val;
9223 if (mode == JIM_VARLIST_LOCALS) {
9224 if (varPtr->linkFramePtr != NULL)
9225 continue;
9226 }
9227 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9228 strlen((const char*)he->key), 0))
9229 continue;
9230 Jim_ListAppendElement(interp, listObjPtr,
9231 Jim_NewStringObj(interp, he->key, -1));
9232 }
9233 Jim_FreeHashTableIterator(htiter);
9234 return listObjPtr;
9235 }
9236
9237 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9238 Jim_Obj **objPtrPtr)
9239 {
9240 Jim_CallFrame *targetCallFrame;
9241
9242 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9243 != JIM_OK)
9244 return JIM_ERR;
9245 /* No proc call at toplevel callframe */
9246 if (targetCallFrame == interp->topFramePtr) {
9247 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9248 Jim_AppendStrings(interp, Jim_GetResult(interp),
9249 "bad level \"",
9250 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9251 return JIM_ERR;
9252 }
9253 *objPtrPtr = Jim_NewListObj(interp,
9254 targetCallFrame->argv,
9255 targetCallFrame->argc);
9256 return JIM_OK;
9257 }
9258
9259 /* -----------------------------------------------------------------------------
9260 * Core commands
9261 * ---------------------------------------------------------------------------*/
9262
9263 /* fake [puts] -- not the real puts, just for debugging. */
9264 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9265 Jim_Obj *const *argv)
9266 {
9267 const char *str;
9268 int len, nonewline = 0;
9269
9270 if (argc != 2 && argc != 3) {
9271 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9272 return JIM_ERR;
9273 }
9274 if (argc == 3) {
9275 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9276 {
9277 Jim_SetResultString(interp, "The second argument must "
9278 "be -nonewline", -1);
9279 return JIM_OK;
9280 } else {
9281 nonewline = 1;
9282 argv++;
9283 }
9284 }
9285 str = Jim_GetString(argv[1], &len);
9286 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9287 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9288 return JIM_OK;
9289 }
9290
9291 /* Helper for [+] and [*] */
9292 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9293 Jim_Obj *const *argv, int op)
9294 {
9295 jim_wide wideValue, res;
9296 double doubleValue, doubleRes;
9297 int i;
9298
9299 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9300
9301 for (i = 1; i < argc; i++) {
9302 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9303 goto trydouble;
9304 if (op == JIM_EXPROP_ADD)
9305 res += wideValue;
9306 else
9307 res *= wideValue;
9308 }
9309 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9310 return JIM_OK;
9311 trydouble:
9312 doubleRes = (double) res;
9313 for (;i < argc; i++) {
9314 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9315 return JIM_ERR;
9316 if (op == JIM_EXPROP_ADD)
9317 doubleRes += doubleValue;
9318 else
9319 doubleRes *= doubleValue;
9320 }
9321 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9322 return JIM_OK;
9323 }
9324
9325 /* Helper for [-] and [/] */
9326 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9327 Jim_Obj *const *argv, int op)
9328 {
9329 jim_wide wideValue, res = 0;
9330 double doubleValue, doubleRes = 0;
9331 int i = 2;
9332
9333 if (argc < 2) {
9334 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9335 return JIM_ERR;
9336 } else if (argc == 2) {
9337 /* The arity = 2 case is different. For [- x] returns -x,
9338 * while [/ x] returns 1/x. */
9339 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9340 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9341 JIM_OK)
9342 {
9343 return JIM_ERR;
9344 } else {
9345 if (op == JIM_EXPROP_SUB)
9346 doubleRes = -doubleValue;
9347 else
9348 doubleRes = 1.0/doubleValue;
9349 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9350 doubleRes));
9351 return JIM_OK;
9352 }
9353 }
9354 if (op == JIM_EXPROP_SUB) {
9355 res = -wideValue;
9356 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9357 } else {
9358 doubleRes = 1.0/wideValue;
9359 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9360 doubleRes));
9361 }
9362 return JIM_OK;
9363 } else {
9364 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9365 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9366 != JIM_OK) {
9367 return JIM_ERR;
9368 } else {
9369 goto trydouble;
9370 }
9371 }
9372 }
9373 for (i = 2; i < argc; i++) {
9374 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9375 doubleRes = (double) res;
9376 goto trydouble;
9377 }
9378 if (op == JIM_EXPROP_SUB)
9379 res -= wideValue;
9380 else
9381 res /= wideValue;
9382 }
9383 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9384 return JIM_OK;
9385 trydouble:
9386 for (;i < argc; i++) {
9387 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9388 return JIM_ERR;
9389 if (op == JIM_EXPROP_SUB)
9390 doubleRes -= doubleValue;
9391 else
9392 doubleRes /= doubleValue;
9393 }
9394 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9395 return JIM_OK;
9396 }
9397
9398
9399 /* [+] */
9400 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9401 Jim_Obj *const *argv)
9402 {
9403 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9404 }
9405
9406 /* [*] */
9407 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9408 Jim_Obj *const *argv)
9409 {
9410 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9411 }
9412
9413 /* [-] */
9414 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9415 Jim_Obj *const *argv)
9416 {
9417 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9418 }
9419
9420 /* [/] */
9421 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9422 Jim_Obj *const *argv)
9423 {
9424 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9425 }
9426
9427 /* [set] */
9428 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9429 Jim_Obj *const *argv)
9430 {
9431 if (argc != 2 && argc != 3) {
9432 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9433 return JIM_ERR;
9434 }
9435 if (argc == 2) {
9436 Jim_Obj *objPtr;
9437 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9438 if (!objPtr)
9439 return JIM_ERR;
9440 Jim_SetResult(interp, objPtr);
9441 return JIM_OK;
9442 }
9443 /* argc == 3 case. */
9444 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9445 return JIM_ERR;
9446 Jim_SetResult(interp, argv[2]);
9447 return JIM_OK;
9448 }
9449
9450 /* [unset] */
9451 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9452 Jim_Obj *const *argv)
9453 {
9454 int i;
9455
9456 if (argc < 2) {
9457 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9458 return JIM_ERR;
9459 }
9460 for (i = 1; i < argc; i++) {
9461 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9462 return JIM_ERR;
9463 }
9464 return JIM_OK;
9465 }
9466
9467 /* [incr] */
9468 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9469 Jim_Obj *const *argv)
9470 {
9471 jim_wide wideValue, increment = 1;
9472 Jim_Obj *intObjPtr;
9473
9474 if (argc != 2 && argc != 3) {
9475 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9476 return JIM_ERR;
9477 }
9478 if (argc == 3) {
9479 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9480 return JIM_ERR;
9481 }
9482 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9483 if (!intObjPtr) return JIM_ERR;
9484 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9485 return JIM_ERR;
9486 if (Jim_IsShared(intObjPtr)) {
9487 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9488 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9489 Jim_FreeNewObj(interp, intObjPtr);
9490 return JIM_ERR;
9491 }
9492 } else {
9493 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9494 /* The following step is required in order to invalidate the
9495 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9496 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9497 return JIM_ERR;
9498 }
9499 }
9500 Jim_SetResult(interp, intObjPtr);
9501 return JIM_OK;
9502 }
9503
9504 /* [while] */
9505 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9506 Jim_Obj *const *argv)
9507 {
9508 if (argc != 3) {
9509 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9510 return JIM_ERR;
9511 }
9512 /* Try to run a specialized version of while if the expression
9513 * is in one of the following forms:
9514 *
9515 * $a < CONST, $a < $b
9516 * $a <= CONST, $a <= $b
9517 * $a > CONST, $a > $b
9518 * $a >= CONST, $a >= $b
9519 * $a != CONST, $a != $b
9520 * $a == CONST, $a == $b
9521 * $a
9522 * !$a
9523 * CONST
9524 */
9525
9526 #ifdef JIM_OPTIMIZATION
9527 {
9528 ExprByteCode *expr;
9529 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9530 int exprLen, retval;
9531
9532 /* STEP 1 -- Check if there are the conditions to run the specialized
9533 * version of while */
9534
9535 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9536 if (expr->len <= 0 || expr->len > 3) goto noopt;
9537 switch(expr->len) {
9538 case 1:
9539 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9540 expr->opcode[0] != JIM_EXPROP_NUMBER)
9541 goto noopt;
9542 break;
9543 case 2:
9544 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9545 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9546 goto noopt;
9547 break;
9548 case 3:
9549 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9550 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9551 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9552 goto noopt;
9553 switch(expr->opcode[2]) {
9554 case JIM_EXPROP_LT:
9555 case JIM_EXPROP_LTE:
9556 case JIM_EXPROP_GT:
9557 case JIM_EXPROP_GTE:
9558 case JIM_EXPROP_NUMEQ:
9559 case JIM_EXPROP_NUMNE:
9560 /* nothing to do */
9561 break;
9562 default:
9563 goto noopt;
9564 }
9565 break;
9566 default:
9567 Jim_Panic(interp,
9568 "Unexpected default reached in Jim_WhileCoreCommand()");
9569 break;
9570 }
9571
9572 /* STEP 2 -- conditions meet. Initialization. Take different
9573 * branches for different expression lengths. */
9574 exprLen = expr->len;
9575
9576 if (exprLen == 1) {
9577 jim_wide wideValue;
9578
9579 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9580 varAObjPtr = expr->obj[0];
9581 Jim_IncrRefCount(varAObjPtr);
9582 } else {
9583 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9584 goto noopt;
9585 }
9586 while (1) {
9587 if (varAObjPtr) {
9588 if (!(objPtr =
9589 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9590 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9591 {
9592 Jim_DecrRefCount(interp, varAObjPtr);
9593 goto noopt;
9594 }
9595 }
9596 if (!wideValue) break;
9597 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9598 switch(retval) {
9599 case JIM_BREAK:
9600 if (varAObjPtr)
9601 Jim_DecrRefCount(interp, varAObjPtr);
9602 goto out;
9603 break;
9604 case JIM_CONTINUE:
9605 continue;
9606 break;
9607 default:
9608 if (varAObjPtr)
9609 Jim_DecrRefCount(interp, varAObjPtr);
9610 return retval;
9611 }
9612 }
9613 }
9614 if (varAObjPtr)
9615 Jim_DecrRefCount(interp, varAObjPtr);
9616 } else if (exprLen == 3) {
9617 jim_wide wideValueA, wideValueB, cmpRes = 0;
9618 int cmpType = expr->opcode[2];
9619
9620 varAObjPtr = expr->obj[0];
9621 Jim_IncrRefCount(varAObjPtr);
9622 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9623 varBObjPtr = expr->obj[1];
9624 Jim_IncrRefCount(varBObjPtr);
9625 } else {
9626 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9627 goto noopt;
9628 }
9629 while (1) {
9630 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9631 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9632 {
9633 Jim_DecrRefCount(interp, varAObjPtr);
9634 if (varBObjPtr)
9635 Jim_DecrRefCount(interp, varBObjPtr);
9636 goto noopt;
9637 }
9638 if (varBObjPtr) {
9639 if (!(objPtr =
9640 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9641 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9642 {
9643 Jim_DecrRefCount(interp, varAObjPtr);
9644 if (varBObjPtr)
9645 Jim_DecrRefCount(interp, varBObjPtr);
9646 goto noopt;
9647 }
9648 }
9649 switch(cmpType) {
9650 case JIM_EXPROP_LT:
9651 cmpRes = wideValueA < wideValueB; break;
9652 case JIM_EXPROP_LTE:
9653 cmpRes = wideValueA <= wideValueB; break;
9654 case JIM_EXPROP_GT:
9655 cmpRes = wideValueA > wideValueB; break;
9656 case JIM_EXPROP_GTE:
9657 cmpRes = wideValueA >= wideValueB; break;
9658 case JIM_EXPROP_NUMEQ:
9659 cmpRes = wideValueA == wideValueB; break;
9660 case JIM_EXPROP_NUMNE:
9661 cmpRes = wideValueA != wideValueB; break;
9662 }
9663 if (!cmpRes) break;
9664 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9665 switch(retval) {
9666 case JIM_BREAK:
9667 Jim_DecrRefCount(interp, varAObjPtr);
9668 if (varBObjPtr)
9669 Jim_DecrRefCount(interp, varBObjPtr);
9670 goto out;
9671 break;
9672 case JIM_CONTINUE:
9673 continue;
9674 break;
9675 default:
9676 Jim_DecrRefCount(interp, varAObjPtr);
9677 if (varBObjPtr)
9678 Jim_DecrRefCount(interp, varBObjPtr);
9679 return retval;
9680 }
9681 }
9682 }
9683 Jim_DecrRefCount(interp, varAObjPtr);
9684 if (varBObjPtr)
9685 Jim_DecrRefCount(interp, varBObjPtr);
9686 } else {
9687 /* TODO: case for len == 2 */
9688 goto noopt;
9689 }
9690 Jim_SetEmptyResult(interp);
9691 return JIM_OK;
9692 }
9693 noopt:
9694 #endif
9695
9696 /* The general purpose implementation of while starts here */
9697 while (1) {
9698 int boolean, retval;
9699
9700 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9701 &boolean)) != JIM_OK)
9702 return retval;
9703 if (!boolean) break;
9704 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9705 switch(retval) {
9706 case JIM_BREAK:
9707 goto out;
9708 break;
9709 case JIM_CONTINUE:
9710 continue;
9711 break;
9712 default:
9713 return retval;
9714 }
9715 }
9716 }
9717 out:
9718 Jim_SetEmptyResult(interp);
9719 return JIM_OK;
9720 }
9721
9722 /* [for] */
9723 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9724 Jim_Obj *const *argv)
9725 {
9726 int retval;
9727
9728 if (argc != 5) {
9729 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9730 return JIM_ERR;
9731 }
9732 /* Check if the for is on the form:
9733 * for {set i CONST} {$i < CONST} {incr i}
9734 * for {set i CONST} {$i < $j} {incr i}
9735 * for {set i CONST} {$i <= CONST} {incr i}
9736 * for {set i CONST} {$i <= $j} {incr i}
9737 * XXX: NOTE: if variable traces are implemented, this optimization
9738 * need to be modified to check for the proc epoch at every variable
9739 * update. */
9740 #ifdef JIM_OPTIMIZATION
9741 {
9742 ScriptObj *initScript, *incrScript;
9743 ExprByteCode *expr;
9744 jim_wide start, stop, currentVal;
9745 unsigned jim_wide procEpoch = interp->procEpoch;
9746 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9747 int cmpType;
9748 struct Jim_Cmd *cmdPtr;
9749
9750 /* Do it only if there aren't shared arguments */
9751 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9752 goto evalstart;
9753 initScript = Jim_GetScript(interp, argv[1]);
9754 expr = Jim_GetExpression(interp, argv[2]);
9755 incrScript = Jim_GetScript(interp, argv[3]);
9756
9757 /* Ensure proper lengths to start */
9758 if (initScript->len != 6) goto evalstart;
9759 if (incrScript->len != 4) goto evalstart;
9760 if (expr->len != 3) goto evalstart;
9761 /* Ensure proper token types. */
9762 if (initScript->token[2].type != JIM_TT_ESC ||
9763 initScript->token[4].type != JIM_TT_ESC ||
9764 incrScript->token[2].type != JIM_TT_ESC ||
9765 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9766 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9767 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9768 (expr->opcode[2] != JIM_EXPROP_LT &&
9769 expr->opcode[2] != JIM_EXPROP_LTE))
9770 goto evalstart;
9771 cmpType = expr->opcode[2];
9772 /* Initialization command must be [set] */
9773 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
9774 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
9775 goto evalstart;
9776 /* Update command must be incr */
9777 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
9778 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
9779 goto evalstart;
9780 /* set, incr, expression must be about the same variable */
9781 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9782 incrScript->token[2].objPtr, 0))
9783 goto evalstart;
9784 if (!Jim_StringEqObj(initScript->token[2].objPtr,
9785 expr->obj[0], 0))
9786 goto evalstart;
9787 /* Check that the initialization and comparison are valid integers */
9788 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
9789 goto evalstart;
9790 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
9791 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
9792 {
9793 goto evalstart;
9794 }
9795
9796 /* Initialization */
9797 varNamePtr = expr->obj[0];
9798 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9799 stopVarNamePtr = expr->obj[1];
9800 Jim_IncrRefCount(stopVarNamePtr);
9801 }
9802 Jim_IncrRefCount(varNamePtr);
9803
9804 /* --- OPTIMIZED FOR --- */
9805 /* Start to loop */
9806 objPtr = Jim_NewIntObj(interp, start);
9807 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
9808 Jim_DecrRefCount(interp, varNamePtr);
9809 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9810 Jim_FreeNewObj(interp, objPtr);
9811 goto evalstart;
9812 }
9813 while (1) {
9814 /* === Check condition === */
9815 /* Common code: */
9816 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
9817 if (objPtr == NULL ||
9818 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
9819 {
9820 Jim_DecrRefCount(interp, varNamePtr);
9821 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
9822 goto testcond;
9823 }
9824 /* Immediate or Variable? get the 'stop' value if the latter. */
9825 if (stopVarNamePtr) {
9826 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
9827 if (objPtr == NULL ||
9828 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
9829 {
9830 Jim_DecrRefCount(interp, varNamePtr);
9831 Jim_DecrRefCount(interp, stopVarNamePtr);
9832 goto testcond;
9833 }
9834 }
9835 if (cmpType == JIM_EXPROP_LT) {
9836 if (currentVal >= stop) break;
9837 } else {
9838 if (currentVal > stop) break;
9839 }
9840 /* Eval body */
9841 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9842 switch(retval) {
9843 case JIM_BREAK:
9844 if (stopVarNamePtr)
9845 Jim_DecrRefCount(interp, stopVarNamePtr);
9846 Jim_DecrRefCount(interp, varNamePtr);
9847 goto out;
9848 case JIM_CONTINUE:
9849 /* nothing to do */
9850 break;
9851 default:
9852 if (stopVarNamePtr)
9853 Jim_DecrRefCount(interp, stopVarNamePtr);
9854 Jim_DecrRefCount(interp, varNamePtr);
9855 return retval;
9856 }
9857 }
9858 /* If there was a change in procedures/command continue
9859 * with the usual [for] command implementation */
9860 if (procEpoch != interp->procEpoch) {
9861 if (stopVarNamePtr)
9862 Jim_DecrRefCount(interp, stopVarNamePtr);
9863 Jim_DecrRefCount(interp, varNamePtr);
9864 goto evalnext;
9865 }
9866 /* Increment */
9867 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
9868 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
9869 objPtr->internalRep.wideValue ++;
9870 Jim_InvalidateStringRep(objPtr);
9871 } else {
9872 Jim_Obj *auxObjPtr;
9873
9874 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
9875 if (stopVarNamePtr)
9876 Jim_DecrRefCount(interp, stopVarNamePtr);
9877 Jim_DecrRefCount(interp, varNamePtr);
9878 goto evalnext;
9879 }
9880 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
9881 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
9882 if (stopVarNamePtr)
9883 Jim_DecrRefCount(interp, stopVarNamePtr);
9884 Jim_DecrRefCount(interp, varNamePtr);
9885 Jim_FreeNewObj(interp, auxObjPtr);
9886 goto evalnext;
9887 }
9888 }
9889 }
9890 if (stopVarNamePtr)
9891 Jim_DecrRefCount(interp, stopVarNamePtr);
9892 Jim_DecrRefCount(interp, varNamePtr);
9893 Jim_SetEmptyResult(interp);
9894 return JIM_OK;
9895 }
9896 #endif
9897 evalstart:
9898 /* Eval start */
9899 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
9900 return retval;
9901 while (1) {
9902 int boolean;
9903 testcond:
9904 /* Test the condition */
9905 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
9906 != JIM_OK)
9907 return retval;
9908 if (!boolean) break;
9909 /* Eval body */
9910 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
9911 switch(retval) {
9912 case JIM_BREAK:
9913 goto out;
9914 break;
9915 case JIM_CONTINUE:
9916 /* Nothing to do */
9917 break;
9918 default:
9919 return retval;
9920 }
9921 }
9922 evalnext:
9923 /* Eval next */
9924 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
9925 switch(retval) {
9926 case JIM_BREAK:
9927 goto out;
9928 break;
9929 case JIM_CONTINUE:
9930 continue;
9931 break;
9932 default:
9933 return retval;
9934 }
9935 }
9936 }
9937 out:
9938 Jim_SetEmptyResult(interp);
9939 return JIM_OK;
9940 }
9941
9942 /* foreach + lmap implementation. */
9943 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
9944 Jim_Obj *const *argv, int doMap)
9945 {
9946 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
9947 int nbrOfLoops = 0;
9948 Jim_Obj *emptyStr, *script, *mapRes = NULL;
9949
9950 if (argc < 4 || argc % 2 != 0) {
9951 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
9952 return JIM_ERR;
9953 }
9954 if (doMap) {
9955 mapRes = Jim_NewListObj(interp, NULL, 0);
9956 Jim_IncrRefCount(mapRes);
9957 }
9958 emptyStr = Jim_NewEmptyStringObj(interp);
9959 Jim_IncrRefCount(emptyStr);
9960 script = argv[argc-1]; /* Last argument is a script */
9961 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
9962 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
9963 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
9964 /* Initialize iterators and remember max nbr elements each list */
9965 memset(listsIdx, 0, nbrOfLists * sizeof(int));
9966 /* Remember lengths of all lists and calculate how much rounds to loop */
9967 for (i=0; i < nbrOfLists*2; i += 2) {
9968 div_t cnt;
9969 int count;
9970 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
9971 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
9972 if (listsEnd[i] == 0) {
9973 Jim_SetResultString(interp, "foreach varlist is empty", -1);
9974 goto err;
9975 }
9976 cnt = div(listsEnd[i+1], listsEnd[i]);
9977 count = cnt.quot + (cnt.rem ? 1 : 0);
9978 if (count > nbrOfLoops)
9979 nbrOfLoops = count;
9980 }
9981 for (; nbrOfLoops-- > 0; ) {
9982 for (i=0; i < nbrOfLists; ++i) {
9983 int varIdx = 0, var = i * 2;
9984 while (varIdx < listsEnd[var]) {
9985 Jim_Obj *varName, *ele;
9986 int lst = i * 2 + 1;
9987 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
9988 != JIM_OK)
9989 goto err;
9990 if (listsIdx[i] < listsEnd[lst]) {
9991 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
9992 != JIM_OK)
9993 goto err;
9994 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
9995 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
9996 goto err;
9997 }
9998 ++listsIdx[i]; /* Remember next iterator of current list */
9999 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10000 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10001 goto err;
10002 }
10003 ++varIdx; /* Next variable */
10004 }
10005 }
10006 switch (result = Jim_EvalObj(interp, script)) {
10007 case JIM_OK:
10008 if (doMap)
10009 Jim_ListAppendElement(interp, mapRes, interp->result);
10010 break;
10011 case JIM_CONTINUE:
10012 break;
10013 case JIM_BREAK:
10014 goto out;
10015 break;
10016 default:
10017 goto err;
10018 }
10019 }
10020 out:
10021 result = JIM_OK;
10022 if (doMap)
10023 Jim_SetResult(interp, mapRes);
10024 else
10025 Jim_SetEmptyResult(interp);
10026 err:
10027 if (doMap)
10028 Jim_DecrRefCount(interp, mapRes);
10029 Jim_DecrRefCount(interp, emptyStr);
10030 Jim_Free(listsIdx);
10031 Jim_Free(listsEnd);
10032 return result;
10033 }
10034
10035 /* [foreach] */
10036 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10037 Jim_Obj *const *argv)
10038 {
10039 return JimForeachMapHelper(interp, argc, argv, 0);
10040 }
10041
10042 /* [lmap] */
10043 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10044 Jim_Obj *const *argv)
10045 {
10046 return JimForeachMapHelper(interp, argc, argv, 1);
10047 }
10048
10049 /* [if] */
10050 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10051 Jim_Obj *const *argv)
10052 {
10053 int boolean, retval, current = 1, falsebody = 0;
10054 if (argc >= 3) {
10055 while (1) {
10056 /* Far not enough arguments given! */
10057 if (current >= argc) goto err;
10058 if ((retval = Jim_GetBoolFromExpr(interp,
10059 argv[current++], &boolean))
10060 != JIM_OK)
10061 return retval;
10062 /* There lacks something, isn't it? */
10063 if (current >= argc) goto err;
10064 if (Jim_CompareStringImmediate(interp, argv[current],
10065 "then")) current++;
10066 /* Tsk tsk, no then-clause? */
10067 if (current >= argc) goto err;
10068 if (boolean)
10069 return Jim_EvalObj(interp, argv[current]);
10070 /* Ok: no else-clause follows */
10071 if (++current >= argc) {
10072 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10073 return JIM_OK;
10074 }
10075 falsebody = current++;
10076 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10077 "else")) {
10078 /* IIICKS - else-clause isn't last cmd? */
10079 if (current != argc-1) goto err;
10080 return Jim_EvalObj(interp, argv[current]);
10081 } else if (Jim_CompareStringImmediate(interp,
10082 argv[falsebody], "elseif"))
10083 /* Ok: elseif follows meaning all the stuff
10084 * again (how boring...) */
10085 continue;
10086 /* OOPS - else-clause is not last cmd?*/
10087 else if (falsebody != argc-1)
10088 goto err;
10089 return Jim_EvalObj(interp, argv[falsebody]);
10090 }
10091 return JIM_OK;
10092 }
10093 err:
10094 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10095 return JIM_ERR;
10096 }
10097
10098 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10099
10100 /* [switch] */
10101 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10102 Jim_Obj *const *argv)
10103 {
10104 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10105 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10106 Jim_Obj *script = 0;
10107 if (argc < 3) goto wrongnumargs;
10108 for (opt=1; opt < argc; ++opt) {
10109 const char *option = Jim_GetString(argv[opt], 0);
10110 if (*option != '-') break;
10111 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10112 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10113 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10114 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10115 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10116 if ((argc - opt) < 2) goto wrongnumargs;
10117 command = argv[++opt];
10118 } else {
10119 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10120 Jim_AppendStrings(interp, Jim_GetResult(interp),
10121 "bad option \"", option, "\": must be -exact, -glob, "
10122 "-regexp, -command procname or --", 0);
10123 goto err;
10124 }
10125 if ((argc - opt) < 2) goto wrongnumargs;
10126 }
10127 strObj = argv[opt++];
10128 patCount = argc - opt;
10129 if (patCount == 1) {
10130 Jim_Obj **vector;
10131 JimListGetElements(interp, argv[opt], &patCount, &vector);
10132 caseList = vector;
10133 } else
10134 caseList = &argv[opt];
10135 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10136 for (i=0; script == 0 && i < patCount; i += 2) {
10137 Jim_Obj *patObj = caseList[i];
10138 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10139 || i < (patCount-2)) {
10140 switch (matchOpt) {
10141 case SWITCH_EXACT:
10142 if (Jim_StringEqObj(strObj, patObj, 0))
10143 script = caseList[i+1];
10144 break;
10145 case SWITCH_GLOB:
10146 if (Jim_StringMatchObj(patObj, strObj, 0))
10147 script = caseList[i+1];
10148 break;
10149 case SWITCH_RE:
10150 command = Jim_NewStringObj(interp, "regexp", -1);
10151 /* Fall thru intentionally */
10152 case SWITCH_CMD: {
10153 Jim_Obj *parms[] = {command, patObj, strObj};
10154 int rc = Jim_EvalObjVector(interp, 3, parms);
10155 long matching;
10156 /* After the execution of a command we need to
10157 * make sure to reconvert the object into a list
10158 * again. Only for the single-list style [switch]. */
10159 if (argc-opt == 1) {
10160 Jim_Obj **vector;
10161 JimListGetElements(interp, argv[opt], &patCount,
10162 &vector);
10163 caseList = vector;
10164 }
10165 /* command is here already decref'd */
10166 if (rc != JIM_OK) {
10167 retcode = rc;
10168 goto err;
10169 }
10170 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10171 if (rc != JIM_OK) {
10172 retcode = rc;
10173 goto err;
10174 }
10175 if (matching)
10176 script = caseList[i+1];
10177 break;
10178 }
10179 default:
10180 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10181 Jim_AppendStrings(interp, Jim_GetResult(interp),
10182 "internal error: no such option implemented", 0);
10183 goto err;
10184 }
10185 } else {
10186 script = caseList[i+1];
10187 }
10188 }
10189 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10190 i += 2)
10191 script = caseList[i+1];
10192 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10193 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10194 Jim_AppendStrings(interp, Jim_GetResult(interp),
10195 "no body specified for pattern \"",
10196 Jim_GetString(caseList[i-2], 0), "\"", 0);
10197 goto err;
10198 }
10199 retcode = JIM_OK;
10200 Jim_SetEmptyResult(interp);
10201 if (script != 0)
10202 retcode = Jim_EvalObj(interp, script);
10203 return retcode;
10204 wrongnumargs:
10205 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10206 "pattern body ... ?default body? or "
10207 "{pattern body ?pattern body ...?}");
10208 err:
10209 return retcode;
10210 }
10211
10212 /* [list] */
10213 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10214 Jim_Obj *const *argv)
10215 {
10216 Jim_Obj *listObjPtr;
10217
10218 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10219 Jim_SetResult(interp, listObjPtr);
10220 return JIM_OK;
10221 }
10222
10223 /* [lindex] */
10224 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10225 Jim_Obj *const *argv)
10226 {
10227 Jim_Obj *objPtr, *listObjPtr;
10228 int i;
10229 int index;
10230
10231 if (argc < 3) {
10232 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10233 return JIM_ERR;
10234 }
10235 objPtr = argv[1];
10236 Jim_IncrRefCount(objPtr);
10237 for (i = 2; i < argc; i++) {
10238 listObjPtr = objPtr;
10239 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10240 Jim_DecrRefCount(interp, listObjPtr);
10241 return JIM_ERR;
10242 }
10243 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10244 JIM_NONE) != JIM_OK) {
10245 /* Returns an empty object if the index
10246 * is out of range. */
10247 Jim_DecrRefCount(interp, listObjPtr);
10248 Jim_SetEmptyResult(interp);
10249 return JIM_OK;
10250 }
10251 Jim_IncrRefCount(objPtr);
10252 Jim_DecrRefCount(interp, listObjPtr);
10253 }
10254 Jim_SetResult(interp, objPtr);
10255 Jim_DecrRefCount(interp, objPtr);
10256 return JIM_OK;
10257 }
10258
10259 /* [llength] */
10260 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10261 Jim_Obj *const *argv)
10262 {
10263 int len;
10264
10265 if (argc != 2) {
10266 Jim_WrongNumArgs(interp, 1, argv, "list");
10267 return JIM_ERR;
10268 }
10269 Jim_ListLength(interp, argv[1], &len);
10270 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10271 return JIM_OK;
10272 }
10273
10274 /* [lappend] */
10275 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10276 Jim_Obj *const *argv)
10277 {
10278 Jim_Obj *listObjPtr;
10279 int shared, i;
10280
10281 if (argc < 2) {
10282 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10283 return JIM_ERR;
10284 }
10285 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10286 if (!listObjPtr) {
10287 /* Create the list if it does not exists */
10288 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10289 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10290 Jim_FreeNewObj(interp, listObjPtr);
10291 return JIM_ERR;
10292 }
10293 }
10294 shared = Jim_IsShared(listObjPtr);
10295 if (shared)
10296 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10297 for (i = 2; i < argc; i++)
10298 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10299 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10300 if (shared)
10301 Jim_FreeNewObj(interp, listObjPtr);
10302 return JIM_ERR;
10303 }
10304 Jim_SetResult(interp, listObjPtr);
10305 return JIM_OK;
10306 }
10307
10308 /* [linsert] */
10309 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10310 Jim_Obj *const *argv)
10311 {
10312 int index, len;
10313 Jim_Obj *listPtr;
10314
10315 if (argc < 4) {
10316 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10317 "?element ...?");
10318 return JIM_ERR;
10319 }
10320 listPtr = argv[1];
10321 if (Jim_IsShared(listPtr))
10322 listPtr = Jim_DuplicateObj(interp, listPtr);
10323 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10324 goto err;
10325 Jim_ListLength(interp, listPtr, &len);
10326 if (index >= len)
10327 index = len;
10328 else if (index < 0)
10329 index = len + index + 1;
10330 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10331 Jim_SetResult(interp, listPtr);
10332 return JIM_OK;
10333 err:
10334 if (listPtr != argv[1]) {
10335 Jim_FreeNewObj(interp, listPtr);
10336 }
10337 return JIM_ERR;
10338 }
10339
10340 /* [lset] */
10341 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10342 Jim_Obj *const *argv)
10343 {
10344 if (argc < 3) {
10345 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10346 return JIM_ERR;
10347 } else if (argc == 3) {
10348 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10349 return JIM_ERR;
10350 Jim_SetResult(interp, argv[2]);
10351 return JIM_OK;
10352 }
10353 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10354 == JIM_ERR) return JIM_ERR;
10355 return JIM_OK;
10356 }
10357
10358 /* [lsort] */
10359 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10360 {
10361 const char *options[] = {
10362 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10363 };
10364 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10365 Jim_Obj *resObj;
10366 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10367 int decreasing = 0;
10368
10369 if (argc < 2) {
10370 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10371 return JIM_ERR;
10372 }
10373 for (i = 1; i < (argc-1); i++) {
10374 int option;
10375
10376 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10377 != JIM_OK)
10378 return JIM_ERR;
10379 switch(option) {
10380 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10381 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10382 case OPT_INCREASING: decreasing = 0; break;
10383 case OPT_DECREASING: decreasing = 1; break;
10384 }
10385 }
10386 if (decreasing) {
10387 switch(lsortType) {
10388 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10389 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10390 }
10391 }
10392 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10393 ListSortElements(interp, resObj, lsortType);
10394 Jim_SetResult(interp, resObj);
10395 return JIM_OK;
10396 }
10397
10398 /* [append] */
10399 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10400 Jim_Obj *const *argv)
10401 {
10402 Jim_Obj *stringObjPtr;
10403 int shared, i;
10404
10405 if (argc < 2) {
10406 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10407 return JIM_ERR;
10408 }
10409 if (argc == 2) {
10410 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10411 if (!stringObjPtr) return JIM_ERR;
10412 } else {
10413 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10414 if (!stringObjPtr) {
10415 /* Create the string if it does not exists */
10416 stringObjPtr = Jim_NewEmptyStringObj(interp);
10417 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10418 != JIM_OK) {
10419 Jim_FreeNewObj(interp, stringObjPtr);
10420 return JIM_ERR;
10421 }
10422 }
10423 }
10424 shared = Jim_IsShared(stringObjPtr);
10425 if (shared)
10426 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10427 for (i = 2; i < argc; i++)
10428 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10429 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10430 if (shared)
10431 Jim_FreeNewObj(interp, stringObjPtr);
10432 return JIM_ERR;
10433 }
10434 Jim_SetResult(interp, stringObjPtr);
10435 return JIM_OK;
10436 }
10437
10438 /* [debug] */
10439 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10440 Jim_Obj *const *argv)
10441 {
10442 const char *options[] = {
10443 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10444 "exprbc",
10445 NULL
10446 };
10447 enum {
10448 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10449 OPT_EXPRLEN, OPT_EXPRBC
10450 };
10451 int option;
10452
10453 if (argc < 2) {
10454 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10455 return JIM_ERR;
10456 }
10457 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10458 JIM_ERRMSG) != JIM_OK)
10459 return JIM_ERR;
10460 if (option == OPT_REFCOUNT) {
10461 if (argc != 3) {
10462 Jim_WrongNumArgs(interp, 2, argv, "object");
10463 return JIM_ERR;
10464 }
10465 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10466 return JIM_OK;
10467 } else if (option == OPT_OBJCOUNT) {
10468 int freeobj = 0, liveobj = 0;
10469 char buf[256];
10470 Jim_Obj *objPtr;
10471
10472 if (argc != 2) {
10473 Jim_WrongNumArgs(interp, 2, argv, "");
10474 return JIM_ERR;
10475 }
10476 /* Count the number of free objects. */
10477 objPtr = interp->freeList;
10478 while (objPtr) {
10479 freeobj++;
10480 objPtr = objPtr->nextObjPtr;
10481 }
10482 /* Count the number of live objects. */
10483 objPtr = interp->liveList;
10484 while (objPtr) {
10485 liveobj++;
10486 objPtr = objPtr->nextObjPtr;
10487 }
10488 /* Set the result string and return. */
10489 sprintf(buf, "free %d used %d", freeobj, liveobj);
10490 Jim_SetResultString(interp, buf, -1);
10491 return JIM_OK;
10492 } else if (option == OPT_OBJECTS) {
10493 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10494 /* Count the number of live objects. */
10495 objPtr = interp->liveList;
10496 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10497 while (objPtr) {
10498 char buf[128];
10499 const char *type = objPtr->typePtr ?
10500 objPtr->typePtr->name : "";
10501 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10502 sprintf(buf, "%p", objPtr);
10503 Jim_ListAppendElement(interp, subListObjPtr,
10504 Jim_NewStringObj(interp, buf, -1));
10505 Jim_ListAppendElement(interp, subListObjPtr,
10506 Jim_NewStringObj(interp, type, -1));
10507 Jim_ListAppendElement(interp, subListObjPtr,
10508 Jim_NewIntObj(interp, objPtr->refCount));
10509 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10510 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10511 objPtr = objPtr->nextObjPtr;
10512 }
10513 Jim_SetResult(interp, listObjPtr);
10514 return JIM_OK;
10515 } else if (option == OPT_INVSTR) {
10516 Jim_Obj *objPtr;
10517
10518 if (argc != 3) {
10519 Jim_WrongNumArgs(interp, 2, argv, "object");
10520 return JIM_ERR;
10521 }
10522 objPtr = argv[2];
10523 if (objPtr->typePtr != NULL)
10524 Jim_InvalidateStringRep(objPtr);
10525 Jim_SetEmptyResult(interp);
10526 return JIM_OK;
10527 } else if (option == OPT_SCRIPTLEN) {
10528 ScriptObj *script;
10529 if (argc != 3) {
10530 Jim_WrongNumArgs(interp, 2, argv, "script");
10531 return JIM_ERR;
10532 }
10533 script = Jim_GetScript(interp, argv[2]);
10534 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10535 return JIM_OK;
10536 } else if (option == OPT_EXPRLEN) {
10537 ExprByteCode *expr;
10538 if (argc != 3) {
10539 Jim_WrongNumArgs(interp, 2, argv, "expression");
10540 return JIM_ERR;
10541 }
10542 expr = Jim_GetExpression(interp, argv[2]);
10543 if (expr == NULL)
10544 return JIM_ERR;
10545 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10546 return JIM_OK;
10547 } else if (option == OPT_EXPRBC) {
10548 Jim_Obj *objPtr;
10549 ExprByteCode *expr;
10550 int i;
10551
10552 if (argc != 3) {
10553 Jim_WrongNumArgs(interp, 2, argv, "expression");
10554 return JIM_ERR;
10555 }
10556 expr = Jim_GetExpression(interp, argv[2]);
10557 if (expr == NULL)
10558 return JIM_ERR;
10559 objPtr = Jim_NewListObj(interp, NULL, 0);
10560 for (i = 0; i < expr->len; i++) {
10561 const char *type;
10562 Jim_ExprOperator *op;
10563
10564 switch(expr->opcode[i]) {
10565 case JIM_EXPROP_NUMBER: type = "number"; break;
10566 case JIM_EXPROP_COMMAND: type = "command"; break;
10567 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10568 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10569 case JIM_EXPROP_SUBST: type = "subst"; break;
10570 case JIM_EXPROP_STRING: type = "string"; break;
10571 default:
10572 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10573 if (op == NULL) {
10574 type = "private";
10575 } else {
10576 type = "operator";
10577 }
10578 break;
10579 }
10580 Jim_ListAppendElement(interp, objPtr,
10581 Jim_NewStringObj(interp, type, -1));
10582 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10583 }
10584 Jim_SetResult(interp, objPtr);
10585 return JIM_OK;
10586 } else {
10587 Jim_SetResultString(interp,
10588 "bad option. Valid options are refcount, "
10589 "objcount, objects, invstr", -1);
10590 return JIM_ERR;
10591 }
10592 return JIM_OK; /* unreached */
10593 }
10594
10595 /* [eval] */
10596 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10597 Jim_Obj *const *argv)
10598 {
10599 if (argc == 2) {
10600 return Jim_EvalObj(interp, argv[1]);
10601 } else if (argc > 2) {
10602 Jim_Obj *objPtr;
10603 int retcode;
10604
10605 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10606 Jim_IncrRefCount(objPtr);
10607 retcode = Jim_EvalObj(interp, objPtr);
10608 Jim_DecrRefCount(interp, objPtr);
10609 return retcode;
10610 } else {
10611 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10612 return JIM_ERR;
10613 }
10614 }
10615
10616 /* [uplevel] */
10617 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10618 Jim_Obj *const *argv)
10619 {
10620 if (argc >= 2) {
10621 int retcode, newLevel, oldLevel;
10622 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10623 Jim_Obj *objPtr;
10624 const char *str;
10625
10626 /* Save the old callframe pointer */
10627 savedCallFrame = interp->framePtr;
10628
10629 /* Lookup the target frame pointer */
10630 str = Jim_GetString(argv[1], NULL);
10631 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10632 {
10633 if (Jim_GetCallFrameByLevel(interp, argv[1],
10634 &targetCallFrame,
10635 &newLevel) != JIM_OK)
10636 return JIM_ERR;
10637 argc--;
10638 argv++;
10639 } else {
10640 if (Jim_GetCallFrameByLevel(interp, NULL,
10641 &targetCallFrame,
10642 &newLevel) != JIM_OK)
10643 return JIM_ERR;
10644 }
10645 if (argc < 2) {
10646 argc++;
10647 argv--;
10648 Jim_WrongNumArgs(interp, 1, argv,
10649 "?level? command ?arg ...?");
10650 return JIM_ERR;
10651 }
10652 /* Eval the code in the target callframe. */
10653 interp->framePtr = targetCallFrame;
10654 oldLevel = interp->numLevels;
10655 interp->numLevels = newLevel;
10656 if (argc == 2) {
10657 retcode = Jim_EvalObj(interp, argv[1]);
10658 } else {
10659 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10660 Jim_IncrRefCount(objPtr);
10661 retcode = Jim_EvalObj(interp, objPtr);
10662 Jim_DecrRefCount(interp, objPtr);
10663 }
10664 interp->numLevels = oldLevel;
10665 interp->framePtr = savedCallFrame;
10666 return retcode;
10667 } else {
10668 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10669 return JIM_ERR;
10670 }
10671 }
10672
10673 /* [expr] */
10674 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10675 Jim_Obj *const *argv)
10676 {
10677 Jim_Obj *exprResultPtr;
10678 int retcode;
10679
10680 if (argc == 2) {
10681 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10682 } else if (argc > 2) {
10683 Jim_Obj *objPtr;
10684
10685 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10686 Jim_IncrRefCount(objPtr);
10687 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10688 Jim_DecrRefCount(interp, objPtr);
10689 } else {
10690 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10691 return JIM_ERR;
10692 }
10693 if (retcode != JIM_OK) return retcode;
10694 Jim_SetResult(interp, exprResultPtr);
10695 Jim_DecrRefCount(interp, exprResultPtr);
10696 return JIM_OK;
10697 }
10698
10699 /* [break] */
10700 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10701 Jim_Obj *const *argv)
10702 {
10703 if (argc != 1) {
10704 Jim_WrongNumArgs(interp, 1, argv, "");
10705 return JIM_ERR;
10706 }
10707 return JIM_BREAK;
10708 }
10709
10710 /* [continue] */
10711 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10712 Jim_Obj *const *argv)
10713 {
10714 if (argc != 1) {
10715 Jim_WrongNumArgs(interp, 1, argv, "");
10716 return JIM_ERR;
10717 }
10718 return JIM_CONTINUE;
10719 }
10720
10721 /* [return] */
10722 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10723 Jim_Obj *const *argv)
10724 {
10725 if (argc == 1) {
10726 return JIM_RETURN;
10727 } else if (argc == 2) {
10728 Jim_SetResult(interp, argv[1]);
10729 interp->returnCode = JIM_OK;
10730 return JIM_RETURN;
10731 } else if (argc == 3 || argc == 4) {
10732 int returnCode;
10733 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10734 return JIM_ERR;
10735 interp->returnCode = returnCode;
10736 if (argc == 4)
10737 Jim_SetResult(interp, argv[3]);
10738 return JIM_RETURN;
10739 } else {
10740 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10741 return JIM_ERR;
10742 }
10743 return JIM_RETURN; /* unreached */
10744 }
10745
10746 /* [tailcall] */
10747 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10748 Jim_Obj *const *argv)
10749 {
10750 Jim_Obj *objPtr;
10751
10752 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10753 Jim_SetResult(interp, objPtr);
10754 return JIM_EVAL;
10755 }
10756
10757 /* [proc] */
10758 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10759 Jim_Obj *const *argv)
10760 {
10761 int argListLen;
10762 int arityMin, arityMax;
10763
10764 if (argc != 4 && argc != 5) {
10765 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10766 return JIM_ERR;
10767 }
10768 Jim_ListLength(interp, argv[2], &argListLen);
10769 arityMin = arityMax = argListLen+1;
10770 if (argListLen) {
10771 const char *str;
10772 int len;
10773 Jim_Obj *lastArgPtr;
10774
10775 Jim_ListIndex(interp, argv[2], argListLen-1, &lastArgPtr, JIM_NONE);
10776 str = Jim_GetString(lastArgPtr, &len);
10777 if (len == 4 && memcmp(str, "args", 4) == 0) {
10778 arityMin--;
10779 arityMax = -1;
10780 }
10781 }
10782 if (argc == 4) {
10783 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10784 argv[2], NULL, argv[3], arityMin, arityMax);
10785 } else {
10786 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
10787 argv[2], argv[3], argv[4], arityMin, arityMax);
10788 }
10789 }
10790
10791 /* [concat] */
10792 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
10793 Jim_Obj *const *argv)
10794 {
10795 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
10796 return JIM_OK;
10797 }
10798
10799 /* [upvar] */
10800 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
10801 Jim_Obj *const *argv)
10802 {
10803 const char *str;
10804 int i;
10805 Jim_CallFrame *targetCallFrame;
10806
10807 /* Lookup the target frame pointer */
10808 str = Jim_GetString(argv[1], NULL);
10809 if (argc > 3 &&
10810 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
10811 {
10812 if (Jim_GetCallFrameByLevel(interp, argv[1],
10813 &targetCallFrame, NULL) != JIM_OK)
10814 return JIM_ERR;
10815 argc--;
10816 argv++;
10817 } else {
10818 if (Jim_GetCallFrameByLevel(interp, NULL,
10819 &targetCallFrame, NULL) != JIM_OK)
10820 return JIM_ERR;
10821 }
10822 /* Check for arity */
10823 if (argc < 3 || ((argc-1)%2) != 0) {
10824 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
10825 return JIM_ERR;
10826 }
10827 /* Now... for every other/local couple: */
10828 for (i = 1; i < argc; i += 2) {
10829 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
10830 targetCallFrame) != JIM_OK) return JIM_ERR;
10831 }
10832 return JIM_OK;
10833 }
10834
10835 /* [global] */
10836 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
10837 Jim_Obj *const *argv)
10838 {
10839 int i;
10840
10841 if (argc < 2) {
10842 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
10843 return JIM_ERR;
10844 }
10845 /* Link every var to the toplevel having the same name */
10846 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
10847 for (i = 1; i < argc; i++) {
10848 if (Jim_SetVariableLink(interp, argv[i], argv[i],
10849 interp->topFramePtr) != JIM_OK) return JIM_ERR;
10850 }
10851 return JIM_OK;
10852 }
10853
10854 /* does the [string map] operation. On error NULL is returned,
10855 * otherwise a new string object with the result, having refcount = 0,
10856 * is returned. */
10857 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
10858 Jim_Obj *objPtr, int nocase)
10859 {
10860 int numMaps;
10861 const char **key, *str, *noMatchStart = NULL;
10862 Jim_Obj **value;
10863 int *keyLen, strLen, i;
10864 Jim_Obj *resultObjPtr;
10865
10866 Jim_ListLength(interp, mapListObjPtr, &numMaps);
10867 if (numMaps % 2) {
10868 Jim_SetResultString(interp,
10869 "list must contain an even number of elements", -1);
10870 return NULL;
10871 }
10872 /* Initialization */
10873 numMaps /= 2;
10874 key = Jim_Alloc(sizeof(char*)*numMaps);
10875 keyLen = Jim_Alloc(sizeof(int)*numMaps);
10876 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
10877 resultObjPtr = Jim_NewStringObj(interp, "", 0);
10878 for (i = 0; i < numMaps; i++) {
10879 Jim_Obj *eleObjPtr;
10880
10881 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
10882 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
10883 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
10884 value[i] = eleObjPtr;
10885 }
10886 str = Jim_GetString(objPtr, &strLen);
10887 /* Map it */
10888 while(strLen) {
10889 for (i = 0; i < numMaps; i++) {
10890 if (strLen >= keyLen[i] && keyLen[i]) {
10891 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
10892 nocase))
10893 {
10894 if (noMatchStart) {
10895 Jim_AppendString(interp, resultObjPtr,
10896 noMatchStart, str-noMatchStart);
10897 noMatchStart = NULL;
10898 }
10899 Jim_AppendObj(interp, resultObjPtr, value[i]);
10900 str += keyLen[i];
10901 strLen -= keyLen[i];
10902 break;
10903 }
10904 }
10905 }
10906 if (i == numMaps) { /* no match */
10907 if (noMatchStart == NULL)
10908 noMatchStart = str;
10909 str ++;
10910 strLen --;
10911 }
10912 }
10913 if (noMatchStart) {
10914 Jim_AppendString(interp, resultObjPtr,
10915 noMatchStart, str-noMatchStart);
10916 }
10917 Jim_Free((void*)key);
10918 Jim_Free(keyLen);
10919 Jim_Free(value);
10920 return resultObjPtr;
10921 }
10922
10923 /* [string] */
10924 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
10925 Jim_Obj *const *argv)
10926 {
10927 int option;
10928 const char *options[] = {
10929 "length", "compare", "match", "equal", "range", "map", "repeat",
10930 "index", "first", "tolower", "toupper", NULL
10931 };
10932 enum {
10933 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
10934 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
10935 };
10936
10937 if (argc < 2) {
10938 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
10939 return JIM_ERR;
10940 }
10941 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10942 JIM_ERRMSG) != JIM_OK)
10943 return JIM_ERR;
10944
10945 if (option == OPT_LENGTH) {
10946 int len;
10947
10948 if (argc != 3) {
10949 Jim_WrongNumArgs(interp, 2, argv, "string");
10950 return JIM_ERR;
10951 }
10952 Jim_GetString(argv[2], &len);
10953 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10954 return JIM_OK;
10955 } else if (option == OPT_COMPARE) {
10956 int nocase = 0;
10957 if ((argc != 4 && argc != 5) ||
10958 (argc == 5 && Jim_CompareStringImmediate(interp,
10959 argv[2], "-nocase") == 0)) {
10960 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
10961 return JIM_ERR;
10962 }
10963 if (argc == 5) {
10964 nocase = 1;
10965 argv++;
10966 }
10967 Jim_SetResult(interp, Jim_NewIntObj(interp,
10968 Jim_StringCompareObj(argv[2],
10969 argv[3], nocase)));
10970 return JIM_OK;
10971 } else if (option == OPT_MATCH) {
10972 int nocase = 0;
10973 if ((argc != 4 && argc != 5) ||
10974 (argc == 5 && Jim_CompareStringImmediate(interp,
10975 argv[2], "-nocase") == 0)) {
10976 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
10977 "string");
10978 return JIM_ERR;
10979 }
10980 if (argc == 5) {
10981 nocase = 1;
10982 argv++;
10983 }
10984 Jim_SetResult(interp,
10985 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
10986 argv[3], nocase)));
10987 return JIM_OK;
10988 } else if (option == OPT_EQUAL) {
10989 if (argc != 4) {
10990 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
10991 return JIM_ERR;
10992 }
10993 Jim_SetResult(interp,
10994 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
10995 argv[3], 0)));
10996 return JIM_OK;
10997 } else if (option == OPT_RANGE) {
10998 Jim_Obj *objPtr;
10999
11000 if (argc != 5) {
11001 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11002 return JIM_ERR;
11003 }
11004 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11005 if (objPtr == NULL)
11006 return JIM_ERR;
11007 Jim_SetResult(interp, objPtr);
11008 return JIM_OK;
11009 } else if (option == OPT_MAP) {
11010 int nocase = 0;
11011 Jim_Obj *objPtr;
11012
11013 if ((argc != 4 && argc != 5) ||
11014 (argc == 5 && Jim_CompareStringImmediate(interp,
11015 argv[2], "-nocase") == 0)) {
11016 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11017 "string");
11018 return JIM_ERR;
11019 }
11020 if (argc == 5) {
11021 nocase = 1;
11022 argv++;
11023 }
11024 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11025 if (objPtr == NULL)
11026 return JIM_ERR;
11027 Jim_SetResult(interp, objPtr);
11028 return JIM_OK;
11029 } else if (option == OPT_REPEAT) {
11030 Jim_Obj *objPtr;
11031 jim_wide count;
11032
11033 if (argc != 4) {
11034 Jim_WrongNumArgs(interp, 2, argv, "string count");
11035 return JIM_ERR;
11036 }
11037 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11038 return JIM_ERR;
11039 objPtr = Jim_NewStringObj(interp, "", 0);
11040 while (count--) {
11041 Jim_AppendObj(interp, objPtr, argv[2]);
11042 }
11043 Jim_SetResult(interp, objPtr);
11044 return JIM_OK;
11045 } else if (option == OPT_INDEX) {
11046 int index, len;
11047 const char *str;
11048
11049 if (argc != 4) {
11050 Jim_WrongNumArgs(interp, 2, argv, "string index");
11051 return JIM_ERR;
11052 }
11053 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11054 return JIM_ERR;
11055 str = Jim_GetString(argv[2], &len);
11056 if (index != INT_MIN && index != INT_MAX)
11057 index = JimRelToAbsIndex(len, index);
11058 if (index < 0 || index >= len) {
11059 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11060 return JIM_OK;
11061 } else {
11062 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11063 return JIM_OK;
11064 }
11065 } else if (option == OPT_FIRST) {
11066 int index = 0, l1, l2;
11067 const char *s1, *s2;
11068
11069 if (argc != 4 && argc != 5) {
11070 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11071 return JIM_ERR;
11072 }
11073 s1 = Jim_GetString(argv[2], &l1);
11074 s2 = Jim_GetString(argv[3], &l2);
11075 if (argc == 5) {
11076 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11077 return JIM_ERR;
11078 index = JimRelToAbsIndex(l2, index);
11079 }
11080 Jim_SetResult(interp, Jim_NewIntObj(interp,
11081 JimStringFirst(s1, l1, s2, l2, index)));
11082 return JIM_OK;
11083 } else if (option == OPT_TOLOWER) {
11084 if (argc != 3) {
11085 Jim_WrongNumArgs(interp, 2, argv, "string");
11086 return JIM_ERR;
11087 }
11088 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11089 } else if (option == OPT_TOUPPER) {
11090 if (argc != 3) {
11091 Jim_WrongNumArgs(interp, 2, argv, "string");
11092 return JIM_ERR;
11093 }
11094 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11095 }
11096 return JIM_OK;
11097 }
11098
11099 /* [time] */
11100 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11101 Jim_Obj *const *argv)
11102 {
11103 long i, count = 1;
11104 jim_wide start, elapsed;
11105 char buf [256];
11106 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11107
11108 if (argc < 2) {
11109 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11110 return JIM_ERR;
11111 }
11112 if (argc == 3) {
11113 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11114 return JIM_ERR;
11115 }
11116 if (count < 0)
11117 return JIM_OK;
11118 i = count;
11119 start = JimClock();
11120 while (i-- > 0) {
11121 int retval;
11122
11123 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11124 return retval;
11125 }
11126 elapsed = JimClock() - start;
11127 sprintf(buf, fmt, elapsed/count);
11128 Jim_SetResultString(interp, buf, -1);
11129 return JIM_OK;
11130 }
11131
11132 /* [exit] */
11133 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11134 Jim_Obj *const *argv)
11135 {
11136 long exitCode = 0;
11137
11138 if (argc > 2) {
11139 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11140 return JIM_ERR;
11141 }
11142 if (argc == 2) {
11143 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11144 return JIM_ERR;
11145 }
11146 interp->exitCode = exitCode;
11147 return JIM_EXIT;
11148 }
11149
11150 /* [catch] */
11151 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11152 Jim_Obj *const *argv)
11153 {
11154 int exitCode = 0;
11155
11156 if (argc != 2 && argc != 3) {
11157 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11158 return JIM_ERR;
11159 }
11160 exitCode = Jim_EvalObj(interp, argv[1]);
11161 if (argc == 3) {
11162 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11163 != JIM_OK)
11164 return JIM_ERR;
11165 }
11166 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11167 return JIM_OK;
11168 }
11169
11170 /* [ref] */
11171 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11172 Jim_Obj *const *argv)
11173 {
11174 if (argc != 3 && argc != 4) {
11175 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11176 return JIM_ERR;
11177 }
11178 if (argc == 3) {
11179 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11180 } else {
11181 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11182 argv[3]));
11183 }
11184 return JIM_OK;
11185 }
11186
11187 /* [getref] */
11188 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11189 Jim_Obj *const *argv)
11190 {
11191 Jim_Reference *refPtr;
11192
11193 if (argc != 2) {
11194 Jim_WrongNumArgs(interp, 1, argv, "reference");
11195 return JIM_ERR;
11196 }
11197 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11198 return JIM_ERR;
11199 Jim_SetResult(interp, refPtr->objPtr);
11200 return JIM_OK;
11201 }
11202
11203 /* [setref] */
11204 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11205 Jim_Obj *const *argv)
11206 {
11207 Jim_Reference *refPtr;
11208
11209 if (argc != 3) {
11210 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11211 return JIM_ERR;
11212 }
11213 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11214 return JIM_ERR;
11215 Jim_IncrRefCount(argv[2]);
11216 Jim_DecrRefCount(interp, refPtr->objPtr);
11217 refPtr->objPtr = argv[2];
11218 Jim_SetResult(interp, argv[2]);
11219 return JIM_OK;
11220 }
11221
11222 /* [collect] */
11223 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11224 Jim_Obj *const *argv)
11225 {
11226 if (argc != 1) {
11227 Jim_WrongNumArgs(interp, 1, argv, "");
11228 return JIM_ERR;
11229 }
11230 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11231 return JIM_OK;
11232 }
11233
11234 /* [finalize] reference ?newValue? */
11235 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11236 Jim_Obj *const *argv)
11237 {
11238 if (argc != 2 && argc != 3) {
11239 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11240 return JIM_ERR;
11241 }
11242 if (argc == 2) {
11243 Jim_Obj *cmdNamePtr;
11244
11245 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11246 return JIM_ERR;
11247 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11248 Jim_SetResult(interp, cmdNamePtr);
11249 } else {
11250 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11251 return JIM_ERR;
11252 Jim_SetResult(interp, argv[2]);
11253 }
11254 return JIM_OK;
11255 }
11256
11257 /* TODO */
11258 /* [info references] (list of all the references/finalizers) */
11259
11260 /* [rename] */
11261 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11262 Jim_Obj *const *argv)
11263 {
11264 const char *oldName, *newName;
11265
11266 if (argc != 3) {
11267 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11268 return JIM_ERR;
11269 }
11270 oldName = Jim_GetString(argv[1], NULL);
11271 newName = Jim_GetString(argv[2], NULL);
11272 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11273 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11274 Jim_AppendStrings(interp, Jim_GetResult(interp),
11275 "can't rename \"", oldName, "\": ",
11276 "command doesn't exist", NULL);
11277 return JIM_ERR;
11278 }
11279 return JIM_OK;
11280 }
11281
11282 /* [dict] */
11283 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11284 Jim_Obj *const *argv)
11285 {
11286 int option;
11287 const char *options[] = {
11288 "create", "get", "set", "unset", "exists", NULL
11289 };
11290 enum {
11291 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11292 };
11293
11294 if (argc < 2) {
11295 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11296 return JIM_ERR;
11297 }
11298
11299 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11300 JIM_ERRMSG) != JIM_OK)
11301 return JIM_ERR;
11302
11303 if (option == OPT_CREATE) {
11304 Jim_Obj *objPtr;
11305
11306 if (argc % 2) {
11307 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11308 return JIM_ERR;
11309 }
11310 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11311 Jim_SetResult(interp, objPtr);
11312 return JIM_OK;
11313 } else if (option == OPT_GET) {
11314 Jim_Obj *objPtr;
11315
11316 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11317 JIM_ERRMSG) != JIM_OK)
11318 return JIM_ERR;
11319 Jim_SetResult(interp, objPtr);
11320 return JIM_OK;
11321 } else if (option == OPT_SET) {
11322 if (argc < 5) {
11323 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11324 return JIM_ERR;
11325 }
11326 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11327 argv[argc-1]);
11328 } else if (option == OPT_UNSET) {
11329 if (argc < 4) {
11330 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11331 return JIM_ERR;
11332 }
11333 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11334 NULL);
11335 } else if (option == OPT_EXIST) {
11336 Jim_Obj *objPtr;
11337 int exists;
11338
11339 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11340 JIM_ERRMSG) == JIM_OK)
11341 exists = 1;
11342 else
11343 exists = 0;
11344 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11345 return JIM_OK;
11346 } else {
11347 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11348 Jim_AppendStrings(interp, Jim_GetResult(interp),
11349 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11350 " must be create, get, set", NULL);
11351 return JIM_ERR;
11352 }
11353 return JIM_OK;
11354 }
11355
11356 /* [load] */
11357 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11358 Jim_Obj *const *argv)
11359 {
11360 if (argc < 2) {
11361 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11362 return JIM_ERR;
11363 }
11364 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11365 }
11366
11367 /* [subst] */
11368 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11369 Jim_Obj *const *argv)
11370 {
11371 int i, flags = 0;
11372 Jim_Obj *objPtr;
11373
11374 if (argc < 2) {
11375 Jim_WrongNumArgs(interp, 1, argv,
11376 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11377 return JIM_ERR;
11378 }
11379 i = argc-2;
11380 while(i--) {
11381 if (Jim_CompareStringImmediate(interp, argv[i+1],
11382 "-nobackslashes"))
11383 flags |= JIM_SUBST_NOESC;
11384 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11385 "-novariables"))
11386 flags |= JIM_SUBST_NOVAR;
11387 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11388 "-nocommands"))
11389 flags |= JIM_SUBST_NOCMD;
11390 else {
11391 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11392 Jim_AppendStrings(interp, Jim_GetResult(interp),
11393 "bad option \"", Jim_GetString(argv[i+1], NULL),
11394 "\": must be -nobackslashes, -nocommands, or "
11395 "-novariables", NULL);
11396 return JIM_ERR;
11397 }
11398 }
11399 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11400 return JIM_ERR;
11401 Jim_SetResult(interp, objPtr);
11402 return JIM_OK;
11403 }
11404
11405 /* [info] */
11406 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11407 Jim_Obj *const *argv)
11408 {
11409 int cmd, result = JIM_OK;
11410 static const char *commands[] = {
11411 "body", "commands", "exists", "globals", "level", "locals",
11412 "vars", "version", "complete", "args", NULL
11413 };
11414 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11415 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS};
11416
11417 if (argc < 2) {
11418 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11419 return JIM_ERR;
11420 }
11421 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11422 != JIM_OK) {
11423 return JIM_ERR;
11424 }
11425
11426 if (cmd == INFO_COMMANDS) {
11427 if (argc != 2 && argc != 3) {
11428 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11429 return JIM_ERR;
11430 }
11431 if (argc == 3)
11432 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11433 else
11434 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11435 } else if (cmd == INFO_EXISTS) {
11436 Jim_Obj *exists;
11437 if (argc != 3) {
11438 Jim_WrongNumArgs(interp, 2, argv, "varName");
11439 return JIM_ERR;
11440 }
11441 exists = Jim_GetVariable(interp, argv[2], 0);
11442 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11443 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11444 int mode;
11445 switch (cmd) {
11446 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11447 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11448 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11449 default: mode = 0; /* avoid warning */; break;
11450 }
11451 if (argc != 2 && argc != 3) {
11452 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11453 return JIM_ERR;
11454 }
11455 if (argc == 3)
11456 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11457 else
11458 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11459 } else if (cmd == INFO_LEVEL) {
11460 Jim_Obj *objPtr;
11461 switch (argc) {
11462 case 2:
11463 Jim_SetResult(interp,
11464 Jim_NewIntObj(interp, interp->numLevels));
11465 break;
11466 case 3:
11467 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11468 return JIM_ERR;
11469 Jim_SetResult(interp, objPtr);
11470 break;
11471 default:
11472 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11473 return JIM_ERR;
11474 }
11475 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11476 Jim_Cmd *cmdPtr;
11477
11478 if (argc != 3) {
11479 Jim_WrongNumArgs(interp, 2, argv, "procname");
11480 return JIM_ERR;
11481 }
11482 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11483 return JIM_ERR;
11484 if (cmdPtr->cmdProc != NULL) {
11485 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11486 Jim_AppendStrings(interp, Jim_GetResult(interp),
11487 "command \"", Jim_GetString(argv[2], NULL),
11488 "\" is not a procedure", NULL);
11489 return JIM_ERR;
11490 }
11491 if (cmd == INFO_BODY)
11492 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11493 else
11494 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11495 } else if (cmd == INFO_VERSION) {
11496 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11497 sprintf(buf, "%d.%d",
11498 JIM_VERSION / 100, JIM_VERSION % 100);
11499 Jim_SetResultString(interp, buf, -1);
11500 } else if (cmd == INFO_COMPLETE) {
11501 const char *s;
11502 int len;
11503
11504 if (argc != 3) {
11505 Jim_WrongNumArgs(interp, 2, argv, "script");
11506 return JIM_ERR;
11507 }
11508 s = Jim_GetString(argv[2], &len);
11509 Jim_SetResult(interp,
11510 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11511 }
11512 return result;
11513 }
11514
11515 /* [split] */
11516 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11517 Jim_Obj *const *argv)
11518 {
11519 const char *str, *splitChars, *noMatchStart;
11520 int splitLen, strLen, i;
11521 Jim_Obj *resObjPtr;
11522
11523 if (argc != 2 && argc != 3) {
11524 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11525 return JIM_ERR;
11526 }
11527 /* Init */
11528 if (argc == 2) {
11529 splitChars = " \n\t\r";
11530 splitLen = 4;
11531 } else {
11532 splitChars = Jim_GetString(argv[2], &splitLen);
11533 }
11534 str = Jim_GetString(argv[1], &strLen);
11535 if (!strLen) return JIM_OK;
11536 noMatchStart = str;
11537 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11538 /* Split */
11539 if (splitLen) {
11540 while (strLen) {
11541 for (i = 0; i < splitLen; i++) {
11542 if (*str == splitChars[i]) {
11543 Jim_Obj *objPtr;
11544
11545 objPtr = Jim_NewStringObj(interp, noMatchStart,
11546 (str-noMatchStart));
11547 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11548 noMatchStart = str+1;
11549 break;
11550 }
11551 }
11552 str ++;
11553 strLen --;
11554 }
11555 Jim_ListAppendElement(interp, resObjPtr,
11556 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11557 } else {
11558 /* This handles the special case of splitchars eq {}. This
11559 * is trivial but we want to perform object sharing as Tcl does. */
11560 Jim_Obj *objCache[256];
11561 const unsigned char *u = (unsigned char*) str;
11562 memset(objCache, 0, sizeof(objCache));
11563 for (i = 0; i < strLen; i++) {
11564 int c = u[i];
11565
11566 if (objCache[c] == NULL)
11567 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11568 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11569 }
11570 }
11571 Jim_SetResult(interp, resObjPtr);
11572 return JIM_OK;
11573 }
11574
11575 /* [join] */
11576 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11577 Jim_Obj *const *argv)
11578 {
11579 const char *joinStr;
11580 int joinStrLen, i, listLen;
11581 Jim_Obj *resObjPtr;
11582
11583 if (argc != 2 && argc != 3) {
11584 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11585 return JIM_ERR;
11586 }
11587 /* Init */
11588 if (argc == 2) {
11589 joinStr = " ";
11590 joinStrLen = 1;
11591 } else {
11592 joinStr = Jim_GetString(argv[2], &joinStrLen);
11593 }
11594 Jim_ListLength(interp, argv[1], &listLen);
11595 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11596 /* Split */
11597 for (i = 0; i < listLen; i++) {
11598 Jim_Obj *objPtr;
11599
11600 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11601 Jim_AppendObj(interp, resObjPtr, objPtr);
11602 if (i+1 != listLen) {
11603 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11604 }
11605 }
11606 Jim_SetResult(interp, resObjPtr);
11607 return JIM_OK;
11608 }
11609
11610 /* [format] */
11611 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11612 Jim_Obj *const *argv)
11613 {
11614 Jim_Obj *objPtr;
11615
11616 if (argc < 2) {
11617 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11618 return JIM_ERR;
11619 }
11620 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11621 if (objPtr == NULL)
11622 return JIM_ERR;
11623 Jim_SetResult(interp, objPtr);
11624 return JIM_OK;
11625 }
11626
11627 /* [scan] */
11628 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11629 Jim_Obj *const *argv)
11630 {
11631 Jim_Obj *listPtr, **outVec;
11632 int outc, i, count = 0;
11633
11634 if (argc < 3) {
11635 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11636 return JIM_ERR;
11637 }
11638 if (argv[2]->typePtr != &scanFmtStringObjType)
11639 SetScanFmtFromAny(interp, argv[2]);
11640 if (FormatGetError(argv[2]) != 0) {
11641 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11642 return JIM_ERR;
11643 }
11644 if (argc > 3) {
11645 int maxPos = FormatGetMaxPos(argv[2]);
11646 int count = FormatGetCnvCount(argv[2]);
11647 if (maxPos > argc-3) {
11648 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11649 return JIM_ERR;
11650 } else if (count != 0 && count < argc-3) {
11651 Jim_SetResultString(interp, "variable is not assigned by any "
11652 "conversion specifiers", -1);
11653 return JIM_ERR;
11654 } else if (count > argc-3) {
11655 Jim_SetResultString(interp, "different numbers of variable names and "
11656 "field specifiers", -1);
11657 return JIM_ERR;
11658 }
11659 }
11660 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11661 if (listPtr == 0)
11662 return JIM_ERR;
11663 if (argc > 3) {
11664 int len = 0;
11665 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11666 Jim_ListLength(interp, listPtr, &len);
11667 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11668 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11669 return JIM_OK;
11670 }
11671 JimListGetElements(interp, listPtr, &outc, &outVec);
11672 for (i = 0; i < outc; ++i) {
11673 if (Jim_Length(outVec[i]) > 0) {
11674 ++count;
11675 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11676 goto err;
11677 }
11678 }
11679 Jim_FreeNewObj(interp, listPtr);
11680 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11681 } else {
11682 if (listPtr == (Jim_Obj*)EOF) {
11683 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11684 return JIM_OK;
11685 }
11686 Jim_SetResult(interp, listPtr);
11687 }
11688 return JIM_OK;
11689 err:
11690 Jim_FreeNewObj(interp, listPtr);
11691 return JIM_ERR;
11692 }
11693
11694 /* [error] */
11695 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11696 Jim_Obj *const *argv)
11697 {
11698 if (argc != 2) {
11699 Jim_WrongNumArgs(interp, 1, argv, "message");
11700 return JIM_ERR;
11701 }
11702 Jim_SetResult(interp, argv[1]);
11703 return JIM_ERR;
11704 }
11705
11706 /* [lrange] */
11707 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11708 Jim_Obj *const *argv)
11709 {
11710 Jim_Obj *objPtr;
11711
11712 if (argc != 4) {
11713 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11714 return JIM_ERR;
11715 }
11716 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11717 return JIM_ERR;
11718 Jim_SetResult(interp, objPtr);
11719 return JIM_OK;
11720 }
11721
11722 /* [env] */
11723 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11724 Jim_Obj *const *argv)
11725 {
11726 const char *key;
11727 char *val;
11728
11729 if (argc != 2) {
11730 Jim_WrongNumArgs(interp, 1, argv, "varName");
11731 return JIM_ERR;
11732 }
11733 key = Jim_GetString(argv[1], NULL);
11734 val = getenv(key);
11735 if (val == NULL) {
11736 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11737 Jim_AppendStrings(interp, Jim_GetResult(interp),
11738 "environment variable \"",
11739 key, "\" does not exist", NULL);
11740 return JIM_ERR;
11741 }
11742 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
11743 return JIM_OK;
11744 }
11745
11746 /* [source] */
11747 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
11748 Jim_Obj *const *argv)
11749 {
11750 int retval;
11751
11752 if (argc != 2) {
11753 Jim_WrongNumArgs(interp, 1, argv, "fileName");
11754 return JIM_ERR;
11755 }
11756 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
11757 if (retval == JIM_RETURN)
11758 return JIM_OK;
11759 return retval;
11760 }
11761
11762 /* [lreverse] */
11763 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
11764 Jim_Obj *const *argv)
11765 {
11766 Jim_Obj *revObjPtr, **ele;
11767 int len;
11768
11769 if (argc != 2) {
11770 Jim_WrongNumArgs(interp, 1, argv, "list");
11771 return JIM_ERR;
11772 }
11773 JimListGetElements(interp, argv[1], &len, &ele);
11774 len--;
11775 revObjPtr = Jim_NewListObj(interp, NULL, 0);
11776 while (len >= 0)
11777 ListAppendElement(revObjPtr, ele[len--]);
11778 Jim_SetResult(interp, revObjPtr);
11779 return JIM_OK;
11780 }
11781
11782 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
11783 {
11784 jim_wide len;
11785
11786 if (step == 0) return -1;
11787 if (start == end) return 0;
11788 else if (step > 0 && start > end) return -1;
11789 else if (step < 0 && end > start) return -1;
11790 len = end-start;
11791 if (len < 0) len = -len; /* abs(len) */
11792 if (step < 0) step = -step; /* abs(step) */
11793 len = 1 + ((len-1)/step);
11794 /* We can truncate safely to INT_MAX, the range command
11795 * will always return an error for a such long range
11796 * because Tcl lists can't be so long. */
11797 if (len > INT_MAX) len = INT_MAX;
11798 return (int)((len < 0) ? -1 : len);
11799 }
11800
11801 /* [range] */
11802 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
11803 Jim_Obj *const *argv)
11804 {
11805 jim_wide start = 0, end, step = 1;
11806 int len, i;
11807 Jim_Obj *objPtr;
11808
11809 if (argc < 2 || argc > 4) {
11810 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
11811 return JIM_ERR;
11812 }
11813 if (argc == 2) {
11814 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
11815 return JIM_ERR;
11816 } else {
11817 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
11818 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
11819 return JIM_ERR;
11820 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
11821 return JIM_ERR;
11822 }
11823 if ((len = JimRangeLen(start, end, step)) == -1) {
11824 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
11825 return JIM_ERR;
11826 }
11827 objPtr = Jim_NewListObj(interp, NULL, 0);
11828 for (i = 0; i < len; i++)
11829 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
11830 Jim_SetResult(interp, objPtr);
11831 return JIM_OK;
11832 }
11833
11834 /* [rand] */
11835 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
11836 Jim_Obj *const *argv)
11837 {
11838 jim_wide min = 0, max, len, maxMul;
11839
11840 if (argc < 1 || argc > 3) {
11841 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
11842 return JIM_ERR;
11843 }
11844 if (argc == 1) {
11845 max = JIM_WIDE_MAX;
11846 } else if (argc == 2) {
11847 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
11848 return JIM_ERR;
11849 } else if (argc == 3) {
11850 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
11851 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
11852 return JIM_ERR;
11853 }
11854 len = max-min;
11855 if (len < 0) {
11856 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
11857 return JIM_ERR;
11858 }
11859 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
11860 while (1) {
11861 jim_wide r;
11862
11863 JimRandomBytes(interp, &r, sizeof(jim_wide));
11864 if (r < 0 || r >= maxMul) continue;
11865 r = (len == 0) ? 0 : r%len;
11866 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
11867 return JIM_OK;
11868 }
11869 }
11870
11871 /* [package] */
11872 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
11873 Jim_Obj *const *argv)
11874 {
11875 int option;
11876 const char *options[] = {
11877 "require", "provide", NULL
11878 };
11879 enum {OPT_REQUIRE, OPT_PROVIDE};
11880
11881 if (argc < 2) {
11882 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11883 return JIM_ERR;
11884 }
11885 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11886 JIM_ERRMSG) != JIM_OK)
11887 return JIM_ERR;
11888
11889 if (option == OPT_REQUIRE) {
11890 int exact = 0;
11891 const char *ver;
11892
11893 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
11894 exact = 1;
11895 argv++;
11896 argc--;
11897 }
11898 if (argc != 3 && argc != 4) {
11899 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
11900 return JIM_ERR;
11901 }
11902 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
11903 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
11904 JIM_ERRMSG);
11905 if (ver == NULL)
11906 return JIM_ERR;
11907 Jim_SetResultString(interp, ver, -1);
11908 } else if (option == OPT_PROVIDE) {
11909 if (argc != 4) {
11910 Jim_WrongNumArgs(interp, 2, argv, "package version");
11911 return JIM_ERR;
11912 }
11913 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
11914 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
11915 }
11916 return JIM_OK;
11917 }
11918
11919 static struct {
11920 const char *name;
11921 Jim_CmdProc cmdProc;
11922 } Jim_CoreCommandsTable[] = {
11923 {"set", Jim_SetCoreCommand},
11924 {"unset", Jim_UnsetCoreCommand},
11925 {"puts", Jim_PutsCoreCommand},
11926 {"+", Jim_AddCoreCommand},
11927 {"*", Jim_MulCoreCommand},
11928 {"-", Jim_SubCoreCommand},
11929 {"/", Jim_DivCoreCommand},
11930 {"incr", Jim_IncrCoreCommand},
11931 {"while", Jim_WhileCoreCommand},
11932 {"for", Jim_ForCoreCommand},
11933 {"foreach", Jim_ForeachCoreCommand},
11934 {"lmap", Jim_LmapCoreCommand},
11935 {"if", Jim_IfCoreCommand},
11936 {"switch", Jim_SwitchCoreCommand},
11937 {"list", Jim_ListCoreCommand},
11938 {"lindex", Jim_LindexCoreCommand},
11939 {"lset", Jim_LsetCoreCommand},
11940 {"llength", Jim_LlengthCoreCommand},
11941 {"lappend", Jim_LappendCoreCommand},
11942 {"linsert", Jim_LinsertCoreCommand},
11943 {"lsort", Jim_LsortCoreCommand},
11944 {"append", Jim_AppendCoreCommand},
11945 {"debug", Jim_DebugCoreCommand},
11946 {"eval", Jim_EvalCoreCommand},
11947 {"uplevel", Jim_UplevelCoreCommand},
11948 {"expr", Jim_ExprCoreCommand},
11949 {"break", Jim_BreakCoreCommand},
11950 {"continue", Jim_ContinueCoreCommand},
11951 {"proc", Jim_ProcCoreCommand},
11952 {"concat", Jim_ConcatCoreCommand},
11953 {"return", Jim_ReturnCoreCommand},
11954 {"upvar", Jim_UpvarCoreCommand},
11955 {"global", Jim_GlobalCoreCommand},
11956 {"string", Jim_StringCoreCommand},
11957 {"time", Jim_TimeCoreCommand},
11958 {"exit", Jim_ExitCoreCommand},
11959 {"catch", Jim_CatchCoreCommand},
11960 {"ref", Jim_RefCoreCommand},
11961 {"getref", Jim_GetrefCoreCommand},
11962 {"setref", Jim_SetrefCoreCommand},
11963 {"finalize", Jim_FinalizeCoreCommand},
11964 {"collect", Jim_CollectCoreCommand},
11965 {"rename", Jim_RenameCoreCommand},
11966 {"dict", Jim_DictCoreCommand},
11967 {"load", Jim_LoadCoreCommand},
11968 {"subst", Jim_SubstCoreCommand},
11969 {"info", Jim_InfoCoreCommand},
11970 {"split", Jim_SplitCoreCommand},
11971 {"join", Jim_JoinCoreCommand},
11972 {"format", Jim_FormatCoreCommand},
11973 {"scan", Jim_ScanCoreCommand},
11974 {"error", Jim_ErrorCoreCommand},
11975 {"lrange", Jim_LrangeCoreCommand},
11976 {"env", Jim_EnvCoreCommand},
11977 {"source", Jim_SourceCoreCommand},
11978 {"lreverse", Jim_LreverseCoreCommand},
11979 {"range", Jim_RangeCoreCommand},
11980 {"rand", Jim_RandCoreCommand},
11981 {"package", Jim_PackageCoreCommand},
11982 {"tailcall", Jim_TailcallCoreCommand},
11983 {NULL, NULL},
11984 };
11985
11986 /* Some Jim core command is actually a procedure written in Jim itself. */
11987 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
11988 {
11989 Jim_Eval(interp, (char*)
11990 "proc lambda {arglist args} {\n"
11991 " set name [ref {} function lambdaFinalizer]\n"
11992 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
11993 " return $name\n"
11994 "}\n"
11995 "proc lambdaFinalizer {name val} {\n"
11996 " rename $name {}\n"
11997 "}\n"
11998 );
11999 }
12000
12001 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12002 {
12003 int i = 0;
12004
12005 while(Jim_CoreCommandsTable[i].name != NULL) {
12006 Jim_CreateCommand(interp,
12007 Jim_CoreCommandsTable[i].name,
12008 Jim_CoreCommandsTable[i].cmdProc,
12009 NULL, NULL);
12010 i++;
12011 }
12012 Jim_RegisterCoreProcedures(interp);
12013 }
12014
12015 /* -----------------------------------------------------------------------------
12016 * Interactive prompt
12017 * ---------------------------------------------------------------------------*/
12018 void Jim_PrintErrorMessage(Jim_Interp *interp)
12019 {
12020 int len, i;
12021
12022 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL,
12023 interp->errorFileName, interp->errorLine);
12024 Jim_fprintf(interp,interp->cookie_stderr, " %s" JIM_NL,
12025 Jim_GetString(interp->result, NULL));
12026 Jim_ListLength(interp, interp->stackTrace, &len);
12027 for (i = len-3; i >= 0; i-= 3) {
12028 Jim_Obj *objPtr;
12029 const char *proc, *file, *line;
12030
12031 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12032 proc = Jim_GetString(objPtr, NULL);
12033 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12034 JIM_NONE);
12035 file = Jim_GetString(objPtr, NULL);
12036 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12037 JIM_NONE);
12038 line = Jim_GetString(objPtr, NULL);
12039 Jim_fprintf( interp, interp->cookie_stderr,
12040 "In procedure '%s' called at file \"%s\", line %s" JIM_NL,
12041 proc, file, line);
12042 }
12043 }
12044
12045 int Jim_InteractivePrompt(Jim_Interp *interp)
12046 {
12047 int retcode = JIM_OK;
12048 Jim_Obj *scriptObjPtr;
12049
12050 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12051 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12052 JIM_VERSION / 100, JIM_VERSION % 100);
12053 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12054 while (1) {
12055 char buf[1024];
12056 const char *result;
12057 const char *retcodestr[] = {
12058 "ok", "error", "return", "break", "continue", "eval", "exit"
12059 };
12060 int reslen;
12061
12062 if (retcode != 0) {
12063 if (retcode >= 2 && retcode <= 6)
12064 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12065 else
12066 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12067 } else
12068 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12069 Jim_fflush( interp, interp->cookie_stdout);
12070 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12071 Jim_IncrRefCount(scriptObjPtr);
12072 while(1) {
12073 const char *str;
12074 char state;
12075 int len;
12076
12077 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12078 Jim_DecrRefCount(interp, scriptObjPtr);
12079 goto out;
12080 }
12081 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12082 str = Jim_GetString(scriptObjPtr, &len);
12083 if (Jim_ScriptIsComplete(str, len, &state))
12084 break;
12085 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12086 Jim_fflush( interp, interp->cookie_stdout);
12087 }
12088 retcode = Jim_EvalObj(interp, scriptObjPtr);
12089 Jim_DecrRefCount(interp, scriptObjPtr);
12090 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12091 if (retcode == JIM_ERR) {
12092 Jim_PrintErrorMessage(interp);
12093 } else if (retcode == JIM_EXIT) {
12094 exit(Jim_GetExitCode(interp));
12095 } else {
12096 if (reslen) {
12097 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12098 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12099 }
12100 }
12101 }
12102 out:
12103 return 0;
12104 }
12105
12106 /* -----------------------------------------------------------------------------
12107 * Jim's idea of STDIO..
12108 * ---------------------------------------------------------------------------*/
12109
12110 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12111 {
12112 int r;
12113
12114 va_list ap;
12115 va_start(ap,fmt);
12116 r = Jim_vfprintf( interp, cookie, fmt,ap );
12117 va_end(ap);
12118 return r;
12119 }
12120
12121 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12122 {
12123 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12124 errno = ENOTSUP;
12125 return -1;
12126 }
12127 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12128 }
12129
12130 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12131 {
12132 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12133 errno = ENOTSUP;
12134 return 0;
12135 }
12136 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12137 }
12138
12139 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12140 {
12141 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12142 errno = ENOTSUP;
12143 return 0;
12144 }
12145 return (*(interp->cb_fread))( ptr, size, n, cookie);
12146 }
12147
12148 int Jim_fflush( Jim_Interp *interp, void *cookie )
12149 {
12150 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12151 /* pretend all is well */
12152 return 0;
12153 }
12154 return (*(interp->cb_fflush))( cookie );
12155 }
12156
12157 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12158 {
12159 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12160 errno = ENOTSUP;
12161 return NULL;
12162 }
12163 return (*(interp->cb_fgets))( s, size, cookie );
12164 }

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)