2 /* Jim - A small embeddable Tcl interpreter
4 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
5 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
7 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
8 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
9 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
10 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
11 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
12 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
13 * Copyright 2009 Zachary T Welch zw@superlucidity.net
14 * Copyright 2009 David Brownell
18 * Redistribution and use in source and binary forms, with or without
19 * modification, are permitted provided that the following conditions
22 * 1. Redistributions of source code must retain the above copyright
23 * notice, this list of conditions and the following disclaimer.
24 * 2. Redistributions in binary form must reproduce the above
25 * copyright notice, this list of conditions and the following
26 * disclaimer in the documentation and/or other materials
27 * provided with the distribution.
29 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
30 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
31 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
32 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
33 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
34 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
35 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
36 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
37 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
38 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
39 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
40 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42 * The views and conclusions contained in the software and documentation
43 * are those of the authors and should not be interpreted as representing
44 * official policies, either expressed or implied, of the Jim Tcl Project.
46 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
69 /* For INFINITY, even if math functions are not enabled */
72 /* -----------------------------------------------------------------------------
74 * ---------------------------------------------------------------------------*/
76 /* A shared empty string for the objects string representation.
77 * Jim_InvalidateStringRep knows about it and don't try to free. */
78 static char *JimEmptyStringRep
= (char *)"";
80 /* -----------------------------------------------------------------------------
81 * Required prototypes of not exported functions
82 * ---------------------------------------------------------------------------*/
83 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
);
84 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
);
85 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int index
, Jim_Obj
*newObjPtr
,
87 static Jim_Obj
*Jim_ExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
88 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
89 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
90 const char *prefix
, const char *const *tablePtr
, const char *name
);
91 static void JimDeleteLocalProcs(Jim_Interp
*interp
);
92 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
,
93 int argc
, Jim_Obj
*const *argv
);
94 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
95 const char *filename
, int linenr
);
96 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
98 static const Jim_HashTableType JimVariablesHashTableType
;
100 const char *tt_name(int type
);
102 /* -----------------------------------------------------------------------------
104 * ---------------------------------------------------------------------------*/
106 /* Glob-style pattern matching. */
107 static int JimStringMatch(const char *pattern
, int patternLen
,
108 const char *string
, int stringLen
, int nocase
)
111 switch (pattern
[0]) {
113 while (pattern
[1] == '*') {
118 return 1; /* match */
120 if (JimStringMatch(pattern
+ 1, patternLen
- 1, string
, stringLen
, nocase
))
121 return 1; /* match */
125 return 0; /* no match */
129 return 0; /* no match */
139 not = pattern
[0] == '^';
146 if (pattern
[0] == '\\') {
149 if (pattern
[0] == string
[0])
152 else if (pattern
[0] == ']') {
155 else if (patternLen
== 0) {
160 else if (pattern
[1] == '-' && patternLen
>= 3) {
161 int start
= pattern
[0];
162 int end
= pattern
[2];
172 start
= tolower(start
);
178 if (c
>= start
&& c
<= end
)
183 if (pattern
[0] == string
[0])
187 if (tolower((int)pattern
[0]) == tolower((int)string
[0]))
197 return 0; /* no match */
203 if (patternLen
>= 2) {
210 if (pattern
[0] != string
[0])
211 return 0; /* no match */
214 if (tolower((int)pattern
[0]) != tolower((int)string
[0]))
215 return 0; /* no match */
223 if (stringLen
== 0) {
224 while (*pattern
== '*') {
231 if (patternLen
== 0 && stringLen
== 0)
236 int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
, int nocase
)
238 unsigned char *u1
= (unsigned char *)s1
, *u2
= (unsigned char *)s2
;
243 diff
= (int)*u1
- *u2
;
256 diff
= tolower((int)*u1
) - tolower((int)*u2
);
271 return diff
< 0 ? -1 : 1;
274 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
275 * The index of the first occurrence of s1 in s2 is returned.
276 * If s1 is not found inside s2, -1 is returned. */
277 int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int index
)
281 if (!l1
|| !l2
|| l1
> l2
)
286 for (i
= index
; i
<= l2
- l1
; i
++) {
287 if (memcmp(s2
, s1
, l1
) == 0)
294 int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
298 if (!l1
|| !l2
|| l1
> l2
)
301 /* Now search for the needle */
302 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
303 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
310 int Jim_WideToString(char *buf
, jim_wide wideValue
)
312 const char *fmt
= "%" JIM_WIDE_MODIFIER
;
314 return sprintf(buf
, fmt
, wideValue
);
318 * After an strtol()/strtod()-like conversion,
319 * check whether something was converted and that
320 * the only thing left is white space.
322 * Returns JIM_OK or JIM_ERR.
324 static int JimCheckConversion(const char *str
, const char *endptr
)
326 if (str
[0] == '\0' || str
== endptr
) {
330 if (endptr
[0] != '\0') {
332 if (!isspace(*endptr
)) {
341 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
345 *widePtr
= strtoull(str
, &endptr
, base
);
347 return JimCheckConversion(str
, endptr
);
350 int Jim_DoubleToString(char *buf
, double doubleValue
)
354 len
= sprintf(buf
, "%.12g", doubleValue
);
356 /* Add a final ".0" if it's a number. But not
359 if (*buf
== '.' || isalpha(*buf
)) {
360 /* inf -> Inf, nan -> Nan */
361 if (*buf
== 'i' || *buf
== 'n') {
362 *buf
= toupper(*buf
);
376 int Jim_StringToDouble(const char *str
, double *doublePtr
)
380 /* Callers can check for underflow via ERANGE */
383 *doublePtr
= strtod(str
, &endptr
);
385 return JimCheckConversion(str
, endptr
);
388 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
392 if ((b
== 0 && e
!= 0) || (e
< 0))
394 for (i
= 0; i
< e
; i
++) {
400 /* -----------------------------------------------------------------------------
402 * ---------------------------------------------------------------------------*/
404 /* Note that 'interp' may be NULL if not available in the
405 * context of the panic. It's only useful to get the error
406 * file descriptor, it will default to stderr otherwise. */
407 void Jim_Panic(Jim_Interp
*interp
, const char *fmt
, ...)
413 * Send it here first.. Assuming STDIO still works
415 fprintf(stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
416 vfprintf(stderr
, fmt
, ap
);
417 fprintf(stderr
, JIM_NL JIM_NL
);
420 #ifdef HAVE_BACKTRACE
426 size
= backtrace(array
, 40);
427 strings
= backtrace_symbols(array
, size
);
428 for (i
= 0; i
< size
; i
++)
429 fprintf(stderr
, "[backtrace] %s" JIM_NL
, strings
[i
]);
430 fprintf(stderr
, "[backtrace] Include the above lines and the output" JIM_NL
);
431 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL
);
438 /* -----------------------------------------------------------------------------
440 * ---------------------------------------------------------------------------*/
442 void *Jim_Alloc(int size
)
447 void Jim_Free(void *ptr
)
452 void *Jim_Realloc(void *ptr
, int size
)
454 return realloc(ptr
, size
);
457 char *Jim_StrDup(const char *s
)
462 char *Jim_StrDupLen(const char *s
, int l
)
464 char *copy
= Jim_Alloc(l
+ 1);
466 memcpy(copy
, s
, l
+ 1);
467 copy
[l
] = 0; /* Just to be sure, original could be substring */
471 /* -----------------------------------------------------------------------------
472 * Time related functions
473 * ---------------------------------------------------------------------------*/
475 /* Returns microseconds of CPU used since start. */
476 static jim_wide
JimClock(void)
480 gettimeofday(&tv
, NULL
);
481 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
484 /* -----------------------------------------------------------------------------
486 * ---------------------------------------------------------------------------*/
488 /* -------------------------- private prototypes ---------------------------- */
489 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
490 static unsigned int JimHashTableNextPower(unsigned int size
);
491 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
);
493 /* -------------------------- hash functions -------------------------------- */
495 /* Thomas Wang's 32 bit Mix Function */
496 unsigned int Jim_IntHashFunction(unsigned int key
)
507 /* Generic hash function (we are using to multiply by 9 and add the byte
509 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
514 h
+= (h
<< 3) + *buf
++;
518 /* ----------------------------- API implementation ------------------------- */
520 /* reset a hashtable already initialized with ht_init().
521 * NOTE: This function should only called by ht_destroy(). */
522 static void JimResetHashTable(Jim_HashTable
*ht
)
531 /* Initialize the hash table */
532 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
534 JimResetHashTable(ht
);
536 ht
->privdata
= privDataPtr
;
540 /* Resize the table to the minimal size that contains all the elements,
541 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
542 int Jim_ResizeHashTable(Jim_HashTable
*ht
)
544 int minimal
= ht
->used
;
546 if (minimal
< JIM_HT_INITIAL_SIZE
)
547 minimal
= JIM_HT_INITIAL_SIZE
;
548 return Jim_ExpandHashTable(ht
, minimal
);
551 /* Expand or create the hashtable */
552 int Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
554 Jim_HashTable n
; /* the new hashtable */
555 unsigned int realsize
= JimHashTableNextPower(size
), i
;
557 /* the size is invalid if it is smaller than the number of
558 * elements already inside the hashtable */
559 if (ht
->used
>= size
)
562 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
564 n
.sizemask
= realsize
- 1;
565 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
567 /* Initialize all the pointers to NULL */
568 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
570 /* Copy all the elements from the old to the new table:
571 * note that if the old hash table is empty ht->size is zero,
572 * so Jim_ExpandHashTable just creates an hash table. */
574 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
575 Jim_HashEntry
*he
, *nextHe
;
577 if (ht
->table
[i
] == NULL
)
580 /* For each hash entry on this slot... */
586 /* Get the new element index */
587 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
588 he
->next
= n
.table
[h
];
591 /* Pass to the next element */
595 assert(ht
->used
== 0);
598 /* Remap the new hashtable in the old */
603 /* Add an element to the target hash table */
604 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
607 Jim_HashEntry
*entry
;
609 /* Get the index of the new element, or -1 if
610 * the element already exists. */
611 if ((index
= JimInsertHashEntry(ht
, key
)) == -1)
614 /* Allocates the memory and stores key */
615 entry
= Jim_Alloc(sizeof(*entry
));
616 entry
->next
= ht
->table
[index
];
617 ht
->table
[index
] = entry
;
619 /* Set the hash entry fields. */
620 Jim_SetHashKey(ht
, entry
, key
);
621 Jim_SetHashVal(ht
, entry
, val
);
626 /* Add an element, discarding the old if the key already exists */
627 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
629 Jim_HashEntry
*entry
;
631 /* Try to add the element. If the key
632 * does not exists Jim_AddHashEntry will suceed. */
633 if (Jim_AddHashEntry(ht
, key
, val
) == JIM_OK
)
635 /* It already exists, get the entry */
636 entry
= Jim_FindHashEntry(ht
, key
);
637 /* Free the old value and set the new one */
638 Jim_FreeEntryVal(ht
, entry
);
639 Jim_SetHashVal(ht
, entry
, val
);
643 /* Search and remove an element */
644 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
647 Jim_HashEntry
*he
, *prevHe
;
651 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
656 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
657 /* Unlink the element from the list */
659 prevHe
->next
= he
->next
;
661 ht
->table
[h
] = he
->next
;
662 Jim_FreeEntryKey(ht
, he
);
663 Jim_FreeEntryVal(ht
, he
);
671 return JIM_ERR
; /* not found */
674 /* Destroy an entire hash table */
675 int Jim_FreeHashTable(Jim_HashTable
*ht
)
679 /* Free all the elements */
680 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
681 Jim_HashEntry
*he
, *nextHe
;
683 if ((he
= ht
->table
[i
]) == NULL
)
687 Jim_FreeEntryKey(ht
, he
);
688 Jim_FreeEntryVal(ht
, he
);
694 /* Free the table and the allocated cache structure */
696 /* Re-initialize the table */
697 JimResetHashTable(ht
);
698 return JIM_OK
; /* never fails */
701 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
708 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
711 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
718 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
720 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
725 iter
->nextEntry
= NULL
;
729 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
732 if (iter
->entry
== NULL
) {
734 if (iter
->index
>= (signed)iter
->ht
->size
)
736 iter
->entry
= iter
->ht
->table
[iter
->index
];
739 iter
->entry
= iter
->nextEntry
;
742 /* We need to save the 'next' here, the iterator user
743 * may delete the entry we are returning. */
744 iter
->nextEntry
= iter
->entry
->next
;
751 /* ------------------------- private functions ------------------------------ */
753 /* Expand the hash table if needed */
754 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
756 /* If the hash table is empty expand it to the intial size,
757 * if the table is "full" dobule its size. */
759 return Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
760 if (ht
->size
== ht
->used
)
761 return Jim_ExpandHashTable(ht
, ht
->size
* 2);
765 /* Our hash table capability is a power of two */
766 static unsigned int JimHashTableNextPower(unsigned int size
)
768 unsigned int i
= JIM_HT_INITIAL_SIZE
;
770 if (size
>= 2147483648U)
779 /* Returns the index of a free slot that can be populated with
780 * an hash entry for the given 'key'.
781 * If the key already exists, -1 is returned. */
782 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
)
787 /* Expand the hashtable if needed */
788 if (JimExpandHashTableIfNeeded(ht
) == JIM_ERR
)
790 /* Compute the key hash value */
791 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
792 /* Search if this slot does not already contain the given key */
795 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
802 /* ----------------------- StringCopy Hash Table Type ------------------------*/
804 static unsigned int JimStringCopyHTHashFunction(const void *key
)
806 return Jim_GenHashFunction(key
, strlen(key
));
809 static const void *JimStringCopyHTKeyDup(void *privdata
, const void *key
)
811 int len
= strlen(key
);
812 char *copy
= Jim_Alloc(len
+ 1);
814 JIM_NOTUSED(privdata
);
816 memcpy(copy
, key
, len
);
821 static void *JimStringKeyValCopyHTValDup(void *privdata
, const void *val
)
823 int len
= strlen(val
);
824 char *copy
= Jim_Alloc(len
+ 1);
826 JIM_NOTUSED(privdata
);
828 memcpy(copy
, val
, len
);
833 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
835 JIM_NOTUSED(privdata
);
837 return strcmp(key1
, key2
) == 0;
840 static void JimStringCopyHTKeyDestructor(void *privdata
, const void *key
)
842 JIM_NOTUSED(privdata
);
844 Jim_Free((void *)key
); /* ATTENTION: const cast */
847 static void JimStringKeyValCopyHTValDestructor(void *privdata
, void *val
)
849 JIM_NOTUSED(privdata
);
851 Jim_Free((void *)val
); /* ATTENTION: const cast */
855 static Jim_HashTableType JimStringCopyHashTableType
= {
856 JimStringCopyHTHashFunction
, /* hash function */
857 JimStringCopyHTKeyDup
, /* key dup */
859 JimStringCopyHTKeyCompare
, /* key compare */
860 JimStringCopyHTKeyDestructor
, /* key destructor */
861 NULL
/* val destructor */
865 /* This is like StringCopy but does not auto-duplicate the key.
866 * It's used for intepreter's shared strings. */
867 static const Jim_HashTableType JimSharedStringsHashTableType
= {
868 JimStringCopyHTHashFunction
, /* hash function */
871 JimStringCopyHTKeyCompare
, /* key compare */
872 JimStringCopyHTKeyDestructor
, /* key destructor */
873 NULL
/* val destructor */
876 /* This is like StringCopy but also automatically handle dynamic
877 * allocated C strings as values. */
878 static const Jim_HashTableType JimStringKeyValCopyHashTableType
= {
879 JimStringCopyHTHashFunction
, /* hash function */
880 JimStringCopyHTKeyDup
, /* key dup */
881 JimStringKeyValCopyHTValDup
, /* val dup */
882 JimStringCopyHTKeyCompare
, /* key compare */
883 JimStringCopyHTKeyDestructor
, /* key destructor */
884 JimStringKeyValCopyHTValDestructor
, /* val destructor */
887 typedef struct AssocDataValue
889 Jim_InterpDeleteProc
*delProc
;
893 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
895 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
897 if (assocPtr
->delProc
!= NULL
)
898 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
902 static const Jim_HashTableType JimAssocDataHashTableType
= {
903 JimStringCopyHTHashFunction
, /* hash function */
904 JimStringCopyHTKeyDup
, /* key dup */
906 JimStringCopyHTKeyCompare
, /* key compare */
907 JimStringCopyHTKeyDestructor
, /* key destructor */
908 JimAssocDataHashTableValueDestructor
/* val destructor */
911 /* -----------------------------------------------------------------------------
912 * Stack - This is a simple generic stack implementation. It is used for
913 * example in the 'expr' expression compiler.
914 * ---------------------------------------------------------------------------*/
915 void Jim_InitStack(Jim_Stack
*stack
)
919 stack
->vector
= NULL
;
922 void Jim_FreeStack(Jim_Stack
*stack
)
924 Jim_Free(stack
->vector
);
927 int Jim_StackLen(Jim_Stack
*stack
)
932 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
934 int neededLen
= stack
->len
+ 1;
936 if (neededLen
> stack
->maxlen
) {
937 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
938 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
940 stack
->vector
[stack
->len
] = element
;
944 void *Jim_StackPop(Jim_Stack
*stack
)
949 return stack
->vector
[stack
->len
];
952 void *Jim_StackPeek(Jim_Stack
*stack
)
956 return stack
->vector
[stack
->len
- 1];
959 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
963 for (i
= 0; i
< stack
->len
; i
++)
964 freeFunc(stack
->vector
[i
]);
967 /* -----------------------------------------------------------------------------
969 * ---------------------------------------------------------------------------*/
972 #define JIM_TT_NONE 0 /* No token returned */
973 #define JIM_TT_STR 1 /* simple string */
974 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
975 #define JIM_TT_VAR 3 /* var substitution */
976 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
977 #define JIM_TT_CMD 5 /* command substitution */
978 #define JIM_TT_SEP 6 /* word separator */
979 #define JIM_TT_EOL 7 /* line separator */
980 #define JIM_TT_EOF 8 /* end of script */
982 /* Additional token types needed for expressions */
983 #define JIM_TT_SUBEXPR_START 10
984 #define JIM_TT_SUBEXPR_END 11
985 #define JIM_TT_EXPR_INT 12
986 #define JIM_TT_EXPR_DOUBLE 13
988 /* Operator token types start here */
989 #define JIM_TT_EXPR_OP 15
992 #define JIM_PS_DEF 0 /* Default state */
993 #define JIM_PS_QUOTE 1 /* Inside "" */
994 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
996 /* Parser context structure. The same context is used both to parse
997 * Tcl scripts and lists. */
1000 const char *prg
; /* Program text */
1001 const char *p
; /* Pointer to the point of the program we are parsing */
1002 int len
; /* Left length of 'prg' */
1003 int linenr
; /* Current line number */
1005 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1006 int tline
; /* Line number of the returned token */
1007 int tt
; /* Token type */
1008 int eof
; /* Non zero if EOF condition is true. */
1009 int state
; /* Parser state */
1010 int comment
; /* Non zero if the next chars may be a comment. */
1011 char missing
; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1014 #define JimParserEof(c) ((c)->eof)
1015 #define JimParserTstart(c) ((c)->tstart)
1016 #define JimParserTend(c) ((c)->tend)
1017 #define JimParserTtype(c) ((c)->tt)
1018 #define JimParserTline(c) ((c)->tline)
1020 static int JimParseScript(struct JimParserCtx
*pc
);
1021 static int JimParseSep(struct JimParserCtx
*pc
);
1022 static int JimParseEol(struct JimParserCtx
*pc
);
1023 static int JimParseCmd(struct JimParserCtx
*pc
);
1024 static int JimParseVar(struct JimParserCtx
*pc
);
1025 static int JimParseBrace(struct JimParserCtx
*pc
);
1026 static int JimParseStr(struct JimParserCtx
*pc
);
1027 static int JimParseComment(struct JimParserCtx
*pc
);
1028 static char *JimParserGetToken(struct JimParserCtx
*pc
, int *lenPtr
, int *typePtr
, int *linePtr
);
1030 /* Initialize a parser context.
1031 * 'prg' is a pointer to the program text, linenr is the line
1032 * number of the first line contained in the program. */
1033 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1041 pc
->tt
= JIM_TT_NONE
;
1043 pc
->state
= JIM_PS_DEF
;
1044 pc
->linenr
= linenr
;
1049 static int JimParseScript(struct JimParserCtx
*pc
)
1051 while (1) { /* the while is used to reiterate with continue if needed */
1054 pc
->tend
= pc
->p
- 1;
1055 pc
->tline
= pc
->linenr
;
1056 pc
->tt
= JIM_TT_EOL
;
1062 if (*(pc
->p
+ 1) == '\n')
1063 return JimParseSep(pc
);
1066 return JimParseStr(pc
);
1072 if (pc
->state
== JIM_PS_DEF
)
1073 return JimParseSep(pc
);
1076 return JimParseStr(pc
);
1082 if (pc
->state
== JIM_PS_DEF
)
1083 return JimParseEol(pc
);
1085 return JimParseStr(pc
);
1089 return JimParseCmd(pc
);
1093 if (JimParseVar(pc
) == JIM_ERR
) {
1094 pc
->tstart
= pc
->tend
= pc
->p
++;
1096 pc
->tline
= pc
->linenr
;
1097 pc
->tt
= JIM_TT_STR
;
1105 JimParseComment(pc
);
1109 return JimParseStr(pc
);
1113 return JimParseStr(pc
);
1120 static int JimParseSep(struct JimParserCtx
*pc
)
1123 pc
->tline
= pc
->linenr
;
1124 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' ||
1125 (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1126 if (*pc
->p
== '\\') {
1134 pc
->tend
= pc
->p
- 1;
1135 pc
->tt
= JIM_TT_SEP
;
1139 static int JimParseEol(struct JimParserCtx
*pc
)
1142 pc
->tline
= pc
->linenr
;
1143 while (*pc
->p
== ' ' || *pc
->p
== '\n' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== ';') {
1149 pc
->tend
= pc
->p
- 1;
1150 pc
->tt
= JIM_TT_EOL
;
1154 /* Todo. Don't stop if ']' appears inside {} or quoted.
1155 * Also should handle the case of puts [string length "]"] */
1156 static int JimParseCmd(struct JimParserCtx
*pc
)
1161 pc
->tstart
= ++pc
->p
;
1163 pc
->tline
= pc
->linenr
;
1168 else if (*pc
->p
== '[' && blevel
== 0) {
1171 else if (*pc
->p
== ']' && blevel
== 0) {
1176 else if (*pc
->p
== '\\') {
1182 else if (*pc
->p
== '{') {
1185 else if (*pc
->p
== '}') {
1189 else if (*pc
->p
== '\n')
1194 pc
->tend
= pc
->p
- 1;
1195 pc
->tt
= JIM_TT_CMD
;
1196 if (*pc
->p
== ']') {
1203 static int JimParseVar(struct JimParserCtx
*pc
)
1205 int brace
= 0, stop
= 0, ttype
= JIM_TT_VAR
;
1207 pc
->tstart
= ++pc
->p
;
1208 pc
->len
--; /* skip the $ */
1209 pc
->tline
= pc
->linenr
;
1210 if (*pc
->p
== '{') {
1211 pc
->tstart
= ++pc
->p
;
1217 if (*pc
->p
== '}' || pc
->len
== 0) {
1218 pc
->tend
= pc
->p
- 1;
1223 else if (*pc
->p
== '\n')
1230 /* Include leading colons */
1231 while (*pc
->p
== ':') {
1236 if (!((*pc
->p
>= 'a' && *pc
->p
<= 'z') ||
1237 (*pc
->p
>= 'A' && *pc
->p
<= 'Z') ||
1238 (*pc
->p
>= '0' && *pc
->p
<= '9') || *pc
->p
== '_'))
1245 /* Parse [dict get] syntax sugar. */
1246 if (*pc
->p
== '(') {
1249 while (count
&& pc
->len
) {
1252 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1256 else if (*pc
->p
== '(') {
1259 else if (*pc
->p
== ')') {
1263 if (*pc
->p
!= '\0') {
1267 ttype
= JIM_TT_DICTSUGAR
;
1269 pc
->tend
= pc
->p
- 1;
1271 /* Check if we parsed just the '$' character.
1272 * That's not a variable so an error is returned
1273 * to tell the state machine to consider this '$' just
1275 if (pc
->tstart
== pc
->p
) {
1284 static int JimParseBrace(struct JimParserCtx
*pc
)
1288 pc
->tstart
= ++pc
->p
;
1290 pc
->tline
= pc
->linenr
;
1292 if (*pc
->p
== '\\' && pc
->len
>= 2) {
1298 else if (*pc
->p
== '{') {
1301 else if (pc
->len
== 0 || *pc
->p
== '}') {
1306 if (pc
->len
== 0 || level
== 0) {
1307 pc
->tend
= pc
->p
- 1;
1312 pc
->tt
= JIM_TT_STR
;
1316 else if (*pc
->p
== '\n') {
1322 return JIM_OK
; /* unreached */
1325 static int JimParseStr(struct JimParserCtx
*pc
)
1327 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1328 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
);
1329 if (newword
&& *pc
->p
== '{') {
1330 return JimParseBrace(pc
);
1332 else if (newword
&& *pc
->p
== '"') {
1333 pc
->state
= JIM_PS_QUOTE
;
1338 pc
->tline
= pc
->linenr
;
1341 if (pc
->state
== JIM_PS_QUOTE
) {
1344 pc
->tend
= pc
->p
- 1;
1345 pc
->tt
= JIM_TT_ESC
;
1350 if (pc
->state
== JIM_PS_DEF
&& *(pc
->p
+ 1) == '\n') {
1351 pc
->tend
= pc
->p
- 1;
1352 pc
->tt
= JIM_TT_ESC
;
1356 if (*(pc
->p
+ 1) == '\n') {
1364 /* If the following token is not '$' just keep going */
1365 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1369 /* Only need a separate ')' token if the previous was a var */
1370 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1371 if (pc
->p
== pc
->tstart
) {
1372 /* At the start of the token, so just return this char */
1376 pc
->tend
= pc
->p
- 1;
1377 pc
->tt
= JIM_TT_ESC
;
1384 pc
->tend
= pc
->p
- 1;
1385 pc
->tt
= JIM_TT_ESC
;
1392 if (pc
->state
== JIM_PS_DEF
) {
1393 pc
->tend
= pc
->p
- 1;
1394 pc
->tt
= JIM_TT_ESC
;
1397 else if (*pc
->p
== '\n') {
1402 if (pc
->state
== JIM_PS_QUOTE
) {
1403 pc
->tend
= pc
->p
- 1;
1404 pc
->tt
= JIM_TT_ESC
;
1407 pc
->state
= JIM_PS_DEF
;
1415 return JIM_OK
; /* unreached */
1418 int JimParseComment(struct JimParserCtx
*pc
)
1421 if (*pc
->p
== '\n') {
1423 if (*(pc
->p
- 1) != '\\') {
1435 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1436 static int xdigitval(int c
)
1438 if (c
>= '0' && c
<= '9')
1440 if (c
>= 'a' && c
<= 'f')
1441 return c
- 'a' + 10;
1442 if (c
>= 'A' && c
<= 'F')
1443 return c
- 'A' + 10;
1447 static int odigitval(int c
)
1449 if (c
>= '0' && c
<= '7')
1454 /* Perform Tcl escape substitution of 's', storing the result
1455 * string into 'dest'. The escaped string is guaranteed to
1456 * be the same length or shorted than the source string.
1457 * Slen is the length of the string at 's', if it's -1 the string
1458 * length will be calculated by the function.
1460 * The function returns the length of the resulting string. */
1461 static int JimEscape(char *dest
, const char *s
, int slen
)
1469 for (i
= 0; i
< slen
; i
++) {
1510 if (s
[i
+ 1] == 'x') {
1512 int c
= xdigitval(s
[i
+ 2]);
1520 c
= xdigitval(s
[i
+ 3]);
1526 val
= (val
* 16) + c
;
1531 else if (s
[i
+ 1] >= '0' && s
[i
+ 1] <= '7') {
1533 int c
= odigitval(s
[i
+ 1]);
1536 c
= odigitval(s
[i
+ 2]);
1542 val
= (val
* 8) + c
;
1543 c
= odigitval(s
[i
+ 3]);
1549 val
= (val
* 8) + c
;
1570 /* Returns a dynamically allocated copy of the current token in the
1571 * parser context. The function performs conversion of escapes if
1572 * the token is of type JIM_TT_ESC.
1574 * Note that after the conversion, tokens that are grouped with
1575 * braces in the source code, are always recognizable from the
1576 * identical string obtained in a different way from the type.
1578 * For example the string:
1582 * will return as first token "*", of type JIM_TT_STR
1588 * will return as first token "*", of type JIM_TT_ESC
1590 char *JimParserGetToken(struct JimParserCtx
*pc
, int *lenPtr
, int *typePtr
, int *linePtr
)
1592 const char *start
, *end
;
1596 start
= JimParserTstart(pc
);
1597 end
= JimParserTend(pc
);
1600 token
= Jim_Alloc(1);
1604 len
= (end
- start
) + 1;
1605 token
= Jim_Alloc(len
+ 1);
1606 if (JimParserTtype(pc
) != JIM_TT_ESC
) {
1607 /* No escape conversion needed? Just copy it. */
1608 memcpy(token
, start
, len
);
1612 /* Else convert the escape chars. */
1613 len
= JimEscape(token
, start
, len
);
1619 *typePtr
= JimParserTtype(pc
);
1621 *linePtr
= JimParserTline(pc
);
1625 /* Parses the given string to determine if it represents a complete script.
1627 * This is useful for interactive shells implementation, for [info complete]
1628 * and is used by source/Jim_EvalFile().
1630 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1631 * '{' on scripts incomplete missing one or more '}' to be balanced.
1632 * '"' on scripts incomplete missing a '"' char.
1634 * If the script is complete, 1 is returned, otherwise 0.
1636 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
1638 struct JimParserCtx parser
;
1640 JimParserInit(&parser
, s
, len
, 1);
1641 while (!JimParserEof(&parser
)) {
1642 JimParseScript(&parser
);
1645 *stateCharPtr
= parser
.missing
;
1647 return parser
.missing
== ' ';
1650 /* -----------------------------------------------------------------------------
1652 * ---------------------------------------------------------------------------*/
1653 static int JimParseListSep(struct JimParserCtx
*pc
);
1654 static int JimParseListStr(struct JimParserCtx
*pc
);
1656 int JimParseList(struct JimParserCtx
*pc
)
1659 pc
->tstart
= pc
->tend
= pc
->p
;
1660 pc
->tline
= pc
->linenr
;
1661 pc
->tt
= JIM_TT_EOL
;
1670 if (pc
->state
== JIM_PS_DEF
)
1671 return JimParseListSep(pc
);
1673 return JimParseListStr(pc
);
1676 return JimParseListStr(pc
);
1682 int JimParseListSep(struct JimParserCtx
*pc
)
1685 pc
->tline
= pc
->linenr
;
1686 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== '\n') {
1690 pc
->tend
= pc
->p
- 1;
1691 pc
->tt
= JIM_TT_SEP
;
1695 int JimParseListStr(struct JimParserCtx
*pc
)
1697 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
|| pc
->tt
== JIM_TT_NONE
);
1699 if (newword
&& *pc
->p
== '{') {
1700 return JimParseBrace(pc
);
1702 else if (newword
&& *pc
->p
== '"') {
1703 pc
->state
= JIM_PS_QUOTE
;
1708 pc
->tline
= pc
->linenr
;
1711 pc
->tend
= pc
->p
- 1;
1712 pc
->tt
= JIM_TT_ESC
;
1724 if (pc
->state
== JIM_PS_DEF
) {
1725 pc
->tend
= pc
->p
- 1;
1726 pc
->tt
= JIM_TT_ESC
;
1729 else if (*pc
->p
== '\n') {
1734 if (pc
->state
== JIM_PS_QUOTE
) {
1735 pc
->tend
= pc
->p
- 1;
1736 pc
->tt
= JIM_TT_ESC
;
1739 pc
->state
= JIM_PS_DEF
;
1747 return JIM_OK
; /* unreached */
1750 /* -----------------------------------------------------------------------------
1751 * Jim_Obj related functions
1752 * ---------------------------------------------------------------------------*/
1754 /* Return a new initialized object. */
1755 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
1759 /* -- Check if there are objects in the free list -- */
1760 if (interp
->freeList
!= NULL
) {
1761 /* -- Unlink the object from the free list -- */
1762 objPtr
= interp
->freeList
;
1763 interp
->freeList
= objPtr
->nextObjPtr
;
1766 /* -- No ready to use objects: allocate a new one -- */
1767 objPtr
= Jim_Alloc(sizeof(*objPtr
));
1770 /* Object is returned with refCount of 0. Every
1771 * kind of GC implemented should take care to don't try
1772 * to scan objects with refCount == 0. */
1773 objPtr
->refCount
= 0;
1774 /* All the other fields are left not initialized to save time.
1775 * The caller will probably want to set them to the right
1778 /* -- Put the object into the live list -- */
1779 objPtr
->prevObjPtr
= NULL
;
1780 objPtr
->nextObjPtr
= interp
->liveList
;
1781 if (interp
->liveList
)
1782 interp
->liveList
->prevObjPtr
= objPtr
;
1783 interp
->liveList
= objPtr
;
1788 /* Free an object. Actually objects are never freed, but
1789 * just moved to the free objects list, where they will be
1790 * reused by Jim_NewObj(). */
1791 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1793 /* Check if the object was already freed, panic. */
1794 if (objPtr
->refCount
!= 0) {
1795 Jim_Panic(interp
, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
1796 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>");
1799 /* Free the internal representation */
1800 Jim_FreeIntRep(interp
, objPtr
);
1801 /* Free the string representation */
1802 if (objPtr
->bytes
!= NULL
) {
1803 if (objPtr
->bytes
!= JimEmptyStringRep
)
1804 Jim_Free(objPtr
->bytes
);
1806 /* Unlink the object from the live objects list */
1807 if (objPtr
->prevObjPtr
)
1808 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
1809 if (objPtr
->nextObjPtr
)
1810 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
1811 if (interp
->liveList
== objPtr
)
1812 interp
->liveList
= objPtr
->nextObjPtr
;
1813 /* Link the object into the free objects list */
1814 objPtr
->prevObjPtr
= NULL
;
1815 objPtr
->nextObjPtr
= interp
->freeList
;
1816 if (interp
->freeList
)
1817 interp
->freeList
->prevObjPtr
= objPtr
;
1818 interp
->freeList
= objPtr
;
1819 objPtr
->refCount
= -1;
1822 /* Invalidate the string representation of an object. */
1823 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
1825 if (objPtr
->bytes
!= NULL
) {
1826 if (objPtr
->bytes
!= JimEmptyStringRep
)
1827 Jim_Free(objPtr
->bytes
);
1829 objPtr
->bytes
= NULL
;
1832 #define Jim_SetStringRep(o, b, l) \
1833 do { (o)->bytes = b; (o)->length = l; } while (0)
1835 /* Set the initial string representation for an object.
1836 * Does not try to free an old one. */
1837 void Jim_InitStringRep(Jim_Obj
*objPtr
, const char *bytes
, int length
)
1840 objPtr
->bytes
= JimEmptyStringRep
;
1844 objPtr
->bytes
= Jim_Alloc(length
+ 1);
1845 objPtr
->length
= length
;
1846 memcpy(objPtr
->bytes
, bytes
, length
);
1847 objPtr
->bytes
[length
] = '\0';
1851 /* Duplicate an object. The returned object has refcount = 0. */
1852 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1856 dupPtr
= Jim_NewObj(interp
);
1857 if (objPtr
->bytes
== NULL
) {
1858 /* Object does not have a valid string representation. */
1859 dupPtr
->bytes
= NULL
;
1862 Jim_InitStringRep(dupPtr
, objPtr
->bytes
, objPtr
->length
);
1864 if (objPtr
->typePtr
!= NULL
) {
1865 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
1866 dupPtr
->internalRep
= objPtr
->internalRep
;
1869 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
1871 dupPtr
->typePtr
= objPtr
->typePtr
;
1874 dupPtr
->typePtr
= NULL
;
1879 /* Return the string representation for objPtr. If the object
1880 * string representation is invalid, calls the method to create
1881 * a new one starting from the internal representation of the object. */
1882 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
1884 if (objPtr
->bytes
== NULL
) {
1885 /* Invalid string repr. Generate it. */
1886 if (objPtr
->typePtr
->updateStringProc
== NULL
) {
1887 Jim_Panic(NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
);
1889 objPtr
->typePtr
->updateStringProc(objPtr
);
1892 *lenPtr
= objPtr
->length
;
1893 return objPtr
->bytes
;
1896 /* Just returns the length of the object's string rep */
1897 int Jim_Length(Jim_Obj
*objPtr
)
1901 Jim_GetString(objPtr
, &len
);
1905 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
1906 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
1908 static const Jim_ObjType dictSubstObjType
= {
1909 "dict-substitution",
1910 FreeDictSubstInternalRep
,
1911 DupDictSubstInternalRep
,
1916 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1918 Jim_DecrRefCount(interp
, (Jim_Obj
*)objPtr
->internalRep
.twoPtrValue
.ptr2
);
1921 static const Jim_ObjType interpolatedObjType
= {
1923 FreeInterpolatedInternalRep
,
1929 /* -----------------------------------------------------------------------------
1931 * ---------------------------------------------------------------------------*/
1932 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
1933 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
1935 static const Jim_ObjType stringObjType
= {
1938 DupStringInternalRep
,
1940 JIM_TYPE_REFERENCES
,
1943 void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
1945 JIM_NOTUSED(interp
);
1947 /* This is a bit subtle: the only caller of this function
1948 * should be Jim_DuplicateObj(), that will copy the
1949 * string representaion. After the copy, the duplicated
1950 * object will not have more room in teh buffer than
1951 * srcPtr->length bytes. So we just set it to length. */
1952 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
1955 int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
1957 /* Get a fresh string representation. */
1958 (void)Jim_GetString(objPtr
, NULL
);
1959 /* Free any other internal representation. */
1960 Jim_FreeIntRep(interp
, objPtr
);
1961 /* Set it as string, i.e. just set the maxLength field. */
1962 objPtr
->typePtr
= &stringObjType
;
1963 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
1967 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
1969 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
1973 /* Alloc/Set the string rep. */
1975 objPtr
->bytes
= JimEmptyStringRep
;
1979 objPtr
->bytes
= Jim_Alloc(len
+ 1);
1980 objPtr
->length
= len
;
1981 memcpy(objPtr
->bytes
, s
, len
);
1982 objPtr
->bytes
[len
] = '\0';
1985 /* No typePtr field for the vanilla string object. */
1986 objPtr
->typePtr
= NULL
;
1990 /* This version does not try to duplicate the 's' pointer, but
1991 * use it directly. */
1992 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
1994 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
1998 Jim_SetStringRep(objPtr
, s
, len
);
1999 objPtr
->typePtr
= NULL
;
2003 /* Low-level string append. Use it only against objects
2004 * of type "string". */
2005 void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2011 needlen
= objPtr
->length
+ len
;
2012 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2013 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2014 if (objPtr
->bytes
== JimEmptyStringRep
) {
2015 objPtr
->bytes
= Jim_Alloc((needlen
* 2) + 1);
2018 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, (needlen
* 2) + 1);
2020 objPtr
->internalRep
.strValue
.maxLength
= needlen
* 2;
2022 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2023 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2024 objPtr
->length
+= len
;
2027 /* Higher level API to append strings to objects. */
2028 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2030 if (Jim_IsShared(objPtr
))
2031 Jim_Panic(interp
, "Jim_AppendString called with shared object");
2032 if (objPtr
->typePtr
!= &stringObjType
)
2033 SetStringFromAny(interp
, objPtr
);
2034 StringAppendString(objPtr
, str
, len
);
2037 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2042 str
= Jim_GetString(appendObjPtr
, &len
);
2043 Jim_AppendString(interp
, objPtr
, str
, len
);
2046 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2050 if (objPtr
->typePtr
!= &stringObjType
)
2051 SetStringFromAny(interp
, objPtr
);
2052 va_start(ap
, objPtr
);
2054 char *s
= va_arg(ap
, char *);
2058 Jim_AppendString(interp
, objPtr
, s
, -1);
2063 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
, int nocase
)
2065 const char *aStr
, *bStr
;
2068 if (aObjPtr
== bObjPtr
)
2070 aStr
= Jim_GetString(aObjPtr
, &aLen
);
2071 bStr
= Jim_GetString(bObjPtr
, &bLen
);
2075 return memcmp(aStr
, bStr
, aLen
) == 0;
2076 for (i
= 0; i
< aLen
; i
++) {
2077 if (tolower((int)aStr
[i
]) != tolower((int)bStr
[i
]))
2083 int Jim_StringMatchObj(Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2085 const char *pattern
, *string
;
2086 int patternLen
, stringLen
;
2088 pattern
= Jim_GetString(patternObjPtr
, &patternLen
);
2089 string
= Jim_GetString(objPtr
, &stringLen
);
2090 return JimStringMatch(pattern
, patternLen
, string
, stringLen
, nocase
);
2093 int Jim_StringCompareObj(Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2095 const char *s1
, *s2
;
2098 s1
= Jim_GetString(firstObjPtr
, &l1
);
2099 s2
= Jim_GetString(secondObjPtr
, &l2
);
2100 return JimStringCompare(s1
, l1
, s2
, l2
, nocase
);
2103 /* Convert a range, as returned by Jim_GetRange(), into
2104 * an absolute index into an object of the specified length.
2105 * This function may return negative values, or values
2106 * bigger or equal to the length of the list if the index
2107 * is out of range. */
2108 static int JimRelToAbsIndex(int len
, int index
)
2115 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2116 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2117 * for implementation of commands like [string range] and [lrange].
2119 * The resulting range is guaranteed to address valid elements of
2121 static void JimRelToAbsRange(int len
, int first
, int last
,
2122 int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2130 rangeLen
= last
- first
+ 1;
2137 rangeLen
-= (last
- (len
- 1));
2147 *rangeLenPtr
= rangeLen
;
2150 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2151 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2157 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
2158 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
2160 str
= Jim_GetString(strObjPtr
, &len
);
2161 first
= JimRelToAbsIndex(len
, first
);
2162 last
= JimRelToAbsIndex(len
, last
);
2163 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
2164 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2167 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2172 if (strObjPtr
->typePtr
!= &stringObjType
) {
2173 SetStringFromAny(interp
, strObjPtr
);
2176 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2178 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2179 for (i
= 0; i
< strObjPtr
->length
; i
++)
2180 buf
[i
] = tolower(buf
[i
]);
2181 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2184 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2189 if (strObjPtr
->typePtr
!= &stringObjType
) {
2190 SetStringFromAny(interp
, strObjPtr
);
2193 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2195 memcpy(buf
, strObjPtr
->bytes
, strObjPtr
->length
+ 1);
2196 for (i
= 0; i
< strObjPtr
->length
; i
++)
2197 buf
[i
] = toupper(buf
[i
]);
2198 return Jim_NewStringObjNoAlloc(interp
, buf
, strObjPtr
->length
);
2201 static const char *trim_left(const char *str
, const char *trimchars
)
2203 return str
+ strspn(str
, trimchars
);
2206 static void trim_right(char *str
, const char *trimchars
)
2208 char *p
= str
+ strlen(str
) - 1;
2209 char *end
= str
- 1;
2214 if (strchr(trimchars
, c
) == 0) {
2222 static const char default_trim_chars
[] = " \t\n\r";
2224 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2227 const char *trimchars
= default_trim_chars
;
2229 if (strObjPtr
->typePtr
!= &stringObjType
) {
2230 SetStringFromAny(interp
, strObjPtr
);
2232 if (trimcharsObjPtr
) {
2233 trimchars
= Jim_GetString(trimcharsObjPtr
, NULL
);
2236 buf
= Jim_Alloc(strObjPtr
->length
+ 1);
2237 strcpy(buf
, trim_left(strObjPtr
->bytes
, trimchars
));
2238 trim_right(buf
, trimchars
);
2240 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2243 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2245 const char *str
= Jim_GetString(strObjPtr
, NULL
);
2246 const char *trimchars
= default_trim_chars
;
2248 if (trimcharsObjPtr
) {
2249 trimchars
= Jim_GetString(trimcharsObjPtr
, NULL
);
2252 return Jim_NewStringObj(interp
, trim_left(str
, trimchars
), -1);
2255 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2258 const char *trimchars
= default_trim_chars
;
2260 if (trimcharsObjPtr
) {
2261 trimchars
= Jim_GetString(trimcharsObjPtr
, NULL
);
2265 if (strObjPtr
->typePtr
!= &stringObjType
) {
2266 SetStringFromAny(interp
, strObjPtr
);
2269 buf
= Jim_StrDup(strObjPtr
->bytes
);
2270 trim_right(buf
, trimchars
);
2272 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2276 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2278 static const char *strclassnames
[] = {
2279 "integer", "alpha", "alnum", "ascii", "digit",
2280 "double", "lower", "upper", "space", "xdigit",
2281 "control", "print", "graph", "punct",
2285 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2286 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2287 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
2293 int (*isclassfunc
)(int c
) = NULL
;
2295 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2299 str
= Jim_GetString(strObjPtr
, &len
);
2301 Jim_SetResultInt(interp
, !strict
);
2306 case STR_IS_INTEGER
:
2309 Jim_SetResultInt(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
2316 Jim_SetResultInt(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
2320 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
2321 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
2322 case STR_IS_ASCII
: isclassfunc
= isascii
; break;
2323 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
2324 case STR_IS_LOWER
: isclassfunc
= islower
; break;
2325 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
2326 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
2327 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
2328 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
2329 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
2330 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
2331 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
2336 for (i
= 0; i
< len
; i
++) {
2337 if (!isclassfunc(str
[i
])) {
2338 Jim_SetResultInt(interp
, 0);
2342 Jim_SetResultInt(interp
, 1);
2346 /* This is the core of the [format] command.
2347 * TODO: Lots of things work - via a hack
2348 * However, no format item can be >= JIM_MAX_FMT
2350 #define JIM_MAX_FMT 2048
2351 static Jim_Obj
*Jim_FormatString_Inner(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
,
2352 int objc
, Jim_Obj
*const *objv
, char *sprintf_buf
)
2359 fmt
= Jim_GetString(fmtObjPtr
, &fmtLen
);
2360 resObjPtr
= Jim_NewStringObj(interp
, "", 0);
2362 const char *p
= fmt
;
2367 /* we cheat and use Sprintf()! */
2382 while (*fmt
!= '%' && fmtLen
) {
2386 Jim_AppendString(interp
, resObjPtr
, p
, fmt
- p
);
2390 fmtLen
--; /* skip '%' */
2393 Jim_AppendString(interp
, resObjPtr
, "%", 1);
2406 prec
= -1; /* not found yet */
2413 case 'b': /* binary - not all printfs() do this */
2414 case 's': /* string */
2415 case 'i': /* integer */
2416 case 'd': /* decimal */
2418 case 'X': /* CAP hex */
2419 case 'c': /* char */
2420 case 'o': /* octal */
2421 case 'u': /* unsigned */
2422 case 'f': /* float */
2432 case ' ': /* sign space */
2476 while (isdigit(*fmt
) && (fmtLen
> 0)) {
2477 accum
= (accum
* 10) + (*fmt
- '0');
2490 /* suck up the next item as an integer */
2495 goto not_enough_args
;
2497 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2498 Jim_FreeNewObj(interp
, resObjPtr
);
2505 /* man 3 printf says */
2506 /* if prec is negative, it is zero */
2526 Jim_FreeNewObj(interp
, resObjPtr
);
2527 Jim_SetResultString(interp
, "not enough arguments for all format specifiers", -1);
2536 * Create the formatter
2537 * cause we cheat and use sprintf()
2548 /* PLUS overrides */
2558 sprintf(cp
, "%d", width
);
2562 /* did we find a period? */
2566 /* did something occur after the period? */
2568 sprintf(cp
, "%d", prec
);
2574 /* here we do the work */
2575 /* actually - we make sprintf() do it for us */
2580 /* BUG: we do not handled embeded NULLs */
2581 buflen
= snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, Jim_GetString(objv
[0], NULL
));
2586 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2587 Jim_FreeNewObj(interp
, resObjPtr
);
2590 c
= (char)wideValue
;
2591 buflen
= snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, c
);
2601 if (Jim_GetDouble(interp
, objv
[0], &doubleValue
) == JIM_ERR
) {
2602 Jim_FreeNewObj(interp
, resObjPtr
);
2605 buflen
= snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, doubleValue
);
2615 #ifdef HAVE_LONG_LONG
2616 /* jim widevaluse are 64bit */
2617 if (sizeof(jim_wide
) == sizeof(long long)) {
2623 if (Jim_GetWide(interp
, objv
[0], &wideValue
) == JIM_ERR
) {
2624 Jim_FreeNewObj(interp
, resObjPtr
);
2627 buflen
= snprintf(sprintf_buf
, JIM_MAX_FMT
, fmt_str
, wideValue
);
2630 sprintf_buf
[0] = '%';
2632 objv
--; /* undo the objv++ below */
2637 Jim_SetResultFormatted(interp
, "bad field specifier \"%s\"", spec
);
2638 Jim_FreeNewObj(interp
, resObjPtr
);
2641 /* force terminate */
2643 printf("FMT was: %s\n", fmt_str
);
2644 printf("RES was: |%s|\n", sprintf_buf
);
2647 Jim_AppendString(interp
, resObjPtr
, sprintf_buf
,
2648 buflen
<= JIM_MAX_FMT
? buflen
: JIM_MAX_FMT
);
2657 Jim_Obj
*Jim_FormatString(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
, int objc
, Jim_Obj
*const *objv
)
2659 char *sprintf_buf
= malloc(JIM_MAX_FMT
);
2660 Jim_Obj
*t
= Jim_FormatString_Inner(interp
, fmtObjPtr
, objc
, objv
, sprintf_buf
);
2666 /* -----------------------------------------------------------------------------
2667 * Compared String Object
2668 * ---------------------------------------------------------------------------*/
2670 /* This is strange object that allows to compare a C literal string
2671 * with a Jim object in very short time if the same comparison is done
2672 * multiple times. For example every time the [if] command is executed,
2673 * Jim has to check if a given argument is "else". This comparions if
2674 * the code has no errors are true most of the times, so we can cache
2675 * inside the object the pointer of the string of the last matching
2676 * comparison. Because most C compilers perform literal sharing,
2677 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2678 * this works pretty well even if comparisons are at different places
2679 * inside the C code. */
2681 static const Jim_ObjType comparedStringObjType
= {
2686 JIM_TYPE_REFERENCES
,
2689 /* The only way this object is exposed to the API is via the following
2690 * function. Returns true if the string and the object string repr.
2691 * are the same, otherwise zero is returned.
2693 * Note: this isn't binary safe, but it hardly needs to be.*/
2694 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
2696 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
)
2699 const char *objStr
= Jim_GetString(objPtr
, NULL
);
2701 if (strcmp(str
, objStr
) != 0)
2703 if (objPtr
->typePtr
!= &comparedStringObjType
) {
2704 Jim_FreeIntRep(interp
, objPtr
);
2705 objPtr
->typePtr
= &comparedStringObjType
;
2707 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
2712 int qsortCompareStringPointers(const void *a
, const void *b
)
2714 char *const *sa
= (char *const *)a
;
2715 char *const *sb
= (char *const *)b
;
2717 return strcmp(*sa
, *sb
);
2721 /* -----------------------------------------------------------------------------
2724 * This object is just a string from the language point of view, but
2725 * in the internal representation it contains the filename and line number
2726 * where this given token was read. This information is used by
2727 * Jim_EvalObj() if the object passed happens to be of type "source".
2729 * This allows to propagate the information about line numbers and file
2730 * names and give error messages with absolute line numbers.
2732 * Note that this object uses shared strings for filenames, and the
2733 * pointer to the filename together with the line number is taken into
2734 * the space for the "inline" internal representation of the Jim_Object,
2735 * so there is almost memory zero-overhead.
2737 * Also the object will be converted to something else if the given
2738 * token it represents in the source file is not something to be
2739 * evaluated (not a script), and will be specialized in some other way,
2740 * so the time overhead is also null.
2741 * ---------------------------------------------------------------------------*/
2743 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2744 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2746 static const Jim_ObjType sourceObjType
= {
2748 FreeSourceInternalRep
,
2749 DupSourceInternalRep
,
2751 JIM_TYPE_REFERENCES
,
2754 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2756 Jim_ReleaseSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
2759 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2761 dupPtr
->internalRep
.sourceValue
.fileName
=
2762 Jim_GetSharedString(interp
, srcPtr
->internalRep
.sourceValue
.fileName
);
2763 dupPtr
->internalRep
.sourceValue
.lineNumber
= dupPtr
->internalRep
.sourceValue
.lineNumber
;
2764 dupPtr
->typePtr
= &sourceObjType
;
2767 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
2768 const char *fileName
, int lineNumber
)
2770 if (Jim_IsShared(objPtr
))
2771 Jim_Panic(interp
, "JimSetSourceInfo called with shared object");
2772 if (objPtr
->typePtr
!= NULL
)
2773 Jim_Panic(interp
, "JimSetSourceInfo called with typePtr != NULL");
2774 objPtr
->internalRep
.sourceValue
.fileName
= Jim_GetSharedString(interp
, fileName
);
2775 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
2776 objPtr
->typePtr
= &sourceObjType
;
2779 /* -----------------------------------------------------------------------------
2781 * ---------------------------------------------------------------------------*/
2783 #define JIM_CMDSTRUCT_EXPAND -1
2785 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2786 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2787 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2789 static const Jim_ObjType scriptObjType
= {
2791 FreeScriptInternalRep
,
2792 DupScriptInternalRep
,
2794 JIM_TYPE_REFERENCES
,
2797 /* The ScriptToken structure represents every token into a scriptObj.
2798 * Every token contains an associated Jim_Obj that can be specialized
2799 * by commands operating on it. */
2800 typedef struct ScriptToken
2807 /* This is the script object internal representation. An array of
2808 * ScriptToken structures, with an associated command structure array.
2809 * The command structure is a pre-computed representation of the
2810 * command length and arguments structure as a simple liner array
2813 * For example the script:
2816 * set $i $x$y [foo]BAR
2818 * will produce a ScriptObj with the following Tokens:
2835 * This is a description of the tokens, separators, and of lines.
2836 * The command structure instead represents the number of arguments
2837 * of every command, followed by the tokens of which every argument
2838 * is composed. So for the example script, the cmdstruct array will
2843 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2844 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2845 * composed of single tokens (1 1) and the last two of double tokens
2848 * The precomputation of the command structure makes Jim_Eval() faster,
2849 * and simpler because there aren't dynamic lengths / allocations.
2851 * -- {expand}/{*} handling --
2853 * Expand is handled in a special way. When a command
2854 * contains at least an argument with the {expand} or {*} prefix,
2855 * the command structure presents a -1 before the integer
2856 * describing the number of arguments. This is used in order
2857 * to send the command exection to a different path in case
2858 * of {expand} and guarantee a fast path for the more common
2859 * case. Also, the integers describing the number of tokens
2860 * are expressed with negative sign, to allow for fast check
2861 * of what's an {expand}-prefixed argument and what not.
2863 * For example the command:
2865 * list {expand}{1 2}
2867 * Will produce the following cmdstruct array:
2871 * -- the substFlags field of the structure --
2873 * The scriptObj structure is used to represent both "script" objects
2874 * and "subst" objects. In the second case, the cmdStruct related
2875 * fields are not used at all, but there is an additional field used
2876 * that is 'substFlags': this represents the flags used to turn
2877 * the string into the internal representation used to perform the
2878 * substitution. If this flags are not what the application requires
2879 * the scriptObj is created again. For example the script:
2881 * subst -nocommands $string
2882 * subst -novariables $string
2884 * Will recreate the internal representation of the $string object
2887 typedef struct ScriptObj
2889 int len
; /* Length as number of tokens. */
2890 ScriptToken
*token
; /* Tokens array. */
2891 int *cmdStruct
; /* commands structure */
2892 int csLen
; /* length of the cmdStruct array. */
2893 int substFlags
; /* flags used for the compilation of "subst" objects */
2894 int inUse
; /* Used to share a ScriptObj. Currently
2895 only used by Jim_EvalObj() as protection against
2896 shimmering of the currently evaluated object. */
2900 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2903 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
2906 if (script
->inUse
!= 0)
2908 for (i
= 0; i
< script
->len
; i
++) {
2909 if (script
->token
[i
].objPtr
!= NULL
) {
2910 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
2913 Jim_Free(script
->token
);
2914 Jim_Free(script
->cmdStruct
);
2915 Jim_Free(script
->fileName
);
2919 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2921 JIM_NOTUSED(interp
);
2922 JIM_NOTUSED(srcPtr
);
2924 /* Just returns an simple string. */
2925 dupPtr
->typePtr
= NULL
;
2928 /* A simple parser token.
2929 * All the simple tokens for the script point into the same script string rep.
2933 const char *token
; /* Pointer to the start of the token */
2934 int len
; /* Length of this token */
2935 int type
; /* Token type */
2936 int line
; /* Line number */
2939 /* A list of parsed tokens representing a script.
2940 * Tokens are added to this list as the script is parsed.
2941 * It grows as needed.
2945 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
2946 ParseToken
*list
; /* Array of tokens */
2947 int size
; /* Current size of the list */
2948 int count
; /* Number of entries used */
2949 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
2952 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
2954 tokenlist
->list
= tokenlist
->static_list
;
2955 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
2956 tokenlist
->count
= 0;
2959 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
2961 if (tokenlist
->list
!= tokenlist
->static_list
) {
2962 Jim_Free(tokenlist
->list
);
2967 * Adds the new token to the tokenlist.
2968 * The token has the given length, type and line number.
2969 * The token list is resized as necessary.
2971 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
2976 if (tokenlist
->count
== tokenlist
->size
) {
2977 /* Resize the list */
2978 tokenlist
->size
*= 2;
2979 if (tokenlist
->list
!= tokenlist
->static_list
) {
2981 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
2984 /* The list needs to become allocated */
2985 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
2986 memcpy(tokenlist
->list
, tokenlist
->static_list
,
2987 tokenlist
->count
* sizeof(*tokenlist
->list
));
2990 t
= &tokenlist
->list
[tokenlist
->count
++];
2998 * Takes a tokenlist and creates the allocated list of script tokens
2999 * in script->token, of length script->len.
3001 * Unnecessary tokens are discarded, and some tokens may be consolidated into
3004 * Also counts the required cmdStruct length in script->csLen.
3006 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3007 ParseTokenList
*tokenlist
)
3010 struct ScriptToken
*token
;
3011 int prevtype
= JIM_TT_EOL
;
3013 /* Be pessimistic. This will definitely be big enough since at least the EOF token
3016 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3019 for (i
= 0; i
< tokenlist
->count
; i
++) {
3020 const ParseToken
*t
= &tokenlist
->list
[i
];
3022 if (t
->type
== JIM_TT_EOF
) {
3028 /* Combine multiple EOLs to one */
3029 if (prevtype
== JIM_TT_EOL
) {
3032 token
->objPtr
= interp
->emptyObj
;
3037 /* Skip SEP before or after EOL */
3038 if (prevtype
== JIM_TT_EOL
|| t
[1].type
== JIM_TT_EOL
) {
3041 token
->objPtr
= interp
->emptyObj
;
3049 if (t
->type
== JIM_TT_ESC
) {
3050 /* Convert the escape chars. */
3051 str
= Jim_Alloc(len
+ 1);
3052 len
= JimEscape(str
, t
->token
, len
);
3055 /* No escape conversion needed, so just copy it. */
3056 str
= Jim_StrDupLen(t
->token
, len
);
3059 /* Every object is initially a string, but the
3060 * internal type may be specialized during execution of the
3062 token
->objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3064 if (script
->fileName
) {
3065 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileName
, t
->line
);
3071 token
->type
= t
->type
;
3072 token
->linenr
= t
->line
;
3074 Jim_IncrRefCount(token
->objPtr
);
3080 script
->len
= token
- script
->token
;
3083 #ifdef JIM_OPTIMIZATION
3086 * An optimised version of ScriptObjAddTokens() for subst objects.
3088 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3089 ParseTokenList
*tokenlist
)
3092 struct ScriptToken
*token
;
3094 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3096 for (i
= 0; i
< tokenlist
->count
; i
++) {
3097 ParseToken
*t
= &tokenlist
->list
[i
];
3101 /* Create a token for 't' */
3102 token
->type
= t
->type
;
3103 token
->linenr
= t
->line
;
3107 if (t
->type
!= JIM_TT_ESC
) {
3108 /* No escape conversion needed, so just copy it. */
3109 str
= Jim_StrDupLen(t
->token
, len
);
3112 /* Else convert the escape chars. */
3113 str
= Jim_Alloc(len
+ 1);
3114 len
= JimEscape(str
, t
->token
, len
);
3117 /* Every object is initially a string, but the
3118 * internal type may be specialized during execution of the
3120 token
->objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3122 /* To add source info to SEP and EOL tokens is useless because
3123 * they will never by called as arguments of Jim_EvalObj(). */
3124 Jim_IncrRefCount(token
->objPtr
);
3132 /* This method takes the string representation of an object
3133 * as a Tcl script, and generates the pre-parsed internal representation
3135 int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3138 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3139 struct JimParserCtx parser
;
3140 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
3144 int initialLineNumber
;
3145 ParseTokenList tokenlist
;
3152 /* Try to get information about filename / line number */
3153 if (objPtr
->typePtr
== &sourceObjType
) {
3154 script
->fileName
= Jim_StrDup(objPtr
->internalRep
.sourceValue
.fileName
);
3155 initialLineNumber
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3158 script
->fileName
= NULL
;
3159 initialLineNumber
= 1;
3162 /* Initially parse the script into tokens (in tokenlist) */
3163 ScriptTokenListInit(&tokenlist
);
3165 JimParserInit(&parser
, scriptText
, scriptTextLen
, initialLineNumber
);
3166 while (!JimParserEof(&parser
)) {
3167 JimParseScript(&parser
);
3168 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3171 /* Add a final EOF token */
3172 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3174 /* Create the "real" script tokens from the initial token list */
3175 script
->substFlags
= 0;
3177 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3179 /* No longer need the token list */
3180 ScriptTokenListFree(&tokenlist
);
3182 if (!script
->fileName
) {
3183 script
->fileName
= Jim_StrDup("");
3187 printf("==== Script ====\n");
3188 for (i
= 0; i
< script
->len
; i
++) {
3189 printf("[%2d] %s (%d)'%s'\n", i
, tt_name(script
->token
[i
].type
),
3190 script
->token
[i
].objPtr
->length
, script
->token
[i
].objPtr
->bytes
);
3194 /* Compute the command structure array
3195 * (see the ScriptObj struct definition for more info).
3196 * Note that the required size has already been calculated in script->csLen.
3199 cs
= script
->cmdStruct
= Jim_Alloc(sizeof(int) * (script
->csLen
));
3201 token
= script
->token
;
3203 line_expand
= 0; /* expand is used on this line */
3204 arg_expand
= 0; /* expand is used on this argument */
3205 csp
= cs
++; /* points to argument count */
3206 args
= 1; /* Number of args on this line */
3207 tokens
= 0; /* Number of tokens in current argument. */
3209 for (i
= 0; i
< script
->len
; i
++) {
3210 ScriptToken
*t
= &token
[i
];
3212 if (tokens
== 0 && t
[0].type
== JIM_TT_STR
&&
3213 t
[1].type
!= JIM_TT_SEP
&& t
[1].type
!= JIM_TT_EOL
&&
3214 (!strcmp(t
->objPtr
->bytes
, "expand") || !strcmp(t
->objPtr
->bytes
, "*"))) {
3216 arg_expand
= line_expand
= 1;
3219 if (t
->type
== JIM_TT_SEP
|| t
->type
== JIM_TT_EOL
) {
3220 /* Now add info about the number of tokens. -ve is list expansion is involved */
3221 *cs
++ = arg_expand
? -tokens
: tokens
;
3225 if (t
->type
== JIM_TT_EOL
) {
3226 /* End of line. Back patch the arg count */
3227 /* Negative value if there is list expansion involved. */
3246 for (i
= 0; i
< script
->csLen
; i
++) {
3247 printf("cs[%d]=%d\n", i
, script
->cmdStruct
[i
]);
3251 /* Free the old internal rep and set the new one. */
3252 Jim_FreeIntRep(interp
, objPtr
);
3253 Jim_SetIntRepPtr(objPtr
, script
);
3254 objPtr
->typePtr
= &scriptObjType
;
3259 ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3261 struct ScriptObj
*script
= Jim_GetIntRepPtr(objPtr
);
3263 if (objPtr
->typePtr
!= &scriptObjType
|| script
->substFlags
) {
3264 SetScriptFromAny(interp
, objPtr
);
3266 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
3269 /* -----------------------------------------------------------------------------
3271 * ---------------------------------------------------------------------------*/
3272 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3277 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3279 if (--cmdPtr
->inUse
== 0) {
3280 if (cmdPtr
->cmdProc
== NULL
) {
3281 Jim_DecrRefCount(interp
, cmdPtr
->argListObjPtr
);
3282 Jim_DecrRefCount(interp
, cmdPtr
->bodyObjPtr
);
3283 if (cmdPtr
->staticVars
) {
3284 Jim_FreeHashTable(cmdPtr
->staticVars
);
3285 Jim_Free(cmdPtr
->staticVars
);
3288 else if (cmdPtr
->delProc
!= NULL
) {
3289 /* If it was a C coded command, call the delProc if any */
3290 cmdPtr
->delProc(interp
, cmdPtr
->privData
);
3296 /* Commands HashTable Type.
3298 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3299 static void Jim_CommandsHT_ValDestructor(void *interp
, void *val
)
3301 JimDecrCmdRefCount(interp
, val
);
3304 static const Jim_HashTableType JimCommandsHashTableType
= {
3305 JimStringCopyHTHashFunction
, /* hash function */
3306 JimStringCopyHTKeyDup
, /* key dup */
3308 JimStringCopyHTKeyCompare
, /* key compare */
3309 JimStringCopyHTKeyDestructor
, /* key destructor */
3310 Jim_CommandsHT_ValDestructor
/* val destructor */
3313 /* ------------------------- Commands related functions --------------------- */
3315 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdName
,
3316 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3320 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) != JIM_ERR
) {
3321 /* Command existed so incr proc epoch */
3322 Jim_InterpIncrProcEpoch(interp
);
3325 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3327 /* Store the new details for this proc */
3328 cmdPtr
->delProc
= delProc
;
3329 cmdPtr
->cmdProc
= cmdProc
;
3330 cmdPtr
->privData
= privData
;
3333 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
3335 /* There is no need to increment the 'proc epoch' because
3336 * creation of a new procedure can never affect existing
3337 * cached commands. We don't do negative caching. */
3341 int Jim_CreateProcedure(Jim_Interp
*interp
, const char *cmdName
,
3342 Jim_Obj
*argListObjPtr
, Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
,
3343 int leftArity
, int optionalArgs
, int args
, int rightArity
)
3347 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3348 cmdPtr
->cmdProc
= NULL
; /* Not a C coded command */
3349 cmdPtr
->argListObjPtr
= argListObjPtr
;
3350 cmdPtr
->bodyObjPtr
= bodyObjPtr
;
3351 Jim_IncrRefCount(argListObjPtr
);
3352 Jim_IncrRefCount(bodyObjPtr
);
3353 cmdPtr
->leftArity
= leftArity
;
3354 cmdPtr
->optionalArgs
= optionalArgs
;
3355 cmdPtr
->args
= args
;
3356 cmdPtr
->rightArity
= rightArity
;
3357 cmdPtr
->staticVars
= NULL
;
3360 /* Create the statics hash table. */
3361 if (staticsListObjPtr
) {
3364 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3366 cmdPtr
->staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3367 Jim_InitHashTable(cmdPtr
->staticVars
, &JimVariablesHashTableType
, interp
);
3368 for (i
= 0; i
< len
; i
++) {
3369 Jim_Obj
*objPtr
= 0, *initObjPtr
= 0, *nameObjPtr
= 0;
3373 Jim_ListIndex(interp
, staticsListObjPtr
, i
, &objPtr
, JIM_NONE
);
3374 /* Check if it's composed of two elements. */
3375 subLen
= Jim_ListLength(interp
, objPtr
);
3376 if (subLen
== 1 || subLen
== 2) {
3377 /* Try to get the variable value from the current
3379 Jim_ListIndex(interp
, objPtr
, 0, &nameObjPtr
, JIM_NONE
);
3381 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3382 if (initObjPtr
== NULL
) {
3383 Jim_SetResultFormatted(interp
,
3384 "variable for initialization of static \"%#s\" not found in the local context",
3390 Jim_ListIndex(interp
, objPtr
, 1, &initObjPtr
, JIM_NONE
);
3392 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3393 varPtr
->objPtr
= initObjPtr
;
3394 Jim_IncrRefCount(initObjPtr
);
3395 varPtr
->linkFramePtr
= NULL
;
3396 if (Jim_AddHashEntry(cmdPtr
->staticVars
,
3397 Jim_GetString(nameObjPtr
, NULL
), varPtr
) != JIM_OK
) {
3398 Jim_SetResultFormatted(interp
,
3399 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3400 Jim_DecrRefCount(interp
, initObjPtr
);
3406 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
3414 /* Add the new command */
3416 /* It may already exist, so we try to delete the old one.
3417 * Note that reference count means that it won't be deleted yet if
3418 * it exists in the call stack
3420 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) != JIM_ERR
) {
3421 /* There was an old procedure with the same name, this requires
3422 * a 'proc epoch' update. */
3423 Jim_InterpIncrProcEpoch(interp
);
3425 /* If a procedure with the same name didn't existed there is no need
3426 * to increment the 'proc epoch' because creation of a new procedure
3427 * can never affect existing cached commands. We don't do
3428 * negative caching. */
3429 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
3431 /* Unlike Tcl, set the name of the proc as the result */
3432 Jim_SetResultString(interp
, cmdName
, -1);
3436 Jim_FreeHashTable(cmdPtr
->staticVars
);
3437 Jim_Free(cmdPtr
->staticVars
);
3438 Jim_DecrRefCount(interp
, argListObjPtr
);
3439 Jim_DecrRefCount(interp
, bodyObjPtr
);
3444 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *cmdName
)
3446 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) == JIM_ERR
)
3448 Jim_InterpIncrProcEpoch(interp
);
3452 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
3456 Jim_Cmd
*copyCmdPtr
;
3458 if (newName
[0] == '\0') /* Delete! */
3459 return Jim_DeleteCommand(interp
, oldName
);
3461 he
= Jim_FindHashEntry(&interp
->commands
, oldName
);
3463 return JIM_ERR
; /* Invalid command name */
3465 copyCmdPtr
= Jim_Alloc(sizeof(Jim_Cmd
));
3466 *copyCmdPtr
= *cmdPtr
;
3467 /* In order to avoid that a procedure will get arglist/body/statics
3468 * freed by the hash table methods, fake a C-coded command
3469 * setting cmdPtr->cmdProc as not NULL */
3470 cmdPtr
->cmdProc
= (void *)1;
3471 /* Also make sure delProc is NULL. */
3472 cmdPtr
->delProc
= NULL
;
3473 /* Destroy the old command, and make sure the new is freed
3475 Jim_DeleteHashEntry(&interp
->commands
, oldName
);
3476 Jim_DeleteHashEntry(&interp
->commands
, newName
);
3477 /* Now the new command. We are sure it can't fail because
3478 * the target name was already freed. */
3479 Jim_AddHashEntry(&interp
->commands
, newName
, copyCmdPtr
);
3480 /* Increment the epoch */
3481 Jim_InterpIncrProcEpoch(interp
);
3485 /* -----------------------------------------------------------------------------
3487 * ---------------------------------------------------------------------------*/
3489 static int SetCommandFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3491 static const Jim_ObjType commandObjType
= {
3496 JIM_TYPE_REFERENCES
,
3499 int SetCommandFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3502 const char *cmdName
;
3504 /* Get the string representation */
3505 cmdName
= Jim_GetString(objPtr
, NULL
);
3506 /* Lookup this name into the commands hash table */
3507 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
3511 /* Free the old internal repr and set the new one. */
3512 Jim_FreeIntRep(interp
, objPtr
);
3513 objPtr
->typePtr
= &commandObjType
;
3514 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
3515 objPtr
->internalRep
.cmdValue
.cmdPtr
= (void *)he
->val
;
3519 /* This function returns the command structure for the command name
3520 * stored in objPtr. It tries to specialize the objPtr to contain
3521 * a cached info instead to perform the lookup into the hash table
3522 * every time. The information cached may not be uptodate, in such
3523 * a case the lookup is performed and the cache updated. */
3524 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
3526 if ((objPtr
->typePtr
!= &commandObjType
||
3527 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
) &&
3528 SetCommandFromAny(interp
, objPtr
) == JIM_ERR
) {
3529 if (flags
& JIM_ERRMSG
) {
3530 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
3534 return objPtr
->internalRep
.cmdValue
.cmdPtr
;
3537 /* -----------------------------------------------------------------------------
3539 * ---------------------------------------------------------------------------*/
3541 /* Variables HashTable Type.
3543 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3544 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3546 Jim_Var
*varPtr
= (void *)val
;
3548 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
3552 static const Jim_HashTableType JimVariablesHashTableType
= {
3553 JimStringCopyHTHashFunction
, /* hash function */
3554 JimStringCopyHTKeyDup
, /* key dup */
3556 JimStringCopyHTKeyCompare
, /* key compare */
3557 JimStringCopyHTKeyDestructor
, /* key destructor */
3558 JimVariablesHTValDestructor
/* val destructor */
3561 /* -----------------------------------------------------------------------------
3563 * ---------------------------------------------------------------------------*/
3565 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3567 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3569 static const Jim_ObjType variableObjType
= {
3574 JIM_TYPE_REFERENCES
,
3577 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3578 * is in the form "varname(key)". */
3579 static int Jim_NameIsDictSugar(const char *str
, int len
)
3581 if (len
&& str
[len
- 1] == ')' && strchr(str
, '(') != NULL
)
3586 /* This method should be called only by the variable API.
3587 * It returns JIM_OK on success (variable already exists),
3588 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
3589 * a variable name, but syntax glue for [dict] i.e. the last
3590 * character is ')' */
3591 int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3594 const char *varName
;
3596 Jim_CallFrame
*framePtr
= interp
->framePtr
;
3598 /* Check if the object is already an uptodate variable */
3599 if (objPtr
->typePtr
== &variableObjType
&&
3600 objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
3601 return JIM_OK
; /* nothing to do */
3604 if (objPtr
->typePtr
== &dictSubstObjType
) {
3605 return JIM_DICT_SUGAR
;
3608 /* Get the string representation */
3609 varName
= Jim_GetString(objPtr
, &len
);
3611 /* Make sure it's not syntax glue to get/set dict. */
3612 if (Jim_NameIsDictSugar(varName
, len
)) {
3613 return JIM_DICT_SUGAR
;
3616 if (varName
[0] == ':' && varName
[1] == ':') {
3617 framePtr
= interp
->topFramePtr
;
3618 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
+ 2);
3624 /* Lookup this name into the variables hash table */
3625 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
3627 /* Try with static vars. */
3628 if (framePtr
->staticVars
== NULL
)
3630 if (!(he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
)))
3634 /* Free the old internal repr and set the new one. */
3635 Jim_FreeIntRep(interp
, objPtr
);
3636 objPtr
->typePtr
= &variableObjType
;
3637 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
3638 objPtr
->internalRep
.varValue
.varPtr
= (void *)he
->val
;
3642 /* -------------------- Variables related functions ------------------------- */
3643 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
3644 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
);
3646 /* For now that's dummy. Variables lookup should be optimized
3647 * in many ways, with caching of lookups, and possibly with
3648 * a table of pre-allocated vars in every CallFrame for local vars.
3649 * All the caching should also have an 'epoch' mechanism similar
3650 * to the one used by Tcl for procedures lookup caching. */
3652 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
3658 if ((err
= SetVariableFromAny(interp
, nameObjPtr
)) != JIM_OK
) {
3659 Jim_CallFrame
*framePtr
= interp
->framePtr
;
3661 /* Check for [dict] syntax sugar. */
3662 if (err
== JIM_DICT_SUGAR
)
3663 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
3664 /* New variable to create */
3665 name
= Jim_GetString(nameObjPtr
, NULL
);
3667 var
= Jim_Alloc(sizeof(*var
));
3668 var
->objPtr
= valObjPtr
;
3669 Jim_IncrRefCount(valObjPtr
);
3670 var
->linkFramePtr
= NULL
;
3671 /* Insert the new variable */
3672 if (name
[0] == ':' && name
[1] == ':') {
3673 /* Into to the top evel frame */
3674 framePtr
= interp
->topFramePtr
;
3675 Jim_AddHashEntry(&framePtr
->vars
, name
+ 2, var
);
3678 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
3680 /* Make the object int rep a variable */
3681 Jim_FreeIntRep(interp
, nameObjPtr
);
3682 nameObjPtr
->typePtr
= &variableObjType
;
3683 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
3684 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
3687 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
3688 if (var
->linkFramePtr
== NULL
) {
3689 Jim_IncrRefCount(valObjPtr
);
3690 Jim_DecrRefCount(interp
, var
->objPtr
);
3691 var
->objPtr
= valObjPtr
;
3693 else { /* Else handle the link */
3694 Jim_CallFrame
*savedCallFrame
;
3696 savedCallFrame
= interp
->framePtr
;
3697 interp
->framePtr
= var
->linkFramePtr
;
3698 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
3699 interp
->framePtr
= savedCallFrame
;
3707 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
3709 Jim_Obj
*nameObjPtr
;
3712 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3713 Jim_IncrRefCount(nameObjPtr
);
3714 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
3715 Jim_DecrRefCount(interp
, nameObjPtr
);
3719 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
3721 Jim_CallFrame
*savedFramePtr
;
3724 savedFramePtr
= interp
->framePtr
;
3725 interp
->framePtr
= interp
->topFramePtr
;
3726 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
3727 interp
->framePtr
= savedFramePtr
;
3731 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
3733 Jim_Obj
*nameObjPtr
, *valObjPtr
;
3736 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3737 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
3738 Jim_IncrRefCount(nameObjPtr
);
3739 Jim_IncrRefCount(valObjPtr
);
3740 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
3741 Jim_DecrRefCount(interp
, nameObjPtr
);
3742 Jim_DecrRefCount(interp
, valObjPtr
);
3746 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
3747 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
3749 const char *varName
;
3752 varName
= Jim_GetString(nameObjPtr
, &len
);
3754 if (Jim_FindHashEntry(&interp
->framePtr
->vars
, varName
)) {
3755 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
3759 /* Check for cycles. */
3760 if (interp
->framePtr
== targetCallFrame
) {
3761 Jim_Obj
*objPtr
= targetNameObjPtr
;
3764 /* Cycles are only possible with 'uplevel 0' */
3766 if (Jim_StringEqObj(objPtr
, nameObjPtr
, 0)) {
3767 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
3770 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
3772 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
3773 if (varPtr
->linkFramePtr
!= targetCallFrame
)
3775 objPtr
= varPtr
->objPtr
;
3778 if (Jim_NameIsDictSugar(varName
, len
)) {
3779 Jim_SetResultString(interp
, "Dict key syntax invalid as link source", -1);
3782 /* Perform the binding */
3783 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
3784 /* We are now sure 'nameObjPtr' type is variableObjType */
3785 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
3789 /* Return the Jim_Obj pointer associated with a variable name,
3790 * or NULL if the variable was not found in the current context.
3791 * The same optimization discussed in the comment to the
3792 * 'SetVariable' function should apply here. */
3793 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
3795 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
3797 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
3799 if (varPtr
->linkFramePtr
== NULL
) {
3800 return varPtr
->objPtr
;
3805 /* The variable is a link? Resolve it. */
3806 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
3808 interp
->framePtr
= varPtr
->linkFramePtr
;
3809 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
3810 interp
->framePtr
= savedCallFrame
;
3815 case JIM_DICT_SUGAR
:
3816 /* [dict] syntax sugar. */
3817 return JimDictSugarGet(interp
, nameObjPtr
);
3820 if (flags
& JIM_ERRMSG
) {
3821 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
3827 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
3829 Jim_CallFrame
*savedFramePtr
;
3832 savedFramePtr
= interp
->framePtr
;
3833 interp
->framePtr
= interp
->topFramePtr
;
3834 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
3835 interp
->framePtr
= savedFramePtr
;
3840 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
3842 Jim_Obj
*nameObjPtr
, *varObjPtr
;
3844 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
3845 Jim_IncrRefCount(nameObjPtr
);
3846 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
3847 Jim_DecrRefCount(interp
, nameObjPtr
);
3851 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
3853 Jim_CallFrame
*savedFramePtr
;
3856 savedFramePtr
= interp
->framePtr
;
3857 interp
->framePtr
= interp
->topFramePtr
;
3858 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
3859 interp
->framePtr
= savedFramePtr
;
3864 /* Unset a variable.
3865 * Note: On success unset invalidates all the variable objects created
3866 * in the current call frame incrementing. */
3867 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
3873 retval
= SetVariableFromAny(interp
, nameObjPtr
);
3874 if (retval
== JIM_DICT_SUGAR
) {
3875 /* [dict] syntax sugar. */
3876 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
3878 else if (retval
== JIM_OK
) {
3879 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
3881 /* If it's a link call UnsetVariable recursively */
3882 if (varPtr
->linkFramePtr
) {
3883 Jim_CallFrame
*savedCallFrame
;
3885 savedCallFrame
= interp
->framePtr
;
3886 interp
->framePtr
= varPtr
->linkFramePtr
;
3887 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
3888 interp
->framePtr
= savedCallFrame
;
3891 Jim_CallFrame
*framePtr
= interp
->framePtr
;
3893 name
= Jim_GetString(nameObjPtr
, NULL
);
3894 if (name
[0] == ':' && name
[1] == ':') {
3895 framePtr
= interp
->topFramePtr
;
3898 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
3899 if (retval
== JIM_OK
) {
3900 /* Change the callframe id, invalidating var lookup caching */
3901 JimChangeCallFrameId(interp
, framePtr
);
3905 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
3906 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
3911 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3913 /* Given a variable name for [dict] operation syntax sugar,
3914 * this function returns two objects, the first with the name
3915 * of the variable to set, and the second with the rispective key.
3916 * For example "foo(bar)" will return objects with string repr. of
3919 * The returned objects have refcount = 1. The function can't fail. */
3920 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3921 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
3923 const char *str
, *p
;
3925 int len
, keyLen
, nameLen
;
3926 Jim_Obj
*varObjPtr
, *keyObjPtr
;
3928 str
= Jim_GetString(objPtr
, &len
);
3930 p
= strchr(str
, '(');
3932 Jim_Panic(interp
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
);
3935 keyLen
= len
- ((p
- str
) + 1);
3936 nameLen
= (p
- str
) - 1;
3937 /* Create the objects with the variable name and key. */
3938 t
= Jim_Alloc(nameLen
+ 1);
3939 memcpy(t
, str
, nameLen
);
3941 varObjPtr
= Jim_NewStringObjNoAlloc(interp
, t
, nameLen
);
3943 t
= Jim_Alloc(keyLen
+ 1);
3944 memcpy(t
, p
, keyLen
);
3946 keyObjPtr
= Jim_NewStringObjNoAlloc(interp
, t
, keyLen
);
3948 Jim_IncrRefCount(varObjPtr
);
3949 Jim_IncrRefCount(keyObjPtr
);
3950 *varPtrPtr
= varObjPtr
;
3951 *keyPtrPtr
= keyObjPtr
;
3954 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3955 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3956 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
3960 SetDictSubstFromAny(interp
, objPtr
);
3962 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
3963 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
);
3965 if (err
== JIM_OK
) {
3966 /* Don't keep an extra ref to the result */
3967 Jim_SetEmptyResult(interp
);
3971 /* Better error message for unset a(2) where a exists but a(2) doesn't */
3972 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
3973 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
3978 /* Make the error more informative and Tcl-compatible */
3979 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
3980 (valObjPtr
? "set" : "unset"), objPtr
);
3985 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
3988 Jim_Obj
*dictObjPtr
;
3989 Jim_Obj
*resObjPtr
= NULL
;
3992 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
3997 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
3998 if (ret
!= JIM_OK
) {
4001 Jim_SetResultFormatted(interp
,
4002 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr
, keyObjPtr
);
4005 Jim_SetResultFormatted(interp
,
4006 "can't read \"%#s(%#s)\": no such element in array", varObjPtr
, keyObjPtr
);
4013 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4014 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4016 Jim_Obj
*varObjPtr
, *keyObjPtr
, *resObjPtr
;
4019 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4021 resObjPtr
= JimDictExpandArrayVariable(interp
, varObjPtr
, keyObjPtr
);
4023 Jim_DecrRefCount(interp
, varObjPtr
);
4024 Jim_DecrRefCount(interp
, keyObjPtr
);
4029 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4031 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4033 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4034 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4037 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4039 JIM_NOTUSED(interp
);
4041 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4042 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4043 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4044 dupPtr
->typePtr
= &dictSubstObjType
;
4047 /* Note: The object *must* be in dict-sugar format */
4048 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4050 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4051 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4053 if (objPtr
->typePtr
== &interpolatedObjType
) {
4054 /* An interpolated object in dict-sugar form */
4056 const ScriptToken
*token
= objPtr
->internalRep
.twoPtrValue
.ptr1
;
4058 varObjPtr
= token
[0].objPtr
;
4059 keyObjPtr
= objPtr
->internalRep
.twoPtrValue
.ptr2
;
4061 Jim_IncrRefCount(varObjPtr
);
4062 Jim_IncrRefCount(keyObjPtr
);
4065 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4068 Jim_FreeIntRep(interp
, objPtr
);
4069 objPtr
->typePtr
= &dictSubstObjType
;
4070 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4071 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4075 /* This function is used to expand [dict get] sugar in the form
4076 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4077 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4078 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4079 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4080 * the [dict]ionary contained in variable VARNAME. */
4081 static Jim_Obj
*Jim_ExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4083 Jim_Obj
*resObjPtr
= NULL
;
4084 Jim_Obj
*substKeyObjPtr
= NULL
;
4086 SetDictSubstFromAny(interp
, objPtr
);
4088 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4089 &substKeyObjPtr
, JIM_NONE
)
4093 Jim_IncrRefCount(substKeyObjPtr
);
4095 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4097 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4102 /* -----------------------------------------------------------------------------
4104 * ---------------------------------------------------------------------------*/
4106 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
)
4110 if (interp
->freeFramesList
) {
4111 cf
= interp
->freeFramesList
;
4112 interp
->freeFramesList
= cf
->nextFramePtr
;
4115 cf
= Jim_Alloc(sizeof(*cf
));
4116 cf
->vars
.table
= NULL
;
4119 cf
->id
= interp
->callFrameEpoch
++;
4120 cf
->parentCallFrame
= NULL
;
4123 cf
->procArgsObjPtr
= NULL
;
4124 cf
->procBodyObjPtr
= NULL
;
4125 cf
->nextFramePtr
= NULL
;
4126 cf
->staticVars
= NULL
;
4127 if (cf
->vars
.table
== NULL
)
4128 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4132 /* Used to invalidate every caching related to callframe stability. */
4133 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
)
4135 cf
->id
= interp
->callFrameEpoch
++;
4138 #define JIM_FCF_NONE 0 /* no flags */
4139 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4140 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
)
4142 if (cf
->procArgsObjPtr
)
4143 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
4144 if (cf
->procBodyObjPtr
)
4145 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
4146 if (!(flags
& JIM_FCF_NOHT
))
4147 Jim_FreeHashTable(&cf
->vars
);
4150 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
4152 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
4154 while (he
!= NULL
) {
4155 Jim_HashEntry
*nextEntry
= he
->next
;
4156 Jim_Var
*varPtr
= (void *)he
->val
;
4158 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
4160 Jim_Free((void *)he
->key
); /* ATTENTION: const cast */
4168 cf
->nextFramePtr
= interp
->freeFramesList
;
4169 interp
->freeFramesList
= cf
;
4172 /* -----------------------------------------------------------------------------
4174 * ---------------------------------------------------------------------------*/
4175 #ifdef JIM_REFERENCES
4177 /* References HashTable Type.
4179 * Keys are jim_wide integers, dynamically allocated for now but in the
4180 * future it's worth to cache this 8 bytes objects. Values are poitners
4181 * to Jim_References. */
4182 static void JimReferencesHTValDestructor(void *interp
, void *val
)
4184 Jim_Reference
*refPtr
= (void *)val
;
4186 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
4187 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
4188 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
4193 unsigned int JimReferencesHTHashFunction(const void *key
)
4195 /* Only the least significant bits are used. */
4196 const jim_wide
*widePtr
= key
;
4197 unsigned int intValue
= (unsigned int)*widePtr
;
4199 return Jim_IntHashFunction(intValue
);
4202 const void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
4204 void *copy
= Jim_Alloc(sizeof(jim_wide
));
4206 JIM_NOTUSED(privdata
);
4208 memcpy(copy
, key
, sizeof(jim_wide
));
4212 int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
4214 JIM_NOTUSED(privdata
);
4216 return memcmp(key1
, key2
, sizeof(jim_wide
)) == 0;
4219 void JimReferencesHTKeyDestructor(void *privdata
, const void *key
)
4221 JIM_NOTUSED(privdata
);
4223 Jim_Free((void *)key
);
4226 static const Jim_HashTableType JimReferencesHashTableType
= {
4227 JimReferencesHTHashFunction
, /* hash function */
4228 JimReferencesHTKeyDup
, /* key dup */
4230 JimReferencesHTKeyCompare
, /* key compare */
4231 JimReferencesHTKeyDestructor
, /* key destructor */
4232 JimReferencesHTValDestructor
/* val destructor */
4235 /* -----------------------------------------------------------------------------
4236 * Reference object type and References API
4237 * ---------------------------------------------------------------------------*/
4239 /* The string representation of references has two features in order
4240 * to make the GC faster. The first is that every reference starts
4241 * with a non common character '<', in order to make the string matching
4242 * faster. The second is that the reference string rep is 42 characters
4243 * in length, this allows to avoid to check every object with a string
4244 * repr < 42, and usually there aren't many of these objects. */
4246 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
4248 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, jim_wide id
)
4250 const char *fmt
= "<reference.<%s>.%020" JIM_WIDE_MODIFIER
">";
4252 sprintf(buf
, fmt
, refPtr
->tag
, id
);
4253 return JIM_REFERENCE_SPACE
;
4256 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
4258 static const Jim_ObjType referenceObjType
= {
4262 UpdateStringOfReference
,
4263 JIM_TYPE_REFERENCES
,
4266 void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
4269 char buf
[JIM_REFERENCE_SPACE
+ 1];
4270 Jim_Reference
*refPtr
;
4272 refPtr
= objPtr
->internalRep
.refValue
.refPtr
;
4273 len
= JimFormatReference(buf
, refPtr
, objPtr
->internalRep
.refValue
.id
);
4274 objPtr
->bytes
= Jim_Alloc(len
+ 1);
4275 memcpy(objPtr
->bytes
, buf
, len
+ 1);
4276 objPtr
->length
= len
;
4279 /* returns true if 'c' is a valid reference tag character.
4280 * i.e. inside the range [_a-zA-Z0-9] */
4281 static int isrefchar(int c
)
4283 return (c
== '_' || isalnum(c
));
4286 int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4290 const char *str
, *start
, *end
;
4292 Jim_Reference
*refPtr
;
4295 /* Get the string representation */
4296 str
= Jim_GetString(objPtr
, &len
);
4297 /* Check if it looks like a reference */
4298 if (len
< JIM_REFERENCE_SPACE
)
4302 end
= str
+ len
- 1;
4303 while (*start
== ' ')
4305 while (*end
== ' ' && end
> start
)
4307 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
4309 /* <reference.<1234567>.%020> */
4310 if (memcmp(start
, "<reference.<", 12) != 0)
4312 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
4314 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4315 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
4316 if (!isrefchar(start
[12 + i
]))
4319 /* Extract info from the refernece. */
4320 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
4322 /* Try to convert the ID into a jim_wide */
4323 if (Jim_StringToWide(refId
, &wideValue
, 10) != JIM_OK
)
4325 /* Check if the reference really exists! */
4326 he
= Jim_FindHashEntry(&interp
->references
, &wideValue
);
4328 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
4332 /* Free the old internal repr and set the new one. */
4333 Jim_FreeIntRep(interp
, objPtr
);
4334 objPtr
->typePtr
= &referenceObjType
;
4335 objPtr
->internalRep
.refValue
.id
= wideValue
;
4336 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
4340 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
4344 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4345 * as finalizer command (or NULL if there is no finalizer).
4346 * The returned reference object has refcount = 0. */
4347 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
4349 struct Jim_Reference
*refPtr
;
4350 jim_wide wideValue
= interp
->referenceNextId
;
4355 /* Perform the Garbage Collection if needed. */
4356 Jim_CollectIfNeeded(interp
);
4358 refPtr
= Jim_Alloc(sizeof(*refPtr
));
4359 refPtr
->objPtr
= objPtr
;
4360 Jim_IncrRefCount(objPtr
);
4361 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
4363 Jim_IncrRefCount(cmdNamePtr
);
4364 Jim_AddHashEntry(&interp
->references
, &wideValue
, refPtr
);
4365 refObjPtr
= Jim_NewObj(interp
);
4366 refObjPtr
->typePtr
= &referenceObjType
;
4367 refObjPtr
->bytes
= NULL
;
4368 refObjPtr
->internalRep
.refValue
.id
= interp
->referenceNextId
;
4369 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
4370 interp
->referenceNextId
++;
4371 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
4372 * that does not pass the 'isrefchar' test is replaced with '_' */
4373 tag
= Jim_GetString(tagPtr
, &tagLen
);
4374 if (tagLen
> JIM_REFERENCE_TAGLEN
)
4375 tagLen
= JIM_REFERENCE_TAGLEN
;
4376 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
4377 if (i
< tagLen
&& isrefchar(tag
[i
]))
4378 refPtr
->tag
[i
] = tag
[i
];
4380 refPtr
->tag
[i
] = '_';
4382 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
4386 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4388 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
4390 return objPtr
->internalRep
.refValue
.refPtr
;
4393 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
4395 Jim_Reference
*refPtr
;
4397 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
4399 Jim_IncrRefCount(cmdNamePtr
);
4400 if (refPtr
->finalizerCmdNamePtr
)
4401 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
4402 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
4406 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
4408 Jim_Reference
*refPtr
;
4410 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
4412 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
4416 /* -----------------------------------------------------------------------------
4417 * References Garbage Collection
4418 * ---------------------------------------------------------------------------*/
4420 /* This the hash table type for the "MARK" phase of the GC */
4421 static const Jim_HashTableType JimRefMarkHashTableType
= {
4422 JimReferencesHTHashFunction
, /* hash function */
4423 JimReferencesHTKeyDup
, /* key dup */
4425 JimReferencesHTKeyCompare
, /* key compare */
4426 JimReferencesHTKeyDestructor
, /* key destructor */
4427 NULL
/* val destructor */
4430 /* #define JIM_DEBUG_GC 1 */
4432 /* Performs the garbage collection. */
4433 int Jim_Collect(Jim_Interp
*interp
)
4435 Jim_HashTable marks
;
4436 Jim_HashTableIterator
*htiter
;
4441 /* Avoid recursive calls */
4442 if (interp
->lastCollectId
== -1) {
4443 /* Jim_Collect() already running. Return just now. */
4446 interp
->lastCollectId
= -1;
4448 /* Mark all the references found into the 'mark' hash table.
4449 * The references are searched in every live object that
4450 * is of a type that can contain references. */
4451 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
4452 objPtr
= interp
->liveList
;
4454 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
4455 const char *str
, *p
;
4458 /* If the object is of type reference, to get the
4459 * Id is simple... */
4460 if (objPtr
->typePtr
== &referenceObjType
) {
4461 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
4463 printf("MARK (reference): %d refcount: %d" JIM_NL
,
4464 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
4466 objPtr
= objPtr
->nextObjPtr
;
4469 /* Get the string repr of the object we want
4470 * to scan for references. */
4471 p
= str
= Jim_GetString(objPtr
, &len
);
4472 /* Skip objects too little to contain references. */
4473 if (len
< JIM_REFERENCE_SPACE
) {
4474 objPtr
= objPtr
->nextObjPtr
;
4477 /* Extract references from the object string repr. */
4483 if ((p
= strstr(p
, "<reference.<")) == NULL
)
4485 /* Check if it's a valid reference. */
4486 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
4488 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
4490 for (i
= 21; i
<= 40; i
++)
4494 memcpy(buf
, p
+ 21, 20);
4496 Jim_StringToWide(buf
, &id
, 10);
4498 /* Ok, a reference for the given ID
4499 * was found. Mark it. */
4500 Jim_AddHashEntry(&marks
, &id
, NULL
);
4502 printf("MARK: %d" JIM_NL
, (int)id
);
4504 p
+= JIM_REFERENCE_SPACE
;
4507 objPtr
= objPtr
->nextObjPtr
;
4510 /* Run the references hash table to destroy every reference that
4511 * is not referenced outside (not present in the mark HT). */
4512 htiter
= Jim_GetHashTableIterator(&interp
->references
);
4513 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
4514 const jim_wide
*refId
;
4515 Jim_Reference
*refPtr
;
4518 /* Check if in the mark phase we encountered
4519 * this reference. */
4520 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
4522 printf("COLLECTING %d" JIM_NL
, (int)*refId
);
4525 /* Drop the reference, but call the
4526 * finalizer first if registered. */
4528 if (refPtr
->finalizerCmdNamePtr
) {
4529 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
4530 Jim_Obj
*objv
[3], *oldResult
;
4532 JimFormatReference(refstr
, refPtr
, *refId
);
4534 objv
[0] = refPtr
->finalizerCmdNamePtr
;
4535 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, 32);
4536 objv
[2] = refPtr
->objPtr
;
4537 Jim_IncrRefCount(objv
[0]);
4538 Jim_IncrRefCount(objv
[1]);
4539 Jim_IncrRefCount(objv
[2]);
4541 /* Drop the reference itself */
4542 Jim_DeleteHashEntry(&interp
->references
, refId
);
4544 /* Call the finalizer. Errors ignored. */
4545 oldResult
= interp
->result
;
4546 Jim_IncrRefCount(oldResult
);
4547 Jim_EvalObjVector(interp
, 3, objv
);
4548 Jim_SetResult(interp
, oldResult
);
4549 Jim_DecrRefCount(interp
, oldResult
);
4551 Jim_DecrRefCount(interp
, objv
[0]);
4552 Jim_DecrRefCount(interp
, objv
[1]);
4553 Jim_DecrRefCount(interp
, objv
[2]);
4556 Jim_DeleteHashEntry(&interp
->references
, refId
);
4560 Jim_FreeHashTableIterator(htiter
);
4561 Jim_FreeHashTable(&marks
);
4562 interp
->lastCollectId
= interp
->referenceNextId
;
4563 interp
->lastCollectTime
= time(NULL
);
4567 #define JIM_COLLECT_ID_PERIOD 5000
4568 #define JIM_COLLECT_TIME_PERIOD 300
4570 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
4575 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
4576 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
4579 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
4580 Jim_Collect(interp
);
4585 /* -----------------------------------------------------------------------------
4586 * Interpreter related functions
4587 * ---------------------------------------------------------------------------*/
4589 Jim_Interp
*Jim_CreateInterp(void)
4591 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
4594 i
->errorFileName
= Jim_StrDup("");
4595 i
->addStackTrace
= 0;
4597 i
->maxNestingDepth
= JIM_MAX_NESTING_DEPTH
;
4598 i
->returnCode
= JIM_OK
;
4602 i
->callFrameEpoch
= 0;
4603 i
->liveList
= i
->freeList
= NULL
;
4604 i
->referenceNextId
= 0;
4605 i
->lastCollectId
= 0;
4606 i
->lastCollectTime
= time(NULL
);
4607 i
->freeFramesList
= NULL
;
4608 i
->prngState
= NULL
;
4611 i
->signal_level
= 0;
4612 i
->signal_set_result
= NULL
;
4613 i
->localProcs
= NULL
;
4615 /* Note that we can create objects only after the
4616 * interpreter liveList and freeList pointers are
4617 * initialized to NULL. */
4618 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
4619 #ifdef JIM_REFERENCES
4620 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
4622 Jim_InitHashTable(&i
->sharedStrings
, &JimSharedStringsHashTableType
, NULL
);
4623 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
4624 Jim_InitHashTable(&i
->packages
, &JimStringKeyValCopyHashTableType
, NULL
);
4625 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
);
4626 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
4627 i
->trueObj
= Jim_NewIntObj(i
, 1);
4628 i
->falseObj
= Jim_NewIntObj(i
, 0);
4629 i
->result
= i
->emptyObj
;
4630 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
4631 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
4632 i
->unknown_called
= 0;
4633 i
->errorProc
= i
->emptyObj
;
4634 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
4635 Jim_IncrRefCount(i
->emptyObj
);
4636 Jim_IncrRefCount(i
->result
);
4637 Jim_IncrRefCount(i
->stackTrace
);
4638 Jim_IncrRefCount(i
->unknown
);
4639 Jim_IncrRefCount(i
->currentScriptObj
);
4640 Jim_IncrRefCount(i
->errorProc
);
4641 Jim_IncrRefCount(i
->trueObj
);
4642 Jim_IncrRefCount(i
->falseObj
);
4644 /* Initialize key variables every interpreter should contain */
4645 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, ". /lib/jim");
4646 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
4651 void Jim_FreeInterp(Jim_Interp
*i
)
4653 Jim_CallFrame
*cf
= i
->framePtr
, *prevcf
, *nextcf
;
4654 Jim_Obj
*objPtr
, *nextObjPtr
;
4656 Jim_DecrRefCount(i
, i
->emptyObj
);
4657 Jim_DecrRefCount(i
, i
->trueObj
);
4658 Jim_DecrRefCount(i
, i
->falseObj
);
4659 Jim_DecrRefCount(i
, i
->result
);
4660 Jim_DecrRefCount(i
, i
->stackTrace
);
4661 Jim_DecrRefCount(i
, i
->errorProc
);
4662 Jim_DecrRefCount(i
, i
->unknown
);
4663 Jim_Free((void *)i
->errorFileName
);
4664 Jim_DecrRefCount(i
, i
->currentScriptObj
);
4665 Jim_FreeHashTable(&i
->commands
);
4666 Jim_FreeHashTable(&i
->references
);
4667 Jim_FreeHashTable(&i
->assocData
);
4668 Jim_FreeHashTable(&i
->packages
);
4669 Jim_Free(i
->prngState
);
4670 JimDeleteLocalProcs(i
);
4672 /* Free the call frames list */
4674 prevcf
= cf
->parentCallFrame
;
4675 JimFreeCallFrame(i
, cf
, JIM_FCF_NONE
);
4678 /* Check that the live object list is empty, otherwise
4679 * there is a memory leak. */
4680 if (i
->liveList
!= NULL
) {
4681 Jim_Obj
*objPtr
= i
->liveList
;
4683 printf(JIM_NL
"-------------------------------------" JIM_NL
);
4684 printf("Objects still in the free list:" JIM_NL
);
4686 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
4688 printf("%p (%d) %-10s: '%.20s'" JIM_NL
,
4689 objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
4690 if (objPtr
->typePtr
== &sourceObjType
) {
4691 printf("FILE %s LINE %d" JIM_NL
,
4692 objPtr
->internalRep
.sourceValue
.fileName
,
4693 objPtr
->internalRep
.sourceValue
.lineNumber
);
4695 objPtr
= objPtr
->nextObjPtr
;
4697 printf("-------------------------------------" JIM_NL JIM_NL
);
4698 Jim_Panic(i
, "Live list non empty freeing the interpreter! Leak?");
4700 /* Free all the freed objects. */
4701 objPtr
= i
->freeList
;
4703 nextObjPtr
= objPtr
->nextObjPtr
;
4705 objPtr
= nextObjPtr
;
4707 /* Free cached CallFrame structures */
4708 cf
= i
->freeFramesList
;
4710 nextcf
= cf
->nextFramePtr
;
4711 if (cf
->vars
.table
!= NULL
)
4712 Jim_Free(cf
->vars
.table
);
4716 /* Free the sharedString hash table. Make sure to free it
4717 * after every other Jim_Object was freed. */
4718 Jim_FreeHashTable(&i
->sharedStrings
);
4719 /* Free the interpreter structure. */
4723 /* Store the call frame relative to the level represented by
4724 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4725 * level is assumed to be '1'.
4727 * If a newLevelptr int pointer is specified, the function stores
4728 * the absolute level integer value of the new target callframe into
4729 * *newLevelPtr. (this is used to adjust interp->numLevels
4730 * in the implementation of [uplevel], so that [info level] will
4731 * return a correct information).
4733 * This function accepts the 'level' argument in the form
4734 * of the commands [uplevel] and [upvar].
4736 * For a function accepting a relative integer as level suitable
4737 * for implementation of [info level ?level?] check the
4738 * GetCallFrameByInteger() function. */
4739 int Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
4740 Jim_CallFrame
**framePtrPtr
, int *newLevelPtr
)
4744 Jim_CallFrame
*framePtr
;
4747 *newLevelPtr
= interp
->numLevels
;
4749 str
= Jim_GetString(levelObjPtr
, NULL
);
4750 if (str
[0] == '#') {
4753 /* speedup for the toplevel (level #0) */
4754 if (str
[1] == '0' && str
[2] == '\0') {
4757 *framePtrPtr
= interp
->topFramePtr
;
4761 level
= strtol(str
+ 1, &endptr
, 0);
4762 if (str
[1] == '\0' || endptr
[0] != '\0' || level
< 0)
4764 /* An 'absolute' level is converted into the
4765 * 'number of levels to go back' format. */
4766 level
= interp
->numLevels
- level
;
4771 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0)
4776 str
= "1"; /* Needed to format the error message. */
4780 framePtr
= interp
->framePtr
;
4782 *newLevelPtr
= (*newLevelPtr
) - level
;
4784 framePtr
= framePtr
->parentCallFrame
;
4785 if (framePtr
== NULL
)
4788 *framePtrPtr
= framePtr
;
4791 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
4795 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4796 * as a relative integer like in the [info level ?level?] command. */
4797 static int JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
4798 Jim_CallFrame
**framePtrPtr
)
4801 jim_wide relLevel
; /* level relative to the current one. */
4802 Jim_CallFrame
*framePtr
;
4804 if (Jim_GetWide(interp
, levelObjPtr
, &level
) != JIM_OK
)
4807 /* An 'absolute' level is converted into the
4808 * 'number of levels to go back' format. */
4809 relLevel
= interp
->numLevels
- level
;
4815 framePtr
= interp
->framePtr
;
4816 while (relLevel
--) {
4817 framePtr
= framePtr
->parentCallFrame
;
4818 if (framePtr
== NULL
)
4821 *framePtrPtr
= framePtr
;
4824 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
4828 static void JimSetErrorFileName(Jim_Interp
*interp
, const char *filename
)
4830 Jim_Free((void *)interp
->errorFileName
);
4831 interp
->errorFileName
= Jim_StrDup(filename
);
4834 static void JimSetErrorLineNumber(Jim_Interp
*interp
, int linenr
)
4836 interp
->errorLine
= linenr
;
4839 static void JimResetStackTrace(Jim_Interp
*interp
)
4841 Jim_DecrRefCount(interp
, interp
->stackTrace
);
4842 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
4843 Jim_IncrRefCount(interp
->stackTrace
);
4846 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
4850 /* Increment reference first in case these are the same object */
4851 Jim_IncrRefCount(stackTraceObj
);
4852 Jim_DecrRefCount(interp
, interp
->stackTrace
);
4853 interp
->stackTrace
= stackTraceObj
;
4854 interp
->errorFlag
= 1;
4856 /* This is a bit ugly.
4857 * If the filename of the last entry of the stack trace is empty,
4858 * the next stack level should be added.
4860 len
= Jim_ListLength(interp
, interp
->stackTrace
);
4862 Jim_Obj
*filenameObj
;
4864 Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
, JIM_NONE
);
4866 Jim_GetString(filenameObj
, &len
);
4869 interp
->addStackTrace
= 1;
4874 /* Returns 1 if the stack trace information was used or 0 if not */
4875 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
4876 const char *filename
, int linenr
)
4879 printf("JimAppendStackTrace: %s:%d (%s)\n", filename
, linenr
, procname
);
4882 /* XXX Omit "unknown" for now since it can be confusing (but it may help too!) */
4883 if (strcmp(procname
, "unknown") == 0) {
4886 if (!*procname
&& !*filename
) {
4887 /* No useful info here */
4891 if (Jim_IsShared(interp
->stackTrace
)) {
4892 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
4893 Jim_IncrRefCount(interp
->stackTrace
);
4896 /* If we have no procname but the previous element did, merge with that frame */
4897 if (!*procname
&& *filename
) {
4898 /* Just a filename. Check the previous entry */
4899 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
4902 Jim_Obj
*procnameObj
;
4903 Jim_Obj
*filenameObj
;
4905 if (Jim_ListIndex(interp
, interp
->stackTrace
, len
- 3, &procnameObj
, JIM_NONE
) == JIM_OK
4906 && Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
,
4907 JIM_NONE
) == JIM_OK
) {
4909 const char *prev_procname
= Jim_GetString(procnameObj
, NULL
);
4910 const char *prev_filename
= Jim_GetString(filenameObj
, NULL
);
4912 if (*prev_procname
&& !*prev_filename
) {
4913 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, Jim_NewStringObj(interp
,
4915 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
),
4923 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
4924 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, filename
, -1));
4925 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
4928 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
4931 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
4933 assocEntryPtr
->delProc
= delProc
;
4934 assocEntryPtr
->data
= data
;
4935 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
4938 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
4940 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
4942 if (entryPtr
!= NULL
) {
4943 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) entryPtr
->val
;
4945 return assocEntryPtr
->data
;
4950 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
4952 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
4955 int Jim_GetExitCode(Jim_Interp
*interp
)
4957 return interp
->exitCode
;
4960 /* -----------------------------------------------------------------------------
4962 * Every interpreter has an hash table where to put shared dynamically
4963 * allocate strings that are likely to be used a lot of times.
4964 * For example, in the 'source' object type, there is a pointer to
4965 * the filename associated with that object. Every script has a lot
4966 * of this objects with the identical file name, so it is wise to share
4969 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4970 * returns the pointer to the shared string. Every time a reference
4971 * to the string is no longer used, the user should call
4972 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4973 * a given string, it is removed from the hash table.
4974 * ---------------------------------------------------------------------------*/
4975 const char *Jim_GetSharedString(Jim_Interp
*interp
, const char *str
)
4977 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
4980 char *strCopy
= Jim_StrDup(str
);
4982 Jim_AddHashEntry(&interp
->sharedStrings
, strCopy
, (void *)1);
4986 long refCount
= (long)he
->val
;
4989 he
->val
= (void *)refCount
;
4994 void Jim_ReleaseSharedString(Jim_Interp
*interp
, const char *str
)
4997 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
5000 Jim_Panic(interp
, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str
);
5003 refCount
= (long)he
->val
;
5005 if (refCount
== 0) {
5006 Jim_DeleteHashEntry(&interp
->sharedStrings
, str
);
5009 he
->val
= (void *)refCount
;
5014 /* -----------------------------------------------------------------------------
5016 * ---------------------------------------------------------------------------*/
5017 #define JIM_INTEGER_SPACE 24
5019 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5020 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5022 static const Jim_ObjType intObjType
= {
5030 /* A coerced double is closer to an int than a double.
5031 * It is an int value temporarily masquerading as a double value.
5032 * i.e. it has the same string value as an int and Jim_GetWide()
5033 * succeeds, but also Jim_GetDouble() returns the value directly.
5035 static const Jim_ObjType coercedDoubleObjType
= {
5044 void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5047 char buf
[JIM_INTEGER_SPACE
+ 1];
5049 len
= Jim_WideToString(buf
, objPtr
->internalRep
.wideValue
);
5050 objPtr
->bytes
= Jim_Alloc(len
+ 1);
5051 memcpy(objPtr
->bytes
, buf
, len
+ 1);
5052 objPtr
->length
= len
;
5055 int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5060 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5061 /* Simple switcheroo */
5062 objPtr
->typePtr
= &intObjType
;
5066 /* Get the string representation */
5067 str
= Jim_GetString(objPtr
, NULL
);
5068 /* Try to convert into a jim_wide */
5069 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5070 if (flags
& JIM_ERRMSG
) {
5071 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5075 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5076 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5079 /* Free the old internal repr and set the new one. */
5080 Jim_FreeIntRep(interp
, objPtr
);
5081 objPtr
->typePtr
= &intObjType
;
5082 objPtr
->internalRep
.wideValue
= wideValue
;
5086 static int Jim_IsWide(Jim_Obj
*objPtr
)
5088 return objPtr
->typePtr
== &intObjType
;
5091 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5093 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5095 *widePtr
= objPtr
->internalRep
.wideValue
;
5099 /* Get a wide but does not set an error if the format is bad. */
5100 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5102 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5104 *widePtr
= objPtr
->internalRep
.wideValue
;
5108 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5113 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5114 if (retval
== JIM_OK
) {
5115 *longPtr
= (long)wideValue
;
5121 void Jim_SetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide wideValue
)
5123 if (Jim_IsShared(objPtr
))
5124 Jim_Panic(interp
, "Jim_SetWide called with shared object");
5125 if (objPtr
->typePtr
!= &intObjType
) {
5126 Jim_FreeIntRep(interp
, objPtr
);
5127 objPtr
->typePtr
= &intObjType
;
5129 Jim_InvalidateStringRep(objPtr
);
5130 objPtr
->internalRep
.wideValue
= wideValue
;
5133 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5137 objPtr
= Jim_NewObj(interp
);
5138 objPtr
->typePtr
= &intObjType
;
5139 objPtr
->bytes
= NULL
;
5140 objPtr
->internalRep
.wideValue
= wideValue
;
5144 /* -----------------------------------------------------------------------------
5146 * ---------------------------------------------------------------------------*/
5147 #define JIM_DOUBLE_SPACE 30
5149 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5150 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5152 static const Jim_ObjType doubleObjType
= {
5156 UpdateStringOfDouble
,
5160 void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5163 char buf
[JIM_DOUBLE_SPACE
+ 1];
5165 len
= Jim_DoubleToString(buf
, objPtr
->internalRep
.doubleValue
);
5166 objPtr
->bytes
= Jim_Alloc(len
+ 1);
5167 memcpy(objPtr
->bytes
, buf
, len
+ 1);
5168 objPtr
->length
= len
;
5171 int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5177 /* Preserve the string representation.
5178 * Needed so we can convert back to int without loss
5180 str
= Jim_GetString(objPtr
, NULL
);
5182 #ifdef HAVE_LONG_LONG
5183 /* Assume a 53 bit mantissa */
5184 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5185 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5187 if (objPtr
->typePtr
== &intObjType
5188 && objPtr
->internalRep
.wideValue
>= MIN_INT_IN_DOUBLE
5189 && objPtr
->internalRep
.wideValue
<= MAX_INT_IN_DOUBLE
) {
5191 /* Direct conversion to coerced double */
5192 objPtr
->typePtr
= &coercedDoubleObjType
;
5197 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
5198 /* Managed to convert to an int, so we can use this as a cooerced double */
5199 Jim_FreeIntRep(interp
, objPtr
);
5200 objPtr
->typePtr
= &coercedDoubleObjType
;
5201 objPtr
->internalRep
.wideValue
= wideValue
;
5205 /* Try to convert into a double */
5206 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
5207 Jim_SetResultFormatted(interp
, "expected number but got \"%#s\"", objPtr
);
5210 /* Free the old internal repr and set the new one. */
5211 Jim_FreeIntRep(interp
, objPtr
);
5213 objPtr
->typePtr
= &doubleObjType
;
5214 objPtr
->internalRep
.doubleValue
= doubleValue
;
5218 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
5220 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5221 *doublePtr
= objPtr
->internalRep
.wideValue
;
5224 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
5227 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5228 *doublePtr
= objPtr
->internalRep
.wideValue
;
5231 *doublePtr
= objPtr
->internalRep
.doubleValue
;
5236 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
5240 objPtr
= Jim_NewObj(interp
);
5241 objPtr
->typePtr
= &doubleObjType
;
5242 objPtr
->bytes
= NULL
;
5243 objPtr
->internalRep
.doubleValue
= doubleValue
;
5247 /* -----------------------------------------------------------------------------
5249 * ---------------------------------------------------------------------------*/
5250 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
5251 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5252 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
5253 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
5254 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
5256 /* Note that while the elements of the list may contain references,
5257 * the list object itself can't. This basically means that the
5258 * list object string representation as a whole can't contain references
5259 * that are not presents in the single elements. */
5260 static const Jim_ObjType listObjType
= {
5262 FreeListInternalRep
,
5268 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5272 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
5273 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
5275 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
5278 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
5282 JIM_NOTUSED(interp
);
5284 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
5285 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
5286 dupPtr
->internalRep
.listValue
.ele
=
5287 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
5288 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
5289 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
5290 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
5291 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
5293 dupPtr
->typePtr
= &listObjType
;
5296 /* The following function checks if a given string can be encoded
5297 * into a list element without any kind of quoting, surrounded by braces,
5298 * or using escapes to quote. */
5299 #define JIM_ELESTR_SIMPLE 0
5300 #define JIM_ELESTR_BRACE 1
5301 #define JIM_ELESTR_QUOTE 2
5302 static int ListElementQuotingType(const char *s
, int len
)
5304 int i
, level
, trySimple
= 1;
5306 /* Try with the SIMPLE case */
5308 return JIM_ELESTR_BRACE
;
5310 return JIM_ELESTR_BRACE
;
5311 if (s
[0] == '"' || s
[0] == '{') {
5315 for (i
= 0; i
< len
; i
++) {
5335 return JIM_ELESTR_SIMPLE
;
5338 /* Test if it's possible to do with braces */
5339 if (s
[len
- 1] == '\\' || s
[len
- 1] == ']')
5340 return JIM_ELESTR_QUOTE
;
5342 for (i
= 0; i
< len
; i
++) {
5350 return JIM_ELESTR_QUOTE
;
5353 if (s
[i
+ 1] == '\n')
5354 return JIM_ELESTR_QUOTE
;
5355 else if (s
[i
+ 1] != '\0')
5362 return JIM_ELESTR_BRACE
;
5363 for (i
= 0; i
< len
; i
++) {
5377 return JIM_ELESTR_BRACE
;
5381 return JIM_ELESTR_SIMPLE
;
5383 return JIM_ELESTR_QUOTE
;
5386 /* Returns the malloc-ed representation of a string
5387 * using backslash to quote special chars. */
5388 char *BackslashQuoteString(const char *s
, int len
, int *qlenPtr
)
5390 char *q
= Jim_Alloc(len
* 2 + 1), *p
;
5442 void UpdateStringOfList(struct Jim_Obj
*objPtr
)
5444 int i
, bufLen
, realLength
;
5448 Jim_Obj
**ele
= objPtr
->internalRep
.listValue
.ele
;
5450 /* (Over) Estimate the space needed. */
5451 quotingType
= Jim_Alloc(sizeof(int) * objPtr
->internalRep
.listValue
.len
+ 1);
5453 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
5456 strRep
= Jim_GetString(ele
[i
], &len
);
5457 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
5458 switch (quotingType
[i
]) {
5459 case JIM_ELESTR_SIMPLE
:
5462 case JIM_ELESTR_BRACE
:
5465 case JIM_ELESTR_QUOTE
:
5469 bufLen
++; /* elements separator. */
5473 /* Generate the string rep. */
5474 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
5476 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
5478 const char *strRep
= Jim_GetString(ele
[i
], &len
);
5481 switch (quotingType
[i
]) {
5482 case JIM_ELESTR_SIMPLE
:
5483 memcpy(p
, strRep
, len
);
5487 case JIM_ELESTR_BRACE
:
5489 memcpy(p
, strRep
, len
);
5492 realLength
+= len
+ 2;
5494 case JIM_ELESTR_QUOTE
:
5495 q
= BackslashQuoteString(strRep
, len
, &qlen
);
5502 /* Add a separating space */
5503 if (i
+ 1 != objPtr
->internalRep
.listValue
.len
) {
5508 *p
= '\0'; /* nul term. */
5509 objPtr
->length
= realLength
;
5510 Jim_Free(quotingType
);
5513 int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
5515 struct JimParserCtx parser
;
5519 /* Get the string representation */
5520 str
= Jim_GetString(objPtr
, &strLen
);
5522 /* Free the old internal repr just now and initialize the
5523 * new one just now. The string->list conversion can't fail. */
5524 Jim_FreeIntRep(interp
, objPtr
);
5525 objPtr
->typePtr
= &listObjType
;
5526 objPtr
->internalRep
.listValue
.len
= 0;
5527 objPtr
->internalRep
.listValue
.maxLen
= 0;
5528 objPtr
->internalRep
.listValue
.ele
= NULL
;
5530 /* Convert into a list */
5531 JimParserInit(&parser
, str
, strLen
, 1);
5532 while (!JimParserEof(&parser
)) {
5535 Jim_Obj
*elementPtr
;
5537 JimParseList(&parser
);
5538 if (JimParserTtype(&parser
) != JIM_TT_STR
&& JimParserTtype(&parser
) != JIM_TT_ESC
)
5540 token
= JimParserGetToken(&parser
, &tokenLen
, &type
, NULL
);
5541 elementPtr
= Jim_NewStringObjNoAlloc(interp
, token
, tokenLen
);
5542 ListAppendElement(objPtr
, elementPtr
);
5547 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
5552 objPtr
= Jim_NewObj(interp
);
5553 objPtr
->typePtr
= &listObjType
;
5554 objPtr
->bytes
= NULL
;
5555 objPtr
->internalRep
.listValue
.ele
= NULL
;
5556 objPtr
->internalRep
.listValue
.len
= 0;
5557 objPtr
->internalRep
.listValue
.maxLen
= 0;
5558 for (i
= 0; i
< len
; i
++) {
5559 ListAppendElement(objPtr
, elements
[i
]);
5564 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5565 * length of the vector. Note that the user of this function should make
5566 * sure that the list object can't shimmer while the vector returned
5567 * is in use, this vector is the one stored inside the internal representation
5568 * of the list object. This function is not exported, extensions should
5569 * always access to the List object elements using Jim_ListIndex(). */
5570 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
5573 *listLen
= Jim_ListLength(interp
, listObj
);
5574 *listVec
= listObj
->internalRep
.listValue
.ele
;
5577 /* Sorting uses ints, but commands may return wide */
5578 static int JimSign(jim_wide w
)
5589 /* ListSortElements type values */
5591 { JIM_LSORT_ASCII
, JIM_LSORT_NOCASE
, JIM_LSORT_INTEGER
, JIM_LSORT_COMMAND
};
5593 /* Why doesn't qsort allow a user arg!!! */
5594 static jmp_buf sort_jmpbuf
;
5595 static Jim_Obj
*sort_command
= 0;
5596 static Jim_Interp
*sort_interp
= 0;
5597 static int sort_order
;
5599 /* Sort the internal rep of a list. */
5600 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
5602 return Jim_StringCompareObj(*lhsObj
, *rhsObj
, 0) * sort_order
;
5605 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
5607 return Jim_StringCompareObj(*lhsObj
, *rhsObj
, 1) * sort_order
;
5610 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
5612 jim_wide lhs
= 0, rhs
= 0;
5614 /* REVISIT: If these are not valid integers, bogus results ... */
5615 if (Jim_GetWide(sort_interp
, *lhsObj
, &lhs
) != JIM_OK
||
5616 Jim_GetWide(sort_interp
, *rhsObj
, &rhs
) != JIM_OK
) {
5617 longjmp(sort_jmpbuf
, JIM_ERR
);
5620 return JimSign(lhs
- rhs
) * sort_order
;
5623 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
5625 Jim_Obj
*compare_script
;
5630 /* This must be a valid list */
5631 compare_script
= Jim_DuplicateObj(sort_interp
, sort_command
);
5632 Jim_ListAppendElement(sort_interp
, compare_script
, *lhsObj
);
5633 Jim_ListAppendElement(sort_interp
, compare_script
, *rhsObj
);
5635 rc
= Jim_EvalObj(sort_interp
, compare_script
);
5638 longjmp(sort_jmpbuf
, rc
);
5641 Jim_GetWide(sort_interp
, Jim_GetResult(sort_interp
), &ret
);
5642 return JimSign(ret
) * sort_order
;
5645 /* Sort a list *in place*. MUST be called with non-shared objects. */
5646 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, int type
, int order
,
5649 typedef int (qsort_comparator
) (const void *, const void *);
5650 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
5655 if (Jim_IsShared(listObjPtr
))
5656 Jim_Panic(interp
, "Jim_ListSortElements called with shared object");
5657 if (!Jim_IsList(listObjPtr
))
5658 SetListFromAny(interp
, listObjPtr
);
5661 sort_command
= command
;
5662 sort_interp
= interp
;
5664 vector
= listObjPtr
->internalRep
.listValue
.ele
;
5665 len
= listObjPtr
->internalRep
.listValue
.len
;
5667 case JIM_LSORT_ASCII
:
5668 fn
= ListSortString
;
5670 case JIM_LSORT_NOCASE
:
5671 fn
= ListSortStringNoCase
;
5673 case JIM_LSORT_INTEGER
:
5674 fn
= ListSortInteger
;
5676 case JIM_LSORT_COMMAND
:
5677 fn
= ListSortCommand
;
5680 fn
= NULL
; /* avoid warning */
5681 Jim_Panic(interp
, "ListSort called with invalid sort type");
5683 if ((rc
= setjmp(sort_jmpbuf
)) == 0) {
5684 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
5686 Jim_InvalidateStringRep(listObjPtr
);
5691 /* This is the low-level function to append an element to a list.
5692 * The higher-level Jim_ListAppendElement() performs shared object
5693 * check and invalidate the string repr. This version is used
5694 * in the internals of the List Object and is not exported.
5696 * NOTE: this function can be called only against objects
5697 * with internal type of List. */
5698 void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
5700 int requiredLen
= listPtr
->internalRep
.listValue
.len
+ 1;
5702 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
5703 int maxLen
= requiredLen
* 2;
5705 listPtr
->internalRep
.listValue
.ele
=
5706 Jim_Realloc(listPtr
->internalRep
.listValue
.ele
, sizeof(Jim_Obj
*) * maxLen
);
5707 listPtr
->internalRep
.listValue
.maxLen
= maxLen
;
5709 listPtr
->internalRep
.listValue
.ele
[listPtr
->internalRep
.listValue
.len
] = objPtr
;
5710 listPtr
->internalRep
.listValue
.len
++;
5711 Jim_IncrRefCount(objPtr
);
5714 /* This is the low-level function to insert elements into a list.
5715 * The higher-level Jim_ListInsertElements() performs shared object
5716 * check and invalidate the string repr. This version is used
5717 * in the internals of the List Object and is not exported.
5719 * NOTE: this function can be called only against objects
5720 * with internal type of List. */
5721 void ListInsertElements(Jim_Obj
*listPtr
, int index
, int elemc
, Jim_Obj
*const *elemVec
)
5723 int currentLen
= listPtr
->internalRep
.listValue
.len
;
5724 int requiredLen
= currentLen
+ elemc
;
5728 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
5729 int maxLen
= requiredLen
* 2;
5731 listPtr
->internalRep
.listValue
.ele
=
5732 Jim_Realloc(listPtr
->internalRep
.listValue
.ele
, sizeof(Jim_Obj
*) * maxLen
);
5733 listPtr
->internalRep
.listValue
.maxLen
= maxLen
;
5735 point
= listPtr
->internalRep
.listValue
.ele
+ index
;
5736 memmove(point
+ elemc
, point
, (currentLen
- index
) * sizeof(Jim_Obj
*));
5737 for (i
= 0; i
< elemc
; ++i
) {
5738 point
[i
] = elemVec
[i
];
5739 Jim_IncrRefCount(point
[i
]);
5741 listPtr
->internalRep
.listValue
.len
+= elemc
;
5744 /* Appends every element of appendListPtr into listPtr.
5745 * Both have to be of the list type. */
5746 void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
5748 int i
, oldLen
= listPtr
->internalRep
.listValue
.len
;
5749 int appendLen
= appendListPtr
->internalRep
.listValue
.len
;
5750 int requiredLen
= oldLen
+ appendLen
;
5752 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
5753 int maxLen
= requiredLen
* 2;
5755 listPtr
->internalRep
.listValue
.ele
=
5756 Jim_Realloc(listPtr
->internalRep
.listValue
.ele
, sizeof(Jim_Obj
*) * maxLen
);
5757 listPtr
->internalRep
.listValue
.maxLen
= maxLen
;
5759 for (i
= 0; i
< appendLen
; i
++) {
5760 Jim_Obj
*objPtr
= appendListPtr
->internalRep
.listValue
.ele
[i
];
5762 listPtr
->internalRep
.listValue
.ele
[oldLen
+ i
] = objPtr
;
5763 Jim_IncrRefCount(objPtr
);
5765 listPtr
->internalRep
.listValue
.len
+= appendLen
;
5768 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
5770 if (Jim_IsShared(listPtr
))
5771 Jim_Panic(interp
, "Jim_ListAppendElement called with shared object");
5772 if (!Jim_IsList(listPtr
))
5773 SetListFromAny(interp
, listPtr
);
5774 Jim_InvalidateStringRep(listPtr
);
5775 ListAppendElement(listPtr
, objPtr
);
5778 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
5780 if (Jim_IsShared(listPtr
))
5781 Jim_Panic(interp
, "Jim_ListAppendList called with shared object");
5782 if (!Jim_IsList(listPtr
))
5783 SetListFromAny(interp
, listPtr
);
5784 Jim_InvalidateStringRep(listPtr
);
5785 ListAppendList(listPtr
, appendListPtr
);
5788 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5790 if (!Jim_IsList(objPtr
))
5791 SetListFromAny(interp
, objPtr
);
5792 return objPtr
->internalRep
.listValue
.len
;
5795 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int index
,
5796 int objc
, Jim_Obj
*const *objVec
)
5798 if (Jim_IsShared(listPtr
))
5799 Jim_Panic(interp
, "Jim_ListInsertElement called with shared object");
5800 if (!Jim_IsList(listPtr
))
5801 SetListFromAny(interp
, listPtr
);
5802 if (index
>= 0 && index
> listPtr
->internalRep
.listValue
.len
)
5803 index
= listPtr
->internalRep
.listValue
.len
;
5806 Jim_InvalidateStringRep(listPtr
);
5807 ListInsertElements(listPtr
, index
, objc
, objVec
);
5810 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int index
, Jim_Obj
**objPtrPtr
, int flags
)
5812 if (!Jim_IsList(listPtr
))
5813 SetListFromAny(interp
, listPtr
);
5814 if ((index
>= 0 && index
>= listPtr
->internalRep
.listValue
.len
) ||
5815 (index
< 0 && (-index
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
5816 if (flags
& JIM_ERRMSG
) {
5817 Jim_SetResultString(interp
, "list index out of range", -1);
5823 index
= listPtr
->internalRep
.listValue
.len
+ index
;
5824 *objPtrPtr
= listPtr
->internalRep
.listValue
.ele
[index
];
5828 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int index
,
5829 Jim_Obj
*newObjPtr
, int flags
)
5831 if (!Jim_IsList(listPtr
))
5832 SetListFromAny(interp
, listPtr
);
5833 if ((index
>= 0 && index
>= listPtr
->internalRep
.listValue
.len
) ||
5834 (index
< 0 && (-index
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
5835 if (flags
& JIM_ERRMSG
) {
5836 Jim_SetResultString(interp
, "list index out of range", -1);
5841 index
= listPtr
->internalRep
.listValue
.len
+ index
;
5842 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[index
]);
5843 listPtr
->internalRep
.listValue
.ele
[index
] = newObjPtr
;
5844 Jim_IncrRefCount(newObjPtr
);
5848 /* Modify the list stored into the variable named 'varNamePtr'
5849 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5850 * with the new element 'newObjptr'. */
5851 int Jim_SetListIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
5852 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
5854 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
5855 int shared
, i
, index
;
5857 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
5860 if ((shared
= Jim_IsShared(objPtr
)))
5861 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
5862 for (i
= 0; i
< indexc
- 1; i
++) {
5863 listObjPtr
= objPtr
;
5864 if (Jim_GetIndex(interp
, indexv
[i
], &index
) != JIM_OK
)
5866 if (Jim_ListIndex(interp
, listObjPtr
, index
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
5869 if (Jim_IsShared(objPtr
)) {
5870 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
5871 ListSetIndex(interp
, listObjPtr
, index
, objPtr
, JIM_NONE
);
5873 Jim_InvalidateStringRep(listObjPtr
);
5875 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &index
) != JIM_OK
)
5877 if (ListSetIndex(interp
, objPtr
, index
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
5879 Jim_InvalidateStringRep(objPtr
);
5880 Jim_InvalidateStringRep(varObjPtr
);
5881 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
5883 Jim_SetResult(interp
, varObjPtr
);
5887 Jim_FreeNewObj(interp
, varObjPtr
);
5892 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
5896 /* If all the objects in objv are lists,
5897 * it's possible to return a list as result, that's the
5898 * concatenation of all the lists. */
5899 for (i
= 0; i
< objc
; i
++) {
5900 if (!Jim_IsList(objv
[i
]))
5904 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
5906 for (i
= 0; i
< objc
; i
++)
5907 Jim_ListAppendList(interp
, objPtr
, objv
[i
]);
5911 /* Else... we have to glue strings together */
5912 int len
= 0, objLen
;
5915 /* Compute the length */
5916 for (i
= 0; i
< objc
; i
++) {
5917 Jim_GetString(objv
[i
], &objLen
);
5922 /* Create the string rep, and a stinrg object holding it. */
5923 p
= bytes
= Jim_Alloc(len
+ 1);
5924 for (i
= 0; i
< objc
; i
++) {
5925 const char *s
= Jim_GetString(objv
[i
], &objLen
);
5927 while (objLen
&& (*s
== ' ' || *s
== '\t' || *s
== '\n')) {
5932 while (objLen
&& (s
[objLen
- 1] == ' ' ||
5933 s
[objLen
- 1] == '\n' || s
[objLen
- 1] == '\t')) {
5937 memcpy(p
, s
, objLen
);
5939 if (objLen
&& i
+ 1 != objc
) {
5942 else if (i
+ 1 != objc
) {
5943 /* Drop the space calcuated for this
5944 * element that is instead null. */
5949 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
5953 /* Returns a list composed of the elements in the specified range.
5954 * first and start are directly accepted as Jim_Objects and
5955 * processed for the end?-index? case. */
5956 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
5957 Jim_Obj
*lastObjPtr
)
5962 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
5963 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
5965 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
5966 first
= JimRelToAbsIndex(len
, first
);
5967 last
= JimRelToAbsIndex(len
, last
);
5968 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
5969 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
5972 /* -----------------------------------------------------------------------------
5974 * ---------------------------------------------------------------------------*/
5975 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5976 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
5977 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
5978 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
5980 /* Dict HashTable Type.
5982 * Keys and Values are Jim objects. */
5984 unsigned int JimObjectHTHashFunction(const void *key
)
5987 Jim_Obj
*objPtr
= (Jim_Obj
*)key
;
5990 str
= Jim_GetString(objPtr
, &len
);
5991 h
= Jim_GenHashFunction((unsigned char *)str
, len
);
5995 int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5997 JIM_NOTUSED(privdata
);
5999 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
, 0);
6002 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6004 Jim_Obj
*objPtr
= val
;
6006 Jim_DecrRefCount(interp
, objPtr
);
6009 static const Jim_HashTableType JimDictHashTableType
= {
6010 JimObjectHTHashFunction
, /* hash function */
6013 JimObjectHTKeyCompare
, /* key compare */
6014 (void (*)(void *, const void *)) /* ATTENTION: const cast */
6015 JimObjectHTKeyValDestructor
, /* key destructor */
6016 JimObjectHTKeyValDestructor
/* val destructor */
6019 /* Note that while the elements of the dict may contain references,
6020 * the list object itself can't. This basically means that the
6021 * dict object string representation as a whole can't contain references
6022 * that are not presents in the single elements. */
6023 static const Jim_ObjType dictObjType
= {
6025 FreeDictInternalRep
,
6031 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6033 JIM_NOTUSED(interp
);
6035 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
6036 Jim_Free(objPtr
->internalRep
.ptr
);
6039 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6041 Jim_HashTable
*ht
, *dupHt
;
6042 Jim_HashTableIterator
*htiter
;
6045 /* Create a new hash table */
6046 ht
= srcPtr
->internalRep
.ptr
;
6047 dupHt
= Jim_Alloc(sizeof(*dupHt
));
6048 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
6050 Jim_ExpandHashTable(dupHt
, ht
->size
);
6051 /* Copy every element from the source to the dup hash table */
6052 htiter
= Jim_GetHashTableIterator(ht
);
6053 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
6054 const Jim_Obj
*keyObjPtr
= he
->key
;
6055 Jim_Obj
*valObjPtr
= he
->val
;
6057 Jim_IncrRefCount((Jim_Obj
*)keyObjPtr
); /* ATTENTION: const cast */
6058 Jim_IncrRefCount(valObjPtr
);
6059 Jim_AddHashEntry(dupHt
, keyObjPtr
, valObjPtr
);
6061 Jim_FreeHashTableIterator(htiter
);
6063 dupPtr
->internalRep
.ptr
= dupHt
;
6064 dupPtr
->typePtr
= &dictObjType
;
6067 void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
6069 int i
, bufLen
, realLength
;
6072 int *quotingType
, objc
;
6074 Jim_HashTableIterator
*htiter
;
6078 /* Trun the hash table into a flat vector of Jim_Objects. */
6079 ht
= objPtr
->internalRep
.ptr
;
6080 objc
= ht
->used
* 2;
6081 objv
= Jim_Alloc(objc
* sizeof(Jim_Obj
*));
6082 htiter
= Jim_GetHashTableIterator(ht
);
6084 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
6085 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
6086 objv
[i
++] = he
->val
;
6088 Jim_FreeHashTableIterator(htiter
);
6089 /* (Over) Estimate the space needed. */
6090 quotingType
= Jim_Alloc(sizeof(int) * objc
);
6092 for (i
= 0; i
< objc
; i
++) {
6095 strRep
= Jim_GetString(objv
[i
], &len
);
6096 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6097 switch (quotingType
[i
]) {
6098 case JIM_ELESTR_SIMPLE
:
6101 case JIM_ELESTR_BRACE
:
6104 case JIM_ELESTR_QUOTE
:
6108 bufLen
++; /* elements separator. */
6112 /* Generate the string rep. */
6113 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6115 for (i
= 0; i
< objc
; i
++) {
6117 const char *strRep
= Jim_GetString(objv
[i
], &len
);
6120 switch (quotingType
[i
]) {
6121 case JIM_ELESTR_SIMPLE
:
6122 memcpy(p
, strRep
, len
);
6126 case JIM_ELESTR_BRACE
:
6128 memcpy(p
, strRep
, len
);
6131 realLength
+= len
+ 2;
6133 case JIM_ELESTR_QUOTE
:
6134 q
= BackslashQuoteString(strRep
, len
, &qlen
);
6141 /* Add a separating space */
6142 if (i
+ 1 != objc
) {
6147 *p
= '\0'; /* nul term. */
6148 objPtr
->length
= realLength
;
6149 Jim_Free(quotingType
);
6153 #ifdef JIM_OPTIMIZATION
6154 static int SetDictFromList(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6160 listlen
= Jim_ListLength(interp
, objPtr
);
6165 /* Now we can't fail */
6166 ht
= Jim_Alloc(sizeof(*ht
));
6167 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
6169 for (i
= 0; i
< listlen
; i
+= 2) {
6173 Jim_ListIndex(interp
, objPtr
, i
, &keyObjPtr
, JIM_NONE
);
6174 Jim_ListIndex(interp
, objPtr
, i
+ 1, &valObjPtr
, JIM_NONE
);
6176 Jim_IncrRefCount(keyObjPtr
);
6177 Jim_IncrRefCount(valObjPtr
);
6179 if (Jim_AddHashEntry(ht
, keyObjPtr
, valObjPtr
) != JIM_OK
) {
6182 he
= Jim_FindHashEntry(ht
, keyObjPtr
);
6183 Jim_DecrRefCount(interp
, keyObjPtr
);
6184 /* ATTENTION: const cast */
6185 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->val
);
6186 he
->val
= valObjPtr
;
6190 Jim_FreeIntRep(interp
, objPtr
);
6191 objPtr
->typePtr
= &dictObjType
;
6192 objPtr
->internalRep
.ptr
= ht
;
6198 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6200 struct JimParserCtx parser
;
6206 /* Get the string representation. Do this first so we don't
6207 * change order in case of fast conversion to dict
6209 str
= Jim_GetString(objPtr
, &strLen
);
6211 #ifdef JIM_OPTIMIZATION
6212 /* If the object is of type "list" with a string rep, we can use
6213 * a specialized version.
6215 if (Jim_IsList(objPtr
)) {
6216 if (SetDictFromList(interp
, objPtr
) != JIM_OK
) {
6223 /* Free the old internal repr just now and initialize the
6224 * new one just now. The string->list conversion can't fail. */
6225 Jim_FreeIntRep(interp
, objPtr
);
6226 ht
= Jim_Alloc(sizeof(*ht
));
6227 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
6228 objPtr
->typePtr
= &dictObjType
;
6229 objPtr
->internalRep
.ptr
= ht
;
6231 /* Convert into a dict */
6232 JimParserInit(&parser
, str
, strLen
, 1);
6234 while (!JimParserEof(&parser
)) {
6238 JimParseList(&parser
);
6239 if (JimParserTtype(&parser
) != JIM_TT_STR
&& JimParserTtype(&parser
) != JIM_TT_ESC
)
6241 token
= JimParserGetToken(&parser
, &tokenLen
, &type
, NULL
);
6242 objv
[i
++] = Jim_NewStringObjNoAlloc(interp
, token
, tokenLen
);
6245 Jim_IncrRefCount(objv
[0]);
6246 Jim_IncrRefCount(objv
[1]);
6247 if (Jim_AddHashEntry(ht
, objv
[0], objv
[1]) != JIM_OK
) {
6250 he
= Jim_FindHashEntry(ht
, objv
[0]);
6251 Jim_DecrRefCount(interp
, objv
[0]);
6252 /* ATTENTION: const cast */
6253 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->val
);
6259 Jim_FreeNewObj(interp
, objv
[0]);
6260 objPtr
->typePtr
= NULL
;
6261 Jim_FreeHashTable(ht
);
6263 #ifdef JIM_OPTIMIZATION
6266 Jim_SetResultString(interp
,
6267 "invalid dictionary value: must be a list with an even number of elements", -1);
6273 /* Dict object API */
6275 /* Add an element to a dict. objPtr must be of the "dict" type.
6276 * The higer-level exported function is Jim_DictAddElement().
6277 * If an element with the specified key already exists, the value
6278 * associated is replaced with the new one.
6280 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6281 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
6282 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
6284 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
6286 if (valueObjPtr
== NULL
) { /* unset */
6287 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
6289 Jim_IncrRefCount(keyObjPtr
);
6290 Jim_IncrRefCount(valueObjPtr
);
6291 if (Jim_AddHashEntry(ht
, keyObjPtr
, valueObjPtr
) != JIM_OK
) {
6292 Jim_HashEntry
*he
= Jim_FindHashEntry(ht
, keyObjPtr
);
6294 Jim_DecrRefCount(interp
, keyObjPtr
);
6295 /* ATTENTION: const cast */
6296 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->val
);
6297 he
->val
= valueObjPtr
;
6302 /* Add an element, higher-level interface for DictAddElement().
6303 * If valueObjPtr == NULL, the key is removed if it exists. */
6304 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
6305 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
6309 if (Jim_IsShared(objPtr
))
6310 Jim_Panic(interp
, "Jim_DictAddElement called with shared object");
6311 if (objPtr
->typePtr
!= &dictObjType
) {
6312 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
)
6315 retcode
= DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
6316 Jim_InvalidateStringRep(objPtr
);
6320 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6326 Jim_Panic(interp
, "Jim_NewDicObj() 'len' argument must be even");
6328 objPtr
= Jim_NewObj(interp
);
6329 objPtr
->typePtr
= &dictObjType
;
6330 objPtr
->bytes
= NULL
;
6331 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
6332 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
6333 for (i
= 0; i
< len
; i
+= 2)
6334 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
6338 /* Return the value associated to the specified dict key
6339 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6341 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
6342 Jim_Obj
**objPtrPtr
, int flags
)
6347 if (dictPtr
->typePtr
!= &dictObjType
) {
6348 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
6351 ht
= dictPtr
->internalRep
.ptr
;
6352 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
6353 if (flags
& JIM_ERRMSG
) {
6354 Jim_SetResultFormatted(interp
, "key \"%#s\" not found in dictionary", keyPtr
);
6358 *objPtrPtr
= he
->val
;
6362 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
6363 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
6366 Jim_HashTableIterator
*htiter
;
6371 if (dictPtr
->typePtr
!= &dictObjType
) {
6372 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
6375 ht
= dictPtr
->internalRep
.ptr
;
6377 /* Turn the hash table into a flat vector of Jim_Objects. */
6378 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
6379 htiter
= Jim_GetHashTableIterator(ht
);
6381 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
6382 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
6383 objv
[i
++] = he
->val
;
6386 Jim_FreeHashTableIterator(htiter
);
6392 /* Return the value associated to the specified dict keys */
6393 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
6394 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
6399 *objPtrPtr
= dictPtr
;
6403 for (i
= 0; i
< keyc
; i
++) {
6406 if (Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
)
6411 *objPtrPtr
= dictPtr
;
6415 /* Modify the dict stored into the variable named 'varNamePtr'
6416 * setting the element specified by the 'keyc' keys objects in 'keyv',
6417 * with the new value of the element 'newObjPtr'.
6419 * If newObjPtr == NULL the operation is to remove the given key
6420 * from the dictionary. */
6421 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6422 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
)
6424 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
6427 varObjPtr
= objPtr
=
6428 Jim_GetVariable(interp
, varNamePtr
, newObjPtr
== NULL
? JIM_ERRMSG
: JIM_NONE
);
6429 if (objPtr
== NULL
) {
6430 if (newObjPtr
== NULL
) /* Cannot remove a key from non existing var */
6432 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
6433 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
6434 Jim_FreeNewObj(interp
, varObjPtr
);
6438 if ((shared
= Jim_IsShared(objPtr
)))
6439 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6440 for (i
= 0; i
< keyc
- 1; i
++) {
6441 dictObjPtr
= objPtr
;
6443 /* Check if it's a valid dictionary */
6444 if (dictObjPtr
->typePtr
!= &dictObjType
) {
6445 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
)
6448 /* Check if the given key exists. */
6449 Jim_InvalidateStringRep(dictObjPtr
);
6450 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
6451 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
6452 /* This key exists at the current level.
6453 * Make sure it's not shared!. */
6454 if (Jim_IsShared(objPtr
)) {
6455 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6456 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
6460 /* Key not found. If it's an [unset] operation
6461 * this is an error. Only the last key may not
6463 if (newObjPtr
== NULL
)
6465 /* Otherwise set an empty dictionary
6466 * as key's value. */
6467 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
6468 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
6471 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
6474 Jim_InvalidateStringRep(objPtr
);
6475 Jim_InvalidateStringRep(varObjPtr
);
6476 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6478 Jim_SetResult(interp
, varObjPtr
);
6482 Jim_FreeNewObj(interp
, varObjPtr
);
6487 /* -----------------------------------------------------------------------------
6489 * ---------------------------------------------------------------------------*/
6490 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
6491 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6493 static const Jim_ObjType indexObjType
= {
6497 UpdateStringOfIndex
,
6501 void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
6504 char buf
[JIM_INTEGER_SPACE
+ 1];
6506 if (objPtr
->internalRep
.indexValue
>= 0)
6507 len
= sprintf(buf
, "%d", objPtr
->internalRep
.indexValue
);
6508 else if (objPtr
->internalRep
.indexValue
== -1)
6509 len
= sprintf(buf
, "end");
6511 len
= sprintf(buf
, "end%d", objPtr
->internalRep
.indexValue
+ 1);
6513 objPtr
->bytes
= Jim_Alloc(len
+ 1);
6514 memcpy(objPtr
->bytes
, buf
, len
+ 1);
6515 objPtr
->length
= len
;
6518 int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6524 /* Get the string representation */
6525 str
= Jim_GetString(objPtr
, NULL
);
6527 /* Try to convert into an index */
6528 if (strncmp(str
, "end", 3) == 0) {
6534 index
= strtol(str
, &endptr
, 10);
6536 if (endptr
== str
) {
6542 /* Now str may include or +<num> or -<num> */
6543 if (*str
== '+' || *str
== '-') {
6544 int sign
= (*str
== '+' ? 1 : -1);
6546 index
+= sign
* strtol(++str
, &endptr
, 10);
6547 if (str
== endptr
|| *endptr
) {
6552 /* The only thing left should be spaces */
6553 while (isspace(*str
)) {
6564 /* end-1 is repesented as -2 */
6568 else if (index
< 0) {
6572 /* Free the old internal repr and set the new one. */
6573 Jim_FreeIntRep(interp
, objPtr
);
6574 objPtr
->typePtr
= &indexObjType
;
6575 objPtr
->internalRep
.indexValue
= index
;
6579 Jim_SetResultFormatted(interp
,
6580 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
6584 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
6586 /* Avoid shimmering if the object is an integer. */
6587 if (objPtr
->typePtr
== &intObjType
) {
6588 jim_wide val
= objPtr
->internalRep
.wideValue
;
6590 if (!(val
< LONG_MIN
) && !(val
> LONG_MAX
)) {
6591 *indexPtr
= (val
< 0) ? -INT_MAX
: (long)val
;;
6595 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
6597 *indexPtr
= objPtr
->internalRep
.indexValue
;
6601 /* -----------------------------------------------------------------------------
6602 * Return Code Object.
6603 * ---------------------------------------------------------------------------*/
6605 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
6606 static const char *jimReturnCodes
[] = {
6608 [JIM_ERR
] = "error",
6609 [JIM_RETURN
] = "return",
6610 [JIM_BREAK
] = "break",
6611 [JIM_CONTINUE
] = "continue",
6612 [JIM_SIGNAL
] = "signal",
6613 [JIM_EXIT
] = "exit",
6614 [JIM_EVAL
] = "eval",
6618 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
6620 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6622 static const Jim_ObjType returnCodeObjType
= {
6630 /* Converts a (standard) return code to a string. Returns "?" for
6631 * non-standard return codes.
6633 const char *Jim_ReturnCode(int code
)
6635 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
6639 return jimReturnCodes
[code
];
6643 int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6648 /* Try to convert into an integer */
6649 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
6650 returnCode
= (int)wideValue
;
6651 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
6652 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
6655 /* Free the old internal repr and set the new one. */
6656 Jim_FreeIntRep(interp
, objPtr
);
6657 objPtr
->typePtr
= &returnCodeObjType
;
6658 objPtr
->internalRep
.returnCode
= returnCode
;
6662 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
6664 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
6666 *intPtr
= objPtr
->internalRep
.returnCode
;
6670 /* -----------------------------------------------------------------------------
6671 * Expression Parsing
6672 * ---------------------------------------------------------------------------*/
6673 static int JimParseExprOperator(struct JimParserCtx
*pc
);
6674 static int JimParseExprNumber(struct JimParserCtx
*pc
);
6675 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
6677 /* Exrp's Stack machine operators opcodes. */
6679 /* Binary operators (numbers) */
6682 /* Continues on from the JIM_TT_ space */
6684 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 15 */
6699 JIM_EXPROP_BITAND
, /* 30 */
6703 /* Note must keep these together */
6704 JIM_EXPROP_LOGICAND
, /* 33 */
6705 JIM_EXPROP_LOGICAND_LEFT
,
6706 JIM_EXPROP_LOGICAND_RIGHT
,
6709 JIM_EXPROP_LOGICOR
, /* 36 */
6710 JIM_EXPROP_LOGICOR_LEFT
,
6711 JIM_EXPROP_LOGICOR_RIGHT
,
6714 /* Ternary operators */
6715 JIM_EXPROP_TERNARY
, /* 39 */
6716 JIM_EXPROP_TERNARY_LEFT
,
6717 JIM_EXPROP_TERNARY_RIGHT
,
6720 JIM_EXPROP_COLON
, /* 42 */
6721 JIM_EXPROP_COLON_LEFT
,
6722 JIM_EXPROP_COLON_RIGHT
,
6724 JIM_EXPROP_POW
, /* 45 */
6726 /* Binary operators (strings) */
6732 /* Unary operators (numbers) */
6735 JIM_EXPROP_UNARYMINUS
,
6736 JIM_EXPROP_UNARYPLUS
,
6739 JIM_EXPROP_FUNC_FIRST
,
6740 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
6741 JIM_EXPROP_FUNC_ABS
,
6742 JIM_EXPROP_FUNC_DOUBLE
,
6743 JIM_EXPROP_FUNC_ROUND
,
6745 #ifdef JIM_MATH_FUNCTIONS
6746 /* math functions from libm */
6747 JIM_EXPROP_FUNC_SIN
,
6748 JIM_EXPROP_FUNC_COS
,
6749 JIM_EXPROP_FUNC_TAN
,
6750 JIM_EXPROP_FUNC_ASIN
,
6751 JIM_EXPROP_FUNC_ACOS
,
6752 JIM_EXPROP_FUNC_ATAN
,
6753 JIM_EXPROP_FUNC_SINH
,
6754 JIM_EXPROP_FUNC_COSH
,
6755 JIM_EXPROP_FUNC_TANH
,
6756 JIM_EXPROP_FUNC_CEIL
,
6757 JIM_EXPROP_FUNC_FLOOR
,
6758 JIM_EXPROP_FUNC_EXP
,
6759 JIM_EXPROP_FUNC_LOG
,
6760 JIM_EXPROP_FUNC_LOG10
,
6761 JIM_EXPROP_FUNC_SQRT
,
6773 /* Operators table */
6774 typedef struct Jim_ExprOperator
6779 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
6783 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
6785 Jim_IncrRefCount(obj
);
6786 e
->stack
[e
->stacklen
++] = obj
;
6789 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
6791 return e
->stack
[--e
->stacklen
];
6794 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
6798 Jim_Obj
*A
= ExprPop(e
);
6800 jim_wide wA
, wC
= 0;
6802 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
6805 switch (e
->opcode
) {
6806 case JIM_EXPROP_FUNC_INT
:
6809 case JIM_EXPROP_FUNC_ROUND
:
6812 case JIM_EXPROP_FUNC_DOUBLE
:
6816 case JIM_EXPROP_FUNC_ABS
:
6817 wC
= wA
>= 0 ? wA
: -wA
;
6819 case JIM_EXPROP_UNARYMINUS
:
6822 case JIM_EXPROP_UNARYPLUS
:
6825 case JIM_EXPROP_NOT
:
6832 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
6833 switch (e
->opcode
) {
6834 case JIM_EXPROP_FUNC_INT
:
6838 case JIM_EXPROP_FUNC_ROUND
:
6839 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
6842 case JIM_EXPROP_FUNC_DOUBLE
:
6845 case JIM_EXPROP_FUNC_ABS
:
6846 dC
= dA
>= 0 ? dA
: -dA
;
6848 case JIM_EXPROP_UNARYMINUS
:
6851 case JIM_EXPROP_UNARYPLUS
:
6854 case JIM_EXPROP_NOT
:
6865 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
6868 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
6872 Jim_DecrRefCount(interp
, A
);
6877 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
6879 Jim_Obj
*A
= ExprPop(e
);
6884 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
) {
6887 switch (e
->opcode
) {
6888 case JIM_EXPROP_BITNOT
:
6894 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
6898 Jim_DecrRefCount(interp
, A
);
6903 #ifdef JIM_MATH_FUNCTIONS
6904 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
6907 Jim_Obj
*A
= ExprPop(e
);
6910 rc
= Jim_GetDouble(interp
, A
, &dA
);
6912 switch (e
->opcode
) {
6913 case JIM_EXPROP_FUNC_SIN
:
6916 case JIM_EXPROP_FUNC_COS
:
6919 case JIM_EXPROP_FUNC_TAN
:
6922 case JIM_EXPROP_FUNC_ASIN
:
6925 case JIM_EXPROP_FUNC_ACOS
:
6928 case JIM_EXPROP_FUNC_ATAN
:
6931 case JIM_EXPROP_FUNC_SINH
:
6934 case JIM_EXPROP_FUNC_COSH
:
6937 case JIM_EXPROP_FUNC_TANH
:
6940 case JIM_EXPROP_FUNC_CEIL
:
6943 case JIM_EXPROP_FUNC_FLOOR
:
6946 case JIM_EXPROP_FUNC_EXP
:
6949 case JIM_EXPROP_FUNC_LOG
:
6952 case JIM_EXPROP_FUNC_LOG10
:
6955 case JIM_EXPROP_FUNC_SQRT
:
6961 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
6964 Jim_DecrRefCount(interp
, A
);
6970 /* A binary operation on two ints */
6971 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
6973 Jim_Obj
*B
= ExprPop(e
);
6974 Jim_Obj
*A
= ExprPop(e
);
6978 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
6983 switch (e
->opcode
) {
6984 case JIM_EXPROP_LSHIFT
:
6987 case JIM_EXPROP_RSHIFT
:
6990 case JIM_EXPROP_BITAND
:
6993 case JIM_EXPROP_BITXOR
:
6996 case JIM_EXPROP_BITOR
:
6999 case JIM_EXPROP_POW
:
7000 wC
= JimPowWide(wA
, wB
);
7002 case JIM_EXPROP_MOD
:
7005 Jim_SetResultString(interp
, "Division by zero", -1);
7012 * This code is tricky: C doesn't guarantee much
7013 * about the quotient or remainder, but Tcl does.
7014 * The remainder always has the same sign as the
7015 * divisor and a smaller absolute value.
7033 case JIM_EXPROP_ROTL
:{
7034 /* uint32_t would be better. But not everyone has inttypes.h? */
7035 unsigned long uA
= (unsigned long)wA
;
7036 const unsigned int S
= sizeof(unsigned long) * 8;
7038 wC
= (unsigned long)((uA
<< wB
) | (uA
>> (S
- wB
)));
7041 case JIM_EXPROP_ROTR
:{
7042 unsigned long uA
= (unsigned long)wA
;
7043 const unsigned int S
= sizeof(unsigned long) * 8;
7045 wC
= (unsigned long)((uA
>> wB
) | (uA
<< (S
- wB
)));
7051 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7055 Jim_DecrRefCount(interp
, A
);
7056 Jim_DecrRefCount(interp
, B
);
7062 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7063 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7067 double dA
, dB
, dC
= 0;
7068 jim_wide wA
, wB
, wC
= 0;
7070 Jim_Obj
*B
= ExprPop(e
);
7071 Jim_Obj
*A
= ExprPop(e
);
7073 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7074 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7075 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7081 switch (e
->opcode
) {
7082 case JIM_EXPROP_POW
:
7083 wC
= JimPowWide(wA
, wB
);
7085 case JIM_EXPROP_ADD
:
7088 case JIM_EXPROP_SUB
:
7091 case JIM_EXPROP_MUL
:
7094 case JIM_EXPROP_DIV
:
7096 Jim_SetResultString(interp
, "Division by zero", -1);
7103 * This code is tricky: C doesn't guarantee much
7104 * about the quotient or remainder, but Tcl does.
7105 * The remainder always has the same sign as the
7106 * divisor and a smaller absolute value.
7124 case JIM_EXPROP_LTE
:
7127 case JIM_EXPROP_GTE
:
7130 case JIM_EXPROP_NUMEQ
:
7133 case JIM_EXPROP_NUMNE
:
7140 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7141 switch (e
->opcode
) {
7142 case JIM_EXPROP_POW
:
7143 #ifdef JIM_MATH_FUNCTIONS
7149 case JIM_EXPROP_ADD
:
7152 case JIM_EXPROP_SUB
:
7155 case JIM_EXPROP_MUL
:
7158 case JIM_EXPROP_DIV
:
7161 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
7163 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
7178 case JIM_EXPROP_LTE
:
7182 case JIM_EXPROP_GTE
:
7186 case JIM_EXPROP_NUMEQ
:
7190 case JIM_EXPROP_NUMNE
:
7199 /* Handle the string case */
7202 const char *sA
= Jim_GetString(A
, &Alen
);
7203 const char *sB
= Jim_GetString(B
, &Blen
);
7207 switch (e
->opcode
) {
7209 wC
= JimStringCompare(sA
, Alen
, sB
, Blen
, 0) < 0;
7212 wC
= JimStringCompare(sA
, Alen
, sB
, Blen
, 0) > 0;
7214 case JIM_EXPROP_LTE
:
7215 wC
= JimStringCompare(sA
, Alen
, sB
, Blen
, 0) <= 0;
7217 case JIM_EXPROP_GTE
:
7218 wC
= JimStringCompare(sA
, Alen
, sB
, Blen
, 0) >= 0;
7220 case JIM_EXPROP_NUMEQ
:
7221 wC
= (Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0);
7223 case JIM_EXPROP_NUMNE
:
7224 wC
= (Alen
!= Blen
|| memcmp(sA
, sB
, Alen
) != 0);
7234 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7237 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7241 Jim_DecrRefCount(interp
, A
);
7242 Jim_DecrRefCount(interp
, B
);
7247 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
7252 listlen
= Jim_ListLength(interp
, listObjPtr
);
7253 for (i
= 0; i
< listlen
; i
++) {
7256 Jim_ListIndex(interp
, listObjPtr
, i
, &objPtr
, JIM_NONE
);
7258 if (Jim_StringEqObj(objPtr
, valObj
, 0)) {
7265 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7267 Jim_Obj
*B
= ExprPop(e
);
7268 Jim_Obj
*A
= ExprPop(e
);
7273 /* XXX: Not needed for IN, NI */
7274 const char *sA
= Jim_GetString(A
, &Alen
);
7275 const char *sB
= Jim_GetString(B
, &Blen
);
7277 switch (e
->opcode
) {
7278 case JIM_EXPROP_STREQ
:
7279 wC
= (Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0);
7281 case JIM_EXPROP_STRNE
:
7282 wC
= (Alen
!= Blen
|| memcmp(sA
, sB
, Alen
) != 0);
7284 case JIM_EXPROP_STRIN
:
7285 wC
= JimSearchList(interp
, B
, A
);
7287 case JIM_EXPROP_STRNI
:
7288 wC
= !JimSearchList(interp
, B
, A
);
7293 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7295 Jim_DecrRefCount(interp
, A
);
7296 Jim_DecrRefCount(interp
, B
);
7301 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
7306 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
7309 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
7315 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
7317 Jim_Obj
*skip
= ExprPop(e
);
7318 Jim_Obj
*A
= ExprPop(e
);
7321 switch (ExprBool(interp
, A
)) {
7323 /* false, so skip RHS opcodes with a 0 result */
7324 e
->skip
= skip
->internalRep
.wideValue
;
7325 ExprPush(e
, Jim_NewIntObj(interp
, 0));
7329 /* true so continue */
7336 Jim_DecrRefCount(interp
, A
);
7337 Jim_DecrRefCount(interp
, skip
);
7342 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
7344 Jim_Obj
*skip
= ExprPop(e
);
7345 Jim_Obj
*A
= ExprPop(e
);
7348 switch (ExprBool(interp
, A
)) {
7350 /* false, so do nothing */
7354 /* true so skip RHS opcodes with a 1 result */
7355 e
->skip
= skip
->internalRep
.wideValue
;
7356 ExprPush(e
, Jim_NewIntObj(interp
, 1));
7364 Jim_DecrRefCount(interp
, A
);
7365 Jim_DecrRefCount(interp
, skip
);
7370 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
7372 Jim_Obj
*A
= ExprPop(e
);
7375 switch (ExprBool(interp
, A
)) {
7377 ExprPush(e
, Jim_NewIntObj(interp
, 0));
7381 ExprPush(e
, Jim_NewIntObj(interp
, 1));
7389 Jim_DecrRefCount(interp
, A
);
7394 static int JimExprOpColon(Jim_Interp
*interp
, struct JimExprState
*e
)
7399 Jim_Obj
*C
= ExprPop(e
);
7400 Jim_Obj
*B
= ExprPop(e
);
7401 Jim_Obj
*A
= ExprPop(e
);
7403 switch (ExprBool(interp
, A
)) {
7417 Jim_DecrRefCount(interp
, A
);
7418 Jim_DecrRefCount(interp
, B
);
7419 Jim_DecrRefCount(interp
, C
);
7426 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
7428 Jim_Obj
*skip
= ExprPop(e
);
7429 Jim_Obj
*A
= ExprPop(e
);
7435 switch (ExprBool(interp
, A
)) {
7437 /* false, skip RHS opcodes */
7438 e
->skip
= skip
->internalRep
.wideValue
;
7439 /* Push a dummy value */
7440 ExprPush(e
, Jim_NewIntObj(interp
, 0));
7444 /* true so do nothing */
7452 Jim_DecrRefCount(interp
, A
);
7453 Jim_DecrRefCount(interp
, skip
);
7458 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
7460 Jim_Obj
*skip
= ExprPop(e
);
7461 Jim_Obj
*B
= ExprPop(e
);
7462 Jim_Obj
*A
= ExprPop(e
);
7464 /* No need to check for A as non-boolean */
7465 if (ExprBool(interp
, A
)) {
7466 /* true, so skip RHS opcodes */
7467 e
->skip
= skip
->internalRep
.wideValue
;
7468 /* Repush B as the answer */
7472 Jim_DecrRefCount(interp
, skip
);
7473 Jim_DecrRefCount(interp
, A
);
7474 Jim_DecrRefCount(interp
, B
);
7478 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
7491 /* name - precedence - arity - opcode */
7492 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
7493 [JIM_EXPROP_FUNC_INT
] = {"int", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
7494 [JIM_EXPROP_FUNC_DOUBLE
] = {"double", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
7495 [JIM_EXPROP_FUNC_ABS
] = {"abs", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
7496 [JIM_EXPROP_FUNC_ROUND
] = {"round", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
7498 #ifdef JIM_MATH_FUNCTIONS
7499 [JIM_EXPROP_FUNC_SIN
] = {"sin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7500 [JIM_EXPROP_FUNC_COS
] = {"cos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7501 [JIM_EXPROP_FUNC_TAN
] = {"tan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7502 [JIM_EXPROP_FUNC_ASIN
] = {"asin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7503 [JIM_EXPROP_FUNC_ACOS
] = {"acos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7504 [JIM_EXPROP_FUNC_ATAN
] = {"atan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7505 [JIM_EXPROP_FUNC_SINH
] = {"sinh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7506 [JIM_EXPROP_FUNC_COSH
] = {"cosh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7507 [JIM_EXPROP_FUNC_TANH
] = {"tanh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7508 [JIM_EXPROP_FUNC_CEIL
] = {"ceil", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7509 [JIM_EXPROP_FUNC_FLOOR
] = {"floor", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7510 [JIM_EXPROP_FUNC_EXP
] = {"exp", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7511 [JIM_EXPROP_FUNC_LOG
] = {"log", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7512 [JIM_EXPROP_FUNC_LOG10
] = {"log10", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7513 [JIM_EXPROP_FUNC_SQRT
] = {"sqrt", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
7516 [JIM_EXPROP_NOT
] = {"!", 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
7517 [JIM_EXPROP_BITNOT
] = {"~", 300, 1, JimExprOpIntUnary
, LAZY_NONE
},
7518 [JIM_EXPROP_UNARYMINUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
7519 [JIM_EXPROP_UNARYPLUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
7521 [JIM_EXPROP_POW
] = {"**", 250, 2, JimExprOpBin
, LAZY_NONE
},
7523 [JIM_EXPROP_MUL
] = {"*", 200, 2, JimExprOpBin
, LAZY_NONE
},
7524 [JIM_EXPROP_DIV
] = {"/", 200, 2, JimExprOpBin
, LAZY_NONE
},
7525 [JIM_EXPROP_MOD
] = {"%", 200, 2, JimExprOpIntBin
, LAZY_NONE
},
7527 [JIM_EXPROP_SUB
] = {"-", 100, 2, JimExprOpBin
, LAZY_NONE
},
7528 [JIM_EXPROP_ADD
] = {"+", 100, 2, JimExprOpBin
, LAZY_NONE
},
7530 [JIM_EXPROP_ROTL
] = {"<<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
7531 [JIM_EXPROP_ROTR
] = {">>>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
7532 [JIM_EXPROP_LSHIFT
] = {"<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
7533 [JIM_EXPROP_RSHIFT
] = {">>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
7535 [JIM_EXPROP_LT
] = {"<", 80, 2, JimExprOpBin
, LAZY_NONE
},
7536 [JIM_EXPROP_GT
] = {">", 80, 2, JimExprOpBin
, LAZY_NONE
},
7537 [JIM_EXPROP_LTE
] = {"<=", 80, 2, JimExprOpBin
, LAZY_NONE
},
7538 [JIM_EXPROP_GTE
] = {">=", 80, 2, JimExprOpBin
, LAZY_NONE
},
7540 [JIM_EXPROP_NUMEQ
] = {"==", 70, 2, JimExprOpBin
, LAZY_NONE
},
7541 [JIM_EXPROP_NUMNE
] = {"!=", 70, 2, JimExprOpBin
, LAZY_NONE
},
7543 [JIM_EXPROP_STREQ
] = {"eq", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
7544 [JIM_EXPROP_STRNE
] = {"ne", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
7546 [JIM_EXPROP_STRIN
] = {"in", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
7547 [JIM_EXPROP_STRNI
] = {"ni", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
7549 [JIM_EXPROP_BITAND
] = {"&", 50, 2, JimExprOpIntBin
, LAZY_NONE
},
7550 [JIM_EXPROP_BITXOR
] = {"^", 49, 2, JimExprOpIntBin
, LAZY_NONE
},
7551 [JIM_EXPROP_BITOR
] = {"|", 48, 2, JimExprOpIntBin
, LAZY_NONE
},
7553 [JIM_EXPROP_LOGICAND
] = {"&&", 10, 2, NULL
, LAZY_OP
},
7554 [JIM_EXPROP_LOGICOR
] = {"||", 9, 2, NULL
, LAZY_OP
},
7556 [JIM_EXPROP_TERNARY
] = {"?", 5, 2, JimExprOpNull
, LAZY_OP
},
7557 [JIM_EXPROP_COLON
] = {":", 5, 2, JimExprOpColon
, LAZY_OP
},
7559 /* private operators */
7560 [JIM_EXPROP_TERNARY_LEFT
] = {NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
},
7561 [JIM_EXPROP_TERNARY_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
7562 [JIM_EXPROP_COLON_LEFT
] = {NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
},
7563 [JIM_EXPROP_COLON_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
7564 [JIM_EXPROP_LOGICAND_LEFT
] = {NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
},
7565 [JIM_EXPROP_LOGICAND_RIGHT
] = {NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
7566 [JIM_EXPROP_LOGICOR_LEFT
] = {NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
},
7567 [JIM_EXPROP_LOGICOR_RIGHT
] = {NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
7570 #define JIM_EXPR_OPERATORS_NUM \
7571 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
7573 int JimParseExpression(struct JimParserCtx
*pc
)
7575 /* Discard spaces and quoted newline */
7576 while (isspace(*pc
->p
) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
7582 pc
->tstart
= pc
->tend
= pc
->p
;
7583 pc
->tline
= pc
->linenr
;
7584 pc
->tt
= JIM_TT_EOL
;
7590 pc
->tstart
= pc
->tend
= pc
->p
;
7591 pc
->tline
= pc
->linenr
;
7592 pc
->tt
= JIM_TT_SUBEXPR_START
;
7597 pc
->tstart
= pc
->tend
= pc
->p
;
7598 pc
->tline
= pc
->linenr
;
7599 pc
->tt
= JIM_TT_SUBEXPR_END
;
7604 return JimParseCmd(pc
);
7607 if (JimParseVar(pc
) == JIM_ERR
)
7608 return JimParseExprOperator(pc
);
7623 return JimParseExprNumber(pc
);
7627 /* Here it's possible to reuse the List String parsing. */
7628 pc
->tt
= JIM_TT_NONE
; /* Make sure it's sensed as a new word. */
7629 return JimParseListStr(pc
);
7635 if (JimParseExprIrrational(pc
) == JIM_ERR
)
7636 return JimParseExprOperator(pc
);
7639 return JimParseExprOperator(pc
);
7645 int JimParseExprNumber(struct JimParserCtx
*pc
)
7650 /* Assume an integer for now */
7651 pc
->tt
= JIM_TT_EXPR_INT
;
7653 pc
->tline
= pc
->linenr
;
7654 while (isdigit(*pc
->p
)
7655 || (allowhex
&& isxdigit(*pc
->p
))
7656 || (allowdot
&& *pc
->p
== '.')
7657 || (pc
->p
- pc
->tstart
== 1 && *pc
->tstart
== '0' && (*pc
->p
== 'x' || *pc
->p
== 'X'))
7659 if ((*pc
->p
== 'x') || (*pc
->p
== 'X')) {
7663 if (*pc
->p
== '.') {
7665 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
7669 if (!allowhex
&& (*pc
->p
== 'e' || *pc
->p
== 'E') && (pc
->p
[1] == '-' || pc
->p
[1] == '+'
7670 || isdigit(pc
->p
[1]))) {
7673 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
7676 pc
->tend
= pc
->p
- 1;
7680 int JimParseExprIrrational(struct JimParserCtx
*pc
)
7682 const char *Tokens
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
7685 for (token
= Tokens
; *token
!= NULL
; token
++) {
7686 int len
= strlen(*token
);
7688 if (strncmp(*token
, pc
->p
, len
) == 0) {
7690 pc
->tend
= pc
->p
+ len
- 1;
7693 pc
->tline
= pc
->linenr
;
7694 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
7701 int JimParseExprOperator(struct JimParserCtx
*pc
)
7704 int bestIdx
= -1, bestLen
= 0;
7706 /* Try to get the longest match. */
7707 for (i
= JIM_TT_EXPR_OP
; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
7711 opname
= Jim_ExprOperators
[i
].name
;
7712 if (opname
== NULL
) {
7715 oplen
= strlen(opname
);
7717 if (strncmp(opname
, pc
->p
, oplen
) == 0 && oplen
> bestLen
) {
7722 if (bestIdx
== -1) {
7726 /* Validate paretheses around function arguments */
7727 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
7728 const char *p
= pc
->p
+ bestLen
;
7729 int len
= pc
->len
- bestLen
;
7731 while (len
&& isspace(*p
)) {
7740 pc
->tend
= pc
->p
+ bestLen
- 1;
7743 pc
->tline
= pc
->linenr
;
7749 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
7751 return &Jim_ExprOperators
[opcode
];
7755 const char *tt_name(int type
)
7757 static const char *tt_names
[] =
7758 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "???", "(((", ")))", "INT",
7760 if (type
< JIM_TT_EXPR_OP
) {
7761 return tt_names
[type
];
7764 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
7765 static char buf
[20];
7767 if (op
&& op
->name
) {
7770 sprintf(buf
, "(%d)", type
);
7777 /* -----------------------------------------------------------------------------
7779 * ---------------------------------------------------------------------------*/
7780 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
7781 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
7782 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7784 static Jim_ObjType exprObjType
= {
7786 FreeExprInternalRep
,
7789 JIM_TYPE_REFERENCES
,
7792 /* Expr bytecode structure */
7793 typedef struct ExprByteCode
7795 int len
; /* Length as number of tokens. */
7796 ScriptToken
*token
; /* Tokens array. */
7797 int inUse
; /* Used for sharing. */
7800 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
7804 for (i
= 0; i
< expr
->len
; i
++) {
7805 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
7807 Jim_Free(expr
->token
);
7811 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7813 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
7816 if (--expr
->inUse
!= 0) {
7820 ExprFreeByteCode(interp
, expr
);
7824 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7826 JIM_NOTUSED(interp
);
7827 JIM_NOTUSED(srcPtr
);
7829 /* Just returns an simple string. */
7830 dupPtr
->typePtr
= NULL
;
7833 /* Check if an expr program looks correct. */
7834 static int ExprCheckCorrectness(ExprByteCode
* expr
)
7840 /* Try to check if there are stack underflows,
7841 * and make sure at the end of the program there is
7842 * a single result on the stack. */
7843 for (i
= 0; i
< expr
->len
; i
++) {
7844 ScriptToken
*t
= &expr
->token
[i
];
7845 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
7848 stacklen
-= op
->arity
;
7852 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
7855 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
7860 /* All operations and operands add one to the stack */
7863 if (stacklen
!= 1 || ternary
!= 0) {
7869 /* This procedure converts every occurrence of || and && opereators
7870 * in lazy unary versions.
7872 * a b || is converted into:
7874 * a <offset> |L b |R
7876 * a b && is converted into:
7878 * a <offset> &L b &R
7880 * "|L" checks if 'a' is true:
7881 * 1) if it is true pushes 1 and skips <offset> instructions to reach
7882 * the opcode just after |R.
7883 * 2) if it is false does nothing.
7884 * "|R" checks if 'b' is true:
7885 * 1) if it is true pushes 1, otherwise pushes 0.
7887 * "&L" checks if 'a' is true:
7888 * 1) if it is true does nothing.
7889 * 2) If it is false pushes 0 and skips <offset> instructions to reach
7890 * the opcode just after &R
7891 * "&R" checks if 'a' is true:
7892 * if it is true pushes 1, otherwise pushes 0.
7894 static void ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
7898 int leftindex
, arity
, offset
;
7900 /* Search for the end of the first operator */
7901 leftindex
= expr
->len
- 1;
7904 ScriptToken
*tt
= &expr
->token
[leftindex
];
7906 if (tt
->type
>= JIM_TT_EXPR_OP
) {
7907 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
7915 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
7916 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
7918 offset
= (expr
->len
- leftindex
) - 1;
7920 /* Now we rely on the fact the the left and right version have opcodes
7921 * 1 and 2 after the main opcode respectively
7923 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
7924 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
7926 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
7927 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
7929 /* Now add the 'R' operator */
7930 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
7931 expr
->token
[expr
->len
].type
= t
->type
+ 2;
7934 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
7935 for (i
= leftindex
- 1; i
> 0; i
--) {
7936 if (JimExprOperatorInfoByOpcode(expr
->token
[i
].type
)->lazy
== LAZY_LEFT
) {
7937 if (expr
->token
[i
- 1].objPtr
->internalRep
.wideValue
+ i
- 1 >= leftindex
) {
7938 expr
->token
[i
- 1].objPtr
->internalRep
.wideValue
+= 2;
7944 static void ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
7946 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
7948 if (JimExprOperatorInfoByOpcode(t
->type
)->lazy
== LAZY_OP
) {
7949 ExprAddLazyOperator(interp
, expr
, t
);
7952 token
->objPtr
= interp
->emptyObj
;
7953 token
->type
= t
->type
;
7958 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
)
7964 int prevtt
= JIM_TT_NONE
;
7967 int count
= tokenlist
->count
- 1;
7969 expr
= Jim_Alloc(sizeof(*expr
));
7973 Jim_InitStack(&stack
);
7975 /* Need extra bytecodes for lazy operators */
7976 for (i
= 0; i
< tokenlist
->count
; i
++) {
7977 ParseToken
*t
= &tokenlist
->list
[i
];
7979 if (JimExprOperatorInfoByOpcode(t
->type
)->lazy
== LAZY_OP
) {
7984 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
7986 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
7987 ParseToken
*t
= &tokenlist
->list
[i
];
7989 /* Next token will be stored here */
7990 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
7992 if (t
->type
== JIM_TT_EOL
) {
8000 case JIM_TT_DICTSUGAR
:
8002 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8003 token
->type
= t
->type
;
8007 case JIM_TT_EXPR_INT
:
8008 token
->objPtr
= Jim_NewIntObj(interp
, strtoull(t
->token
, NULL
, 0));
8009 token
->type
= t
->type
;
8013 case JIM_TT_EXPR_DOUBLE
:
8014 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, NULL
));
8015 token
->type
= t
->type
;
8019 case JIM_TT_SUBEXPR_START
:
8020 Jim_StackPush(&stack
, t
);
8021 prevtt
= JIM_TT_NONE
;
8024 case JIM_TT_SUBEXPR_END
:
8026 while (Jim_StackLen(&stack
)) {
8027 ParseToken
*tt
= Jim_StackPop(&stack
);
8029 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
8034 ExprAddOperator(interp
, expr
, tt
);
8037 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
8044 /* Must be an operator */
8045 const struct Jim_ExprOperator
*op
;
8048 /* Convert -/+ to unary minus or unary plus if necessary */
8049 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
8050 if (t
->type
== JIM_EXPROP_SUB
) {
8051 t
->type
= JIM_EXPROP_UNARYMINUS
;
8053 else if (t
->type
== JIM_EXPROP_ADD
) {
8054 t
->type
= JIM_EXPROP_UNARYPLUS
;
8058 op
= JimExprOperatorInfoByOpcode(t
->type
);
8060 /* Now handle precedence */
8061 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
8062 const struct Jim_ExprOperator
*tt_op
=
8063 JimExprOperatorInfoByOpcode(tt
->type
);
8065 /* XXX: Should handle right-to-left associativity of ?: operator */
8067 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
8068 ExprAddOperator(interp
, expr
, tt
);
8069 Jim_StackPop(&stack
);
8075 Jim_StackPush(&stack
, t
);
8082 /* Reduce any remaining subexpr */
8083 while (Jim_StackLen(&stack
)) {
8084 ParseToken
*tt
= Jim_StackPop(&stack
);
8086 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
8088 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
8091 ExprAddOperator(interp
, expr
, tt
);
8095 /* Free the stack used for the compilation. */
8096 Jim_FreeStack(&stack
);
8098 for (i
= 0; i
< expr
->len
; i
++) {
8099 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
8103 ExprFreeByteCode(interp
, expr
);
8111 /* This method takes the string representation of an expression
8112 * and generates a program for the Expr's stack-based VM. */
8113 int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
8116 const char *exprText
;
8117 struct JimParserCtx parser
;
8118 struct ExprByteCode
*expr
;
8119 ParseTokenList tokenlist
;
8122 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
8124 /* Initially tokenise the expression into tokenlist */
8125 ScriptTokenListInit(&tokenlist
);
8127 JimParserInit(&parser
, exprText
, exprTextLen
, 0);
8128 while (!JimParserEof(&parser
)) {
8129 if (JimParseExpression(&parser
) != JIM_OK
) {
8130 ScriptTokenListFree(&tokenlist
);
8132 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
8137 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
8141 /* Now create the expression bytecode from the tokenlist */
8142 expr
= ExprCreateByteCode(interp
, &tokenlist
);
8144 /* No longer need the token list */
8145 ScriptTokenListFree(&tokenlist
);
8154 printf("==== Expr ====\n");
8155 for (i
= 0; i
< expr
->len
; i
++) {
8156 ScriptToken
*t
= &expr
->token
[i
];
8158 printf("[%2d] %s '%s'\n", i
, tt_name(t
->type
), Jim_GetString(t
->objPtr
, NULL
));
8162 /* Check program correctness. */
8163 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
8164 ExprFreeByteCode(interp
, expr
);
8171 printf("==== Expr ====\n");
8172 for (i
= 0; i
< expr
->len
; i
++) {
8173 ScriptToken
*t
= &expr
->token
[i
];
8175 printf("[%2d] %s '%s'\n", i
, tt_name(t
->type
), Jim_GetString(t
->objPtr
, NULL
));
8180 /* Free the old internal rep and set the new one. */
8181 Jim_FreeIntRep(interp
, objPtr
);
8182 Jim_SetIntRepPtr(objPtr
, expr
);
8183 objPtr
->typePtr
= &exprObjType
;
8187 static ExprByteCode
*Jim_GetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8189 if (objPtr
->typePtr
!= &exprObjType
) {
8190 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
8194 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
8197 /* -----------------------------------------------------------------------------
8198 * Expressions evaluation.
8199 * Jim uses a specialized stack-based virtual machine for expressions,
8200 * that takes advantage of the fact that expr's operators
8201 * can't be redefined.
8203 * Jim_EvalExpression() uses the bytecode compiled by
8204 * SetExprFromAny() method of the "expression" object.
8206 * On success a Tcl Object containing the result of the evaluation
8207 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
8209 * On error the function returns a retcode != to JIM_OK and set a suitable
8210 * error on the interp.
8211 * ---------------------------------------------------------------------------*/
8212 #define JIM_EE_STATICSTACK_LEN 10
8214 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
8217 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
8219 int retcode
= JIM_OK
;
8220 struct JimExprState e
;
8222 expr
= Jim_GetExpression(interp
, exprObjPtr
);
8224 return JIM_ERR
; /* error in expression. */
8227 #ifdef JIM_OPTIMIZATION
8228 /* Check for one of the following common expressions used by while/for
8233 * $a < CONST, $a < $b
8234 * $a <= CONST, $a <= $b
8235 * $a > CONST, $a > $b
8236 * $a >= CONST, $a >= $b
8237 * $a != CONST, $a != $b
8238 * $a == CONST, $a == $b
8243 /* STEP 1 -- Check if there are the conditions to run the specialized
8244 * version of while */
8246 switch (expr
->len
) {
8248 if (expr
->token
[0].type
== JIM_TT_EXPR_INT
) {
8249 *exprResultPtrPtr
= expr
->token
[0].objPtr
;
8250 Jim_IncrRefCount(*exprResultPtrPtr
);
8253 if (expr
->token
[0].type
== JIM_TT_VAR
) {
8254 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_ERRMSG
);
8256 *exprResultPtrPtr
= objPtr
;
8257 Jim_IncrRefCount(*exprResultPtrPtr
);
8264 if (expr
->token
[1].type
== JIM_EXPROP_NOT
&& expr
->token
[0].type
== JIM_TT_VAR
) {
8267 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
8268 if (objPtr
&& Jim_IsWide(objPtr
)
8269 && Jim_GetWide(interp
, objPtr
, &wideValue
) == JIM_OK
) {
8270 *exprResultPtrPtr
= wideValue
? interp
->falseObj
: interp
->trueObj
;
8271 Jim_IncrRefCount(*exprResultPtrPtr
);
8278 if (expr
->token
[0].type
== JIM_TT_VAR
&& (expr
->token
[1].type
== JIM_TT_EXPR_INT
8279 || expr
->token
[1].type
== JIM_TT_VAR
)) {
8280 switch (expr
->token
[2].type
) {
8282 case JIM_EXPROP_LTE
:
8284 case JIM_EXPROP_GTE
:
8285 case JIM_EXPROP_NUMEQ
:
8286 case JIM_EXPROP_NUMNE
:{
8288 jim_wide wideValueA
;
8289 jim_wide wideValueB
;
8291 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
8292 if (objPtr
&& Jim_IsWide(objPtr
)
8293 && Jim_GetWide(interp
, objPtr
, &wideValueA
) == JIM_OK
) {
8294 if (expr
->token
[1].type
== JIM_TT_VAR
) {
8296 Jim_GetVariable(interp
, expr
->token
[1].objPtr
,
8300 objPtr
= expr
->token
[1].objPtr
;
8302 if (objPtr
&& Jim_IsWide(objPtr
)
8303 && Jim_GetWide(interp
, objPtr
, &wideValueB
) == JIM_OK
) {
8306 switch (expr
->token
[2].type
) {
8308 cmpRes
= wideValueA
< wideValueB
;
8310 case JIM_EXPROP_LTE
:
8311 cmpRes
= wideValueA
<= wideValueB
;
8314 cmpRes
= wideValueA
> wideValueB
;
8316 case JIM_EXPROP_GTE
:
8317 cmpRes
= wideValueA
>= wideValueB
;
8319 case JIM_EXPROP_NUMEQ
:
8320 cmpRes
= wideValueA
== wideValueB
;
8322 case JIM_EXPROP_NUMNE
:
8323 cmpRes
= wideValueA
!= wideValueB
;
8325 default: /*notreached */
8329 cmpRes
? interp
->trueObj
: interp
->falseObj
;
8330 Jim_IncrRefCount(*exprResultPtrPtr
);
8342 /* In order to avoid that the internal repr gets freed due to
8343 * shimmering of the exprObjPtr's object, we make the internal rep
8347 /* The stack-based expr VM itself */
8349 /* Stack allocation. Expr programs have the feature that
8350 * a program of length N can't require a stack longer than
8352 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
8353 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
8355 e
.stack
= staticStack
;
8359 /* Execute every instruction */
8360 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
8363 switch (expr
->token
[i
].type
) {
8364 case JIM_TT_EXPR_INT
:
8365 case JIM_TT_EXPR_DOUBLE
:
8367 ExprPush(&e
, expr
->token
[i
].objPtr
);
8371 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
8373 ExprPush(&e
, objPtr
);
8380 case JIM_TT_DICTSUGAR
:
8381 objPtr
= Jim_ExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
8383 ExprPush(&e
, objPtr
);
8391 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
8392 if (retcode
== JIM_OK
) {
8393 ExprPush(&e
, objPtr
);
8398 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
8399 if (retcode
== JIM_OK
) {
8400 ExprPush(&e
, Jim_GetResult(interp
));
8405 /* Find and execute the operation */
8407 e
.opcode
= expr
->token
[i
].type
;
8409 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
8410 /* Skip some opcodes if necessary */
8419 if (retcode
== JIM_OK
) {
8420 *exprResultPtrPtr
= ExprPop(&e
);
8423 for (i
= 0; i
< e
.stacklen
; i
++) {
8424 Jim_DecrRefCount(interp
, e
.stack
[i
]);
8427 if (e
.stack
!= staticStack
) {
8433 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
8438 Jim_Obj
*exprResultPtr
;
8440 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
8441 if (retcode
!= JIM_OK
)
8444 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
8445 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
8446 Jim_DecrRefCount(interp
, exprResultPtr
);
8450 Jim_DecrRefCount(interp
, exprResultPtr
);
8451 *boolPtr
= doubleValue
!= 0;
8455 *boolPtr
= wideValue
!= 0;
8457 Jim_DecrRefCount(interp
, exprResultPtr
);
8461 /* -----------------------------------------------------------------------------
8462 * ScanFormat String Object
8463 * ---------------------------------------------------------------------------*/
8465 /* This Jim_Obj will held a parsed representation of a format string passed to
8466 * the Jim_ScanString command. For error diagnostics, the scanformat string has
8467 * to be parsed in its entirely first and then, if correct, can be used for
8468 * scanning. To avoid endless re-parsing, the parsed representation will be
8469 * stored in an internal representation and re-used for performance reason. */
8471 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
8472 * scanformat string. This part will later be used to extract information
8473 * out from the string to be parsed by Jim_ScanString */
8475 typedef struct ScanFmtPartDescr
8477 char type
; /* Type of conversion (e.g. c, d, f) */
8478 char modifier
; /* Modify type (e.g. l - long, h - short */
8479 size_t width
; /* Maximal width of input to be converted */
8480 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
8481 char *arg
; /* Specification of a CHARSET conversion */
8482 char *prefix
; /* Prefix to be scanned literally before conversion */
8485 /* The ScanFmtStringObj will hold the internal representation of a scanformat
8486 * string parsed and separated in part descriptions. Furthermore it contains
8487 * the original string representation of the scanformat string to allow for
8488 * fast update of the Jim_Obj's string representation part.
8490 * As an add-on the internal object representation adds some scratch pad area
8491 * for usage by Jim_ScanString to avoid endless allocating and freeing of
8492 * memory for purpose of string scanning.
8494 * The error member points to a static allocated string in case of a mal-
8495 * formed scanformat string or it contains '0' (NULL) in case of a valid
8496 * parse representation.
8498 * The whole memory of the internal representation is allocated as a single
8499 * area of memory that will be internally separated. So freeing and duplicating
8500 * of such an object is cheap */
8502 typedef struct ScanFmtStringObj
8504 jim_wide size
; /* Size of internal repr in bytes */
8505 char *stringRep
; /* Original string representation */
8506 size_t count
; /* Number of ScanFmtPartDescr contained */
8507 size_t convCount
; /* Number of conversions that will assign */
8508 size_t maxPos
; /* Max position index if XPG3 is used */
8509 const char *error
; /* Ptr to error text (NULL if no error */
8510 char *scratch
; /* Some scratch pad used by Jim_ScanString */
8511 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
8515 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8516 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8517 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
8519 static const Jim_ObjType scanFmtStringObjType
= {
8521 FreeScanFmtInternalRep
,
8522 DupScanFmtInternalRep
,
8523 UpdateStringOfScanFmt
,
8527 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8529 JIM_NOTUSED(interp
);
8530 Jim_Free((char *)objPtr
->internalRep
.ptr
);
8531 objPtr
->internalRep
.ptr
= 0;
8534 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8536 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
8537 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
8539 JIM_NOTUSED(interp
);
8540 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
8541 dupPtr
->internalRep
.ptr
= newVec
;
8542 dupPtr
->typePtr
= &scanFmtStringObjType
;
8545 void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
8547 char *bytes
= ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
;
8549 objPtr
->bytes
= Jim_StrDup(bytes
);
8550 objPtr
->length
= strlen(bytes
);
8553 /* SetScanFmtFromAny will parse a given string and create the internal
8554 * representation of the format specification. In case of an error
8555 * the error data member of the internal representation will be set
8556 * to an descriptive error text and the function will be left with
8557 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
8560 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8562 ScanFmtStringObj
*fmtObj
;
8564 int maxCount
, i
, approxSize
, lastPos
= -1;
8565 const char *fmt
= objPtr
->bytes
;
8566 int maxFmtLen
= objPtr
->length
;
8567 const char *fmtEnd
= fmt
+ maxFmtLen
;
8570 Jim_FreeIntRep(interp
, objPtr
);
8571 /* Count how many conversions could take place maximally */
8572 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
8575 /* Calculate an approximation of the memory necessary */
8576 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
8577 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
8578 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
8579 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
8580 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
8581 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
8582 +1; /* safety byte */
8583 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
8584 memset(fmtObj
, 0, approxSize
);
8585 fmtObj
->size
= approxSize
;
8587 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
8588 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
8589 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
8590 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
8591 objPtr
->internalRep
.ptr
= fmtObj
;
8592 objPtr
->typePtr
= &scanFmtStringObjType
;
8593 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
8594 int width
= 0, skip
;
8595 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
8598 descr
->width
= 0; /* Assume width unspecified */
8599 /* Overread and store any "literal" prefix */
8600 if (*fmt
!= '%' || fmt
[1] == '%') {
8602 descr
->prefix
= &buffer
[i
];
8603 for (; fmt
< fmtEnd
; ++fmt
) {
8613 /* Skip the conversion introducing '%' sign */
8615 /* End reached due to non-conversion literal only? */
8618 descr
->pos
= 0; /* Assume "natural" positioning */
8620 descr
->pos
= -1; /* Okay, conversion will not be assigned */
8624 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
8625 /* Check if next token is a number (could be width or pos */
8626 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
8628 /* Was the number a XPG3 position specifier? */
8629 if (descr
->pos
!= -1 && *fmt
== '$') {
8635 /* Look if "natural" postioning and XPG3 one was mixed */
8636 if ((lastPos
== 0 && descr
->pos
> 0)
8637 || (lastPos
> 0 && descr
->pos
== 0)) {
8638 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
8641 /* Look if this position was already used */
8642 for (prev
= 0; prev
< curr
; ++prev
) {
8643 if (fmtObj
->descr
[prev
].pos
== -1)
8645 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
8647 "variable is assigned by multiple \"%n$\" conversion specifiers";
8651 /* Try to find a width after the XPG3 specifier */
8652 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
8653 descr
->width
= width
;
8656 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
8657 fmtObj
->maxPos
= descr
->pos
;
8660 /* Number was not a XPG3, so it has to be a width */
8661 descr
->width
= width
;
8664 /* If positioning mode was undetermined yet, fix this */
8666 lastPos
= descr
->pos
;
8667 /* Handle CHARSET conversion type ... */
8669 int swapped
= 1, beg
= i
, end
, j
;
8672 descr
->arg
= &buffer
[i
];
8675 buffer
[i
++] = *fmt
++;
8677 buffer
[i
++] = *fmt
++;
8678 while (*fmt
&& *fmt
!= ']')
8679 buffer
[i
++] = *fmt
++;
8681 fmtObj
->error
= "unmatched [ in format string";
8686 /* In case a range fence was given "backwards", swap it */
8689 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
8690 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
8691 char tmp
= buffer
[j
- 1];
8693 buffer
[j
- 1] = buffer
[j
+ 1];
8694 buffer
[j
+ 1] = tmp
;
8701 /* Remember any valid modifier if given */
8702 if (strchr("hlL", *fmt
) != 0)
8703 descr
->modifier
= tolower((int)*fmt
++);
8706 if (strchr("efgcsndoxui", *fmt
) == 0) {
8707 fmtObj
->error
= "bad scan conversion character";
8710 else if (*fmt
== 'c' && descr
->width
!= 0) {
8711 fmtObj
->error
= "field width may not be specified in %c " "conversion";
8714 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
8715 fmtObj
->error
= "unsigned wide not supported";
8725 /* Some accessor macros to allow lowlevel access to fields of internal repr */
8727 #define FormatGetCnvCount(_fo_) \
8728 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
8729 #define FormatGetMaxPos(_fo_) \
8730 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
8731 #define FormatGetError(_fo_) \
8732 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
8734 /* Some Bit testing/setting/cleaning routines. For now only used in handling
8735 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
8736 * bitvector implementation in Jim? */
8738 static int JimTestBit(const char *bitvec
, char ch
)
8740 div_t pos
= div(ch
- 1, 8);
8742 return bitvec
[pos
.quot
] & (1 << pos
.rem
);
8745 static void JimSetBit(char *bitvec
, char ch
)
8747 div_t pos
= div(ch
- 1, 8);
8749 bitvec
[pos
.quot
] |= (1 << pos
.rem
);
8752 #if 0 /* currently not used */
8753 static void JimClearBit(char *bitvec
, char ch
)
8755 div_t pos
= div(ch
- 1, 8);
8757 bitvec
[pos
.quot
] &= ~(1 << pos
.rem
);
8761 /* JimScanAString is used to scan an unspecified string that ends with
8762 * next WS, or a string that is specified via a charset. The charset
8763 * is currently implemented in a way to only allow for usage with
8764 * ASCII. Whenever we will switch to UNICODE, another idea has to
8767 * FIXME: Works only with ASCII */
8769 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
8773 char charset
[256 / 8 + 1]; /* A Charset may contain max 256 chars */
8774 char *buffer
= Jim_Alloc(strlen(str
) + 1), *anchor
= buffer
;
8776 /* First init charset to nothing or all, depending if a specified
8777 * or an unspecified string has to be parsed */
8778 memset(charset
, (sdescr
? 0 : 255), sizeof(charset
));
8780 /* There was a set description given, that means we are parsing
8781 * a specified string. So we have to build a corresponding
8782 * charset reflecting the description */
8785 /* Should the set be negated at the end? */
8786 if (*sdescr
== '^') {
8790 /* Here '-' is meant literally and not to define a range */
8791 if (*sdescr
== '-') {
8792 JimSetBit(charset
, '-');
8796 if (sdescr
[1] == '-' && sdescr
[2] != 0) {
8797 /* Handle range definitions */
8800 for (i
= sdescr
[0]; i
<= sdescr
[2]; ++i
)
8801 JimSetBit(charset
, (char)i
);
8805 /* Handle verbatim character definitions */
8806 JimSetBit(charset
, *sdescr
++);
8809 /* Negate the charset if there was a NOT given */
8810 for (i
= 0; notFlag
&& i
< sizeof(charset
); ++i
)
8811 charset
[i
] = ~charset
[i
];
8813 /* And after all the mess above, the real work begin ... */
8814 while (str
&& *str
) {
8815 if (!sdescr
&& isspace(*str
))
8816 break; /* EOS via WS if unspecified */
8817 if (JimTestBit(charset
, *str
))
8820 break; /* EOS via mismatch if specified scanning */
8822 *buffer
= 0; /* Close the string properly ... */
8823 result
= Jim_NewStringObj(interp
, anchor
, -1);
8824 Jim_Free(anchor
); /* ... and free it afer usage */
8828 /* ScanOneEntry will scan one entry out of the string passed as argument.
8829 * It use the sscanf() function for this task. After extracting and
8830 * converting of the value, the count of scanned characters will be
8831 * returned of -1 in case of no conversion tool place and string was
8832 * already scanned thru */
8834 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, long pos
,
8835 ScanFmtStringObj
* fmtObj
, long index
, Jim_Obj
**valObjPtr
)
8838 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[index
];
8839 size_t sLen
= strlen(&str
[pos
]), scanned
= 0;
8840 size_t anchor
= pos
;
8843 /* First pessimistically assume, we will not scan anything :-) */
8845 if (descr
->prefix
) {
8846 /* There was a prefix given before the conversion, skip it and adjust
8847 * the string-to-be-parsed accordingly */
8848 for (i
= 0; str
[pos
] && descr
->prefix
[i
]; ++i
) {
8849 /* If prefix require, skip WS */
8850 if (isspace(descr
->prefix
[i
]))
8851 while (str
[pos
] && isspace(str
[pos
]))
8853 else if (descr
->prefix
[i
] != str
[pos
])
8854 break; /* Prefix do not match here, leave the loop */
8856 ++pos
; /* Prefix matched so far, next round */
8859 return -1; /* All of str consumed: EOF condition */
8860 else if (descr
->prefix
[i
] != 0)
8861 return 0; /* Not whole prefix consumed, no conversion possible */
8863 /* For all but following conversion, skip leading WS */
8864 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
8865 while (isspace(str
[pos
]))
8867 /* Determine how much skipped/scanned so far */
8868 scanned
= pos
- anchor
;
8869 if (descr
->type
== 'n') {
8870 /* Return pseudo conversion means: how much scanned so far? */
8871 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
8873 else if (str
[pos
] == 0) {
8874 /* Cannot scan anything, as str is totally consumed */
8878 /* Processing of conversions follows ... */
8879 if (descr
->width
> 0) {
8880 /* Do not try to scan as fas as possible but only the given width.
8881 * To ensure this, we copy the part that should be scanned. */
8882 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
8884 tok
= Jim_StrDupLen(&str
[pos
], tLen
);
8887 /* As no width was given, simply refer to the original string */
8890 switch (descr
->type
) {
8892 *valObjPtr
= Jim_NewIntObj(interp
, *tok
);
8900 char *endp
; /* Position where the number finished */
8903 int base
= descr
->type
== 'o' ? 8
8904 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
8906 /* Try to scan a number with the given base */
8907 w
= strtoull(tok
, &endp
, base
);
8908 if (endp
== tok
&& base
== 0) {
8909 /* If scanning failed, and base was undetermined, simply
8910 * put it to 10 and try once more. This should catch the
8911 * case where %i begin to parse a number prefix (e.g.
8912 * '0x' but no further digits follows. This will be
8913 * handled as a ZERO followed by a char 'x' by Tcl */
8914 w
= strtoull(tok
, &endp
, 10);
8918 /* There was some number sucessfully scanned! */
8919 *valObjPtr
= Jim_NewIntObj(interp
, w
);
8921 /* Adjust the number-of-chars scanned so far */
8922 scanned
+= endp
- tok
;
8925 /* Nothing was scanned. We have to determine if this
8926 * happened due to e.g. prefix mismatch or input str
8928 scanned
= *tok
? 0 : -1;
8934 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
8935 scanned
+= Jim_Length(*valObjPtr
);
8942 double value
= strtod(tok
, &endp
);
8945 /* There was some number sucessfully scanned! */
8946 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
8947 /* Adjust the number-of-chars scanned so far */
8948 scanned
+= endp
- tok
;
8951 /* Nothing was scanned. We have to determine if this
8952 * happened due to e.g. prefix mismatch or input str
8954 scanned
= *tok
? 0 : -1;
8959 /* If a substring was allocated (due to pre-defined width) do not
8960 * forget to free it */
8961 if (tok
!= &str
[pos
])
8962 Jim_Free((char *)tok
);
8967 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
8968 * string and returns all converted (and not ignored) values in a list back
8969 * to the caller. If an error occured, a NULL pointer will be returned */
8971 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
8975 const char *str
= Jim_GetString(strObjPtr
, 0);
8976 Jim_Obj
*resultList
= 0;
8977 Jim_Obj
**resultVec
= 0;
8979 Jim_Obj
*emptyStr
= 0;
8980 ScanFmtStringObj
*fmtObj
;
8982 /* This should never happen. The format object should already be of the correct type */
8983 if (fmtObjPtr
->typePtr
!= &scanFmtStringObjType
) {
8984 Jim_Panic(interp
, "Jim_ScanString() for non-scan format");
8986 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
8987 /* Check if format specification was valid */
8988 if (fmtObj
->error
!= 0) {
8989 if (flags
& JIM_ERRMSG
)
8990 Jim_SetResultString(interp
, fmtObj
->error
, -1);
8993 /* Allocate a new "shared" empty string for all unassigned conversions */
8994 emptyStr
= Jim_NewEmptyStringObj(interp
);
8995 Jim_IncrRefCount(emptyStr
);
8996 /* Create a list and fill it with empty strings up to max specified XPG3 */
8997 resultList
= Jim_NewListObj(interp
, 0, 0);
8998 if (fmtObj
->maxPos
> 0) {
8999 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9000 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9001 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9003 /* Now handle every partial format description */
9004 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9005 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9008 /* Only last type may be "literal" w/o conversion - skip it! */
9009 if (descr
->type
== 0)
9011 /* As long as any conversion could be done, we will proceed */
9013 scanned
= ScanOneEntry(interp
, str
, pos
, fmtObj
, i
, &value
);
9014 /* In case our first try results in EOF, we will leave */
9015 if (scanned
== -1 && i
== 0)
9017 /* Advance next pos-to-be-scanned for the amount scanned already */
9019 /* value == 0 means no conversion took place so take empty string */
9021 value
= Jim_NewEmptyStringObj(interp
);
9022 /* If value is a non-assignable one, skip it */
9023 if (descr
->pos
== -1) {
9024 Jim_FreeNewObj(interp
, value
);
9026 else if (descr
->pos
== 0)
9027 /* Otherwise append it to the result list if no XPG3 was given */
9028 Jim_ListAppendElement(interp
, resultList
, value
);
9029 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9030 /* But due to given XPG3, put the value into the corr. slot */
9031 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9032 Jim_IncrRefCount(value
);
9033 resultVec
[descr
->pos
- 1] = value
;
9036 /* Otherwise, the slot was already used - free obj and ERROR */
9037 Jim_FreeNewObj(interp
, value
);
9041 Jim_DecrRefCount(interp
, emptyStr
);
9044 Jim_DecrRefCount(interp
, emptyStr
);
9045 Jim_FreeNewObj(interp
, resultList
);
9046 return (Jim_Obj
*)EOF
;
9048 Jim_DecrRefCount(interp
, emptyStr
);
9049 Jim_FreeNewObj(interp
, resultList
);
9053 /* -----------------------------------------------------------------------------
9054 * Pseudo Random Number Generation
9055 * ---------------------------------------------------------------------------*/
9056 static void JimPrngSeed(Jim_Interp
*interp
, const unsigned char *seed
, int seedLen
);
9058 /* Initialize the sbox with the numbers from 0 to 255 */
9059 static void JimPrngInit(Jim_Interp
*interp
)
9062 /* REVISIT: Move off stack */
9063 unsigned int seed
[256];
9065 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
9066 for (i
= 0; i
< 256; i
++)
9067 seed
[i
] = (rand() ^ time(NULL
) ^ clock());
9068 JimPrngSeed(interp
, (unsigned char *)seed
, sizeof(int) * 256);
9071 /* Generates N bytes of random data */
9072 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
9074 Jim_PrngState
*prng
;
9075 unsigned char *destByte
= (unsigned char *)dest
;
9076 unsigned int si
, sj
, x
;
9078 /* initialization, only needed the first time */
9079 if (interp
->prngState
== NULL
)
9080 JimPrngInit(interp
);
9081 prng
= interp
->prngState
;
9082 /* generates 'len' bytes of pseudo-random numbers */
9083 for (x
= 0; x
< len
; x
++) {
9084 prng
->i
= (prng
->i
+ 1) & 0xff;
9085 si
= prng
->sbox
[prng
->i
];
9086 prng
->j
= (prng
->j
+ si
) & 0xff;
9087 sj
= prng
->sbox
[prng
->j
];
9088 prng
->sbox
[prng
->i
] = sj
;
9089 prng
->sbox
[prng
->j
] = si
;
9090 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
9094 /* Re-seed the generator with user-provided bytes */
9095 static void JimPrngSeed(Jim_Interp
*interp
, const unsigned char *seed
, int seedLen
)
9098 /* REVISIT: Move off stack */
9099 unsigned char buf
[256];
9100 Jim_PrngState
*prng
;
9102 /* initialization, only needed the first time */
9103 if (interp
->prngState
== NULL
)
9104 JimPrngInit(interp
);
9105 prng
= interp
->prngState
;
9107 /* Set the sbox[i] with i */
9108 for (i
= 0; i
< 256; i
++)
9110 /* Now use the seed to perform a random permutation of the sbox */
9111 for (i
= 0; i
< seedLen
; i
++) {
9114 t
= prng
->sbox
[i
& 0xFF];
9115 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
9116 prng
->sbox
[seed
[i
]] = t
;
9118 prng
->i
= prng
->j
= 0;
9119 /* discard the first 256 bytes of stream. */
9120 JimRandomBytes(interp
, buf
, 256);
9123 /* -----------------------------------------------------------------------------
9125 * ---------------------------------------------------------------------------*/
9126 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
9127 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
9129 /* Handle calls to the [unknown] command */
9130 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *filename
,
9133 Jim_Obj
**v
, *sv
[JIM_EVAL_SARGV_LEN
];
9136 /* If JimUnknown() is recursively called too many times...
9139 if (interp
->unknown_called
> 50) {
9143 /* If the [unknown] command does not exists returns
9145 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
9148 /* The object interp->unknown just contains
9149 * the "unknown" string, it is used in order to
9150 * avoid to lookup the unknown command every time
9151 * but instread to cache the result. */
9152 if (argc
+ 1 <= JIM_EVAL_SARGV_LEN
)
9155 v
= Jim_Alloc(sizeof(Jim_Obj
*) * (argc
+ 1));
9156 /* Make a copy of the arguments vector, but shifted on
9157 * the right of one position. The command name of the
9158 * command will be instead the first argument of the
9159 * [unknown] call. */
9160 memcpy(v
+ 1, argv
, sizeof(Jim_Obj
*) * argc
);
9161 v
[0] = interp
->unknown
;
9163 interp
->unknown_called
++;
9164 retCode
= JimEvalObjVector(interp
, argc
+ 1, v
, filename
, linenr
);
9165 interp
->unknown_called
--;
9173 /* Eval the object vector 'objv' composed of 'objc' elements.
9174 * Every element is used as single argument.
9175 * Jim_EvalObj() will call this function every time its object
9176 * argument is of "list" type, with no string representation.
9178 * This is possible because the string representation of a
9179 * list object generated by the UpdateStringOfList is made
9180 * in a way that ensures that every list element is a different
9181 * command argument. */
9182 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
9183 const char *filename
, int linenr
)
9188 /* Incr refcount of arguments. */
9189 for (i
= 0; i
< objc
; i
++)
9190 Jim_IncrRefCount(objv
[i
]);
9191 /* Command lookup */
9192 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
9193 if (cmdPtr
== NULL
) {
9194 retcode
= JimUnknown(interp
, objc
, objv
, filename
, linenr
);
9197 /* Call it -- Make sure result is an empty object. */
9198 JimIncrCmdRefCount(cmdPtr
);
9199 Jim_SetEmptyResult(interp
);
9200 if (cmdPtr
->cmdProc
) {
9201 interp
->cmdPrivData
= cmdPtr
->privData
;
9202 retcode
= cmdPtr
->cmdProc(interp
, objc
, objv
);
9205 retcode
= JimCallProcedure(interp
, cmdPtr
, filename
, linenr
, objc
, objv
);
9207 JimDecrCmdRefCount(interp
, cmdPtr
);
9209 /* Decr refcount of arguments and return the retcode */
9210 for (i
= 0; i
< objc
; i
++)
9211 Jim_DecrRefCount(interp
, objv
[i
]);
9216 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
9218 return JimEvalObjVector(interp
, objc
, objv
, NULL
, 0);
9221 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
9222 * via *objPtrPtr. This function is only called by Jim_EvalObj().
9223 * The returned object has refcount = 0. */
9224 int Jim_InterpolateTokens(Jim_Interp
*interp
, ScriptToken
* token
, int tokens
, Jim_Obj
**objPtrPtr
)
9226 int totlen
= 0, i
, retcode
;
9228 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
9232 if (tokens
<= JIM_EVAL_SINTV_LEN
)
9235 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
9236 /* Compute every token forming the argument
9237 * in the intv objects vector. */
9238 for (i
= 0; i
< tokens
; i
++) {
9239 switch (token
[i
].type
) {
9242 intv
[i
] = token
[i
].objPtr
;
9245 intv
[i
] = Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
9251 case JIM_TT_DICTSUGAR
:
9252 intv
[i
] = Jim_ExpandDictSugar(interp
, token
[i
].objPtr
);
9259 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
9260 if (retcode
!= JIM_OK
)
9262 intv
[i
] = Jim_GetResult(interp
);
9265 Jim_Panic(interp
, "default token type reached " "in Jim_InterpolateTokens().");
9268 Jim_IncrRefCount(intv
[i
]);
9269 /* Make sure there is a valid
9270 * string rep, and add the string
9271 * length to the total legnth. */
9272 Jim_GetString(intv
[i
], NULL
);
9273 totlen
+= intv
[i
]->length
;
9275 /* Concatenate every token in an unique
9277 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
9279 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
9280 && token
[2].type
== JIM_TT_VAR
) {
9281 /* May be able to do fast interpolated object -> dictSubst */
9282 objPtr
->typePtr
= &interpolatedObjType
;
9283 objPtr
->internalRep
.twoPtrValue
.ptr1
= token
;
9284 objPtr
->internalRep
.twoPtrValue
.ptr2
= intv
[2];
9285 Jim_IncrRefCount(intv
[2]);
9288 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
9289 objPtr
->length
= totlen
;
9290 for (i
= 0; i
< tokens
; i
++) {
9291 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
9292 s
+= intv
[i
]->length
;
9293 Jim_DecrRefCount(interp
, intv
[i
]);
9295 objPtr
->bytes
[totlen
] = '\0';
9296 /* Free the intv vector if not static. */
9297 if (tokens
> JIM_EVAL_SINTV_LEN
)
9300 *objPtrPtr
= objPtr
;
9305 Jim_DecrRefCount(interp
, intv
[i
]);
9306 if (tokens
> JIM_EVAL_SINTV_LEN
)
9311 /* Helper of Jim_EvalObj() to perform argument expansion.
9312 * Basically this function append an argument to 'argv'
9313 * (and increments argc by reference accordingly), performing
9314 * expansion of the list object if 'expand' is non-zero, or
9315 * just adding objPtr to argv if 'expand' is zero. */
9316 void Jim_ExpandArgument(Jim_Interp
*interp
, Jim_Obj
***argv
,
9317 int *argcPtr
, int expand
, Jim_Obj
*objPtr
)
9320 (*argv
) = Jim_Realloc(*argv
, sizeof(Jim_Obj
*) * ((*argcPtr
) + 1));
9321 /* refcount of objPtr not incremented because
9322 * we are actually transfering a reference from
9323 * the old 'argv' to the expanded one. */
9324 (*argv
)[*argcPtr
] = objPtr
;
9330 len
= Jim_ListLength(interp
, objPtr
);
9331 (*argv
) = Jim_Realloc(*argv
, sizeof(Jim_Obj
*) * ((*argcPtr
) + len
));
9332 for (i
= 0; i
< len
; i
++) {
9333 (*argv
)[*argcPtr
] = objPtr
->internalRep
.listValue
.ele
[i
];
9334 Jim_IncrRefCount(objPtr
->internalRep
.listValue
.ele
[i
]);
9337 /* The original object reference is no longer needed,
9338 * after the expansion it is no longer present on
9339 * the argument vector, but the single elements are
9341 Jim_DecrRefCount(interp
, objPtr
);
9345 static void JimAddErrorToStack(Jim_Interp
*interp
, int retcode
, const char *filename
, int line
)
9350 /* XXX: Don't create a stack frame for 'return -code error' */
9352 /* Pick up 'return -code error' too */
9353 if (retcode
== JIM_RETURN
) {
9354 rc
= interp
->returnCode
;
9358 printf("JimAddErrorToStack: retcode=%s, %s:%d, ast=%d, errorFlag=%d\n",
9359 Jim_ReturnCode(retcode
), filename
, line
, interp
->addStackTrace
, interp
->errorFlag
);
9362 if (rc
== JIM_ERR
&& !interp
->errorFlag
) {
9363 /* This is the first error, so save the file/line information and reset the stack */
9364 interp
->errorFlag
= 1;
9365 JimSetErrorFileName(interp
, filename
);
9366 JimSetErrorLineNumber(interp
, line
);
9368 JimResetStackTrace(interp
);
9369 /* Always add a level where the error first occurs */
9370 interp
->addStackTrace
++;
9373 /* Now if this is an "interesting" level, add it to the stack trace */
9374 if (rc
== JIM_ERR
&& interp
->addStackTrace
> 0) {
9375 /* Add the stack info for the current level */
9377 JimAppendStackTrace(interp
, Jim_GetString(interp
->errorProc
, NULL
), filename
, line
);
9379 /* Note: if we didn't have a filename for this level,
9380 * don't clear the addStackTrace flag
9381 * so we can pick it up at the next level
9384 interp
->addStackTrace
= 0;
9387 Jim_DecrRefCount(interp
, interp
->errorProc
);
9388 interp
->errorProc
= interp
->emptyObj
;
9389 Jim_IncrRefCount(interp
->errorProc
);
9391 else if (rc
== JIM_RETURN
&& interp
->returnCode
== JIM_ERR
) {
9392 /* Propagate the addStackTrace value through 'return -code error' */
9395 interp
->addStackTrace
= 0;
9399 /* And delete any local procs */
9400 static void JimDeleteLocalProcs(Jim_Interp
*interp
)
9402 if (interp
->localProcs
) {
9405 while ((procname
= Jim_StackPop(interp
->localProcs
)) != NULL
) {
9406 Jim_DeleteCommand(interp
, procname
);
9409 Jim_FreeStack(interp
->localProcs
);
9410 Jim_Free(interp
->localProcs
);
9411 interp
->localProcs
= NULL
;
9415 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
9416 * Otherwise eval with Jim_EvalObj()
9418 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, const char *filename
, int linenr
)
9420 if (!Jim_IsList(listPtr
)) {
9421 return Jim_EvalObj(interp
, listPtr
);
9424 int retcode
= JIM_OK
;
9426 if (listPtr
->internalRep
.listValue
.len
) {
9427 Jim_IncrRefCount(listPtr
);
9428 retcode
= JimEvalObjVector(interp
,
9429 listPtr
->internalRep
.listValue
.len
,
9430 listPtr
->internalRep
.listValue
.ele
, filename
, linenr
);
9431 Jim_DecrRefCount(interp
, listPtr
);
9437 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
9442 ScriptToken
*cmdtoken
= NULL
;
9443 int *cs
; /* command structure array */
9444 int retcode
= JIM_OK
;
9445 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
, *tmpObjPtr
;
9447 interp
->errorFlag
= 0;
9449 /* If the object is of type "list", we can call
9450 * a specialized version of Jim_EvalObj() */
9451 if (Jim_IsList(scriptObjPtr
)) {
9452 return Jim_EvalObjList(interp
, scriptObjPtr
, NULL
, 0);
9455 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
9456 script
= Jim_GetScript(interp
, scriptObjPtr
);
9458 /* Reset the interpreter result. This is useful to
9459 * return the emtpy result in the case of empty program. */
9460 Jim_SetEmptyResult(interp
);
9462 #ifdef JIM_OPTIMIZATION
9463 /* Check for one of the following common scripts used by for, while
9468 if (script
->len
== 0) {
9469 Jim_DecrRefCount(interp
, scriptObjPtr
);
9472 if (script
->len
== 4 && script
->token
[0].type
== JIM_TT_ESC
9473 && script
->token
[2].type
== JIM_TT_ESC
9474 && script
->token
[2].objPtr
->typePtr
== &variableObjType
) {
9475 if (Jim_CompareStringImmediate(interp
, script
->token
[0].objPtr
, "incr")) {
9476 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, script
->token
[2].objPtr
, JIM_NONE
);
9478 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
9479 objPtr
->internalRep
.wideValue
++;
9480 Jim_InvalidateStringRep(objPtr
);
9481 Jim_DecrRefCount(interp
, scriptObjPtr
);
9482 Jim_SetResult(interp
, objPtr
);
9489 /* Now we have to make sure the internal repr will not be
9490 * freed on shimmering.
9492 * Think for example to this:
9494 * set x {llength $x; ... some more code ...}; eval $x
9496 * In order to preserve the internal rep, we increment the
9497 * inUse field of the script internal rep structure. */
9500 token
= script
->token
;
9502 cs
= script
->cmdStruct
;
9503 i
= 0; /* 'i' is the current token index. */
9505 /* Execute every command sequentially, returns on
9506 * error (i.e. if a command does not return JIM_OK) */
9509 int argc
= *cs
++; /* Get the number of arguments */
9512 /* Set the expand flag if needed. */
9517 /* Allocate the arguments vector */
9518 if (argc
<= JIM_EVAL_SARGV_LEN
)
9521 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
9523 /* This is the command token. Remember it in the case of error */
9524 cmdtoken
= &token
[i
];
9526 /* Populate the arguments objects. */
9527 for (j
= 0; j
< argc
; j
++) {
9530 /* tokens is negative if expansion is needed.
9531 * for this argument. */
9533 tokens
= (-tokens
) - 1;
9537 /* Fast path if the token does not
9538 * need interpolation */
9539 switch (token
[i
].type
) {
9542 argv
[j
] = token
[i
].objPtr
;
9545 tmpObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
9550 argv
[j
] = tmpObjPtr
;
9552 case JIM_TT_DICTSUGAR
:
9553 tmpObjPtr
= Jim_ExpandDictSugar(interp
, token
[i
].objPtr
);
9558 argv
[j
] = tmpObjPtr
;
9561 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
9562 if (retcode
!= JIM_OK
) {
9565 argv
[j
] = Jim_GetResult(interp
);
9568 Jim_Panic(interp
, "default token type reached " "in Jim_EvalObj().");
9571 Jim_IncrRefCount(argv
[j
]);
9575 /* For interpolation we call a helper
9576 * function to do the work for us. */
9577 if ((retcode
= Jim_InterpolateTokens(interp
,
9578 token
+ i
, tokens
, &tmpObjPtr
)) != JIM_OK
) {
9581 argv
[j
] = tmpObjPtr
;
9582 Jim_IncrRefCount(argv
[j
]);
9586 /* Handle {expand} expansion */
9588 int *ecs
= cs
- argc
;
9590 Jim_Obj
**eargv
= NULL
;
9592 for (j
= 0; j
< argc
; j
++) {
9593 Jim_ExpandArgument(interp
, &eargv
, &eargc
, ecs
[j
] < 0, argv
[j
]);
9601 /* Nothing to do with zero args. */
9606 /* Lookup the command to call */
9607 cmd
= Jim_GetCommand(interp
, argv
[0], JIM_ERRMSG
);
9609 /* Call it -- Make sure result is an empty object. */
9610 JimIncrCmdRefCount(cmd
);
9611 Jim_SetEmptyResult(interp
);
9613 interp
->cmdPrivData
= cmd
->privData
;
9614 retcode
= cmd
->cmdProc(interp
, argc
, argv
);
9618 JimCallProcedure(interp
, cmd
, script
->fileName
, cmdtoken
->linenr
, argc
, argv
);
9620 JimDecrCmdRefCount(interp
, cmd
);
9623 /* Call [unknown] */
9624 retcode
= JimUnknown(interp
, argc
, argv
, script
->fileName
, cmdtoken
->linenr
);
9626 if (interp
->signal_level
&& interp
->sigmask
) {
9627 /* Check for a signal after each command */
9628 retcode
= JIM_SIGNAL
;
9630 if (retcode
!= JIM_OK
) {
9633 /* Decrement the arguments count */
9634 for (j
= 0; j
< argc
; j
++) {
9635 Jim_DecrRefCount(interp
, argv
[j
]);
9638 if (argv
!= sargv
) {
9643 /* Note that we don't have to decrement inUse, because the
9644 * following code transfers our use of the reference again to
9645 * the script object. */
9646 j
= 0; /* on normal termination, the argv array is already
9647 Jim_DecrRefCount-ed. */
9649 JimAddErrorToStack(interp
, retcode
, script
->fileName
, cmdtoken
? cmdtoken
->linenr
: 0);
9650 Jim_FreeIntRep(interp
, scriptObjPtr
);
9651 scriptObjPtr
->typePtr
= &scriptObjType
;
9652 Jim_SetIntRepPtr(scriptObjPtr
, script
);
9653 Jim_DecrRefCount(interp
, scriptObjPtr
);
9654 for (i
= 0; i
< j
; i
++) {
9655 Jim_DecrRefCount(interp
, argv
[i
]);
9663 /* Call a procedure implemented in Tcl.
9664 * It's possible to speed-up a lot this function, currently
9665 * the callframes are not cached, but allocated and
9666 * destroied every time. What is expecially costly is
9667 * to create/destroy the local vars hash table every time.
9669 * This can be fixed just implementing callframes caching
9670 * in JimCreateCallFrame() and JimFreeCallFrame(). */
9671 int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
, int argc
,
9672 Jim_Obj
*const *argv
)
9675 Jim_CallFrame
*callFramePtr
;
9677 Jim_Obj
*procname
= argv
[0];
9678 Jim_Stack
*prevLocalProcs
;
9681 if (argc
- 1 < cmd
->leftArity
+ cmd
->rightArity
||
9682 (!cmd
->args
&& argc
- 1 > cmd
->leftArity
+ cmd
->rightArity
+ cmd
->optionalArgs
)) {
9683 /* Create a nice error message, consistent with Tcl 8.5 */
9684 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
9685 int arglen
= Jim_ListLength(interp
, cmd
->argListObjPtr
);
9687 for (i
= 0; i
< arglen
; i
++) {
9690 Jim_ListIndex(interp
, cmd
->argListObjPtr
, i
, &argObjPtr
, JIM_NONE
);
9692 Jim_AppendString(interp
, argmsg
, " ", 1);
9694 if (i
< cmd
->leftArity
|| i
>= arglen
- cmd
->rightArity
) {
9695 Jim_AppendObj(interp
, argmsg
, argObjPtr
);
9697 else if (i
== arglen
- cmd
->rightArity
- cmd
->args
) {
9698 Jim_AppendString(interp
, argmsg
, "?argument ...?", -1);
9703 Jim_AppendString(interp
, argmsg
, "?", 1);
9704 Jim_ListIndex(interp
, argObjPtr
, 0, &objPtr
, JIM_NONE
);
9705 Jim_AppendObj(interp
, argmsg
, objPtr
);
9706 Jim_AppendString(interp
, argmsg
, "?", 1);
9709 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procname
, argmsg
);
9710 Jim_FreeNewObj(interp
, argmsg
);
9714 /* Check if there are too nested calls */
9715 if (interp
->numLevels
== interp
->maxNestingDepth
) {
9716 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
9720 /* Create a new callframe */
9721 callFramePtr
= JimCreateCallFrame(interp
);
9722 callFramePtr
->parentCallFrame
= interp
->framePtr
;
9723 callFramePtr
->argv
= argv
;
9724 callFramePtr
->argc
= argc
;
9725 callFramePtr
->procArgsObjPtr
= cmd
->argListObjPtr
;
9726 callFramePtr
->procBodyObjPtr
= cmd
->bodyObjPtr
;
9727 callFramePtr
->staticVars
= cmd
->staticVars
;
9728 callFramePtr
->filename
= filename
;
9729 callFramePtr
->line
= linenr
;
9730 Jim_IncrRefCount(cmd
->argListObjPtr
);
9731 Jim_IncrRefCount(cmd
->bodyObjPtr
);
9732 interp
->framePtr
= callFramePtr
;
9733 interp
->numLevels
++;
9735 /* Simplify arg counting */
9741 /* Assign in this order:
9742 * leftArity required args.
9743 * rightArity required args (but actually do it last for simplicity)
9744 * optionalArgs optional args
9745 * remaining args into 'args' if 'args'
9748 /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */
9750 /* leftArity required args */
9751 for (d
= 0; d
< cmd
->leftArity
; d
++) {
9752 Jim_ListIndex(interp
, cmd
->argListObjPtr
, d
, &argObjPtr
, JIM_NONE
);
9753 Jim_SetVariable(interp
, argObjPtr
, *argv
++);
9757 /* Shorten our idea of the number of supplied args */
9758 argc
-= cmd
->rightArity
;
9760 /* optionalArgs optional args */
9761 for (i
= 0; i
< cmd
->optionalArgs
; i
++) {
9762 Jim_Obj
*nameObjPtr
;
9763 Jim_Obj
*valueObjPtr
;
9765 Jim_ListIndex(interp
, cmd
->argListObjPtr
, d
++, &argObjPtr
, JIM_NONE
);
9767 /* The name is the first element of the list */
9768 Jim_ListIndex(interp
, argObjPtr
, 0, &nameObjPtr
, JIM_NONE
);
9770 valueObjPtr
= *argv
++;
9774 /* No more values, so use default */
9775 /* The value is the second element of the list */
9776 Jim_ListIndex(interp
, argObjPtr
, 1, &valueObjPtr
, JIM_NONE
);
9778 Jim_SetVariable(interp
, nameObjPtr
, valueObjPtr
);
9781 /* Any remaining args go to 'args' */
9783 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
9785 /* Use the 'args' name from the procedure args */
9786 Jim_ListIndex(interp
, cmd
->argListObjPtr
, d
, &argObjPtr
, JIM_NONE
);
9787 Jim_SetVariable(interp
, argObjPtr
, listObjPtr
);
9792 /* rightArity required args */
9793 for (i
= 0; i
< cmd
->rightArity
; i
++) {
9794 Jim_ListIndex(interp
, cmd
->argListObjPtr
, d
++, &argObjPtr
, JIM_NONE
);
9795 Jim_SetVariable(interp
, argObjPtr
, *argv
++);
9798 /* Install a new stack for local procs */
9799 prevLocalProcs
= interp
->localProcs
;
9800 interp
->localProcs
= NULL
;
9803 retcode
= Jim_EvalObj(interp
, cmd
->bodyObjPtr
);
9805 /* Delete any local procs */
9806 JimDeleteLocalProcs(interp
);
9807 interp
->localProcs
= prevLocalProcs
;
9809 /* Destroy the callframe */
9810 interp
->numLevels
--;
9811 interp
->framePtr
= interp
->framePtr
->parentCallFrame
;
9812 if (callFramePtr
->vars
.size
!= JIM_HT_INITIAL_SIZE
) {
9813 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NONE
);
9816 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NOHT
);
9818 /* Handle the JIM_EVAL return code */
9819 while (retcode
== JIM_EVAL
) {
9820 Jim_Obj
*resultScriptObjPtr
= Jim_GetResult(interp
);
9822 Jim_IncrRefCount(resultScriptObjPtr
);
9823 /* Should be a list! */
9824 retcode
= Jim_EvalObjList(interp
, resultScriptObjPtr
, filename
, linenr
);
9825 Jim_DecrRefCount(interp
, resultScriptObjPtr
);
9827 /* Handle the JIM_RETURN return code */
9828 if (retcode
== JIM_RETURN
) {
9829 if (--interp
->returnLevel
<= 0) {
9830 retcode
= interp
->returnCode
;
9831 interp
->returnCode
= JIM_OK
;
9832 interp
->returnLevel
= 0;
9835 else if (retcode
== JIM_ERR
) {
9836 interp
->addStackTrace
++;
9837 Jim_DecrRefCount(interp
, interp
->errorProc
);
9838 interp
->errorProc
= procname
;
9839 Jim_IncrRefCount(interp
->errorProc
);
9844 int Jim_Eval_Named(Jim_Interp
*interp
, const char *script
, const char *filename
, int lineno
)
9847 Jim_Obj
*scriptObjPtr
;
9849 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
9850 Jim_IncrRefCount(scriptObjPtr
);
9854 Jim_Obj
*prevScriptObj
;
9856 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, lineno
);
9858 prevScriptObj
= interp
->currentScriptObj
;
9859 interp
->currentScriptObj
= scriptObjPtr
;
9861 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
9863 interp
->currentScriptObj
= prevScriptObj
;
9866 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
9868 Jim_DecrRefCount(interp
, scriptObjPtr
);
9872 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
9874 return Jim_Eval_Named(interp
, script
, NULL
, 0);
9877 /* Execute script in the scope of the global level */
9878 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
9880 Jim_CallFrame
*savedFramePtr
;
9883 savedFramePtr
= interp
->framePtr
;
9884 interp
->framePtr
= interp
->topFramePtr
;
9885 retval
= Jim_Eval(interp
, script
);
9886 interp
->framePtr
= savedFramePtr
;
9890 int Jim_EvalObjBackground(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
9892 Jim_CallFrame
*savedFramePtr
;
9895 savedFramePtr
= interp
->framePtr
;
9896 interp
->framePtr
= interp
->topFramePtr
;
9897 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
9898 interp
->framePtr
= savedFramePtr
;
9899 /* Try to report the error (if any) via the bgerror proc */
9900 if (retval
!= JIM_OK
) {
9903 objv
[0] = Jim_NewStringObj(interp
, "bgerror", -1);
9904 objv
[1] = Jim_GetResult(interp
);
9905 Jim_IncrRefCount(objv
[0]);
9906 Jim_IncrRefCount(objv
[1]);
9907 if (Jim_GetCommand(interp
, objv
[0], JIM_NONE
) == NULL
|| Jim_EvalObjVector(interp
, 2, objv
) != JIM_OK
) {
9908 /* Report the error to stderr. */
9909 fprintf(stderr
, "Background error:" JIM_NL
);
9910 Jim_PrintErrorMessage(interp
);
9912 Jim_DecrRefCount(interp
, objv
[0]);
9913 Jim_DecrRefCount(interp
, objv
[1]);
9918 #include <sys/stat.h>
9920 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
9924 Jim_Obj
*scriptObjPtr
;
9925 Jim_Obj
*prevScriptObj
;
9926 Jim_Stack
*prevLocalProcs
;
9932 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "r")) == NULL
) {
9933 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
9936 if (sb
.st_size
== 0) {
9941 buf
= Jim_Alloc(sb
.st_size
+ 1);
9942 readlen
= fread(buf
, sb
.st_size
, 1, fp
);
9948 buf
[sb
.st_size
] = 0;
9950 if (!Jim_ScriptIsComplete(buf
, sb
.st_size
, &missing
)) {
9951 Jim_SetResultFormatted(interp
, "missing %s in \"%s\"",
9952 missing
== '{' ? "close-brace" : "\"", filename
);
9957 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, sb
.st_size
);
9958 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, 1);
9959 Jim_IncrRefCount(scriptObjPtr
);
9961 prevScriptObj
= interp
->currentScriptObj
;
9962 interp
->currentScriptObj
= scriptObjPtr
;
9964 /* Install a new stack for local procs */
9965 prevLocalProcs
= interp
->localProcs
;
9966 interp
->localProcs
= NULL
;
9968 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
9970 /* Delete any local procs */
9971 JimDeleteLocalProcs(interp
);
9972 interp
->localProcs
= prevLocalProcs
;
9974 /* Handle the JIM_RETURN return code */
9975 if (retcode
== JIM_RETURN
) {
9976 if (--interp
->returnLevel
<= 0) {
9977 retcode
= interp
->returnCode
;
9978 interp
->returnCode
= JIM_OK
;
9979 interp
->returnLevel
= 0;
9982 if (retcode
== JIM_ERR
) {
9983 /* EvalFile changes context, so add a stack frame here */
9984 interp
->addStackTrace
++;
9987 interp
->currentScriptObj
= prevScriptObj
;
9989 Jim_DecrRefCount(interp
, scriptObjPtr
);
9994 /* -----------------------------------------------------------------------------
9996 * ---------------------------------------------------------------------------*/
9997 static int JimParseSubstStr(struct JimParserCtx
*pc
)
10000 pc
->tline
= pc
->linenr
;
10001 while (*pc
->p
&& *pc
->p
!= '$' && *pc
->p
!= '[') {
10002 if (*pc
->p
== '\\' && pc
->len
> 1) {
10009 pc
->tend
= pc
->p
- 1;
10010 pc
->tt
= JIM_TT_ESC
;
10014 static int JimParseSubst(struct JimParserCtx
*pc
, int flags
)
10018 if (pc
->len
== 0) {
10019 pc
->tstart
= pc
->tend
= pc
->p
;
10020 pc
->tline
= pc
->linenr
;
10021 pc
->tt
= JIM_TT_EOL
;
10027 retval
= JimParseCmd(pc
);
10028 if (flags
& JIM_SUBST_NOCMD
) {
10031 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
10036 if (JimParseVar(pc
) == JIM_ERR
) {
10037 pc
->tstart
= pc
->tend
= pc
->p
++;
10039 pc
->tline
= pc
->linenr
;
10040 pc
->tt
= JIM_TT_STR
;
10043 if (flags
& JIM_SUBST_NOVAR
) {
10045 if (flags
& JIM_SUBST_NOESC
)
10046 pc
->tt
= JIM_TT_STR
;
10048 pc
->tt
= JIM_TT_ESC
;
10049 if (*pc
->tstart
== '{') {
10051 if (*(pc
->tend
+ 1))
10058 retval
= JimParseSubstStr(pc
);
10059 if (flags
& JIM_SUBST_NOESC
)
10060 pc
->tt
= JIM_TT_STR
;
10067 /* The subst object type reuses most of the data structures and functions
10068 * of the script object. Script's data structures are a bit more complex
10069 * for what is needed for [subst]itution tasks, but the reuse helps to
10070 * deal with a single data structure at the cost of some more memory
10071 * usage for substitutions. */
10072 static const Jim_ObjType substObjType
= {
10074 FreeScriptInternalRep
,
10075 DupScriptInternalRep
,
10077 JIM_TYPE_REFERENCES
,
10080 /* This method takes the string representation of an object
10081 * as a Tcl string where to perform [subst]itution, and generates
10082 * the pre-parsed internal representation. */
10083 int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
10086 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
10087 struct JimParserCtx parser
;
10088 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
10089 ParseTokenList tokenlist
;
10091 /* Initially parse the subst into tokens (in tokenlist) */
10092 ScriptTokenListInit(&tokenlist
);
10094 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
10096 JimParseSubst(&parser
, flags
);
10097 if (JimParserEof(&parser
)) {
10098 /* Note that subst doesn't need the EOL token */
10101 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
10105 /* Create the "real" subst/script tokens from the initial token list */
10106 script
->cmdStruct
= NULL
;
10109 script
->substFlags
= flags
;
10110 script
->fileName
= NULL
;
10111 #ifdef JIM_OPTIMIZATION
10112 SubstObjAddTokens(interp
, script
, &tokenlist
);
10114 ScriptObjAddTokens(interp
, script
, &tokenlist
);
10117 /* No longer need the token list */
10118 ScriptTokenListFree(&tokenlist
);
10123 printf("==== Subst ====\n");
10124 for (i
= 0; i
< script
->len
; i
++) {
10125 printf("[%2d] %s (%d)'%s'\n", i
, tt_name(script
->token
[i
].type
),
10126 script
->token
[i
].objPtr
->length
, script
->token
[i
].objPtr
->bytes
);
10130 /* Free the old internal rep and set the new one. */
10131 Jim_FreeIntRep(interp
, objPtr
);
10132 Jim_SetIntRepPtr(objPtr
, script
);
10133 objPtr
->typePtr
= &scriptObjType
;
10137 ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
10139 struct ScriptObj
*script
= Jim_GetIntRepPtr(objPtr
);
10141 if (objPtr
->typePtr
!= &substObjType
|| script
->substFlags
!= flags
)
10142 SetSubstFromAny(interp
, objPtr
, flags
);
10143 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
10146 /* Performs commands,variables,blackslashes substitution,
10147 * storing the result object (with refcount 0) into
10149 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
10152 ScriptToken
*token
;
10153 int i
, len
, retcode
= JIM_OK
;
10155 Jim_Obj
*resObjPtr
, *savedResultObjPtr
;
10157 script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
10158 #ifdef JIM_OPTIMIZATION
10159 /* Fast path for a very common case with array-alike syntax,
10160 * that's: $foo($bar) */
10161 if (script
->len
== 1 && script
->token
[0].type
== JIM_TT_VAR
) {
10162 Jim_Obj
*varObjPtr
= script
->token
[0].objPtr
;
10164 Jim_IncrRefCount(varObjPtr
);
10165 resObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
10166 if (resObjPtr
== NULL
) {
10167 Jim_DecrRefCount(interp
, varObjPtr
);
10170 Jim_DecrRefCount(interp
, varObjPtr
);
10171 *resObjPtrPtr
= resObjPtr
;
10176 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
10177 /* In order to preserve the internal rep, we increment the
10178 * inUse field of the script internal rep structure. */
10181 token
= script
->token
;
10184 /* Save the interp old result, to set it again before
10186 savedResultObjPtr
= interp
->result
;
10187 Jim_IncrRefCount(savedResultObjPtr
);
10189 /* Perform the substitution. Starts with an empty object
10190 * and adds every token (performing the appropriate
10191 * var/command/escape substitution). */
10192 resObjPtr
= Jim_NewStringObj(interp
, "", 0);
10193 for (i
= 0; i
< len
; i
++) {
10196 switch (token
[i
].type
) {
10199 Jim_AppendObj(interp
, resObjPtr
, token
[i
].objPtr
);
10202 case JIM_TT_DICTSUGAR
:
10203 if (token
[i
].type
== JIM_TT_VAR
) {
10204 objPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10207 objPtr
= Jim_ExpandDictSugar(interp
, token
[i
].objPtr
);
10209 if (objPtr
== NULL
)
10211 Jim_IncrRefCount(objPtr
);
10212 Jim_AppendObj(interp
, resObjPtr
, objPtr
);
10213 Jim_DecrRefCount(interp
, objPtr
);
10216 rc
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10217 if (rc
== JIM_BREAK
) {
10218 /* Stop substituting */
10221 else if (rc
== JIM_CONTINUE
) {
10222 /* just skip this one */
10224 else if (rc
== JIM_OK
|| rc
== JIM_RETURN
) {
10225 Jim_AppendObj(interp
, resObjPtr
, interp
->result
);
10233 "default token type (%d) reached " "in Jim_SubstObj().", token
[i
].type
);
10238 if (retcode
== JIM_OK
)
10239 Jim_SetResult(interp
, savedResultObjPtr
);
10240 Jim_DecrRefCount(interp
, savedResultObjPtr
);
10241 /* Note that we don't have to decrement inUse, because the
10242 * following code transfers our use of the reference again to
10243 * the script object. */
10244 Jim_FreeIntRep(interp
, substObjPtr
);
10245 substObjPtr
->typePtr
= &scriptObjType
;
10246 Jim_SetIntRepPtr(substObjPtr
, script
);
10247 Jim_DecrRefCount(interp
, substObjPtr
);
10248 *resObjPtrPtr
= resObjPtr
;
10251 Jim_FreeNewObj(interp
, resObjPtr
);
10256 /* -----------------------------------------------------------------------------
10257 * Core commands utility functions
10258 * ---------------------------------------------------------------------------*/
10259 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
10262 Jim_Obj
*objPtr
= Jim_NewEmptyStringObj(interp
);
10264 Jim_AppendString(interp
, objPtr
, "wrong # args: should be \"", -1);
10265 for (i
= 0; i
< argc
; i
++) {
10266 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
10267 if (!(i
+ 1 == argc
&& msg
[0] == '\0'))
10268 Jim_AppendString(interp
, objPtr
, " ", 1);
10270 Jim_AppendString(interp
, objPtr
, msg
, -1);
10271 Jim_AppendString(interp
, objPtr
, "\"", 1);
10272 Jim_SetResult(interp
, objPtr
);
10275 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int procs_only
)
10277 Jim_HashTableIterator
*htiter
;
10279 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
10280 const char *pattern
;
10281 int patternLen
= 0;
10283 pattern
= patternObjPtr
? Jim_GetString(patternObjPtr
, &patternLen
) : NULL
;
10284 htiter
= Jim_GetHashTableIterator(&interp
->commands
);
10285 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
10286 Jim_Cmd
*cmdPtr
= he
->val
;
10288 if (procs_only
&& cmdPtr
->cmdProc
!= NULL
) {
10291 if (pattern
&& !JimStringMatch(pattern
, patternLen
, he
->key
,
10292 strlen((const char *)he
->key
), 0))
10294 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
10296 Jim_FreeHashTableIterator(htiter
);
10300 /* Keep this in order */
10301 #define JIM_VARLIST_GLOBALS 0
10302 #define JIM_VARLIST_LOCALS 1
10303 #define JIM_VARLIST_VARS 2
10305 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
10307 Jim_HashTableIterator
*htiter
;
10309 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
10310 const char *pattern
;
10311 int patternLen
= 0;
10313 pattern
= patternObjPtr
? Jim_GetString(patternObjPtr
, &patternLen
) : NULL
;
10314 if (mode
== JIM_VARLIST_GLOBALS
) {
10315 htiter
= Jim_GetHashTableIterator(&interp
->topFramePtr
->vars
);
10318 /* For [info locals], if we are at top level an emtpy list
10319 * is returned. I don't agree, but we aim at compatibility (SS) */
10320 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
)
10322 htiter
= Jim_GetHashTableIterator(&interp
->framePtr
->vars
);
10324 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
10325 Jim_Var
*varPtr
= (Jim_Var
*)he
->val
;
10327 if (mode
== JIM_VARLIST_LOCALS
) {
10328 if (varPtr
->linkFramePtr
!= NULL
)
10331 if (pattern
&& !JimStringMatch(pattern
, patternLen
, he
->key
,
10332 strlen((const char *)he
->key
), 0))
10334 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
10336 Jim_FreeHashTableIterator(htiter
);
10340 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
10341 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
10343 Jim_CallFrame
*targetCallFrame
;
10345 if (JimGetCallFrameByInteger(interp
, levelObjPtr
, &targetCallFrame
)
10348 /* No proc call at toplevel callframe */
10349 if (targetCallFrame
== interp
->topFramePtr
) {
10350 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
10353 if (info_level_cmd
) {
10354 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
10357 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
10359 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
10360 Jim_ListAppendElement(interp
, listObj
, Jim_NewStringObj(interp
,
10361 targetCallFrame
->filename
? : "", -1));
10362 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
10363 *objPtrPtr
= listObj
;
10368 /* -----------------------------------------------------------------------------
10370 * ---------------------------------------------------------------------------*/
10372 /* fake [puts] -- not the real puts, just for debugging. */
10373 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10378 if (argc
!= 2 && argc
!= 3) {
10379 Jim_WrongNumArgs(interp
, 1, argv
, "-nonewline string");
10383 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
10384 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
10392 str
= Jim_GetString(argv
[1], 0);
10393 printf("%s%s", str
, nonewline
? "" : "\n");
10397 /* Helper for [+] and [*] */
10398 static int Jim_AddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
10400 jim_wide wideValue
, res
;
10401 double doubleValue
, doubleRes
;
10404 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
10406 for (i
= 1; i
< argc
; i
++) {
10407 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
10409 if (op
== JIM_EXPROP_ADD
)
10414 Jim_SetResultInt(interp
, res
);
10417 doubleRes
= (double)res
;
10418 for (; i
< argc
; i
++) {
10419 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
10421 if (op
== JIM_EXPROP_ADD
)
10422 doubleRes
+= doubleValue
;
10424 doubleRes
*= doubleValue
;
10426 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
10430 /* Helper for [-] and [/] */
10431 static int Jim_SubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
10433 jim_wide wideValue
, res
= 0;
10434 double doubleValue
, doubleRes
= 0;
10438 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
10441 else if (argc
== 2) {
10442 /* The arity = 2 case is different. For [- x] returns -x,
10443 * while [/ x] returns 1/x. */
10444 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
10445 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
10449 if (op
== JIM_EXPROP_SUB
)
10450 doubleRes
= -doubleValue
;
10452 doubleRes
= 1.0 / doubleValue
;
10453 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
10457 if (op
== JIM_EXPROP_SUB
) {
10459 Jim_SetResultInt(interp
, res
);
10462 doubleRes
= 1.0 / wideValue
;
10463 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
10468 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
10469 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
10478 for (i
= 2; i
< argc
; i
++) {
10479 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
10480 doubleRes
= (double)res
;
10483 if (op
== JIM_EXPROP_SUB
)
10488 Jim_SetResultInt(interp
, res
);
10491 for (; i
< argc
; i
++) {
10492 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
10494 if (op
== JIM_EXPROP_SUB
)
10495 doubleRes
-= doubleValue
;
10497 doubleRes
/= doubleValue
;
10499 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
10505 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10507 return Jim_AddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
10511 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10513 return Jim_AddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
10517 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10519 return Jim_SubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
10523 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10525 return Jim_SubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
10529 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10531 if (argc
!= 2 && argc
!= 3) {
10532 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
10538 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
10541 Jim_SetResult(interp
, objPtr
);
10544 /* argc == 3 case. */
10545 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
10547 Jim_SetResult(interp
, argv
[2]);
10553 * unset ?-nocomplain? ?--? ?varName ...?
10555 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10561 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
10565 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
10574 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
10584 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10586 jim_wide wideValue
, increment
= 1;
10587 Jim_Obj
*intObjPtr
;
10589 if (argc
!= 2 && argc
!= 3) {
10590 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10594 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10597 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_NONE
);
10599 /* Set missing variable to 0 */
10602 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10605 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10606 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10607 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10608 Jim_FreeNewObj(interp
, intObjPtr
);
10613 Jim_SetWide(interp
, intObjPtr
, wideValue
+ increment
);
10614 /* The following step is required in order to invalidate the
10615 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10616 if (argv
[1]->typePtr
!= &variableObjType
) {
10617 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10622 Jim_SetResult(interp
, intObjPtr
);
10627 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10630 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
10634 /* The general purpose implementation of while starts here */
10636 int boolean
, retval
;
10638 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
10643 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
10657 Jim_SetEmptyResult(interp
);
10662 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10666 Jim_Obj
*varNamePtr
= NULL
;
10667 Jim_Obj
*stopVarNamePtr
= NULL
;
10670 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
10674 /* Do the initialisation */
10675 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
10679 /* And do the first test now. Better for optimisation
10680 * if we can do next/test at the bottom of the loop
10682 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
10684 /* Ready to do the body as follows:
10686 * body // check retcode
10687 * next // check retcode
10688 * test // check retcode/test bool
10692 #ifdef JIM_OPTIMIZATION
10693 /* Check if the for is on the form:
10694 * for ... {$i < CONST} {incr i}
10695 * for ... {$i < $j} {incr i}
10697 if (retval
== JIM_OK
&& boolean
) {
10698 ScriptObj
*incrScript
;
10699 ExprByteCode
*expr
;
10700 jim_wide stop
, currentVal
;
10701 unsigned jim_wide procEpoch
;
10705 /* Do it only if there aren't shared arguments */
10706 expr
= Jim_GetExpression(interp
, argv
[2]);
10707 incrScript
= Jim_GetScript(interp
, argv
[3]);
10709 /* Ensure proper lengths to start */
10710 if (incrScript
->len
!= 4 || !expr
|| expr
->len
!= 3) {
10713 /* Ensure proper token types. */
10714 if (incrScript
->token
[2].type
!= JIM_TT_ESC
||
10715 expr
->token
[0].type
!= JIM_TT_VAR
||
10716 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
10720 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
10723 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
10730 /* Update command must be incr */
10731 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[0].objPtr
, "incr")) {
10735 /* incr, expression must be about the same variable */
10736 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
, 0)) {
10740 /* Get the stop condition (must be a variable or integer) */
10741 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
10742 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
10747 stopVarNamePtr
= expr
->token
[1].objPtr
;
10748 Jim_IncrRefCount(stopVarNamePtr
);
10749 /* Keep the compiler happy */
10753 /* Initialization */
10754 procEpoch
= interp
->procEpoch
;
10755 varNamePtr
= expr
->token
[0].objPtr
;
10756 Jim_IncrRefCount(varNamePtr
);
10758 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
10759 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
10763 /* --- OPTIMIZED FOR --- */
10764 while (retval
== JIM_OK
) {
10765 /* === Check condition === */
10766 /* Note that currentVal is already set here */
10768 /* Immediate or Variable? get the 'stop' value if the latter. */
10769 if (stopVarNamePtr
) {
10770 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
10771 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
10776 if (currentVal
>= stop
+ cmpOffset
) {
10781 retval
= Jim_EvalObj(interp
, argv
[4]);
10782 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
10784 /* If there was a change in procedures/command continue
10785 * with the usual [for] command implementation */
10786 if (procEpoch
!= interp
->procEpoch
) {
10790 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
10793 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10794 currentVal
= ++objPtr
->internalRep
.wideValue
;
10795 Jim_InvalidateStringRep(objPtr
);
10798 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
10799 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
10800 ++currentVal
)) != JIM_OK
) {
10811 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
10813 retval
= Jim_EvalObj(interp
, argv
[4]);
10815 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
10818 retval
= Jim_EvalObj(interp
, argv
[3]);
10819 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
10822 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
10827 if (stopVarNamePtr
) {
10828 Jim_DecrRefCount(interp
, stopVarNamePtr
);
10831 Jim_DecrRefCount(interp
, varNamePtr
);
10834 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
10835 Jim_SetEmptyResult(interp
);
10842 /* foreach + lmap implementation. */
10843 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
10845 int result
= JIM_ERR
, i
, nbrOfLists
, *listsIdx
, *listsEnd
;
10846 int nbrOfLoops
= 0;
10847 Jim_Obj
*emptyStr
, *script
, *mapRes
= NULL
;
10849 if (argc
< 4 || argc
% 2 != 0) {
10850 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
10854 mapRes
= Jim_NewListObj(interp
, NULL
, 0);
10855 Jim_IncrRefCount(mapRes
);
10857 emptyStr
= Jim_NewEmptyStringObj(interp
);
10858 Jim_IncrRefCount(emptyStr
);
10859 script
= argv
[argc
- 1]; /* Last argument is a script */
10860 nbrOfLists
= (argc
- 1 - 1) / 2; /* argc - 'foreach' - script */
10861 listsIdx
= (int *)Jim_Alloc(nbrOfLists
* sizeof(int));
10862 listsEnd
= (int *)Jim_Alloc(nbrOfLists
* 2 * sizeof(int));
10863 /* Initialize iterators and remember max nbr elements each list */
10864 memset(listsIdx
, 0, nbrOfLists
* sizeof(int));
10865 /* Remember lengths of all lists and calculate how much rounds to loop */
10866 for (i
= 0; i
< nbrOfLists
* 2; i
+= 2) {
10870 listsEnd
[i
] = Jim_ListLength(interp
, argv
[i
+ 1]);
10871 listsEnd
[i
+ 1] = Jim_ListLength(interp
, argv
[i
+ 2]);
10872 if (listsEnd
[i
] == 0) {
10873 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
10876 cnt
= div(listsEnd
[i
+ 1], listsEnd
[i
]);
10877 count
= cnt
.quot
+ (cnt
.rem
? 1 : 0);
10878 if (count
> nbrOfLoops
)
10879 nbrOfLoops
= count
;
10881 for (; nbrOfLoops
-- > 0;) {
10882 for (i
= 0; i
< nbrOfLists
; ++i
) {
10883 int varIdx
= 0, var
= i
* 2;
10885 while (varIdx
< listsEnd
[var
]) {
10886 Jim_Obj
*varName
, *ele
;
10887 int lst
= i
* 2 + 1;
10889 if (Jim_ListIndex(interp
, argv
[var
+ 1], varIdx
, &varName
, JIM_ERRMSG
)
10892 if (listsIdx
[i
] < listsEnd
[lst
]) {
10893 if (Jim_ListIndex(interp
, argv
[lst
+ 1], listsIdx
[i
], &ele
, JIM_ERRMSG
)
10896 /* Avoid shimmering */
10897 Jim_IncrRefCount(ele
);
10898 result
= Jim_SetVariable(interp
, varName
, ele
);
10899 Jim_DecrRefCount(interp
, ele
);
10900 if (result
== JIM_OK
) {
10901 ++listsIdx
[i
]; /* Remember next iterator of current list */
10902 ++varIdx
; /* Next variable */
10906 else if (Jim_SetVariable(interp
, varName
, emptyStr
) == JIM_OK
) {
10907 ++varIdx
; /* Next variable */
10913 switch (result
= Jim_EvalObj(interp
, script
)) {
10916 Jim_ListAppendElement(interp
, mapRes
, interp
->result
);
10930 Jim_SetResult(interp
, mapRes
);
10932 Jim_SetEmptyResult(interp
);
10935 Jim_DecrRefCount(interp
, mapRes
);
10936 Jim_DecrRefCount(interp
, emptyStr
);
10937 Jim_Free(listsIdx
);
10938 Jim_Free(listsEnd
);
10943 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10945 return JimForeachMapHelper(interp
, argc
, argv
, 0);
10949 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10951 return JimForeachMapHelper(interp
, argc
, argv
, 1);
10955 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10957 int boolean
, retval
, current
= 1, falsebody
= 0;
10961 /* Far not enough arguments given! */
10962 if (current
>= argc
)
10964 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
10967 /* There lacks something, isn't it? */
10968 if (current
>= argc
)
10970 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
10972 /* Tsk tsk, no then-clause? */
10973 if (current
>= argc
)
10976 return Jim_EvalObj(interp
, argv
[current
]);
10977 /* Ok: no else-clause follows */
10978 if (++current
>= argc
) {
10979 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
10982 falsebody
= current
++;
10983 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
10984 /* IIICKS - else-clause isn't last cmd? */
10985 if (current
!= argc
- 1)
10987 return Jim_EvalObj(interp
, argv
[current
]);
10989 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
10990 /* Ok: elseif follows meaning all the stuff
10991 * again (how boring...) */
10993 /* OOPS - else-clause is not last cmd? */
10994 else if (falsebody
!= argc
- 1)
10996 return Jim_EvalObj(interp
, argv
[falsebody
]);
11001 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11006 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11007 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
11008 Jim_Obj
*stringObj
, int nocase
)
11015 parms
[argc
++] = commandObj
;
11017 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
11019 parms
[argc
++] = patternObj
;
11020 parms
[argc
++] = stringObj
;
11022 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
11024 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
11032 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
11035 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11037 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
11038 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
11039 Jim_Obj
*script
= 0;
11043 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
11044 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
11047 for (opt
= 1; opt
< argc
; ++opt
) {
11048 const char *option
= Jim_GetString(argv
[opt
], 0);
11050 if (*option
!= '-')
11052 else if (strncmp(option
, "--", 2) == 0) {
11056 else if (strncmp(option
, "-exact", 2) == 0)
11057 matchOpt
= SWITCH_EXACT
;
11058 else if (strncmp(option
, "-glob", 2) == 0)
11059 matchOpt
= SWITCH_GLOB
;
11060 else if (strncmp(option
, "-regexp", 2) == 0)
11061 matchOpt
= SWITCH_RE
;
11062 else if (strncmp(option
, "-command", 2) == 0) {
11063 matchOpt
= SWITCH_CMD
;
11064 if ((argc
- opt
) < 2)
11066 command
= argv
[++opt
];
11069 Jim_SetResultFormatted(interp
,
11070 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
11074 if ((argc
- opt
) < 2)
11077 strObj
= argv
[opt
++];
11078 patCount
= argc
- opt
;
11079 if (patCount
== 1) {
11082 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
11086 caseList
= &argv
[opt
];
11087 if (patCount
== 0 || patCount
% 2 != 0)
11089 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
11090 Jim_Obj
*patObj
= caseList
[i
];
11092 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
11093 || i
< (patCount
- 2)) {
11094 switch (matchOpt
) {
11096 if (Jim_StringEqObj(strObj
, patObj
, 0))
11097 script
= caseList
[i
+ 1];
11100 if (Jim_StringMatchObj(patObj
, strObj
, 0))
11101 script
= caseList
[i
+ 1];
11104 command
= Jim_NewStringObj(interp
, "regexp", -1);
11105 /* Fall thru intentionally */
11107 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
11109 /* After the execution of a command we need to
11110 * make sure to reconvert the object into a list
11111 * again. Only for the single-list style [switch]. */
11112 if (argc
- opt
== 1) {
11115 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
11118 /* command is here already decref'd */
11123 script
= caseList
[i
+ 1];
11129 script
= caseList
[i
+ 1];
11132 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
11133 script
= caseList
[i
+ 1];
11134 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
11135 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
11138 Jim_SetEmptyResult(interp
);
11140 return Jim_EvalObj(interp
, script
);
11146 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11148 Jim_Obj
*listObjPtr
;
11150 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
11151 Jim_SetResult(interp
, listObjPtr
);
11156 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11158 Jim_Obj
*objPtr
, *listObjPtr
;
11163 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?...?");
11167 Jim_IncrRefCount(objPtr
);
11168 for (i
= 2; i
< argc
; i
++) {
11169 listObjPtr
= objPtr
;
11170 if (Jim_GetIndex(interp
, argv
[i
], &index
) != JIM_OK
) {
11171 Jim_DecrRefCount(interp
, listObjPtr
);
11174 if (Jim_ListIndex(interp
, listObjPtr
, index
, &objPtr
, JIM_NONE
) != JIM_OK
) {
11175 /* Returns an empty object if the index
11176 * is out of range. */
11177 Jim_DecrRefCount(interp
, listObjPtr
);
11178 Jim_SetEmptyResult(interp
);
11181 Jim_IncrRefCount(objPtr
);
11182 Jim_DecrRefCount(interp
, listObjPtr
);
11184 Jim_SetResult(interp
, objPtr
);
11185 Jim_DecrRefCount(interp
, objPtr
);
11190 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11193 Jim_WrongNumArgs(interp
, 1, argv
, "list");
11196 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
11201 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11203 static const char *options
[] = {
11204 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
11208 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
11213 int opt_nocase
= 0;
11215 int opt_inline
= 0;
11216 int opt_match
= OPT_EXACT
;
11219 Jim_Obj
*listObjPtr
= NULL
;
11220 Jim_Obj
*commandObj
= NULL
;
11224 Jim_WrongNumArgs(interp
, 1, argv
,
11225 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
11229 for (i
= 1; i
< argc
- 2; i
++) {
11232 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
11254 if (i
>= argc
- 2) {
11257 commandObj
= argv
[++i
];
11262 opt_match
= option
;
11270 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11272 if (opt_match
== OPT_REGEXP
) {
11273 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
11276 Jim_IncrRefCount(commandObj
);
11279 listlen
= Jim_ListLength(interp
, argv
[0]);
11280 for (i
= 0; i
< listlen
; i
++) {
11284 Jim_ListIndex(interp
, argv
[0], i
, &objPtr
, JIM_NONE
);
11285 switch (opt_match
) {
11287 eq
= Jim_StringEqObj(objPtr
, argv
[1], opt_nocase
);
11291 eq
= Jim_StringMatchObj(argv
[1], objPtr
, opt_nocase
);
11296 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
11299 Jim_FreeNewObj(interp
, listObjPtr
);
11307 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
11308 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
11312 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
11313 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
11314 Jim_Obj
*resultObj
;
11317 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
11319 else if (!opt_inline
) {
11320 resultObj
= Jim_NewIntObj(interp
, i
);
11323 resultObj
= objPtr
;
11327 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
11330 Jim_SetResult(interp
, resultObj
);
11337 Jim_SetResult(interp
, listObjPtr
);
11342 Jim_SetResultBool(interp
, opt_not
);
11344 else if (!opt_inline
) {
11345 Jim_SetResultInt(interp
, -1);
11351 Jim_DecrRefCount(interp
, commandObj
);
11357 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11359 Jim_Obj
*listObjPtr
;
11363 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
11366 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_NONE
);
11368 /* Create the list if it does not exists */
11369 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11370 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
11371 Jim_FreeNewObj(interp
, listObjPtr
);
11375 shared
= Jim_IsShared(listObjPtr
);
11377 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
11378 for (i
= 2; i
< argc
; i
++)
11379 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
11380 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
11382 Jim_FreeNewObj(interp
, listObjPtr
);
11385 Jim_SetResult(interp
, listObjPtr
);
11390 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11396 Jim_WrongNumArgs(interp
, 1, argv
, "list index element " "?element ...?");
11400 if (Jim_IsShared(listPtr
))
11401 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
11402 if (Jim_GetIndex(interp
, argv
[2], &index
) != JIM_OK
)
11404 len
= Jim_ListLength(interp
, listPtr
);
11407 else if (index
< 0)
11408 index
= len
+ index
+ 1;
11409 Jim_ListInsertElements(interp
, listPtr
, index
, argc
- 3, &argv
[3]);
11410 Jim_SetResult(interp
, listPtr
);
11413 if (listPtr
!= argv
[1]) {
11414 Jim_FreeNewObj(interp
, listPtr
);
11420 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11422 int first
, last
, len
, rangeLen
;
11424 Jim_Obj
*newListObj
;
11429 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element element ...?");
11432 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
11433 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
11438 len
= Jim_ListLength(interp
, listObj
);
11440 first
= JimRelToAbsIndex(len
, first
);
11441 last
= JimRelToAbsIndex(len
, last
);
11442 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
11444 /* Now construct a new list which consists of:
11445 * <elements before first> <supplied elements> <elements after last>
11448 /* Check to see if trying to replace past the end of the list */
11450 /* OK. Not past the end */
11452 else if (len
== 0) {
11453 /* Special for empty list, adjust first to 0 */
11457 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
11458 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
11462 newListObj
= Jim_NewListObj(interp
, NULL
, 0);
11464 shared
= Jim_IsShared(listObj
);
11466 listObj
= Jim_DuplicateObj(interp
, listObj
);
11469 /* Add the first set of elements */
11470 for (i
= 0; i
< first
; i
++) {
11471 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
11474 /* Add supplied elements */
11475 for (i
= 4; i
< argc
; i
++) {
11476 Jim_ListAppendElement(interp
, newListObj
, argv
[i
]);
11479 /* Add the remaining elements */
11480 for (i
= first
+ rangeLen
; i
< len
; i
++) {
11481 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
11483 Jim_SetResult(interp
, newListObj
);
11485 Jim_FreeNewObj(interp
, listObj
);
11491 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11494 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
11497 else if (argc
== 3) {
11498 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11500 Jim_SetResult(interp
, argv
[2]);
11503 if (Jim_SetListIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1])
11510 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
11512 const char *options
[] = {
11513 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", NULL
11516 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
};
11518 int i
, lsortType
= JIM_LSORT_ASCII
; /* default sort type */
11519 int lsort_order
= 1;
11520 Jim_Obj
*lsort_command
= NULL
;
11525 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
11528 for (i
= 1; i
< (argc
- 1); i
++) {
11531 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
)
11536 lsortType
= JIM_LSORT_ASCII
;
11539 lsortType
= JIM_LSORT_NOCASE
;
11542 lsortType
= JIM_LSORT_INTEGER
;
11544 case OPT_INCREASING
:
11547 case OPT_DECREASING
:
11551 if (i
>= (argc
- 2)) {
11554 lsortType
= JIM_LSORT_COMMAND
;
11555 lsort_command
= argv
[i
+ 1];
11560 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
11561 retCode
= ListSortElements(interp
, resObj
, lsortType
, lsort_order
, lsort_command
);
11562 if (retCode
== JIM_OK
) {
11563 Jim_SetResult(interp
, resObj
);
11566 Jim_FreeNewObj(interp
, resObj
);
11572 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11574 Jim_Obj
*stringObjPtr
;
11578 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
11582 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11587 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_NONE
);
11588 if (!stringObjPtr
) {
11589 /* Create the string if it does not exists */
11590 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
11591 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
)
11593 Jim_FreeNewObj(interp
, stringObjPtr
);
11598 shared
= Jim_IsShared(stringObjPtr
);
11600 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
11601 for (i
= 2; i
< argc
; i
++)
11602 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
11603 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
11605 Jim_FreeNewObj(interp
, stringObjPtr
);
11608 Jim_SetResult(interp
, stringObjPtr
);
11613 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11615 const char *options
[] = {
11616 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
11622 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
11623 OPT_EXPRLEN
, OPT_EXPRBC
11628 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
11631 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
11633 if (option
== OPT_REFCOUNT
) {
11635 Jim_WrongNumArgs(interp
, 2, argv
, "object");
11638 Jim_SetResultInt(interp
, argv
[2]->refCount
);
11641 else if (option
== OPT_OBJCOUNT
) {
11642 int freeobj
= 0, liveobj
= 0;
11643 /* REVISIT: Move off stack */
11648 Jim_WrongNumArgs(interp
, 2, argv
, "");
11651 /* Count the number of free objects. */
11652 objPtr
= interp
->freeList
;
11655 objPtr
= objPtr
->nextObjPtr
;
11657 /* Count the number of live objects. */
11658 objPtr
= interp
->liveList
;
11661 objPtr
= objPtr
->nextObjPtr
;
11663 /* Set the result string and return. */
11664 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
11665 Jim_SetResultString(interp
, buf
, -1);
11668 else if (option
== OPT_OBJECTS
) {
11669 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
11671 /* Count the number of live objects. */
11672 objPtr
= interp
->liveList
;
11673 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11675 /* REVISIT: Move off stack */
11677 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
11679 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11680 sprintf(buf
, "%p", objPtr
);
11681 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
11682 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
11683 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
11684 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
11685 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
11686 objPtr
= objPtr
->nextObjPtr
;
11688 Jim_SetResult(interp
, listObjPtr
);
11691 else if (option
== OPT_INVSTR
) {
11695 Jim_WrongNumArgs(interp
, 2, argv
, "object");
11699 if (objPtr
->typePtr
!= NULL
)
11700 Jim_InvalidateStringRep(objPtr
);
11701 Jim_SetEmptyResult(interp
);
11704 else if (option
== OPT_SCRIPTLEN
) {
11708 Jim_WrongNumArgs(interp
, 2, argv
, "script");
11711 script
= Jim_GetScript(interp
, argv
[2]);
11712 Jim_SetResultInt(interp
, script
->len
);
11715 else if (option
== OPT_EXPRLEN
) {
11716 ExprByteCode
*expr
;
11719 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
11722 expr
= Jim_GetExpression(interp
, argv
[2]);
11725 Jim_SetResultInt(interp
, expr
->len
);
11728 else if (option
== OPT_EXPRBC
) {
11730 ExprByteCode
*expr
;
11734 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
11737 expr
= Jim_GetExpression(interp
, argv
[2]);
11740 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
11741 for (i
= 0; i
< expr
->len
; i
++) {
11743 const Jim_ExprOperator
*op
;
11744 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
11746 switch (expr
->token
[i
].type
) {
11747 case JIM_TT_EXPR_INT
:
11750 case JIM_TT_EXPR_DOUBLE
:
11759 case JIM_TT_DICTSUGAR
:
11760 type
= "dictsugar";
11769 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
11776 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
11779 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
11780 Jim_ListAppendElement(interp
, objPtr
, obj
);
11782 Jim_SetResult(interp
, objPtr
);
11786 Jim_SetResultString(interp
,
11787 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
11790 return JIM_OK
; /* unreached */
11794 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11797 Jim_Stack
*prevLocalProcs
;
11800 Jim_WrongNumArgs(interp
, 1, argv
, "script ?...?");
11804 /* Install a new stack for local procs */
11805 prevLocalProcs
= interp
->localProcs
;
11806 interp
->localProcs
= NULL
;
11809 rc
= Jim_EvalObj(interp
, argv
[1]);
11812 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
11815 /* Delete any local procs */
11816 JimDeleteLocalProcs(interp
);
11817 interp
->localProcs
= prevLocalProcs
;
11819 if (rc
== JIM_ERR
) {
11820 /* eval is "interesting", so add a stack frame here */
11821 interp
->addStackTrace
++;
11827 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11830 int retcode
, newLevel
, oldLevel
;
11831 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
11835 /* Save the old callframe pointer */
11836 savedCallFrame
= interp
->framePtr
;
11838 /* Lookup the target frame pointer */
11839 str
= Jim_GetString(argv
[1], NULL
);
11840 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
11841 if (Jim_GetCallFrameByLevel(interp
, argv
[1], &targetCallFrame
, &newLevel
) != JIM_OK
)
11847 if (Jim_GetCallFrameByLevel(interp
, NULL
, &targetCallFrame
, &newLevel
) != JIM_OK
)
11852 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
11855 /* Eval the code in the target callframe. */
11856 interp
->framePtr
= targetCallFrame
;
11857 oldLevel
= interp
->numLevels
;
11858 interp
->numLevels
= newLevel
;
11860 retcode
= Jim_EvalObj(interp
, argv
[1]);
11863 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
11864 Jim_IncrRefCount(objPtr
);
11865 retcode
= Jim_EvalObj(interp
, objPtr
);
11866 Jim_DecrRefCount(interp
, objPtr
);
11868 interp
->numLevels
= oldLevel
;
11869 interp
->framePtr
= savedCallFrame
;
11873 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
11879 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11881 Jim_Obj
*exprResultPtr
;
11885 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
11887 else if (argc
> 2) {
11890 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
11891 Jim_IncrRefCount(objPtr
);
11892 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
11893 Jim_DecrRefCount(interp
, objPtr
);
11896 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
11899 if (retcode
!= JIM_OK
)
11901 Jim_SetResult(interp
, exprResultPtr
);
11902 Jim_DecrRefCount(interp
, exprResultPtr
);
11907 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11910 Jim_WrongNumArgs(interp
, 1, argv
, "");
11917 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11920 Jim_WrongNumArgs(interp
, 1, argv
, "");
11923 return JIM_CONTINUE
;
11927 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11930 Jim_Obj
*stackTraceObj
= NULL
;
11931 Jim_Obj
*errorCodeObj
= NULL
;
11932 int returnCode
= JIM_OK
;
11935 for (i
= 1; i
< argc
- 1; i
+= 2) {
11936 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
11937 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
11941 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
11942 stackTraceObj
= argv
[i
+ 1];
11944 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
11945 errorCodeObj
= argv
[i
+ 1];
11947 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
11948 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
11949 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
11958 if (i
!= argc
- 1 && i
!= argc
) {
11959 Jim_WrongNumArgs(interp
, 1, argv
,
11960 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
11963 /* If a stack trace is supplied and code is error, set the stack trace */
11964 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
11965 JimSetStackTrace(interp
, stackTraceObj
);
11967 /* If an error code list is supplied, set the global $errorCode */
11968 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
11969 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
11971 interp
->returnCode
= returnCode
;
11972 interp
->returnLevel
= level
;
11974 if (i
== argc
- 1) {
11975 Jim_SetResult(interp
, argv
[i
]);
11981 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11985 objPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
11986 Jim_SetResult(interp
, objPtr
);
11991 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11994 int leftArity
, rightArity
;
11996 int optionalArgs
= 0;
11999 if (argc
!= 4 && argc
!= 5) {
12000 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
12003 argListLen
= Jim_ListLength(interp
, argv
[2]);
12007 /* Examine the argument list for default parameters and 'args' */
12008 for (i
= 0; i
< argListLen
; i
++) {
12012 Jim_ListIndex(interp
, argv
[2], i
, &argPtr
, JIM_NONE
);
12013 if (Jim_CompareStringImmediate(interp
, argPtr
, "args")) {
12015 Jim_SetResultString(interp
, "procedure has 'args' specified more than once", -1);
12019 Jim_SetResultString(interp
, "procedure has 'args' in invalid position", -1);
12026 /* Does this parameter have a default? */
12027 Jim_GetString(argPtr
, NULL
);
12028 len
= Jim_ListLength(interp
, argPtr
);
12030 Jim_SetResultString(interp
, "procedure has argument with no name", -1);
12034 Jim_SetResultString(interp
, "procedure has argument with too many fields", -1);
12038 /* A required arg. Is it part of leftArity or rightArity? */
12039 if (optionalArgs
|| args
) {
12047 /* Optional arg. Can't be after rightArity */
12048 if (rightArity
|| args
) {
12049 Jim_SetResultString(interp
, "procedure has optional arg in invalid position", -1);
12057 return Jim_CreateProcedure(interp
, Jim_GetString(argv
[1], NULL
),
12058 argv
[2], NULL
, argv
[3], leftArity
, optionalArgs
, args
, rightArity
);
12061 return Jim_CreateProcedure(interp
, Jim_GetString(argv
[1], NULL
),
12062 argv
[2], argv
[3], argv
[4], leftArity
, optionalArgs
, args
, rightArity
);
12067 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12069 /* Evaluate the arguments */
12070 int retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
12072 /* If OK, and the result is a proc, add it to the list of local procs */
12073 if (retcode
== 0) {
12074 const char *procname
= Jim_GetString(Jim_GetResult(interp
), NULL
);
12076 if (Jim_FindHashEntry(&interp
->commands
, procname
) == NULL
) {
12077 Jim_SetResultFormatted(interp
, "not a proc: \"%s\"", procname
);
12080 if (interp
->localProcs
== NULL
) {
12081 interp
->localProcs
= Jim_Alloc(sizeof(*interp
->localProcs
));
12082 Jim_InitStack(interp
->localProcs
);
12084 Jim_StackPush(interp
->localProcs
, Jim_StrDup(procname
));
12092 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12094 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12099 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12102 Jim_CallFrame
*targetCallFrame
;
12104 /* Lookup the target frame pointer */
12105 if (argc
> 3 && (argc
% 2 == 0)) {
12106 if (Jim_GetCallFrameByLevel(interp
, argv
[1], &targetCallFrame
, NULL
) != JIM_OK
) {
12112 else if (Jim_GetCallFrameByLevel(interp
, NULL
, &targetCallFrame
, NULL
) != JIM_OK
) {
12116 /* Check for arity */
12118 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
12122 /* Now... for every other/local couple: */
12123 for (i
= 1; i
< argc
; i
+= 2) {
12124 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
12131 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12136 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
12139 /* Link every var to the toplevel having the same name */
12140 if (interp
->numLevels
== 0)
12141 return JIM_OK
; /* global at toplevel... */
12142 for (i
= 1; i
< argc
; i
++) {
12143 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
12149 /* does the [string map] operation. On error NULL is returned,
12150 * otherwise a new string object with the result, having refcount = 0,
12152 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
12153 Jim_Obj
*objPtr
, int nocase
)
12156 const char **key
, *str
, *noMatchStart
= NULL
;
12158 int *keyLen
, strLen
, i
;
12159 Jim_Obj
*resultObjPtr
;
12161 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
12163 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
12166 /* Initialization */
12168 key
= Jim_Alloc(sizeof(char *) * numMaps
);
12169 keyLen
= Jim_Alloc(sizeof(int) * numMaps
);
12170 value
= Jim_Alloc(sizeof(Jim_Obj
*) * numMaps
);
12171 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
12172 for (i
= 0; i
< numMaps
; i
++) {
12173 Jim_Obj
*eleObjPtr
= 0;
12175 Jim_ListIndex(interp
, mapListObjPtr
, i
* 2, &eleObjPtr
, JIM_NONE
);
12176 key
[i
] = Jim_GetString(eleObjPtr
, &keyLen
[i
]);
12177 Jim_ListIndex(interp
, mapListObjPtr
, i
* 2 + 1, &eleObjPtr
, JIM_NONE
);
12178 value
[i
] = eleObjPtr
;
12180 str
= Jim_GetString(objPtr
, &strLen
);
12183 for (i
= 0; i
< numMaps
; i
++) {
12184 if (strLen
>= keyLen
[i
] && keyLen
[i
]) {
12185 if (!JimStringCompare(str
, keyLen
[i
], key
[i
], keyLen
[i
], nocase
)) {
12186 if (noMatchStart
) {
12187 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
12188 noMatchStart
= NULL
;
12190 Jim_AppendObj(interp
, resultObjPtr
, value
[i
]);
12192 strLen
-= keyLen
[i
];
12197 if (i
== numMaps
) { /* no match */
12198 if (noMatchStart
== NULL
)
12199 noMatchStart
= str
;
12204 if (noMatchStart
) {
12205 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
12207 Jim_Free((void *)key
);
12210 return resultObjPtr
;
12214 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12219 static const char *options
[] = {
12220 "length", "compare", "match", "equal", "is", "range", "map",
12221 "repeat", "reverse", "index", "first", "last",
12222 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
12226 OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_RANGE
, OPT_MAP
,
12227 OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
,
12228 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
12230 static const char *nocase_options
[] = {
12235 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
12238 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
12239 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
12245 Jim_WrongNumArgs(interp
, 2, argv
, "string");
12248 Jim_GetString(argv
[2], &len
);
12249 Jim_SetResultInt(interp
, len
);
12256 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
12257 JIM_ENUM_ABBREV
) != JIM_OK
)) {
12258 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? string1 string2");
12261 if (opt_case
== 0) {
12264 if (option
== OPT_COMPARE
) {
12265 Jim_SetResultInt(interp
, Jim_StringCompareObj(argv
[2], argv
[3], !opt_case
));
12268 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[2], argv
[3], !opt_case
));
12275 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
12276 JIM_ENUM_ABBREV
) != JIM_OK
)) {
12277 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
12280 if (opt_case
== 0) {
12283 Jim_SetResultBool(interp
, Jim_StringMatchObj(argv
[2], argv
[3], !opt_case
));
12291 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
12292 JIM_ENUM_ABBREV
) != JIM_OK
)) {
12293 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
12297 if (opt_case
== 0) {
12300 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
12301 if (objPtr
== NULL
) {
12304 Jim_SetResult(interp
, objPtr
);
12312 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
12315 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
12316 if (objPtr
== NULL
) {
12319 Jim_SetResult(interp
, objPtr
);
12328 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
12331 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
12334 objPtr
= Jim_NewStringObj(interp
, "", 0);
12337 Jim_AppendObj(interp
, objPtr
, argv
[2]);
12340 Jim_SetResult(interp
, objPtr
);
12350 Jim_WrongNumArgs(interp
, 2, argv
, "string");
12353 str
= Jim_GetString(argv
[2], &len
);
12354 buf
= Jim_Alloc(len
+ 1);
12355 for (i
= 0; i
< len
; i
++) {
12356 buf
[i
] = str
[len
- i
- 1];
12359 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
12368 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
12371 if (Jim_GetIndex(interp
, argv
[3], &index
) != JIM_OK
) {
12374 str
= Jim_GetString(argv
[2], &len
);
12375 if (index
!= INT_MIN
&& index
!= INT_MAX
) {
12376 index
= JimRelToAbsIndex(len
, index
);
12378 if (index
< 0 || index
>= len
) {
12379 Jim_SetResultString(interp
, "", 0);
12382 Jim_SetResultString(interp
, str
+ index
, 1);
12389 int index
= 0, l1
, l2
;
12390 const char *s1
, *s2
;
12392 if (argc
!= 4 && argc
!= 5) {
12393 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
12396 s1
= Jim_GetString(argv
[2], &l1
);
12397 s2
= Jim_GetString(argv
[3], &l2
);
12399 if (Jim_GetIndex(interp
, argv
[4], &index
) != JIM_OK
) {
12402 index
= JimRelToAbsIndex(l2
, index
);
12404 else if (option
== OPT_LAST
) {
12407 if (option
== OPT_FIRST
) {
12408 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, index
));
12411 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, index
));
12418 case OPT_TRIMRIGHT
:{
12419 Jim_Obj
*trimchars
;
12421 if (argc
!= 3 && argc
!= 4) {
12422 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
12425 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
12426 if (option
== OPT_TRIM
) {
12427 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
12429 else if (option
== OPT_TRIMLEFT
) {
12430 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
12432 else if (option
== OPT_TRIMRIGHT
) {
12433 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
12441 Jim_WrongNumArgs(interp
, 2, argv
, "string");
12444 if (option
== OPT_TOLOWER
) {
12445 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
12448 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
12453 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
12454 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
12456 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
12463 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12466 jim_wide start
, elapsed
;
12468 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
12471 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
12475 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
12481 start
= JimClock();
12485 retval
= Jim_EvalObj(interp
, argv
[1]);
12486 if (retval
!= JIM_OK
) {
12490 elapsed
= JimClock() - start
;
12491 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
12492 Jim_SetResultString(interp
, buf
, -1);
12497 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12502 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
12506 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
12509 interp
->exitCode
= exitCode
;
12514 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12520 /* Which return codes are caught? These are the defaults */
12522 (1 << JIM_OK
| 1 << JIM_ERR
| 1 << JIM_BREAK
| 1 << JIM_CONTINUE
| 1 << JIM_RETURN
);
12524 /* Reset the error code before catch.
12525 * Note that this is not strictly correct.
12527 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
12529 for (i
= 1; i
< argc
- 1; i
++) {
12530 const char *arg
= Jim_GetString(argv
[i
], NULL
);
12534 /* It's a pity we can't use Jim_GetEnum here :-( */
12535 if (strcmp(arg
, "--") == 0) {
12543 if (strncmp(arg
, "-no", 3) == 0) {
12552 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
12556 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
12563 mask
|= (1 << option
);
12566 mask
&= ~(1 << option
);
12571 if (argc
< 1 || argc
> 3) {
12573 Jim_WrongNumArgs(interp
, 1, argv
,
12574 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
12579 if (mask
& (1 << JIM_SIGNAL
)) {
12583 interp
->signal_level
+= sig
;
12584 if (interp
->signal_level
&& interp
->sigmask
) {
12585 /* If a signal is set, don't even try to execute the body */
12586 exitCode
= JIM_SIGNAL
;
12589 exitCode
= Jim_EvalObj(interp
, argv
[0]);
12591 interp
->signal_level
-= sig
;
12593 /* Catch or pass through? Only the first 64 codes can be passed through */
12594 if (exitCode
>= 0 && exitCode
< (int)sizeof(mask
) && ((1 << exitCode
) & mask
) == 0) {
12595 /* Not caught, pass it up */
12599 if (sig
&& exitCode
== JIM_SIGNAL
) {
12600 /* Catch the signal at this level */
12601 if (interp
->signal_set_result
) {
12602 interp
->signal_set_result(interp
, interp
->sigmask
);
12605 Jim_SetResultInt(interp
, interp
->sigmask
);
12607 interp
->sigmask
= 0;
12611 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
12615 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
12617 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
12618 Jim_ListAppendElement(interp
, optListObj
,
12619 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
12620 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
12621 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
12622 if (exitCode
== JIM_ERR
) {
12623 Jim_Obj
*errorCode
;
12624 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
12626 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
12628 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
12630 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
12631 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
12634 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
12639 Jim_SetResultInt(interp
, exitCode
);
12643 #ifdef JIM_REFERENCES
12646 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12648 if (argc
!= 3 && argc
!= 4) {
12649 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
12653 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
12656 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
12662 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12664 Jim_Reference
*refPtr
;
12667 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
12670 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
12672 Jim_SetResult(interp
, refPtr
->objPtr
);
12677 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12679 Jim_Reference
*refPtr
;
12682 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
12685 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
12687 Jim_IncrRefCount(argv
[2]);
12688 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
12689 refPtr
->objPtr
= argv
[2];
12690 Jim_SetResult(interp
, argv
[2]);
12695 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12698 Jim_WrongNumArgs(interp
, 1, argv
, "");
12701 Jim_SetResultInt(interp
, Jim_Collect(interp
));
12705 /* [finalize] reference ?newValue? */
12706 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12708 if (argc
!= 2 && argc
!= 3) {
12709 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
12713 Jim_Obj
*cmdNamePtr
;
12715 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
12717 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
12718 Jim_SetResult(interp
, cmdNamePtr
);
12721 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
12723 Jim_SetResult(interp
, argv
[2]);
12730 /* [info references] (list of all the references/finalizers) */
12734 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12736 const char *oldName
, *newName
;
12739 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
12742 oldName
= Jim_GetString(argv
[1], NULL
);
12743 newName
= Jim_GetString(argv
[2], NULL
);
12744 if (Jim_RenameCommand(interp
, oldName
, newName
) != JIM_OK
) {
12745 Jim_SetResultFormatted(interp
, "can't rename \"%#s\": command doesn't exist", argv
[1]);
12752 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12756 const char *options
[] = {
12757 "create", "get", "set", "unset", "exists", NULL
12761 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXIST
12765 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
12769 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
12775 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
12776 JIM_ERRMSG
) != JIM_OK
) {
12779 Jim_SetResult(interp
, objPtr
);
12784 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
12787 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1]);
12790 Jim_SetResultBool(interp
, Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3,
12791 &objPtr
, JIM_ERRMSG
) == JIM_OK
);
12796 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
12799 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
);
12803 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
12806 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
12807 Jim_SetResult(interp
, objPtr
);
12816 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12818 const char *options
[] = {
12819 "-nobackslashes", "-nocommands", "-novariables", NULL
12822 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
12824 int flags
= JIM_SUBST_FLAG
;
12828 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
12831 for (i
= 1; i
< (argc
- 1); i
++) {
12834 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
12835 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
12839 case OPT_NOBACKSLASHES
:
12840 flags
|= JIM_SUBST_NOESC
;
12842 case OPT_NOCOMMANDS
:
12843 flags
|= JIM_SUBST_NOCMD
;
12845 case OPT_NOVARIABLES
:
12846 flags
|= JIM_SUBST_NOVAR
;
12850 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
12853 Jim_SetResult(interp
, objPtr
);
12858 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12864 static const char *commands
[] = {
12865 "body", "commands", "procs", "exists", "globals", "level", "frame", "locals",
12866 "vars", "version", "patchlevel", "complete", "args", "hostname",
12867 "script", "source", "stacktrace", "nameofexecutable", "returncodes", NULL
12870 { INFO_BODY
, INFO_COMMANDS
, INFO_PROCS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
, INFO_FRAME
,
12871 INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
12872 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
12877 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
12880 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
12885 /* Test for the the most common commands first, just in case it makes a difference */
12889 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
12892 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
12896 case INFO_COMMANDS
:
12898 if (argc
!= 2 && argc
!= 3) {
12899 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
12902 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
,
12903 (cmd
== INFO_PROCS
)));
12907 mode
++; /* JIM_VARLIST_VARS */
12909 mode
++; /* JIM_VARLIST_LOCALS */
12911 /* mode 0 => JIM_VARLIST_GLOBALS */
12912 if (argc
!= 2 && argc
!= 3) {
12913 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
12916 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
12921 Jim_WrongNumArgs(interp
, 2, argv
, "");
12924 Jim_SetResultString(interp
, Jim_GetScript(interp
, interp
->currentScriptObj
)->fileName
,
12929 const char *filename
= "";
12931 Jim_Obj
*resObjPtr
;
12934 Jim_WrongNumArgs(interp
, 2, argv
, "source");
12937 if (argv
[2]->typePtr
== &sourceObjType
) {
12938 filename
= argv
[2]->internalRep
.sourceValue
.fileName
;
12939 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
12941 else if (argv
[2]->typePtr
== &scriptObjType
) {
12942 ScriptObj
*script
= Jim_GetScript(interp
, argv
[2]);
12944 filename
= script
->fileName
;
12945 if (script
->token
) {
12946 line
= script
->token
->linenr
;
12949 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12950 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObj(interp
, filename
, -1));
12951 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
12952 Jim_SetResult(interp
, resObjPtr
);
12956 case INFO_STACKTRACE
:
12957 Jim_SetResult(interp
, interp
->stackTrace
);
12964 Jim_SetResultInt(interp
, interp
->numLevels
);
12968 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
12971 Jim_SetResult(interp
, objPtr
);
12975 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
12985 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
12988 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
12991 if (cmdPtr
->cmdProc
!= NULL
) {
12992 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
12995 Jim_SetResult(interp
,
12996 cmd
== INFO_BODY
? cmdPtr
->bodyObjPtr
: cmdPtr
->argListObjPtr
);
13001 case INFO_PATCHLEVEL
:{
13002 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
13004 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
13005 Jim_SetResultString(interp
, buf
, -1);
13009 case INFO_COMPLETE
:
13011 Jim_WrongNumArgs(interp
, 2, argv
, "script");
13016 const char *s
= Jim_GetString(argv
[2], &len
);
13018 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, NULL
));
13022 case INFO_HOSTNAME
:
13023 /* Redirect to os.gethostname if it exists */
13024 return Jim_Eval(interp
, "os.gethostname");
13026 case INFO_NAMEOFEXECUTABLE
:
13027 /* Redirect to Tcl proc */
13028 return Jim_Eval(interp
, "{info nameofexecutable}");
13030 case INFO_RETURNCODES
:
13033 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
13035 for (i
= 0; jimReturnCodes
[i
]; i
++) {
13036 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
13037 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
13038 jimReturnCodes
[i
], -1));
13041 Jim_SetResult(interp
, listObjPtr
);
13043 else if (argc
== 3) {
13047 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
13050 name
= Jim_ReturnCode(code
);
13051 if (*name
== '?') {
13052 Jim_SetResultInt(interp
, code
);
13055 Jim_SetResultString(interp
, name
, -1);
13059 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
13068 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13070 const char *str
, *splitChars
, *noMatchStart
;
13071 int splitLen
, strLen
, i
;
13072 Jim_Obj
*resObjPtr
;
13074 if (argc
!= 2 && argc
!= 3) {
13075 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
13080 splitChars
= " \n\t\r";
13084 splitChars
= Jim_GetString(argv
[2], &splitLen
);
13086 str
= Jim_GetString(argv
[1], &strLen
);
13089 noMatchStart
= str
;
13090 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
13094 for (i
= 0; i
< splitLen
; i
++) {
13095 if (*str
== splitChars
[i
]) {
13098 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
13099 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
13100 noMatchStart
= str
+ 1;
13107 Jim_ListAppendElement(interp
, resObjPtr
,
13108 Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
)));
13111 /* This handles the special case of splitchars eq {}. This
13112 * is trivial but we want to perform object sharing as Tcl does. */
13113 Jim_Obj
*objCache
[256];
13114 const unsigned char *u
= (unsigned char *)str
;
13116 memset(objCache
, 0, sizeof(objCache
));
13117 for (i
= 0; i
< strLen
; i
++) {
13120 if (objCache
[c
] == NULL
)
13121 objCache
[c
] = Jim_NewStringObj(interp
, (char *)u
+ i
, 1);
13122 Jim_ListAppendElement(interp
, resObjPtr
, objCache
[c
]);
13125 Jim_SetResult(interp
, resObjPtr
);
13130 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13132 const char *joinStr
;
13133 int joinStrLen
, i
, listLen
;
13134 Jim_Obj
*resObjPtr
;
13136 if (argc
!= 2 && argc
!= 3) {
13137 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
13146 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
13148 listLen
= Jim_ListLength(interp
, argv
[1]);
13149 resObjPtr
= Jim_NewStringObj(interp
, NULL
, 0);
13151 for (i
= 0; i
< listLen
; i
++) {
13152 Jim_Obj
*objPtr
= 0;
13154 Jim_ListIndex(interp
, argv
[1], i
, &objPtr
, JIM_NONE
);
13155 Jim_AppendObj(interp
, resObjPtr
, objPtr
);
13156 if (i
+ 1 != listLen
) {
13157 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
13160 Jim_SetResult(interp
, resObjPtr
);
13165 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13170 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
13173 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
13174 if (objPtr
== NULL
)
13176 Jim_SetResult(interp
, objPtr
);
13181 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13183 Jim_Obj
*listPtr
, **outVec
;
13184 int outc
, i
, count
= 0;
13187 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
13190 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
13191 SetScanFmtFromAny(interp
, argv
[2]);
13192 if (FormatGetError(argv
[2]) != 0) {
13193 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
13197 int maxPos
= FormatGetMaxPos(argv
[2]);
13198 int count
= FormatGetCnvCount(argv
[2]);
13200 if (maxPos
> argc
- 3) {
13201 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
13204 else if (count
> argc
- 3) {
13205 Jim_SetResultString(interp
, "different numbers of variable names and "
13206 "field specifiers", -1);
13209 else if (count
< argc
- 3) {
13210 Jim_SetResultString(interp
, "variable is not assigned by any "
13211 "conversion specifiers", -1);
13215 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
13223 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
13224 int len
= Jim_ListLength(interp
, listPtr
);
13227 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
13228 for (i
= 0; i
< outc
; ++i
) {
13229 if (Jim_Length(outVec
[i
]) > 0) {
13231 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
13237 Jim_FreeNewObj(interp
, listPtr
);
13242 if (rc
== JIM_OK
) {
13243 Jim_SetResultInt(interp
, count
);
13248 if (listPtr
== (Jim_Obj
*)EOF
) {
13249 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
13252 Jim_SetResult(interp
, listPtr
);
13258 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13260 if (argc
!= 2 && argc
!= 3) {
13261 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
13264 Jim_SetResult(interp
, argv
[1]);
13266 JimSetStackTrace(interp
, argv
[2]);
13269 interp
->addStackTrace
++;
13274 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13279 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
13282 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
13284 Jim_SetResult(interp
, objPtr
);
13289 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13294 if (argc
< 3 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
<= 0) {
13295 Jim_WrongNumArgs(interp
, 1, argv
, "positiveCount value ?value ...?");
13302 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
13306 for (i
= 0; i
< argc
; i
++) {
13307 ListAppendElement(objPtr
, argv
[i
]);
13311 Jim_SetResult(interp
, objPtr
);
13316 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13322 extern char **environ
;
13325 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
13327 for (i
= 0; environ
[i
]; i
++) {
13328 const char *equals
= strchr(environ
[i
], '=');
13331 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, environ
[i
],
13332 equals
- environ
[i
]));
13333 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
13337 Jim_SetResult(interp
, listObjPtr
);
13342 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
13345 key
= Jim_GetString(argv
[1], NULL
);
13349 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
13352 val
= Jim_GetString(argv
[2], NULL
);
13354 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
13359 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13364 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
13367 retval
= Jim_EvalFile(interp
, Jim_GetString(argv
[1], NULL
));
13368 if (retval
== JIM_RETURN
)
13374 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13376 Jim_Obj
*revObjPtr
, **ele
;
13380 Jim_WrongNumArgs(interp
, 1, argv
, "list");
13383 JimListGetElements(interp
, argv
[1], &len
, &ele
);
13385 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
13387 ListAppendElement(revObjPtr
, ele
[len
--]);
13388 Jim_SetResult(interp
, revObjPtr
);
13392 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
13400 else if (step
> 0 && start
> end
)
13402 else if (step
< 0 && end
> start
)
13406 len
= -len
; /* abs(len) */
13408 step
= -step
; /* abs(step) */
13409 len
= 1 + ((len
- 1) / step
);
13410 /* We can truncate safely to INT_MAX, the range command
13411 * will always return an error for a such long range
13412 * because Tcl lists can't be so long. */
13415 return (int)((len
< 0) ? -1 : len
);
13419 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13421 jim_wide start
= 0, end
, step
= 1;
13425 if (argc
< 2 || argc
> 4) {
13426 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
13430 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
13434 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
13435 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
13437 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
13440 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
13441 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
13444 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
13445 for (i
= 0; i
< len
; i
++)
13446 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
13447 Jim_SetResult(interp
, objPtr
);
13452 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13454 jim_wide min
= 0, max
= 0, len
, maxMul
;
13456 if (argc
< 1 || argc
> 3) {
13457 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
13461 max
= JIM_WIDE_MAX
;
13462 } else if (argc
== 2) {
13463 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
13465 } else if (argc
== 3) {
13466 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
13467 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
13472 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
13475 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
13479 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
13480 if (r
< 0 || r
>= maxMul
) continue;
13481 r
= (len
== 0) ? 0 : r
%len
;
13482 Jim_SetResultInt(interp
, min
+r
);
13487 static const struct {
13489 Jim_CmdProc cmdProc
;
13490 } Jim_CoreCommandsTable
[] = {
13491 {"set", Jim_SetCoreCommand
},
13492 {"unset", Jim_UnsetCoreCommand
},
13493 {"puts", Jim_PutsCoreCommand
},
13494 {"+", Jim_AddCoreCommand
},
13495 {"*", Jim_MulCoreCommand
},
13496 {"-", Jim_SubCoreCommand
},
13497 {"/", Jim_DivCoreCommand
},
13498 {"incr", Jim_IncrCoreCommand
},
13499 {"while", Jim_WhileCoreCommand
},
13500 {"for", Jim_ForCoreCommand
},
13501 {"foreach", Jim_ForeachCoreCommand
},
13502 {"lmap", Jim_LmapCoreCommand
},
13503 {"if", Jim_IfCoreCommand
},
13504 {"switch", Jim_SwitchCoreCommand
},
13505 {"list", Jim_ListCoreCommand
},
13506 {"lindex", Jim_LindexCoreCommand
},
13507 {"lset", Jim_LsetCoreCommand
},
13508 {"lsearch", Jim_LsearchCoreCommand
},
13509 {"llength", Jim_LlengthCoreCommand
},
13510 {"lappend", Jim_LappendCoreCommand
},
13511 {"linsert", Jim_LinsertCoreCommand
},
13512 {"lreplace", Jim_LreplaceCoreCommand
},
13513 {"lsort", Jim_LsortCoreCommand
},
13514 {"append", Jim_AppendCoreCommand
},
13515 {"debug", Jim_DebugCoreCommand
},
13516 {"eval", Jim_EvalCoreCommand
},
13517 {"uplevel", Jim_UplevelCoreCommand
},
13518 {"expr", Jim_ExprCoreCommand
},
13519 {"break", Jim_BreakCoreCommand
},
13520 {"continue", Jim_ContinueCoreCommand
},
13521 {"proc", Jim_ProcCoreCommand
},
13522 {"concat", Jim_ConcatCoreCommand
},
13523 {"return", Jim_ReturnCoreCommand
},
13524 {"upvar", Jim_UpvarCoreCommand
},
13525 {"global", Jim_GlobalCoreCommand
},
13526 {"string", Jim_StringCoreCommand
},
13527 {"time", Jim_TimeCoreCommand
},
13528 {"exit", Jim_ExitCoreCommand
},
13529 {"catch", Jim_CatchCoreCommand
},
13530 #ifdef JIM_REFERENCES
13531 {"ref", Jim_RefCoreCommand
},
13532 {"getref", Jim_GetrefCoreCommand
},
13533 {"setref", Jim_SetrefCoreCommand
},
13534 {"finalize", Jim_FinalizeCoreCommand
},
13535 {"collect", Jim_CollectCoreCommand
},
13537 {"rename", Jim_RenameCoreCommand
},
13538 {"dict", Jim_DictCoreCommand
},
13539 {"subst", Jim_SubstCoreCommand
},
13540 {"info", Jim_InfoCoreCommand
},
13541 {"split", Jim_SplitCoreCommand
},
13542 {"join", Jim_JoinCoreCommand
},
13543 {"format", Jim_FormatCoreCommand
},
13544 {"scan", Jim_ScanCoreCommand
},
13545 {"error", Jim_ErrorCoreCommand
},
13546 {"lrange", Jim_LrangeCoreCommand
},
13547 {"lrepeat", Jim_LrepeatCoreCommand
},
13548 {"env", Jim_EnvCoreCommand
},
13549 {"source", Jim_SourceCoreCommand
},
13550 {"lreverse", Jim_LreverseCoreCommand
},
13551 {"range", Jim_RangeCoreCommand
},
13552 {"rand", Jim_RandCoreCommand
},
13553 {"tailcall", Jim_TailcallCoreCommand
},
13554 {"local", Jim_LocalCoreCommand
},
13558 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
13562 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
13563 Jim_CreateCommand(interp
,
13564 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
13569 /* -----------------------------------------------------------------------------
13570 * Interactive prompt
13571 * ---------------------------------------------------------------------------*/
13572 void Jim_PrintErrorMessage(Jim_Interp
*interp
)
13576 if (*interp
->errorFileName
) {
13577 fprintf(stderr
, "%s:%d: Runtime Error: ", interp
->errorFileName
, interp
->errorLine
);
13579 fprintf(stderr
, "%s" JIM_NL
, Jim_GetString(interp
->result
, NULL
));
13580 len
= Jim_ListLength(interp
, interp
->stackTrace
);
13581 for (i
= len
- 3; i
>= 0; i
-= 3) {
13582 Jim_Obj
*objPtr
= 0;
13583 const char *proc
, *file
, *line
;
13585 Jim_ListIndex(interp
, interp
->stackTrace
, i
, &objPtr
, JIM_NONE
);
13586 proc
= Jim_GetString(objPtr
, NULL
);
13587 Jim_ListIndex(interp
, interp
->stackTrace
, i
+ 1, &objPtr
, JIM_NONE
);
13588 file
= Jim_GetString(objPtr
, NULL
);
13589 Jim_ListIndex(interp
, interp
->stackTrace
, i
+ 2, &objPtr
, JIM_NONE
);
13590 line
= Jim_GetString(objPtr
, NULL
);
13592 fprintf(stderr
, "in procedure '%s' ", proc
);
13594 fprintf(stderr
, "called ");
13598 fprintf(stderr
, "at file \"%s\", line %s", file
, line
);
13600 if (*file
|| *proc
) {
13601 fprintf(stderr
, JIM_NL
);
13606 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
13607 const char *prefix
, const char *const *tablePtr
, const char *name
)
13610 char **tablePtrSorted
;
13613 for (count
= 0; tablePtr
[count
]; count
++) {
13616 if (name
== NULL
) {
13620 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
13621 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
13622 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
13623 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
13624 for (i
= 0; i
< count
; i
++) {
13625 if (i
+ 1 == count
&& count
> 1) {
13626 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
13628 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
13629 if (i
+ 1 != count
) {
13630 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
13633 Jim_Free(tablePtrSorted
);
13636 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
13637 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
13639 const char *bad
= "bad ";
13640 const char *const *entryPtr
= NULL
;
13644 const char *arg
= Jim_GetString(objPtr
, &arglen
);
13648 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
13649 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
13650 /* Found an exact match */
13654 if (flags
& JIM_ENUM_ABBREV
) {
13655 /* Accept an unambiguous abbreviation.
13656 * Note that '-' doesnt' consitute a valid abbreviation
13658 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
13659 if (*arg
== '-' && arglen
== 1) {
13663 bad
= "ambiguous ";
13671 /* If we had an unambiguous partial match */
13678 if (flags
& JIM_ERRMSG
) {
13679 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
13684 int Jim_FindByName(const char *name
, const char *array
[], size_t len
)
13688 for (i
= 0; i
< (int)len
; i
++) {
13689 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
13696 int Jim_IsDict(Jim_Obj
*objPtr
)
13698 return objPtr
->typePtr
== &dictObjType
;
13701 int Jim_IsList(Jim_Obj
*objPtr
)
13703 return objPtr
->typePtr
== &listObjType
;
13707 * Very simple printf-like formatting, designed for error messages.
13709 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
13710 * The resulting string is created and set as the result.
13712 * Each '%s' should correspond to a regular string parameter.
13713 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
13714 * Any other printf specifier is not allowed (but %% is allowed for the % character).
13716 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
13718 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
13720 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
13722 /* Initial space needed */
13723 int len
= strlen(format
);
13726 const char *params
[5];
13731 va_start(args
, format
);
13733 for (i
= 0; i
< len
&& n
< 5; i
++) {
13736 if (strncmp(format
+ i
, "%s", 2) == 0) {
13737 params
[n
] = va_arg(args
, char *);
13739 l
= strlen(params
[n
]);
13741 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
13742 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
13744 params
[n
] = Jim_GetString(objPtr
, &l
);
13747 if (format
[i
] == '%') {
13757 buf
= Jim_Alloc(len
+ 1);
13758 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
13760 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13764 * Local Variables: ***
13765 * c-basic-offset: 4 ***