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,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
53 #include <pkgconf/jimtcl.h>
57 typedef CYG_ADDRWORD
intptr_t;
68 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
69 #endif /* JIM_ANSIC */
74 /* Include the platform dependent libraries for
75 * dynamic loading of libraries. */
77 #if defined(_WIN32) || defined(WIN32)
84 #define WIN32_LEAN_AND_MEAN
87 #pragma warning(disable:4146)
92 #endif /* JIM_DYNLIB */
95 #include <cyg/jimtcl/jim.h>
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
104 /* -----------------------------------------------------------------------------
106 * ---------------------------------------------------------------------------*/
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep
= (char*) "";
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
);
116 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
);
117 static void JimRegisterCoreApi(Jim_Interp
*interp
);
119 static Jim_HashTableType
*getJimVariablesHashTableType(void);
121 /* -----------------------------------------------------------------------------
123 * ---------------------------------------------------------------------------*/
126 jim_vasprintf(const char *fmt
, va_list ap
)
128 #ifndef HAVE_VASPRINTF
130 static char buf
[2048];
131 vsnprintf(buf
, sizeof(buf
), fmt
, ap
);
132 /* garentee termination */
133 buf
[sizeof(buf
)-1] = 0;
137 result
= vasprintf(&buf
, fmt
, ap
);
138 if (result
< 0) exit(-1);
144 jim_vasprintf_done(void *buf
)
146 #ifndef HAVE_VASPRINTF
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
161 #ifdef HAVE_LONG_LONG_INT
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide
JimStrtoll(const char *nptr
, char **endptr
, register int base
)
165 register const char *s
;
166 register unsigned jim_wide acc
;
167 register unsigned char c
;
168 register unsigned jim_wide qbase
, cutoff
;
169 register int neg
, any
, cutlim
;
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
179 } while (isspace(c
));
188 if ((base
== 0 || base
== 16) &&
189 c
== '0' && (*s
== 'x' || *s
== 'X')) {
195 base
= c
== '0' ? 8 : 10;
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
212 * Set any if any `digits' consumed; make it negative to indicate
215 qbase
= (unsigned)base
;
216 cutoff
= neg
? (unsigned jim_wide
)-(LLONG_MIN
+ LLONG_MAX
) + LLONG_MAX
218 cutlim
= (int)(cutoff
% qbase
);
220 for (acc
= 0, any
= 0;; c
= *s
++) {
226 c
-= isupper(c
) ? 'A' - 10 : 'a' - 10;
231 if (any
< 0 || acc
> cutoff
|| (acc
== cutoff
&& c
> cutlim
))
240 acc
= neg
? LLONG_MIN
: LLONG_MAX
;
245 *endptr
= (char *)(any
? s
- 1 : nptr
);
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern
, int patternLen
,
252 const char *string
, int stringLen
, int nocase
)
255 switch (pattern
[0]) {
257 while (pattern
[1] == '*') {
262 return 1; /* match */
264 if (JimStringMatch(pattern
+ 1, patternLen
-1,
265 string
, stringLen
, nocase
))
266 return 1; /* match */
270 return 0; /* no match */
274 return 0; /* no match */
284 not = pattern
[0] == '^';
291 if (pattern
[0] == '\\') {
294 if (pattern
[0] == string
[0])
296 } else if (pattern
[0] == ']') {
298 } else if (patternLen
== 0) {
302 } else if (pattern
[1] == '-' && patternLen
>= 3) {
303 int start
= pattern
[0];
304 int end
= pattern
[2];
312 start
= tolower(start
);
318 if (c
>= start
&& c
<= end
)
322 if (pattern
[0] == string
[0])
325 if (tolower((int)pattern
[0]) == tolower((int)string
[0]))
335 return 0; /* no match */
341 if (patternLen
>= 2) {
348 if (pattern
[0] != string
[0])
349 return 0; /* no match */
351 if (tolower((int)pattern
[0]) != tolower((int)string
[0]))
352 return 0; /* no match */
360 if (stringLen
== 0) {
361 while (*pattern
== '*') {
368 if (patternLen
== 0 && stringLen
== 0)
373 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
,
376 unsigned char *u1
= (unsigned char*) s1
, *u2
= (unsigned char*) s2
;
382 u1
++; u2
++; l1
--; l2
--;
384 if (!l1
&& !l2
) return 0;
388 if (tolower((int)*u1
) != tolower((int)*u2
))
389 return tolower((int)*u1
)-tolower((int)*u2
);
390 u1
++; u2
++; l1
--; l2
--;
392 if (!l1
&& !l2
) return 0;
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int index_t
)
404 if (!l1
|| !l2
|| l1
> l2
) return -1;
405 if (index_t
< 0) index_t
= 0;
407 for (i
= index_t
; i
<= l2
-l1
; i
++) {
408 if (memcmp(s2
, s1
, l1
) == 0)
415 static int Jim_WideToString(char *buf
, jim_wide wideValue
)
417 const char *fmt
= "%" JIM_WIDE_MODIFIER
;
418 return sprintf(buf
, fmt
, wideValue
);
421 static int Jim_StringToWide(const char *str
, jim_wide
*widePtr
, int base
)
425 #ifdef HAVE_LONG_LONG_INT
426 *widePtr
= JimStrtoll(str
, &endptr
, base
);
428 *widePtr
= strtol(str
, &endptr
, base
);
430 if ((str
[0] == '\0') || (str
== endptr
))
432 if (endptr
[0] != '\0') {
434 if (!isspace((int)*endptr
))
442 static int Jim_StringToIndex(const char *str
, int *intPtr
)
446 *intPtr
= strtol(str
, &endptr
, 10);
447 if ((str
[0] == '\0') || (str
== endptr
))
449 if (endptr
[0] != '\0') {
451 if (!isspace((int)*endptr
))
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
466 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
468 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, jim_wide id
)
470 const char *fmt
= "<reference.<%s>.%020" JIM_WIDE_MODIFIER
">";
471 sprintf(buf
, fmt
, refPtr
->tag
, id
);
472 return JIM_REFERENCE_SPACE
;
475 static int Jim_DoubleToString(char *buf
, double doubleValue
)
480 len
= sprintf(buf
, "%.17g", doubleValue
);
483 if (*s
== '.') return len
;
486 /* Add a final ".0" if it's a number. But not
488 if (isdigit((int)buf
[0])
489 || ((buf
[0] == '-' || buf
[0] == '+')
490 && isdigit((int)buf
[1]))) {
499 static int Jim_StringToDouble(const char *str
, double *doublePtr
)
503 *doublePtr
= strtod(str
, &endptr
);
504 if (str
[0] == '\0' || endptr
[0] != '\0' || (str
== endptr
))
509 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
512 if ((b
== 0 && e
!= 0) || (e
< 0)) return 0;
513 for (i
= 0; i
< e
; i
++) {res
*= b
;}
517 /* -----------------------------------------------------------------------------
519 * ---------------------------------------------------------------------------*/
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp
*interp
, const char *fmt
, ...)
530 * Send it here first.. Assuming STDIO still works
532 fprintf(stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
533 vfprintf(stderr
, fmt
, ap
);
534 fprintf(stderr
, JIM_NL JIM_NL
);
537 #ifdef HAVE_BACKTRACE
543 size
= backtrace(array
, 40);
544 strings
= backtrace_symbols(array
, size
);
545 for (i
= 0; i
< size
; i
++)
546 fprintf(fp
,"[backtrace] %s" JIM_NL
, strings
[i
]);
547 fprintf(fp
,"[backtrace] Include the above lines and the output" JIM_NL
);
548 fprintf(fp
,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL
);
552 /* This may actually crash... we do it last */
553 if (interp
&& interp
->cookie_stderr
) {
554 Jim_fprintf(interp
, interp
->cookie_stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
555 Jim_vfprintf(interp
, interp
->cookie_stderr
, fmt
, ap
);
556 Jim_fprintf(interp
, interp
->cookie_stderr
, JIM_NL JIM_NL
);
561 /* -----------------------------------------------------------------------------
563 * ---------------------------------------------------------------------------*/
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
574 void *Jim_Alloc(int size
)
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
579 void *p
= malloc(size
);
581 Jim_Panic(NULL
,"malloc: Out of memory");
585 void Jim_Free(void *ptr
) {
589 static void *Jim_Realloc(void *ptr
, int size
)
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
594 void *p
= realloc(ptr
, size
);
596 Jim_Panic(NULL
,"realloc: Out of memory");
600 char *Jim_StrDup(const char *s
)
603 char *copy
= Jim_Alloc(l
+ 1);
605 memcpy(copy
, s
, l
+ 1);
609 static char *Jim_StrDupLen(const char *s
, int l
)
611 char *copy
= Jim_Alloc(l
+ 1);
613 memcpy(copy
, s
, l
+ 1);
614 copy
[l
] = 0; /* Just to be sure, original could be substring */
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide
JimClock(void)
624 #if (defined WIN32) && !(defined JIM_ANSIC)
626 QueryPerformanceFrequency(&f
);
627 QueryPerformanceCounter(&t
);
628 return (long)((t
.QuadPart
* 1000000) / f
.QuadPart
);
630 clock_t clocks
= clock();
632 return (long)(clocks
*(1000000/CLOCKS_PER_SEC
));
636 /* -----------------------------------------------------------------------------
638 * ---------------------------------------------------------------------------*/
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
642 static unsigned int JimHashTableNextPower(unsigned int size
);
643 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
);
645 /* -------------------------- hash functions -------------------------------- */
647 /* Thomas Wang's 32 bit Mix Function */
648 static unsigned int Jim_IntHashFunction(unsigned int key
)
659 /* Identity hash function for integer keys */
660 unsigned int Jim_IdentityHashFunction(unsigned int key
)
665 /* Generic hash function (we are using to multiply by 9 and add the byte
667 static unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
671 h
+= (h
<< 3)+*buf
++;
675 /* ----------------------------- API implementation ------------------------- */
676 /* reset an hashtable already initialized with ht_init().
677 * NOTE: This function should only called by ht_destroy(). */
678 static void JimResetHashTable(Jim_HashTable
*ht
)
687 /* Initialize the hash table */
688 int Jim_InitHashTable(Jim_HashTable
*ht
, Jim_HashTableType
*type
,
691 JimResetHashTable(ht
);
693 ht
->privdata
= privDataPtr
;
697 /* Resize the table to the minimal size that contains all the elements,
698 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
699 int Jim_ResizeHashTable(Jim_HashTable
*ht
)
701 int minimal
= ht
->used
;
703 if (minimal
< JIM_HT_INITIAL_SIZE
)
704 minimal
= JIM_HT_INITIAL_SIZE
;
705 return Jim_ExpandHashTable(ht
, minimal
);
708 /* Expand or create the hashtable */
709 int Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
711 Jim_HashTable n
; /* the new hashtable */
712 unsigned int realsize
= JimHashTableNextPower(size
), i
;
714 /* the size is invalid if it is smaller than the number of
715 * elements already inside the hashtable */
716 if (ht
->used
>= size
)
719 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
721 n
.sizemask
= realsize
-1;
722 n
.table
= Jim_Alloc(realsize
*sizeof(Jim_HashEntry
*));
724 /* Initialize all the pointers to NULL */
725 memset(n
.table
, 0, realsize
*sizeof(Jim_HashEntry
*));
727 /* Copy all the elements from the old to the new table:
728 * note that if the old hash table is empty ht->size is zero,
729 * so Jim_ExpandHashTable just creates an hash table. */
731 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
732 Jim_HashEntry
*he
, *nextHe
;
734 if (ht
->table
[i
] == NULL
) continue;
736 /* For each hash entry on this slot... */
742 /* Get the new element index */
743 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
744 he
->next
= n
.table
[h
];
747 /* Pass to the next element */
751 assert(ht
->used
== 0);
754 /* Remap the new hashtable in the old */
759 /* Add an element to the target hash table */
760 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
763 Jim_HashEntry
*entry
;
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index_t
= JimInsertHashEntry(ht
, key
)) == -1)
770 /* Allocates the memory and stores key */
771 entry
= Jim_Alloc(sizeof(*entry
));
772 entry
->next
= ht
->table
[index_t
];
773 ht
->table
[index_t
] = entry
;
775 /* Set the hash entry fields. */
776 Jim_SetHashKey(ht
, entry
, key
);
777 Jim_SetHashVal(ht
, entry
, val
);
782 /* Add an element, discarding the old if the key already exists */
783 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
785 Jim_HashEntry
*entry
;
787 /* Try to add the element. If the key
788 * does not exists Jim_AddHashEntry will suceed. */
789 if (Jim_AddHashEntry(ht
, key
, val
) == JIM_OK
)
791 /* It already exists, get the entry */
792 entry
= Jim_FindHashEntry(ht
, key
);
793 /* Free the old value and set the new one */
794 Jim_FreeEntryVal(ht
, entry
);
795 Jim_SetHashVal(ht
, entry
, val
);
799 /* Search and remove an element */
800 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
803 Jim_HashEntry
*he
, *prevHe
;
807 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
812 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
813 /* Unlink the element from the list */
815 prevHe
->next
= he
->next
;
817 ht
->table
[h
] = he
->next
;
818 Jim_FreeEntryKey(ht
, he
);
819 Jim_FreeEntryVal(ht
, he
);
827 return JIM_ERR
; /* not found */
830 /* Destroy an entire hash table */
831 int Jim_FreeHashTable(Jim_HashTable
*ht
)
835 /* Free all the elements */
836 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
837 Jim_HashEntry
*he
, *nextHe
;
839 if ((he
= ht
->table
[i
]) == NULL
) continue;
842 Jim_FreeEntryKey(ht
, he
);
843 Jim_FreeEntryVal(ht
, he
);
849 /* Free the table and the allocated cache structure */
851 /* Re-initialize the table */
852 JimResetHashTable(ht
);
853 return JIM_OK
; /* never fails */
856 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
861 if (ht
->size
== 0) return NULL
;
862 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
865 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
872 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
874 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
879 iter
->nextEntry
= NULL
;
883 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
886 if (iter
->entry
== NULL
) {
889 (signed)iter
->ht
->size
) break;
890 iter
->entry
= iter
->ht
->table
[iter
->index
];
892 iter
->entry
= iter
->nextEntry
;
895 /* We need to save the 'next' here, the iterator user
896 * may delete the entry we are returning. */
897 iter
->nextEntry
= iter
->entry
->next
;
904 /* ------------------------- private functions ------------------------------ */
906 /* Expand the hash table if needed */
907 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
909 /* If the hash table is empty expand it to the intial size,
910 * if the table is "full" dobule its size. */
912 return Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
913 if (ht
->size
== ht
->used
)
914 return Jim_ExpandHashTable(ht
, ht
->size
*2);
918 /* Our hash table capability is a power of two */
919 static unsigned int JimHashTableNextPower(unsigned int size
)
921 unsigned int i
= JIM_HT_INITIAL_SIZE
;
923 if (size
>= 2147483648U)
932 /* Returns the index of a free slot that can be populated with
933 * an hash entry for the given 'key'.
934 * If the key already exists, -1 is returned. */
935 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
)
940 /* Expand the hashtable if needed */
941 if (JimExpandHashTableIfNeeded(ht
) == JIM_ERR
)
943 /* Compute the key hash value */
944 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
945 /* Search if this slot does not already contain the given key */
948 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
955 /* ----------------------- StringCopy Hash Table Type ------------------------*/
957 static unsigned int JimStringCopyHTHashFunction(const void *key
)
959 return Jim_GenHashFunction(key
, strlen(key
));
962 static const void *JimStringCopyHTKeyDup(void *privdata
, const void *key
)
964 int len
= strlen(key
);
965 char *copy
= Jim_Alloc(len
+ 1);
966 JIM_NOTUSED(privdata
);
968 memcpy(copy
, key
, len
);
973 static void *JimStringKeyValCopyHTValDup(void *privdata
, const void *val
)
975 int len
= strlen(val
);
976 char *copy
= Jim_Alloc(len
+ 1);
977 JIM_NOTUSED(privdata
);
979 memcpy(copy
, val
, len
);
984 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
,
987 JIM_NOTUSED(privdata
);
989 return strcmp(key1
, key2
) == 0;
992 static void JimStringCopyHTKeyDestructor(void *privdata
, const void *key
)
994 JIM_NOTUSED(privdata
);
996 Jim_Free((void*)key
); /* ATTENTION: const cast */
999 static void JimStringKeyValCopyHTValDestructor(void *privdata
, void *val
)
1001 JIM_NOTUSED(privdata
);
1003 Jim_Free((void*)val
); /* ATTENTION: const cast */
1006 static Jim_HashTableType JimStringCopyHashTableType
= {
1007 JimStringCopyHTHashFunction
, /* hash function */
1008 JimStringCopyHTKeyDup
, /* key dup */
1010 JimStringCopyHTKeyCompare
, /* key compare */
1011 JimStringCopyHTKeyDestructor
, /* key destructor */
1012 NULL
/* val destructor */
1015 /* This is like StringCopy but does not auto-duplicate the key.
1016 * It's used for intepreter's shared strings. */
1017 static Jim_HashTableType JimSharedStringsHashTableType
= {
1018 JimStringCopyHTHashFunction
, /* hash function */
1021 JimStringCopyHTKeyCompare
, /* key compare */
1022 JimStringCopyHTKeyDestructor
, /* key destructor */
1023 NULL
/* val destructor */
1026 /* This is like StringCopy but also automatically handle dynamic
1027 * allocated C strings as values. */
1028 static Jim_HashTableType JimStringKeyValCopyHashTableType
= {
1029 JimStringCopyHTHashFunction
, /* hash function */
1030 JimStringCopyHTKeyDup
, /* key dup */
1031 JimStringKeyValCopyHTValDup
, /* val dup */
1032 JimStringCopyHTKeyCompare
, /* key compare */
1033 JimStringCopyHTKeyDestructor
, /* key destructor */
1034 JimStringKeyValCopyHTValDestructor
, /* val destructor */
1037 typedef struct AssocDataValue
{
1038 Jim_InterpDeleteProc
*delProc
;
1042 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1044 AssocDataValue
*assocPtr
= (AssocDataValue
*)data
;
1045 if (assocPtr
->delProc
!= NULL
)
1046 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1050 static Jim_HashTableType JimAssocDataHashTableType
= {
1051 JimStringCopyHTHashFunction
, /* hash function */
1052 JimStringCopyHTKeyDup
, /* key dup */
1054 JimStringCopyHTKeyCompare
, /* key compare */
1055 JimStringCopyHTKeyDestructor
, /* key destructor */
1056 JimAssocDataHashTableValueDestructor
/* val destructor */
1059 /* -----------------------------------------------------------------------------
1060 * Stack - This is a simple generic stack implementation. It is used for
1061 * example in the 'expr' expression compiler.
1062 * ---------------------------------------------------------------------------*/
1063 void Jim_InitStack(Jim_Stack
*stack
)
1067 stack
->vector
= NULL
;
1070 void Jim_FreeStack(Jim_Stack
*stack
)
1072 Jim_Free(stack
->vector
);
1075 int Jim_StackLen(Jim_Stack
*stack
)
1080 void Jim_StackPush(Jim_Stack
*stack
, void *element
) {
1081 int neededLen
= stack
->len
+ 1;
1082 if (neededLen
> stack
->maxlen
) {
1083 stack
->maxlen
= neededLen
*2;
1084 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void*)*stack
->maxlen
);
1086 stack
->vector
[stack
->len
] = element
;
1090 void *Jim_StackPop(Jim_Stack
*stack
)
1092 if (stack
->len
== 0) return NULL
;
1094 return stack
->vector
[stack
->len
];
1097 void *Jim_StackPeek(Jim_Stack
*stack
)
1099 if (stack
->len
== 0) return NULL
;
1100 return stack
->vector
[stack
->len
-1];
1103 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
)(void *ptr
))
1107 for (i
= 0; i
< stack
->len
; i
++)
1108 freeFunc(stack
->vector
[i
]);
1111 /* -----------------------------------------------------------------------------
1113 * ---------------------------------------------------------------------------*/
1116 #define JIM_TT_NONE -1 /* No token returned */
1117 #define JIM_TT_STR 0 /* simple string */
1118 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1119 #define JIM_TT_VAR 2 /* var substitution */
1120 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1121 #define JIM_TT_CMD 4 /* command substitution */
1122 #define JIM_TT_SEP 5 /* word separator */
1123 #define JIM_TT_EOL 6 /* line separator */
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 7
1127 #define JIM_TT_SUBEXPR_END 8
1128 #define JIM_TT_EXPR_NUMBER 9
1129 #define JIM_TT_EXPR_OPERATOR 10
1132 #define JIM_PS_DEF 0 /* Default state */
1133 #define JIM_PS_QUOTE 1 /* Inside "" */
1135 /* Parser context structure. The same context is used both to parse
1136 * Tcl scripts and lists. */
1137 struct JimParserCtx
{
1138 const char *prg
; /* Program text */
1139 const char *p
; /* Pointer to the point of the program we are parsing */
1140 int len
; /* Left length of 'prg' */
1141 int linenr
; /* Current line number */
1143 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1144 int tline
; /* Line number of the returned token */
1145 int tt
; /* Token type */
1146 int eof
; /* Non zero if EOF condition is true. */
1147 int state
; /* Parser state */
1148 int comment
; /* Non zero if the next chars may be a comment. */
1151 #define JimParserEof(c) ((c)->eof)
1152 #define JimParserTstart(c) ((c)->tstart)
1153 #define JimParserTend(c) ((c)->tend)
1154 #define JimParserTtype(c) ((c)->tt)
1155 #define JimParserTline(c) ((c)->tline)
1157 static int JimParseScript(struct JimParserCtx
*pc
);
1158 static int JimParseSep(struct JimParserCtx
*pc
);
1159 static int JimParseEol(struct JimParserCtx
*pc
);
1160 static int JimParseCmd(struct JimParserCtx
*pc
);
1161 static int JimParseVar(struct JimParserCtx
*pc
);
1162 static int JimParseBrace(struct JimParserCtx
*pc
);
1163 static int JimParseStr(struct JimParserCtx
*pc
);
1164 static int JimParseComment(struct JimParserCtx
*pc
);
1165 static char *JimParserGetToken(struct JimParserCtx
*pc
,
1166 int *lenPtr
, int *typePtr
, int *linePtr
);
1168 /* Initialize a parser context.
1169 * 'prg' is a pointer to the program text, linenr is the line
1170 * number of the first line contained in the program. */
1171 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
,
1172 int len
, int linenr
)
1180 pc
->tt
= JIM_TT_NONE
;
1182 pc
->state
= JIM_PS_DEF
;
1183 pc
->linenr
= linenr
;
1187 int JimParseScript(struct JimParserCtx
*pc
)
1189 while (1) { /* the while is used to reiterate with continue if needed */
1193 pc
->tline
= pc
->linenr
;
1194 pc
->tt
= JIM_TT_EOL
;
1200 if (*(pc
->p
+ 1) == '\n')
1201 return JimParseSep(pc
);
1204 return JimParseStr(pc
);
1210 if (pc
->state
== JIM_PS_DEF
)
1211 return JimParseSep(pc
);
1214 return JimParseStr(pc
);
1220 if (pc
->state
== JIM_PS_DEF
)
1221 return JimParseEol(pc
);
1223 return JimParseStr(pc
);
1227 return JimParseCmd(pc
);
1231 if (JimParseVar(pc
) == JIM_ERR
) {
1232 pc
->tstart
= pc
->tend
= pc
->p
++; pc
->len
--;
1233 pc
->tline
= pc
->linenr
;
1234 pc
->tt
= JIM_TT_STR
;
1241 JimParseComment(pc
);
1244 return JimParseStr(pc
);
1248 return JimParseStr(pc
);
1255 int JimParseSep(struct JimParserCtx
*pc
)
1258 pc
->tline
= pc
->linenr
;
1259 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' ||
1260 (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1261 if (*pc
->p
== '\\') {
1268 pc
->tt
= JIM_TT_SEP
;
1272 int JimParseEol(struct JimParserCtx
*pc
)
1275 pc
->tline
= pc
->linenr
;
1276 while (*pc
->p
== ' ' || *pc
->p
== '\n' ||
1277 *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== ';') {
1283 pc
->tt
= JIM_TT_EOL
;
1287 /* Todo. Don't stop if ']' appears inside {} or quoted.
1288 * Also should handle the case of puts [string length "]"] */
1289 int JimParseCmd(struct JimParserCtx
*pc
)
1294 pc
->tstart
= ++pc
->p
; pc
->len
--;
1295 pc
->tline
= pc
->linenr
;
1299 } else if (*pc
->p
== '[' && blevel
== 0) {
1301 } else if (*pc
->p
== ']' && blevel
== 0) {
1304 } else if (*pc
->p
== '\\') {
1306 } else if (*pc
->p
== '{') {
1308 } else if (*pc
->p
== '}') {
1311 } else if (*pc
->p
== '\n')
1316 pc
->tt
= JIM_TT_CMD
;
1317 if (*pc
->p
== ']') {
1323 int JimParseVar(struct JimParserCtx
*pc
)
1325 int brace
= 0, stop
= 0, ttype
= JIM_TT_VAR
;
1327 pc
->tstart
= ++pc
->p
; pc
->len
--; /* skip the $ */
1328 pc
->tline
= pc
->linenr
;
1329 if (*pc
->p
== '{') {
1330 pc
->tstart
= ++pc
->p
; pc
->len
--;
1335 if (*pc
->p
== '}' || pc
->len
== 0) {
1341 else if (*pc
->p
== '\n')
1346 /* Include leading colons */
1347 while (*pc
->p
== ':') {
1352 if (!((*pc
->p
>= 'a' && *pc
->p
<= 'z') ||
1353 (*pc
->p
>= 'A' && *pc
->p
<= 'Z') ||
1354 (*pc
->p
>= '0' && *pc
->p
<= '9') || *pc
->p
== '_'))
1360 /* Parse [dict get] syntax sugar. */
1361 if (*pc
->p
== '(') {
1362 while (*pc
->p
!= ')' && pc
->len
) {
1364 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1365 pc
->p
+= 2; pc
->len
-= 2;
1368 if (*pc
->p
!= '\0') {
1371 ttype
= JIM_TT_DICTSUGAR
;
1375 /* Check if we parsed just the '$' character.
1376 * That's not a variable so an error is returned
1377 * to tell the state machine to consider this '$' just
1379 if (pc
->tstart
== pc
->p
) {
1387 int JimParseBrace(struct JimParserCtx
*pc
)
1391 pc
->tstart
= ++pc
->p
; pc
->len
--;
1392 pc
->tline
= pc
->linenr
;
1394 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1398 } else if (*pc
->p
== '{') {
1400 } else if (pc
->len
== 0 || *pc
->p
== '}') {
1402 if (pc
->len
== 0 || level
== 0) {
1407 pc
->tt
= JIM_TT_STR
;
1410 } else if (*pc
->p
== '\n') {
1415 return JIM_OK
; /* unreached */
1418 int JimParseStr(struct JimParserCtx
*pc
)
1420 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1421 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
);
1422 if (newword
&& *pc
->p
== '{') {
1423 return JimParseBrace(pc
);
1424 } else if (newword
&& *pc
->p
== '"') {
1425 pc
->state
= JIM_PS_QUOTE
;
1429 pc
->tline
= pc
->linenr
;
1433 pc
->tt
= JIM_TT_ESC
;
1438 if (pc
->state
== JIM_PS_DEF
&&
1439 *(pc
->p
+ 1) == '\n') {
1441 pc
->tt
= JIM_TT_ESC
;
1451 pc
->tt
= JIM_TT_ESC
;
1458 if (pc
->state
== JIM_PS_DEF
) {
1460 pc
->tt
= JIM_TT_ESC
;
1462 } else if (*pc
->p
== '\n') {
1467 if (pc
->state
== JIM_PS_QUOTE
) {
1469 pc
->tt
= JIM_TT_ESC
;
1471 pc
->state
= JIM_PS_DEF
;
1478 return JIM_OK
; /* unreached */
1481 int JimParseComment(struct JimParserCtx
*pc
)
1484 if (*pc
->p
== '\n') {
1486 if (*(pc
->p
-1) != '\\') {
1496 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1497 static int xdigitval(int c
)
1499 if (c
>= '0' && c
<= '9') return c
-'0';
1500 if (c
>= 'a' && c
<= 'f') return c
-'a'+10;
1501 if (c
>= 'A' && c
<= 'F') return c
-'A'+10;
1505 static int odigitval(int c
)
1507 if (c
>= '0' && c
<= '7') return c
-'0';
1511 /* Perform Tcl escape substitution of 's', storing the result
1512 * string into 'dest'. The escaped string is guaranteed to
1513 * be the same length or shorted than the source string.
1514 * Slen is the length of the string at 's', if it's -1 the string
1515 * length will be calculated by the function.
1517 * The function returns the length of the resulting string. */
1518 static int JimEscape(char *dest
, const char *s
, int slen
)
1526 for (i
= 0; i
< slen
; i
++) {
1530 case 'a': *p
++ = 0x7; i
++; break;
1531 case 'b': *p
++ = 0x8; i
++; break;
1532 case 'f': *p
++ = 0xc; i
++; break;
1533 case 'n': *p
++ = 0xa; i
++; break;
1534 case 'r': *p
++ = 0xd; i
++; break;
1535 case 't': *p
++ = 0x9; i
++; break;
1536 case 'v': *p
++ = 0xb; i
++; break;
1537 case '\0': *p
++ = '\\'; i
++; break;
1538 case '\n': *p
++ = ' '; i
++; break;
1540 if (s
[i
+ 1] == 'x') {
1542 int c
= xdigitval(s
[i
+ 2]);
1549 c
= xdigitval(s
[i
+ 3]);
1559 } else if (s
[i
+ 1] >= '0' && s
[i
+ 1] <= '7')
1562 int c
= odigitval(s
[i
+ 1]);
1564 c
= odigitval(s
[i
+ 2]);
1571 c
= odigitval(s
[i
+ 3]);
1597 /* Returns a dynamically allocated copy of the current token in the
1598 * parser context. The function perform conversion of escapes if
1599 * the token is of type JIM_TT_ESC.
1601 * Note that after the conversion, tokens that are grouped with
1602 * braces in the source code, are always recognizable from the
1603 * identical string obtained in a different way from the type.
1605 * For exmple the string:
1609 * will return as first token "expand", of type JIM_TT_STR
1615 * will return as first token "expand", of type JIM_TT_ESC
1617 char *JimParserGetToken(struct JimParserCtx
*pc
,
1618 int *lenPtr
, int *typePtr
, int *linePtr
)
1620 const char *start
, *end
;
1624 start
= JimParserTstart(pc
);
1625 end
= JimParserTend(pc
);
1627 if (lenPtr
) *lenPtr
= 0;
1628 if (typePtr
) *typePtr
= JimParserTtype(pc
);
1629 if (linePtr
) *linePtr
= JimParserTline(pc
);
1630 token
= Jim_Alloc(1);
1634 len
= (end
-start
) + 1;
1635 token
= Jim_Alloc(len
+ 1);
1636 if (JimParserTtype(pc
) != JIM_TT_ESC
) {
1637 /* No escape conversion needed? Just copy it. */
1638 memcpy(token
, start
, len
);
1641 /* Else convert the escape chars. */
1642 len
= JimEscape(token
, start
, len
);
1644 if (lenPtr
) *lenPtr
= len
;
1645 if (typePtr
) *typePtr
= JimParserTtype(pc
);
1646 if (linePtr
) *linePtr
= JimParserTline(pc
);
1650 /* The following functin is not really part of the parsing engine of Jim,
1651 * but it somewhat related. Given an string and its length, it tries
1652 * to guess if the script is complete or there are instead " " or { }
1653 * open and not completed. This is useful for interactive shells
1654 * implementation and for [info complete].
1656 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1657 * '{' on scripts incomplete missing one or more '}' to be balanced.
1658 * '"' on scripts incomplete missing a '"' char.
1660 * If the script is complete, 1 is returned, otherwise 0. */
1661 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
1675 } else if (state
== '"') {
1682 } else if (state
== ' ') {
1699 *stateCharPtr
= state
;
1700 return state
== ' ';
1703 /* -----------------------------------------------------------------------------
1705 * ---------------------------------------------------------------------------*/
1706 static int JimParseListSep(struct JimParserCtx
*pc
);
1707 static int JimParseListStr(struct JimParserCtx
*pc
);
1709 static int JimParseList(struct JimParserCtx
*pc
)
1712 pc
->tstart
= pc
->tend
= pc
->p
;
1713 pc
->tline
= pc
->linenr
;
1714 pc
->tt
= JIM_TT_EOL
;
1723 if (pc
->state
== JIM_PS_DEF
)
1724 return JimParseListSep(pc
);
1726 return JimParseListStr(pc
);
1729 return JimParseListStr(pc
);
1735 int JimParseListSep(struct JimParserCtx
*pc
)
1738 pc
->tline
= pc
->linenr
;
1739 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== '\n')
1744 pc
->tt
= JIM_TT_SEP
;
1748 int JimParseListStr(struct JimParserCtx
*pc
)
1750 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1751 pc
->tt
== JIM_TT_NONE
);
1752 if (newword
&& *pc
->p
== '{') {
1753 return JimParseBrace(pc
);
1754 } else if (newword
&& *pc
->p
== '"') {
1755 pc
->state
= JIM_PS_QUOTE
;
1759 pc
->tline
= pc
->linenr
;
1763 pc
->tt
= JIM_TT_ESC
;
1774 if (pc
->state
== JIM_PS_DEF
) {
1776 pc
->tt
= JIM_TT_ESC
;
1778 } else if (*pc
->p
== '\n') {
1783 if (pc
->state
== JIM_PS_QUOTE
) {
1785 pc
->tt
= JIM_TT_ESC
;
1787 pc
->state
= JIM_PS_DEF
;
1794 return JIM_OK
; /* unreached */
1797 /* -----------------------------------------------------------------------------
1798 * Jim_Obj related functions
1799 * ---------------------------------------------------------------------------*/
1801 /* Return a new initialized object. */
1802 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
1806 /* -- Check if there are objects in the free list -- */
1807 if (interp
->freeList
!= NULL
) {
1808 /* -- Unlink the object from the free list -- */
1809 objPtr
= interp
->freeList
;
1810 interp
->freeList
= objPtr
->nextObjPtr
;
1812 /* -- No ready to use objects: allocate a new one -- */
1813 objPtr
= Jim_Alloc(sizeof(*objPtr
));
1816 /* Object is returned with refCount of 0. Every
1817 * kind of GC implemented should take care to don't try
1818 * to scan objects with refCount == 0. */
1819 objPtr
->refCount
= 0;
1820 /* All the other fields are left not initialized to save time.
1821 * The caller will probably want set they to the right
1824 /* -- Put the object into the live list -- */
1825 objPtr
->prevObjPtr
= NULL
;
1826 objPtr
->nextObjPtr
= interp
->liveList
;
1827 if (interp
->liveList
)
1828 interp
->liveList
->prevObjPtr
= objPtr
;
1829 interp
->liveList
= objPtr
;
1834 /* Free an object. Actually objects are never freed, but
1835 * just moved to the free objects list, where they will be
1836 * reused by Jim_NewObj(). */
1837 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1839 /* Check if the object was already freed, panic. */
1840 if (objPtr
->refCount
!= 0) {
1841 Jim_Panic(interp
,"!!!Object %p freed with bad refcount %d", objPtr
,
1844 /* Free the internal representation */
1845 Jim_FreeIntRep(interp
, objPtr
);
1846 /* Free the string representation */
1847 if (objPtr
->bytes
!= NULL
) {
1848 if (objPtr
->bytes
!= JimEmptyStringRep
)
1849 Jim_Free(objPtr
->bytes
);
1851 /* Unlink the object from the live objects list */
1852 if (objPtr
->prevObjPtr
)
1853 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
1854 if (objPtr
->nextObjPtr
)
1855 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
1856 if (interp
->liveList
== objPtr
)
1857 interp
->liveList
= objPtr
->nextObjPtr
;
1858 /* Link the object into the free objects list */
1859 objPtr
->prevObjPtr
= NULL
;
1860 objPtr
->nextObjPtr
= interp
->freeList
;
1861 if (interp
->freeList
)
1862 interp
->freeList
->prevObjPtr
= objPtr
;
1863 interp
->freeList
= objPtr
;
1864 objPtr
->refCount
= -1;
1867 /* Invalidate the string representation of an object. */
1868 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
1870 if (objPtr
->bytes
!= NULL
) {
1871 if (objPtr
->bytes
!= JimEmptyStringRep
)
1872 Jim_Free(objPtr
->bytes
);
1874 objPtr
->bytes
= NULL
;
1877 #define Jim_SetStringRep(o, b, l) \
1878 do { (o)->bytes = b; (o)->length = l; } while (0)
1880 /* Set the initial string representation for an object.
1881 * Does not try to free an old one. */
1882 void Jim_InitStringRep(Jim_Obj
*objPtr
, const char *bytes
, int length
)
1885 objPtr
->bytes
= JimEmptyStringRep
;
1888 objPtr
->bytes
= Jim_Alloc(length
+ 1);
1889 objPtr
->length
= length
;
1890 memcpy(objPtr
->bytes
, bytes
, length
);
1891 objPtr
->bytes
[length
] = '\0';
1895 /* Duplicate an object. The returned object has refcount = 0. */
1896 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1900 dupPtr
= Jim_NewObj(interp
);
1901 if (objPtr
->bytes
== NULL
) {
1902 /* Object does not have a valid string representation. */
1903 dupPtr
->bytes
= NULL
;
1905 Jim_InitStringRep(dupPtr
, objPtr
->bytes
, objPtr
->length
);
1907 if (objPtr
->typePtr
!= NULL
) {
1908 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
1909 dupPtr
->internalRep
= objPtr
->internalRep
;
1911 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
1913 dupPtr
->typePtr
= objPtr
->typePtr
;
1915 dupPtr
->typePtr
= NULL
;
1920 /* Return the string representation for objPtr. If the object
1921 * string representation is invalid, calls the method to create
1922 * a new one starting from the internal representation of the object. */
1923 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
1925 if (objPtr
->bytes
== NULL
) {
1926 /* Invalid string repr. Generate it. */
1927 if (objPtr
->typePtr
->updateStringProc
== NULL
) {
1928 Jim_Panic(NULL
,"UpdataStringProc called against '%s' type.",
1929 objPtr
->typePtr
->name
);
1931 objPtr
->typePtr
->updateStringProc(objPtr
);
1934 *lenPtr
= objPtr
->length
;
1935 return objPtr
->bytes
;
1938 /* Just returns the length of the object's string rep */
1939 int Jim_Length(Jim_Obj
*objPtr
)
1943 Jim_GetString(objPtr
, &len
);
1947 /* -----------------------------------------------------------------------------
1949 * ---------------------------------------------------------------------------*/
1950 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
1951 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
1953 static Jim_ObjType stringObjType
= {
1956 DupStringInternalRep
,
1958 JIM_TYPE_REFERENCES
,
1961 void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
1963 JIM_NOTUSED(interp
);
1965 /* This is a bit subtle: the only caller of this function
1966 * should be Jim_DuplicateObj(), that will copy the
1967 * string representaion. After the copy, the duplicated
1968 * object will not have more room in teh buffer than
1969 * srcPtr->length bytes. So we just set it to length. */
1970 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
1973 int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1975 /* Get a fresh string representation. */
1976 (void) Jim_GetString(objPtr
, NULL
);
1977 /* Free any other internal representation. */
1978 Jim_FreeIntRep(interp
, objPtr
);
1979 /* Set it as string, i.e. just set the maxLength field. */
1980 objPtr
->typePtr
= &stringObjType
;
1981 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
1985 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
1987 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
1991 /* Alloc/Set the string rep. */
1993 objPtr
->bytes
= JimEmptyStringRep
;
1996 objPtr
->bytes
= Jim_Alloc(len
+ 1);
1997 objPtr
->length
= len
;
1998 memcpy(objPtr
->bytes
, s
, len
);
1999 objPtr
->bytes
[len
] = '\0';
2002 /* No typePtr field for the vanilla string object. */
2003 objPtr
->typePtr
= NULL
;
2007 /* This version does not try to duplicate the 's' pointer, but
2008 * use it directly. */
2009 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2011 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2015 Jim_SetStringRep(objPtr
, s
, len
);
2016 objPtr
->typePtr
= NULL
;
2020 /* Low-level string append. Use it only against objects
2021 * of type "string". */
2022 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2028 needlen
= objPtr
->length
+ len
;
2029 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2030 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2031 if (objPtr
->bytes
== JimEmptyStringRep
) {
2032 objPtr
->bytes
= Jim_Alloc((needlen
*2) + 1);
2034 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, (needlen
*2) + 1);
2036 objPtr
->internalRep
.strValue
.maxLength
= needlen
*2;
2038 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2039 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2040 objPtr
->length
+= len
;
2043 /* Low-level wrapper to append an object. */
2044 void StringAppendObj(Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2049 str
= Jim_GetString(appendObjPtr
, &len
);
2050 StringAppendString(objPtr
, str
, len
);
2053 /* Higher level API to append strings to objects. */
2054 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
,
2057 if (Jim_IsShared(objPtr
))
2058 Jim_Panic(interp
,"Jim_AppendString called with shared object");
2059 if (objPtr
->typePtr
!= &stringObjType
)
2060 SetStringFromAny(interp
, objPtr
);
2061 StringAppendString(objPtr
, str
, len
);
2064 void Jim_AppendString_sprintf(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *fmt
, ...)
2070 buf
= jim_vasprintf(fmt
, ap
);
2074 Jim_AppendString(interp
, objPtr
, buf
, -1);
2075 jim_vasprintf_done(buf
);
2080 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2081 Jim_Obj
*appendObjPtr
)
2086 str
= Jim_GetString(appendObjPtr
, &len
);
2087 Jim_AppendString(interp
, objPtr
, str
, len
);
2090 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2094 if (objPtr
->typePtr
!= &stringObjType
)
2095 SetStringFromAny(interp
, objPtr
);
2096 va_start(ap
, objPtr
);
2098 char *s
= va_arg(ap
, char*);
2100 if (s
== NULL
) break;
2101 Jim_AppendString(interp
, objPtr
, s
, -1);
2106 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
, int nocase
)
2108 const char *aStr
, *bStr
;
2111 if (aObjPtr
== bObjPtr
) return 1;
2112 aStr
= Jim_GetString(aObjPtr
, &aLen
);
2113 bStr
= Jim_GetString(bObjPtr
, &bLen
);
2114 if (aLen
!= bLen
) return 0;
2116 return memcmp(aStr
, bStr
, aLen
) == 0;
2117 for (i
= 0; i
< aLen
; i
++) {
2118 if (tolower((int)aStr
[i
]) != tolower((int)bStr
[i
]))
2124 int Jim_StringMatchObj(Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
,
2127 const char *pattern
, *string
;
2128 int patternLen
, stringLen
;
2130 pattern
= Jim_GetString(patternObjPtr
, &patternLen
);
2131 string
= Jim_GetString(objPtr
, &stringLen
);
2132 return JimStringMatch(pattern
, patternLen
, string
, stringLen
, nocase
);
2135 static int Jim_StringCompareObj(Jim_Obj
*firstObjPtr
,
2136 Jim_Obj
*secondObjPtr
, int nocase
)
2138 const char *s1
, *s2
;
2141 s1
= Jim_GetString(firstObjPtr
, &l1
);
2142 s2
= Jim_GetString(secondObjPtr
, &l2
);
2143 return JimStringCompare(s1
, l1
, s2
, l2
, nocase
);
2146 /* Convert a range, as returned by Jim_GetRange(), into
2147 * an absolute index into an object of the specified length.
2148 * This function may return negative values, or values
2149 * bigger or equal to the length of the list if the index
2150 * is out of range. */
2151 static int JimRelToAbsIndex(int len
, int index_t
)
2154 return len
+ index_t
;
2158 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2159 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2160 * for implementation of commands like [string range] and [lrange].
2162 * The resulting range is guaranteed to address valid elements of
2164 static void JimRelToAbsRange(int len
, int first
, int last
,
2165 int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2172 rangeLen
= last
-first
+ 1;
2179 rangeLen
-= (last
-(len
-1));
2184 if (rangeLen
< 0) rangeLen
= 0;
2188 *rangeLenPtr
= rangeLen
;
2191 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2192 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2198 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
2199 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
2201 str
= Jim_GetString(strObjPtr
, &len
);
2202 first
= JimRelToAbsIndex(len
, first
);
2203 last
= JimRelToAbsIndex(len
, last
);
2204 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
2205 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2208 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2212 if (strObjPtr
->typePtr
!= &stringObjType
) {
2213 SetStringFromAny(interp
, strObjPtr
);
2216 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2218 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2219 for (i
= 0; i
< strObjPtr
->length
; i
++)
2220 buf
[i
] = tolower((unsigned)buf
[i
]);
2221 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2224 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2228 if (strObjPtr
->typePtr
!= &stringObjType
) {
2229 SetStringFromAny(interp
, strObjPtr
);
2232 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2234 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2235 for (i
= 0; i
< strObjPtr
->length
; i
++)
2236 buf
[i
] = toupper((unsigned)buf
[i
]);
2237 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2240 /* This is the core of the [format] command.
2241 * TODO: Lots of things work - via a hack
2242 * However, no format item can be >= JIM_MAX_FMT
2244 #define JIM_MAX_FMT 2048
2245 static Jim_Obj
*Jim_FormatString_Inner(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
,
2246 int objc
, Jim_Obj
*const *objv
, char *sprintf_buf
)
2248 const char *fmt
, *_fmt
;
2253 fmt
= Jim_GetString(fmtObjPtr
, &fmtLen
);
2255 resObjPtr
= Jim_NewStringObj(interp
, "", 0);
2257 const char *p
= fmt
;
2261 /* we cheat and use Sprintf()! */
2275 while (*fmt
!= '%' && fmtLen
) {
2278 Jim_AppendString(interp
, resObjPtr
, p
, fmt
-p
);
2281 fmt
++; fmtLen
--; /* skip '%' */
2290 prec
= -1; /* not found yet */
2297 case 'b': /* binary - not all printfs() do this */
2298 case 's': /* string */
2299 case 'i': /* integer */
2300 case 'd': /* decimal */
2302 case 'X': /* CAP hex */
2303 case 'c': /* char */
2304 case 'o': /* octal */
2305 case 'u': /* unsigned */
2306 case 'f': /* float */
2310 case '0': /* zero pad */
2320 case ' ': /* sign space */
2350 while (isdigit((unsigned)*fmt
) && (fmtLen
> 0)) {
2351 accum
= (accum
* 10) + (*fmt
- '0');
2362 /* suck up the next item as an integer */
2366 goto not_enough_args
;
2368 if (Jim_GetWide(interp
,objv
[0],&wideValue
)== JIM_ERR
) {
2369 Jim_FreeNewObj(interp
, resObjPtr
);
2376 /* man 3 printf says */
2377 /* if prec is negative, it is zero */
2396 Jim_FreeNewObj(interp
, resObjPtr
);
2397 Jim_SetResultString(interp
,
2398 "not enough arguments for all format specifiers", -1);
2406 * Create the formatter
2407 * cause we cheat and use sprintf()
2417 /* PLUS overrides */
2427 sprintf(cp
, "%d", width
);
2431 /* did we find a period? */
2435 /* did something occur after the period? */
2437 sprintf(cp
, "%d", prec
);
2443 /* here we do the work */
2444 /* actually - we make sprintf() do it for us */
2449 /* BUG: we do not handled embeded NULLs */
2450 snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, Jim_GetString(objv
[0], NULL
));
2455 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2456 Jim_FreeNewObj(interp
, resObjPtr
);
2459 c
= (char) wideValue
;
2460 snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, c
);
2470 if (Jim_GetDouble(interp
, objv
[0], &doubleValue
) == JIM_ERR
) {
2471 Jim_FreeNewObj(interp
, resObjPtr
);
2474 snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, doubleValue
);
2483 /* jim widevaluse are 64bit */
2484 if (sizeof(jim_wide
) == sizeof(long long)) {
2492 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2493 Jim_FreeNewObj(interp
, resObjPtr
);
2496 snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, wideValue
);
2499 sprintf_buf
[0] = '%';
2501 objv
--; /* undo the objv++ below */
2504 spec
[0] = *fmt
; spec
[1] = '\0';
2505 Jim_FreeNewObj(interp
, resObjPtr
);
2506 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
2507 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
2508 "bad field specifier \"", spec
, "\"", NULL
);
2511 /* force terminate */
2513 printf("FMT was: %s\n", fmt_str
);
2514 printf("RES was: |%s|\n", sprintf_buf
);
2517 sprintf_buf
[ JIM_MAX_FMT
- 1] = 0;
2518 Jim_AppendString(interp
, resObjPtr
, sprintf_buf
, strlen(sprintf_buf
));
2527 Jim_Obj
*Jim_FormatString(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
,
2528 int objc
, Jim_Obj
*const *objv
)
2530 char *sprintf_buf
= malloc(JIM_MAX_FMT
);
2531 Jim_Obj
*t
= Jim_FormatString_Inner(interp
, fmtObjPtr
, objc
, objv
, sprintf_buf
);
2536 /* -----------------------------------------------------------------------------
2537 * Compared String Object
2538 * ---------------------------------------------------------------------------*/
2540 /* This is strange object that allows to compare a C literal string
2541 * with a Jim object in very short time if the same comparison is done
2542 * multiple times. For example every time the [if] command is executed,
2543 * Jim has to check if a given argument is "else". This comparions if
2544 * the code has no errors are true most of the times, so we can cache
2545 * inside the object the pointer of the string of the last matching
2546 * comparison. Because most C compilers perform literal sharing,
2547 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2548 * this works pretty well even if comparisons are at different places
2549 * inside the C code. */
2551 static Jim_ObjType comparedStringObjType
= {
2556 JIM_TYPE_REFERENCES
,
2559 /* The only way this object is exposed to the API is via the following
2560 * function. Returns true if the string and the object string repr.
2561 * are the same, otherwise zero is returned.
2563 * Note: this isn't binary safe, but it hardly needs to be.*/
2564 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2567 if (objPtr
->typePtr
== &comparedStringObjType
&&
2568 objPtr
->internalRep
.ptr
== str
)
2571 const char *objStr
= Jim_GetString(objPtr
, NULL
);
2572 if (strcmp(str
, objStr
) != 0) return 0;
2573 if (objPtr
->typePtr
!= &comparedStringObjType
) {
2574 Jim_FreeIntRep(interp
, objPtr
);
2575 objPtr
->typePtr
= &comparedStringObjType
;
2577 objPtr
->internalRep
.ptr
= (char*)str
; /*ATTENTION: const cast */
2582 static int qsortCompareStringPointers(const void *a
, const void *b
)
2584 char * const *sa
= (char * const *)a
;
2585 char * const *sb
= (char * const *)b
;
2586 return strcmp(*sa
, *sb
);
2589 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2590 const char * const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
2592 const char * const *entryPtr
= NULL
;
2593 char **tablePtrSorted
;
2597 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
2598 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
2602 count
++; /* If nothing matches, this will reach the len of tablePtr */
2604 if (flags
& JIM_ERRMSG
) {
2607 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
2608 Jim_AppendStrings(interp
, Jim_GetResult(interp
),
2609 "bad ", name
, " \"", Jim_GetString(objPtr
, NULL
), "\": must be one of ",
2611 tablePtrSorted
= Jim_Alloc(sizeof(char*)*count
);
2612 memcpy(tablePtrSorted
, tablePtr
, sizeof(char*)*count
);
2613 qsort(tablePtrSorted
, count
, sizeof(char*), qsortCompareStringPointers
);
2614 for (i
= 0; i
< count
; i
++) {
2615 if (i
+ 1 == count
&& count
> 1)
2616 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
2617 Jim_AppendString(interp
, Jim_GetResult(interp
),
2618 tablePtrSorted
[i
], -1);
2620 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
2622 Jim_Free(tablePtrSorted
);
2627 int Jim_GetNvp(Jim_Interp
*interp
,
2629 const Jim_Nvp
*nvp_table
,
2630 const Jim_Nvp
** result
)
2635 e
= Jim_Nvp_name2value_obj(interp
, nvp_table
, objPtr
, &n
);
2640 /* Success? found? */
2643 *result
= (Jim_Nvp
*)n
;
2650 /* -----------------------------------------------------------------------------
2653 * This object is just a string from the language point of view, but
2654 * in the internal representation it contains the filename and line number
2655 * where this given token was read. This information is used by
2656 * Jim_EvalObj() if the object passed happens to be of type "source".
2658 * This allows to propagate the information about line numbers and file
2659 * names and give error messages with absolute line numbers.
2661 * Note that this object uses shared strings for filenames, and the
2662 * pointer to the filename together with the line number is taken into
2663 * the space for the "inline" internal represenation of the Jim_Object,
2664 * so there is almost memory zero-overhead.
2666 * Also the object will be converted to something else if the given
2667 * token it represents in the source file is not something to be
2668 * evaluated (not a script), and will be specialized in some other way,
2669 * so the time overhead is alzo null.
2670 * ---------------------------------------------------------------------------*/
2672 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2673 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2675 static Jim_ObjType sourceObjType
= {
2677 FreeSourceInternalRep
,
2678 DupSourceInternalRep
,
2680 JIM_TYPE_REFERENCES
,
2683 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2685 Jim_ReleaseSharedString(interp
,
2686 objPtr
->internalRep
.sourceValue
.fileName
);
2689 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2691 dupPtr
->internalRep
.sourceValue
.fileName
=
2692 Jim_GetSharedString(interp
,
2693 srcPtr
->internalRep
.sourceValue
.fileName
);
2694 dupPtr
->internalRep
.sourceValue
.lineNumber
=
2695 dupPtr
->internalRep
.sourceValue
.lineNumber
;
2696 dupPtr
->typePtr
= &sourceObjType
;
2699 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2700 const char *fileName
, int lineNumber
)
2702 if (Jim_IsShared(objPtr
))
2703 Jim_Panic(interp
,"JimSetSourceInfo called with shared object");
2704 if (objPtr
->typePtr
!= NULL
)
2705 Jim_Panic(interp
,"JimSetSourceInfo called with typePtr != NULL");
2706 objPtr
->internalRep
.sourceValue
.fileName
=
2707 Jim_GetSharedString(interp
, fileName
);
2708 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
2709 objPtr
->typePtr
= &sourceObjType
;
2712 /* -----------------------------------------------------------------------------
2714 * ---------------------------------------------------------------------------*/
2716 #define JIM_CMDSTRUCT_EXPAND -1
2718 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2719 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2720 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2722 static Jim_ObjType scriptObjType
= {
2724 FreeScriptInternalRep
,
2725 DupScriptInternalRep
,
2727 JIM_TYPE_REFERENCES
,
2730 /* The ScriptToken structure represents every token into a scriptObj.
2731 * Every token contains an associated Jim_Obj that can be specialized
2732 * by commands operating on it. */
2733 typedef struct ScriptToken
{
2739 /* This is the script object internal representation. An array of
2740 * ScriptToken structures, with an associated command structure array.
2741 * The command structure is a pre-computed representation of the
2742 * command length and arguments structure as a simple liner array
2745 * For example the script:
2748 * set $i $x$y [foo]BAR
2750 * will produce a ScriptObj with the following Tokens:
2767 * This is a description of the tokens, separators, and of lines.
2768 * The command structure instead represents the number of arguments
2769 * of every command, followed by the tokens of which every argument
2770 * is composed. So for the example script, the cmdstruct array will
2775 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2776 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2777 * composed of single tokens (1 1) and the last two of double tokens
2780 * The precomputation of the command structure makes Jim_Eval() faster,
2781 * and simpler because there aren't dynamic lengths / allocations.
2783 * -- {expand} handling --
2785 * Expand is handled in a special way. When a command
2786 * contains at least an argument with the {expand} prefix,
2787 * the command structure presents a -1 before the integer
2788 * describing the number of arguments. This is used in order
2789 * to send the command exection to a different path in case
2790 * of {expand} and guarantee a fast path for the more common
2791 * case. Also, the integers describing the number of tokens
2792 * are expressed with negative sign, to allow for fast check
2793 * of what's an {expand}-prefixed argument and what not.
2795 * For example the command:
2797 * list {expand}{1 2}
2799 * Will produce the following cmdstruct array:
2803 * -- the substFlags field of the structure --
2805 * The scriptObj structure is used to represent both "script" objects
2806 * and "subst" objects. In the second case, the cmdStruct related
2807 * fields are not used at all, but there is an additional field used
2808 * that is 'substFlags': this represents the flags used to turn
2809 * the string into the intenral representation used to perform the
2810 * substitution. If this flags are not what the application requires
2811 * the scriptObj is created again. For example the script:
2813 * subst -nocommands $string
2814 * subst -novariables $string
2816 * Will recreate the internal representation of the $string object
2819 typedef struct ScriptObj
{
2820 int len
; /* Length as number of tokens. */
2821 int commands
; /* number of top-level commands in script. */
2822 ScriptToken
*token
; /* Tokens array. */
2823 int *cmdStruct
; /* commands structure */
2824 int csLen
; /* length of the cmdStruct array. */
2825 int substFlags
; /* flags used for the compilation of "subst" objects */
2826 int inUse
; /* Used to share a ScriptObj. Currently
2827 only used by Jim_EvalObj() as protection against
2828 shimmering of the currently evaluated object. */
2832 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2835 struct ScriptObj
*script
= (void*) objPtr
->internalRep
.ptr
;
2841 if (script
->inUse
!= 0) return;
2842 for (i
= 0; i
< script
->len
; i
++) {
2843 if (script
->token
[i
].objPtr
!= NULL
)
2844 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
2846 Jim_Free(script
->token
);
2847 Jim_Free(script
->cmdStruct
);
2848 Jim_Free(script
->fileName
);
2852 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2854 JIM_NOTUSED(interp
);
2855 JIM_NOTUSED(srcPtr
);
2857 /* Just returns an simple string. */
2858 dupPtr
->typePtr
= NULL
;
2861 /* Add a new token to the internal repr of a script object */
2862 static void ScriptObjAddToken(Jim_Interp
*interp
, struct ScriptObj
*script
,
2863 char *strtoken
, int len
, int type
, char *filename
, int linenr
)
2866 struct ScriptToken
*token
;
2868 prevtype
= (script
->len
== 0) ? JIM_TT_EOL
: \
2869 script
->token
[script
->len
-1].type
;
2870 /* Skip tokens without meaning, like words separators
2871 * following a word separator or an end of command and
2873 if (prevtype
== JIM_TT_EOL
) {
2874 if (type
== JIM_TT_EOL
|| type
== JIM_TT_SEP
) {
2878 } else if (prevtype
== JIM_TT_SEP
) {
2879 if (type
== JIM_TT_SEP
) {
2882 } else if (type
== JIM_TT_EOL
) {
2883 /* If an EOL is following by a SEP, drop the previous
2886 Jim_DecrRefCount(interp
, script
->token
[script
->len
].objPtr
);
2888 } else if (prevtype
!= JIM_TT_EOL
&& prevtype
!= JIM_TT_SEP
&&
2889 type
== JIM_TT_ESC
&& len
== 0)
2891 /* Don't add empty tokens used in interpolation */
2895 /* Make space for a new istruction */
2897 script
->token
= Jim_Realloc(script
->token
,
2898 sizeof(ScriptToken
)*script
->len
);
2899 /* Initialize the new token */
2900 token
= script
->token
+ (script
->len
-1);
2902 /* Every object is intially as a string, but the
2903 * internal type may be specialized during execution of the
2905 token
->objPtr
= Jim_NewStringObjNoAlloc(interp
, strtoken
, len
);
2906 /* To add source info to SEP and EOL tokens is useless because
2907 * they will never by called as arguments of Jim_EvalObj(). */
2908 if (filename
&& type
!= JIM_TT_SEP
&& type
!= JIM_TT_EOL
)
2909 JimSetSourceInfo(interp
, token
->objPtr
, filename
, linenr
);
2910 Jim_IncrRefCount(token
->objPtr
);
2911 token
->linenr
= linenr
;
2914 /* Add an integer into the command structure field of the script object. */
2915 static void ScriptObjAddInt(struct ScriptObj
*script
, int val
)
2918 script
->cmdStruct
= Jim_Realloc(script
->cmdStruct
,
2919 sizeof(int)*script
->csLen
);
2920 script
->cmdStruct
[script
->csLen
-1] = val
;
2923 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2924 * of objPtr. Search nested script objects recursively. */
2925 static Jim_Obj
*ScriptSearchLiteral(Jim_Interp
*interp
, ScriptObj
*script
,
2926 ScriptObj
*scriptBarrier
, Jim_Obj
*objPtr
)
2930 for (i
= 0; i
< script
->len
; i
++) {
2931 if (script
->token
[i
].objPtr
!= objPtr
&&
2932 Jim_StringEqObj(script
->token
[i
].objPtr
, objPtr
, 0)) {
2933 return script
->token
[i
].objPtr
;
2935 /* Enter recursively on scripts only if the object
2936 * is not the same as the one we are searching for
2937 * shared occurrences. */
2938 if (script
->token
[i
].objPtr
->typePtr
== &scriptObjType
&&
2939 script
->token
[i
].objPtr
!= objPtr
) {
2940 Jim_Obj
*foundObjPtr
;
2942 ScriptObj
*subScript
=
2943 script
->token
[i
].objPtr
->internalRep
.ptr
;
2944 /* Don't recursively enter the script we are trying
2945 * to make shared to avoid circular references. */
2946 if (subScript
== scriptBarrier
) continue;
2947 if (subScript
!= script
) {
2949 ScriptSearchLiteral(interp
, subScript
,
2950 scriptBarrier
, objPtr
);
2951 if (foundObjPtr
!= NULL
)
2959 /* Share literals of a script recursively sharing sub-scripts literals. */
2960 static void ScriptShareLiterals(Jim_Interp
*interp
, ScriptObj
*script
,
2961 ScriptObj
*topLevelScript
)
2966 /* Try to share with toplevel object. */
2967 if (topLevelScript
!= NULL
) {
2968 for (i
= 0; i
< script
->len
; i
++) {
2969 Jim_Obj
*foundObjPtr
;
2970 char *str
= script
->token
[i
].objPtr
->bytes
;
2972 if (script
->token
[i
].objPtr
->refCount
!= 1) continue;
2973 if (script
->token
[i
].objPtr
->typePtr
== &scriptObjType
) continue;
2974 if (strchr(str
, ' ') || strchr(str
, '\n')) continue;
2975 foundObjPtr
= ScriptSearchLiteral(interp
,
2977 script
, /* barrier */
2978 script
->token
[i
].objPtr
);
2979 if (foundObjPtr
!= NULL
) {
2980 Jim_IncrRefCount(foundObjPtr
);
2981 Jim_DecrRefCount(interp
,
2982 script
->token
[i
].objPtr
);
2983 script
->token
[i
].objPtr
= foundObjPtr
;
2987 /* Try to share locally */
2988 for (i
= 0; i
< script
->len
; i
++) {
2989 char *str
= script
->token
[i
].objPtr
->bytes
;
2991 if (script
->token
[i
].objPtr
->refCount
!= 1) continue;
2992 if (strchr(str
, ' ') || strchr(str
, '\n')) continue;
2993 for (j
= 0; j
< script
->len
; j
++) {
2994 if (script
->token
[i
].objPtr
!=
2995 script
->token
[j
].objPtr
&&
2996 Jim_StringEqObj(script
->token
[i
].objPtr
,
2997 script
->token
[j
].objPtr
, 0))
2999 Jim_IncrRefCount(script
->token
[j
].objPtr
);
3000 Jim_DecrRefCount(interp
,
3001 script
->token
[i
].objPtr
);
3002 script
->token
[i
].objPtr
=
3003 script
->token
[j
].objPtr
;
3009 /* This method takes the string representation of an object
3010 * as a Tcl script, and generates the pre-parsed internal representation
3012 int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3015 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3016 struct JimParserCtx parser
;
3017 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
3019 int args
, tokens
, start
, end
, i
;
3020 int initialLineNumber
;
3021 int propagateSourceInfo
= 0;
3025 script
->commands
= 0;
3026 script
->token
= NULL
;
3027 script
->cmdStruct
= NULL
;
3029 /* Try to get information about filename / line number */
3030 if (objPtr
->typePtr
== &sourceObjType
) {
3032 Jim_StrDup(objPtr
->internalRep
.sourceValue
.fileName
);
3033 initialLineNumber
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3034 propagateSourceInfo
= 1;
3036 script
->fileName
= Jim_StrDup("");
3037 initialLineNumber
= 1;
3040 JimParserInit(&parser
, scriptText
, scriptTextLen
, initialLineNumber
);
3041 while (!JimParserEof(&parser
)) {
3043 int len
, type
, linenr
;
3045 JimParseScript(&parser
);
3046 token_t
= JimParserGetToken(&parser
, &len
, &type
, &linenr
);
3047 ScriptObjAddToken(interp
, script
, token_t
, len
, type
,
3048 propagateSourceInfo
? script
->fileName
: NULL
,
3051 token
= script
->token
;
3053 /* Compute the command structure array
3054 * (see the ScriptObj struct definition for more info) */
3055 start
= 0; /* Current command start token index */
3056 end
= -1; /* Current command end token index */
3058 int expand
= 0; /* expand flag. set to 1 on {expand} form. */
3059 int interpolation
= 0; /* set to 1 if there is at least one
3060 argument of the command obtained via
3061 interpolation of more tokens. */
3062 /* Search for the end of command, while
3063 * count the number of args. */
3065 if (start
>= script
->len
) break;
3066 args
= 1; /* Number of args in current command */
3067 while (token
[end
].type
!= JIM_TT_EOL
) {
3068 if (end
== 0 || token
[end
-1].type
== JIM_TT_SEP
||
3069 token
[end
-1].type
== JIM_TT_EOL
)
3071 if (token
[end
].type
== JIM_TT_STR
&&
3072 token
[end
+ 1].type
!= JIM_TT_SEP
&&
3073 token
[end
+ 1].type
!= JIM_TT_EOL
&&
3074 (!strcmp(token
[end
].objPtr
->bytes
, "expand") ||
3075 !strcmp(token
[end
].objPtr
->bytes
, "*")))
3078 if (token
[end
].type
== JIM_TT_SEP
)
3082 interpolation
= !((end
-start
+ 1) == args
*2);
3083 /* Add the 'number of arguments' info into cmdstruct.
3084 * Negative value if there is list expansion involved. */
3086 ScriptObjAddInt(script
, -1);
3087 ScriptObjAddInt(script
, args
);
3088 /* Now add info about the number of tokens. */
3089 tokens
= 0; /* Number of tokens in current argument. */
3091 for (i
= start
; i
<= end
; i
++) {
3092 if (token
[i
].type
== JIM_TT_SEP
||
3093 token
[i
].type
== JIM_TT_EOL
)
3095 if (tokens
== 1 && expand
)
3097 ScriptObjAddInt(script
,
3098 expand
? -tokens
: tokens
);
3103 } else if (tokens
== 0 && token
[i
].type
== JIM_TT_STR
&&
3104 (!strcmp(token
[i
].objPtr
->bytes
, "expand") ||
3105 !strcmp(token
[i
].objPtr
->bytes
, "*")))
3112 /* Perform literal sharing, but only for objects that appear
3113 * to be scripts written as literals inside the source code,
3114 * and not computed at runtime. Literal sharing is a costly
3115 * operation that should be done only against objects that
3116 * are likely to require compilation only the first time, and
3117 * then are executed multiple times. */
3118 if (propagateSourceInfo
&& interp
->framePtr
->procBodyObjPtr
) {
3119 Jim_Obj
*bodyObjPtr
= interp
->framePtr
->procBodyObjPtr
;
3120 if (bodyObjPtr
->typePtr
== &scriptObjType
) {
3121 ScriptObj
*bodyScript
=
3122 bodyObjPtr
->internalRep
.ptr
;
3123 ScriptShareLiterals(interp
, script
, bodyScript
);
3125 } else if (propagateSourceInfo
) {
3126 ScriptShareLiterals(interp
, script
, NULL
);
3128 /* Free the old internal rep and set the new one. */
3129 Jim_FreeIntRep(interp
, objPtr
);
3130 Jim_SetIntRepPtr(objPtr
, script
);
3131 objPtr
->typePtr
= &scriptObjType
;
3135 static ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3137 if (objPtr
->typePtr
!= &scriptObjType
) {
3138 SetScriptFromAny(interp
, objPtr
);
3140 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
3143 /* -----------------------------------------------------------------------------
3145 * ---------------------------------------------------------------------------*/
3147 /* Commands HashTable Type.
3149 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3150 static void Jim_CommandsHT_ValDestructor(void *interp
, void *val
)
3152 Jim_Cmd
*cmdPtr
= (void*) val
;
3154 if (cmdPtr
->cmdProc
== NULL
) {
3155 Jim_DecrRefCount(interp
, cmdPtr
->argListObjPtr
);
3156 Jim_DecrRefCount(interp
, cmdPtr
->bodyObjPtr
);
3157 if (cmdPtr
->staticVars
) {
3158 Jim_FreeHashTable(cmdPtr
->staticVars
);
3159 Jim_Free(cmdPtr
->staticVars
);
3161 } else if (cmdPtr
->delProc
!= NULL
) {
3162 /* If it was a C coded command, call the delProc if any */
3163 cmdPtr
->delProc(interp
, cmdPtr
->privData
);
3168 static Jim_HashTableType JimCommandsHashTableType
= {
3169 JimStringCopyHTHashFunction
, /* hash function */
3170 JimStringCopyHTKeyDup
, /* key dup */
3172 JimStringCopyHTKeyCompare
, /* key compare */
3173 JimStringCopyHTKeyDestructor
, /* key destructor */
3174 Jim_CommandsHT_ValDestructor
/* val destructor */
3177 /* ------------------------- Commands related functions --------------------- */
3179 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdName
,
3180 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3185 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
3186 if (he
== NULL
) { /* New command to create */
3187 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3188 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
3190 Jim_InterpIncrProcEpoch(interp
);
3191 /* Free the arglist/body objects if it was a Tcl procedure */
3193 if (cmdPtr
->cmdProc
== NULL
) {
3194 Jim_DecrRefCount(interp
, cmdPtr
->argListObjPtr
);
3195 Jim_DecrRefCount(interp
, cmdPtr
->bodyObjPtr
);
3196 if (cmdPtr
->staticVars
) {
3197 Jim_FreeHashTable(cmdPtr
->staticVars
);
3198 Jim_Free(cmdPtr
->staticVars
);
3200 cmdPtr
->staticVars
= NULL
;
3201 } else if (cmdPtr
->delProc
!= NULL
) {
3202 /* If it was a C coded command, call the delProc if any */
3203 cmdPtr
->delProc(interp
, cmdPtr
->privData
);
3207 /* Store the new details for this proc */
3208 cmdPtr
->delProc
= delProc
;
3209 cmdPtr
->cmdProc
= cmdProc
;
3210 cmdPtr
->privData
= privData
;
3212 /* There is no need to increment the 'proc epoch' because
3213 * creation of a new procedure can never affect existing
3214 * cached commands. We don't do negative caching. */