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

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)