1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
47 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
50 #include <pkgconf/jimtcl.h>
62 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
63 #endif /* JIM_ANSIC */
68 /* Include the platform dependent libraries for
69 * dynamic loading of libraries. */
71 #if defined(_WIN32) || defined(WIN32)
78 #define WIN32_LEAN_AND_MEAN
81 #pragma warning(disable:4146)
86 #endif /* JIM_DYNLIB */
89 #include <cyg/jimtcl/jim.h>
98 /* -----------------------------------------------------------------------------
100 * ---------------------------------------------------------------------------*/
102 /* A shared empty string for the objects string representation.
103 * Jim_InvalidateStringRep knows about it and don't try to free. */
104 static char *JimEmptyStringRep
= (char*) "";
106 /* -----------------------------------------------------------------------------
107 * Required prototypes of not exported functions
108 * ---------------------------------------------------------------------------*/
109 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
);
110 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
);
111 static void JimRegisterCoreApi(Jim_Interp
*interp
);
113 static Jim_HashTableType
*getJimVariablesHashTableType(void);
115 /* -----------------------------------------------------------------------------
117 * ---------------------------------------------------------------------------*/
120 jim_vasprintf( const char *fmt
, va_list ap
)
122 #ifndef HAVE_VASPRINTF
124 static char buf
[2048];
125 vsnprintf( buf
, sizeof(buf
), fmt
, ap
);
126 /* garentee termination */
127 buf
[sizeof(buf
)-1] = 0;
131 result
= vasprintf( &buf
, fmt
, ap
);
132 if (result
< 0) exit(-1);
138 jim_vasprintf_done( void *buf
)
140 #ifndef HAVE_VASPRINTF
149 * Convert a string to a jim_wide INTEGER.
150 * This function originates from BSD.
152 * Ignores `locale' stuff. Assumes that the upper and lower case
153 * alphabets and digits are each contiguous.
155 #ifdef HAVE_LONG_LONG_INT
156 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
157 static jim_wide
JimStrtoll(const char *nptr
, char **endptr
, register int base
)
159 register const char *s
;
160 register unsigned jim_wide acc
;
161 register unsigned char c
;
162 register unsigned jim_wide qbase
, cutoff
;
163 register int neg
, any
, cutlim
;
166 * Skip white space and pick up leading +/- sign if any.
167 * If base is 0, allow 0x for hex and 0 for octal, else
168 * assume decimal; if base is already 16, allow 0x.
173 } while (isspace(c
));
182 if ((base
== 0 || base
== 16) &&
183 c
== '0' && (*s
== 'x' || *s
== 'X')) {
189 base
= c
== '0' ?
8 : 10;
192 * Compute the cutoff value between legal numbers and illegal
193 * numbers. That is the largest legal value, divided by the
194 * base. An input number that is greater than this value, if
195 * followed by a legal input character, is too big. One that
196 * is equal to this value may be valid or not; the limit
197 * between valid and invalid numbers is then based on the last
198 * digit. For instance, if the range for quads is
199 * [-9223372036854775808..9223372036854775807] and the input base
200 * is 10, cutoff will be set to 922337203685477580 and cutlim to
201 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
202 * accumulated a value > 922337203685477580, or equal but the
203 * next digit is > 7 (or 8), the number is too big, and we will
204 * return a range error.
206 * Set any if any `digits' consumed; make it negative to indicate
209 qbase
= (unsigned)base
;
210 cutoff
= neg ?
(unsigned jim_wide
)-(LLONG_MIN
+ LLONG_MAX
) + LLONG_MAX
212 cutlim
= (int)(cutoff
% qbase
);
214 for (acc
= 0, any
= 0;; c
= *s
++) {
220 c
-= isupper(c
) ?
'A' - 10 : 'a' - 10;
225 if (any
< 0 || acc
> cutoff
|| (acc
== cutoff
&& c
> cutlim
))
234 acc
= neg ? LLONG_MIN
: LLONG_MAX
;
239 *endptr
= (char *)(any ? s
- 1 : nptr
);
244 /* Glob-style pattern matching. */
245 static int JimStringMatch(const char *pattern
, int patternLen
,
246 const char *string
, int stringLen
, int nocase
)
249 switch (pattern
[0]) {
251 while (pattern
[1] == '*') {
256 return 1; /* match */
258 if (JimStringMatch(pattern
+ 1, patternLen
-1,
259 string
, stringLen
, nocase
))
260 return 1; /* match */
264 return 0; /* no match */
268 return 0; /* no match */
278 not = pattern
[0] == '^';
285 if (pattern
[0] == '\\') {
288 if (pattern
[0] == string
[0])
290 } else if (pattern
[0] == ']') {
292 } else if (patternLen
== 0) {
296 } else if (pattern
[1] == '-' && patternLen
>= 3) {
297 int start
= pattern
[0];
298 int end
= pattern
[2];
306 start
= tolower(start
);
312 if (c
>= start
&& c
<= end
)
316 if (pattern
[0] == string
[0])
319 if (tolower((int)pattern
[0]) == tolower((int)string
[0]))
329 return 0; /* no match */
335 if (patternLen
>= 2) {
342 if (pattern
[0] != string
[0])
343 return 0; /* no match */
345 if (tolower((int)pattern
[0]) != tolower((int)string
[0]))
346 return 0; /* no match */
354 if (stringLen
== 0) {
355 while (*pattern
== '*') {
362 if (patternLen
== 0 && stringLen
== 0)
367 int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
,
370 unsigned char *u1
= (unsigned char*) s1
, *u2
= (unsigned char*) s2
;
376 u1
++; u2
++; l1
--; l2
--;
378 if (!l1
&& !l2
) return 0;
382 if (tolower((int)*u1
) != tolower((int)*u2
))
383 return tolower((int)*u1
)-tolower((int)*u2
);
384 u1
++; u2
++; l1
--; l2
--;
386 if (!l1
&& !l2
) return 0;
391 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
392 * The index of the first occurrence of s1 in s2 is returned.
393 * If s1 is not found inside s2, -1 is returned. */
394 int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int index
)
398 if (!l1
|| !l2
|| l1
> l2
) return -1;
399 if (index
< 0) index
= 0;
401 for (i
= index
; i
<= l2
-l1
; i
++) {
402 if (memcmp(s2
, s1
, l1
) == 0)
409 int Jim_WideToString(char *buf
, jim_wide wideValue
)
411 const char *fmt
= "%" JIM_WIDE_MODIFIER
;
412 return sprintf(buf
, fmt
, wideValue
);
415 int Jim_StringToWide(const char *str
, jim_wide
*widePtr
, int base
)
419 #ifdef HAVE_LONG_LONG_INT
420 *widePtr
= JimStrtoll(str
, &endptr
, base
);
422 *widePtr
= strtol(str
, &endptr
, base
);
424 if ((str
[0] == '\0') || (str
== endptr
) )
426 if (endptr
[0] != '\0') {
428 if (!isspace((int)*endptr
))
436 int Jim_StringToIndex(const char *str
, int *intPtr
)
440 *intPtr
= strtol(str
, &endptr
, 10);
441 if ( (str
[0] == '\0') || (str
== endptr
) )
443 if (endptr
[0] != '\0') {
445 if (!isspace((int)*endptr
))
453 /* The string representation of references has two features in order
454 * to make the GC faster. The first is that every reference starts
455 * with a non common character '~', in order to make the string matching
456 * fater. The second is that the reference string rep his 32 characters
457 * in length, this allows to avoid to check every object with a string
458 * repr < 32, and usually there are many of this objects. */
460 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
462 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, jim_wide id
)
464 const char *fmt
= "<reference.<%s>.%020" JIM_WIDE_MODIFIER
">";
465 sprintf(buf
, fmt
, refPtr
->tag
, id
);
466 return JIM_REFERENCE_SPACE
;
469 int Jim_DoubleToString(char *buf
, double doubleValue
)
474 len
= sprintf(buf
, "%.17g", doubleValue
);
477 if (*s
== '.') return len
;
480 /* Add a final ".0" if it's a number. But not
482 if (isdigit((int)buf
[0])
483 || ((buf
[0] == '-' || buf
[0] == '+')
484 && isdigit((int)buf
[1]))) {
493 int Jim_StringToDouble(const char *str
, double *doublePtr
)
497 *doublePtr
= strtod(str
, &endptr
);
498 if (str
[0] == '\0' || endptr
[0] != '\0' || (str
== endptr
) )
503 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
506 if ((b
== 0 && e
!= 0) || (e
<0)) return 0;
507 for (i
= 0; i
<e
; i
++) {res
*= b
;}
511 /* -----------------------------------------------------------------------------
513 * ---------------------------------------------------------------------------*/
515 /* Note that 'interp' may be NULL if not available in the
516 * context of the panic. It's only useful to get the error
517 * file descriptor, it will default to stderr otherwise. */
518 void Jim_Panic(Jim_Interp
*interp
, const char *fmt
, ...)
524 * Send it here first.. Assuming STDIO still works
526 fprintf(stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
527 vfprintf(stderr
, fmt
, ap
);
528 fprintf(stderr
, JIM_NL JIM_NL
);
531 #ifdef HAVE_BACKTRACE
537 size
= backtrace(array
, 40);
538 strings
= backtrace_symbols(array
, size
);
539 for (i
= 0; i
< size
; i
++)
540 fprintf(fp
,"[backtrace] %s" JIM_NL
, strings
[i
]);
541 fprintf(fp
,"[backtrace] Include the above lines and the output" JIM_NL
);
542 fprintf(fp
,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL
);
546 /* This may actually crash... we do it last */
547 if ( interp
&& interp
->cookie_stderr
){
548 Jim_fprintf( interp
, interp
->cookie_stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
549 Jim_vfprintf( interp
, interp
->cookie_stderr
, fmt
, ap
);
550 Jim_fprintf( interp
, interp
->cookie_stderr
, JIM_NL JIM_NL
);
555 /* -----------------------------------------------------------------------------
557 * ---------------------------------------------------------------------------*/
559 /* Macro used for memory debugging.
560 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
561 * and similary for Jim_Realloc and Jim_Free */
563 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
564 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
565 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
568 void *Jim_Alloc(int size
)
570 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
573 void *p
= malloc(size
);
575 Jim_Panic(NULL
,"malloc: Out of memory");
579 void Jim_Free(void *ptr
) {
583 void *Jim_Realloc(void *ptr
, int size
)
585 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
588 void *p
= realloc(ptr
, size
);
590 Jim_Panic(NULL
,"realloc: Out of memory");
594 char *Jim_StrDup(const char *s
)
597 char *copy
= Jim_Alloc(l
+ 1);
599 memcpy(copy
, s
, l
+ 1);
603 char *Jim_StrDupLen(const char *s
, int l
)
605 char *copy
= Jim_Alloc(l
+ 1);
607 memcpy(copy
, s
, l
+ 1);
608 copy
[l
] = 0; /* Just to be sure, original could be substring */
612 /* -----------------------------------------------------------------------------
613 * Time related functions
614 * ---------------------------------------------------------------------------*/
615 /* Returns microseconds of CPU used since start. */
616 static jim_wide
JimClock(void)
618 #if (defined WIN32) && !(defined JIM_ANSIC)
620 QueryPerformanceFrequency(&f
);
621 QueryPerformanceCounter(&t
);
622 return (long)((t
.QuadPart
* 1000000) / f
.QuadPart
);
624 clock_t clocks
= clock();
626 return (long)(clocks
*(1000000/CLOCKS_PER_SEC
));
630 /* -----------------------------------------------------------------------------
632 * ---------------------------------------------------------------------------*/
634 /* -------------------------- private prototypes ---------------------------- */
635 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
636 static unsigned int JimHashTableNextPower(unsigned int size
);
637 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
);
639 /* -------------------------- hash functions -------------------------------- */
641 /* Thomas Wang's 32 bit Mix Function */
642 unsigned int Jim_IntHashFunction(unsigned int key
)
653 /* Identity hash function for integer keys */
654 unsigned int Jim_IdentityHashFunction(unsigned int key
)
659 /* Generic hash function (we are using to multiply by 9 and add the byte
661 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
665 h
+= (h
<< 3)+*buf
++;
669 /* ----------------------------- API implementation ------------------------- */
670 /* reset an hashtable already initialized with ht_init().
671 * NOTE: This function should only called by ht_destroy(). */
672 static void JimResetHashTable(Jim_HashTable
*ht
)
681 /* Initialize the hash table */
682 int Jim_InitHashTable(Jim_HashTable
*ht
, Jim_HashTableType
*type
,
685 JimResetHashTable(ht
);
687 ht
->privdata
= privDataPtr
;
691 /* Resize the table to the minimal size that contains all the elements,
692 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
693 int Jim_ResizeHashTable(Jim_HashTable
*ht
)
695 int minimal
= ht
->used
;
697 if (minimal
< JIM_HT_INITIAL_SIZE
)
698 minimal
= JIM_HT_INITIAL_SIZE
;
699 return Jim_ExpandHashTable(ht
, minimal
);
702 /* Expand or create the hashtable */
703 int Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
705 Jim_HashTable n
; /* the new hashtable */
706 unsigned int realsize
= JimHashTableNextPower(size
), i
;
708 /* the size is invalid if it is smaller than the number of
709 * elements already inside the hashtable */
710 if (ht
->used
>= size
)
713 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
715 n
.sizemask
= realsize
-1;
716 n
.table
= Jim_Alloc(realsize
*sizeof(Jim_HashEntry
*));
718 /* Initialize all the pointers to NULL */
719 memset(n
.table
, 0, realsize
*sizeof(Jim_HashEntry
*));
721 /* Copy all the elements from the old to the new table:
722 * note that if the old hash table is empty ht->size is zero,
723 * so Jim_ExpandHashTable just creates an hash table. */
725 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
726 Jim_HashEntry
*he
, *nextHe
;
728 if (ht
->table
[i
] == NULL
) continue;
730 /* For each hash entry on this slot... */
736 /* Get the new element index */
737 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
738 he
->next
= n
.table
[h
];
741 /* Pass to the next element */
745 assert(ht
->used
== 0);
748 /* Remap the new hashtable in the old */
753 /* Add an element to the target hash table */
754 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
757 Jim_HashEntry
*entry
;
759 /* Get the index of the new element, or -1 if
760 * the element already exists. */
761 if ((index
= JimInsertHashEntry(ht
, key
)) == -1)
764 /* Allocates the memory and stores key */
765 entry
= Jim_Alloc(sizeof(*entry
));
766 entry
->next
= ht
->table
[index
];
767 ht
->table
[index
] = entry
;
769 /* Set the hash entry fields. */
770 Jim_SetHashKey(ht
, entry
, key
);
771 Jim_SetHashVal(ht
, entry
, val
);
776 /* Add an element, discarding the old if the key already exists */
777 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
779 Jim_HashEntry
*entry
;
781 /* Try to add the element. If the key
782 * does not exists Jim_AddHashEntry will suceed. */
783 if (Jim_AddHashEntry(ht
, key
, val
) == JIM_OK
)
785 /* It already exists, get the entry */
786 entry
= Jim_FindHashEntry(ht
, key
);
787 /* Free the old value and set the new one */
788 Jim_FreeEntryVal(ht
, entry
);
789 Jim_SetHashVal(ht
, entry
, val
);
793 /* Search and remove an element */
794 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
797 Jim_HashEntry
*he
, *prevHe
;
801 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
806 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
807 /* Unlink the element from the list */
809 prevHe
->next
= he
->next
;
811 ht
->table
[h
] = he
->next
;
812 Jim_FreeEntryKey(ht
, he
);
813 Jim_FreeEntryVal(ht
, he
);
821 return JIM_ERR
; /* not found */
824 /* Destroy an entire hash table */
825 int Jim_FreeHashTable(Jim_HashTable
*ht
)
829 /* Free all the elements */
830 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
831 Jim_HashEntry
*he
, *nextHe
;
833 if ((he
= ht
->table
[i
]) == NULL
) continue;
836 Jim_FreeEntryKey(ht
, he
);
837 Jim_FreeEntryVal(ht
, he
);
843 /* Free the table and the allocated cache structure */
845 /* Re-initialize the table */
846 JimResetHashTable(ht
);
847 return JIM_OK
; /* never fails */
850 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
855 if (ht
->size
== 0) return NULL
;
856 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
859 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
866 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
868 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
873 iter
->nextEntry
= NULL
;
877 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
880 if (iter
->entry
== NULL
) {
883 (signed)iter
->ht
->size
) break;
884 iter
->entry
= iter
->ht
->table
[iter
->index
];
886 iter
->entry
= iter
->nextEntry
;
889 /* We need to save the 'next' here, the iterator user
890 * may delete the entry we are returning. */
891 iter
->nextEntry
= iter
->entry
->next
;
898 /* ------------------------- private functions ------------------------------ */
900 /* Expand the hash table if needed */
901 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
903 /* If the hash table is empty expand it to the intial size,
904 * if the table is "full" dobule its size. */
906 return Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
907 if (ht
->size
== ht
->used
)
908 return Jim_ExpandHashTable(ht
, ht
->size
*2);
912 /* Our hash table capability is a power of two */
913 static unsigned int JimHashTableNextPower(unsigned int size
)
915 unsigned int i
= JIM_HT_INITIAL_SIZE
;
917 if (size
>= 2147483648U)
926 /* Returns the index of a free slot that can be populated with
927 * an hash entry for the given 'key'.
928 * If the key already exists, -1 is returned. */
929 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
)
934 /* Expand the hashtable if needed */
935 if (JimExpandHashTableIfNeeded(ht
) == JIM_ERR
)
937 /* Compute the key hash value */
938 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
939 /* Search if this slot does not already contain the given key */
942 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
949 /* ----------------------- StringCopy Hash Table Type ------------------------*/
951 static unsigned int JimStringCopyHTHashFunction(const void *key
)
953 return Jim_GenHashFunction(key
, strlen(key
));
956 static const void *JimStringCopyHTKeyDup(void *privdata
, const void *key
)
958 int len
= strlen(key
);
959 char *copy
= Jim_Alloc(len
+ 1);
960 JIM_NOTUSED(privdata
);
962 memcpy(copy
, key
, len
);
967 static void *JimStringKeyValCopyHTValDup(void *privdata
, const void *val
)
969 int len
= strlen(val
);
970 char *copy
= Jim_Alloc(len
+ 1);
971 JIM_NOTUSED(privdata
);
973 memcpy(copy
, val
, len
);
978 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
,
981 JIM_NOTUSED(privdata
);
983 return strcmp(key1
, key2
) == 0;
986 static void JimStringCopyHTKeyDestructor(void *privdata
, const void *key
)
988 JIM_NOTUSED(privdata
);
990 Jim_Free((void*)key
); /* ATTENTION: const cast */
993 static void JimStringKeyValCopyHTValDestructor(void *privdata
, void *val
)
995 JIM_NOTUSED(privdata
);
997 Jim_Free((void*)val
); /* ATTENTION: const cast */
1000 static Jim_HashTableType JimStringCopyHashTableType
= {
1001 JimStringCopyHTHashFunction
, /* hash function */
1002 JimStringCopyHTKeyDup
, /* key dup */
1004 JimStringCopyHTKeyCompare
, /* key compare */
1005 JimStringCopyHTKeyDestructor
, /* key destructor */
1006 NULL
/* val destructor */
1009 /* This is like StringCopy but does not auto-duplicate the key.
1010 * It's used for intepreter's shared strings. */
1011 static Jim_HashTableType JimSharedStringsHashTableType
= {
1012 JimStringCopyHTHashFunction
, /* hash function */
1015 JimStringCopyHTKeyCompare
, /* key compare */
1016 JimStringCopyHTKeyDestructor
, /* key destructor */
1017 NULL
/* val destructor */
1020 /* This is like StringCopy but also automatically handle dynamic
1021 * allocated C strings as values. */
1022 static Jim_HashTableType JimStringKeyValCopyHashTableType
= {
1023 JimStringCopyHTHashFunction
, /* hash function */
1024 JimStringCopyHTKeyDup
, /* key dup */
1025 JimStringKeyValCopyHTValDup
, /* val dup */
1026 JimStringCopyHTKeyCompare
, /* key compare */
1027 JimStringCopyHTKeyDestructor
, /* key destructor */
1028 JimStringKeyValCopyHTValDestructor
, /* val destructor */
1031 typedef struct AssocDataValue
{
1032 Jim_InterpDeleteProc
*delProc
;
1036 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1038 AssocDataValue
*assocPtr
= (AssocDataValue
*)data
;
1039 if (assocPtr
->delProc
!= NULL
)
1040 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1044 static Jim_HashTableType JimAssocDataHashTableType
= {
1045 JimStringCopyHTHashFunction
, /* hash function */
1046 JimStringCopyHTKeyDup
, /* key dup */
1048 JimStringCopyHTKeyCompare
, /* key compare */
1049 JimStringCopyHTKeyDestructor
, /* key destructor */
1050 JimAssocDataHashTableValueDestructor
/* val destructor */
1053 /* -----------------------------------------------------------------------------
1054 * Stack - This is a simple generic stack implementation. It is used for
1055 * example in the 'expr' expression compiler.
1056 * ---------------------------------------------------------------------------*/
1057 void Jim_InitStack(Jim_Stack
*stack
)
1061 stack
->vector
= NULL
;
1064 void Jim_FreeStack(Jim_Stack
*stack
)
1066 Jim_Free(stack
->vector
);
1069 int Jim_StackLen(Jim_Stack
*stack
)
1074 void Jim_StackPush(Jim_Stack
*stack
, void *element
) {
1075 int neededLen
= stack
->len
+ 1;
1076 if (neededLen
> stack
->maxlen
) {
1077 stack
->maxlen
= neededLen
*2;
1078 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void*)*stack
->maxlen
);
1080 stack
->vector
[stack
->len
] = element
;
1084 void *Jim_StackPop(Jim_Stack
*stack
)
1086 if (stack
->len
== 0) return NULL
;
1088 return stack
->vector
[stack
->len
];
1091 void *Jim_StackPeek(Jim_Stack
*stack
)
1093 if (stack
->len
== 0) return NULL
;
1094 return stack
->vector
[stack
->len
-1];
1097 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
)(void *ptr
))
1101 for (i
= 0; i
< stack
->len
; i
++)
1102 freeFunc(stack
->vector
[i
]);
1105 /* -----------------------------------------------------------------------------
1107 * ---------------------------------------------------------------------------*/
1110 #define JIM_TT_NONE -1 /* No token returned */
1111 #define JIM_TT_STR 0 /* simple string */
1112 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1113 #define JIM_TT_VAR 2 /* var substitution */
1114 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1115 #define JIM_TT_CMD 4 /* command substitution */
1116 #define JIM_TT_SEP 5 /* word separator */
1117 #define JIM_TT_EOL 6 /* line separator */
1119 /* Additional token types needed for expressions */
1120 #define JIM_TT_SUBEXPR_START 7
1121 #define JIM_TT_SUBEXPR_END 8
1122 #define JIM_TT_EXPR_NUMBER 9
1123 #define JIM_TT_EXPR_OPERATOR 10
1126 #define JIM_PS_DEF 0 /* Default state */
1127 #define JIM_PS_QUOTE 1 /* Inside "" */
1129 /* Parser context structure. The same context is used both to parse
1130 * Tcl scripts and lists. */
1131 struct JimParserCtx
{
1132 const char *prg
; /* Program text */
1133 const char *p
; /* Pointer to the point of the program we are parsing */
1134 int len
; /* Left length of 'prg' */
1135 int linenr
; /* Current line number */
1137 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1138 int tline
; /* Line number of the returned token */
1139 int tt
; /* Token type */
1140 int eof
; /* Non zero if EOF condition is true. */
1141 int state
; /* Parser state */
1142 int comment
; /* Non zero if the next chars may be a comment. */
1145 #define JimParserEof(c) ((c)->eof)
1146 #define JimParserTstart(c) ((c)->tstart)
1147 #define JimParserTend(c) ((c)->tend)
1148 #define JimParserTtype(c) ((c)->tt)
1149 #define JimParserTline(c) ((c)->tline)
1151 static int JimParseScript(struct JimParserCtx
*pc
);
1152 static int JimParseSep(struct JimParserCtx
*pc
);
1153 static int JimParseEol(struct JimParserCtx
*pc
);
1154 static int JimParseCmd(struct JimParserCtx
*pc
);
1155 static int JimParseVar(struct JimParserCtx
*pc
);
1156 static int JimParseBrace(struct JimParserCtx
*pc
);
1157 static int JimParseStr(struct JimParserCtx
*pc
);
1158 static int JimParseComment(struct JimParserCtx
*pc
);
1159 static char *JimParserGetToken(struct JimParserCtx
*pc
,
1160 int *lenPtr
, int *typePtr
, int *linePtr
);
1162 /* Initialize a parser context.
1163 * 'prg' is a pointer to the program text, linenr is the line
1164 * number of the first line contained in the program. */
1165 void JimParserInit(struct JimParserCtx
*pc
, const char *prg
,
1166 int len
, int linenr
)
1174 pc
->tt
= JIM_TT_NONE
;
1176 pc
->state
= JIM_PS_DEF
;
1177 pc
->linenr
= linenr
;
1181 int JimParseScript(struct JimParserCtx
*pc
)
1183 while (1) { /* the while is used to reiterate with continue if needed */
1187 pc
->tline
= pc
->linenr
;
1188 pc
->tt
= JIM_TT_EOL
;
1194 if (*(pc
->p
+ 1) == '\n')
1195 return JimParseSep(pc
);
1198 return JimParseStr(pc
);
1204 if (pc
->state
== JIM_PS_DEF
)
1205 return JimParseSep(pc
);
1208 return JimParseStr(pc
);
1214 if (pc
->state
== JIM_PS_DEF
)
1215 return JimParseEol(pc
);
1217 return JimParseStr(pc
);
1221 return JimParseCmd(pc
);
1225 if (JimParseVar(pc
) == JIM_ERR
) {
1226 pc
->tstart
= pc
->tend
= pc
->p
++; pc
->len
--;
1227 pc
->tline
= pc
->linenr
;
1228 pc
->tt
= JIM_TT_STR
;
1235 JimParseComment(pc
);
1238 return JimParseStr(pc
);
1242 return JimParseStr(pc
);
1249 int JimParseSep(struct JimParserCtx
*pc
)
1252 pc
->tline
= pc
->linenr
;
1253 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' ||
1254 (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1255 if (*pc
->p
== '\\') {
1262 pc
->tt
= JIM_TT_SEP
;
1266 int JimParseEol(struct JimParserCtx
*pc
)
1269 pc
->tline
= pc
->linenr
;
1270 while (*pc
->p
== ' ' || *pc
->p
== '\n' ||
1271 *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== ';') {
1277 pc
->tt
= JIM_TT_EOL
;
1281 /* Todo. Don't stop if ']' appears inside {} or quoted.
1282 * Also should handle the case of puts [string length "]"] */
1283 int JimParseCmd(struct JimParserCtx
*pc
)
1288 pc
->tstart
= ++pc
->p
; pc
->len
--;
1289 pc
->tline
= pc
->linenr
;
1293 } else if (*pc
->p
== '[' && blevel
== 0) {
1295 } else if (*pc
->p
== ']' && blevel
== 0) {
1298 } else if (*pc
->p
== '\\') {
1300 } else if (*pc
->p
== '{') {
1302 } else if (*pc
->p
== '}') {
1305 } else if (*pc
->p
== '\n')
1310 pc
->tt
= JIM_TT_CMD
;
1311 if (*pc
->p
== ']') {
1317 int JimParseVar(struct JimParserCtx
*pc
)
1319 int brace
= 0, stop
= 0, ttype
= JIM_TT_VAR
;
1321 pc
->tstart
= ++pc
->p
; pc
->len
--; /* skip the $ */
1322 pc
->tline
= pc
->linenr
;
1323 if (*pc
->p
== '{') {
1324 pc
->tstart
= ++pc
->p
; pc
->len
--;
1329 if (*pc
->p
== '}' || pc
->len
== 0) {
1335 else if (*pc
->p
== '\n')
1340 /* Include leading colons */
1341 while (*pc
->p
== ':') {
1346 if (!((*pc
->p
>= 'a' && *pc
->p
<= 'z') ||
1347 (*pc
->p
>= 'A' && *pc
->p
<= 'Z') ||
1348 (*pc
->p
>= '0' && *pc
->p
<= '9') || *pc
->p
== '_'))
1354 /* Parse [dict get] syntax sugar. */
1355 if (*pc
->p
== '(') {
1356 while (*pc
->p
!= ')' && pc
->len
) {
1358 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1359 pc
->p
+= 2; pc
->len
-= 2;
1362 if (*pc
->p
!= '\0') {
1365 ttype
= JIM_TT_DICTSUGAR
;
1369 /* Check if we parsed just the '$' character.
1370 * That's not a variable so an error is returned
1371 * to tell the state machine to consider this '$' just
1373 if (pc
->tstart
== pc
->p
) {
1381 int JimParseBrace(struct JimParserCtx
*pc
)
1385 pc
->tstart
= ++pc
->p
; pc
->len
--;
1386 pc
->tline
= pc
->linenr
;
1388 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1392 } else if (*pc
->p
== '{') {
1394 } else if (pc
->len
== 0 || *pc
->p
== '}') {
1396 if (pc
->len
== 0 || level
== 0) {
1401 pc
->tt
= JIM_TT_STR
;
1404 } else if (*pc
->p
== '\n') {
1409 return JIM_OK
; /* unreached */
1412 int JimParseStr(struct JimParserCtx
*pc
)
1414 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1415 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
);
1416 if (newword
&& *pc
->p
== '{') {
1417 return JimParseBrace(pc
);
1418 } else if (newword
&& *pc
->p
== '"') {
1419 pc
->state
= JIM_PS_QUOTE
;
1423 pc
->tline
= pc
->linenr
;
1427 pc
->tt
= JIM_TT_ESC
;
1432 if (pc
->state
== JIM_PS_DEF
&&
1433 *(pc
->p
+ 1) == '\n') {
1435 pc
->tt
= JIM_TT_ESC
;
1445 pc
->tt
= JIM_TT_ESC
;
1452 if (pc
->state
== JIM_PS_DEF
) {
1454 pc
->tt
= JIM_TT_ESC
;
1456 } else if (*pc
->p
== '\n') {
1461 if (pc
->state
== JIM_PS_QUOTE
) {
1463 pc
->tt
= JIM_TT_ESC
;
1465 pc
->state
= JIM_PS_DEF
;
1472 return JIM_OK
; /* unreached */
1475 int JimParseComment(struct JimParserCtx
*pc
)
1478 if (*pc
->p
== '\n') {
1480 if (*(pc
->p
-1) != '\\') {
1490 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1491 static int xdigitval(int c
)
1493 if (c
>= '0' && c
<= '9') return c
-'0';
1494 if (c
>= 'a' && c
<= 'f') return c
-'a'+10;
1495 if (c
>= 'A' && c
<= 'F') return c
-'A'+10;
1499 static int odigitval(int c
)
1501 if (c
>= '0' && c
<= '7') return c
-'0';
1505 /* Perform Tcl escape substitution of 's', storing the result
1506 * string into 'dest'. The escaped string is guaranteed to
1507 * be the same length or shorted than the source string.
1508 * Slen is the length of the string at 's', if it's -1 the string
1509 * length will be calculated by the function.
1511 * The function returns the length of the resulting string. */
1512 static int JimEscape(char *dest
, const char *s
, int slen
)
1520 for (i
= 0; i
< slen
; i
++) {
1524 case 'a': *p
++ = 0x7; i
++; break;
1525 case 'b': *p
++ = 0x8; i
++; break;
1526 case 'f': *p
++ = 0xc; i
++; break;
1527 case 'n': *p
++ = 0xa; i
++; break;
1528 case 'r': *p
++ = 0xd; i
++; break;
1529 case 't': *p
++ = 0x9; i
++; break;
1530 case 'v': *p
++ = 0xb; i
++; break;
1531 case '\0': *p
++ = '\\'; i
++; break;
1532 case '\n': *p
++ = ' '; i
++; break;
1534 if (s
[i
+ 1] == 'x') {
1536 int c
= xdigitval(s
[i
+ 2]);
1543 c
= xdigitval(s
[i
+ 3]);
1553 } else if (s
[i
+ 1] >= '0' && s
[i
+ 1] <= '7')
1556 int c
= odigitval(s
[i
+ 1]);
1558 c
= odigitval(s
[i
+ 2]);
1565 c
= odigitval(s
[i
+ 3]);
1591 /* Returns a dynamically allocated copy of the current token in the
1592 * parser context. The function perform conversion of escapes if
1593 * the token is of type JIM_TT_ESC.
1595 * Note that after the conversion, tokens that are grouped with
1596 * braces in the source code, are always recognizable from the
1597 * identical string obtained in a different way from the type.
1599 * For exmple the string:
1603 * will return as first token "expand", of type JIM_TT_STR
1609 * will return as first token "expand", of type JIM_TT_ESC
1611 char *JimParserGetToken(struct JimParserCtx
*pc
,
1612 int *lenPtr
, int *typePtr
, int *linePtr
)
1614 const char *start
, *end
;
1618 start
= JimParserTstart(pc
);
1619 end
= JimParserTend(pc
);
1621 if (lenPtr
) *lenPtr
= 0;
1622 if (typePtr
) *typePtr
= JimParserTtype(pc
);
1623 if (linePtr
) *linePtr
= JimParserTline(pc
);
1624 token
= Jim_Alloc(1);
1628 len
= (end
-start
) + 1;
1629 token
= Jim_Alloc(len
+ 1);
1630 if (JimParserTtype(pc
) != JIM_TT_ESC
) {
1631 /* No escape conversion needed? Just copy it. */
1632 memcpy(token
, start
, len
);
1635 /* Else convert the escape chars. */
1636 len
= JimEscape(token
, start
, len
);
1638 if (lenPtr
) *lenPtr
= len
;
1639 if (typePtr
) *typePtr
= JimParserTtype(pc
);
1640 if (linePtr
) *linePtr
= JimParserTline(pc
);
1644 /* The following functin is not really part of the parsing engine of Jim,
1645 * but it somewhat related. Given an string and its length, it tries
1646 * to guess if the script is complete or there are instead " " or { }
1647 * open and not completed. This is useful for interactive shells
1648 * implementation and for [info complete].
1650 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1651 * '{' on scripts incomplete missing one or more '}' to be balanced.
1652 * '"' on scripts incomplete missing a '"' char.
1654 * If the script is complete, 1 is returned, otherwise 0. */
1655 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
1669 } else if (state
== '"') {
1676 } else if (state
== ' ') {
1693 *stateCharPtr
= state
;
1694 return state
== ' ';
1697 /* -----------------------------------------------------------------------------
1699 * ---------------------------------------------------------------------------*/
1700 static int JimParseListSep(struct JimParserCtx
*pc
);
1701 static int JimParseListStr(struct JimParserCtx
*pc
);
1703 int JimParseList(struct JimParserCtx
*pc
)
1706 pc
->tstart
= pc
->tend
= pc
->p
;
1707 pc
->tline
= pc
->linenr
;
1708 pc
->tt
= JIM_TT_EOL
;
1717 if (pc
->state
== JIM_PS_DEF
)
1718 return JimParseListSep(pc
);
1720 return JimParseListStr(pc
);
1723 return JimParseListStr(pc
);
1729 int JimParseListSep(struct JimParserCtx
*pc
)
1732 pc
->tline
= pc
->linenr
;
1733 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== '\n')
1738 pc
->tt
= JIM_TT_SEP
;
1742 int JimParseListStr(struct JimParserCtx
*pc
)
1744 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1745 pc
->tt
== JIM_TT_NONE
);
1746 if (newword
&& *pc
->p
== '{') {
1747 return JimParseBrace(pc
);
1748 } else if (newword
&& *pc
->p
== '"') {
1749 pc
->state
= JIM_PS_QUOTE
;
1753 pc
->tline
= pc
->linenr
;
1757 pc
->tt
= JIM_TT_ESC
;
1768 if (pc
->state
== JIM_PS_DEF
) {
1770 pc
->tt
= JIM_TT_ESC
;
1772 } else if (*pc
->p
== '\n') {
1777 if (pc
->state
== JIM_PS_QUOTE
) {
1779 pc
->tt
= JIM_TT_ESC
;
1781 pc
->state
= JIM_PS_DEF
;
1788 return JIM_OK
; /* unreached */
1791 /* -----------------------------------------------------------------------------
1792 * Jim_Obj related functions
1793 * ---------------------------------------------------------------------------*/
1795 /* Return a new initialized object. */
1796 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
1800 /* -- Check if there are objects in the free list -- */
1801 if (interp
->freeList
!= NULL
) {
1802 /* -- Unlink the object from the free list -- */
1803 objPtr
= interp
->freeList
;
1804 interp
->freeList
= objPtr
->nextObjPtr
;
1806 /* -- No ready to use objects: allocate a new one -- */
1807 objPtr
= Jim_Alloc(sizeof(*objPtr
));
1810 /* Object is returned with refCount of 0. Every
1811 * kind of GC implemented should take care to don't try
1812 * to scan objects with refCount == 0. */
1813 objPtr
->refCount
= 0;
1814 /* All the other fields are left not initialized to save time.
1815 * The caller will probably want set they to the right
1818 /* -- Put the object into the live list -- */
1819 objPtr
->prevObjPtr
= NULL
;
1820 objPtr
->nextObjPtr
= interp
->liveList
;
1821 if (interp
->liveList
)
1822 interp
->liveList
->prevObjPtr
= objPtr
;
1823 interp
->liveList
= objPtr
;
1828 /* Free an object. Actually objects are never freed, but
1829 * just moved to the free objects list, where they will be
1830 * reused by Jim_NewObj(). */
1831 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1833 /* Check if the object was already freed, panic. */
1834 if (objPtr
->refCount
!= 0) {
1835 Jim_Panic(interp
,"!!!Object %p freed with bad refcount %d", objPtr
,
1838 /* Free the internal representation */
1839 Jim_FreeIntRep(interp
, objPtr
);
1840 /* Free the string representation */
1841 if (objPtr
->bytes
!= NULL
) {
1842 if (objPtr
->bytes
!= JimEmptyStringRep
)
1843 Jim_Free(objPtr
->bytes
);
1845 /* Unlink the object from the live objects list */
1846 if (objPtr
->prevObjPtr
)
1847 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
1848 if (objPtr
->nextObjPtr
)
1849 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
1850 if (interp
->liveList
== objPtr
)
1851 interp
->liveList
= objPtr
->nextObjPtr
;
1852 /* Link the object into the free objects list */
1853 objPtr
->prevObjPtr
= NULL
;
1854 objPtr
->nextObjPtr
= interp
->freeList
;
1855 if (interp
->freeList
)
1856 interp
->freeList
->prevObjPtr
= objPtr
;
1857 interp
->freeList
= objPtr
;
1858 objPtr
->refCount
= -1;
1861 /* Invalidate the string representation of an object. */
1862 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
1864 if (objPtr
->bytes
!= NULL
) {
1865 if (objPtr
->bytes
!= JimEmptyStringRep
)
1866 Jim_Free(objPtr
->bytes
);
1868 objPtr
->bytes
= NULL
;
1871 #define Jim_SetStringRep(o, b, l) \
1872 do { (o)->bytes = b; (o)->length = l; } while (0)
1874 /* Set the initial string representation for an object.
1875 * Does not try to free an old one. */
1876 void Jim_InitStringRep(Jim_Obj
*objPtr
, const char *bytes
, int length
)
1879 objPtr
->bytes
= JimEmptyStringRep
;
1882 objPtr
->bytes
= Jim_Alloc(length
+ 1);
1883 objPtr
->length
= length
;
1884 memcpy(objPtr
->bytes
, bytes
, length
);
1885 objPtr
->bytes
[length
] = '\0';
1889 /* Duplicate an object. The returned object has refcount = 0. */
1890 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1894 dupPtr
= Jim_NewObj(interp
);
1895 if (objPtr
->bytes
== NULL
) {
1896 /* Object does not have a valid string representation. */
1897 dupPtr
->bytes
= NULL
;
1899 Jim_InitStringRep(dupPtr
, objPtr
->bytes
, objPtr
->length
);
1901 if (objPtr
->typePtr
!= NULL
) {
1902 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
1903 dupPtr
->internalRep
= objPtr
->internalRep
;
1905 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
1907 dupPtr
->typePtr
= objPtr
->typePtr
;
1909 dupPtr
->typePtr
= NULL
;
1914 /* Return the string representation for objPtr. If the object
1915 * string representation is invalid, calls the method to create
1916 * a new one starting from the internal representation of the object. */
1917 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
1919 if (objPtr
->bytes
== NULL
) {
1920 /* Invalid string repr. Generate it. */
1921 if (objPtr
->typePtr
->updateStringProc
== NULL
) {
1922 Jim_Panic(NULL
,"UpdataStringProc called against '%s' type.",
1923 objPtr
->typePtr
->name
);
1925 objPtr
->typePtr
->updateStringProc(objPtr
);
1928 *lenPtr
= objPtr
->length
;
1929 return objPtr
->bytes
;
1932 /* Just returns the length of the object's string rep */
1933 int Jim_Length(Jim_Obj
*objPtr
)
1937 Jim_GetString(objPtr
, &len
);
1941 /* -----------------------------------------------------------------------------
1943 * ---------------------------------------------------------------------------*/
1944 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
1945 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
1947 static Jim_ObjType stringObjType
= {
1950 DupStringInternalRep
,
1952 JIM_TYPE_REFERENCES
,
1955 void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
1957 JIM_NOTUSED(interp
);
1959 /* This is a bit subtle: the only caller of this function
1960 * should be Jim_DuplicateObj(), that will copy the
1961 * string representaion. After the copy, the duplicated
1962 * object will not have more room in teh buffer than
1963 * srcPtr->length bytes. So we just set it to length. */
1964 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
1967 int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1969 /* Get a fresh string representation. */
1970 (void) Jim_GetString(objPtr
, NULL
);
1971 /* Free any other internal representation. */
1972 Jim_FreeIntRep(interp
, objPtr
);
1973 /* Set it as string, i.e. just set the maxLength field. */
1974 objPtr
->typePtr
= &stringObjType
;
1975 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
1979 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
1981 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
1985 /* Alloc/Set the string rep. */
1987 objPtr
->bytes
= JimEmptyStringRep
;
1990 objPtr
->bytes
= Jim_Alloc(len
+ 1);
1991 objPtr
->length
= len
;
1992 memcpy(objPtr
->bytes
, s
, len
);
1993 objPtr
->bytes
[len
] = '\0';
1996 /* No typePtr field for the vanilla string object. */
1997 objPtr
->typePtr
= NULL
;
2001 /* This version does not try to duplicate the 's' pointer, but
2002 * use it directly. */
2003 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2005 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2009 Jim_SetStringRep(objPtr
, s
, len
);
2010 objPtr
->typePtr
= NULL
;
2014 /* Low-level string append. Use it only against objects
2015 * of type "string". */
2016 void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2022 needlen
= objPtr
->length
+ len
;
2023 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2024 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2025 if (objPtr
->bytes
== JimEmptyStringRep
) {
2026 objPtr
->bytes
= Jim_Alloc((needlen
*2) + 1);
2028 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, (needlen
*2) + 1);
2030 objPtr
->internalRep
.strValue
.maxLength
= needlen
*2;
2032 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2033 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2034 objPtr
->length
+= len
;
2037 /* Low-level wrapper to append an object. */
2038 void StringAppendObj(Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2043 str
= Jim_GetString(appendObjPtr
, &len
);
2044 StringAppendString(objPtr
, str
, len
);
2047 /* Higher level API to append strings to objects. */
2048 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
,
2051 if (Jim_IsShared(objPtr
))
2052 Jim_Panic(interp
,"Jim_AppendString called with shared object");
2053 if (objPtr
->typePtr
!= &stringObjType
)
2054 SetStringFromAny(interp
, objPtr
);
2055 StringAppendString(objPtr
, str
, len
);
2058 void Jim_AppendString_sprintf( Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *fmt
, ... )
2063 va_start( ap
, fmt
);
2064 buf
= jim_vasprintf( fmt
, ap
);
2068 Jim_AppendString( interp
, objPtr
, buf
, -1 );
2069 jim_vasprintf_done(buf
);
2074 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2075 Jim_Obj
*appendObjPtr
)
2080 str
= Jim_GetString(appendObjPtr
, &len
);
2081 Jim_AppendString(interp
, objPtr
, str
, len
);
2084 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2088 if (objPtr
->typePtr
!= &stringObjType
)
2089 SetStringFromAny(interp
, objPtr
);
2090 va_start(ap
, objPtr
);
2092 char *s
= va_arg(ap
, char*);
2094 if (s
== NULL
) break;
2095 Jim_AppendString(interp
, objPtr
, s
, -1);
2100 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
, int nocase
)
2102 const char *aStr
, *bStr
;
2105 if (aObjPtr
== bObjPtr
) return 1;
2106 aStr
= Jim_GetString(aObjPtr
, &aLen
);
2107 bStr
= Jim_GetString(bObjPtr
, &bLen
);
2108 if (aLen
!= bLen
) return 0;
2110 return memcmp(aStr
, bStr
, aLen
) == 0;
2111 for (i
= 0; i
< aLen
; i
++) {
2112 if (tolower((int)aStr
[i
]) != tolower((int)bStr
[i
]))
2118 int Jim_StringMatchObj(Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
,
2121 const char *pattern
, *string
;
2122 int patternLen
, stringLen
;
2124 pattern
= Jim_GetString(patternObjPtr
, &patternLen
);
2125 string
= Jim_GetString(objPtr
, &stringLen
);
2126 return JimStringMatch(pattern
, patternLen
, string
, stringLen
, nocase
);
2129 int Jim_StringCompareObj(Jim_Obj
*firstObjPtr
,
2130 Jim_Obj
*secondObjPtr
, int nocase
)
2132 const char *s1
, *s2
;
2135 s1
= Jim_GetString(firstObjPtr
, &l1
);
2136 s2
= Jim_GetString(secondObjPtr
, &l2
);
2137 return JimStringCompare(s1
, l1
, s2
, l2
, nocase
);
2140 /* Convert a range, as returned by Jim_GetRange(), into
2141 * an absolute index into an object of the specified length.
2142 * This function may return negative values, or values
2143 * bigger or equal to the length of the list if the index
2144 * is out of range. */
2145 static int JimRelToAbsIndex(int len
, int index
)
2152 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2153 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2154 * for implementation of commands like [string range] and [lrange].
2156 * The resulting range is guaranteed to address valid elements of
2158 static void JimRelToAbsRange(int len
, int first
, int last
,
2159 int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2166 rangeLen
= last
-first
+ 1;
2173 rangeLen
-= (last
-(len
-1));
2178 if (rangeLen
< 0) rangeLen
= 0;
2182 *rangeLenPtr
= rangeLen
;
2185 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2186 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2192 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
2193 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
2195 str
= Jim_GetString(strObjPtr
, &len
);
2196 first
= JimRelToAbsIndex(len
, first
);
2197 last
= JimRelToAbsIndex(len
, last
);
2198 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
2199 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2202 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2206 if (strObjPtr
->typePtr
!= &stringObjType
) {
2207 SetStringFromAny(interp
, strObjPtr
);
2210 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2212 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2213 for (i
= 0; i
< strObjPtr
->length
; i
++)
2214 buf
[i
] = tolower(buf
[i
]);
2215 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2218 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2222 if (strObjPtr
->typePtr
!= &stringObjType
) {
2223 SetStringFromAny(interp
, strObjPtr
);
2226 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2228 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2229 for (i
= 0; i
< strObjPtr
->length
; i
++)
2230 buf
[i
] = toupper(buf
[i
]);
2231 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2234 /* This is the core of the [format] command.
2235 * TODO: Lots of things work - via a hack
2236 * However, no format item can be >= JIM_MAX_FMT
2238 #define JIM_MAX_FMT 2048
2239 static Jim_Obj
*Jim_FormatString_Inner(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
,
2240 int objc
, Jim_Obj
*const *objv
, char *sprintf_buf
)
2242 const char *fmt
, *_fmt
;
2247 fmt
= Jim_GetString(fmtObjPtr
, &fmtLen
);
2249 resObjPtr
= Jim_NewStringObj(interp
, "", 0);
2251 const char *p
= fmt
;
2255 /* we cheat and use Sprintf()! */
2269 while (*fmt
!= '%' && fmtLen
) {
2272 Jim_AppendString(interp
, resObjPtr
, p
, fmt
-p
);
2275 fmt
++; fmtLen
--; /* skip '%' */
2284 prec
= -1; /* not found yet */
2291 case 'b': /* binary - not all printfs() do this */
2292 case 's': /* string */
2293 case 'i': /* integer */
2294 case 'd': /* decimal */
2296 case 'X': /* CAP hex */
2297 case 'c': /* char */
2298 case 'o': /* octal */
2299 case 'u': /* unsigned */
2300 case 'f': /* float */
2304 case '0': /* zero pad */
2314 case ' ': /* sign space */
2344 while ( isdigit(*fmt
) && (fmtLen
> 0) ){
2345 accum
= (accum
* 10) + (*fmt
- '0');
2356 /* suck up the next item as an integer */
2360 goto not_enough_args
;
2362 if ( Jim_GetWide(interp
,objv
[0],&wideValue
)== JIM_ERR
){
2363 Jim_FreeNewObj(interp
, resObjPtr
);
2370 /* man 3 printf says */
2371 /* if prec is negative, it is zero */
2390 Jim_FreeNewObj(interp
, resObjPtr
);
2391 Jim_SetResultString(interp
,
2392 "not enough arguments for all format specifiers", -1);
2400 * Create the formatter
2401 * cause we cheat and use sprintf()
2411 /* PLUS overrides */
2421 sprintf( cp
, "%d", width
);
2425 /* did we find a period? */
2429 /* did something occur after the period? */
2431 sprintf( cp
, "%d", prec
);
2437 /* here we do the work */
2438 /* actually - we make sprintf() do it for us */
2443 /* BUG: we do not handled embeded NULLs */
2444 snprintf( sprintf_buf
, JIM_MAX_FMT
, fmt_str
, Jim_GetString( objv
[0], NULL
));
2449 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2450 Jim_FreeNewObj(interp
, resObjPtr
);
2453 c
= (char) wideValue
;
2454 snprintf( sprintf_buf
, JIM_MAX_FMT
, fmt_str
, c
);
2464 if ( Jim_GetDouble( interp
, objv
[0], &doubleValue
) == JIM_ERR
){
2465 Jim_FreeNewObj( interp
, resObjPtr
);
2468 snprintf( sprintf_buf
, JIM_MAX_FMT
, fmt_str
, doubleValue
);
2477 /* jim widevaluse are 64bit */
2478 if ( sizeof(jim_wide
) == sizeof(long long) ){
2486 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2487 Jim_FreeNewObj(interp
, resObjPtr
);
2490 snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, wideValue
);
2493 sprintf_buf
[0] = '%';
2495 objv
--; /* undo the objv++ below */
2498 spec
[0] = *fmt
; spec
[1] = '\0';
2499 Jim_FreeNewObj(interp
, resObjPtr
);
2500 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
2501 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
2502 "bad field specifier \"", spec
, "\"", NULL
);
2505 /* force terminate */
2507 printf("FMT was: %s\n", fmt_str
);
2508 printf("RES was: |%s|\n", sprintf_buf
);
2511 sprintf_buf
[ JIM_MAX_FMT
- 1] = 0;
2512 Jim_AppendString( interp
, resObjPtr
, sprintf_buf
, strlen(sprintf_buf
) );
2521 Jim_Obj
*Jim_FormatString(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
,
2522 int objc
, Jim_Obj
*const *objv
)
2524 char *sprintf_buf
= malloc(JIM_MAX_FMT
);
2525 Jim_Obj
*t
= Jim_FormatString_Inner(interp
, fmtObjPtr
, objc
, objv
, sprintf_buf
);
2530 /* -----------------------------------------------------------------------------
2531 * Compared String Object
2532 * ---------------------------------------------------------------------------*/
2534 /* This is strange object that allows to compare a C literal string
2535 * with a Jim object in very short time if the same comparison is done
2536 * multiple times. For example every time the [if] command is executed,
2537 * Jim has to check if a given argument is "else". This comparions if
2538 * the code has no errors are true most of the times, so we can cache
2539 * inside the object the pointer of the string of the last matching
2540 * comparison. Because most C compilers perform literal sharing,
2541 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2542 * this works pretty well even if comparisons are at different places
2543 * inside the C code. */
2545 static Jim_ObjType comparedStringObjType
= {
2550 JIM_TYPE_REFERENCES
,
2553 /* The only way this object is exposed to the API is via the following
2554 * function. Returns true if the string and the object string repr.
2555 * are the same, otherwise zero is returned.
2557 * Note: this isn't binary safe, but it hardly needs to be.*/
2558 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2561 if (objPtr
->typePtr
== &comparedStringObjType
&&
2562 objPtr
->internalRep
.ptr
== str
)
2565 const char *objStr
= Jim_GetString(objPtr
, NULL
);
2566 if (strcmp(str
, objStr
) != 0) return 0;
2567 if (objPtr
->typePtr
!= &comparedStringObjType
) {
2568 Jim_FreeIntRep(interp
, objPtr
);
2569 objPtr
->typePtr
= &comparedStringObjType
;
2571 objPtr
->internalRep
.ptr
= (char*)str
; /*ATTENTION: const cast */
2576 int qsortCompareStringPointers(const void *a
, const void *b
)
2578 char * const *sa
= (char * const *)a
;
2579 char * const *sb
= (char * const *)b
;
2580 return strcmp(*sa
, *sb
);
2583 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2584 const char * const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
2586 const char * const *entryPtr
= NULL
;
2587 char **tablePtrSorted
;
2591 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
2592 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
2596 count
++; /* If nothing matches, this will reach the len of tablePtr */
2598 if (flags
& JIM_ERRMSG
) {
2601 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
2602 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
2603 "bad ", name
, " \"", Jim_GetString(objPtr
, NULL
), "\": must be one of ",
2605 tablePtrSorted
= Jim_Alloc(sizeof(char*)*count
);
2606 memcpy(tablePtrSorted
, tablePtr
, sizeof(char*)*count
);
2607 qsort(tablePtrSorted
, count
, sizeof(char*), qsortCompareStringPointers
);
2608 for (i
= 0; i
< count
; i
++) {
2609 if (i
+ 1 == count
&& count
> 1)
2610 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
2611 Jim_AppendString(interp
, Jim_GetResult(interp
),
2612 tablePtrSorted
[i
], -1);
2614 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
2616 Jim_Free(tablePtrSorted
);
2621 int Jim_GetNvp(Jim_Interp
*interp
,
2623 const Jim_Nvp
*nvp_table
,
2624 const Jim_Nvp
** result
)
2629 e
= Jim_Nvp_name2value_obj( interp
, nvp_table
, objPtr
, &n
);
2630 if ( e
== JIM_ERR
){
2634 /* Success? found? */
2637 *result
= (Jim_Nvp
*)n
;
2644 /* -----------------------------------------------------------------------------
2647 * This object is just a string from the language point of view, but
2648 * in the internal representation it contains the filename and line number
2649 * where this given token was read. This information is used by
2650 * Jim_EvalObj() if the object passed happens to be of type "source".
2652 * This allows to propagate the information about line numbers and file
2653 * names and give error messages with absolute line numbers.
2655 * Note that this object uses shared strings for filenames, and the
2656 * pointer to the filename together with the line number is taken into
2657 * the space for the "inline" internal represenation of the Jim_Object,
2658 * so there is almost memory zero-overhead.
2660 * Also the object will be converted to something else if the given
2661 * token it represents in the source file is not something to be
2662 * evaluated (not a script), and will be specialized in some other way,
2663 * so the time overhead is alzo null.
2664 * ---------------------------------------------------------------------------*/
2666 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2667 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2669 static Jim_ObjType sourceObjType
= {
2671 FreeSourceInternalRep
,
2672 DupSourceInternalRep
,
2674 JIM_TYPE_REFERENCES
,
2677 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2679 Jim_ReleaseSharedString(interp
,
2680 objPtr
->internalRep
.sourceValue
.fileName
);
2683 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2685 dupPtr
->internalRep
.sourceValue
.fileName
=
2686 Jim_GetSharedString(interp
,
2687 srcPtr
->internalRep
.sourceValue
.fileName
);
2688 dupPtr
->internalRep
.sourceValue
.lineNumber
=
2689 dupPtr
->internalRep
.sourceValue
.lineNumber
;
2690 dupPtr
->typePtr
= &sourceObjType
;
2693 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2694 const char *fileName
, int lineNumber
)
2696 if (Jim_IsShared(objPtr
))
2697 Jim_Panic(interp
,"JimSetSourceInfo called with shared object");
2698 if (objPtr
->typePtr
!= NULL
)
2699 Jim_Panic(interp
,"JimSetSourceInfo called with typePtr != NULL");
2700 objPtr
->internalRep
.sourceValue
.fileName
=
2701 Jim_GetSharedString(interp
, fileName
);
2702 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
2703 objPtr
->typePtr
= &sourceObjType
;
2706 /* -----------------------------------------------------------------------------
2708 * ---------------------------------------------------------------------------*/
2710 #define JIM_CMDSTRUCT_EXPAND -1
2712 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2713 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2714 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2716 static Jim_ObjType scriptObjType
= {
2718 FreeScriptInternalRep
,
2719 DupScriptInternalRep
,
2721 JIM_TYPE_REFERENCES
,
2724 /* The ScriptToken structure represents every token into a scriptObj.
2725 * Every token contains an associated Jim_Obj that can be specialized
2726 * by commands operating on it. */
2727 typedef struct ScriptToken
{
2733 /* This is the script object internal representation. An array of
2734 * ScriptToken structures, with an associated command structure array.
2735 * The command structure is a pre-computed representation of the
2736 * command length and arguments structure as a simple liner array
2739 * For example the script:
2742 * set $i $x$y [foo]BAR
2744 * will produce a ScriptObj with the following Tokens:
2761 * This is a description of the tokens, separators, and of lines.
2762 * The command structure instead represents the number of arguments
2763 * of every command, followed by the tokens of which every argument
2764 * is composed. So for the example script, the cmdstruct array will
2769 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2770 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2771 * composed of single tokens (1 1) and the last two of double tokens
2774 * The precomputation of the command structure makes Jim_Eval() faster,
2775 * and simpler because there aren't dynamic lengths / allocations.
2777 * -- {expand} handling --
2779 * Expand is handled in a special way. When a command
2780 * contains at least an argument with the {expand} prefix,
2781 * the command structure presents a -1 before the integer
2782 * describing the number of arguments. This is used in order
2783 * to send the command exection to a different path in case
2784 * of {expand} and guarantee a fast path for the more common
2785 * case. Also, the integers describing the number of tokens
2786 * are expressed with negative sign, to allow for fast check
2787 * of what's an {expand}-prefixed argument and what not.
2789 * For example the command:
2791 * list {expand}{1 2}
2793 * Will produce the following cmdstruct array:
2797 * -- the substFlags field of the structure --
2799 * The scriptObj structure is used to represent both "script" objects
2800 * and "subst" objects. In the second case, the cmdStruct related
2801 * fields are not used at all, but there is an additional field used
2802 * that is 'substFlags': this represents the flags used to turn
2803 * the string into the intenral representation used to perform the
2804 * substitution. If this flags are not what the application requires
2805 * the scriptObj is created again. For example the script:
2807 * subst -nocommands $string
2808 * subst -novariables $string
2810 * Will recreate the internal representation of the $string object
2813 typedef struct ScriptObj
{
2814 int len
; /* Length as number of tokens. */
2815 int commands
; /* number of top-level commands in script. */
2816 ScriptToken
*token
; /* Tokens array. */
2817 int *cmdStruct
; /* commands structure */
2818 int csLen
; /* length of the cmdStruct array. */
2819 int substFlags
; /* flags used for the compilation of "subst" objects */
2820 int inUse
; /* Used to share a ScriptObj. Currently
2821 only used by Jim_EvalObj() as protection against
2822 shimmering of the currently evaluated object. */
2826 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2829 struct ScriptObj
*script
= (void*) objPtr
->internalRep
.ptr
;
2832 if (script
->inUse
!= 0) return;
2833 for (i
= 0; i
< script
->len
; i
++) {
2834 if (script
->token
[i
].objPtr
!= NULL
)
2835 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
2837 Jim_Free(script
->token
);
2838 Jim_Free(script
->cmdStruct
);
2839 Jim_Free(script
->fileName
);
2843 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2845 JIM_NOTUSED(interp
);
2846 JIM_NOTUSED(srcPtr
);
2848 /* Just returns an simple string. */
2849 dupPtr
->typePtr
= NULL
;
2852 /* Add a new token to the internal repr of a script object */
2853 static void ScriptObjAddToken(Jim_Interp
*interp
, struct ScriptObj
*script
,
2854 char *strtoken
, int len
, int type
, char *filename
, int linenr
)
2857 struct ScriptToken
*token
;
2859 prevtype
= (script
->len
== 0) ? JIM_TT_EOL
: \
2860 script
->token
[script
->len
-1].type
;
2861 /* Skip tokens without meaning, like words separators
2862 * following a word separator or an end of command and
2864 if (prevtype
== JIM_TT_EOL
) {
2865 if (type
== JIM_TT_EOL
|| type
== JIM_TT_SEP
) {
2869 } else if (prevtype
== JIM_TT_SEP
) {
2870 if (type
== JIM_TT_SEP
) {
2873 } else if (type
== JIM_TT_EOL
) {
2874 /* If an EOL is following by a SEP, drop the previous
2877 Jim_DecrRefCount(interp
, script
->token
[script
->len
].objPtr
);
2879 } else if (prevtype
!= JIM_TT_EOL
&& prevtype
!= JIM_TT_SEP
&&
2880 type
== JIM_TT_ESC
&& len
== 0)
2882 /* Don't add empty tokens used in interpolation */
2886 /* Make space for a new istruction */
2888 script
->token
= Jim_Realloc(script
->token
,
2889 sizeof(ScriptToken
)*script
->len
);
2890 /* Initialize the new token */
2891 token
= script
->token
+ (script
->len
-1);
2893 /* Every object is intially as a string, but the
2894 * internal type may be specialized during execution of the
2896 token
->objPtr
= Jim_NewStringObjNoAlloc(interp
, strtoken
, len
);
2897 /* To add source info to SEP and EOL tokens is useless because
2898 * they will never by called as arguments of Jim_EvalObj(). */
2899 if (filename
&& type
!= JIM_TT_SEP
&& type
!= JIM_TT_EOL
)
2900 JimSetSourceInfo(interp
, token
->objPtr
, filename
, linenr
);
2901 Jim_IncrRefCount(token
->objPtr
);
2902 token
->linenr
= linenr
;
2905 /* Add an integer into the command structure field of the script object. */
2906 static void ScriptObjAddInt(struct ScriptObj
*script
, int val
)
2909 script
->cmdStruct
= Jim_Realloc(script
->cmdStruct
,
2910 sizeof(int)*script
->csLen
);
2911 script
->cmdStruct
[script
->csLen
-1] = val
;
2914 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2915 * of objPtr. Search nested script objects recursively. */
2916 static Jim_Obj
*ScriptSearchLiteral(Jim_Interp
*interp
, ScriptObj
*script
,
2917 ScriptObj
*scriptBarrier
, Jim_Obj
*objPtr
)
2921 for (i
= 0; i
< script
->len
; i
++) {
2922 if (script
->token
[i
].objPtr
!= objPtr
&&
2923 Jim_StringEqObj(script
->token
[i
].objPtr
, objPtr
, 0)) {
2924 return script
->token
[i
].objPtr
;
2926 /* Enter recursively on scripts only if the object
2927 * is not the same as the one we are searching for
2928 * shared occurrences. */
2929 if (script
->token
[i
].objPtr
->typePtr
== &scriptObjType
&&
2930 script
->token
[i
].objPtr
!= objPtr
) {
2931 Jim_Obj
*foundObjPtr
;
2933 ScriptObj
*subScript
=
2934 script
->token
[i
].objPtr
->internalRep
.ptr
;
2935 /* Don't recursively enter the script we are trying
2936 * to make shared to avoid circular references. */
2937 if (subScript
== scriptBarrier
) continue;
2938 if (subScript
!= script
) {
2940 ScriptSearchLiteral(interp
, subScript
,
2941 scriptBarrier
, objPtr
);
2942 if (foundObjPtr
!= NULL
)
2950 /* Share literals of a script recursively sharing sub-scripts literals. */
2951 static void ScriptShareLiterals(Jim_Interp
*interp
, ScriptObj
*script
,
2952 ScriptObj
*topLevelScript
)
2957 /* Try to share with toplevel object. */
2958 if (topLevelScript
!= NULL
) {
2959 for (i
= 0; i
< script
->len
; i
++) {
2960 Jim_Obj
*foundObjPtr
;
2961 char *str
= script
->token
[i
].objPtr
->bytes
;
2963 if (script
->token
[i
].objPtr
->refCount
!= 1) continue;
2964 if (script
->token
[i
].objPtr
->typePtr
== &scriptObjType
) continue;
2965 if (strchr(str
, ' ') || strchr(str
, '\n')) continue;
2966 foundObjPtr
= ScriptSearchLiteral(interp
,
2968 script
, /* barrier */
2969 script
->token
[i
].objPtr
);
2970 if (foundObjPtr
!= NULL
) {
2971 Jim_IncrRefCount(foundObjPtr
);
2972 Jim_DecrRefCount(interp
,
2973 script
->token
[i
].objPtr
);
2974 script
->token
[i
].objPtr
= foundObjPtr
;
2978 /* Try to share locally */
2979 for (i
= 0; i
< script
->len
; i
++) {
2980 char *str
= script
->token
[i
].objPtr
->bytes
;
2982 if (script
->token
[i
].objPtr
->refCount
!= 1) continue;
2983 if (strchr(str
, ' ') || strchr(str
, '\n')) continue;
2984 for (j
= 0; j
< script
->len
; j
++) {
2985 if (script
->token
[i
].objPtr
!=
2986 script
->token
[j
].objPtr
&&
2987 Jim_StringEqObj(script
->token
[i
].objPtr
,
2988 script
->token
[j
].objPtr
, 0))
2990 Jim_IncrRefCount(script
->token
[j
].objPtr
);
2991 Jim_DecrRefCount(interp
,
2992 script
->token
[i
].objPtr
);
2993 script
->token
[i
].objPtr
=
2994 script
->token
[j
].objPtr
;
3000 /* This method takes the string representation of an object
3001 * as a Tcl script, and generates the pre-parsed internal representation
3003 int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3006 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3007 struct JimParserCtx parser
;
3008 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
3010 int args
, tokens
, start
, end
, i
;
3011 int initialLineNumber
;
3012 int propagateSourceInfo
= 0;
3016 script
->commands
= 0;
3017 script
->token
= NULL
;
3018 script
->cmdStruct
= NULL
;
3020 /* Try to get information about filename / line number */
3021 if (objPtr
->typePtr
== &sourceObjType
) {
3023 Jim_StrDup(objPtr
->internalRep
.sourceValue
.fileName
);
3024 initialLineNumber
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3025 propagateSourceInfo
= 1;
3027 script
->fileName
= Jim_StrDup("");
3028 initialLineNumber
= 1;
3031 JimParserInit(&parser
, scriptText
, scriptTextLen
, initialLineNumber
);
3032 while (!JimParserEof(&parser
)) {
3034 int len
, type
, linenr
;
3036 JimParseScript(&parser
);
3037 token
= JimParserGetToken(&parser
, &len
, &type
, &linenr
);
3038 ScriptObjAddToken(interp
, script
, token
, len
, type
,
3039 propagateSourceInfo ? script
->fileName
: NULL
,
3042 token
= script
->token
;
3044 /* Compute the command structure array
3045 * (see the ScriptObj struct definition for more info) */
3046 start
= 0; /* Current command start token index */
3047 end
= -1; /* Current command end token index */
3049 int expand
= 0; /* expand flag. set to 1 on {expand} form. */
3050 int interpolation
= 0; /* set to 1 if there is at least one
3051 argument of the command obtained via
3052 interpolation of more tokens. */
3053 /* Search for the end of command, while
3054 * count the number of args. */
3056 if (start
>= script
->len
) break;
3057 args
= 1; /* Number of args in current command */
3058 while (token
[end
].type
!= JIM_TT_EOL
) {
3059 if (end
== 0 || token
[end
-1].type
== JIM_TT_SEP
||
3060 token
[end
-1].type
== JIM_TT_EOL
)
3062 if (token
[end
].type
== JIM_TT_STR
&&
3063 token
[end
+ 1].type
!= JIM_TT_SEP
&&
3064 token
[end
+ 1].type
!= JIM_TT_EOL
&&
3065 (!strcmp(token
[end
].objPtr
->bytes
, "expand") ||
3066 !strcmp(token
[end
].objPtr
->bytes
, "*")))
3069 if (token
[end
].type
== JIM_TT_SEP
)
3073 interpolation
= !((end
-start
+ 1) == args
*2);
3074 /* Add the 'number of arguments' info into cmdstruct.
3075 * Negative value if there is list expansion involved. */
3077 ScriptObjAddInt(script
, -1);
3078 ScriptObjAddInt(script
, args
);
3079 /* Now add info about the number of tokens. */
3080 tokens
= 0; /* Number of tokens in current argument. */
3082 for (i
= start
; i
<= end
; i
++) {
3083 if (token
[i
].type
== JIM_TT_SEP
||
3084 token
[i
].type
== JIM_TT_EOL
)
3086 if (tokens
== 1 && expand
)
3088 ScriptObjAddInt(script
,
3089 expand ?
-tokens
: tokens
);
3094 } else if (tokens
== 0 && token
[i
].type
== JIM_TT_STR
&&
3095 (!strcmp(token
[i
].objPtr
->bytes
, "expand") ||
3096 !strcmp(token
[i
].objPtr
->bytes
, "*")))
3103 /* Perform literal sharing, but only for objects that appear
3104 * to be scripts written as literals inside the source code,
3105 * and not computed at runtime. Literal sharing is a costly
3106 * operation that should be done only against objects that
3107 * are likely to require compilation only the first time, and
3108 * then are executed multiple times. */
3109 if (propagateSourceInfo
&& interp
->framePtr
->procBodyObjPtr
) {
3110 Jim_Obj
*bodyObjPtr
= interp
->framePtr
->procBodyObjPtr
;
3111 if (bodyObjPtr
->typePtr
== &scriptObjType
) {
3112 ScriptObj
*bodyScript
=
3113 bodyObjPtr
->internalRep
.ptr
;
3114 ScriptShareLiterals(interp
, script
, bodyScript
);
3116 } else if (propagateSourceInfo
) {
3117 ScriptShareLiterals(interp
, script
, NULL
);
3119 /* Free the old internal rep and set the new one. */
3120 Jim_FreeIntRep(interp
, objPtr
);
3121 Jim_SetIntRepPtr(objPtr
, script
);
3122 objPtr
->typePtr
= &scriptObjType
;
3126 ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3128 if (objPtr
->typePtr
!= &scriptObjType
) {
3129 SetScriptFromAny(interp
, objPtr
);
3131 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
3134 /* -----------------------------------------------------------------------------
3136 * ---------------------------------------------------------------------------*/
3138 /* Commands HashTable Type.
3140 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3141 static void Jim_CommandsHT_ValDestructor(void *interp
, void *val
)
3143 Jim_Cmd
*cmdPtr
= (void*) val
;
3145 if (cmdPtr
->cmdProc
== NULL
) {
3146 Jim_DecrRefCount(interp
, cmdPtr
->argListObjPtr
);
3147 Jim_DecrRefCount(interp
, cmdPtr
->bodyObjPtr
);
3148 if (cmdPtr
->staticVars
) {
3149 Jim_FreeHashTable(cmdPtr
->staticVars
);
3150 Jim_Free(cmdPtr
->staticVars
);
3152 } else if (cmdPtr
->delProc
!= NULL
) {
3153 /* If it was a C coded command, call the delProc if any */
3154 cmdPtr
->delProc(interp
, cmdPtr
->privData
);
3159 static Jim_HashTableType JimCommandsHashTableType
= {
3160 JimStringCopyHTHashFunction
, /* hash function */
3161 JimStringCopyHTKeyDup
, /* key dup */
3163 JimStringCopyHTKeyCompare
, /* key compare */
3164 JimStringCopyHTKeyDestructor
, /* key destructor */
3165 Jim_CommandsHT_ValDestructor
/* val destructor */
3168 /* ------------------------- Commands related functions --------------------- */
3170 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdName
,
3171 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3176 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
3177 if (he
== NULL
) { /* New command to create */
3178 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3179 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
3181 Jim_InterpIncrProcEpoch(interp
);
3182 /* Free the arglist/body objects if it was a Tcl procedure */
3184 if (cmdPtr
->cmdProc
== NULL
) {
3185 Jim_DecrRefCount(interp
, cmdPtr
->argListObjPtr
);
3186 Jim_DecrRefCount(interp
, cmdPtr
->bodyObjPtr
);
3187 if (cmdPtr
->staticVars
) {
3188 Jim_FreeHashTable(cmdPtr
->staticVars
);
3189 Jim_Free(cmdPtr
->staticVars
);
3191 cmdPtr
->staticVars
= NULL
;
3192 } else if (cmdPtr
->delProc
!= NULL
) {
3193 /* If it was a C coded command, call the delProc if any */
3194 cmdPtr
->delProc(interp
, cmdPtr
->privData
);
3198 /* Store the new details for this proc */
3199 cmdPtr
->delProc
= delProc
;
3200 cmdPtr
->cmdProc
= cmdProc
;
3201 cmdPtr
->privData
= privData
;
3203 /* There is no need to increment the 'proc epoch' because
3204 * creation of a new procedure can never affect existing
3205 * cached commands. We don't do negative caching. */
3209 int Jim_CreateProcedure(Jim_Interp
*interp
, const char *cmdName
,
3210 Jim_Obj
*argListObjPtr
, Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
,
3211 int arityMin
, int arityMax
)
3215 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3216 cmdPtr
->cmdProc
= NULL
; /* Not a C coded command */
3217 cmdPtr
->argListObjPtr
= argListObjPtr
;
3218 cmdPtr
->bodyObjPtr
= bodyObjPtr
;
3219 Jim_IncrRefCount(argListObjPtr
);
3220 Jim_IncrRefCount(bodyObjPtr
);
3221 cmdPtr
->arityMin
= arityMin
;
3222 cmdPtr
->arityMax
= arityMax
;
3223 cmdPtr
->staticVars
= NULL
;
3225 /* Create the statics hash table. */
3226 if (staticsListObjPtr
) {
3229 Jim_ListLength(interp
, staticsListObjPtr
, &len
);
3231 cmdPtr
->staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3232 Jim_InitHashTable(cmdPtr
->staticVars
, getJimVariablesHashTableType(),
3234 for (i
= 0; i
< len
; i
++) {
3235 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3239 Jim_ListIndex(interp
, staticsListObjPtr
, i
, &objPtr
, JIM_NONE
);
3240 /* Check if it's composed of two elements. */
3241 Jim_ListLength(interp
, objPtr
, &subLen
);
3242 if (subLen
== 1 || subLen
== 2) {
3243 /* Try to get the variable value from the current
3245 Jim_ListIndex(interp
, objPtr
, 0, &nameObjPtr
, JIM_NONE
);
3247 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
,
3249 if (initObjPtr
== NULL
) {
3250 Jim_SetResult(interp
,
3251 Jim_NewEmptyStringObj(interp
));
3252 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3253 "variable for initialization of static \"",
3254 Jim_GetString(nameObjPtr
, NULL
),
3255 "\" not found in the local context",
3260 Jim_ListIndex(interp
, objPtr
, 1, &initObjPtr
, JIM_NONE
);
3262 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3263 varPtr
->objPtr
= initObjPtr
;
3264 Jim_IncrRefCount(initObjPtr
);
3265 varPtr
->linkFramePtr
= NULL
;
3266 if (Jim_AddHashEntry(cmdPtr
->staticVars
,
3267 Jim_GetString(nameObjPtr
, NULL
),
3270 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
3271 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3272 "static variable name \"",
3273 Jim_GetString(objPtr
, NULL
), "\"",
3274 " duplicated in statics list", NULL
);
3275 Jim_DecrRefCount(interp
, initObjPtr
);
3280 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
3281 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3282 "too many fields in static specifier \"",
3283 objPtr
, "\"", NULL
);
3290 /* Add the new command */
3292 /* it may already exist, so we try to delete the old one */
3293 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) != JIM_ERR
) {
3294 /* There was an old procedure with the same name, this requires
3295 * a 'proc epoch' update. */
3296 Jim_InterpIncrProcEpoch(interp
);
3298 /* If a procedure with the same name didn't existed there is no need
3299 * to increment the 'proc epoch' because creation of a new procedure
3300 * can never affect existing cached commands. We don't do
3301 * negative caching. */
3302 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
3306 Jim_FreeHashTable(cmdPtr
->staticVars
);
3307 Jim_Free(cmdPtr
->staticVars
);
3308 Jim_DecrRefCount(interp
, argListObjPtr
);
3309 Jim_DecrRefCount(interp
, bodyObjPtr
);
3314 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *cmdName
)
3316 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) == JIM_ERR
)
3318 Jim_InterpIncrProcEpoch(interp
);
3322 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
,
3323 const char *newName
)
3327 Jim_Cmd
*copyCmdPtr
;
3329 if (newName
[0] == '\0') /* Delete! */
3330 return Jim_DeleteCommand(interp
, oldName
);
3332 he
= Jim_FindHashEntry(&interp
->commands
, oldName
);
3334 return JIM_ERR
; /* Invalid command name */
3336 copyCmdPtr
= Jim_Alloc(sizeof(Jim_Cmd
));
3337 *copyCmdPtr
= *cmdPtr
;
3338 /* In order to avoid that a procedure will get arglist/body/statics
3339 * freed by the hash table methods, fake a C-coded command
3340 * setting cmdPtr->cmdProc as not NULL */
3341 cmdPtr
->cmdProc
= (void*)1;
3342 /* Also make sure delProc is NULL. */
3343 cmdPtr
->delProc
= NULL
;
3344 /* Destroy the old command, and make sure the new is freed
3346 Jim_DeleteHashEntry(&interp
->commands
, oldName
);
3347 Jim_DeleteHashEntry(&interp
->commands
, newName
);
3348 /* Now the new command. We are sure it can't fail because
3349 * the target name was already freed. */
3350 Jim_AddHashEntry(&interp
->commands
, newName
, copyCmdPtr
);
3351 /* Increment the epoch */
3352 Jim_InterpIncrProcEpoch(interp
);
3356 /* -----------------------------------------------------------------------------
3358 * ---------------------------------------------------------------------------*/
3360 static int SetCommandFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3362 static Jim_ObjType commandObjType
= {
3367 JIM_TYPE_REFERENCES
,
3370 int SetCommandFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3373 const char *cmdName
;
3375 /* Get the string representation */
3376 cmdName
= Jim_GetString(objPtr
, NULL
);
3377 /* Lookup this name into the commands hash table */
3378 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
3382 /* Free the old internal repr and set the new one. */
3383 Jim_FreeIntRep(interp
, objPtr
);
3384 objPtr
->typePtr
= &commandObjType
;
3385 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
3386 objPtr
->internalRep
.cmdValue
.cmdPtr
= (void*)he
->val
;
3390 /* This function returns the command structure for the command name
3391 * stored in objPtr. It tries to specialize the objPtr to contain
3392 * a cached info instead to perform the lookup into the hash table
3393 * every time. The information cached may not be uptodate, in such
3394 * a case the lookup is performed and the cache updated. */
3395 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
3397 if ((objPtr
->typePtr
!= &commandObjType
||
3398 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
) &&
3399 SetCommandFromAny(interp
, objPtr
) == JIM_ERR
) {
3400 if (flags
& JIM_ERRMSG
) {
3401 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
3402 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3403 "invalid command name \"", objPtr
->bytes
, "\"",
3408 return objPtr
->internalRep
.cmdValue
.cmdPtr
;
3411 /* -----------------------------------------------------------------------------
3413 * ---------------------------------------------------------------------------*/
3415 /* Variables HashTable Type.
3417 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3418 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3420 Jim_Var
*varPtr
= (void*) val
;
3422 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
3426 static Jim_HashTableType JimVariablesHashTableType
= {
3427 JimStringCopyHTHashFunction
, /* hash function */
3428 JimStringCopyHTKeyDup
, /* key dup */
3430 JimStringCopyHTKeyCompare
, /* key compare */
3431 JimStringCopyHTKeyDestructor
, /* key destructor */
3432 JimVariablesHTValDestructor
/* val destructor */
3435 static Jim_HashTableType
*getJimVariablesHashTableType(void)
3437 return &JimVariablesHashTableType
;
3440 /* -----------------------------------------------------------------------------
3442 * ---------------------------------------------------------------------------*/
3444 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3446 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3448 static Jim_ObjType variableObjType
= {
3453 JIM_TYPE_REFERENCES
,
3456 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3457 * is in the form "varname(key)". */
3458 static int Jim_NameIsDictSugar(const char *str
, int len
)
3462 if (len
&& str
[len
-1] == ')' && strchr(str
, '(') != NULL
)
3467 /* This method should be called only by the variable API.
3468 * It returns JIM_OK on success (variable already exists),
3469 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3470 * a variable name, but syntax glue for [dict] i.e. the last
3471 * character is ')' */
3472 int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3475 const char *varName
;
3478 /* Check if the object is already an uptodate variable */
3479 if (objPtr
->typePtr
== &variableObjType
&&
3480 objPtr
->internalRep
.varValue
.callFrameId
== interp
->framePtr
->id
)
3481 return JIM_OK
; /* nothing to do */
3482 /* Get the string representation */
3483 varName
= Jim_GetString(objPtr
, &len
);
3484 /* Make sure it's not syntax glue to get/set dict. */
3485 if (Jim_NameIsDictSugar(varName
, len
))
3486 return JIM_DICT_SUGAR
;
3487 if (varName
[0] == ':' && varName
[1] == ':') {
3488 he
= Jim_FindHashEntry(&interp
->topFramePtr
->vars
, varName
+ 2);
3494 /* Lookup this name into the variables hash table */
3495 he
= Jim_FindHashEntry(&interp
->framePtr
->vars
, varName
);
3497 /* Try with static vars. */
3498 if (interp
->framePtr
->staticVars
== NULL
)
3500 if (!(he
= Jim_FindHashEntry(interp
->framePtr
->staticVars
, varName
)))
3504 /* Free the old internal repr and set the new one. */
3505 Jim_FreeIntRep(interp
, objPtr
);
3506 objPtr
->typePtr
= &variableObjType
;
3507 objPtr
->internalRep
.varValue
.callFrameId
= interp
->framePtr
->id
;
3508 objPtr
->internalRep
.varValue
.varPtr
= (void*)he
->val
;
3512 /* -------------------- Variables related functions ------------------------- */
3513 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
,
3514 Jim_Obj
*valObjPtr
);
3515 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
);
3517 /* For now that's dummy. Variables lookup should be optimized
3518 * in many ways, with caching of lookups, and possibly with
3519 * a table of pre-allocated vars in every CallFrame for local vars.
3520 * All the caching should also have an 'epoch' mechanism similar
3521 * to the one used by Tcl for procedures lookup caching. */
3523 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
3529 if ((err
= SetVariableFromAny(interp
, nameObjPtr
)) != JIM_OK
) {
3530 /* Check for [dict] syntax sugar. */
3531 if (err
== JIM_DICT_SUGAR
)
3532 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
3533 /* New variable to create */
3534 name
= Jim_GetString(nameObjPtr
, NULL
);
3536 var
= Jim_Alloc(sizeof(*var
));
3537 var
->objPtr
= valObjPtr
;
3538 Jim_IncrRefCount(valObjPtr
);
3539 var
->linkFramePtr
= NULL
;
3540 /* Insert the new variable */
3541 if (name
[0] == ':' && name
[1] == ':') {
3542 /* Into to the top evel frame */
3543 Jim_AddHashEntry(&interp
->topFramePtr
->vars
, name
+ 2, var
);
3546 Jim_AddHashEntry(&interp
->framePtr
->vars
, name
, var
);
3548 /* Make the object int rep a variable */
3549 Jim_FreeIntRep(interp
, nameObjPtr
);
3550 nameObjPtr
->typePtr
= &variableObjType
;
3551 nameObjPtr
->internalRep
.varValue
.callFrameId
=
3552 interp
->framePtr
->id
;
3553 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
3555 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
3556 if (var
->linkFramePtr
== NULL
) {
3557 Jim_IncrRefCount(valObjPtr
);
3558 Jim_DecrRefCount(interp
, var
->objPtr
);
3559 var
->objPtr
= valObjPtr
;
3560 } else { /* Else handle the link */
3561 Jim_CallFrame
*savedCallFrame
;
3563 savedCallFrame
= interp
->framePtr
;
3564 interp
->framePtr
= var
->linkFramePtr
;
3565 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
3566 interp
->framePtr
= savedCallFrame
;
3574 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
3576 Jim_Obj
*nameObjPtr
;
3579 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3580 Jim_IncrRefCount(nameObjPtr
);
3581 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
3582 Jim_DecrRefCount(interp
, nameObjPtr
);
3586 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
3588 Jim_CallFrame
*savedFramePtr
;
3591 savedFramePtr
= interp
->framePtr
;
3592 interp
->framePtr
= interp
->topFramePtr
;
3593 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
3594 interp
->framePtr
= savedFramePtr
;
3598 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
3600 Jim_Obj
*nameObjPtr
, *valObjPtr
;
3603 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3604 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
3605 Jim_IncrRefCount(nameObjPtr
);
3606 Jim_IncrRefCount(valObjPtr
);
3607 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
3608 Jim_DecrRefCount(interp
, nameObjPtr
);
3609 Jim_DecrRefCount(interp
, valObjPtr
);
3613 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
3614 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
3616 const char *varName
;
3619 /* Check for cycles. */
3620 if (interp
->framePtr
== targetCallFrame
) {
3621 Jim_Obj
*objPtr
= targetNameObjPtr
;
3623 /* Cycles are only possible with 'uplevel 0' */
3625 if (Jim_StringEqObj(objPtr
, nameObjPtr
, 0)) {
3626 Jim_SetResultString(interp
,
3627 "can't upvar from variable to itself", -1);
3630 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
3632 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
3633 if (varPtr
->linkFramePtr
!= targetCallFrame
) break;
3634 objPtr
= varPtr
->objPtr
;
3637 varName
= Jim_GetString(nameObjPtr
, &len
);
3638 if (Jim_NameIsDictSugar(varName
, len
)) {
3639 Jim_SetResultString(interp
,
3640 "Dict key syntax invalid as link source", -1);
3643 /* Perform the binding */
3644 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
3645 /* We are now sure 'nameObjPtr' type is variableObjType */
3646 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
3650 /* Return the Jim_Obj pointer associated with a variable name,
3651 * or NULL if the variable was not found in the current context.
3652 * The same optimization discussed in the comment to the
3653 * 'SetVariable' function should apply here. */
3654 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
3658 /* All the rest is handled here */
3659 if ((err
= SetVariableFromAny(interp
, nameObjPtr
)) != JIM_OK
) {
3660 /* Check for [dict] syntax sugar. */
3661 if (err
== JIM_DICT_SUGAR
)
3662 return JimDictSugarGet(interp
, nameObjPtr
);
3663 if (flags
& JIM_ERRMSG
) {
3664 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
3665 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3666 "can't read \"", nameObjPtr
->bytes
,
3667 "\": no such variable", NULL
);
3673 Jim_CallFrame
*savedCallFrame
;
3675 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
3676 if (varPtr
->linkFramePtr
== NULL
)
3677 return varPtr
->objPtr
;
3678 /* The variable is a link? Resolve it. */
3679 savedCallFrame
= interp
->framePtr
;
3680 interp
->framePtr
= varPtr
->linkFramePtr
;
3681 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
3682 if (objPtr
== NULL
&& flags
& JIM_ERRMSG
) {
3683 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
3684 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
3685 "can't read \"", nameObjPtr
->bytes
,
3686 "\": no such variable", NULL
);
3688 interp
->framePtr
= savedCallFrame
;
3693 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
3696 Jim_CallFrame
*savedFramePtr
;
3699 savedFramePtr
= interp
->framePtr
;
3700 interp
->framePtr
= interp
->topFramePtr
;
3701 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
3702 interp
->framePtr
= savedFramePtr
;
3707 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
3709 Jim_Obj
*nameObjPtr
, *varObjPtr
;
3711 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3712 Jim_IncrRefCount(nameObjPtr
);
3713 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
3714 Jim_DecrRefCount(interp
, nameObjPtr
);
3718 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
,
3721 Jim_CallFrame
*savedFramePtr
;
3724 savedFramePtr
= interp
->framePtr
;