1 /* This is single source file, bootstrap version of Jim Tcl. See http://jim.berlios.de/ */
7 #define HAVE_NO_AUTOCONF
9 #define TCL_LIBRARY "."
10 #define jim_ext_bootstrap
12 #define jim_ext_readdir
14 #define jim_ext_regexp
19 #define jim_ext_stdlib
20 #define jim_ext_tclcompat
21 #if defined(__MINGW32__)
22 #define TCL_PLATFORM_OS "mingw"
23 #define TCL_PLATFORM_PLATFORM "windows"
24 #define HAVE_MKDIR_ONE_ARG
27 #define TCL_PLATFORM_OS "unknown"
28 #define TCL_PLATFORM_PLATFORM "unix"
35 * UTF-8 utility functions
37 * (c) 2010 Steve Bennett <steveb@workware.net.au>
39 * See LICENCE for licence details.
43 * Converts the given unicode codepoint (0 - 0xffff) to utf-8
44 * and stores the result at 'p'.
46 * Returns the number of utf-8 characters (1-3).
48 int utf8_fromunicode(char *p
, unsigned short uc
);
53 /* No utf-8 support. 1 byte = 1 char */
54 #define utf8_strlen(S, B) (B) < 0 ? strlen(S) : (B)
55 #define utf8_tounicode(S, CP) (*(CP) = *(S), 1)
56 #define utf8_upper(C) toupper(C)
57 #define utf8_lower(C) tolower(C)
58 #define utf8_index(C, I) (I)
59 #define utf8_charlen(C) 1
60 #define utf8_prev_len(S, L) 1
64 * Returns the length of the utf-8 sequence starting with 'c'.
66 * Returns 1-4, or -1 if this is not a valid start byte.
68 * Note that charlen=4 is not supported by the rest of the API.
70 int utf8_charlen(int c
);
73 * Returns the number of characters in the utf-8
74 * string of the given byte length.
76 * Any bytes which are not part of an valid utf-8
77 * sequence are treated as individual characters.
79 * The string *must* be null terminated.
81 * Does not support unicode code points > \uffff
83 int utf8_strlen(const char *str
, int bytelen
);
86 * Returns the byte index of the given character in the utf-8 string.
88 * The string *must* be null terminated.
90 * This will return the byte length of a utf-8 string
91 * if given the char length.
93 int utf8_index(const char *str
, int charindex
);
96 * Returns the unicode codepoint corresponding to the
97 * utf-8 sequence 'str'.
99 * Stores the result in *uc and returns the number of bytes
102 * If 'str' is null terminated, then an invalid utf-8 sequence
103 * at the end of the string will be returned as individual bytes.
105 * If it is not null terminated, the length *must* be checked first.
107 * Does not support unicode code points > \uffff
109 int utf8_tounicode(const char *str
, int *uc
);
112 * Returns the number of bytes before 'str' that the previous
113 * utf-8 character sequence starts (which may be the middle of a sequence).
115 * Looks back at most 'len' bytes backwards, which must be > 0.
116 * If no start char is found, returns -len
118 int utf8_prev_len(const char *str
, int len
);
121 * Returns the upper-case variant of the given unicode codepoint.
123 * Does not support unicode code points > \uffff
125 int utf8_upper(int uc
);
128 * Returns the lower-case variant of the given unicode codepoint.
130 * NOTE: Use utf8_upper() in preference for case-insensitive matching.
132 * Does not support unicode code points > \uffff
134 int utf8_lower(int uc
);
139 /* Jim - A small embeddable Tcl interpreter
141 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
142 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
143 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
144 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
145 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
146 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
147 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
149 * Redistribution and use in source and binary forms, with or without
150 * modification, are permitted provided that the following conditions
153 * 1. Redistributions of source code must retain the above copyright
154 * notice, this list of conditions and the following disclaimer.
155 * 2. Redistributions in binary form must reproduce the above
156 * copyright notice, this list of conditions and the following
157 * disclaimer in the documentation and/or other materials
158 * provided with the distribution.
160 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
161 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
162 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
163 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
164 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
165 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
166 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
167 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
168 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
169 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
170 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
171 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
173 * The views and conclusions contained in the software and documentation
174 * are those of the authors and should not be interpreted as representing
175 * official policies, either expressed or implied, of the Jim Tcl Project.
177 *--- Inline Header File Documentation ---
178 * [By Duane Ellis, openocd@duaneellis.com, 8/18/8]
180 * Belief is "Jim" would greatly benifit if Jim Internals where
181 * documented in some way - form whatever, and perhaps - the package:
182 * 'doxygen' is the correct approach to do that.
184 * Details, see: http://www.stack.nl/~dimitri/doxygen/
186 * To that end please follow these guide lines:
188 * (A) Document the PUBLIC api in the .H file.
190 * (B) Document JIM Internals, in the .C file.
192 * (C) Remember JIM is embedded in other packages, to that end do
193 * not assume that your way of documenting is the right way, Jim's
194 * public documentation should be agnostic, such that it is some
195 * what agreeable with the "package" that is embedding JIM inside
196 * of it's own doxygen documentation.
198 * (D) Use minimal Doxygen tags.
200 * This will be an "ongoing work in progress" for some time.
212 #include <stdio.h> /* for the FILE typedef definition */
213 #include <stdlib.h> /* In order to export the Jim_Free() macro */
214 #include <stdarg.h> /* In order to get type va_list */
216 /* -----------------------------------------------------------------------------
217 * System configuration
218 * autoconf (configure) will set these
219 * ---------------------------------------------------------------------------*/
221 #ifndef HAVE_NO_AUTOCONF
224 /* -----------------------------------------------------------------------------
225 * Compiler specific fixes.
226 * ---------------------------------------------------------------------------*/
228 /* Long Long type and related issues */
230 # ifdef HAVE_LONG_LONG
231 # define jim_wide long long
233 # define LLONG_MAX 9223372036854775807LL
236 # define LLONG_MIN (-LLONG_MAX - 1LL)
238 # define JIM_WIDE_MIN LLONG_MIN
239 # define JIM_WIDE_MAX LLONG_MAX
241 # define jim_wide long
242 # define JIM_WIDE_MIN LONG_MIN
243 # define JIM_WIDE_MAX LONG_MAX
246 /* -----------------------------------------------------------------------------
247 * LIBC specific fixes
248 * ---------------------------------------------------------------------------*/
250 # ifdef HAVE_LONG_LONG
251 # define JIM_WIDE_MODIFIER "lld"
253 # define JIM_WIDE_MODIFIER "ld"
254 # define strtoull strtoul
258 #define UCHAR(c) ((unsigned char)(c))
260 /* -----------------------------------------------------------------------------
262 * ---------------------------------------------------------------------------*/
264 /* Jim version numbering: every version of jim is marked with a
265 * successive integer number. This is version 0. The first
266 * stable version will be 1, then 2, 3, and so on. */
267 #define JIM_VERSION 71
273 #define JIM_CONTINUE 4
276 /* The following are internal codes and should never been seen/used */
279 #define JIM_MAX_NESTING_DEPTH 1000 /* default max nesting depth */
281 /* Some function get an integer argument with flags to change
283 #define JIM_NONE 0 /* no flags set */
284 #define JIM_ERRMSG 1 /* set an error message in the interpreter. */
286 #define JIM_UNSHARED 4 /* Flag to Jim_GetVariable() */
288 /* Flags for Jim_SubstObj() */
289 #define JIM_SUBST_NOVAR 1 /* don't perform variables substitutions */
290 #define JIM_SUBST_NOCMD 2 /* don't perform command substitutions */
291 #define JIM_SUBST_NOESC 4 /* don't perform escapes substitutions */
292 #define JIM_SUBST_FLAG 128 /* flag to indicate that this is a real substition object */
294 /* Unused arguments generate annoying warnings... */
295 #define JIM_NOTUSED(V) ((void) V)
297 /* Flags for Jim_GetEnum() */
298 #define JIM_ENUM_ABBREV 2 /* Allow unambiguous abbreviation */
300 /* Flags used by API calls getting a 'nocase' argument. */
301 #define JIM_CASESENS 0 /* case sensitive */
302 #define JIM_NOCASE 1 /* no case */
304 /* Filesystem related */
305 #define JIM_PATH_LEN 1024
307 /* Newline, some embedded system may need -DJIM_CRLF */
309 #define JIM_NL "\r\n"
314 #define JIM_LIBPATH "auto_path"
315 #define JIM_INTERACTIVE "tcl_interactive"
317 /* -----------------------------------------------------------------------------
319 * ---------------------------------------------------------------------------*/
321 typedef struct Jim_Stack
{
327 /* -----------------------------------------------------------------------------
329 * ---------------------------------------------------------------------------*/
331 typedef struct Jim_HashEntry
{
337 struct Jim_HashEntry
*next
;
340 typedef struct Jim_HashTableType
{
341 unsigned int (*hashFunction
)(const void *key
);
342 const void *(*keyDup
)(void *privdata
, const void *key
);
343 void *(*valDup
)(void *privdata
, const void *obj
);
344 int (*keyCompare
)(void *privdata
, const void *key1
, const void *key2
);
345 void (*keyDestructor
)(void *privdata
, const void *key
);
346 void (*valDestructor
)(void *privdata
, void *obj
);
349 typedef struct Jim_HashTable
{
350 Jim_HashEntry
**table
;
351 const Jim_HashTableType
*type
;
353 unsigned int sizemask
;
355 unsigned int collisions
;
359 typedef struct Jim_HashTableIterator
{
362 Jim_HashEntry
*entry
, *nextEntry
;
363 } Jim_HashTableIterator
;
365 /* This is the initial size of every hash table */
366 #define JIM_HT_INITIAL_SIZE 16
368 /* ------------------------------- Macros ------------------------------------*/
369 #define Jim_FreeEntryVal(ht, entry) \
370 if ((ht)->type->valDestructor) \
371 (ht)->type->valDestructor((ht)->privdata, (entry)->u.val)
373 #define Jim_SetHashVal(ht, entry, _val_) do { \
374 if ((ht)->type->valDup) \
375 entry->u.val = (ht)->type->valDup((ht)->privdata, _val_); \
377 entry->u.val = (_val_); \
380 #define Jim_FreeEntryKey(ht, entry) \
381 if ((ht)->type->keyDestructor) \
382 (ht)->type->keyDestructor((ht)->privdata, (entry)->key)
384 #define Jim_SetHashKey(ht, entry, _key_) do { \
385 if ((ht)->type->keyDup) \
386 entry->key = (ht)->type->keyDup((ht)->privdata, _key_); \
388 entry->key = (_key_); \
391 #define Jim_CompareHashKeys(ht, key1, key2) \
392 (((ht)->type->keyCompare) ? \
393 (ht)->type->keyCompare((ht)->privdata, key1, key2) : \
396 #define Jim_HashKey(ht, key) (ht)->type->hashFunction(key)
398 #define Jim_GetHashEntryKey(he) ((he)->key)
399 #define Jim_GetHashEntryVal(he) ((he)->val)
400 #define Jim_GetHashTableCollisions(ht) ((ht)->collisions)
401 #define Jim_GetHashTableSize(ht) ((ht)->size)
402 #define Jim_GetHashTableUsed(ht) ((ht)->used)
404 /* -----------------------------------------------------------------------------
406 * ---------------------------------------------------------------------------*/
408 /* -----------------------------------------------------------------------------
409 * Jim object. This is mostly the same as Tcl_Obj itself,
410 * with the addition of the 'prev' and 'next' pointers.
411 * In Jim all the objects are stored into a linked list for GC purposes,
412 * so that it's possible to access every object living in a given interpreter
413 * sequentially. When an object is freed, it's moved into a different
414 * linked list, used as object pool.
416 * The refcount of a freed object is always -1.
417 * ---------------------------------------------------------------------------*/
418 typedef struct Jim_Obj
{
419 int refCount
; /* reference count */
420 char *bytes
; /* string representation buffer. NULL = no string repr. */
421 int length
; /* number of bytes in 'bytes', not including the numterm. */
422 const struct Jim_ObjType
*typePtr
; /* object type. */
423 /* Internal representation union */
425 /* integer number type */
427 /* hashed object type value */
431 /* return code type */
433 /* double number type */
435 /* Generic pointer */
437 /* Generic two pointers value */
442 /* Variable object */
444 unsigned jim_wide callFrameId
;
445 struct Jim_Var
*varPtr
;
449 unsigned jim_wide procEpoch
;
450 struct Jim_Cmd
*cmdPtr
;
454 struct Jim_Obj
**ele
; /* Elements vector */
455 int len
; /* Length */
456 int maxLen
; /* Allocated 'ele' length */
461 int charLength
; /* utf-8 char length. -1 if unknown */
466 struct Jim_Reference
*refPtr
;
470 const char *fileName
;
473 /* Dict substitution type */
475 struct Jim_Obj
*varNameObjPtr
;
476 struct Jim_Obj
*indexObjPtr
;
478 /* tagged binary type */
483 /* Regular expression pattern */
486 void *compre
; /* really an allocated (regex_t *) */
493 /* This are 8 or 16 bytes more for every object
494 * but this is required for efficient garbage collection
495 * of Jim references. */
496 struct Jim_Obj
*prevObjPtr
; /* pointer to the prev object. */
497 struct Jim_Obj
*nextObjPtr
; /* pointer to the next object. */
500 /* Jim_Obj related macros */
501 #define Jim_IncrRefCount(objPtr) \
503 #define Jim_DecrRefCount(interp, objPtr) \
504 if (--(objPtr)->refCount <= 0) Jim_FreeObj(interp, objPtr)
505 #define Jim_IsShared(objPtr) \
506 ((objPtr)->refCount > 1)
508 /* This macro is used when we allocate a new object using
509 * Jim_New...Obj(), but for some error we need to destroy it.
510 * Instead to use Jim_IncrRefCount() + Jim_DecrRefCount() we
511 * can just call Jim_FreeNewObj. To call Jim_Free directly
512 * seems too raw, the object handling may change and we want
513 * that Jim_FreeNewObj() can be called only against objects
514 * that are belived to have refcount == 0. */
515 #define Jim_FreeNewObj Jim_FreeObj
517 /* Free the internal representation of the object. */
518 #define Jim_FreeIntRep(i,o) \
519 if ((o)->typePtr && (o)->typePtr->freeIntRepProc) \
520 (o)->typePtr->freeIntRepProc(i, o)
522 /* Get the internal representation pointer */
523 #define Jim_GetIntRepPtr(o) (o)->internalRep.ptr
525 /* Set the internal representation pointer */
526 #define Jim_SetIntRepPtr(o, p) \
527 (o)->internalRep.ptr = (p)
529 /* The object type structure.
530 * There are four methods.
532 * - FreeIntRep is used to free the internal representation of the object.
533 * Can be NULL if there is nothing to free.
534 * - DupIntRep is used to duplicate the internal representation of the object.
535 * If NULL, when an object is duplicated, the internalRep union is
536 * directly copied from an object to another.
537 * Note that it's up to the caller to free the old internal repr of the
538 * object before to call the Dup method.
539 * - UpdateString is used to create the string from the internal repr.
540 * - setFromAny is used to convert the current object into one of this type.
545 typedef void (Jim_FreeInternalRepProc
)(struct Jim_Interp
*interp
,
546 struct Jim_Obj
*objPtr
);
547 typedef void (Jim_DupInternalRepProc
)(struct Jim_Interp
*interp
,
548 struct Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
549 typedef void (Jim_UpdateStringProc
)(struct Jim_Obj
*objPtr
);
551 typedef struct Jim_ObjType
{
552 const char *name
; /* The name of the type. */
553 Jim_FreeInternalRepProc
*freeIntRepProc
;
554 Jim_DupInternalRepProc
*dupIntRepProc
;
555 Jim_UpdateStringProc
*updateStringProc
;
559 /* Jim_ObjType flags */
560 #define JIM_TYPE_NONE 0 /* No flags */
561 #define JIM_TYPE_REFERENCES 1 /* The object may contain referneces. */
563 /* Starting from 1 << 20 flags are reserved for private uses of
564 * different calls. This way the same 'flags' argument may be used
565 * to pass both global flags and private flags. */
566 #define JIM_PRIV_FLAG_SHIFT 20
568 /* -----------------------------------------------------------------------------
569 * Call frame, vars, commands structures
570 * ---------------------------------------------------------------------------*/
573 typedef struct Jim_CallFrame
{
574 unsigned jim_wide id
; /* Call Frame ID. Used for caching. */
575 int level
; /* Level of this call frame. 0 = global */
576 struct Jim_HashTable vars
; /* Where local vars are stored */
577 struct Jim_HashTable
*staticVars
; /* pointer to procedure static vars */
578 struct Jim_CallFrame
*parentCallFrame
;
579 Jim_Obj
*const *argv
; /* object vector of the current procedure call. */
580 int argc
; /* number of args of the current procedure call. */
581 Jim_Obj
*procArgsObjPtr
; /* arglist object of the running procedure */
582 Jim_Obj
*procBodyObjPtr
; /* body object of the running procedure */
583 struct Jim_CallFrame
*nextFramePtr
;
584 const char *filename
; /* file and line of caller of this proc (if available) */
588 /* The var structure. It just holds the pointer of the referenced
589 * object. If linkFramePtr is not NULL the variable is a link
590 * to a variable of name store on objPtr living on the given callframe
591 * (this happens when the [global] or [upvar] command is used).
592 * The interp in order to always know how to free the Jim_Obj associated
593 * with a given variable because In Jim objects memory managment is
594 * bound to interpreters. */
595 typedef struct Jim_Var
{
597 struct Jim_CallFrame
*linkFramePtr
;
600 /* The cmd structure. */
601 typedef int (*Jim_CmdProc
)(struct Jim_Interp
*interp
, int argc
,
602 Jim_Obj
*const *argv
);
603 typedef void (*Jim_DelCmdProc
)(struct Jim_Interp
*interp
, void *privData
);
605 /* A command is implemented in C if funcPtr is != NULL, otherwise
606 * it's a Tcl procedure with the arglist and body represented by the
607 * two objects referenced by arglistObjPtr and bodyoObjPtr. */
608 typedef struct Jim_Cmd
{
609 int inUse
; /* Reference count */
610 int isproc
; /* Is this a procedure? */
613 /* native (C) command */
614 Jim_CmdProc cmdProc
; /* The command implementation */
615 Jim_DelCmdProc delProc
; /* Called when the command is deleted if != NULL */
616 void *privData
; /* command-private data available via Jim_CmdPrivData() */
620 Jim_Obj
*argListObjPtr
;
622 Jim_HashTable
*staticVars
; /* Static vars hash table. NULL if no statics. */
623 int leftArity
; /* Required args assigned from the left */
624 int optionalArgs
; /* Number of optional args (default values) */
625 int rightArity
; /* Required args assigned from the right */
626 int args
; /* True if 'args' specified */
627 struct Jim_Cmd
*prevCmd
; /* Previous command defn if proc created 'local' */
628 int upcall
; /* True if proc is currently in upcall */
633 /* Pseudo Random Number Generator State structure */
634 typedef struct Jim_PrngState
{
635 unsigned char sbox
[256];
639 /* -----------------------------------------------------------------------------
640 * Jim interpreter structure.
641 * Fields similar to the real Tcl interpreter structure have the same names.
642 * ---------------------------------------------------------------------------*/
643 typedef struct Jim_Interp
{
644 Jim_Obj
*result
; /* object returned by the last command called. */
645 int errorLine
; /* Error line where an error occurred. */
646 char *errorFileName
; /* Error file where an error occurred. */
647 int addStackTrace
; /* > 0 If a level should be added to the stack trace */
648 int maxNestingDepth
; /* Used for infinite loop detection. */
649 int returnCode
; /* Completion code to return on JIM_RETURN. */
650 int returnLevel
; /* Current level of 'return -level' */
651 int exitCode
; /* Code to return to the OS on JIM_EXIT. */
652 long id
; /* Hold unique id for various purposes */
653 int signal_level
; /* A nesting level of catch -signal */
654 jim_wide sigmask
; /* Bit mask of caught signals, or 0 if none */
655 int (*signal_set_result
)(struct Jim_Interp
*interp
, jim_wide sigmask
); /* Set a result for the sigmask */
656 Jim_CallFrame
*framePtr
; /* Pointer to the current call frame */
657 Jim_CallFrame
*topFramePtr
; /* toplevel/global frame pointer. */
658 struct Jim_HashTable commands
; /* Commands hash table */
659 unsigned jim_wide procEpoch
; /* Incremented every time the result
660 of procedures names lookup caching
661 may no longer be valid. */
662 unsigned jim_wide callFrameEpoch
; /* Incremented every time a new
663 callframe is created. This id is used for the
664 'ID' field contained in the Jim_CallFrame
666 int local
; /* If 'local' is in effect, newly defined procs keep a reference to the old defn */
667 Jim_Obj
*liveList
; /* Linked list of all the live objects. */
668 Jim_Obj
*freeList
; /* Linked list of all the unused objects. */
669 Jim_Obj
*currentScriptObj
; /* Script currently in execution. */
670 Jim_Obj
*emptyObj
; /* Shared empty string object. */
671 Jim_Obj
*trueObj
; /* Shared true int object. */
672 Jim_Obj
*falseObj
; /* Shared false int object. */
673 unsigned jim_wide referenceNextId
; /* Next id for reference. */
674 struct Jim_HashTable references
; /* References hash table. */
675 jim_wide lastCollectId
; /* reference max Id of the last GC
676 execution. It's set to -1 while the collection
677 is running as sentinel to avoid to recursive
678 calls via the [collect] command inside
680 time_t lastCollectTime
; /* unix time of the last GC execution */
681 struct Jim_HashTable sharedStrings
; /* Shared Strings hash table */
682 Jim_Obj
*stackTrace
; /* Stack trace object. */
683 Jim_Obj
*errorProc
; /* Name of last procedure which returned an error */
684 Jim_Obj
*unknown
; /* Unknown command cache */
685 int unknown_called
; /* The unknown command has been invoked */
686 int errorFlag
; /* Set if an error occurred during execution. */
687 void *cmdPrivData
; /* Used to pass the private data pointer to
688 a command. It is set to what the user specified
689 via Jim_CreateCommand(). */
691 struct Jim_CallFrame
*freeFramesList
; /* list of CallFrame structures. */
692 struct Jim_HashTable assocData
; /* per-interp storage for use by packages */
693 Jim_PrngState
*prngState
; /* per interpreter Random Number Gen. state. */
694 struct Jim_HashTable packages
; /* Provided packages hash table */
695 Jim_Stack
*localProcs
; /* procs to be destroyed on end of evaluation */
696 Jim_Stack
*loadHandles
; /* handles of loaded modules [load] */
699 /* Currently provided as macro that performs the increment.
700 * At some point may be a real function doing more work.
701 * The proc epoch is used in order to know when a command lookup
702 * cached can no longer considered valid. */
703 #define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++
704 #define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l))
705 #define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval))
706 /* Note: Using trueObj and falseObj here makes some things slower...*/
707 #define Jim_SetResultBool(i,b) Jim_SetResultInt(i, b)
708 #define Jim_SetEmptyResult(i) Jim_SetResult(i, (i)->emptyObj)
709 #define Jim_GetResult(i) ((i)->result)
710 #define Jim_CmdPrivData(i) ((i)->cmdPrivData)
711 #define Jim_String(o) Jim_GetString((o), NULL)
713 /* Note that 'o' is expanded only one time inside this macro,
714 * so it's safe to use side effects. */
715 #define Jim_SetResult(i,o) do { \
716 Jim_Obj *_resultObjPtr_ = (o); \
717 Jim_IncrRefCount(_resultObjPtr_); \
718 Jim_DecrRefCount(i,(i)->result); \
719 (i)->result = _resultObjPtr_; \
722 /* Use this for filehandles, etc. which need a unique id */
723 #define Jim_GetId(i) (++(i)->id)
725 /* Reference structure. The interpreter pointer is held within privdata member in HashTable */
726 #define JIM_REFERENCE_TAGLEN 7 /* The tag is fixed-length, because the reference
727 string representation must be fixed length. */
728 typedef struct Jim_Reference
{
730 Jim_Obj
*finalizerCmdNamePtr
;
731 char tag
[JIM_REFERENCE_TAGLEN
+1];
734 /* -----------------------------------------------------------------------------
735 * Exported API prototypes.
736 * ---------------------------------------------------------------------------*/
738 /* Macros that are common for extensions and core. */
739 #define Jim_NewEmptyStringObj(i) Jim_NewStringObj(i, "", 0)
741 /* The core includes real prototypes, extensions instead
742 * include a global function pointer for every function exported.
743 * Once the extension calls Jim_InitExtension(), the global
744 * functon pointers are set to the value of the STUB table
745 * contained in the Jim_Interp structure.
747 * This makes Jim able to load extensions even if it is statically
748 * linked itself, and to load extensions compiled with different
749 * versions of Jim (as long as the API is still compatible.) */
751 /* Macros are common for core and extensions */
752 #define Jim_FreeHashTableIterator(iter) Jim_Free(iter)
756 /* Memory allocation */
757 JIM_EXPORT
void *Jim_Alloc (int size
);
758 JIM_EXPORT
void *Jim_Realloc(void *ptr
, int size
);
759 JIM_EXPORT
void Jim_Free (void *ptr
);
760 JIM_EXPORT
char * Jim_StrDup (const char *s
);
761 JIM_EXPORT
char *Jim_StrDupLen(const char *s
, int l
);
764 JIM_EXPORT
char **Jim_GetEnviron(void);
765 JIM_EXPORT
void Jim_SetEnviron(char **env
);
768 JIM_EXPORT
int Jim_Eval(Jim_Interp
*interp
, const char *script
);
769 /* in C code, you can do this and get better error messages */
770 /* Jim_Eval_Named( interp, "some tcl commands", __FILE__, __LINE__ ); */
771 JIM_EXPORT
int Jim_Eval_Named(Jim_Interp
*interp
, const char *script
,const char *filename
, int lineno
);
772 JIM_EXPORT
int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
);
773 JIM_EXPORT
int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
);
774 JIM_EXPORT
int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
);
775 JIM_EXPORT
int Jim_EvalObj (Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
);
776 JIM_EXPORT
int Jim_EvalObjVector (Jim_Interp
*interp
, int objc
,
777 Jim_Obj
*const *objv
);
778 JIM_EXPORT
int Jim_EvalObjPrefix(Jim_Interp
*interp
, const char *prefix
,
779 int objc
, Jim_Obj
*const *objv
);
780 JIM_EXPORT
int Jim_SubstObj (Jim_Interp
*interp
, Jim_Obj
*substObjPtr
,
781 Jim_Obj
**resObjPtrPtr
, int flags
);
784 JIM_EXPORT
void Jim_InitStack(Jim_Stack
*stack
);
785 JIM_EXPORT
void Jim_FreeStack(Jim_Stack
*stack
);
786 JIM_EXPORT
int Jim_StackLen(Jim_Stack
*stack
);
787 JIM_EXPORT
void Jim_StackPush(Jim_Stack
*stack
, void *element
);
788 JIM_EXPORT
void * Jim_StackPop(Jim_Stack
*stack
);
789 JIM_EXPORT
void * Jim_StackPeek(Jim_Stack
*stack
);
790 JIM_EXPORT
void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
)(void *ptr
));
793 JIM_EXPORT
int Jim_InitHashTable (Jim_HashTable
*ht
,
794 const Jim_HashTableType
*type
, void *privdata
);
795 JIM_EXPORT
int Jim_ExpandHashTable (Jim_HashTable
*ht
,
797 JIM_EXPORT
int Jim_AddHashEntry (Jim_HashTable
*ht
, const void *key
,
799 JIM_EXPORT
int Jim_ReplaceHashEntry (Jim_HashTable
*ht
,
800 const void *key
, void *val
);
801 JIM_EXPORT
int Jim_DeleteHashEntry (Jim_HashTable
*ht
,
803 JIM_EXPORT
int Jim_FreeHashTable (Jim_HashTable
*ht
);
804 JIM_EXPORT Jim_HashEntry
* Jim_FindHashEntry (Jim_HashTable
*ht
,
806 JIM_EXPORT
int Jim_ResizeHashTable (Jim_HashTable
*ht
);
807 JIM_EXPORT Jim_HashTableIterator
*Jim_GetHashTableIterator
809 JIM_EXPORT Jim_HashEntry
* Jim_NextHashEntry
810 (Jim_HashTableIterator
*iter
);
813 JIM_EXPORT Jim_Obj
* Jim_NewObj (Jim_Interp
*interp
);
814 JIM_EXPORT
void Jim_FreeObj (Jim_Interp
*interp
, Jim_Obj
*objPtr
);
815 JIM_EXPORT
void Jim_InvalidateStringRep (Jim_Obj
*objPtr
);
816 JIM_EXPORT
void Jim_InitStringRep (Jim_Obj
*objPtr
, const char *bytes
,
818 JIM_EXPORT Jim_Obj
* Jim_DuplicateObj (Jim_Interp
*interp
,
820 JIM_EXPORT
const char * Jim_GetString(Jim_Obj
*objPtr
,
822 JIM_EXPORT
int Jim_Length(Jim_Obj
*objPtr
);
825 JIM_EXPORT Jim_Obj
* Jim_NewStringObj (Jim_Interp
*interp
,
826 const char *s
, int len
);
827 JIM_EXPORT Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
,
828 const char *s
, int charlen
);
829 JIM_EXPORT Jim_Obj
* Jim_NewStringObjNoAlloc (Jim_Interp
*interp
,
831 JIM_EXPORT
void Jim_AppendString (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
832 const char *str
, int len
);
833 JIM_EXPORT
void Jim_AppendObj (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
834 Jim_Obj
*appendObjPtr
);
835 JIM_EXPORT
void Jim_AppendStrings (Jim_Interp
*interp
,
836 Jim_Obj
*objPtr
, ...);
837 JIM_EXPORT
int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
);
838 JIM_EXPORT
int Jim_StringMatchObj (Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
,
839 Jim_Obj
*objPtr
, int nocase
);
840 JIM_EXPORT Jim_Obj
* Jim_StringRangeObj (Jim_Interp
*interp
,
841 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
,
842 Jim_Obj
*lastObjPtr
);
843 JIM_EXPORT Jim_Obj
* Jim_FormatString (Jim_Interp
*interp
,
844 Jim_Obj
*fmtObjPtr
, int objc
, Jim_Obj
*const *objv
);
845 JIM_EXPORT Jim_Obj
* Jim_ScanString (Jim_Interp
*interp
, Jim_Obj
*strObjPtr
,
846 Jim_Obj
*fmtObjPtr
, int flags
);
847 JIM_EXPORT
int Jim_CompareStringImmediate (Jim_Interp
*interp
,
848 Jim_Obj
*objPtr
, const char *str
);
849 JIM_EXPORT
int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
,
850 Jim_Obj
*secondObjPtr
, int nocase
);
851 JIM_EXPORT
int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
853 /* reference object */
854 JIM_EXPORT Jim_Obj
* Jim_NewReference (Jim_Interp
*interp
,
855 Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
);
856 JIM_EXPORT Jim_Reference
* Jim_GetReference (Jim_Interp
*interp
,
858 JIM_EXPORT
int Jim_SetFinalizer (Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
);
859 JIM_EXPORT
int Jim_GetFinalizer (Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
);
862 JIM_EXPORT Jim_Interp
* Jim_CreateInterp (void);
863 JIM_EXPORT
void Jim_FreeInterp (Jim_Interp
*i
);
864 JIM_EXPORT
int Jim_GetExitCode (Jim_Interp
*interp
);
865 JIM_EXPORT
const char *Jim_ReturnCode(int code
);
866 JIM_EXPORT
void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...);
869 JIM_EXPORT
void Jim_RegisterCoreCommands (Jim_Interp
*interp
);
870 JIM_EXPORT
int Jim_CreateCommand (Jim_Interp
*interp
,
871 const char *cmdName
, Jim_CmdProc cmdProc
, void *privData
,
872 Jim_DelCmdProc delProc
);
873 JIM_EXPORT
int Jim_DeleteCommand (Jim_Interp
*interp
,
874 const char *cmdName
);
875 JIM_EXPORT
int Jim_RenameCommand (Jim_Interp
*interp
,
876 const char *oldName
, const char *newName
);
877 JIM_EXPORT Jim_Cmd
* Jim_GetCommand (Jim_Interp
*interp
,
878 Jim_Obj
*objPtr
, int flags
);
879 JIM_EXPORT
int Jim_SetVariable (Jim_Interp
*interp
,
880 Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
);
881 JIM_EXPORT
int Jim_SetVariableStr (Jim_Interp
*interp
,
882 const char *name
, Jim_Obj
*objPtr
);
883 JIM_EXPORT
int Jim_SetGlobalVariableStr (Jim_Interp
*interp
,
884 const char *name
, Jim_Obj
*objPtr
);
885 JIM_EXPORT
int Jim_SetVariableStrWithStr (Jim_Interp
*interp
,
886 const char *name
, const char *val
);
887 JIM_EXPORT
int Jim_SetVariableLink (Jim_Interp
*interp
,
888 Jim_Obj
*nameObjPtr
, Jim_Obj
*targetNameObjPtr
,
889 Jim_CallFrame
*targetCallFrame
);
890 JIM_EXPORT Jim_Obj
* Jim_GetVariable (Jim_Interp
*interp
,
891 Jim_Obj
*nameObjPtr
, int flags
);
892 JIM_EXPORT Jim_Obj
* Jim_GetGlobalVariable (Jim_Interp
*interp
,
893 Jim_Obj
*nameObjPtr
, int flags
);
894 JIM_EXPORT Jim_Obj
* Jim_GetVariableStr (Jim_Interp
*interp
,
895 const char *name
, int flags
);
896 JIM_EXPORT Jim_Obj
* Jim_GetGlobalVariableStr (Jim_Interp
*interp
,
897 const char *name
, int flags
);
898 JIM_EXPORT
int Jim_UnsetVariable (Jim_Interp
*interp
,
899 Jim_Obj
*nameObjPtr
, int flags
);
902 JIM_EXPORT Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
,
903 Jim_Obj
*levelObjPtr
);
905 /* garbage collection */
906 JIM_EXPORT
int Jim_Collect (Jim_Interp
*interp
);
907 JIM_EXPORT
void Jim_CollectIfNeeded (Jim_Interp
*interp
);
910 JIM_EXPORT
int Jim_GetIndex (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
914 JIM_EXPORT Jim_Obj
* Jim_NewListObj (Jim_Interp
*interp
,
915 Jim_Obj
*const *elements
, int len
);
916 JIM_EXPORT
void Jim_ListInsertElements (Jim_Interp
*interp
,
917 Jim_Obj
*listPtr
, int listindex
, int objc
, Jim_Obj
*const *objVec
);
918 JIM_EXPORT
void Jim_ListAppendElement (Jim_Interp
*interp
,
919 Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
920 JIM_EXPORT
void Jim_ListAppendList (Jim_Interp
*interp
,
921 Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
);
922 JIM_EXPORT
int Jim_ListLength (Jim_Interp
*interp
, Jim_Obj
*objPtr
);
923 JIM_EXPORT
int Jim_ListIndex (Jim_Interp
*interp
, Jim_Obj
*listPrt
,
924 int listindex
, Jim_Obj
**objPtrPtr
, int seterr
);
925 JIM_EXPORT
int Jim_SetListIndex (Jim_Interp
*interp
,
926 Jim_Obj
*varNamePtr
, Jim_Obj
*const *indexv
, int indexc
,
928 JIM_EXPORT Jim_Obj
* Jim_ConcatObj (Jim_Interp
*interp
, int objc
,
929 Jim_Obj
*const *objv
);
932 JIM_EXPORT Jim_Obj
* Jim_NewDictObj (Jim_Interp
*interp
,
933 Jim_Obj
*const *elements
, int len
);
934 JIM_EXPORT
int Jim_DictKey (Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
935 Jim_Obj
*keyPtr
, Jim_Obj
**objPtrPtr
, int flags
);
936 JIM_EXPORT
int Jim_DictKeysVector (Jim_Interp
*interp
,
937 Jim_Obj
*dictPtr
, Jim_Obj
*const *keyv
, int keyc
,
938 Jim_Obj
**objPtrPtr
, int flags
);
939 JIM_EXPORT
int Jim_SetDictKeysVector (Jim_Interp
*interp
,
940 Jim_Obj
*varNamePtr
, Jim_Obj
*const *keyv
, int keyc
,
942 JIM_EXPORT
int Jim_DictPairs(Jim_Interp
*interp
,
943 Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
);
944 JIM_EXPORT
int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
945 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
);
946 JIM_EXPORT
int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObj
);
947 JIM_EXPORT
int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
949 /* return code object */
950 JIM_EXPORT
int Jim_GetReturnCode (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
953 /* expression object */
954 JIM_EXPORT
int Jim_EvalExpression (Jim_Interp
*interp
,
955 Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
);
956 JIM_EXPORT
int Jim_GetBoolFromExpr (Jim_Interp
*interp
,
957 Jim_Obj
*exprObjPtr
, int *boolPtr
);
960 JIM_EXPORT
int Jim_GetWide (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
962 JIM_EXPORT
int Jim_GetLong (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
964 #define Jim_NewWideObj Jim_NewIntObj
965 JIM_EXPORT Jim_Obj
* Jim_NewIntObj (Jim_Interp
*interp
,
969 JIM_EXPORT
int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
971 JIM_EXPORT
void Jim_SetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
973 JIM_EXPORT Jim_Obj
* Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
);
976 JIM_EXPORT
const char * Jim_GetSharedString (Jim_Interp
*interp
,
978 JIM_EXPORT
void Jim_ReleaseSharedString (Jim_Interp
*interp
,
981 /* commands utilities */
982 JIM_EXPORT
void Jim_WrongNumArgs (Jim_Interp
*interp
, int argc
,
983 Jim_Obj
*const *argv
, const char *msg
);
984 JIM_EXPORT
int Jim_GetEnum (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
985 const char * const *tablePtr
, int *indexPtr
, const char *name
, int flags
);
986 JIM_EXPORT
int Jim_ScriptIsComplete (const char *s
, int len
,
989 * Find a matching name in the array of the given length.
991 * NULL entries are ignored.
993 * Returns the matching index if found, or -1 if not.
995 JIM_EXPORT
int Jim_FindByName(const char *name
, const char * const array
[], size_t len
);
997 /* package utilities */
998 typedef void (Jim_InterpDeleteProc
)(Jim_Interp
*interp
, void *data
);
999 JIM_EXPORT
void * Jim_GetAssocData(Jim_Interp
*interp
, const char *key
);
1000 JIM_EXPORT
int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
,
1001 Jim_InterpDeleteProc
*delProc
, void *data
);
1002 JIM_EXPORT
int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
);
1004 /* Packages C API */
1006 JIM_EXPORT
int Jim_PackageProvide (Jim_Interp
*interp
,
1007 const char *name
, const char *ver
, int flags
);
1008 JIM_EXPORT
int Jim_PackageRequire (Jim_Interp
*interp
,
1009 const char *name
, int flags
);
1011 /* error messages */
1012 JIM_EXPORT
void Jim_MakeErrorMessage (Jim_Interp
*interp
);
1014 /* interactive mode */
1015 JIM_EXPORT
int Jim_InteractivePrompt (Jim_Interp
*interp
);
1018 JIM_EXPORT
int Jim_InitStaticExtensions(Jim_Interp
*interp
);
1019 JIM_EXPORT
int Jim_StringToWide(const char *str
, jim_wide
*widePtr
, int base
);
1022 JIM_EXPORT
int Jim_LoadLibrary(Jim_Interp
*interp
, const char *pathName
);
1023 JIM_EXPORT
void Jim_FreeLoadHandles(Jim_Interp
*interp
);
1026 JIM_EXPORT
FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*command
);
1029 /* type inspection - avoid where possible */
1030 JIM_EXPORT
int Jim_IsDict(Jim_Obj
*objPtr
);
1031 JIM_EXPORT
int Jim_IsList(Jim_Obj
*objPtr
);
1037 #endif /* __JIM__H */
1040 * Local Variables: ***
1041 * c-basic-offset: 4 ***
1045 /* Provides a common approach to implementing Tcl commands
1046 * which implement subcommands
1048 #ifndef JIM_SUBCMD_H
1049 #define JIM_SUBCMD_H
1052 #define JIM_MODFLAG_HIDDEN 0x0001 /* Don't show the subcommand in usage or commands */
1053 #define JIM_MODFLAG_FULLARGV 0x0002 /* Subcmd proc gets called with full argv */
1055 /* Custom flags start at 0x0100 */
1058 * Returns JIM_OK if OK, JIM_ERR (etc.) on error, break, continue, etc.
1059 * Returns -1 if invalid args.
1061 typedef int tclmod_cmd_function(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1064 const char *cmd
; /* Name of the (sub)command */
1065 const char *args
; /* Textual description of allowed args */
1066 tclmod_cmd_function
*function
; /* Function implementing the subcommand */
1067 short minargs
; /* Minimum required arguments */
1068 short maxargs
; /* Maximum allowed arguments or -1 if no limit */
1069 unsigned flags
; /* JIM_MODFLAG_... plus custom flags */
1070 const char *description
; /* Description of the subcommand */
1074 * Looks up the appropriate subcommand in the given command table and return
1075 * the command function which implements the subcommand.
1076 * NULL will be returned and an appropriate error will be set if the subcommand or
1077 * arguments are invalid.
1081 * const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, command_table, argc, argv);
1083 * return Jim_CallSubCmd(interp, ct, argc, argv);
1087 const jim_subcmd_type
*
1088 Jim_ParseSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
*command_table
, int argc
, Jim_Obj
*const *argv
);
1091 * Parses the args against the given command table and executes the subcommand if found
1092 * or sets an appropriate error if the subcommand or arguments is invalid.
1094 * Can be used directly with Jim_CreateCommand() where the ClientData is the command table.
1096 * e.g. Jim_CreateCommand(interp, "mycmd", Jim_SubCmdProc, command_table, NULL);
1098 int Jim_SubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1101 * Invokes the given subcmd with the given args as returned
1102 * by Jim_ParseSubCmd()
1104 * If ct is NULL, returns JIM_ERR, leaving any message.
1105 * Otherwise invokes ct->function
1107 * If ct->function returns -1, sets an error message and returns JIM_ERR.
1108 * Otherwise returns the result of ct->function.
1110 int Jim_CallSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
*ct
, int argc
, Jim_Obj
*const *argv
);
1113 * Standard processing for a command.
1115 * This does the '-help' and '-usage' check and the number of args checks.
1116 * for a top level command against a single 'jim_subcmd_type' structure.
1118 * Additionally, if command_table->function is set, it should point to a sub command table
1119 * and '-subhelp ?subcmd?', '-subusage' and '-subcommands' are then also recognised.
1121 * Returns 0 if user requested usage, -1 on arg error, 1 if OK to process.
1124 Jim_CheckCmdUsage(Jim_Interp
*interp
, const jim_subcmd_type
*command_table
, int argc
, Jim_Obj
*const *argv
);
1130 #ifndef _JIMAUTOCONF_H
1131 #error Need jimautoconf.h
1134 #if defined(HAVE_REGCOMP) && !defined(JIM_REGEXP)
1135 /* Use POSIX regex */
1143 * Definitions etc. for regexp(3) routines.
1145 * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
1146 * not the System V one.
1148 * 11/04/02 (seiwald) - const-ing for string literals
1157 * The "internal use only" fields in regexp.h are present to pass info from
1158 * compile to execute that permits the execute phase to run lots faster on
1159 * simple cases. They are:
1161 * regstart char that must begin a match; '\0' if none obvious
1162 * reganch is the match anchored (at beginning-of-line only)?
1163 * regmust string (pointer into program) that match must include, or NULL
1164 * regmlen length of regmust string
1166 * Regstart and reganch permit very fast decisions on suitable starting points
1167 * for a match, cutting down the work a lot. Regmust permits fast rejection
1168 * of lines that cannot possibly match. The regmust tests are costly enough
1169 * that regcomp() supplies a regmust only if the r.e. contains something
1170 * potentially expensive (at present, the only such thing detected is * or +
1171 * at the start of the r.e., which can involve a lot of backup). Regmlen is
1172 * supplied because the test in regexec() needs it and regcomp() is computing
1176 typedef struct regexp
{
1178 int re_nsub
; /* number of parenthesized subexpressions */
1181 int cflags
; /* Flags used when compiling */
1182 int err
; /* Any error which occurred during compile */
1183 int regstart
; /* Internal use only. */
1184 int reganch
; /* Internal use only. */
1185 int regmust
; /* Internal use only. */
1186 int regmlen
; /* Internal use only. */
1187 int *program
; /* Allocated */
1189 /* working state - compile */
1190 const char *regparse
; /* Input-scan pointer. */
1191 int p
; /* Current output pos in program */
1192 int proglen
; /* Allocated program size */
1194 /* working state - exec */
1195 int eflags
; /* Flags used when executing */
1196 const char *start
; /* Initial string pointer. */
1197 const char *reginput
; /* Current input pointer. */
1198 const char *regbol
; /* Beginning of input, for ^ check. */
1200 /* Input to regexec() */
1201 regmatch_t
*pmatch
; /* submatches will be stored here */
1202 int nmatch
; /* size of pmatch[] */
1205 typedef regexp regex_t
;
1207 #define REG_EXTENDED 0
1208 #define REG_NEWLINE 1
1211 #define REG_NOTBOL 16
1214 REG_NOERROR
, /* Success. */
1215 REG_NOMATCH
, /* Didn't find a match (for regexec). */
1216 REG_BADPAT
, /* >= REG_BADPAT is an error */
1217 REG_ERR_NULL_ARGUMENT
,
1221 REG_ERR_TOO_MANY_PAREN
,
1222 REG_ERR_UNMATCHED_PAREN
,
1223 REG_ERR_UNMATCHED_BRACES
,
1225 REG_ERR_JUNK_ON_END
,
1226 REG_ERR_OPERAND_COULD_BE_EMPTY
,
1227 REG_ERR_NESTED_COUNT
,
1229 REG_ERR_COUNT_FOLLOWS_NOTHING
,
1230 REG_ERR_TRAILING_BACKSLASH
,
1236 int regcomp(regex_t
*preg
, const char *regex
, int cflags
);
1237 int regexec(regex_t
*preg
, const char *string
, size_t nmatch
, regmatch_t pmatch
[], int eflags
);
1238 size_t regerror(int errcode
, const regex_t
*preg
, char *errbuf
, size_t errbuf_size
);
1239 void regfree(regex_t
*preg
);
1244 int Jim_bootstrapInit(Jim_Interp
*interp
)
1246 if (Jim_PackageProvide(interp
, "bootstrap", "1.0", JIM_ERRMSG
))
1249 return Jim_Eval_Named(interp
,
1252 "proc package {args} {}\n"
1253 ,"bootstrap.tcl", 1);
1255 int Jim_globInit(Jim_Interp
*interp
)
1257 if (Jim_PackageProvide(interp
, "glob", "1.0", JIM_ERRMSG
))
1260 return Jim_Eval_Named(interp
,
1267 "package require readdir\n"
1280 "proc glob {args} {\n"
1285 " local proc glob.readdir_pattern {dir pattern} {\n"
1289 " if {$pattern in {. ..}} {\n"
1290 " return $pattern\n"
1294 " if {[string match {*[*?]*} $pattern]} {\n"
1296 " set files [readdir -nocomplain $dir]\n"
1297 " } elseif {[file isdir $dir] && [file exists $dir/$pattern]} {\n"
1298 " set files [list $pattern]\n"
1303 " foreach name $files {\n"
1304 " if {[string match $pattern $name]} {\n"
1306 " if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n"
1309 " lappend result $name\n"
1320 " proc glob.expandbraces {pattern} {\n"
1323 " if {[set fb [string first \"\\{\" $pattern]] < 0} {\n"
1324 " return $pattern\n"
1326 " if {[set nb [string first \"\\}\" $pattern $fb]] < 0} {\n"
1327 " return $pattern\n"
1329 " set before [string range $pattern 0 $fb-1]\n"
1330 " set braced [string range $pattern $fb+1 $nb-1]\n"
1331 " set after [string range $pattern $nb+1 end]\n"
1333 " lmap part [split $braced ,] {\n"
1334 " set pat $before$part$after\n"
1339 " proc glob.glob {pattern} {\n"
1340 " set dir [file dirname $pattern]\n"
1341 " if {$dir eq $pattern} {\n"
1343 " return [list $dir]\n"
1347 " set dirlist [glob.glob $dir]\n"
1348 " set pattern [file tail $pattern]\n"
1352 " foreach dir $dirlist {\n"
1353 " set globdir $dir\n"
1354 " if {[string match \"*/\" $dir]} {\n"
1356 " } elseif {$dir eq \".\"} {\n"
1357 " set globdir \"\"\n"
1362 " foreach pat [glob.expandbraces $pattern] {\n"
1363 " foreach name [glob.readdir_pattern $dir $pat] {\n"
1364 " lappend result $globdir$sep$name\n"
1372 " set nocomplain 0\n"
1374 " if {[lindex $args 0] eq \"-nocomplain\"} {\n"
1375 " set nocomplain 1\n"
1376 " set args [lrange $args 1 end]\n"
1380 " foreach pattern $args {\n"
1381 " lappend result {*}[glob.glob $pattern]\n"
1384 " if {$nocomplain == 0 && [llength $result] == 0} {\n"
1385 " return -code error \"no files matched glob patterns\"\n"
1392 int Jim_stdlibInit(Jim_Interp
*interp
)
1394 if (Jim_PackageProvide(interp
, "stdlib", "1.0", JIM_ERRMSG
))
1397 return Jim_Eval_Named(interp
,
1401 "proc alias {name args} {\n"
1402 " set prefix $args\n"
1403 " proc $name args prefix {\n"
1404 " tailcall {*}$prefix {*}$args\n"
1409 "proc lambda {arglist args} {\n"
1410 " set name [ref {} function lambda.finalizer]\n"
1411 " tailcall proc $name $arglist {*}$args\n"
1414 "proc lambda.finalizer {name val} {\n"
1415 " rename $name {}\n"
1419 "proc curry {args} {\n"
1420 " set prefix $args\n"
1421 " lambda args prefix {\n"
1422 " tailcall {*}$prefix {*}$args\n"
1434 "proc function {value} {\n"
1439 "proc lassign {list args} {\n"
1441 " lappend list {}\n"
1442 " uplevel 1 [list foreach $args $list break]\n"
1443 " lrange $list [llength $args] end-1\n"
1449 "proc stacktrace {} {\n"
1451 " foreach level [range 1 [info level]] {\n"
1452 " lassign [info frame -$level] p f l\n"
1453 " lappend trace $p $f $l\n"
1459 "proc stackdump {stacktrace} {\n"
1462 " foreach {l f p} [lreverse $stacktrace] {\n"
1464 " append result \\n\n"
1467 " if {$p ne \"\"} {\n"
1468 " append result \"in procedure '$p' \"\n"
1469 " if {$f ne \"\"} {\n"
1470 " append result \"called \"\n"
1473 " if {$f ne \"\"} {\n"
1474 " append result \"at file \\\"$f\\\", line $l\"\n"
1482 "proc errorInfo {msg {stacktrace \"\"}} {\n"
1483 " if {$stacktrace eq \"\"} {\n"
1484 " set stacktrace [info stacktrace]\n"
1486 " lassign $stacktrace p f l\n"
1487 " if {$f ne \"\"} {\n"
1488 " set result \"Runtime Error: $f:$l: \"\n"
1490 " append result \"$msg\\n\"\n"
1491 " append result [stackdump $stacktrace]\n"
1494 " string trim $result\n"
1499 "proc {info nameofexecutable} {} {\n"
1500 " if {[info exists ::jim_argv0]} {\n"
1501 " if {[string first \"/\" $::jim_argv0] >= 0} {\n"
1502 " return $::jim_argv0\n"
1504 " foreach path [split [env PATH \"\"] :] {\n"
1505 " set exec [file join $path $::jim_argv0]\n"
1506 " if {[file executable $exec]} {\n"
1515 "proc {dict with} {dictVar args script} {\n"
1516 " upvar $dictVar dict\n"
1518 " foreach {n v} [dict get $dict {*}$args] {\n"
1519 " upvar $n var_$n\n"
1521 " lappend keys $n\n"
1523 " catch {uplevel 1 $script} msg opts\n"
1524 " if {[info exists dict] && [dict exists $dict {*}$args]} {\n"
1525 " foreach n $keys {\n"
1526 " if {[info exists var_$n]} {\n"
1527 " dict set dict {*}$args $n [set var_$n]\n"
1529 " dict unset dict {*}$args $n\n"
1533 " return {*}$opts $msg\n"
1538 "proc {dict merge} {dict args} {\n"
1539 " foreach d $args {\n"
1542 " foreach {k v} $d {\n"
1543 " dict set dict $k $v\n"
1550 int Jim_tclcompatInit(Jim_Interp
*interp
)
1552 if (Jim_PackageProvide(interp
, "tclcompat", "1.0", JIM_ERRMSG
))
1555 return Jim_Eval_Named(interp
,
1565 "if {[info commands stdout] ne \"\"} {\n"
1567 " foreach p {gets flush close eof seek tell} {\n"
1568 " proc $p {chan args} {p} {\n"
1569 " tailcall $chan $p {*}$args\n"
1576 " proc puts {{-nonewline {}} {chan stdout} msg} {\n"
1577 " if {${-nonewline} ni {-nonewline {}}} {\n"
1578 " tailcall ${-nonewline} puts $msg\n"
1580 " tailcall $chan puts {*}${-nonewline} $msg\n"
1587 " proc read {{-nonewline {}} chan} {\n"
1588 " if {${-nonewline} ni {-nonewline {}}} {\n"
1589 " tailcall ${-nonewline} read {*}${chan}\n"
1591 " tailcall $chan read {*}${-nonewline}\n"
1594 " proc fconfigure {f args} {\n"
1595 " foreach {n v} $args {\n"
1596 " switch -glob -- $n {\n"
1601 " $f buffering $v\n"
1607 " return -code error \"fconfigure: unknown option $n\"\n"
1615 "proc case {var args} {\n"
1617 " if {[lindex $args 0] eq \"in\"} {\n"
1618 " set args [lrange $args 1 end]\n"
1622 " if {[llength $args] == 1} {\n"
1623 " set args [lindex $args 0]\n"
1627 " if {[llength $args] % 2 != 0} {\n"
1628 " return -code error \"extra case pattern with no body\"\n"
1632 " local proc case.checker {value pattern} {\n"
1633 " string match $pattern $value\n"
1636 " foreach {value action} $args {\n"
1637 " if {$value eq \"default\"} {\n"
1638 " set do_action $action\n"
1640 " } elseif {[lsearch -bool -command case.checker $value $var]} {\n"
1641 " set do_action $action\n"
1646 " if {[info exists do_action]} {\n"
1647 " set rc [catch [list uplevel 1 $do_action] result opts]\n"
1649 " incr opts(-level)\n"
1651 " return {*}$opts $result\n"
1656 "proc fileevent {args} {\n"
1657 " tailcall {*}$args\n"
1663 "proc parray {arrayname {pattern *} {puts puts}} {\n"
1664 " upvar $arrayname a\n"
1667 " foreach name [array names a $pattern]] {\n"
1668 " if {[string length $name] > $max} {\n"
1669 " set max [string length $name]\n"
1672 " incr max [string length $arrayname]\n"
1674 " foreach name [lsort [array names a $pattern]] {\n"
1675 " $puts [format \"%-${max}s = %s\" $arrayname\\($name\\) $a($name)]\n"
1680 "proc {file copy} {{force {}} source target} {\n"
1682 " if {$force ni {{} -force}} {\n"
1683 " error \"bad option \\\"$force\\\": should be -force\"\n"
1686 " set in [open $source]\n"
1688 " if {$force eq \"\" && [file exists $target]} {\n"
1690 " error \"error copying \\\"$source\\\" to \\\"$target\\\": file already exists\"\n"
1692 " set out [open $target w]\n"
1693 " $in copyto $out\n"
1695 " } on error {msg opts} {\n"
1696 " incr opts(-level)\n"
1697 " return {*}$opts $msg\n"
1699 " catch {$in close}\n"
1705 "proc popen {cmd {mode r}} {\n"
1706 " lassign [socket pipe] r w\n"
1708 " if {[string match \"w*\" $mode]} {\n"
1709 " lappend cmd <@$r &\n"
1710 " set pids [exec {*}$cmd]\n"
1714 " lappend cmd >@$w &\n"
1715 " set pids [exec {*}$cmd]\n"
1719 " lambda {cmd args} {f pids} {\n"
1720 " if {$cmd eq \"pid\"} {\n"
1723 " if {$cmd eq \"close\"} {\n"
1726 " foreach p $pids { os.wait $p }\n"
1729 " tailcall $f $cmd {*}$args\n"
1731 " } on error {error opts} {\n"
1739 "local proc pid {{chan {}}} {\n"
1740 " if {$chan eq \"\"} {\n"
1741 " tailcall upcall pid\n"
1743 " if {[catch {$chan tell}]} {\n"
1744 " return -code error \"can not find channel named \\\"$chan\\\"\"\n"
1746 " if {[catch {$chan pid} pids]} {\n"
1765 "proc try {args} {\n"
1766 " set catchopts {}\n"
1767 " while {[string match -* [lindex $args 0]]} {\n"
1768 " set args [lassign $args opt]\n"
1769 " if {$opt eq \"--\"} {\n"
1772 " lappend catchopts $opt\n"
1774 " if {[llength $args] == 0} {\n"
1775 " return -code error {wrong # args: should be \"try ?options? script ?argument ...?\"}\n"
1777 " set args [lassign $args script]\n"
1778 " set code [catch -eval {*}$catchopts [list uplevel 1 $script] msg opts]\n"
1782 " foreach {on codes vars script} $args {\n"
1783 " switch -- $on \\\n"
1785 " if {!$handled && ($codes eq \"*\" || [info returncode $code] in $codes)} {\n"
1786 " lassign $vars msgvar optsvar\n"
1787 " if {$msgvar ne \"\"} {\n"
1788 " upvar $msgvar hmsg\n"
1791 " if {$optsvar ne \"\"} {\n"
1792 " upvar $optsvar hopts\n"
1793 " set hopts $opts\n"
1796 " set code [catch [list uplevel 1 $script] msg opts]\n"
1801 " set finalcode [catch [list uplevel 1 $codes] finalmsg finalopts]\n"
1802 " if {$finalcode} {\n"
1804 " set code $finalcode\n"
1805 " set msg $finalmsg\n"
1806 " set opts $finalopts\n"
1811 " return -code error \"try: expected 'on' or 'finally', got '$on'\"\n"
1816 " incr opts(-level)\n"
1817 " return {*}$opts $msg\n"
1824 "proc throw {code {msg \"\"}} {\n"
1825 " return -code $code $msg\n"
1829 "proc {file delete force} {path} {\n"
1830 " foreach e [readdir $path] {\n"
1831 " file delete -force $path/$e\n"
1833 " file delete $path\n"
1835 ,"tclcompat.tcl", 1);
1838 /* Jim - A small embeddable Tcl interpreter
1840 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
1841 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
1842 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
1843 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
1844 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
1845 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
1846 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
1848 * Redistribution and use in source and binary forms, with or without
1849 * modification, are permitted provided that the following conditions
1852 * 1. Redistributions of source code must retain the above copyright
1853 * notice, this list of conditions and the following disclaimer.
1854 * 2. Redistributions in binary form must reproduce the above
1855 * copyright notice, this list of conditions and the following
1856 * disclaimer in the documentation and/or other materials
1857 * provided with the distribution.
1859 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
1860 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
1861 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
1862 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1863 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
1864 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1865 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1866 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1867 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1868 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
1869 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
1870 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1872 * The views and conclusions contained in the software and documentation
1873 * are those of the authors and should not be interpreted as representing
1874 * official policies, either expressed or implied, of the Jim Tcl Project.
1884 #if defined(HAVE_SYS_SOCKET_H) && defined(HAVE_SELECT) && defined(HAVE_NETINET_IN_H) && defined(HAVE_NETDB_H) && defined(HAVE_ARPA_INET_H)
1885 #include <sys/socket.h>
1886 #include <netinet/in.h>
1887 #include <arpa/inet.h>
1889 #ifdef HAVE_SYS_UN_H
1897 #define AIO_CMD_LEN 32 /* e.g. aio.handleXXXXXX */
1898 #define AIO_BUF_LEN 256 /* Can keep this small and rely on stdio buffering */
1900 #define AIO_KEEPOPEN 1
1902 #if defined(JIM_IPV6)
1912 union sockaddr_any
{
1914 struct sockaddr_in sin
;
1916 struct sockaddr_in6 sin6
;
1920 #ifndef HAVE_INET_NTOP
1921 const char *inet_ntop(int af
, const void *src
, char *dst
, int size
)
1923 if (af
!= PF_INET
) {
1926 snprintf(dst
, size
, "%s", inet_ntoa(((struct sockaddr_in
*)src
)->sin_addr
));
1932 typedef struct AioFile
1937 int OpenFlags
; /* AIO_KEEPOPEN? keep FILE* */
1950 static int JimAioSubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1953 static int JimParseIPv6Address(Jim_Interp
*interp
, const char *hostport
, union sockaddr_any
*sa
, int *salen
)
1957 * An IPv6 addr/port looks like:
1960 * [fe80::223:6cff:fe95:bdc0%en1]:2000
1964 * Note that the "any" address is ::, which is the same as when no address is specified.
1966 char *sthost
= NULL
;
1969 struct addrinfo req
;
1970 struct addrinfo
*ai
;
1972 stport
= strrchr(hostport
, ':');
1974 /* No : so, the whole thing is the port */
1977 sthost
= Jim_StrDup(hostport
);
1983 if (*hostport
== '[') {
1984 /* This is a numeric ipv6 address */
1985 char *pt
= strchr(++hostport
, ']');
1987 sthost
= Jim_StrDupLen(hostport
, pt
- hostport
);
1992 sthost
= Jim_StrDupLen(hostport
, stport
- hostport
- 1);
1995 memset(&req
, '\0', sizeof(req
));
1996 req
.ai_family
= PF_INET6
;
1998 if (getaddrinfo(sthost
, NULL
, &req
, &ai
)) {
1999 Jim_SetResultFormatted(interp
, "Not a valid address: %s", hostport
);
2003 memcpy(&sa
->sin
, ai
->ai_addr
, ai
->ai_addrlen
);
2004 *salen
= ai
->ai_addrlen
;
2006 sa
->sin
.sin_port
= htons(atoi(stport
));
2014 Jim_SetResultString(interp
, "ipv6 not supported", -1);
2019 static int JimParseIpAddress(Jim_Interp
*interp
, const char *hostport
, union sockaddr_any
*sa
, int *salen
)
2021 /* An IPv4 addr/port looks like:
2026 * If the address is missing, INADDR_ANY is used.
2027 * If the port is missing, 0 is used (only useful for server sockets).
2029 char *sthost
= NULL
;
2033 stport
= strrchr(hostport
, ':');
2035 /* No : so, the whole thing is the port */
2037 sthost
= Jim_StrDup("0.0.0.0");
2040 sthost
= Jim_StrDupLen(hostport
, stport
- hostport
);
2045 #ifdef HAVE_GETADDRINFO
2046 struct addrinfo req
;
2047 struct addrinfo
*ai
;
2048 memset(&req
, '\0', sizeof(req
));
2049 req
.ai_family
= PF_INET
;
2051 if (getaddrinfo(sthost
, NULL
, &req
, &ai
)) {
2055 memcpy(&sa
->sin
, ai
->ai_addr
, ai
->ai_addrlen
);
2056 *salen
= ai
->ai_addrlen
;
2064 if ((he
= gethostbyname(sthost
)) != NULL
) {
2065 if (he
->h_length
== sizeof(sa
->sin
.sin_addr
)) {
2066 *salen
= sizeof(sa
->sin
);
2067 sa
->sin
.sin_family
= he
->h_addrtype
;
2068 memcpy(&sa
->sin
.sin_addr
, he
->h_addr
, he
->h_length
); /* set address */
2074 sa
->sin
.sin_port
= htons(atoi(stport
));
2078 if (ret
!= JIM_OK
) {
2079 Jim_SetResultFormatted(interp
, "Not a valid address: %s", hostport
);
2085 #ifdef HAVE_SYS_UN_H
2086 static int JimParseDomainAddress(Jim_Interp
*interp
, const char *path
, struct sockaddr_un
*sa
)
2088 sa
->sun_family
= PF_UNIX
;
2089 snprintf(sa
->sun_path
, sizeof(sa
->sun_path
), "%s", path
);
2096 static void JimAioSetError(Jim_Interp
*interp
, Jim_Obj
*name
)
2099 Jim_SetResultFormatted(interp
, "%#s: %s", name
, strerror(errno
));
2102 Jim_SetResultString(interp
, strerror(errno
), -1);
2106 static void JimAioDelProc(Jim_Interp
*interp
, void *privData
)
2108 AioFile
*af
= privData
;
2110 JIM_NOTUSED(interp
);
2112 Jim_DecrRefCount(interp
, af
->filename
);
2114 if (!(af
->OpenFlags
& AIO_KEEPOPEN
)) {
2117 #ifdef jim_ext_eventloop
2118 /* remove existing EventHandlers */
2120 Jim_DeleteFileHandler(interp
, af
->fp
);
2123 Jim_DeleteFileHandler(interp
, af
->fp
);
2126 Jim_DeleteFileHandler(interp
, af
->fp
);
2132 static int aio_cmd_read(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2134 AioFile
*af
= Jim_CmdPrivData(interp
);
2135 char buf
[AIO_BUF_LEN
];
2138 int neededLen
= -1; /* -1 is "read as much as possible" */
2140 if (argc
&& Jim_CompareStringImmediate(interp
, argv
[0], "-nonewline")) {
2148 if (Jim_GetWide(interp
, argv
[0], &wideValue
) != JIM_OK
)
2150 if (wideValue
< 0) {
2151 Jim_SetResultString(interp
, "invalid parameter: negative len", -1);
2154 neededLen
= (int)wideValue
;
2159 objPtr
= Jim_NewStringObj(interp
, NULL
, 0);
2160 while (neededLen
!= 0) {
2164 if (neededLen
== -1) {
2165 readlen
= AIO_BUF_LEN
;
2168 readlen
= (neededLen
> AIO_BUF_LEN
? AIO_BUF_LEN
: neededLen
);
2170 retval
= fread(buf
, 1, readlen
, af
->fp
);
2172 Jim_AppendString(interp
, objPtr
, buf
, retval
);
2173 if (neededLen
!= -1) {
2174 neededLen
-= retval
;
2177 if (retval
!= readlen
)
2180 /* Check for error conditions */
2181 if (ferror(af
->fp
)) {
2183 /* eof and EAGAIN are not error conditions */
2184 if (!feof(af
->fp
) && errno
!= EAGAIN
) {
2186 Jim_FreeNewObj(interp
, objPtr
);
2187 JimAioSetError(interp
, af
->filename
);
2193 const char *s
= Jim_GetString(objPtr
, &len
);
2195 if (len
> 0 && s
[len
- 1] == '\n') {
2197 objPtr
->bytes
[objPtr
->length
] = '\0';
2200 Jim_SetResult(interp
, objPtr
);
2204 static int aio_cmd_copy(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2206 AioFile
*af
= Jim_CmdPrivData(interp
);
2208 long maxlen
= LONG_MAX
;
2209 FILE *outfh
= Jim_AioFilehandle(interp
, argv
[0]);
2211 if (outfh
== NULL
) {
2216 if (Jim_GetLong(interp
, argv
[1], &maxlen
) != JIM_OK
) {
2221 while (count
< maxlen
) {
2222 int ch
= fgetc(af
->fp
);
2224 if (ch
== EOF
|| fputc(ch
, outfh
) == EOF
) {
2230 if (ferror(af
->fp
)) {
2231 Jim_SetResultFormatted(interp
, "error while reading: %s", strerror(errno
));
2236 if (ferror(outfh
)) {
2237 Jim_SetResultFormatted(interp
, "error while writing: %s", strerror(errno
));
2242 Jim_SetResultInt(interp
, count
);
2247 static int aio_cmd_gets(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2249 AioFile
*af
= Jim_CmdPrivData(interp
);
2250 char buf
[AIO_BUF_LEN
];
2255 objPtr
= Jim_NewStringObj(interp
, NULL
, 0);
2259 buf
[AIO_BUF_LEN
- 1] = '_';
2260 if (fgets(buf
, AIO_BUF_LEN
, af
->fp
) == NULL
)
2262 if (buf
[AIO_BUF_LEN
- 1] == '\0' && buf
[AIO_BUF_LEN
- 2] != '\n')
2265 Jim_AppendString(interp
, objPtr
, buf
, AIO_BUF_LEN
- 1);
2268 int len
= strlen(buf
);
2271 int hasnl
= (buf
[len
- 1] == '\n');
2274 Jim_AppendString(interp
, objPtr
, buf
, strlen(buf
) - hasnl
);
2280 if (ferror(af
->fp
) && errno
!= EAGAIN
&& errno
!= EINTR
) {
2282 Jim_FreeNewObj(interp
, objPtr
);
2283 JimAioSetError(interp
, af
->filename
);
2287 /* On EOF returns -1 if varName was specified, or the empty string. */
2288 if (feof(af
->fp
) && Jim_Length(objPtr
) == 0) {
2289 Jim_FreeNewObj(interp
, objPtr
);
2291 Jim_SetResultInt(interp
, -1);
2298 Jim_GetString(objPtr
, &totLen
);
2299 if (Jim_SetVariable(interp
, argv
[0], objPtr
) != JIM_OK
) {
2300 Jim_FreeNewObj(interp
, objPtr
);
2303 Jim_SetResultInt(interp
, totLen
);
2306 Jim_SetResult(interp
, objPtr
);
2311 static int aio_cmd_puts(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2313 AioFile
*af
= Jim_CmdPrivData(interp
);
2319 if (!Jim_CompareStringImmediate(interp
, argv
[0], "-nonewline")) {
2328 wdata
= Jim_GetString(strObj
, &wlen
);
2329 if (fwrite(wdata
, 1, wlen
, af
->fp
) == (unsigned)wlen
) {
2330 if (argc
== 2 || putc('\n', af
->fp
) != EOF
) {
2334 JimAioSetError(interp
, af
->filename
);
2339 static int aio_cmd_recvfrom(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2341 AioFile
*af
= Jim_CmdPrivData(interp
);
2343 union sockaddr_any sa
;
2345 socklen_t salen
= sizeof(sa
);
2348 if (Jim_GetLong(interp
, argv
[0], &len
) != JIM_OK
) {
2352 buf
= Jim_Alloc(len
+ 1);
2354 rlen
= recvfrom(fileno(af
->fp
), buf
, len
, 0, &sa
.sa
, &salen
);
2357 JimAioSetError(interp
, NULL
);
2361 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, rlen
));
2364 /* INET6_ADDRSTRLEN is 46. Add some for [] and port */
2368 if (sa
.sa
.sa_family
== PF_INET6
) {
2370 /* Allow 9 for []:65535\0 */
2371 inet_ntop(sa
.sa
.sa_family
, &sa
.sin6
.sin6_addr
, addrbuf
+ 1, sizeof(addrbuf
) - 9);
2372 snprintf(addrbuf
+ strlen(addrbuf
), 8, "]:%d", ntohs(sa
.sin
.sin_port
));
2377 /* Allow 7 for :65535\0 */
2378 inet_ntop(sa
.sa
.sa_family
, &sa
.sin
.sin_addr
, addrbuf
, sizeof(addrbuf
) - 7);
2379 snprintf(addrbuf
+ strlen(addrbuf
), 7, ":%d", ntohs(sa
.sin
.sin_port
));
2382 if (Jim_SetVariable(interp
, argv
[1], Jim_NewStringObj(interp
, addrbuf
, -1)) != JIM_OK
) {
2391 static int aio_cmd_sendto(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2393 AioFile
*af
= Jim_CmdPrivData(interp
);
2397 union sockaddr_any sa
;
2398 const char *addr
= Jim_String(argv
[1]);
2401 if (IPV6
&& af
->addr_family
== PF_INET6
) {
2402 if (JimParseIPv6Address(interp
, addr
, &sa
, &salen
) != JIM_OK
) {
2406 else if (JimParseIpAddress(interp
, addr
, &sa
, &salen
) != JIM_OK
) {
2409 wdata
= Jim_GetString(argv
[0], &wlen
);
2411 /* Note that we don't validate the socket type. Rely on sendto() failing if appropriate */
2412 len
= sendto(fileno(af
->fp
), wdata
, wlen
, 0, &sa
.sa
, salen
);
2414 JimAioSetError(interp
, NULL
);
2417 Jim_SetResultInt(interp
, len
);
2421 static int aio_cmd_accept(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2423 AioFile
*serv_af
= Jim_CmdPrivData(interp
);
2425 union sockaddr_any sa
;
2426 socklen_t addrlen
= sizeof(sa
);
2428 char buf
[AIO_CMD_LEN
];
2430 sock
= accept(serv_af
->fd
, &sa
.sa
, &addrlen
);
2434 /* Create the file command */
2435 af
= Jim_Alloc(sizeof(*af
));
2438 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2440 af
->filename
= Jim_NewStringObj(interp
, "accept", -1);
2441 Jim_IncrRefCount(af
->filename
);
2442 af
->fp
= fdopen(sock
, "r+");
2446 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2451 af
->addr_family
= serv_af
->addr_family
;
2452 snprintf(buf
, sizeof(buf
), "aio.sockstream%ld", Jim_GetId(interp
));
2453 Jim_CreateCommand(interp
, buf
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2454 Jim_SetResultString(interp
, buf
, -1);
2460 static int aio_cmd_flush(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2462 AioFile
*af
= Jim_CmdPrivData(interp
);
2464 if (fflush(af
->fp
) == EOF
) {
2465 JimAioSetError(interp
, af
->filename
);
2471 static int aio_cmd_eof(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2473 AioFile
*af
= Jim_CmdPrivData(interp
);
2475 Jim_SetResultInt(interp
, feof(af
->fp
));
2479 static int aio_cmd_close(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2481 Jim_DeleteCommand(interp
, Jim_String(argv
[0]));
2485 static int aio_cmd_seek(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2487 AioFile
*af
= Jim_CmdPrivData(interp
);
2488 int orig
= SEEK_SET
;
2492 if (Jim_CompareStringImmediate(interp
, argv
[1], "start"))
2494 else if (Jim_CompareStringImmediate(interp
, argv
[1], "current"))
2496 else if (Jim_CompareStringImmediate(interp
, argv
[1], "end"))
2502 if (Jim_GetLong(interp
, argv
[0], &offset
) != JIM_OK
) {
2505 if (fseek(af
->fp
, offset
, orig
) == -1) {
2506 JimAioSetError(interp
, af
->filename
);
2512 static int aio_cmd_tell(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2514 AioFile
*af
= Jim_CmdPrivData(interp
);
2516 Jim_SetResultInt(interp
, ftell(af
->fp
));
2520 static int aio_cmd_filename(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2522 AioFile
*af
= Jim_CmdPrivData(interp
);
2524 Jim_SetResult(interp
, af
->filename
);
2529 static int aio_cmd_ndelay(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2531 AioFile
*af
= Jim_CmdPrivData(interp
);
2533 int fmode
= af
->flags
;
2538 if (Jim_GetLong(interp
, argv
[0], &nb
) != JIM_OK
) {
2547 fcntl(af
->fd
, F_SETFL
, fmode
);
2550 Jim_SetResultInt(interp
, (fmode
& O_NONBLOCK
) ? 1 : 0);
2555 static int aio_cmd_buffering(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2557 AioFile
*af
= Jim_CmdPrivData(interp
);
2559 static const char *options
[] = {
2573 if (Jim_GetEnum(interp
, argv
[0], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
2578 setvbuf(af
->fp
, NULL
, _IONBF
, 0);
2581 setvbuf(af
->fp
, NULL
, _IOLBF
, BUFSIZ
);
2584 setvbuf(af
->fp
, NULL
, _IOFBF
, BUFSIZ
);
2590 #ifdef jim_ext_eventloop
2591 static void JimAioFileEventFinalizer(Jim_Interp
*interp
, void *clientData
)
2593 Jim_Obj
*objPtr
= clientData
;
2595 Jim_DecrRefCount(interp
, objPtr
);
2598 static int JimAioFileEventHandler(Jim_Interp
*interp
, void *clientData
, int mask
)
2600 Jim_Obj
*objPtr
= clientData
;
2602 return Jim_EvalObjBackground(interp
, objPtr
);
2605 static int aio_eventinfo(Jim_Interp
*interp
, AioFile
* af
, unsigned mask
, Jim_Obj
**scriptHandlerObj
,
2606 int argc
, Jim_Obj
* const *argv
)
2611 /* Return current script */
2612 if (*scriptHandlerObj
) {
2613 Jim_SetResult(interp
, *scriptHandlerObj
);
2618 if (*scriptHandlerObj
) {
2619 /* Delete old handler */
2620 Jim_DeleteFileHandler(interp
, af
->fp
);
2621 *scriptHandlerObj
= NULL
;
2624 /* Now possibly add the new script(s) */
2625 Jim_GetString(argv
[0], &scriptlen
);
2626 if (scriptlen
== 0) {
2627 /* Empty script, so done */
2631 /* A new script to add */
2632 Jim_IncrRefCount(argv
[0]);
2633 *scriptHandlerObj
= argv
[0];
2635 Jim_CreateFileHandler(interp
, af
->fp
, mask
,
2636 JimAioFileEventHandler
, *scriptHandlerObj
, JimAioFileEventFinalizer
);
2641 static int aio_cmd_readable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2643 AioFile
*af
= Jim_CmdPrivData(interp
);
2645 return aio_eventinfo(interp
, af
, JIM_EVENT_READABLE
, &af
->rEvent
, argc
, argv
);
2648 static int aio_cmd_writable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2650 AioFile
*af
= Jim_CmdPrivData(interp
);
2652 return aio_eventinfo(interp
, af
, JIM_EVENT_WRITABLE
, &af
->wEvent
, argc
, argv
);
2655 static int aio_cmd_onexception(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2657 AioFile
*af
= Jim_CmdPrivData(interp
);
2659 return aio_eventinfo(interp
, af
, JIM_EVENT_EXCEPTION
, &af
->wEvent
, argc
, argv
);
2663 static const jim_subcmd_type aio_command_table
[] = {
2665 .args
= "?-nonewline? ?len?",
2666 .function
= aio_cmd_read
,
2669 .description
= "Read and return bytes from the stream. To eof if no len."
2672 .args
= "handle ?size?",
2673 .function
= aio_cmd_copy
,
2676 .description
= "Copy up to 'size' bytes to the given filehandle, or to eof if no size."
2680 .function
= aio_cmd_gets
,
2683 .description
= "Read one line and return it or store it in the var"
2686 .args
= "?-nonewline? str",
2687 .function
= aio_cmd_puts
,
2690 .description
= "Write the string, with newline unless -nonewline"
2693 { .cmd
= "recvfrom",
2694 .args
= "len ?addrvar?",
2695 .function
= aio_cmd_recvfrom
,
2698 .description
= "Receive up to 'len' bytes on the socket. Sets 'addrvar' with receive address, if set"
2701 .args
= "str address",
2702 .function
= aio_cmd_sendto
,
2705 .description
= "Send 'str' to the given address (dgram only)"
2708 .function
= aio_cmd_accept
,
2709 .description
= "Server socket only: Accept a connection and return stream"
2713 .function
= aio_cmd_flush
,
2714 .description
= "Flush the stream"
2717 .function
= aio_cmd_eof
,
2718 .description
= "Returns 1 if stream is at eof"
2721 .flags
= JIM_MODFLAG_FULLARGV
,
2722 .function
= aio_cmd_close
,
2723 .description
= "Closes the stream"
2726 .args
= "offset ?start|current|end",
2727 .function
= aio_cmd_seek
,
2730 .description
= "Seeks in the stream (default 'current')"
2733 .function
= aio_cmd_tell
,
2734 .description
= "Returns the current seek position"
2736 { .cmd
= "filename",
2737 .function
= aio_cmd_filename
,
2738 .description
= "Returns the original filename"
2743 .function
= aio_cmd_ndelay
,
2746 .description
= "Set O_NDELAY (if arg). Returns current/new setting."
2749 { .cmd
= "buffering",
2750 .args
= "none|line|full",
2751 .function
= aio_cmd_buffering
,
2754 .description
= "Sets buffering"
2756 #ifdef jim_ext_eventloop
2757 { .cmd
= "readable",
2758 .args
= "?readable-script?",
2761 .function
= aio_cmd_readable
,
2762 .description
= "Returns script, or invoke readable-script when readable, {} to remove",
2764 { .cmd
= "writable",
2765 .args
= "?writable-script?",
2768 .function
= aio_cmd_writable
,
2769 .description
= "Returns script, or invoke writable-script when writable, {} to remove",
2771 { .cmd
= "onexception",
2772 .args
= "?exception-script?",
2775 .function
= aio_cmd_onexception
,
2776 .description
= "Returns script, or invoke exception-script when oob data, {} to remove",
2782 static int JimAioSubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2784 return Jim_CallSubCmd(interp
, Jim_ParseSubCmd(interp
, aio_command_table
, argc
, argv
), argc
, argv
);
2787 static int JimAioOpenCommand(Jim_Interp
*interp
, int argc
,
2788 Jim_Obj
*const *argv
)
2792 char buf
[AIO_CMD_LEN
];
2794 const char *cmdname
;
2796 if (argc
!= 2 && argc
!= 3) {
2797 Jim_WrongNumArgs(interp
, 1, argv
, "filename ?mode?");
2800 cmdname
= Jim_String(argv
[1]);
2801 if (Jim_CompareStringImmediate(interp
, argv
[1], "stdin")) {
2802 OpenFlags
|= AIO_KEEPOPEN
;
2805 else if (Jim_CompareStringImmediate(interp
, argv
[1], "stdout")) {
2806 OpenFlags
|= AIO_KEEPOPEN
;
2809 else if (Jim_CompareStringImmediate(interp
, argv
[1], "stderr")) {
2810 OpenFlags
|= AIO_KEEPOPEN
;
2814 const char *mode
= (argc
== 3) ? Jim_String(argv
[2]) : "r";
2815 const char *filename
= Jim_String(argv
[1]);
2817 #ifdef jim_ext_tclcompat
2818 /* If the filename starts with '|', use popen instead */
2819 if (*filename
== '|') {
2820 Jim_Obj
*evalObj
[3];
2822 evalObj
[0] = Jim_NewStringObj(interp
, "popen", -1);
2823 evalObj
[1] = Jim_NewStringObj(interp
, filename
+ 1, -1);
2824 evalObj
[2] = Jim_NewStringObj(interp
, mode
, -1);
2826 return Jim_EvalObjVector(interp
, 3, evalObj
);
2829 fp
= fopen(filename
, mode
);
2831 JimAioSetError(interp
, argv
[1]);
2834 /* Get the next file id */
2835 snprintf(buf
, sizeof(buf
), "aio.handle%ld", Jim_GetId(interp
));
2839 /* Create the file command */
2840 af
= Jim_Alloc(sizeof(*af
));
2842 af
->fd
= fileno(fp
);
2844 if ((OpenFlags
& AIO_KEEPOPEN
) == 0) {
2845 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2849 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2851 af
->filename
= argv
[1];
2852 Jim_IncrRefCount(af
->filename
);
2853 af
->OpenFlags
= OpenFlags
;
2857 Jim_CreateCommand(interp
, cmdname
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2858 Jim_SetResultString(interp
, cmdname
, -1);
2865 * Creates a channel for fd.
2867 * hdlfmt is a sprintf format for the filehandle. Anything with %ld at the end will do.
2868 * mode is usual "r+", but may be another fdopen() mode as required.
2870 * Creates the command and lappends the name of the command to the current result.
2873 static int JimMakeChannel(Jim_Interp
*interp
, Jim_Obj
*filename
, const char *hdlfmt
, int fd
, int family
,
2877 char buf
[AIO_CMD_LEN
];
2879 FILE *fp
= fdopen(fd
, mode
);
2883 JimAioSetError(interp
, NULL
);
2887 /* Create the file command */
2888 af
= Jim_Alloc(sizeof(*af
));
2891 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2893 af
->filename
= filename
;
2894 Jim_IncrRefCount(af
->filename
);
2896 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2901 af
->addr_family
= family
;
2902 snprintf(buf
, sizeof(buf
), hdlfmt
, Jim_GetId(interp
));
2903 Jim_CreateCommand(interp
, buf
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2905 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
, buf
, -1));
2910 static int JimAioSockCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2912 const char *hdlfmt
= "aio.unknown%ld";
2913 const char *socktypes
[] = {
2934 SOCK_STREAM6_CLIENT
,
2935 SOCK_STREAM6_SERVER
,
2939 const char *hostportarg
= NULL
;
2942 const char *mode
= "r+";
2943 int family
= PF_INET
;
2944 Jim_Obj
*argv0
= argv
[0];
2947 if (argc
> 1 && Jim_CompareStringImmediate(interp
, argv
[1], "-ipv6")) {
2949 Jim_SetResultString(interp
, "ipv6 not supported", -1);
2960 Jim_WrongNumArgs(interp
, 1, &argv0
, "?-ipv6? type ?address?");
2964 if (Jim_GetEnum(interp
, argv
[1], socktypes
, &socktype
, "socket type", JIM_ERRMSG
) != JIM_OK
)
2967 Jim_SetResultString(interp
, "", 0);
2969 hdlfmt
= "aio.sock%ld";
2972 hostportarg
= Jim_String(argv
[2]);
2976 case SOCK_DGRAM_CLIENT
:
2978 /* No address, so an unconnected dgram socket */
2979 sock
= socket(family
, SOCK_DGRAM
, 0);
2981 JimAioSetError(interp
, NULL
);
2987 case SOCK_STREAM_CLIENT
:
2989 union sockaddr_any sa
;
2997 if (JimParseIPv6Address(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3001 else if (JimParseIpAddress(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3004 sock
= socket(family
, (socktype
== SOCK_DGRAM_CLIENT
) ? SOCK_DGRAM
: SOCK_STREAM
, 0);
3006 JimAioSetError(interp
, NULL
);
3009 res
= connect(sock
, &sa
.sa
, salen
);
3011 JimAioSetError(interp
, argv
[2]);
3018 case SOCK_STREAM_SERVER
:
3019 case SOCK_DGRAM_SERVER
:
3021 union sockaddr_any sa
;
3029 if (JimParseIPv6Address(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3033 else if (JimParseIpAddress(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3036 sock
= socket(family
, (socktype
== SOCK_DGRAM_SERVER
) ? SOCK_DGRAM
: SOCK_STREAM
, 0);
3038 JimAioSetError(interp
, NULL
);
3042 /* Enable address reuse */
3043 setsockopt(sock
, SOL_SOCKET
, SO_REUSEADDR
, (void *)&on
, sizeof(on
));
3045 res
= bind(sock
, &sa
.sa
, salen
);
3047 JimAioSetError(interp
, argv
[2]);
3051 if (socktype
== SOCK_STREAM_SERVER
) {
3052 res
= listen(sock
, 5);
3054 JimAioSetError(interp
, NULL
);
3059 hdlfmt
= "aio.socksrv%ld";
3063 #ifdef HAVE_SYS_UN_H
3066 struct sockaddr_un sa
;
3069 if (argc
!= 3 || ipv6
) {
3073 if (JimParseDomainAddress(interp
, hostportarg
, &sa
) != JIM_OK
) {
3074 JimAioSetError(interp
, argv
[2]);
3078 sock
= socket(PF_UNIX
, SOCK_STREAM
, 0);
3080 JimAioSetError(interp
, NULL
);
3083 len
= strlen(sa
.sun_path
) + 1 + sizeof(sa
.sun_family
);
3084 res
= connect(sock
, (struct sockaddr
*)&sa
, len
);
3086 JimAioSetError(interp
, argv
[2]);
3090 hdlfmt
= "aio.sockunix%ld";
3094 case SOCK_UNIX_SERVER
:
3096 struct sockaddr_un sa
;
3099 if (argc
!= 3 || ipv6
) {
3103 if (JimParseDomainAddress(interp
, hostportarg
, &sa
) != JIM_OK
) {
3104 JimAioSetError(interp
, argv
[2]);
3108 sock
= socket(PF_UNIX
, SOCK_STREAM
, 0);
3110 JimAioSetError(interp
, NULL
);
3113 len
= strlen(sa
.sun_path
) + 1 + sizeof(sa
.sun_family
);
3114 res
= bind(sock
, (struct sockaddr
*)&sa
, len
);
3116 JimAioSetError(interp
, argv
[2]);
3120 res
= listen(sock
, 5);
3122 JimAioSetError(interp
, NULL
);
3126 hdlfmt
= "aio.sockunixsrv%ld";
3132 case SOCK_STREAM_PIPE
:
3136 if (argc
!= 2 || ipv6
) {
3141 JimAioSetError(interp
, NULL
);
3145 hdlfmt
= "aio.pipe%ld";
3146 if (JimMakeChannel(interp
, argv
[1], hdlfmt
, p
[0], family
, "r") != JIM_OK
) {
3149 JimAioSetError(interp
, NULL
);
3152 /* Note, if this fails it will leave p[0] open, but this should never happen */
3159 Jim_SetResultString(interp
, "Unsupported socket type", -1);
3163 return JimMakeChannel(interp
, argv
[1], hdlfmt
, sock
, family
, mode
);
3167 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*command
)
3169 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, command
, JIM_ERRMSG
);
3171 if (cmdPtr
&& !cmdPtr
->isproc
&& cmdPtr
->u
.native
.cmdProc
== JimAioSubCmdProc
) {
3172 return ((AioFile
*) cmdPtr
->u
.native
.privData
)->fp
;
3174 Jim_SetResultFormatted(interp
, "Not a filehandle: \"%#s\"", command
);
3178 int Jim_aioInit(Jim_Interp
*interp
)
3180 if (Jim_PackageProvide(interp
, "aio", "1.0", JIM_ERRMSG
))
3183 Jim_CreateCommand(interp
, "open", JimAioOpenCommand
, NULL
, NULL
);
3185 Jim_CreateCommand(interp
, "socket", JimAioSockCommand
, NULL
, NULL
);
3188 /* Takeover stdin, stdout and stderr */
3189 Jim_EvalGlobal(interp
, "open stdin; open stdout; open stderr");
3195 * Tcl readdir command.
3197 * (c) 2008 Steve Bennett <steveb@worware.net.au>
3199 * Redistribution and use in source and binary forms, with or without
3200 * modification, are permitted provided that the following conditions
3203 * 1. Redistributions of source code must retain the above copyright
3204 * notice, this list of conditions and the following disclaimer.
3205 * 2. Redistributions in binary form must reproduce the above
3206 * copyright notice, this list of conditions and the following
3207 * disclaimer in the documentation and/or other materials
3208 * provided with the distribution.
3210 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3211 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3212 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3213 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3214 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3215 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3216 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3217 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3218 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3219 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3220 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3221 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3223 * The views and conclusions contained in the software and documentation
3224 * are those of the authors and should not be interpreted as representing
3225 * official policies, either expressed or implied, of the Jim Tcl Project.
3227 * Based on original work by:
3228 *-----------------------------------------------------------------------------
3229 * Copyright 1991-1994 Karl Lehenbauer and Mark Diekhans.
3231 * Permission to use, copy, modify, and distribute this software and its
3232 * documentation for any purpose and without fee is hereby granted, provided
3233 * that the above copyright notice appear in all copies. Karl Lehenbauer and
3234 * Mark Diekhans make no representations about the suitability of this
3235 * software for any purpose. It is provided "as is" without express or
3237 *-----------------------------------------------------------------------------
3247 *-----------------------------------------------------------------------------
3250 * Implements the rename TCL command:
3251 * readdir ?-nocomplain? dirPath
3254 * Standard TCL result.
3255 *-----------------------------------------------------------------------------
3257 int Jim_ReaddirCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3259 const char *dirPath
;
3261 struct dirent
*entryPtr
;
3264 if (argc
== 3 && Jim_CompareStringImmediate(interp
, argv
[1], "-nocomplain")) {
3267 if (argc
!= 2 && !nocomplain
) {
3268 Jim_WrongNumArgs(interp
, 1, argv
, "?-nocomplain? dirPath");
3272 dirPath
= Jim_String(argv
[1 + nocomplain
]);
3274 dirPtr
= opendir(dirPath
);
3275 if (dirPtr
== NULL
) {
3279 Jim_SetResultString(interp
, strerror(errno
), -1);
3282 Jim_SetResultString(interp
, strerror(errno
), -1);
3284 Jim_SetResult(interp
, Jim_NewListObj(interp
, NULL
, 0));
3286 while ((entryPtr
= readdir(dirPtr
)) != NULL
) {
3287 if (entryPtr
->d_name
[0] == '.') {
3288 if (entryPtr
->d_name
[1] == '\0') {
3291 if ((entryPtr
->d_name
[1] == '.') && (entryPtr
->d_name
[2] == '\0'))
3294 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
,
3295 entryPtr
->d_name
, -1));
3302 int Jim_readdirInit(Jim_Interp
*interp
)
3304 if (Jim_PackageProvide(interp
, "readdir", "1.0", JIM_ERRMSG
))
3307 Jim_CreateCommand(interp
, "readdir", Jim_ReaddirCmd
, NULL
, NULL
);
3311 * Implements the regexp and regsub commands for Jim
3313 * (c) 2008 Steve Bennett <steveb@workware.net.au>
3315 * Uses C library regcomp()/regexec() for the matching.
3317 * Redistribution and use in source and binary forms, with or without
3318 * modification, are permitted provided that the following conditions
3321 * 1. Redistributions of source code must retain the above copyright
3322 * notice, this list of conditions and the following disclaimer.
3323 * 2. Redistributions in binary form must reproduce the above
3324 * copyright notice, this list of conditions and the following
3325 * disclaimer in the documentation and/or other materials
3326 * provided with the distribution.
3328 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3329 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3330 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3331 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3332 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3333 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3334 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3335 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3336 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3337 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3338 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3339 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3341 * The views and conclusions contained in the software and documentation
3342 * are those of the authors and should not be interpreted as representing
3343 * official policies, either expressed or implied, of the Jim Tcl Project.
3345 * Based on code originally from Tcl 6.7:
3347 * Copyright 1987-1991 Regents of the University of California
3348 * Permission to use, copy, modify, and distribute this
3349 * software and its documentation for any purpose and without
3350 * fee is hereby granted, provided that the above copyright
3351 * notice appear in all copies. The University of California
3352 * makes no representations about the suitability of this
3353 * software for any purpose. It is provided "as is" without
3354 * express or implied warranty.
3361 static void FreeRegexpInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3363 regfree(objPtr
->internalRep
.regexpValue
.compre
);
3364 Jim_Free(objPtr
->internalRep
.regexpValue
.compre
);
3367 static const Jim_ObjType regexpObjType
= {
3369 FreeRegexpInternalRep
,
3375 static regex_t
*SetRegexpFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, unsigned flags
)
3378 const char *pattern
;
3381 /* Check if the object is already an uptodate variable */
3382 if (objPtr
->typePtr
== ®expObjType
&&
3383 objPtr
->internalRep
.regexpValue
.compre
&& objPtr
->internalRep
.regexpValue
.flags
== flags
) {
3385 return objPtr
->internalRep
.regexpValue
.compre
;
3388 /* Not a regexp or the flags do not match */
3389 if (objPtr
->typePtr
== ®expObjType
) {
3390 FreeRegexpInternalRep(interp
, objPtr
);
3391 objPtr
->typePtr
= NULL
;
3394 /* Get the string representation */
3395 pattern
= Jim_String(objPtr
);
3396 compre
= Jim_Alloc(sizeof(regex_t
));
3398 if ((ret
= regcomp(compre
, pattern
, REG_EXTENDED
| flags
)) != 0) {
3401 regerror(ret
, compre
, buf
, sizeof(buf
));
3402 Jim_SetResultFormatted(interp
, "couldn't compile regular expression pattern: %s", buf
);
3408 objPtr
->typePtr
= ®expObjType
;
3409 objPtr
->internalRep
.regexpValue
.flags
= flags
;
3410 objPtr
->internalRep
.regexpValue
.compre
= compre
;
3415 int Jim_RegexpCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3417 int opt_indices
= 0;
3423 regmatch_t
*pmatch
= NULL
;
3425 int result
= JIM_OK
;
3426 const char *pattern
;
3427 const char *source_str
;
3428 int num_matches
= 0;
3430 Jim_Obj
*resultListObj
= NULL
;
3431 int regcomp_flags
= 0;
3435 OPT_INDICES
, OPT_NOCASE
, OPT_LINE
, OPT_ALL
, OPT_INLINE
, OPT_START
, OPT_END
3437 static const char * const options
[] = {
3438 "-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL
3443 Jim_WrongNumArgs(interp
, 1, argv
,
3444 "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
3448 for (i
= 1; i
< argc
; i
++) {
3449 const char *opt
= Jim_String(argv
[i
]);
3454 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, "switch", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
3457 if (option
== OPT_END
) {
3467 regcomp_flags
|= REG_ICASE
;
3471 regcomp_flags
|= REG_NEWLINE
;
3486 if (Jim_GetIndex(interp
, argv
[i
], &offset
) != JIM_OK
) {
3496 regex
= SetRegexpFromAny(interp
, argv
[i
], regcomp_flags
);
3501 pattern
= Jim_String(argv
[i
]);
3502 source_str
= Jim_GetString(argv
[i
+ 1], &source_len
);
3504 num_vars
= argc
- i
- 2;
3508 Jim_SetResultString(interp
, "regexp match variables not allowed when using -inline",
3513 num_vars
= regex
->re_nsub
+ 1;
3516 pmatch
= Jim_Alloc((num_vars
+ 1) * sizeof(*pmatch
));
3518 /* If an offset has been specified, adjust for that now.
3519 * If it points past the end of the string, point to the terminating null
3523 offset
+= source_len
+ 1;
3525 if (offset
> source_len
) {
3526 source_str
+= source_len
;
3528 else if (offset
> 0) {
3529 source_str
+= offset
;
3531 eflags
|= REG_NOTBOL
;
3535 resultListObj
= Jim_NewListObj(interp
, NULL
, 0);
3539 match
= regexec(regex
, source_str
, num_vars
+ 1, pmatch
, eflags
);
3540 if (match
>= REG_BADPAT
) {
3543 regerror(match
, regex
, buf
, sizeof(buf
));
3544 Jim_SetResultFormatted(interp
, "error while matching pattern: %s", buf
);
3549 if (match
== REG_NOMATCH
) {
3555 if (opt_all
&& !opt_inline
) {
3556 /* Just count the number of matches, so skip the substitution h */
3557 goto try_next_match
;
3561 * If additional variable names have been specified, return
3562 * index information in those variables.
3566 for (i
+= 2; opt_inline
? j
< num_vars
: i
< argc
; i
++, j
++) {
3570 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
3573 resultObj
= Jim_NewStringObj(interp
, "", 0);
3576 if (pmatch
[j
].rm_so
== -1) {
3578 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
, -1));
3579 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
, -1));
3583 int len
= pmatch
[j
].rm_eo
- pmatch
[j
].rm_so
;
3586 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
,
3587 offset
+ pmatch
[j
].rm_so
));
3588 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
,
3589 offset
+ pmatch
[j
].rm_so
+ len
- 1));
3592 Jim_AppendString(interp
, resultObj
, source_str
+ pmatch
[j
].rm_so
, len
);
3597 Jim_ListAppendElement(interp
, resultListObj
, resultObj
);
3600 /* And now set the result variable */
3601 result
= Jim_SetVariable(interp
, argv
[i
], resultObj
);
3603 if (result
!= JIM_OK
) {
3604 Jim_FreeObj(interp
, resultObj
);
3611 if (opt_all
&& (pattern
[0] != '^' || (regcomp_flags
& REG_NEWLINE
)) && *source_str
) {
3612 if (pmatch
[0].rm_eo
) {
3613 offset
+= pmatch
[0].rm_eo
;
3614 source_str
+= pmatch
[0].rm_eo
;
3621 eflags
= REG_NOTBOL
;
3627 if (result
== JIM_OK
) {
3629 Jim_SetResult(interp
, resultListObj
);
3632 Jim_SetResultInt(interp
, num_matches
);
3640 #define MAX_SUB_MATCHES 50
3642 int Jim_RegsubCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3644 int regcomp_flags
= 0;
3645 int regexec_flags
= 0;
3651 regmatch_t pmatch
[MAX_SUB_MATCHES
+ 1];
3652 int num_matches
= 0;
3657 const char *source_str
;
3659 const char *replace_str
;
3661 const char *pattern
;
3664 OPT_NOCASE
, OPT_LINE
, OPT_ALL
, OPT_START
, OPT_END
3666 static const char * const options
[] = {
3667 "-nocase", "-line", "-all", "-start", "--", NULL
3672 Jim_WrongNumArgs(interp
, 1, argv
,
3673 "?switches? exp string subSpec ?varName?");
3677 for (i
= 1; i
< argc
; i
++) {
3678 const char *opt
= Jim_String(argv
[i
]);
3683 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, "switch", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
3686 if (option
== OPT_END
) {
3692 regcomp_flags
|= REG_ICASE
;
3696 regcomp_flags
|= REG_NEWLINE
;
3707 if (Jim_GetIndex(interp
, argv
[i
], &offset
) != JIM_OK
) {
3713 if (argc
- i
!= 3 && argc
- i
!= 4) {
3717 regex
= SetRegexpFromAny(interp
, argv
[i
], regcomp_flags
);
3721 pattern
= Jim_String(argv
[i
]);
3723 source_str
= Jim_GetString(argv
[i
+ 1], &source_len
);
3724 replace_str
= Jim_GetString(argv
[i
+ 2], &replace_len
);
3725 varname
= argv
[i
+ 3];
3727 /* Create the result string */
3728 resultObj
= Jim_NewStringObj(interp
, "", 0);
3730 /* If an offset has been specified, adjust for that now.
3731 * If it points past the end of the string, point to the terminating null
3735 offset
+= source_len
+ 1;
3737 if (offset
> source_len
) {
3738 offset
= source_len
;
3740 else if (offset
< 0) {
3745 /* Copy the part before -start */
3746 Jim_AppendString(interp
, resultObj
, source_str
, offset
);
3749 * The following loop is to handle multiple matches within the
3750 * same source string; each iteration handles one match and its
3751 * corresponding substitution. If "-all" hasn't been specified
3752 * then the loop body only gets executed once.
3755 n
= source_len
- offset
;
3756 p
= source_str
+ offset
;
3758 int match
= regexec(regex
, p
, MAX_SUB_MATCHES
, pmatch
, regexec_flags
);
3760 if (match
>= REG_BADPAT
) {
3763 regerror(match
, regex
, buf
, sizeof(buf
));
3764 Jim_SetResultFormatted(interp
, "error while matching pattern: %s", buf
);
3767 if (match
== REG_NOMATCH
) {
3774 * Copy the portion of the source string before the match to the
3777 Jim_AppendString(interp
, resultObj
, p
, pmatch
[0].rm_so
);
3780 * Append the subSpec (replace_str) argument to the variable, making appropriate
3781 * substitutions. This code is a bit hairy because of the backslash
3782 * conventions and because the code saves up ranges of characters in
3783 * subSpec to reduce the number of calls to Jim_SetVar.
3786 for (j
= 0; j
< replace_len
; j
++) {
3788 int c
= replace_str
[j
];
3793 else if (c
== '\\' && j
< replace_len
) {
3794 c
= replace_str
[++j
];
3795 if ((c
>= '0') && (c
<= '9')) {
3798 else if ((c
== '\\') || (c
== '&')) {
3799 Jim_AppendString(interp
, resultObj
, replace_str
+ j
, 1);
3803 Jim_AppendString(interp
, resultObj
, replace_str
+ j
- 1, 2);
3808 Jim_AppendString(interp
, resultObj
, replace_str
+ j
, 1);
3811 if ((idx
< MAX_SUB_MATCHES
) && pmatch
[idx
].rm_so
!= -1 && pmatch
[idx
].rm_eo
!= -1) {
3812 Jim_AppendString(interp
, resultObj
, p
+ pmatch
[idx
].rm_so
,
3813 pmatch
[idx
].rm_eo
- pmatch
[idx
].rm_so
);
3817 p
+= pmatch
[0].rm_eo
;
3818 n
-= pmatch
[0].rm_eo
;
3820 /* If -all is not specified, or there is no source left, we are done */
3821 if (!opt_all
|| n
== 0) {
3825 /* An anchored pattern without -line must be done */
3826 if ((regcomp_flags
& REG_NEWLINE
) == 0 && pattern
[0] == '^') {
3830 /* If the pattern is empty, need to step forwards */
3831 if (pattern
[0] == '\0' && n
) {
3832 /* Need to copy the char we are moving over */
3833 Jim_AppendString(interp
, resultObj
, p
, 1);
3838 regexec_flags
|= REG_NOTBOL
;
3842 * Copy the portion of the string after the last match to the
3845 Jim_AppendString(interp
, resultObj
, p
, -1);
3847 /* And now set or return the result variable */
3848 if (argc
- i
== 4) {
3849 result
= Jim_SetVariable(interp
, varname
, resultObj
);
3851 if (result
== JIM_OK
) {
3852 Jim_SetResultInt(interp
, num_matches
);
3855 Jim_FreeObj(interp
, resultObj
);
3859 Jim_SetResult(interp
, resultObj
);
3866 int Jim_regexpInit(Jim_Interp
*interp
)
3868 if (Jim_PackageProvide(interp
, "regexp", "1.0", JIM_ERRMSG
))
3871 Jim_CreateCommand(interp
, "regexp", Jim_RegexpCmd
, NULL
, NULL
);
3872 Jim_CreateCommand(interp
, "regsub", Jim_RegsubCmd
, NULL
, NULL
);
3876 * Implements the file command for jim
3878 * (c) 2008 Steve Bennett <steveb@workware.net.au>
3880 * Redistribution and use in source and binary forms, with or without
3881 * modification, are permitted provided that the following conditions
3884 * 1. Redistributions of source code must retain the above copyright
3885 * notice, this list of conditions and the following disclaimer.
3886 * 2. Redistributions in binary form must reproduce the above
3887 * copyright notice, this list of conditions and the following
3888 * disclaimer in the documentation and/or other materials
3889 * provided with the distribution.
3891 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3892 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3893 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3894 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3895 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3896 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3897 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3898 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3899 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3900 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3901 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3902 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3904 * The views and conclusions contained in the software and documentation
3905 * are those of the authors and should not be interpreted as representing
3906 * official policies, either expressed or implied, of the Jim Tcl Project.
3908 * Based on code originally from Tcl 6.7:
3910 * Copyright 1987-1991 Regents of the University of California
3911 * Permission to use, copy, modify, and distribute this
3912 * software and its documentation for any purpose and without
3913 * fee is hereby granted, provided that the above copyright
3914 * notice appear in all copies. The University of California
3915 * makes no representations about the suitability of this
3916 * software for any purpose. It is provided "as is" without
3917 * express or implied warranty.
3926 #include <sys/stat.h>
3927 #include <sys/param.h>
3931 # define MAXPATHLEN JIM_PATH_LEN
3935 *----------------------------------------------------------------------
3939 * Given a mode word, returns a string identifying the type of a
3943 * A static text string giving the file type from mode.
3948 *----------------------------------------------------------------------
3951 static const char *JimGetFileType(int mode
)
3953 if (S_ISREG(mode
)) {
3956 else if (S_ISDIR(mode
)) {
3959 else if (S_ISCHR(mode
)) {
3960 return "characterSpecial";
3962 else if (S_ISBLK(mode
)) {
3963 return "blockSpecial";
3965 else if (S_ISFIFO(mode
)) {
3969 else if (S_ISLNK(mode
)) {
3974 else if (S_ISSOCK(mode
)) {
3982 *----------------------------------------------------------------------
3986 * This is a utility procedure that breaks out the fields of a
3987 * "stat" structure and stores them in textual form into the
3988 * elements of an associative array.
3991 * Returns a standard Tcl return value. If an error occurs then
3992 * a message is left in interp->result.
3995 * Elements of the associative array given by "varName" are modified.
3997 *----------------------------------------------------------------------
4000 static int set_array_int_value(Jim_Interp
*interp
, Jim_Obj
*container
, const char *key
,
4003 Jim_Obj
*nameobj
= Jim_NewStringObj(interp
, key
, -1);
4004 Jim_Obj
*valobj
= Jim_NewWideObj(interp
, value
);
4006 if (Jim_SetDictKeysVector(interp
, container
, &nameobj
, 1, valobj
) != JIM_OK
) {
4007 Jim_FreeObj(interp
, nameobj
);
4008 Jim_FreeObj(interp
, valobj
);
4014 static int set_array_string_value(Jim_Interp
*interp
, Jim_Obj
*container
, const char *key
,
4017 Jim_Obj
*nameobj
= Jim_NewStringObj(interp
, key
, -1);
4018 Jim_Obj
*valobj
= Jim_NewStringObj(interp
, value
, -1);
4020 if (Jim_SetDictKeysVector(interp
, container
, &nameobj
, 1, valobj
) != JIM_OK
) {
4021 Jim_FreeObj(interp
, nameobj
);
4022 Jim_FreeObj(interp
, valobj
);
4028 static int StoreStatData(Jim_Interp
*interp
, Jim_Obj
*varName
, const struct stat
*sb
)
4030 if (set_array_int_value(interp
, varName
, "dev", sb
->st_dev
) != JIM_OK
) {
4031 Jim_SetResultFormatted(interp
, "can't set \"%#s(dev)\": variables isn't array", varName
);
4034 set_array_int_value(interp
, varName
, "ino", sb
->st_ino
);
4035 set_array_int_value(interp
, varName
, "mode", sb
->st_mode
);
4036 set_array_int_value(interp
, varName
, "nlink", sb
->st_nlink
);
4037 set_array_int_value(interp
, varName
, "uid", sb
->st_uid
);
4038 set_array_int_value(interp
, varName
, "gid", sb
->st_gid
);
4039 set_array_int_value(interp
, varName
, "size", sb
->st_size
);
4040 set_array_int_value(interp
, varName
, "atime", sb
->st_atime
);
4041 set_array_int_value(interp
, varName
, "mtime", sb
->st_mtime
);
4042 set_array_int_value(interp
, varName
, "ctime", sb
->st_ctime
);
4043 set_array_string_value(interp
, varName
, "type", JimGetFileType((int)sb
->st_mode
));
4045 /* And also return the value */
4046 Jim_SetResult(interp
, Jim_GetVariable(interp
, varName
, 0));
4051 static int file_cmd_dirname(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4053 const char *path
= Jim_String(argv
[0]);
4054 const char *p
= strrchr(path
, '/');
4057 Jim_SetResultString(interp
, ".", -1);
4059 else if (p
== path
) {
4060 Jim_SetResultString(interp
, "/", -1);
4062 #if defined(__MINGW32__)
4063 else if (p
[-1] == ':') {
4065 Jim_SetResultString(interp
, path
, p
- path
+ 1);
4069 Jim_SetResultString(interp
, path
, p
- path
);
4074 static int file_cmd_rootname(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4076 const char *path
= Jim_String(argv
[0]);
4077 const char *lastSlash
= strrchr(path
, '/');
4078 const char *p
= strrchr(path
, '.');
4080 if (p
== NULL
|| (lastSlash
!= NULL
&& lastSlash
> p
)) {
4081 Jim_SetResult(interp
, argv
[0]);
4084 Jim_SetResultString(interp
, path
, p
- path
);
4089 static int file_cmd_extension(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4091 const char *path
= Jim_String(argv
[0]);
4092 const char *lastSlash
= strrchr(path
, '/');
4093 const char *p
= strrchr(path
, '.');
4095 if (p
== NULL
|| (lastSlash
!= NULL
&& lastSlash
>= p
)) {
4098 Jim_SetResultString(interp
, p
, -1);
4102 static int file_cmd_tail(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4104 const char *path
= Jim_String(argv
[0]);
4105 const char *lastSlash
= strrchr(path
, '/');
4108 Jim_SetResultString(interp
, lastSlash
+ 1, -1);
4111 Jim_SetResult(interp
, argv
[0]);
4116 static int file_cmd_normalize(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4118 #ifdef HAVE_REALPATH
4119 const char *path
= Jim_String(argv
[0]);
4120 char *newname
= Jim_Alloc(MAXPATHLEN
+ 1);
4122 if (realpath(path
, newname
)) {
4123 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, newname
, -1));
4127 Jim_SetResult(interp
, argv
[0]);
4131 Jim_SetResultString(interp
, "Not implemented", -1);
4136 static int file_cmd_join(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4139 char *newname
= Jim_Alloc(MAXPATHLEN
+ 1);
4140 char *last
= newname
;
4144 /* Simple implementation for now */
4145 for (i
= 0; i
< argc
; i
++) {
4147 const char *part
= Jim_GetString(argv
[i
], &len
);
4150 /* Absolute component, so go back to the start */
4153 #if defined(__MINGW32__)
4154 else if (strchr(part
, ':')) {
4155 /* Absolute compontent on mingw, so go back to the start */
4160 /* Add a slash if needed */
4161 if (last
!= newname
) {
4166 if (last
+ len
- newname
>= MAXPATHLEN
) {
4168 Jim_SetResultString(interp
, "Path too long", -1);
4171 memcpy(last
, part
, len
);
4175 /* Remove a slash if needed */
4176 if (last
!= newname
&& last
[-1] == '/') {
4183 /* Probably need to handle some special cases ... */
4185 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, newname
, last
- newname
));
4190 static int file_access(Jim_Interp
*interp
, Jim_Obj
*filename
, int mode
)
4192 const char *path
= Jim_String(filename
);
4193 int rc
= access(path
, mode
);
4195 Jim_SetResultBool(interp
, rc
!= -1);
4200 static int file_cmd_readable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4202 return file_access(interp
, argv
[0], R_OK
);
4205 static int file_cmd_writable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4207 return file_access(interp
, argv
[0], W_OK
);
4210 static int file_cmd_executable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4212 return file_access(interp
, argv
[0], X_OK
);
4215 static int file_cmd_exists(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4217 return file_access(interp
, argv
[0], F_OK
);
4220 static int file_cmd_delete(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4222 int force
= Jim_CompareStringImmediate(interp
, argv
[0], "-force");
4224 if (force
|| Jim_CompareStringImmediate(interp
, argv
[0], "--")) {
4230 const char *path
= Jim_String(argv
[0]);
4232 if (unlink(path
) == -1 && errno
!= ENOENT
) {
4233 if (rmdir(path
) == -1) {
4234 /* Maybe try using the script helper */
4235 if (!force
|| Jim_EvalObjPrefix(interp
, "file delete force", 1, argv
) != JIM_OK
) {
4236 Jim_SetResultFormatted(interp
, "couldn't delete file \"%s\": %s", path
,
4247 #ifdef HAVE_MKDIR_ONE_ARG
4248 #define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME)
4250 #define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME, 0755)
4254 * Create directory, creating all intermediate paths if necessary.
4256 * Returns 0 if OK or -1 on failure (and sets errno)
4258 * Note: The path may be modified.
4260 static int mkdir_all(char *path
)
4264 /* First time just try to make the dir */
4268 /* Must have failed the first time, so recursively make the parent and try again */
4269 char *slash
= strrchr(path
, '/');
4271 if (slash
&& slash
!= path
) {
4273 if (mkdir_all(path
) != 0) {
4279 if (MKDIR_DEFAULT(path
) == 0) {
4282 if (errno
== ENOENT
) {
4283 /* Create the parent and try again */
4286 /* Maybe it already exists as a directory */
4287 if (errno
== EEXIST
) {
4290 if (stat(path
, &sb
) == 0 && S_ISDIR(sb
.st_mode
)) {
4302 static int file_cmd_mkdir(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4305 char *path
= Jim_StrDup(Jim_String(argv
[0]));
4306 int rc
= mkdir_all(path
);
4310 Jim_SetResultFormatted(interp
, "can't create directory \"%#s\": %s", argv
[0],
4320 static int file_cmd_tempfile(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4324 const char *template = "/tmp/tcl.tmp.XXXXXX";
4327 template = Jim_String(argv
[0]);
4329 filename
= Jim_StrDup(template);
4331 fd
= mkstemp(filename
);
4333 Jim_SetResultString(interp
, "Failed to create tempfile", -1);
4338 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, filename
, -1));
4343 static int file_cmd_rename(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4350 if (!Jim_CompareStringImmediate(interp
, argv
[0], "-force")) {
4358 source
= Jim_String(argv
[0]);
4359 dest
= Jim_String(argv
[1]);
4361 if (!force
&& access(dest
, F_OK
) == 0) {
4362 Jim_SetResultFormatted(interp
, "error renaming \"%#s\" to \"%#s\": target exists", argv
[0],
4367 if (rename(source
, dest
) != 0) {
4368 Jim_SetResultFormatted(interp
, "error renaming \"%#s\" to \"%#s\": %s", argv
[0], argv
[1],
4376 static int file_stat(Jim_Interp
*interp
, Jim_Obj
*filename
, struct stat
*sb
)
4378 const char *path
= Jim_String(filename
);
4380 if (stat(path
, sb
) == -1) {
4381 Jim_SetResultFormatted(interp
, "could not read \"%#s\": %s", filename
, strerror(errno
));
4391 static int file_lstat(Jim_Interp
*interp
, Jim_Obj
*filename
, struct stat
*sb
)
4393 const char *path
= Jim_String(filename
);
4395 if (lstat(path
, sb
) == -1) {
4396 Jim_SetResultFormatted(interp
, "could not read \"%#s\": %s", filename
, strerror(errno
));
4402 static int file_cmd_atime(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4406 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4409 Jim_SetResultInt(interp
, sb
.st_atime
);
4413 static int file_cmd_mtime(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4417 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4420 Jim_SetResultInt(interp
, sb
.st_mtime
);
4424 static int file_cmd_copy(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4426 return Jim_EvalObjPrefix(interp
, "file copy", argc
, argv
);
4429 static int file_cmd_size(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4433 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4436 Jim_SetResultInt(interp
, sb
.st_size
);
4440 static int file_cmd_isdirectory(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4445 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4446 ret
= S_ISDIR(sb
.st_mode
);
4448 Jim_SetResultInt(interp
, ret
);
4452 static int file_cmd_isfile(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4457 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4458 ret
= S_ISREG(sb
.st_mode
);
4460 Jim_SetResultInt(interp
, ret
);
4465 static int file_cmd_owned(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4470 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4471 ret
= (geteuid() == sb
.st_uid
);
4473 Jim_SetResultInt(interp
, ret
);
4478 #if defined(HAVE_READLINK)
4479 static int file_cmd_readlink(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4481 const char *path
= Jim_String(argv
[0]);
4482 char *linkValue
= Jim_Alloc(MAXPATHLEN
+ 1);
4484 int linkLength
= readlink(path
, linkValue
, MAXPATHLEN
);
4486 if (linkLength
== -1) {
4487 Jim_Free(linkValue
);
4488 Jim_SetResultFormatted(interp
, "couldn't readlink \"%s\": %s", argv
[0], strerror(errno
));
4491 linkValue
[linkLength
] = 0;
4492 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, linkValue
, linkLength
));
4497 static int file_cmd_type(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4501 if (file_lstat(interp
, argv
[0], &sb
) != JIM_OK
) {
4504 Jim_SetResultString(interp
, JimGetFileType((int)sb
.st_mode
), -1);
4508 static int file_cmd_lstat(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4512 if (file_lstat(interp
, argv
[0], &sb
) != JIM_OK
) {
4515 return StoreStatData(interp
, argv
[1], &sb
);
4518 static int file_cmd_stat(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4522 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4525 return StoreStatData(interp
, argv
[1], &sb
);
4528 static const jim_subcmd_type file_command_table
[] = {
4531 .function
= file_cmd_atime
,
4534 .description
= "Last access time"
4538 .function
= file_cmd_mtime
,
4541 .description
= "Last modification time"
4544 .args
= "?-force? source dest",
4545 .function
= file_cmd_copy
,
4548 .description
= "Copy source file to destination file"
4552 .function
= file_cmd_dirname
,
4555 .description
= "Directory part of the name"
4557 { .cmd
= "rootname",
4559 .function
= file_cmd_rootname
,
4562 .description
= "Name without any extension"
4564 { .cmd
= "extension",
4566 .function
= file_cmd_extension
,
4569 .description
= "Last extension including the dot"
4573 .function
= file_cmd_tail
,
4576 .description
= "Last component of the name"
4578 { .cmd
= "normalize",
4580 .function
= file_cmd_normalize
,
4583 .description
= "Normalized path of name"
4586 .args
= "name ?name ...?",
4587 .function
= file_cmd_join
,
4590 .description
= "Join multiple path components"
4592 { .cmd
= "readable",
4594 .function
= file_cmd_readable
,
4597 .description
= "Is file readable"
4599 { .cmd
= "writable",
4601 .function
= file_cmd_writable
,
4604 .description
= "Is file writable"
4606 { .cmd
= "executable",
4608 .function
= file_cmd_executable
,
4611 .description
= "Is file executable"
4615 .function
= file_cmd_exists
,
4618 .description
= "Does file exist"
4621 .args
= "?-force|--? name ...",
4622 .function
= file_cmd_delete
,
4625 .description
= "Deletes the files or directories (must be empty unless -force)"
4629 .function
= file_cmd_mkdir
,
4632 .description
= "Creates the directories"
4635 { .cmd
= "tempfile",
4636 .args
= "?template?",
4637 .function
= file_cmd_tempfile
,
4640 .description
= "Creates a temporary filename"
4644 .args
= "?-force? source dest",
4645 .function
= file_cmd_rename
,
4648 .description
= "Renames a file"
4650 #if defined(HAVE_READLINK)
4651 { .cmd
= "readlink",
4653 .function
= file_cmd_readlink
,
4656 .description
= "Value of the symbolic link"
4661 .function
= file_cmd_size
,
4664 .description
= "Size of file"
4668 .function
= file_cmd_stat
,
4671 .description
= "Stores results of stat in var array"
4675 .function
= file_cmd_lstat
,
4678 .description
= "Stores results of lstat in var array"
4682 .function
= file_cmd_type
,
4685 .description
= "Returns type of the file"
4690 .function
= file_cmd_owned
,
4693 .description
= "Returns 1 if owned by the current owner"
4696 { .cmd
= "isdirectory",
4698 .function
= file_cmd_isdirectory
,
4701 .description
= "Returns 1 if name is a directory"
4705 .function
= file_cmd_isfile
,
4708 .description
= "Returns 1 if name is a file"
4715 static int Jim_CdCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4720 Jim_WrongNumArgs(interp
, 1, argv
, "dirname");
4724 path
= Jim_String(argv
[1]);
4726 if (chdir(path
) != 0) {
4727 Jim_SetResultFormatted(interp
, "couldn't change working directory to \"%s\": %s", path
,
4734 static int Jim_PwdCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4736 const int cwd_len
= 2048;
4737 char *cwd
= malloc(cwd_len
);
4739 if (getcwd(cwd
, cwd_len
) == NULL
) {
4740 Jim_SetResultString(interp
, "Failed to get pwd", -1);
4743 #if defined(__MINGW32__)
4745 /* Try to keep backlashes out of paths */
4747 while ((p
= strchr(p
, '\\')) != NULL
) {
4753 Jim_SetResultString(interp
, cwd
, -1);
4759 int Jim_fileInit(Jim_Interp
*interp
)
4761 if (Jim_PackageProvide(interp
, "file", "1.0", JIM_ERRMSG
))
4764 Jim_CreateCommand(interp
, "file", Jim_SubCmdProc
, (void *)file_command_table
, NULL
);
4765 Jim_CreateCommand(interp
, "pwd", Jim_PwdCmd
, NULL
, NULL
);
4766 Jim_CreateCommand(interp
, "cd", Jim_CdCmd
, NULL
, NULL
);
4771 * (c) 2008 Steve Bennett <steveb@workware.net.au>
4773 * Implements the exec command for Jim
4775 * Based on code originally from Tcl 6.7 by John Ousterhout.
4778 * The Tcl_Fork and Tcl_WaitPids procedures are based on code
4779 * contributed by Karl Lehenbauer, Mark Diekhans and Peter
4782 * Copyright 1987-1991 Regents of the University of California
4783 * Permission to use, copy, modify, and distribute this
4784 * software and its documentation for any purpose and without
4785 * fee is hereby granted, provided that the above copyright
4786 * notice appear in all copies. The University of California
4787 * makes no representations about the suitability of this
4788 * software for any purpose. It is provided "as is" without
4789 * express or implied warranty.
4796 #if defined(HAVE_VFORK) && defined(HAVE_WAITPID)
4802 #include <sys/wait.h>
4804 #if defined(__GNUC__) && !defined(__clang__)
4805 #define IGNORE_RC(EXPR) ((EXPR) < 0 ? -1 : 0)
4807 #define IGNORE_RC(EXPR) EXPR
4810 /* These two could be moved into the Tcl core */
4811 static void Jim_SetResultErrno(Jim_Interp
*interp
, const char *msg
)
4813 Jim_SetResultFormatted(interp
, "%s: %s", msg
, strerror(errno
));
4816 static void Jim_RemoveTrailingNewline(Jim_Obj
*objPtr
)
4819 const char *s
= Jim_GetString(objPtr
, &len
);
4821 if (len
> 0 && s
[len
- 1] == '\n') {
4823 objPtr
->bytes
[objPtr
->length
] = '\0';
4828 * Read from 'fd' and append the data to strObj
4829 * Returns JIM_OK if OK, or JIM_ERR on error.
4831 static int JimAppendStreamToString(Jim_Interp
*interp
, int fd
, Jim_Obj
*strObj
)
4837 count
= read(fd
, buffer
, sizeof(buffer
));
4840 Jim_RemoveTrailingNewline(strObj
);
4846 Jim_AppendString(interp
, strObj
, buffer
, count
);
4851 * If the last character of the result is a newline, then remove
4852 * the newline character (the newline would just confuse things).
4854 * Note: Ideally we could do this by just reducing the length of stringrep
4855 * by 1, but there is no API for this :-(
4857 static void JimTrimTrailingNewline(Jim_Interp
*interp
)
4860 const char *p
= Jim_GetString(Jim_GetResult(interp
), &len
);
4862 if (len
> 0 && p
[len
- 1] == '\n') {
4863 Jim_SetResultString(interp
, p
, len
- 1);
4868 * Builds the environment array from $::env
4870 * If $::env is not set, simply returns environ.
4872 * Otherwise allocates the environ array from the contents of $::env
4874 * If the exec fails, memory can be freed via JimFreeEnv()
4876 static char **JimBuildEnv(Jim_Interp
*interp
)
4878 #ifdef jim_ext_tclcompat
4884 Jim_Obj
*objPtr
= Jim_GetGlobalVariableStr(interp
, "env", JIM_NONE
);
4887 return Jim_GetEnviron();
4890 /* Calculate the required size */
4891 len
= Jim_ListLength(interp
, objPtr
);
4896 env
= Jim_Alloc(sizeof(*env
) * (len
/ 2 + 1));
4899 for (i
= 0; i
< len
; i
+= 2) {
4901 const char *s1
, *s2
;
4904 Jim_ListIndex(interp
, objPtr
, i
, &elemObj
, JIM_NONE
);
4905 s1
= Jim_GetString(elemObj
, &l1
);
4906 Jim_ListIndex(interp
, objPtr
, i
+ 1, &elemObj
, JIM_NONE
);
4907 s2
= Jim_GetString(elemObj
, &l2
);
4909 env
[n
] = Jim_Alloc(l1
+ l2
+ 2);
4910 sprintf(env
[n
], "%s=%s", s1
, s2
);
4917 return Jim_GetEnviron();
4922 * Frees the environment allocated by JimBuildEnv()
4924 * Must pass original_environ.
4926 static void JimFreeEnv(Jim_Interp
*interp
, char **env
, char **original_environ
)
4928 #ifdef jim_ext_tclcompat
4929 if (env
!= original_environ
) {
4931 for (i
= 0; env
[i
]; i
++) {
4940 * Create error messages for unusual process exits. An
4941 * extra newline gets appended to each error message, but
4942 * it gets removed below (in the same fashion that an
4943 * extra newline in the command's output is removed).
4945 static int JimCheckWaitStatus(Jim_Interp
*interp
, int pid
, int waitStatus
)
4947 Jim_Obj
*errorCode
= Jim_NewListObj(interp
, NULL
, 0);
4950 if (WIFEXITED(waitStatus
)) {
4951 if (WEXITSTATUS(waitStatus
) == 0) {
4952 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "NONE", -1));
4956 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "CHILDSTATUS", -1));
4957 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
4958 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WEXITSTATUS(waitStatus
)));
4965 if (WIFSIGNALED(waitStatus
)) {
4966 type
= "CHILDKILLED";
4971 action
= "suspended";
4974 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, type
, -1));
4976 #ifdef jim_ext_signal
4977 Jim_SetResultFormatted(interp
, "child %s by signal %s", action
, Jim_SignalId(WTERMSIG(waitStatus
)));
4978 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, Jim_SignalId(WTERMSIG(waitStatus
)), -1));
4979 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
4980 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, Jim_SignalName(WTERMSIG(waitStatus
)), -1));
4982 Jim_SetResultFormatted(interp
, "child %s by signal %d", action
, WTERMSIG(waitStatus
));
4983 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WTERMSIG(waitStatus
)));
4984 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
4985 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WTERMSIG(waitStatus
)));
4988 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCode
);
4993 * Data structures of the following type are used by JimFork and
4994 * JimWaitPids to keep track of child processes.
4999 int pid
; /* Process id of child. */
5000 int status
; /* Status returned when child exited or suspended. */
5001 int flags
; /* Various flag bits; see below for definitions. */
5004 struct WaitInfoTable
{
5005 struct WaitInfo
*info
;
5011 * Flag bits in WaitInfo structures:
5013 * WI_DETACHED - Non-zero means no-one cares about the
5014 * process anymore. Ignore it until it
5015 * exits, then forget about it.
5018 #define WI_DETACHED 2
5020 #define WAIT_TABLE_GROW_BY 4
5022 static void JimFreeWaitInfoTable(struct Jim_Interp
*interp
, void *privData
)
5024 struct WaitInfoTable
*table
= privData
;
5026 Jim_Free(table
->info
);
5030 static struct WaitInfoTable
*JimAllocWaitInfoTable(void)
5032 struct WaitInfoTable
*table
= Jim_Alloc(sizeof(*table
));
5034 table
->size
= table
->used
= 0;
5039 static int Jim_CreatePipeline(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
,
5040 int **pidArrayPtr
, int *inPipePtr
, int *outPipePtr
, int *errFilePtr
);
5041 static void JimDetachPids(Jim_Interp
*interp
, int numPids
, const int *pidPtr
);
5042 static int Jim_CleanupChildren(Jim_Interp
*interp
, int numPids
, int *pidPtr
, int errorId
);
5044 static int Jim_ExecCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5046 int outputId
; /* File id for output pipe. -1
5047 * means command overrode. */
5048 int errorId
; /* File id for temporary file
5049 * containing error output. */
5051 int numPids
, result
;
5054 * See if the command is to be run in background; if so, create
5055 * the command, detach it, and return.
5057 if (argc
> 1 && Jim_CompareStringImmediate(interp
, argv
[argc
- 1], "&")) {
5062 numPids
= Jim_CreatePipeline(interp
, argc
- 1, argv
+ 1, &pidPtr
, NULL
, NULL
, NULL
);
5066 /* The return value is a list of the pids */
5067 listObj
= Jim_NewListObj(interp
, NULL
, 0);
5068 for (i
= 0; i
< numPids
; i
++) {
5069 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, pidPtr
[i
]));
5071 Jim_SetResult(interp
, listObj
);
5072 JimDetachPids(interp
, numPids
, pidPtr
);
5078 * Create the command's pipeline.
5081 Jim_CreatePipeline(interp
, argc
- 1, argv
+ 1, &pidPtr
, (int *)NULL
, &outputId
, &errorId
);
5087 * Read the child's output (if any) and put it into the result.
5089 Jim_SetResultString(interp
, "", 0);
5092 if (outputId
!= -1) {
5093 result
= JimAppendStreamToString(interp
, outputId
, Jim_GetResult(interp
));
5095 Jim_SetResultErrno(interp
, "error reading from output pipe");
5100 if (Jim_CleanupChildren(interp
, numPids
, pidPtr
, errorId
) != JIM_OK
) {
5106 void Jim_ReapDetachedPids(struct WaitInfoTable
*table
)
5112 struct WaitInfo
*waitPtr
;
5115 for (waitPtr
= table
->info
, count
= table
->used
; count
> 0; waitPtr
++, count
--) {
5116 if (waitPtr
->flags
& WI_DETACHED
) {
5118 int pid
= waitpid(waitPtr
->pid
, &status
, WNOHANG
);
5120 if (waitPtr
!= &table
->info
[table
->used
- 1]) {
5121 *waitPtr
= table
->info
[table
->used
- 1];
5130 * Does waitpid() on the given pid, and then removes the
5131 * entry from the wait table.
5133 * Returns the pid if OK and updates *statusPtr with the status,
5134 * or -1 if the pid was not in the table.
5136 static int JimWaitPid(struct WaitInfoTable
*table
, int pid
, int *statusPtr
)
5140 /* Find it in the table */
5141 for (i
= 0; i
< table
->used
; i
++) {
5142 if (pid
== table
->info
[i
].pid
) {
5144 waitpid(pid
, statusPtr
, 0);
5146 /* Remove it from the table */
5147 if (i
!= table
->used
- 1) {
5148 table
->info
[i
] = table
->info
[table
->used
- 1];
5160 *----------------------------------------------------------------------
5164 * This procedure is called to indicate that one or more child
5165 * processes have been placed in background and are no longer
5166 * cared about. These children can be cleaned up with JimReapDetachedPids().
5174 *----------------------------------------------------------------------
5177 static void JimDetachPids(Jim_Interp
*interp
, int numPids
, const int *pidPtr
)
5180 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5182 for (j
= 0; j
< numPids
; j
++) {
5183 /* Find it in the table */
5185 for (i
= 0; i
< table
->used
; i
++) {
5186 if (pidPtr
[j
] == table
->info
[i
].pid
) {
5187 table
->info
[i
].flags
|= WI_DETACHED
;
5195 *----------------------------------------------------------------------
5197 * Jim_CreatePipeline --
5199 * Given an argc/argv array, instantiate a pipeline of processes
5200 * as described by the argv.
5203 * The return value is a count of the number of new processes
5204 * created, or -1 if an error occurred while creating the pipeline.
5205 * *pidArrayPtr is filled in with the address of a dynamically
5206 * allocated array giving the ids of all of the processes. It
5207 * is up to the caller to free this array when it isn't needed
5208 * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
5209 * with the file id for the input pipe for the pipeline (if any):
5210 * the caller must eventually close this file. If outPipePtr
5211 * isn't NULL, then *outPipePtr is filled in with the file id
5212 * for the output pipe from the pipeline: the caller must close
5213 * this file. If errFilePtr isn't NULL, then *errFilePtr is filled
5214 * with a file id that may be used to read error output after the
5215 * pipeline completes.
5218 * Processes and pipes are created.
5220 *----------------------------------------------------------------------
5223 Jim_CreatePipeline(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int **pidArrayPtr
,
5224 int *inPipePtr
, int *outPipePtr
, int *errFilePtr
)
5226 int *pidPtr
= NULL
; /* Points to malloc-ed array holding all
5227 * the pids of child processes. */
5228 int numPids
= 0; /* Actual number of processes that exist
5229 * at *pidPtr right now. */
5230 int cmdCount
; /* Count of number of distinct commands
5231 * found in argc/argv. */
5232 const char *input
= NULL
; /* Describes input for pipeline, depending
5233 * on "inputFile". NULL means take input
5234 * from stdin/pipe. */
5236 #define FILE_NAME 0 /* input/output: filename */
5237 #define FILE_APPEND 1 /* output only: filename, append */
5238 #define FILE_HANDLE 2 /* input/output: filehandle */
5239 #define FILE_TEXT 3 /* input only: input is actual text */
5241 int inputFile
= FILE_NAME
; /* 1 means input is name of input file.
5242 * 2 means input is filehandle name.
5243 * 0 means input holds actual
5244 * text to be input to command. */
5246 int outputFile
= FILE_NAME
; /* 0 means output is the name of output file.
5247 * 1 means output is the name of output file, and append.
5248 * 2 means output is filehandle name.
5249 * All this is ignored if output is NULL
5251 int errorFile
= FILE_NAME
; /* 0 means error is the name of error file.
5252 * 1 means error is the name of error file, and append.
5253 * 2 means error is filehandle name.
5254 * All this is ignored if error is NULL
5256 const char *output
= NULL
; /* Holds name of output file to pipe to,
5257 * or NULL if output goes to stdout/pipe. */
5258 const char *error
= NULL
; /* Holds name of stderr file to pipe to,
5259 * or NULL if stderr goes to stderr/pipe. */
5260 int inputId
= -1; /* Readable file id input to current command in
5261 * pipeline (could be file or pipe). -1
5262 * means use stdin. */
5263 int outputId
= -1; /* Writable file id for output from current
5264 * command in pipeline (could be file or pipe).
5265 * -1 means use stdout. */
5266 int errorId
= -1; /* Writable file id for all standard error
5267 * output from all commands in pipeline. -1
5268 * means use stderr. */
5269 int lastOutputId
= -1; /* Write file id for output from last command
5270 * in pipeline (could be file or pipe).
5271 * -1 means use stdout. */
5272 int pipeIds
[2]; /* File ids for pipe that's being created. */
5273 int firstArg
, lastArg
; /* Indexes of first and last arguments in
5274 * current command. */
5278 char **orig_environ
;
5279 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5281 /* Holds the args which will be used to exec */
5282 char **arg_array
= Jim_Alloc(sizeof(*arg_array
) * (argc
+ 1));
5285 Jim_ReapDetachedPids(table
);
5287 if (inPipePtr
!= NULL
) {
5290 if (outPipePtr
!= NULL
) {
5293 if (errFilePtr
!= NULL
) {
5296 pipeIds
[0] = pipeIds
[1] = -1;
5299 * First, scan through all the arguments to figure out the structure
5300 * of the pipeline. Count the number of distinct processes (it's the
5301 * number of "|" arguments). If there are "<", "<<", or ">" arguments
5302 * then make note of input and output redirection and remove these
5303 * arguments and the arguments that follow them.
5307 for (i
= 0; i
< argc
; i
++) {
5308 const char *arg
= Jim_String(argv
[i
]);
5310 if (arg
[0] == '<') {
5311 inputFile
= FILE_NAME
;
5313 if (*input
== '<') {
5314 inputFile
= FILE_TEXT
;
5317 else if (*input
== '@') {
5318 inputFile
= FILE_HANDLE
;
5322 if (!*input
&& ++i
< argc
) {
5323 input
= Jim_String(argv
[i
]);
5326 else if (arg
[0] == '>') {
5329 outputFile
= FILE_NAME
;
5332 if (*output
== '>') {
5333 outputFile
= FILE_APPEND
;
5336 if (*output
== '&') {
5337 /* Redirect stderr too */
5341 if (*output
== '@') {
5342 outputFile
= FILE_HANDLE
;
5345 if (!*output
&& ++i
< argc
) {
5346 output
= Jim_String(argv
[i
]);
5349 errorFile
= outputFile
;
5353 else if (arg
[0] == '2' && arg
[1] == '>') {
5355 errorFile
= FILE_NAME
;
5357 if (*error
== '@') {
5358 errorFile
= FILE_HANDLE
;
5361 else if (*error
== '>') {
5362 errorFile
= FILE_APPEND
;
5365 if (!*error
&& ++i
< argc
) {
5366 error
= Jim_String(argv
[i
]);
5370 if (strcmp(arg
, "|") == 0 || strcmp(arg
, "|&") == 0) {
5371 if (i
== lastBar
+ 1 || i
== argc
- 1) {
5372 Jim_SetResultString(interp
, "illegal use of | or |& in command", -1);
5378 /* Either |, |& or a "normal" arg, so store it in the arg array */
5379 arg_array
[arg_count
++] = (char *)arg
;
5384 Jim_SetResultFormatted(interp
, "can't specify \"%s\" as last word in command", arg
);
5389 if (arg_count
== 0) {
5390 Jim_SetResultString(interp
, "didn't specify command to execute", -1);
5392 Jim_Free(arg_array
);
5396 /* Must do this before vfork(), so do it now */
5397 orig_environ
= Jim_GetEnviron();
5398 Jim_SetEnviron(JimBuildEnv(interp
));
5401 * Set up the redirected input source for the pipeline, if
5404 if (input
!= NULL
) {
5405 if (inputFile
== FILE_TEXT
) {
5407 * Immediate data in command. Create temporary file and
5408 * put data into file.
5411 #define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
5412 char inName
[sizeof(TMP_STDIN_NAME
) + 1];
5415 strcpy(inName
, TMP_STDIN_NAME
);
5416 inputId
= mkstemp(inName
);
5418 Jim_SetResultErrno(interp
, "couldn't create input file for command");
5421 length
= strlen(input
);
5422 if (write(inputId
, input
, length
) != length
) {
5423 Jim_SetResultErrno(interp
, "couldn't write file input for command");
5426 if (lseek(inputId
, 0L, SEEK_SET
) == -1 || unlink(inName
) == -1) {
5427 Jim_SetResultErrno(interp
, "couldn't reset or remove input file for command");
5431 else if (inputFile
== FILE_HANDLE
) {
5432 /* Should be a file descriptor */
5433 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, input
, -1);
5434 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5436 Jim_FreeNewObj(interp
, fhObj
);
5440 inputId
= dup(fileno(fh
));
5444 * File redirection. Just open the file.
5446 inputId
= open(input
, O_RDONLY
, 0);
5448 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", input
,
5454 else if (inPipePtr
!= NULL
) {
5455 if (pipe(pipeIds
) != 0) {
5456 Jim_SetResultErrno(interp
, "couldn't create input pipe for command");
5459 inputId
= pipeIds
[0];
5460 *inPipePtr
= pipeIds
[1];
5461 pipeIds
[0] = pipeIds
[1] = -1;
5465 * Set up the redirected output sink for the pipeline from one
5466 * of two places, if requested.
5468 if (output
!= NULL
) {
5469 if (outputFile
== FILE_HANDLE
) {
5470 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, output
, -1);
5471 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5473 Jim_FreeNewObj(interp
, fhObj
);
5478 lastOutputId
= dup(fileno(fh
));
5482 * Output is to go to a file.
5484 int mode
= O_WRONLY
| O_CREAT
| O_TRUNC
;
5486 if (outputFile
== FILE_APPEND
) {
5487 mode
= O_WRONLY
| O_CREAT
| O_APPEND
;
5490 lastOutputId
= open(output
, mode
, 0666);
5491 if (lastOutputId
< 0) {
5492 Jim_SetResultFormatted(interp
, "couldn't write file \"%s\": %s", output
,
5498 else if (outPipePtr
!= NULL
) {
5500 * Output is to go to a pipe.
5502 if (pipe(pipeIds
) != 0) {
5503 Jim_SetResultErrno(interp
, "couldn't create output pipe");
5506 lastOutputId
= pipeIds
[1];
5507 *outPipePtr
= pipeIds
[0];
5508 pipeIds
[0] = pipeIds
[1] = -1;
5511 /* If we are redirecting stderr with 2>filename or 2>@fileId, then we ignore errFilePtr */
5512 if (error
!= NULL
) {
5513 if (errorFile
== FILE_HANDLE
) {
5514 if (strcmp(error
, "1") == 0) {
5516 if (lastOutputId
>= 0) {
5517 errorId
= dup(lastOutputId
);
5520 /* No redirection of stdout, so just use 2>@stdout */
5525 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, error
, -1);
5526 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5528 Jim_FreeNewObj(interp
, fhObj
);
5533 errorId
= dup(fileno(fh
));
5538 * Output is to go to a file.
5540 int mode
= O_WRONLY
| O_CREAT
| O_TRUNC
;
5542 if (errorFile
== FILE_APPEND
) {
5543 mode
= O_WRONLY
| O_CREAT
| O_APPEND
;
5546 errorId
= open(error
, mode
, 0666);
5548 Jim_SetResultFormatted(interp
, "couldn't write file \"%s\": %s", error
,
5553 else if (errFilePtr
!= NULL
) {
5555 * Set up the standard error output sink for the pipeline, if
5556 * requested. Use a temporary file which is opened, then deleted.
5557 * Could potentially just use pipe, but if it filled up it could
5558 * cause the pipeline to deadlock: we'd be waiting for processes
5559 * to complete before reading stderr, and processes couldn't complete
5560 * because stderr was backed up.
5563 #define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
5564 char errName
[sizeof(TMP_STDERR_NAME
) + 1];
5566 strcpy(errName
, TMP_STDERR_NAME
);
5567 errorId
= mkstemp(errName
);
5570 Jim_SetResultErrno(interp
, "couldn't create error file for command");
5573 *errFilePtr
= open(errName
, O_RDONLY
, 0);
5574 if (*errFilePtr
< 0) {
5577 if (unlink(errName
) == -1) {
5578 Jim_SetResultErrno(interp
, "couldn't remove error file for command");
5584 * Scan through the argc array, forking off a process for each
5585 * group of arguments between "|" arguments.
5588 pidPtr
= (int *)Jim_Alloc(cmdCount
* sizeof(*pidPtr
));
5589 for (i
= 0; i
< numPids
; i
++) {
5592 for (firstArg
= 0; firstArg
< arg_count
; numPids
++, firstArg
= lastArg
+ 1) {
5593 int pipe_dup_err
= 0;
5594 int origErrorId
= errorId
;
5598 for (lastArg
= firstArg
; lastArg
< arg_count
; lastArg
++) {
5599 if (arg_array
[lastArg
][0] == '|') {
5600 if (arg_array
[lastArg
][1] == '&') {
5606 /* Replace | with NULL for execv() */
5607 arg_array
[lastArg
] = NULL
;
5608 if (lastArg
== arg_count
) {
5609 outputId
= lastOutputId
;
5612 if (pipe(pipeIds
) != 0) {
5613 Jim_SetResultErrno(interp
, "couldn't create pipe");
5616 outputId
= pipeIds
[1];
5618 execName
= arg_array
[firstArg
];
5620 /* Now fork the child */
5623 * Disable SIGPIPE signals: if they were allowed, this process
5624 * might go away unexpectedly if children misbehave. This code
5625 * can potentially interfere with other application code that
5626 * expects to handle SIGPIPEs; what's really needed is an
5627 * arbiter for signals to allow them to be "shared".
5629 if (table
->info
== NULL
) {
5630 (void)signal(SIGPIPE
, SIG_IGN
);
5633 /* Need to do this befor vfork() */
5638 /* Need to prep an error message before vfork(), just in case */
5639 snprintf(execerr
, sizeof(execerr
), "couldn't exec \"%s\"", execName
);
5640 execerrlen
= strlen(execerr
);
5643 * Make a new process and enter it into the table if the fork
5648 Jim_SetResultErrno(interp
, "couldn't fork child process");
5654 if (inputId
!= -1) dup2(inputId
, 0);
5655 if (outputId
!= -1) dup2(outputId
, 1);
5656 if (errorId
!= -1) dup2(errorId
, 2);
5658 for (i
= 3; (i
<= outputId
) || (i
<= inputId
) || (i
<= errorId
); i
++) {
5662 execvp(execName
, &arg_array
[firstArg
]);
5664 /* we really can ignore the error here! */
5665 IGNORE_RC(write(2, execerr
, execerrlen
));
5672 * Enlarge the wait table if there isn't enough space for a new
5675 if (table
->used
== table
->size
) {
5676 table
->size
+= WAIT_TABLE_GROW_BY
;
5677 table
->info
= Jim_Realloc(table
->info
, table
->size
* sizeof(*table
->info
));
5680 table
->info
[table
->used
].pid
= pid
;
5681 table
->info
[table
->used
].flags
= 0;
5684 pidPtr
[numPids
] = pid
;
5686 /* Restore in case of pipe_dup_err */
5687 errorId
= origErrorId
;
5690 * Close off our copies of file descriptors that were set up for
5691 * this child, then set up the input for the next child.
5694 if (inputId
!= -1) {
5697 if (outputId
!= -1) {
5700 inputId
= pipeIds
[0];
5701 pipeIds
[0] = pipeIds
[1] = -1;
5703 *pidArrayPtr
= pidPtr
;
5706 * All done. Cleanup open files lying around and then return.
5710 if (inputId
!= -1) {
5713 if (lastOutputId
!= -1) {
5714 close(lastOutputId
);
5716 if (errorId
!= -1) {
5719 Jim_Free(arg_array
);
5721 JimFreeEnv(interp
, Jim_GetEnviron(), orig_environ
);
5722 Jim_SetEnviron(orig_environ
);
5727 * An error occurred. There could have been extra files open, such
5728 * as pipes between children. Clean them all up. Detach any child
5729 * processes that have been created.
5733 if ((inPipePtr
!= NULL
) && (*inPipePtr
!= -1)) {
5737 if ((outPipePtr
!= NULL
) && (*outPipePtr
!= -1)) {
5741 if ((errFilePtr
!= NULL
) && (*errFilePtr
!= -1)) {
5745 if (pipeIds
[0] != -1) {
5748 if (pipeIds
[1] != -1) {
5751 if (pidPtr
!= NULL
) {
5752 for (i
= 0; i
< numPids
; i
++) {
5753 if (pidPtr
[i
] != -1) {
5754 JimDetachPids(interp
, 1, &pidPtr
[i
]);
5764 *----------------------------------------------------------------------
5766 * CleanupChildren --
5768 * This is a utility procedure used to wait for child processes
5769 * to exit, record information about abnormal exits, and then
5770 * collect any stderr output generated by them.
5773 * The return value is a standard Tcl result. If anything at
5774 * weird happened with the child processes, JIM_ERROR is returned
5775 * and a message is left in interp->result.
5778 * If the last character of interp->result is a newline, then it
5779 * is removed. File errorId gets closed, and pidPtr is freed
5780 * back to the storage allocator.
5782 *----------------------------------------------------------------------
5785 static int Jim_CleanupChildren(Jim_Interp
*interp
, int numPids
, int *pidPtr
, int errorId
)
5787 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5788 int result
= JIM_OK
;
5791 for (i
= 0; i
< numPids
; i
++) {
5793 if (JimWaitPid(table
, pidPtr
[i
], &waitStatus
) > 0) {
5794 if (JimCheckWaitStatus(interp
, pidPtr
[i
], waitStatus
) != JIM_OK
) {
5802 * Read the standard error file. If there's anything there,
5803 * then add the file's contents to the result
5807 if (JimAppendStreamToString(interp
, errorId
, Jim_GetResult(interp
)) != JIM_OK
) {
5808 Jim_SetResultErrno(interp
, "error reading from stderr output file");
5814 JimTrimTrailingNewline(interp
);
5819 int Jim_execInit(Jim_Interp
*interp
)
5821 if (Jim_PackageProvide(interp
, "exec", "1.0", JIM_ERRMSG
))
5824 Jim_CreateCommand(interp
, "exec", Jim_ExecCmd
, JimAllocWaitInfoTable(), JimFreeWaitInfoTable
);
5828 /* e.g. Windows. Poor mans implementation of exec with system()
5829 * The system() call *may* do command line redirection, etc.
5830 * The standard output is not available.
5831 * Can't redirect filehandles.
5833 static int Jim_ExecCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5835 Jim_Obj
*cmdlineObj
= Jim_NewEmptyStringObj(interp
);
5839 /* Create a quoted command line */
5840 for (i
= 1; i
< argc
; i
++) {
5842 const char *arg
= Jim_GetString(argv
[i
], &len
);
5845 Jim_AppendString(interp
, cmdlineObj
, " ", 1);
5847 if (strpbrk(arg
, "\\\" ") == NULL
) {
5848 /* No quoting required */
5849 Jim_AppendString(interp
, cmdlineObj
, arg
, len
);
5853 Jim_AppendString(interp
, cmdlineObj
, "\"", 1);
5854 for (j
= 0; j
< len
; j
++) {
5855 if (arg
[j
] == '\\' || arg
[j
] == '"') {
5856 Jim_AppendString(interp
, cmdlineObj
, "\\", 1);
5858 Jim_AppendString(interp
, cmdlineObj
, &arg
[j
], 1);
5860 Jim_AppendString(interp
, cmdlineObj
, "\"", 1);
5862 rc
= system(Jim_String(cmdlineObj
));
5864 Jim_FreeNewObj(interp
, cmdlineObj
);
5867 Jim_Obj
*errorCode
= Jim_NewListObj(interp
, NULL
, 0);
5868 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "CHILDSTATUS", -1));
5869 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, 0));
5870 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, rc
));
5871 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCode
);
5878 int Jim_execInit(Jim_Interp
*interp
)
5880 if (Jim_PackageProvide(interp
, "exec", "1.0", JIM_ERRMSG
))
5883 Jim_CreateCommand(interp
, "exec", Jim_ExecCmd
, NULL
, NULL
);
5891 * Implements the clock command
5894 /* For strptime() */
5895 #ifndef _XOPEN_SOURCE
5896 #define _XOPEN_SOURCE 500
5903 #include <sys/time.h>
5906 static int clock_cmd_format(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5908 /* How big is big enough? */
5913 const char *format
= "%a %b %d %H:%M:%S %Z %Y";
5915 if (argc
== 2 || (argc
== 3 && !Jim_CompareStringImmediate(interp
, argv
[1], "-format"))) {
5920 format
= Jim_String(argv
[2]);
5923 if (Jim_GetLong(interp
, argv
[0], &seconds
) != JIM_OK
) {
5928 strftime(buf
, sizeof(buf
), format
, localtime(&t
));
5930 Jim_SetResultString(interp
, buf
, -1);
5935 #ifdef HAVE_STRPTIME
5936 static int clock_cmd_scan(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5940 time_t now
= time(0);
5942 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-format")) {
5946 /* Initialise with the current date/time */
5947 localtime_r(&now
, &tm
);
5949 pt
= strptime(Jim_String(argv
[0]), Jim_String(argv
[2]), &tm
);
5950 if (pt
== 0 || *pt
!= 0) {
5951 Jim_SetResultString(interp
, "Failed to parse time according to format", -1);
5955 /* Now convert into a time_t */
5956 Jim_SetResultInt(interp
, mktime(&tm
));
5962 static int clock_cmd_seconds(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5964 Jim_SetResultInt(interp
, time(NULL
));
5969 static int clock_cmd_micros(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5973 gettimeofday(&tv
, NULL
);
5975 Jim_SetResultInt(interp
, (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
);
5980 static int clock_cmd_millis(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5984 gettimeofday(&tv
, NULL
);
5986 Jim_SetResultInt(interp
, (jim_wide
) tv
.tv_sec
* 1000 + tv
.tv_usec
/ 1000);
5991 static const jim_subcmd_type clock_command_table
[] = {
5993 .function
= clock_cmd_seconds
,
5996 .description
= "Returns the current time as seconds since the epoch"
5999 .function
= clock_cmd_micros
,
6002 .description
= "Returns the current time in 'clicks'"
6004 { .cmd
= "microseconds",
6005 .function
= clock_cmd_micros
,
6008 .description
= "Returns the current time in microseconds"
6010 { .cmd
= "milliseconds",
6011 .function
= clock_cmd_millis
,
6014 .description
= "Returns the current time in milliseconds"
6017 .args
= "seconds ?-format format?",
6018 .function
= clock_cmd_format
,
6021 .description
= "Format the given time"
6023 #ifdef HAVE_STRPTIME
6025 .args
= "str -format format",
6026 .function
= clock_cmd_scan
,
6029 .description
= "Determine the time according to the given format"
6035 int Jim_clockInit(Jim_Interp
*interp
)
6037 if (Jim_PackageProvide(interp
, "clock", "1.0", JIM_ERRMSG
))
6040 Jim_CreateCommand(interp
, "clock", Jim_SubCmdProc
, (void *)clock_command_table
, NULL
);
6045 * Implements the array command for jim
6047 * (c) 2008 Steve Bennett <steveb@workware.net.au>
6049 * Redistribution and use in source and binary forms, with or without
6050 * modification, are permitted provided that the following conditions
6053 * 1. Redistributions of source code must retain the above copyright
6054 * notice, this list of conditions and the following disclaimer.
6055 * 2. Redistributions in binary form must reproduce the above
6056 * copyright notice, this list of conditions and the following
6057 * disclaimer in the documentation and/or other materials
6058 * provided with the distribution.
6060 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
6061 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
6062 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
6063 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
6064 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
6065 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
6066 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
6067 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
6068 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
6069 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
6070 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
6071 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
6073 * The views and conclusions contained in the software and documentation
6074 * are those of the authors and should not be interpreted as representing
6075 * official policies, either expressed or implied, of the Jim Tcl Project.
6077 * Based on code originally from Tcl 6.7:
6079 * Copyright 1987-1991 Regents of the University of California
6080 * Permission to use, copy, modify, and distribute this
6081 * software and its documentation for any purpose and without
6082 * fee is hereby granted, provided that the above copyright
6083 * notice appear in all copies. The University of California
6084 * makes no representations about the suitability of this
6085 * software for any purpose. It is provided "as is" without
6086 * express or implied warranty.
6097 static int array_cmd_exists(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6099 /* Just a regular [info exists] */
6100 Jim_SetResultInt(interp
, Jim_GetVariable(interp
, argv
[0], 0) != 0);
6104 static int array_cmd_get(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6110 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6112 Jim_Obj
**dictValuesObj
;
6118 if (argc
== 1 || Jim_CompareStringImmediate(interp
, argv
[1], "*")) {
6122 /* If it is a dictionary or list with an even number of elements, nothing else to do */
6124 if (Jim_IsDict(objPtr
) || (Jim_IsList(objPtr
) && Jim_ListLength(interp
, objPtr
) % 2 == 0)) {
6125 Jim_SetResult(interp
, objPtr
);
6130 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
6134 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
6139 /* Return the whole array */
6140 Jim_SetResult(interp
, dictObj
);
6143 /* Only return the matching values */
6144 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
6146 for (i
= 0; i
< len
; i
+= 2) {
6147 if (Jim_StringMatchObj(interp
, argv
[1], dictValuesObj
[i
], 0)) {
6148 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
]);
6149 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
+ 1]);
6153 Jim_SetResult(interp
, resultObj
);
6155 Jim_Free(dictValuesObj
);
6160 static int array_cmd_names(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6162 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6168 return Jim_DictKeys(interp
, objPtr
, argc
== 1 ? NULL
: argv
[1]);
6171 static int array_cmd_unset(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6178 Jim_Obj
**dictValuesObj
;
6180 if (argc
== 1 || Jim_CompareStringImmediate(interp
, argv
[1], "*")) {
6181 /* Unset the whole array */
6182 Jim_UnsetVariable(interp
, argv
[0], JIM_NONE
);
6186 objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6188 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
6192 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
6196 /* Create a new object with the values which don't match */
6197 resultObj
= Jim_NewDictObj(interp
, NULL
, 0);
6199 for (i
= 0; i
< len
; i
+= 2) {
6200 if (!Jim_StringMatchObj(interp
, argv
[1], dictValuesObj
[i
], 0)) {
6201 Jim_DictAddElement(interp
, resultObj
, dictValuesObj
[i
], dictValuesObj
[i
+ 1]);
6204 Jim_Free(dictValuesObj
);
6206 Jim_SetVariable(interp
, argv
[0], resultObj
);
6210 static int array_cmd_size(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6215 /* Not found means zero length */
6216 objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6218 len
= Jim_DictSize(interp
, objPtr
);
6224 Jim_SetResultInt(interp
, len
);
6229 static int array_cmd_set(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6234 Jim_Obj
*listObj
= argv
[1];
6236 if (Jim_GetVariable(interp
, argv
[0], JIM_NONE
) == NULL
) {
6237 /* Doesn't exist, so just set the list directly */
6238 return Jim_SetVariable(interp
, argv
[0], listObj
);
6241 len
= Jim_ListLength(interp
, listObj
);
6243 Jim_SetResultString(interp
, "list must have an even number of elements", -1);
6246 for (i
= 0; i
< len
&& rc
== JIM_OK
; i
+= 2) {
6250 Jim_ListIndex(interp
, listObj
, i
, &nameObj
, JIM_NONE
);
6251 Jim_ListIndex(interp
, listObj
, i
+ 1, &valueObj
, JIM_NONE
);
6253 rc
= Jim_SetDictKeysVector(interp
, argv
[0], &nameObj
, 1, valueObj
);
6259 static const jim_subcmd_type array_command_table
[] = {
6261 .args
= "arrayName",
6262 .function
= array_cmd_exists
,
6265 .description
= "Does array exist?"
6268 .args
= "arrayName ?pattern?",
6269 .function
= array_cmd_get
,
6272 .description
= "Array contents as name value list"
6275 .args
= "arrayName ?pattern?",
6276 .function
= array_cmd_names
,
6279 .description
= "Array keys as a list"
6282 .args
= "arrayName list",
6283 .function
= array_cmd_set
,
6286 .description
= "Set array from list"
6289 .args
= "arrayName",
6290 .function
= array_cmd_size
,
6293 .description
= "Number of elements in array"
6296 .args
= "arrayName ?pattern?",
6297 .function
= array_cmd_unset
,
6300 .description
= "Unset elements of an array"
6306 int Jim_arrayInit(Jim_Interp
*interp
)
6308 if (Jim_PackageProvide(interp
, "array", "1.0", JIM_ERRMSG
))
6311 Jim_CreateCommand(interp
, "array", Jim_SubCmdProc
, (void *)array_command_table
, NULL
);
6314 int Jim_InitStaticExtensions(Jim_Interp
*interp
)
6316 extern int Jim_bootstrapInit(Jim_Interp
*);
6317 Jim_bootstrapInit(interp
);
6318 extern int Jim_aioInit(Jim_Interp
*);
6319 Jim_aioInit(interp
);
6320 extern int Jim_readdirInit(Jim_Interp
*);
6321 Jim_readdirInit(interp
);
6322 extern int Jim_globInit(Jim_Interp
*);
6323 Jim_globInit(interp
);
6324 extern int Jim_regexpInit(Jim_Interp
*);
6325 Jim_regexpInit(interp
);
6326 extern int Jim_fileInit(Jim_Interp
*);
6327 Jim_fileInit(interp
);
6328 extern int Jim_execInit(Jim_Interp
*);
6329 Jim_execInit(interp
);
6330 extern int Jim_clockInit(Jim_Interp
*);
6331 Jim_clockInit(interp
);
6332 extern int Jim_arrayInit(Jim_Interp
*);
6333 Jim_arrayInit(interp
);
6334 extern int Jim_stdlibInit(Jim_Interp
*);
6335 Jim_stdlibInit(interp
);
6336 extern int Jim_tclcompatInit(Jim_Interp
*);
6337 Jim_tclcompatInit(interp
);
6341 /* Jim - A small embeddable Tcl interpreter
6343 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
6344 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6345 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6346 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
6347 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
6348 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
6349 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
6350 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
6351 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
6352 * Copyright 2009 Zachary T Welch zw@superlucidity.net
6353 * Copyright 2009 David Brownell
6355 * Redistribution and use in source and binary forms, with or without
6356 * modification, are permitted provided that the following conditions
6359 * 1. Redistributions of source code must retain the above copyright
6360 * notice, this list of conditions and the following disclaimer.
6361 * 2. Redistributions in binary form must reproduce the above
6362 * copyright notice, this list of conditions and the following
6363 * disclaimer in the documentation and/or other materials
6364 * provided with the distribution.
6366 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
6367 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
6368 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
6369 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
6370 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
6371 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
6372 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
6373 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
6374 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
6375 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
6376 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
6377 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
6379 * The views and conclusions contained in the software and documentation
6380 * are those of the authors and should not be interpreted as representing
6381 * official policies, either expressed or implied, of the Jim Tcl Project.
6383 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
6398 #include <sys/time.h>
6401 #ifdef HAVE_BACKTRACE
6402 #include <execinfo.h>
6404 #ifdef HAVE_CRT_EXTERNS_H
6405 #include <crt_externs.h>
6408 /* For INFINITY, even if math functions are not enabled */
6411 /* For the no-autoconf case */
6413 #define TCL_LIBRARY "."
6415 #ifndef TCL_PLATFORM_OS
6416 #define TCL_PLATFORM_OS "unknown"
6418 #ifndef TCL_PLATFORM_PLATFORM
6419 #define TCL_PLATFORM_PLATFORM "unknown"
6422 /*#define DEBUG_SHOW_SCRIPT*/
6423 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
6424 /*#define DEBUG_SHOW_SUBST*/
6425 /*#define DEBUG_SHOW_EXPR*/
6426 /*#define DEBUG_SHOW_EXPR_TOKENS*/
6427 /*#define JIM_DEBUG_GC*/
6428 #ifdef JIM_MAINTAINER
6429 #define JIM_DEBUG_COMMAND
6430 #define JIM_DEBUG_PANIC
6433 const char *jim_tt_name(int type
);
6435 #ifdef JIM_DEBUG_PANIC
6436 static void JimPanicDump(int panic_condition
, Jim_Interp
*interp
, const char *fmt
, ...);
6437 #define JimPanic(X) JimPanicDump X
6442 /* -----------------------------------------------------------------------------
6444 * ---------------------------------------------------------------------------*/
6446 /* A shared empty string for the objects string representation.
6447 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
6448 static char JimEmptyStringRep
[] = "";
6450 /* -----------------------------------------------------------------------------
6451 * Required prototypes of not exported functions
6452 * ---------------------------------------------------------------------------*/
6453 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
);
6454 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
);
6455 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
6457 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6458 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6459 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
6460 const char *prefix
, const char *const *tablePtr
, const char *name
);
6461 static void JimDeleteLocalProcs(Jim_Interp
*interp
);
6462 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
,
6463 int argc
, Jim_Obj
*const *argv
);
6464 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
6465 const char *filename
, int linenr
);
6466 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
6467 static int JimSign(jim_wide w
);
6468 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
6469 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
6470 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
6473 static const Jim_HashTableType JimVariablesHashTableType
;
6475 /* Fast access to the int (wide) value of an object which is known to be of int type */
6476 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
6478 #define JimObjTypeName(O) (objPtr->typePtr ? objPtr->typePtr->name : "none")
6480 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
6482 int l
= utf8_tounicode(s
, uc
);
6484 *uc
= utf8_upper(*uc
);
6489 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
6490 #define JIM_CHARSET_SCAN 2
6491 #define JIM_CHARSET_GLOB 0
6494 * pattern points to a string like "[^a-z\ub5]"
6496 * The pattern may contain trailing chars, which are ignored.
6498 * The pattern is matched against unicode char 'c'.
6500 * If (flags & JIM_NOCASE), case is ignored when matching.
6501 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
6502 * of the charset, per scan, rather than glob/string match.
6504 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
6505 * or the null character if the ']' is missing.
6507 * Returns NULL on no match.
6509 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
6516 if (flags
& JIM_NOCASE
) {
6521 if (flags
& JIM_CHARSET_SCAN
) {
6522 if (*pattern
== '^') {
6527 /* Special case. If the first char is ']', it is part of the set */
6528 if (*pattern
== ']') {
6533 while (*pattern
&& *pattern
!= ']') {
6535 if (pattern
[0] == '\\') {
6537 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
6540 /* Is this a range? a-z */
6544 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
6545 if (pattern
[0] == '-' && pattern
[1]) {
6547 pattern
+= utf8_tounicode(pattern
, &pchar
);
6548 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
6550 /* Handle reversed range too */
6551 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
6567 return match
? pattern
: NULL
;
6570 /* Glob-style pattern matching. */
6572 /* Note: string *must* be valid UTF-8 sequences
6573 * slen is a char length, not byte counts.
6575 static int GlobMatch(const char *pattern
, const char *string
, int nocase
)
6580 switch (pattern
[0]) {
6582 while (pattern
[1] == '*') {
6587 return 1; /* match */
6590 /* Recursive call - Does the remaining pattern match anywhere? */
6591 if (GlobMatch(pattern
, string
, nocase
))
6592 return 1; /* match */
6593 string
+= utf8_tounicode(string
, &c
);
6595 return 0; /* no match */
6598 string
+= utf8_tounicode(string
, &c
);
6602 string
+= utf8_tounicode(string
, &c
);
6603 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
6608 /* Ran out of pattern (no ']') */
6619 string
+= utf8_tounicode_case(string
, &c
, nocase
);
6620 utf8_tounicode_case(pattern
, &pchar
, nocase
);
6626 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
6628 while (*pattern
== '*') {
6634 if (!*pattern
&& !*string
) {
6640 static int JimStringMatch(Jim_Interp
*interp
, Jim_Obj
*patternObj
, const char *string
, int nocase
)
6642 return GlobMatch(Jim_String(patternObj
), string
, nocase
);
6646 * string comparison works on binary data.
6648 * Note that the lengths are byte lengths, not char lengths.
6650 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
)
6653 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
6656 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
6659 return JimSign(memcmp(s1
, s2
, l1
));
6666 * If maxchars is -1, compares to end of string.
6667 * Otherwise compares at most 'maxchars' characters.
6669 static int JimStringCompareNoCase(const char *s1
, const char *s2
, int maxchars
)
6671 while (*s1
&& *s2
&& maxchars
) {
6673 s1
+= utf8_tounicode_case(s1
, &c1
, 1);
6674 s2
+= utf8_tounicode_case(s2
, &c2
, 1);
6676 return JimSign(c1
- c2
);
6683 /* One string or both terminated */
6693 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
6694 * The index of the first occurrence of s1 in s2 is returned.
6695 * If s1 is not found inside s2, -1 is returned. */
6696 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
6701 if (!l1
|| !l2
|| l1
> l2
) {
6706 s2
+= utf8_index(s2
, idx
);
6708 l1bytelen
= utf8_index(s1
, l1
);
6710 for (i
= idx
; i
<= l2
- l1
; i
++) {
6712 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
6715 s2
+= utf8_tounicode(s2
, &c
);
6721 * Note: Lengths and return value are in bytes, not chars.
6723 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
6727 if (!l1
|| !l2
|| l1
> l2
)
6730 /* Now search for the needle */
6731 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
6732 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
6741 * Note: Lengths and return value are in chars.
6743 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
6745 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
6747 n
= utf8_strlen(s2
, n
);
6753 int Jim_WideToString(char *buf
, jim_wide wideValue
)
6755 const char *fmt
= "%" JIM_WIDE_MODIFIER
;
6757 return sprintf(buf
, fmt
, wideValue
);
6761 * After an strtol()/strtod()-like conversion,
6762 * check whether something was converted and that
6763 * the only thing left is white space.
6765 * Returns JIM_OK or JIM_ERR.
6767 static int JimCheckConversion(const char *str
, const char *endptr
)
6769 if (str
[0] == '\0' || str
== endptr
) {
6773 if (endptr
[0] != '\0') {
6775 if (!isspace(UCHAR(*endptr
))) {
6784 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
6788 *widePtr
= strtoull(str
, &endptr
, base
);
6790 return JimCheckConversion(str
, endptr
);
6793 int Jim_DoubleToString(char *buf
, double doubleValue
)
6798 len
= sprintf(buf
, "%.12g", doubleValue
);
6800 /* Add a final ".0" if it's a number. But not
6803 if (*buf
== '.' || isalpha(UCHAR(*buf
))) {
6804 /* inf -> Inf, nan -> Nan */
6805 if (*buf
== 'i' || *buf
== 'n') {
6806 *buf
= toupper(UCHAR(*buf
));
6809 /* Infinity -> Inf */
6811 len
= buf
- buf0
+ 3;
6825 int Jim_StringToDouble(const char *str
, double *doublePtr
)
6829 /* Callers can check for underflow via ERANGE */
6832 *doublePtr
= strtod(str
, &endptr
);
6834 return JimCheckConversion(str
, endptr
);
6837 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
6839 jim_wide i
, res
= 1;
6841 if ((b
== 0 && e
!= 0) || (e
< 0))
6843 for (i
= 0; i
< e
; i
++) {
6849 /* -----------------------------------------------------------------------------
6851 * ---------------------------------------------------------------------------*/
6852 #ifdef JIM_DEBUG_PANIC
6853 /* Note that 'interp' may be NULL if not available in the
6854 * context of the panic. It's only useful to get the error
6855 * file descriptor, it will default to stderr otherwise. */
6856 void JimPanicDump(int condition
, Jim_Interp
*interp
, const char *fmt
, ...)
6866 * Send it here first.. Assuming STDIO still works
6868 fprintf(stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
6869 vfprintf(stderr
, fmt
, ap
);
6870 fprintf(stderr
, JIM_NL JIM_NL
);
6873 #ifdef HAVE_BACKTRACE
6879 size
= backtrace(array
, 40);
6880 strings
= backtrace_symbols(array
, size
);
6881 for (i
= 0; i
< size
; i
++)
6882 fprintf(stderr
, "[backtrace] %s" JIM_NL
, strings
[i
]);
6883 fprintf(stderr
, "[backtrace] Include the above lines and the output" JIM_NL
);
6884 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL
);
6892 /* -----------------------------------------------------------------------------
6894 * ---------------------------------------------------------------------------*/
6896 void *Jim_Alloc(int size
)
6898 return malloc(size
);
6901 void Jim_Free(void *ptr
)
6906 void *Jim_Realloc(void *ptr
, int size
)
6908 return realloc(ptr
, size
);
6911 char *Jim_StrDup(const char *s
)
6916 char *Jim_StrDupLen(const char *s
, int l
)
6918 char *copy
= Jim_Alloc(l
+ 1);
6920 memcpy(copy
, s
, l
+ 1);
6921 copy
[l
] = 0; /* Just to be sure, original could be substring */
6925 /* -----------------------------------------------------------------------------
6926 * Time related functions
6927 * ---------------------------------------------------------------------------*/
6929 /* Returns microseconds of CPU used since start. */
6930 static jim_wide
JimClock(void)
6934 gettimeofday(&tv
, NULL
);
6935 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
6938 /* -----------------------------------------------------------------------------
6940 * ---------------------------------------------------------------------------*/
6942 /* -------------------------- private prototypes ---------------------------- */
6943 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
6944 static unsigned int JimHashTableNextPower(unsigned int size
);
6945 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
);
6947 /* -------------------------- hash functions -------------------------------- */
6949 /* Thomas Wang's 32 bit Mix Function */
6950 unsigned int Jim_IntHashFunction(unsigned int key
)
6952 key
+= ~(key
<< 15);
6956 key
+= ~(key
<< 11);
6961 /* Generic hash function (we are using to multiply by 9 and add the byte
6963 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
6968 h
+= (h
<< 3) + *buf
++;
6972 /* ----------------------------- API implementation ------------------------- */
6974 /* reset a hashtable already initialized with ht_init().
6975 * NOTE: This function should only called by ht_destroy(). */
6976 static void JimResetHashTable(Jim_HashTable
*ht
)
6985 /* Initialize the hash table */
6986 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
6988 JimResetHashTable(ht
);
6990 ht
->privdata
= privDataPtr
;
6994 /* Resize the table to the minimal size that contains all the elements,
6995 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
6996 int Jim_ResizeHashTable(Jim_HashTable
*ht
)
6998 int minimal
= ht
->used
;
7000 if (minimal
< JIM_HT_INITIAL_SIZE
)
7001 minimal
= JIM_HT_INITIAL_SIZE
;
7002 return Jim_ExpandHashTable(ht
, minimal
);
7005 /* Expand or create the hashtable */
7006 int Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
7008 Jim_HashTable n
; /* the new hashtable */
7009 unsigned int realsize
= JimHashTableNextPower(size
), i
;
7011 /* the size is invalid if it is smaller than the number of
7012 * elements already inside the hashtable */
7013 if (ht
->used
>= size
)
7016 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
7018 n
.sizemask
= realsize
- 1;
7019 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
7021 /* Initialize all the pointers to NULL */
7022 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
7024 /* Copy all the elements from the old to the new table:
7025 * note that if the old hash table is empty ht->size is zero,
7026 * so Jim_ExpandHashTable just creates an hash table. */
7028 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
7029 Jim_HashEntry
*he
, *nextHe
;
7031 if (ht
->table
[i
] == NULL
)
7034 /* For each hash entry on this slot... */
7040 /* Get the new element index */
7041 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
7042 he
->next
= n
.table
[h
];
7045 /* Pass to the next element */
7049 assert(ht
->used
== 0);
7050 Jim_Free(ht
->table
);
7052 /* Remap the new hashtable in the old */
7057 /* Add an element to the target hash table */
7058 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
7061 Jim_HashEntry
*entry
;
7063 /* Get the index of the new element, or -1 if
7064 * the element already exists. */
7065 if ((idx
= JimInsertHashEntry(ht
, key
)) == -1)
7068 /* Allocates the memory and stores key */
7069 entry
= Jim_Alloc(sizeof(*entry
));
7070 entry
->next
= ht
->table
[idx
];
7071 ht
->table
[idx
] = entry
;
7073 /* Set the hash entry fields. */
7074 Jim_SetHashKey(ht
, entry
, key
);
7075 Jim_SetHashVal(ht
, entry
, val
);
7080 /* Add an element, discarding the old if the key already exists */
7081 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
7083 Jim_HashEntry
*entry
;
7085 /* Try to add the element. If the key
7086 * does not exists Jim_AddHashEntry will suceed. */
7087 if (Jim_AddHashEntry(ht
, key
, val
) == JIM_OK
)
7089 /* It already exists, get the entry */
7090 entry
= Jim_FindHashEntry(ht
, key
);
7091 /* Free the old value and set the new one */
7092 Jim_FreeEntryVal(ht
, entry
);
7093 Jim_SetHashVal(ht
, entry
, val
);
7097 /* Search and remove an element */
7098 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
7101 Jim_HashEntry
*he
, *prevHe
;
7105 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7110 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
7111 /* Unlink the element from the list */
7113 prevHe
->next
= he
->next
;
7115 ht
->table
[h
] = he
->next
;
7116 Jim_FreeEntryKey(ht
, he
);
7117 Jim_FreeEntryVal(ht
, he
);
7125 return JIM_ERR
; /* not found */
7128 /* Destroy an entire hash table */
7129 int Jim_FreeHashTable(Jim_HashTable
*ht
)
7133 /* Free all the elements */
7134 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
7135 Jim_HashEntry
*he
, *nextHe
;
7137 if ((he
= ht
->table
[i
]) == NULL
)
7141 Jim_FreeEntryKey(ht
, he
);
7142 Jim_FreeEntryVal(ht
, he
);
7148 /* Free the table and the allocated cache structure */
7149 Jim_Free(ht
->table
);
7150 /* Re-initialize the table */
7151 JimResetHashTable(ht
);
7152 return JIM_OK
; /* never fails */
7155 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
7162 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7165 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
7172 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
7174 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
7179 iter
->nextEntry
= NULL
;
7183 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
7186 if (iter
->entry
== NULL
) {
7188 if (iter
->index
>= (signed)iter
->ht
->size
)
7190 iter
->entry
= iter
->ht
->table
[iter
->index
];
7193 iter
->entry
= iter
->nextEntry
;
7196 /* We need to save the 'next' here, the iterator user
7197 * may delete the entry we are returning. */
7198 iter
->nextEntry
= iter
->entry
->next
;
7205 /* ------------------------- private functions ------------------------------ */
7207 /* Expand the hash table if needed */
7208 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
7210 /* If the hash table is empty expand it to the intial size,
7211 * if the table is "full" dobule its size. */
7213 return Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
7214 if (ht
->size
== ht
->used
)
7215 return Jim_ExpandHashTable(ht
, ht
->size
* 2);
7219 /* Our hash table capability is a power of two */
7220 static unsigned int JimHashTableNextPower(unsigned int size
)
7222 unsigned int i
= JIM_HT_INITIAL_SIZE
;
7224 if (size
>= 2147483648U)
7233 /* Returns the index of a free slot that can be populated with
7234 * an hash entry for the given 'key'.
7235 * If the key already exists, -1 is returned. */
7236 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
)
7241 /* Expand the hashtable if needed */
7242 if (JimExpandHashTableIfNeeded(ht
) == JIM_ERR
)
7244 /* Compute the key hash value */
7245 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7246 /* Search if this slot does not already contain the given key */
7249 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
7256 /* ----------------------- StringCopy Hash Table Type ------------------------*/
7258 static unsigned int JimStringCopyHTHashFunction(const void *key
)
7260 return Jim_GenHashFunction(key
, strlen(key
));
7263 static const void *JimStringCopyHTKeyDup(void *privdata
, const void *key
)
7265 int len
= strlen(key
);
7266 char *copy
= Jim_Alloc(len
+ 1);
7268 JIM_NOTUSED(privdata
);
7270 memcpy(copy
, key
, len
);
7275 static void *JimStringKeyValCopyHTValDup(void *privdata
, const void *val
)
7277 int len
= strlen(val
);
7278 char *copy
= Jim_Alloc(len
+ 1);
7280 JIM_NOTUSED(privdata
);
7282 memcpy(copy
, val
, len
);
7287 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7289 JIM_NOTUSED(privdata
);
7291 return strcmp(key1
, key2
) == 0;
7294 static void JimStringCopyHTKeyDestructor(void *privdata
, const void *key
)
7296 JIM_NOTUSED(privdata
);
7298 Jim_Free((void *)key
); /* ATTENTION: const cast */
7301 static void JimStringKeyValCopyHTValDestructor(void *privdata
, void *val
)
7303 JIM_NOTUSED(privdata
);
7305 Jim_Free((void *)val
); /* ATTENTION: const cast */
7309 static Jim_HashTableType JimStringCopyHashTableType
= {
7310 JimStringCopyHTHashFunction
, /* hash function */
7311 JimStringCopyHTKeyDup
, /* key dup */
7313 JimStringCopyHTKeyCompare
, /* key compare */
7314 JimStringCopyHTKeyDestructor
, /* key destructor */
7315 NULL
/* val destructor */
7319 /* This is like StringCopy but does not auto-duplicate the key.
7320 * It's used for intepreter's shared strings. */
7321 static const Jim_HashTableType JimSharedStringsHashTableType
= {
7322 JimStringCopyHTHashFunction
, /* hash function */
7325 JimStringCopyHTKeyCompare
, /* key compare */
7326 JimStringCopyHTKeyDestructor
, /* key destructor */
7327 NULL
/* val destructor */
7330 /* This is like StringCopy but also automatically handle dynamic
7331 * allocated C strings as values. */
7332 static const Jim_HashTableType JimStringKeyValCopyHashTableType
= {
7333 JimStringCopyHTHashFunction
, /* hash function */
7334 JimStringCopyHTKeyDup
, /* key dup */
7335 JimStringKeyValCopyHTValDup
, /* val dup */
7336 JimStringCopyHTKeyCompare
, /* key compare */
7337 JimStringCopyHTKeyDestructor
, /* key destructor */
7338 JimStringKeyValCopyHTValDestructor
, /* val destructor */
7341 typedef struct AssocDataValue
7343 Jim_InterpDeleteProc
*delProc
;
7347 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
7349 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
7351 if (assocPtr
->delProc
!= NULL
)
7352 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
7356 static const Jim_HashTableType JimAssocDataHashTableType
= {
7357 JimStringCopyHTHashFunction
, /* hash function */
7358 JimStringCopyHTKeyDup
, /* key dup */
7360 JimStringCopyHTKeyCompare
, /* key compare */
7361 JimStringCopyHTKeyDestructor
, /* key destructor */
7362 JimAssocDataHashTableValueDestructor
/* val destructor */
7365 /* -----------------------------------------------------------------------------
7366 * Stack - This is a simple generic stack implementation. It is used for
7367 * example in the 'expr' expression compiler.
7368 * ---------------------------------------------------------------------------*/
7369 void Jim_InitStack(Jim_Stack
*stack
)
7373 stack
->vector
= NULL
;
7376 void Jim_FreeStack(Jim_Stack
*stack
)
7378 Jim_Free(stack
->vector
);
7381 int Jim_StackLen(Jim_Stack
*stack
)
7386 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
7388 int neededLen
= stack
->len
+ 1;
7390 if (neededLen
> stack
->maxlen
) {
7391 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
7392 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
7394 stack
->vector
[stack
->len
] = element
;
7398 void *Jim_StackPop(Jim_Stack
*stack
)
7400 if (stack
->len
== 0)
7403 return stack
->vector
[stack
->len
];
7406 void *Jim_StackPeek(Jim_Stack
*stack
)
7408 if (stack
->len
== 0)
7410 return stack
->vector
[stack
->len
- 1];
7413 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
7417 for (i
= 0; i
< stack
->len
; i
++)
7418 freeFunc(stack
->vector
[i
]);
7421 /* -----------------------------------------------------------------------------
7423 * ---------------------------------------------------------------------------*/
7426 #define JIM_TT_NONE 0 /* No token returned */
7427 #define JIM_TT_STR 1 /* simple string */
7428 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
7429 #define JIM_TT_VAR 3 /* var substitution */
7430 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
7431 #define JIM_TT_CMD 5 /* command substitution */
7432 /* Note: Keep these three together for TOKEN_IS_SEP() */
7433 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
7434 #define JIM_TT_EOL 7 /* line separator */
7435 #define JIM_TT_EOF 8 /* end of script */
7437 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
7438 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
7440 /* Additional token types needed for expressions */
7441 #define JIM_TT_SUBEXPR_START 11
7442 #define JIM_TT_SUBEXPR_END 12
7443 #define JIM_TT_EXPR_INT 13
7444 #define JIM_TT_EXPR_DOUBLE 14
7446 #define JIM_TT_EXPRSUGAR 15 /* $(expression) */
7448 /* Operator token types start here */
7449 #define JIM_TT_EXPR_OP 20
7451 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
7454 #define JIM_PS_DEF 0 /* Default state */
7455 #define JIM_PS_QUOTE 1 /* Inside "" */
7456 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
7458 /* Parser context structure. The same context is used both to parse
7459 * Tcl scripts and lists. */
7462 const char *p
; /* Pointer to the point of the program we are parsing */
7463 int len
; /* Remaining length */
7464 int linenr
; /* Current line number */
7466 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
7467 int tline
; /* Line number of the returned token */
7468 int tt
; /* Token type */
7469 int eof
; /* Non zero if EOF condition is true. */
7470 int state
; /* Parser state */
7471 int comment
; /* Non zero if the next chars may be a comment. */
7472 char missing
; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
7473 int missingline
; /* Line number starting the missing token */
7477 * Results of missing quotes, braces, etc. from parsing.
7479 struct JimParseResult
{
7480 char missing
; /* From JimParserCtx.missing */
7481 int line
; /* From JimParserCtx.missingline */
7484 static int JimParseScript(struct JimParserCtx
*pc
);
7485 static int JimParseSep(struct JimParserCtx
*pc
);
7486 static int JimParseEol(struct JimParserCtx
*pc
);
7487 static int JimParseCmd(struct JimParserCtx
*pc
);
7488 static int JimParseQuote(struct JimParserCtx
*pc
);
7489 static int JimParseVar(struct JimParserCtx
*pc
);
7490 static int JimParseBrace(struct JimParserCtx
*pc
);
7491 static int JimParseStr(struct JimParserCtx
*pc
);
7492 static int JimParseComment(struct JimParserCtx
*pc
);
7493 static void JimParseSubCmd(struct JimParserCtx
*pc
);
7494 static int JimParseSubQuote(struct JimParserCtx
*pc
);
7495 static void JimParseSubCmd(struct JimParserCtx
*pc
);
7496 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
7498 /* Initialize a parser context.
7499 * 'prg' is a pointer to the program text, linenr is the line
7500 * number of the first line contained in the program. */
7501 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
7508 pc
->tt
= JIM_TT_NONE
;
7510 pc
->state
= JIM_PS_DEF
;
7511 pc
->linenr
= linenr
;
7514 pc
->missingline
= linenr
;
7517 static int JimParseScript(struct JimParserCtx
*pc
)
7519 while (1) { /* the while is used to reiterate with continue if needed */
7522 pc
->tend
= pc
->p
- 1;
7523 pc
->tline
= pc
->linenr
;
7524 pc
->tt
= JIM_TT_EOL
;
7530 if (*(pc
->p
+ 1) == '\n' && pc
->state
== JIM_PS_DEF
) {
7531 return JimParseSep(pc
);
7535 return JimParseStr(pc
);
7541 if (pc
->state
== JIM_PS_DEF
)
7542 return JimParseSep(pc
);
7545 return JimParseStr(pc
);
7551 if (pc
->state
== JIM_PS_DEF
)
7552 return JimParseEol(pc
);
7554 return JimParseStr(pc
);
7558 return JimParseCmd(pc
);
7562 if (JimParseVar(pc
) == JIM_ERR
) {
7563 pc
->tstart
= pc
->tend
= pc
->p
++;
7565 pc
->tline
= pc
->linenr
;
7566 pc
->tt
= JIM_TT_STR
;
7574 JimParseComment(pc
);
7578 return JimParseStr(pc
);
7582 return JimParseStr(pc
);
7589 static int JimParseSep(struct JimParserCtx
*pc
)
7592 pc
->tline
= pc
->linenr
;
7593 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' ||
7594 (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
7595 if (*pc
->p
== '\\') {
7603 pc
->tend
= pc
->p
- 1;
7604 pc
->tt
= JIM_TT_SEP
;
7608 static int JimParseEol(struct JimParserCtx
*pc
)
7611 pc
->tline
= pc
->linenr
;
7612 while (*pc
->p
== ' ' || *pc
->p
== '\n' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== ';') {
7618 pc
->tend
= pc
->p
- 1;
7619 pc
->tt
= JIM_TT_EOL
;
7624 ** Here are the rules for parsing:
7625 ** {braced expression}
7626 ** - Count open and closing braces
7627 ** - Backslash escapes meaning of braces
7629 ** "quoted expression"
7630 ** - First double quote at start of word terminates the expression
7631 ** - Backslash escapes quote and bracket
7632 ** - [commands brackets] are counted/nested
7633 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
7635 ** [command expression]
7636 ** - Count open and closing brackets
7637 ** - Backslash escapes quote, bracket and brace
7638 ** - [commands brackets] are counted/nested
7639 ** - "quoted expressions" are parsed according to quoting rules
7640 ** - {braced expressions} are parsed according to brace rules
7642 ** For everything, backslash escapes the next char, newline increments current line
7646 * Parses a braced expression starting at pc->p.
7648 * Positions the parser at the end of the braced expression,
7649 * sets pc->tend and possibly pc->missing.
7651 static void JimParseSubBrace(struct JimParserCtx
*pc
)
7655 /* Skip the brace */
7662 if (*++pc
->p
== '\n') {
7675 pc
->tend
= pc
->p
- 1;
7690 pc
->missingline
= pc
->tline
;
7691 pc
->tend
= pc
->p
- 1;
7695 * Parses a quoted expression starting at pc->p.
7697 * Positions the parser at the end of the quoted expression,
7698 * sets pc->tend and possibly pc->missing.
7700 * Returns the type of the token of the string,
7701 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
7704 static int JimParseSubQuote(struct JimParserCtx
*pc
)
7706 int tt
= JIM_TT_STR
;
7707 int line
= pc
->tline
;
7709 /* Skip the quote */
7716 if (*++pc
->p
== '\n') {
7725 pc
->tend
= pc
->p
- 1;
7747 pc
->missingline
= line
;
7748 pc
->tend
= pc
->p
- 1;
7753 * Parses a [command] expression starting at pc->p.
7755 * Positions the parser at the end of the command expression,
7756 * sets pc->tend and possibly pc->missing.
7758 static void JimParseSubCmd(struct JimParserCtx
*pc
)
7761 int startofword
= 1;
7762 int line
= pc
->tline
;
7764 /* Skip the bracket */
7771 if (*++pc
->p
== '\n') {
7784 pc
->tend
= pc
->p
- 1;
7793 JimParseSubQuote(pc
);
7799 JimParseSubBrace(pc
);
7807 startofword
= isspace(UCHAR(*pc
->p
));
7812 pc
->missingline
= line
;
7813 pc
->tend
= pc
->p
- 1;
7816 static int JimParseBrace(struct JimParserCtx
*pc
)
7818 pc
->tstart
= pc
->p
+ 1;
7819 pc
->tline
= pc
->linenr
;
7820 pc
->tt
= JIM_TT_STR
;
7821 JimParseSubBrace(pc
);
7825 static int JimParseCmd(struct JimParserCtx
*pc
)
7827 pc
->tstart
= pc
->p
+ 1;
7828 pc
->tline
= pc
->linenr
;
7829 pc
->tt
= JIM_TT_CMD
;
7834 static int JimParseQuote(struct JimParserCtx
*pc
)
7836 pc
->tstart
= pc
->p
+ 1;
7837 pc
->tline
= pc
->linenr
;
7838 pc
->tt
= JimParseSubQuote(pc
);
7842 static int JimParseVar(struct JimParserCtx
*pc
)
7844 int brace
= 0, stop
= 0;
7845 int ttype
= JIM_TT_VAR
;
7847 pc
->tstart
= ++pc
->p
;
7848 pc
->len
--; /* skip the $ */
7849 pc
->tline
= pc
->linenr
;
7850 if (*pc
->p
== '{') {
7851 pc
->tstart
= ++pc
->p
;
7857 if (*pc
->p
== '}' || pc
->len
== 0) {
7858 pc
->tend
= pc
->p
- 1;
7863 else if (*pc
->p
== '\n')
7871 /* Skip double colon, but not single colon! */
7872 if (pc
->p
[0] == ':' && pc
->len
> 1 && pc
->p
[1] == ':') {
7877 if (!((*pc
->p
>= 'a' && *pc
->p
<= 'z') ||
7878 (*pc
->p
>= 'A' && *pc
->p
<= 'Z') ||
7879 (*pc
->p
>= '0' && *pc
->p
<= '9') || *pc
->p
== '_'))
7886 /* Parse [dict get] syntax sugar. */
7887 if (*pc
->p
== '(') {
7889 const char *paren
= NULL
;
7891 while (count
&& pc
->len
) {
7894 if (*pc
->p
== '\\' && pc
->len
>= 1) {
7898 else if (*pc
->p
== '(') {
7901 else if (*pc
->p
== ')') {
7911 /* Did not find a matching paren. Back up */
7913 pc
->len
+= (pc
->p
- paren
);
7916 ttype
= (*pc
->tstart
== '(') ? JIM_TT_EXPRSUGAR
: JIM_TT_DICTSUGAR
;
7918 pc
->tend
= pc
->p
- 1;
7920 /* Check if we parsed just the '$' character.
7921 * That's not a variable so an error is returned
7922 * to tell the state machine to consider this '$' just
7924 if (pc
->tstart
== pc
->p
) {
7933 static int JimParseStr(struct JimParserCtx
*pc
)
7935 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
7936 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
);
7937 if (newword
&& *pc
->p
== '{') {
7938 return JimParseBrace(pc
);
7940 else if (newword
&& *pc
->p
== '"') {
7941 pc
->state
= JIM_PS_QUOTE
;
7944 /* In case the end quote is missing */
7945 pc
->missingline
= pc
->tline
;
7948 pc
->tline
= pc
->linenr
;
7951 if (pc
->state
== JIM_PS_QUOTE
) {
7954 pc
->tend
= pc
->p
- 1;
7955 pc
->tt
= JIM_TT_ESC
;
7960 if (pc
->state
== JIM_PS_DEF
&& *(pc
->p
+ 1) == '\n') {
7961 pc
->tend
= pc
->p
- 1;
7962 pc
->tt
= JIM_TT_ESC
;
7966 if (*(pc
->p
+ 1) == '\n') {
7974 /* If the following token is not '$' just keep going */
7975 if (pc
->len
> 1 && pc
->p
[1] != '$') {
7979 /* Only need a separate ')' token if the previous was a var */
7980 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
7981 if (pc
->p
== pc
->tstart
) {
7982 /* At the start of the token, so just return this char */
7986 pc
->tend
= pc
->p
- 1;
7987 pc
->tt
= JIM_TT_ESC
;
7994 pc
->tend
= pc
->p
- 1;
7995 pc
->tt
= JIM_TT_ESC
;
8002 if (pc
->state
== JIM_PS_DEF
) {
8003 pc
->tend
= pc
->p
- 1;
8004 pc
->tt
= JIM_TT_ESC
;
8007 else if (*pc
->p
== '\n') {
8012 if (pc
->state
== JIM_PS_QUOTE
) {
8013 pc
->tend
= pc
->p
- 1;
8014 pc
->tt
= JIM_TT_ESC
;
8017 pc
->state
= JIM_PS_DEF
;
8025 return JIM_OK
; /* unreached */
8028 static int JimParseComment(struct JimParserCtx
*pc
)
8031 if (*pc
->p
== '\n') {
8033 if (*(pc
->p
- 1) != '\\') {
8045 /* xdigitval and odigitval are helper functions for JimEscape() */
8046 static int xdigitval(int c
)
8048 if (c
>= '0' && c
<= '9')
8050 if (c
>= 'a' && c
<= 'f')
8051 return c
- 'a' + 10;
8052 if (c
>= 'A' && c
<= 'F')
8053 return c
- 'A' + 10;
8057 static int odigitval(int c
)
8059 if (c
>= '0' && c
<= '7')
8064 /* Perform Tcl escape substitution of 's', storing the result
8065 * string into 'dest'. The escaped string is guaranteed to
8066 * be the same length or shorted than the source string.
8067 * Slen is the length of the string at 's', if it's -1 the string
8068 * length will be calculated by the function.
8070 * The function returns the length of the resulting string. */
8071 static int JimEscape(char *dest
, const char *s
, int slen
)
8079 for (i
= 0; i
< slen
; i
++) {
8109 /* A unicode or hex sequence.
8110 * \u Expect 1-4 hex chars and convert to utf-8.
8111 * \x Expect 1-2 hex chars and convert to hex.
8112 * An invalid sequence means simply the escaped char.
8120 for (k
= 0; k
< (s
[i
] == 'u' ? 4 : 2); k
++) {
8121 int c
= xdigitval(s
[i
+ k
+ 1]);
8125 val
= (val
<< 4) | c
;
8128 /* Got a valid sequence, so convert */
8130 p
+= utf8_fromunicode(p
, val
);
8138 /* Not a valid codepoint, just an escaped char */
8151 /* Replace all spaces and tabs after backslash newline with a single space*/
8155 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
8168 int c
= odigitval(s
[i
+ 1]);
8171 c
= odigitval(s
[i
+ 2]);
8177 val
= (val
* 8) + c
;
8178 c
= odigitval(s
[i
+ 3]);
8184 val
= (val
* 8) + c
;
8205 /* Returns a dynamically allocated copy of the current token in the
8206 * parser context. The function performs conversion of escapes if
8207 * the token is of type JIM_TT_ESC.
8209 * Note that after the conversion, tokens that are grouped with
8210 * braces in the source code, are always recognizable from the
8211 * identical string obtained in a different way from the type.
8213 * For example the string:
8217 * will return as first token "*", of type JIM_TT_STR
8223 * will return as first token "*", of type JIM_TT_ESC
8225 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
8227 const char *start
, *end
;
8235 token
= Jim_Alloc(1);
8239 len
= (end
- start
) + 1;
8240 token
= Jim_Alloc(len
+ 1);
8241 if (pc
->tt
!= JIM_TT_ESC
) {
8242 /* No escape conversion needed? Just copy it. */
8243 memcpy(token
, start
, len
);
8247 /* Else convert the escape chars. */
8248 len
= JimEscape(token
, start
, len
);
8252 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
8255 /* Parses the given string to determine if it represents a complete script.
8257 * This is useful for interactive shells implementation, for [info complete].
8259 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
8260 * '{' on scripts incomplete missing one or more '}' to be balanced.
8261 * '[' on scripts incomplete missing one or more ']' to be balanced.
8262 * '"' on scripts incomplete missing a '"' char.
8264 * If the script is complete, 1 is returned, otherwise 0.
8266 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
8268 struct JimParserCtx parser
;
8270 JimParserInit(&parser
, s
, len
, 1);
8271 while (!parser
.eof
) {
8272 JimParseScript(&parser
);
8275 *stateCharPtr
= parser
.missing
;
8277 return parser
.missing
== ' ';
8280 /* -----------------------------------------------------------------------------
8282 * ---------------------------------------------------------------------------*/
8283 static int JimParseListSep(struct JimParserCtx
*pc
);
8284 static int JimParseListStr(struct JimParserCtx
*pc
);
8285 static int JimParseListQuote(struct JimParserCtx
*pc
);
8287 static int JimParseList(struct JimParserCtx
*pc
)
8294 return JimParseListSep(pc
);
8297 return JimParseListQuote(pc
);
8300 return JimParseBrace(pc
);
8304 return JimParseListStr(pc
);
8309 pc
->tstart
= pc
->tend
= pc
->p
;
8310 pc
->tline
= pc
->linenr
;
8311 pc
->tt
= JIM_TT_EOL
;
8316 static int JimParseListSep(struct JimParserCtx
*pc
)
8319 pc
->tline
= pc
->linenr
;
8320 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== '\n') {
8321 if (*pc
->p
== '\n') {
8327 pc
->tend
= pc
->p
- 1;
8328 pc
->tt
= JIM_TT_SEP
;
8332 static int JimParseListQuote(struct JimParserCtx
*pc
)
8338 pc
->tline
= pc
->linenr
;
8339 pc
->tt
= JIM_TT_STR
;
8344 pc
->tt
= JIM_TT_ESC
;
8345 if (--pc
->len
== 0) {
8346 /* Trailing backslash */
8356 pc
->tend
= pc
->p
- 1;
8365 pc
->tend
= pc
->p
- 1;
8369 static int JimParseListStr(struct JimParserCtx
*pc
)
8372 pc
->tline
= pc
->linenr
;
8373 pc
->tt
= JIM_TT_STR
;
8378 if (--pc
->len
== 0) {
8379 /* Trailing backslash */
8383 pc
->tt
= JIM_TT_ESC
;
8390 pc
->tend
= pc
->p
- 1;
8396 pc
->tend
= pc
->p
- 1;
8400 /* -----------------------------------------------------------------------------
8401 * Jim_Obj related functions
8402 * ---------------------------------------------------------------------------*/
8404 /* Return a new initialized object. */
8405 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
8409 /* -- Check if there are objects in the free list -- */
8410 if (interp
->freeList
!= NULL
) {
8411 /* -- Unlink the object from the free list -- */
8412 objPtr
= interp
->freeList
;
8413 interp
->freeList
= objPtr
->nextObjPtr
;
8416 /* -- No ready to use objects: allocate a new one -- */
8417 objPtr
= Jim_Alloc(sizeof(*objPtr
));
8420 /* Object is returned with refCount of 0. Every
8421 * kind of GC implemented should take care to don't try
8422 * to scan objects with refCount == 0. */
8423 objPtr
->refCount
= 0;
8424 /* All the other fields are left not initialized to save time.
8425 * The caller will probably want to set them to the right
8428 /* -- Put the object into the live list -- */
8429 objPtr
->prevObjPtr
= NULL
;
8430 objPtr
->nextObjPtr
= interp
->liveList
;
8431 if (interp
->liveList
)
8432 interp
->liveList
->prevObjPtr
= objPtr
;
8433 interp
->liveList
= objPtr
;
8438 /* Free an object. Actually objects are never freed, but
8439 * just moved to the free objects list, where they will be
8440 * reused by Jim_NewObj(). */
8441 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8443 /* Check if the object was already freed, panic. */
8444 JimPanic((objPtr
->refCount
!= 0, interp
, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
8445 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
8447 /* Free the internal representation */
8448 Jim_FreeIntRep(interp
, objPtr
);
8449 /* Free the string representation */
8450 if (objPtr
->bytes
!= NULL
) {
8451 if (objPtr
->bytes
!= JimEmptyStringRep
)
8452 Jim_Free(objPtr
->bytes
);
8454 /* Unlink the object from the live objects list */
8455 if (objPtr
->prevObjPtr
)
8456 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
8457 if (objPtr
->nextObjPtr
)
8458 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
8459 if (interp
->liveList
== objPtr
)
8460 interp
->liveList
= objPtr
->nextObjPtr
;
8461 /* Link the object into the free objects list */
8462 objPtr
->prevObjPtr
= NULL
;
8463 objPtr
->nextObjPtr
= interp
->freeList
;
8464 if (interp
->freeList
)
8465 interp
->freeList
->prevObjPtr
= objPtr
;
8466 interp
->freeList
= objPtr
;
8467 objPtr
->refCount
= -1;
8470 /* Invalidate the string representation of an object. */
8471 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
8473 if (objPtr
->bytes
!= NULL
) {
8474 if (objPtr
->bytes
!= JimEmptyStringRep
)
8475 Jim_Free(objPtr
->bytes
);
8477 objPtr
->bytes
= NULL
;
8480 #define Jim_SetStringRep(o, b, l) \
8481 do { (o)->bytes = b; (o)->length = l; } while (0)
8483 /* Set the initial string representation for an object.
8484 * Does not try to free an old one. */
8485 void Jim_InitStringRep(Jim_Obj
*objPtr
, const char *bytes
, int length
)
8488 objPtr
->bytes
= JimEmptyStringRep
;
8492 objPtr
->bytes
= Jim_Alloc(length
+ 1);
8493 objPtr
->length
= length
;
8494 memcpy(objPtr
->bytes
, bytes
, length
);
8495 objPtr
->bytes
[length
] = '\0';
8499 /* Duplicate an object. The returned object has refcount = 0. */
8500 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8504 dupPtr
= Jim_NewObj(interp
);
8505 if (objPtr
->bytes
== NULL
) {
8506 /* Object does not have a valid string representation. */
8507 dupPtr
->bytes
= NULL
;
8510 Jim_InitStringRep(dupPtr
, objPtr
->bytes
, objPtr
->length
);
8513 /* By default, the new object has the same type as the old object */
8514 dupPtr
->typePtr
= objPtr
->typePtr
;
8515 if (objPtr
->typePtr
!= NULL
) {
8516 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
8517 dupPtr
->internalRep
= objPtr
->internalRep
;
8520 /* The dup proc may set a different type, e.g. NULL */
8521 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
8527 /* Return the string representation for objPtr. If the object
8528 * string representation is invalid, calls the method to create
8529 * a new one starting from the internal representation of the object. */
8530 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
8532 if (objPtr
->bytes
== NULL
) {
8533 /* Invalid string repr. Generate it. */
8534 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
8535 objPtr
->typePtr
->updateStringProc(objPtr
);
8538 *lenPtr
= objPtr
->length
;
8539 return objPtr
->bytes
;
8542 /* Just returns the length of the object's string rep */
8543 int Jim_Length(Jim_Obj
*objPtr
)
8547 Jim_GetString(objPtr
, &len
);
8551 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8552 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8554 static const Jim_ObjType dictSubstObjType
= {
8555 "dict-substitution",
8556 FreeDictSubstInternalRep
,
8557 DupDictSubstInternalRep
,
8562 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8564 Jim_DecrRefCount(interp
, (Jim_Obj
*)objPtr
->internalRep
.twoPtrValue
.ptr2
);
8567 static const Jim_ObjType interpolatedObjType
= {
8569 FreeInterpolatedInternalRep
,
8575 /* -----------------------------------------------------------------------------
8577 * ---------------------------------------------------------------------------*/
8578 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8579 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8581 static const Jim_ObjType stringObjType
= {
8584 DupStringInternalRep
,
8586 JIM_TYPE_REFERENCES
,
8589 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8591 JIM_NOTUSED(interp
);
8593 /* This is a bit subtle: the only caller of this function
8594 * should be Jim_DuplicateObj(), that will copy the
8595 * string representaion. After the copy, the duplicated
8596 * object will not have more room in teh buffer than
8597 * srcPtr->length bytes. So we just set it to length. */
8598 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
8600 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
8603 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8605 /* Get a fresh string representation. */
8606 (void)Jim_String(objPtr
);
8607 /* Free any other internal representation. */
8608 Jim_FreeIntRep(interp
, objPtr
);
8609 /* Set it as string, i.e. just set the maxLength field. */
8610 objPtr
->typePtr
= &stringObjType
;
8611 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
8612 /* Don't know the utf-8 length yet */
8613 objPtr
->internalRep
.strValue
.charLength
= -1;
8618 * Returns the length of the object string in chars, not bytes.
8620 * These may be different for a utf-8 string.
8622 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8625 if (objPtr
->typePtr
!= &stringObjType
)
8626 SetStringFromAny(interp
, objPtr
);
8628 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
8629 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
8631 return objPtr
->internalRep
.strValue
.charLength
;
8633 return Jim_Length(objPtr
);
8637 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
8638 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
8640 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
8642 /* Need to find out how many bytes the string requires */
8645 /* Alloc/Set the string rep. */
8647 objPtr
->bytes
= JimEmptyStringRep
;
8651 objPtr
->bytes
= Jim_Alloc(len
+ 1);
8652 objPtr
->length
= len
;
8653 memcpy(objPtr
->bytes
, s
, len
);
8654 objPtr
->bytes
[len
] = '\0';
8657 /* No typePtr field for the vanilla string object. */
8658 objPtr
->typePtr
= NULL
;
8662 /* charlen is in characters -- see also Jim_NewStringObj() */
8663 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
8666 /* Need to find out how many bytes the string requires */
8667 int bytelen
= utf8_index(s
, charlen
);
8669 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
8671 /* Remember the utf8 length, so set the type */
8672 objPtr
->typePtr
= &stringObjType
;
8673 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
8674 objPtr
->internalRep
.strValue
.charLength
= charlen
;
8678 return Jim_NewStringObj(interp
, s
, charlen
);
8682 /* This version does not try to duplicate the 's' pointer, but
8683 * use it directly. */
8684 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
8686 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
8690 Jim_SetStringRep(objPtr
, s
, len
);
8691 objPtr
->typePtr
= NULL
;
8695 /* Low-level string append. Use it only against objects
8696 * of type "string". */
8697 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
8703 needlen
= objPtr
->length
+ len
;
8704 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
8705 objPtr
->internalRep
.strValue
.maxLength
== 0) {
8707 /* Inefficient to malloc() for less than 8 bytes */
8711 if (objPtr
->bytes
== JimEmptyStringRep
) {
8712 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
8715 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
8717 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
8719 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
8720 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
8721 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
8722 /* Update the utf-8 char length */
8723 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
8725 objPtr
->length
+= len
;
8728 /* Higher level API to append strings to objects. */
8729 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
8731 JimPanic((Jim_IsShared(objPtr
), interp
, "Jim_AppendString called with shared object"));
8732 if (objPtr
->typePtr
!= &stringObjType
)
8733 SetStringFromAny(interp
, objPtr
);
8734 StringAppendString(objPtr
, str
, len
);
8737 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
8742 str
= Jim_GetString(appendObjPtr
, &len
);
8743 Jim_AppendString(interp
, objPtr
, str
, len
);
8746 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
8750 if (objPtr
->typePtr
!= &stringObjType
)
8751 SetStringFromAny(interp
, objPtr
);
8752 va_start(ap
, objPtr
);
8754 char *s
= va_arg(ap
, char *);
8758 Jim_AppendString(interp
, objPtr
, s
, -1);
8763 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
8765 const char *aStr
, *bStr
;
8768 if (aObjPtr
== bObjPtr
)
8770 aStr
= Jim_GetString(aObjPtr
, &aLen
);
8771 bStr
= Jim_GetString(bObjPtr
, &bLen
);
8774 return JimStringCompare(aStr
, aLen
, bStr
, bLen
) == 0;
8777 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
8779 return JimStringMatch(interp
, patternObjPtr
, Jim_String(objPtr
), nocase
);
8782 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
8784 const char *s1
, *s2
;
8787 s1
= Jim_GetString(firstObjPtr
, &l1
);
8788 s2
= Jim_GetString(secondObjPtr
, &l2
);
8791 return JimStringCompareNoCase(s1
, s2
, -1);
8793 return JimStringCompare(s1
, l1
, s2
, l2
);
8796 /* Convert a range, as returned by Jim_GetRange(), into
8797 * an absolute index into an object of the specified length.
8798 * This function may return negative values, or values
8799 * bigger or equal to the length of the list if the index
8800 * is out of range. */
8801 static int JimRelToAbsIndex(int len
, int idx
)
8808 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
8809 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
8810 * for implementation of commands like [string range] and [lrange].
8812 * The resulting range is guaranteed to address valid elements of
8814 static void JimRelToAbsRange(int len
, int first
, int last
,
8815 int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
8823 rangeLen
= last
- first
+ 1;
8830 rangeLen
-= (last
- (len
- 1));
8840 *rangeLenPtr
= rangeLen
;
8843 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
8844 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
8851 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
8852 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
8854 str
= Jim_GetString(strObjPtr
, &bytelen
);
8855 first
= JimRelToAbsIndex(bytelen
, first
);
8856 last
= JimRelToAbsIndex(bytelen
, last
);
8857 JimRelToAbsRange(bytelen
, first
, last
, &first
, &last
, &rangeLen
);
8858 if (first
== 0 && rangeLen
== bytelen
) {
8861 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
8864 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
8865 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
8873 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
8874 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
8876 str
= Jim_GetString(strObjPtr
, &bytelen
);
8877 len
= Jim_Utf8Length(interp
, strObjPtr
);
8878 first
= JimRelToAbsIndex(len
, first
);
8879 last
= JimRelToAbsIndex(len
, last
);
8880 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
8881 if (first
== 0 && rangeLen
== len
) {
8884 if (len
== bytelen
) {
8885 /* ASCII optimisation */
8886 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
8888 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
8890 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
8894 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
8900 if (strObjPtr
->typePtr
!= &stringObjType
) {
8901 SetStringFromAny(interp
, strObjPtr
);
8904 str
= Jim_GetString(strObjPtr
, &len
);
8906 buf
= p
= Jim_Alloc(len
+ 1);
8909 str
+= utf8_tounicode(str
, &c
);
8910 p
+= utf8_fromunicode(p
, utf8_lower(c
));
8913 return Jim_NewStringObjNoAlloc(interp
, buf
, len
);
8916 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
8922 if (strObjPtr
->typePtr
!= &stringObjType
) {
8923 SetStringFromAny(interp
, strObjPtr
);
8926 str
= Jim_GetString(strObjPtr
, &len
);
8928 buf
= p
= Jim_Alloc(len
+ 1);
8931 str
+= utf8_tounicode(str
, &c
);
8932 p
+= utf8_fromunicode(p
, utf8_upper(c
));
8935 return Jim_NewStringObjNoAlloc(interp
, buf
, len
);
8938 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
8939 * for unicode character 'c'.
8940 * Returns the position if found or NULL if not
8942 static const char *utf8_memchr(const char *str
, int len
, int c
)
8947 int n
= utf8_tounicode(str
, &sc
);
8956 return memchr(str
, c
, len
);
8961 * Searches for the first non-trim char in string (str, len)
8963 * If none is found, returns just past the last char.
8965 * Lengths are in bytes.
8967 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
8971 int n
= utf8_tounicode(str
, &c
);
8973 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
8974 /* Not a trim char, so stop */
8984 * Searches backwards for a non-trim char in string (str, len).
8986 * Returns a pointer to just after the non-trim char, or NULL if not found.
8988 * Lengths are in bytes.
8990 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
8996 int n
= utf8_prev_len(str
, len
);
9001 n
= utf8_tounicode(str
, &c
);
9003 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
9011 static const char default_trim_chars
[] = " \t\n\r";
9012 /* sizeof() here includes the null byte */
9013 static int default_trim_chars_len
= sizeof(default_trim_chars
);
9015 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9018 const char *str
= Jim_GetString(strObjPtr
, &len
);
9019 const char *trimchars
= default_trim_chars
;
9020 int trimcharslen
= default_trim_chars_len
;
9023 if (trimcharsObjPtr
) {
9024 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
9027 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
9028 if (newstr
== str
) {
9032 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
9035 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9038 const char *trimchars
= default_trim_chars
;
9039 int trimcharslen
= default_trim_chars_len
;
9040 const char *nontrim
;
9042 if (trimcharsObjPtr
) {
9043 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
9046 if (strObjPtr
->typePtr
!= &stringObjType
) {
9047 SetStringFromAny(interp
, strObjPtr
);
9049 Jim_GetString(strObjPtr
, &len
);
9050 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
9052 if (nontrim
== NULL
) {
9053 /* All trim, so return a zero-length string */
9054 return Jim_NewEmptyStringObj(interp
);
9056 if (nontrim
== strObjPtr
->bytes
+ len
) {
9060 if (Jim_IsShared(strObjPtr
)) {
9061 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
9064 /* Can modify this string in place */
9065 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
9066 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
9072 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9074 /* First trim left. */
9075 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
9077 /* Now trim right */
9078 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
9080 if (objPtr
!= strObjPtr
) {
9081 /* Note that we don't want this object to be leaked */
9082 Jim_IncrRefCount(objPtr
);
9083 Jim_DecrRefCount(interp
, objPtr
);
9090 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
9092 static const char * const strclassnames
[] = {
9093 "integer", "alpha", "alnum", "ascii", "digit",
9094 "double", "lower", "upper", "space", "xdigit",
9095 "control", "print", "graph", "punct",
9099 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
9100 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
9101 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
9107 int (*isclassfunc
)(int c
) = NULL
;
9109 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
9113 str
= Jim_GetString(strObjPtr
, &len
);
9115 Jim_SetResultInt(interp
, !strict
);
9120 case STR_IS_INTEGER
:
9123 Jim_SetResultInt(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
9130 Jim_SetResultInt(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
9134 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
9135 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
9136 case STR_IS_ASCII
: isclassfunc
= isascii
; break;
9137 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
9138 case STR_IS_LOWER
: isclassfunc
= islower
; break;
9139 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
9140 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
9141 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
9142 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
9143 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
9144 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
9145 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
9150 for (i
= 0; i
< len
; i
++) {
9151 if (!isclassfunc(str
[i
])) {
9152 Jim_SetResultInt(interp
, 0);
9156 Jim_SetResultInt(interp
, 1);
9160 /* -----------------------------------------------------------------------------
9161 * Compared String Object
9162 * ---------------------------------------------------------------------------*/
9164 /* This is strange object that allows to compare a C literal string
9165 * with a Jim object in very short time if the same comparison is done
9166 * multiple times. For example every time the [if] command is executed,
9167 * Jim has to check if a given argument is "else". This comparions if
9168 * the code has no errors are true most of the times, so we can cache
9169 * inside the object the pointer of the string of the last matching
9170 * comparison. Because most C compilers perform literal sharing,
9171 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
9172 * this works pretty well even if comparisons are at different places
9173 * inside the C code. */
9175 static const Jim_ObjType comparedStringObjType
= {
9180 JIM_TYPE_REFERENCES
,
9183 /* The only way this object is exposed to the API is via the following
9184 * function. Returns true if the string and the object string repr.
9185 * are the same, otherwise zero is returned.
9187 * Note: this isn't binary safe, but it hardly needs to be.*/
9188 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
9190 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
)
9193 const char *objStr
= Jim_String(objPtr
);
9195 if (strcmp(str
, objStr
) != 0)
9197 if (objPtr
->typePtr
!= &comparedStringObjType
) {
9198 Jim_FreeIntRep(interp
, objPtr
);
9199 objPtr
->typePtr
= &comparedStringObjType
;
9201 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
9206 static int qsortCompareStringPointers(const void *a
, const void *b
)
9208 char *const *sa
= (char *const *)a
;
9209 char *const *sb
= (char *const *)b
;
9211 return strcmp(*sa
, *sb
);
9215 /* -----------------------------------------------------------------------------
9218 * This object is just a string from the language point of view, but
9219 * in the internal representation it contains the filename and line number
9220 * where this given token was read. This information is used by
9221 * Jim_EvalObj() if the object passed happens to be of type "source".
9223 * This allows to propagate the information about line numbers and file
9224 * names and give error messages with absolute line numbers.
9226 * Note that this object uses shared strings for filenames, and the
9227 * pointer to the filename together with the line number is taken into
9228 * the space for the "inline" internal representation of the Jim_Object,
9229 * so there is almost memory zero-overhead.
9231 * Also the object will be converted to something else if the given
9232 * token it represents in the source file is not something to be
9233 * evaluated (not a script), and will be specialized in some other way,
9234 * so the time overhead is also null.
9235 * ---------------------------------------------------------------------------*/
9237 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9238 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9240 static const Jim_ObjType sourceObjType
= {
9242 FreeSourceInternalRep
,
9243 DupSourceInternalRep
,
9245 JIM_TYPE_REFERENCES
,
9248 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9250 Jim_ReleaseSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
9253 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9255 dupPtr
->internalRep
.sourceValue
.fileName
=
9256 Jim_GetSharedString(interp
, srcPtr
->internalRep
.sourceValue
.fileName
);
9257 dupPtr
->internalRep
.sourceValue
.lineNumber
= dupPtr
->internalRep
.sourceValue
.lineNumber
;
9258 dupPtr
->typePtr
= &sourceObjType
;
9261 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
9262 const char *fileName
, int lineNumber
)
9265 JimPanic((Jim_IsShared(objPtr
), interp
, "JimSetSourceInfo called with shared object"));
9266 JimPanic((objPtr
->typePtr
!= NULL
, interp
, "JimSetSourceInfo called with typePtr != NULL"));
9267 objPtr
->internalRep
.sourceValue
.fileName
= Jim_GetSharedString(interp
, fileName
);
9268 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
9269 objPtr
->typePtr
= &sourceObjType
;
9273 /* -----------------------------------------------------------------------------
9275 * ---------------------------------------------------------------------------*/
9277 static const Jim_ObjType scriptLineObjType
= {
9285 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
9289 #ifdef DEBUG_SHOW_SCRIPT
9291 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
9292 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
9294 objPtr
= Jim_NewEmptyStringObj(interp
);
9296 objPtr
->typePtr
= &scriptLineObjType
;
9297 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
9298 objPtr
->internalRep
.scriptLineValue
.line
= line
;
9303 #define JIM_CMDSTRUCT_EXPAND -1
9305 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9306 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9307 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, struct JimParseResult
*result
);
9309 static const Jim_ObjType scriptObjType
= {
9311 FreeScriptInternalRep
,
9312 DupScriptInternalRep
,
9314 JIM_TYPE_REFERENCES
,
9317 /* The ScriptToken structure represents every token into a scriptObj.
9318 * Every token contains an associated Jim_Obj that can be specialized
9319 * by commands operating on it. */
9320 typedef struct ScriptToken
9326 /* This is the script object internal representation. An array of
9327 * ScriptToken structures, including a pre-computed representation of the
9328 * command length and arguments.
9330 * For example the script:
9333 * set $i $x$y [foo]BAR
9335 * will produce a ScriptObj with the following Tokens:
9350 * "puts hello" has two args (LIN 2), composed of single tokens.
9351 * (Note that the WRD token is omitted for the common case of a single token.)
9353 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
9354 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
9356 * The precomputation of the command structure makes Jim_Eval() faster,
9357 * and simpler because there aren't dynamic lengths / allocations.
9359 * -- {expand}/{*} handling --
9361 * Expand is handled in a special way.
9363 * If a "word" begins with {*}, the word token count is -ve.
9365 * For example the command:
9369 * Will produce the following cmdstruct array:
9376 * Note that the 'LIN' token also contains the source information for the
9377 * first word of the line for error reporting purposes
9379 * -- the substFlags field of the structure --
9381 * The scriptObj structure is used to represent both "script" objects
9382 * and "subst" objects. In the second case, the there are no LIN and WRD
9383 * tokens. Instead SEP and EOL tokens are added as-is.
9384 * In addition, the field 'substFlags' is used to represent the flags used to turn
9385 * the string into the internal representation used to perform the
9386 * substitution. If this flags are not what the application requires
9387 * the scriptObj is created again. For example the script:
9389 * subst -nocommands $string
9390 * subst -novariables $string
9392 * Will recreate the internal representation of the $string object
9395 typedef struct ScriptObj
9397 int len
; /* Length as number of tokens. */
9398 ScriptToken
*token
; /* Tokens array. */
9399 int substFlags
; /* flags used for the compilation of "subst" objects */
9400 int inUse
; /* Used to share a ScriptObj. Currently
9401 only used by Jim_EvalObj() as protection against
9402 shimmering of the currently evaluated object. */
9403 const char *fileName
;
9404 int line
; /* Line number of the first line */
9407 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9410 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
9413 if (script
->inUse
!= 0)
9415 for (i
= 0; i
< script
->len
; i
++) {
9416 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
9418 Jim_Free(script
->token
);
9419 if (script
->fileName
) {
9420 Jim_ReleaseSharedString(interp
, script
->fileName
);
9425 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9427 JIM_NOTUSED(interp
);
9428 JIM_NOTUSED(srcPtr
);
9430 /* Just returns an simple string. */
9431 dupPtr
->typePtr
= NULL
;
9434 /* A simple parser token.
9435 * All the simple tokens for the script point into the same script string rep.
9439 const char *token
; /* Pointer to the start of the token */
9440 int len
; /* Length of this token */
9441 int type
; /* Token type */
9442 int line
; /* Line number */
9445 /* A list of parsed tokens representing a script.
9446 * Tokens are added to this list as the script is parsed.
9447 * It grows as needed.
9451 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
9452 ParseToken
*list
; /* Array of tokens */
9453 int size
; /* Current size of the list */
9454 int count
; /* Number of entries used */
9455 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
9458 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
9460 tokenlist
->list
= tokenlist
->static_list
;
9461 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
9462 tokenlist
->count
= 0;
9465 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
9467 if (tokenlist
->list
!= tokenlist
->static_list
) {
9468 Jim_Free(tokenlist
->list
);
9473 * Adds the new token to the tokenlist.
9474 * The token has the given length, type and line number.
9475 * The token list is resized as necessary.
9477 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
9482 if (tokenlist
->count
== tokenlist
->size
) {
9483 /* Resize the list */
9484 tokenlist
->size
*= 2;
9485 if (tokenlist
->list
!= tokenlist
->static_list
) {
9487 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
9490 /* The list needs to become allocated */
9491 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
9492 memcpy(tokenlist
->list
, tokenlist
->static_list
,
9493 tokenlist
->count
* sizeof(*tokenlist
->list
));
9496 t
= &tokenlist
->list
[tokenlist
->count
++];
9503 /* Counts the number of adjoining non-separator.
9505 * Returns -ve if the first token is the expansion
9506 * operator (in which case the count doesn't include
9509 static int JimCountWordTokens(ParseToken
*t
)
9514 /* Is the first word {*} or {expand}? */
9515 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
9516 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
9517 /* Create an expand token */
9523 /* Now count non-separator words */
9524 while (!TOKEN_IS_SEP(t
->type
)) {
9529 return count
* expand
;
9533 * Create a script/subst object from the given token.
9535 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
9539 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
9540 /* Convert the backlash escapes . */
9542 char *str
= Jim_Alloc(len
+ 1);
9543 len
= JimEscape(str
, t
->token
, len
);
9544 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
9547 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
9548 * with a single space. This is currently not done.
9550 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9556 * Takes a tokenlist and creates the allocated list of script tokens
9557 * in script->token, of length script->len.
9559 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
9562 * Also sets script->line to the line number of the first token
9564 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
9565 ParseTokenList
*tokenlist
)
9568 struct ScriptToken
*token
;
9569 /* Number of tokens so far for the current command */
9571 /* This is the first token for the current command */
9572 ScriptToken
*linefirst
;
9576 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
9577 printf("==== Tokens ====\n");
9578 for (i
= 0; i
< tokenlist
->count
; i
++) {
9579 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
9580 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
9584 /* May need up to one extra script token for each EOL in the worst case */
9585 count
= tokenlist
->count
;
9586 for (i
= 0; i
< tokenlist
->count
; i
++) {
9587 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
9591 linenr
= script
->line
= tokenlist
->list
[0].line
;
9593 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9595 /* This is the first token for the current command */
9596 linefirst
= token
++;
9598 for (i
= 0; i
< tokenlist
->count
; ) {
9599 /* Look ahead to find out how many tokens make up the next word */
9602 /* Skip any leading separators */
9603 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
9607 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
9609 if (wordtokens
== 0) {
9610 /* None, so at end of line */
9612 linefirst
->type
= JIM_TT_LINE
;
9613 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
9614 Jim_IncrRefCount(linefirst
->objPtr
);
9616 /* Reset for new line */
9618 linefirst
= token
++;
9623 else if (wordtokens
!= 1) {
9624 /* More than 1, or {expand}, so insert a WORD token */
9625 token
->type
= JIM_TT_WORD
;
9626 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
9627 Jim_IncrRefCount(token
->objPtr
);
9629 if (wordtokens
< 0) {
9630 /* Skip the expand token */
9632 wordtokens
= -wordtokens
- 1;
9637 if (lineargs
== 0) {
9638 /* First real token on the line, so record the line number */
9639 linenr
= tokenlist
->list
[i
].line
;
9643 /* Add each non-separator word token to the line */
9644 while (wordtokens
--) {
9645 const ParseToken
*t
= &tokenlist
->list
[i
++];
9647 token
->type
= t
->type
;
9648 token
->objPtr
= JimMakeScriptObj(interp
, t
);
9649 Jim_IncrRefCount(token
->objPtr
);
9651 /* Every object is initially a string, but the
9652 * internal type may be specialized during execution of the
9654 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileName
, t
->line
);
9659 if (lineargs
== 0) {
9663 script
->len
= token
- script
->token
;
9665 assert(script
->len
< count
);
9667 #ifdef DEBUG_SHOW_SCRIPT
9668 printf("==== Script (%s) ====\n", script
->fileName
);
9669 for (i
= 0; i
< script
->len
; i
++) {
9670 const ScriptToken
*t
= &script
->token
[i
];
9671 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9678 * Similar to ScriptObjAddTokens(), but for subst objects.
9680 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
9681 ParseTokenList
*tokenlist
)
9684 struct ScriptToken
*token
;
9686 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
9688 for (i
= 0; i
< tokenlist
->count
; i
++) {
9689 const ParseToken
*t
= &tokenlist
->list
[i
];
9691 /* Create a token for 't' */
9692 token
->type
= t
->type
;
9693 token
->objPtr
= JimMakeScriptObj(interp
, t
);
9694 Jim_IncrRefCount(token
->objPtr
);
9701 /* This method takes the string representation of an object
9702 * as a Tcl script, and generates the pre-parsed internal representation
9704 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, struct JimParseResult
*result
)
9707 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
9708 struct JimParserCtx parser
;
9709 struct ScriptObj
*script
;
9710 ParseTokenList tokenlist
;
9713 /* Try to get information about filename / line number */
9714 if (objPtr
->typePtr
== &sourceObjType
) {
9715 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9718 /* Initially parse the script into tokens (in tokenlist) */
9719 ScriptTokenListInit(&tokenlist
);
9721 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
9722 while (!parser
.eof
) {
9723 JimParseScript(&parser
);
9724 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9727 if (result
&& parser
.missing
!= ' ') {
9728 ScriptTokenListFree(&tokenlist
);
9729 result
->missing
= parser
.missing
;
9730 result
->line
= parser
.missingline
;
9734 /* Add a final EOF token */
9735 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
9737 /* Create the "real" script tokens from the initial token list */
9738 script
= Jim_Alloc(sizeof(*script
));
9739 memset(script
, 0, sizeof(*script
));
9741 script
->line
= line
;
9742 if (objPtr
->typePtr
== &sourceObjType
) {
9743 script
->fileName
= Jim_GetSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
9746 ScriptObjAddTokens(interp
, script
, &tokenlist
);
9748 /* No longer need the token list */
9749 ScriptTokenListFree(&tokenlist
);
9751 if (!script
->fileName
) {
9752 script
->fileName
= Jim_GetSharedString(interp
, "");
9755 /* Free the old internal rep and set the new one. */
9756 Jim_FreeIntRep(interp
, objPtr
);
9757 Jim_SetIntRepPtr(objPtr
, script
);
9758 objPtr
->typePtr
= &scriptObjType
;
9763 ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9765 struct ScriptObj
*script
= Jim_GetIntRepPtr(objPtr
);
9767 if (objPtr
->typePtr
!= &scriptObjType
|| script
->substFlags
) {
9768 SetScriptFromAny(interp
, objPtr
, NULL
);
9770 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
9773 /* -----------------------------------------------------------------------------
9775 * ---------------------------------------------------------------------------*/
9776 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
9781 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
9783 if (--cmdPtr
->inUse
== 0) {
9784 if (cmdPtr
->isproc
) {
9785 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
9786 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
9787 if (cmdPtr
->u
.proc
.staticVars
) {
9788 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
9789 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
9791 if (cmdPtr
->u
.proc
.prevCmd
) {
9792 /* Delete any pushed command too */
9793 JimDecrCmdRefCount(interp
, cmdPtr
->u
.proc
.prevCmd
);
9798 if (cmdPtr
->u
.native
.delProc
) {
9799 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
9806 /* Commands HashTable Type.
9808 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
9809 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
9811 JimDecrCmdRefCount(interp
, val
);
9814 static const Jim_HashTableType JimCommandsHashTableType
= {
9815 JimStringCopyHTHashFunction
, /* hash function */
9816 JimStringCopyHTKeyDup
, /* key dup */
9818 JimStringCopyHTKeyCompare
, /* key compare */
9819 JimStringCopyHTKeyDestructor
, /* key destructor */
9820 JimCommandsHT_ValDestructor
/* val destructor */
9823 /* ------------------------- Commands related functions --------------------- */
9825 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdName
,
9826 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
9830 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) != JIM_ERR
) {
9831 /* Command existed so incr proc epoch */
9832 Jim_InterpIncrProcEpoch(interp
);
9835 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
9837 /* Store the new details for this proc */
9838 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
9840 cmdPtr
->u
.native
.delProc
= delProc
;
9841 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
9842 cmdPtr
->u
.native
.privData
= privData
;
9844 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
9846 /* There is no need to increment the 'proc epoch' because
9847 * creation of a new procedure can never affect existing
9848 * cached commands. We don't do negative caching. */
9852 static int JimCreateProcedure(Jim_Interp
*interp
, const char *cmdName
,
9853 Jim_Obj
*argListObjPtr
, Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
,
9854 int leftArity
, int optionalArgs
, int args
, int rightArity
)
9859 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
9860 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
9863 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
9864 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
9865 Jim_IncrRefCount(argListObjPtr
);
9866 Jim_IncrRefCount(bodyObjPtr
);
9867 cmdPtr
->u
.proc
.leftArity
= leftArity
;
9868 cmdPtr
->u
.proc
.optionalArgs
= optionalArgs
;
9869 cmdPtr
->u
.proc
.args
= args
;
9870 cmdPtr
->u
.proc
.rightArity
= rightArity
;
9871 cmdPtr
->u
.proc
.staticVars
= NULL
;
9872 cmdPtr
->u
.proc
.prevCmd
= NULL
;
9875 /* Create the statics hash table. */
9876 if (staticsListObjPtr
) {
9879 len
= Jim_ListLength(interp
, staticsListObjPtr
);
9881 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
9882 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
9883 for (i
= 0; i
< len
; i
++) {
9884 Jim_Obj
*objPtr
= 0, *initObjPtr
= 0, *nameObjPtr
= 0;
9888 Jim_ListIndex(interp
, staticsListObjPtr
, i
, &objPtr
, JIM_NONE
);
9889 /* Check if it's composed of two elements. */
9890 subLen
= Jim_ListLength(interp
, objPtr
);
9891 if (subLen
== 1 || subLen
== 2) {
9892 /* Try to get the variable value from the current
9894 Jim_ListIndex(interp
, objPtr
, 0, &nameObjPtr
, JIM_NONE
);
9896 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
9897 if (initObjPtr
== NULL
) {
9898 Jim_SetResultFormatted(interp
,
9899 "variable for initialization of static \"%#s\" not found in the local context",
9905 Jim_ListIndex(interp
, objPtr
, 1, &initObjPtr
, JIM_NONE
);
9907 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
9911 varPtr
= Jim_Alloc(sizeof(*varPtr
));
9912 varPtr
->objPtr
= initObjPtr
;
9913 Jim_IncrRefCount(initObjPtr
);
9914 varPtr
->linkFramePtr
= NULL
;
9915 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
9916 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
9917 Jim_SetResultFormatted(interp
,
9918 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
9919 Jim_DecrRefCount(interp
, initObjPtr
);
9925 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
9933 /* Add the new command */
9935 /* It may already exist, so we try to delete the old one.
9936 * Note that reference count means that it won't be deleted yet if
9937 * it exists in the call stack.
9939 * BUT, if 'local' is in force, instead of deleting the existing
9940 * proc, we stash a reference to the old proc here.
9942 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
9944 /* There was an old procedure with the same name, this requires
9945 * a 'proc epoch' update. */
9947 /* If a procedure with the same name didn't existed there is no need
9948 * to increment the 'proc epoch' because creation of a new procedure
9949 * can never affect existing cached commands. We don't do
9950 * negative caching. */
9951 Jim_InterpIncrProcEpoch(interp
);
9954 if (he
&& interp
->local
) {
9955 /* Just push this proc over the top of the previous one */
9956 cmdPtr
->u
.proc
.prevCmd
= he
->u
.val
;
9961 /* Replace the existing proc */
9962 Jim_DeleteHashEntry(&interp
->commands
, cmdName
);
9965 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
9968 /* Unlike Tcl, set the name of the proc as the result */
9969 Jim_SetResultString(interp
, cmdName
, -1);
9973 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
9974 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
9975 Jim_DecrRefCount(interp
, argListObjPtr
);
9976 Jim_DecrRefCount(interp
, bodyObjPtr
);
9981 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *cmdName
)
9983 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) == JIM_ERR
)
9985 Jim_InterpIncrProcEpoch(interp
);
9989 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
9993 /* Does it exist? */
9994 he
= Jim_FindHashEntry(&interp
->commands
, oldName
);
9996 Jim_SetResultFormatted(interp
, "can't %s \"%s\": command doesn't exist",
9997 newName
[0] ? "rename" : "delete", oldName
);
10001 if (newName
[0] == '\0') /* Delete! */
10002 return Jim_DeleteCommand(interp
, oldName
);
10005 if (Jim_FindHashEntry(&interp
->commands
, newName
)) {
10006 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
10010 /* Add the new name first */
10011 JimIncrCmdRefCount(he
->u
.val
);
10012 Jim_AddHashEntry(&interp
->commands
, newName
, he
->u
.val
);
10014 /* Now remove the old name */
10015 Jim_DeleteHashEntry(&interp
->commands
, oldName
);
10017 /* Increment the epoch */
10018 Jim_InterpIncrProcEpoch(interp
);
10022 /* -----------------------------------------------------------------------------
10024 * ---------------------------------------------------------------------------*/
10026 static int SetCommandFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
10028 static const Jim_ObjType commandObjType
= {
10033 JIM_TYPE_REFERENCES
,
10036 int SetCommandFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10039 const char *cmdName
;
10041 /* Get the string representation */
10042 cmdName
= Jim_String(objPtr
);
10043 /* Lookup this name into the commands hash table */
10044 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
10048 /* Free the old internal repr and set the new one. */
10049 Jim_FreeIntRep(interp
, objPtr
);
10050 objPtr
->typePtr
= &commandObjType
;
10051 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
10052 objPtr
->internalRep
.cmdValue
.cmdPtr
= (void *)he
->u
.val
;
10056 /* This function returns the command structure for the command name
10057 * stored in objPtr. It tries to specialize the objPtr to contain
10058 * a cached info instead to perform the lookup into the hash table
10059 * every time. The information cached may not be uptodate, in such
10060 * a case the lookup is performed and the cache updated.
10062 * Respects the 'upcall' setting
10064 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
10068 if ((objPtr
->typePtr
!= &commandObjType
||
10069 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
) &&
10070 SetCommandFromAny(interp
, objPtr
) == JIM_ERR
) {
10071 if (flags
& JIM_ERRMSG
) {
10072 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
10076 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
10077 while (cmd
->isproc
&& cmd
->u
.proc
.upcall
) {
10078 cmd
= cmd
->u
.proc
.prevCmd
;
10083 /* -----------------------------------------------------------------------------
10085 * ---------------------------------------------------------------------------*/
10087 /* Variables HashTable Type.
10089 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
10090 static void JimVariablesHTValDestructor(void *interp
, void *val
)
10092 Jim_Var
*varPtr
= (void *)val
;
10094 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
10098 static const Jim_HashTableType JimVariablesHashTableType
= {
10099 JimStringCopyHTHashFunction
, /* hash function */
10100 JimStringCopyHTKeyDup
, /* key dup */
10101 NULL
, /* val dup */
10102 JimStringCopyHTKeyCompare
, /* key compare */
10103 JimStringCopyHTKeyDestructor
, /* key destructor */
10104 JimVariablesHTValDestructor
/* val destructor */
10107 /* -----------------------------------------------------------------------------
10109 * ---------------------------------------------------------------------------*/
10111 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
10113 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
10115 static const Jim_ObjType variableObjType
= {
10120 JIM_TYPE_REFERENCES
,
10123 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
10124 * is in the form "varname(key)". */
10125 static int JimNameIsDictSugar(const char *str
, int len
)
10127 if (len
&& str
[len
- 1] == ')' && strchr(str
, '(') != NULL
)
10133 * Check that the name does not contain embedded nulls.
10135 * Variable and procedure names are maniplated as null terminated strings, so
10136 * don't allow names with embedded nulls.
10138 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
10140 /* Variable names and proc names can't contain embedded nulls */
10141 if (nameObjPtr
->typePtr
!= &variableObjType
) {
10143 const char *str
= Jim_GetString(nameObjPtr
, &len
);
10144 if (memchr(str
, '\0', len
)) {
10145 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
10152 /* This method should be called only by the variable API.
10153 * It returns JIM_OK on success (variable already exists),
10154 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
10155 * a variable name, but syntax glue for [dict] i.e. the last
10156 * character is ')' */
10157 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
10160 const char *varName
;
10162 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10164 /* Check if the object is already an uptodate variable */
10165 if (objPtr
->typePtr
== &variableObjType
&&
10166 objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
10167 return JIM_OK
; /* nothing to do */
10170 if (objPtr
->typePtr
== &dictSubstObjType
) {
10171 return JIM_DICT_SUGAR
;
10174 if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
10178 /* Get the string representation */
10179 varName
= Jim_GetString(objPtr
, &len
);
10181 /* Make sure it's not syntax glue to get/set dict. */
10182 if (JimNameIsDictSugar(varName
, len
)) {
10183 return JIM_DICT_SUGAR
;
10186 if (varName
[0] == ':' && varName
[1] == ':') {
10187 framePtr
= interp
->topFramePtr
;
10188 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
+ 2);
10194 /* Lookup this name into the variables hash table */
10195 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
10197 /* Try with static vars. */
10198 if (framePtr
->staticVars
== NULL
)
10200 if (!(he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
)))
10204 /* Free the old internal repr and set the new one. */
10205 Jim_FreeIntRep(interp
, objPtr
);
10206 objPtr
->typePtr
= &variableObjType
;
10207 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
10208 objPtr
->internalRep
.varValue
.varPtr
= (void *)he
->u
.val
;
10212 /* -------------------- Variables related functions ------------------------- */
10213 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
10214 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
10216 /* For now that's dummy. Variables lookup should be optimized
10217 * in many ways, with caching of lookups, and possibly with
10218 * a table of pre-allocated vars in every CallFrame for local vars.
10219 * All the caching should also have an 'epoch' mechanism similar
10220 * to the one used by Tcl for procedures lookup caching. */
10222 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
10228 if ((err
= SetVariableFromAny(interp
, nameObjPtr
)) != JIM_OK
) {
10229 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10231 /* Check for [dict] syntax sugar. */
10232 if (err
== JIM_DICT_SUGAR
)
10233 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
10235 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
10239 /* New variable to create */
10240 name
= Jim_String(nameObjPtr
);
10242 var
= Jim_Alloc(sizeof(*var
));
10243 var
->objPtr
= valObjPtr
;
10244 Jim_IncrRefCount(valObjPtr
);
10245 var
->linkFramePtr
= NULL
;
10246 /* Insert the new variable */
10247 if (name
[0] == ':' && name
[1] == ':') {
10248 /* Into the top level frame */
10249 framePtr
= interp
->topFramePtr
;
10250 Jim_AddHashEntry(&framePtr
->vars
, name
+ 2, var
);
10253 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
10255 /* Make the object int rep a variable */
10256 Jim_FreeIntRep(interp
, nameObjPtr
);
10257 nameObjPtr
->typePtr
= &variableObjType
;
10258 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
10259 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
10262 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10263 if (var
->linkFramePtr
== NULL
) {
10264 Jim_IncrRefCount(valObjPtr
);
10265 Jim_DecrRefCount(interp
, var
->objPtr
);
10266 var
->objPtr
= valObjPtr
;
10268 else { /* Else handle the link */
10269 Jim_CallFrame
*savedCallFrame
;
10271 savedCallFrame
= interp
->framePtr
;
10272 interp
->framePtr
= var
->linkFramePtr
;
10273 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
10274 interp
->framePtr
= savedCallFrame
;
10282 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
10284 Jim_Obj
*nameObjPtr
;
10287 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10288 Jim_IncrRefCount(nameObjPtr
);
10289 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
10290 Jim_DecrRefCount(interp
, nameObjPtr
);
10294 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
10296 Jim_CallFrame
*savedFramePtr
;
10299 savedFramePtr
= interp
->framePtr
;
10300 interp
->framePtr
= interp
->topFramePtr
;
10301 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
10302 interp
->framePtr
= savedFramePtr
;
10306 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
10308 Jim_Obj
*nameObjPtr
, *valObjPtr
;
10311 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10312 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
10313 Jim_IncrRefCount(nameObjPtr
);
10314 Jim_IncrRefCount(valObjPtr
);
10315 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
10316 Jim_DecrRefCount(interp
, nameObjPtr
);
10317 Jim_DecrRefCount(interp
, valObjPtr
);
10321 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
10322 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
10324 const char *varName
;
10327 varName
= Jim_GetString(nameObjPtr
, &len
);
10329 if (varName
[0] == ':' && varName
[1] == ':') {
10330 /* Linking a global var does nothing */
10334 if (JimNameIsDictSugar(varName
, len
)) {
10335 Jim_SetResultString(interp
, "Dict key syntax invalid as link source", -1);
10339 /* Check for an existing variable or link */
10340 if (SetVariableFromAny(interp
, nameObjPtr
) == JIM_OK
) {
10341 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10343 if (varPtr
->linkFramePtr
== NULL
) {
10344 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
10348 /* It exists, but is a link, so delete the link */
10349 varPtr
->linkFramePtr
= NULL
;
10352 /* Check for cycles. */
10353 if (interp
->framePtr
== targetCallFrame
) {
10354 Jim_Obj
*objPtr
= targetNameObjPtr
;
10357 /* Cycles are only possible with 'uplevel 0' */
10359 if (Jim_StringEqObj(objPtr
, nameObjPtr
)) {
10360 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
10363 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
10365 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
10366 if (varPtr
->linkFramePtr
!= targetCallFrame
)
10368 objPtr
= varPtr
->objPtr
;
10372 /* Perform the binding */
10373 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
10374 /* We are now sure 'nameObjPtr' type is variableObjType */
10375 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
10379 /* Return the Jim_Obj pointer associated with a variable name,
10380 * or NULL if the variable was not found in the current context.
10381 * The same optimization discussed in the comment to the
10382 * 'SetVariable' function should apply here.
10384 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
10385 * in a dictionary which is shared, the array variable value is duplicated first.
10386 * This allows the array element to be updated (e.g. append, lappend) without
10387 * affecting other references to the dictionary.
10389 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10391 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
10393 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10395 if (varPtr
->linkFramePtr
== NULL
) {
10396 return varPtr
->objPtr
;
10401 /* The variable is a link? Resolve it. */
10402 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10404 interp
->framePtr
= varPtr
->linkFramePtr
;
10405 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
10406 interp
->framePtr
= savedCallFrame
;
10410 /* Error, so fall through to the error message */
10415 case JIM_DICT_SUGAR
:
10416 /* [dict] syntax sugar. */
10417 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
10419 if (flags
& JIM_ERRMSG
) {
10420 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
10425 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10427 Jim_CallFrame
*savedFramePtr
;
10430 savedFramePtr
= interp
->framePtr
;
10431 interp
->framePtr
= interp
->topFramePtr
;
10432 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
10433 interp
->framePtr
= savedFramePtr
;
10438 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
10440 Jim_Obj
*nameObjPtr
, *varObjPtr
;
10442 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10443 Jim_IncrRefCount(nameObjPtr
);
10444 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
10445 Jim_DecrRefCount(interp
, nameObjPtr
);
10449 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
10451 Jim_CallFrame
*savedFramePtr
;
10454 savedFramePtr
= interp
->framePtr
;
10455 interp
->framePtr
= interp
->topFramePtr
;
10456 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
10457 interp
->framePtr
= savedFramePtr
;
10462 /* Unset a variable.
10463 * Note: On success unset invalidates all the variable objects created
10464 * in the current call frame incrementing. */
10465 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10471 retval
= SetVariableFromAny(interp
, nameObjPtr
);
10472 if (retval
== JIM_DICT_SUGAR
) {
10473 /* [dict] syntax sugar. */
10474 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
10476 else if (retval
== JIM_OK
) {
10477 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10479 /* If it's a link call UnsetVariable recursively */
10480 if (varPtr
->linkFramePtr
) {
10481 Jim_CallFrame
*savedCallFrame
;
10483 savedCallFrame
= interp
->framePtr
;
10484 interp
->framePtr
= varPtr
->linkFramePtr
;
10485 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
10486 interp
->framePtr
= savedCallFrame
;
10489 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10491 name
= Jim_String(nameObjPtr
);
10492 if (name
[0] == ':' && name
[1] == ':') {
10493 framePtr
= interp
->topFramePtr
;
10496 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
10497 if (retval
== JIM_OK
) {
10498 /* Change the callframe id, invalidating var lookup caching */
10499 JimChangeCallFrameId(interp
, framePtr
);
10503 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
10504 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
10509 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
10511 /* Given a variable name for [dict] operation syntax sugar,
10512 * this function returns two objects, the first with the name
10513 * of the variable to set, and the second with the rispective key.
10514 * For example "foo(bar)" will return objects with string repr. of
10517 * The returned objects have refcount = 1. The function can't fail. */
10518 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
10519 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
10521 const char *str
, *p
;
10523 Jim_Obj
*varObjPtr
, *keyObjPtr
;
10525 str
= Jim_GetString(objPtr
, &len
);
10527 p
= strchr(str
, '(');
10528 JimPanic((p
== NULL
, interp
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
10530 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
10533 keyLen
= (str
+ len
) - p
;
10534 if (str
[len
- 1] == ')') {
10538 /* Create the objects with the variable name and key. */
10539 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
10541 Jim_IncrRefCount(varObjPtr
);
10542 Jim_IncrRefCount(keyObjPtr
);
10543 *varPtrPtr
= varObjPtr
;
10544 *keyPtrPtr
= keyObjPtr
;
10547 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
10548 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
10549 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
10553 SetDictSubstFromAny(interp
, objPtr
);
10555 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10556 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
);
10558 if (err
== JIM_OK
) {
10559 /* Don't keep an extra ref to the result */
10560 Jim_SetEmptyResult(interp
);
10564 /* Better error message for unset a(2) where a exists but a(2) doesn't */
10565 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
10566 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
10571 /* Make the error more informative and Tcl-compatible */
10572 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
10573 (valObjPtr
? "set" : "unset"), objPtr
);
10579 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
10581 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
10582 * and stored back to the variable before expansion.
10584 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
10585 Jim_Obj
*keyObjPtr
, int flags
)
10587 Jim_Obj
*dictObjPtr
;
10588 Jim_Obj
*resObjPtr
= NULL
;
10591 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
10596 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
10597 if (ret
!= JIM_OK
) {
10600 Jim_SetResultFormatted(interp
,
10601 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr
, keyObjPtr
);
10604 Jim_SetResultFormatted(interp
,
10605 "can't read \"%#s(%#s)\": no such element in array", varObjPtr
, keyObjPtr
);
10608 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
10609 dictObjPtr
= Jim_DuplicateObj(interp
, dictObjPtr
);
10610 if (Jim_SetVariable(interp
, varObjPtr
, dictObjPtr
) != JIM_OK
) {
10611 /* This can probably never happen */
10612 JimPanic((1, interp
, "SetVariable failed for JIM_UNSHARED"));
10614 /* We know that the key exists. Get the result in the now-unshared dictionary */
10615 Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
10621 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
10622 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
10624 SetDictSubstFromAny(interp
, objPtr
);
10626 return JimDictExpandArrayVariable(interp
,
10627 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10628 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
10631 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
10633 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10635 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
10636 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
10639 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
10641 JIM_NOTUSED(interp
);
10643 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
10644 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
10645 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
10646 dupPtr
->typePtr
= &dictSubstObjType
;
10649 /* Note: The object *must* be in dict-sugar format */
10650 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10652 if (objPtr
->typePtr
!= &dictSubstObjType
) {
10653 Jim_Obj
*varObjPtr
, *keyObjPtr
;
10655 if (objPtr
->typePtr
== &interpolatedObjType
) {
10656 /* An interpolated object in dict-sugar form */
10658 const ScriptToken
*token
= objPtr
->internalRep
.twoPtrValue
.ptr1
;
10660 varObjPtr
= token
[0].objPtr
;
10661 keyObjPtr
= objPtr
->internalRep
.twoPtrValue
.ptr2
;
10663 Jim_IncrRefCount(varObjPtr
);
10664 Jim_IncrRefCount(keyObjPtr
);
10667 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
10670 Jim_FreeIntRep(interp
, objPtr
);
10671 objPtr
->typePtr
= &dictSubstObjType
;
10672 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
10673 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
10677 /* This function is used to expand [dict get] sugar in the form
10678 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
10679 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
10680 * object that is *guaranteed* to be in the form VARNAME(INDEX).
10681 * The 'index' part is [subst]ituted, and is used to lookup a key inside
10682 * the [dict]ionary contained in variable VARNAME. */
10683 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10685 Jim_Obj
*resObjPtr
= NULL
;
10686 Jim_Obj
*substKeyObjPtr
= NULL
;
10688 SetDictSubstFromAny(interp
, objPtr
);
10690 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
10691 &substKeyObjPtr
, JIM_NONE
)
10695 Jim_IncrRefCount(substKeyObjPtr
);
10697 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10698 substKeyObjPtr
, 0);
10699 Jim_DecrRefCount(interp
, substKeyObjPtr
);
10704 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10706 Jim_Obj
*resultObjPtr
;
10708 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
10709 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
10710 resultObjPtr
->refCount
--;
10711 return resultObjPtr
;
10716 /* -----------------------------------------------------------------------------
10718 * ---------------------------------------------------------------------------*/
10720 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
)
10724 if (interp
->freeFramesList
) {
10725 cf
= interp
->freeFramesList
;
10726 interp
->freeFramesList
= cf
->nextFramePtr
;
10729 cf
= Jim_Alloc(sizeof(*cf
));
10730 cf
->vars
.table
= NULL
;
10733 cf
->id
= interp
->callFrameEpoch
++;
10734 cf
->parentCallFrame
= parent
;
10735 cf
->level
= parent
? parent
->level
+ 1 : 0;
10738 cf
->procArgsObjPtr
= NULL
;
10739 cf
->procBodyObjPtr
= NULL
;
10740 cf
->nextFramePtr
= NULL
;
10741 cf
->staticVars
= NULL
;
10742 if (cf
->vars
.table
== NULL
)
10743 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
10747 /* Used to invalidate every caching related to callframe stability. */
10748 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
)
10750 cf
->id
= interp
->callFrameEpoch
++;
10753 #define JIM_FCF_NONE 0 /* no flags */
10754 #define JIM_FCF_NOHT 1 /* don't free the hash table */
10755 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
)
10757 if (cf
->procArgsObjPtr
)
10758 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
10759 if (cf
->procBodyObjPtr
)
10760 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
10761 if (!(flags
& JIM_FCF_NOHT
))
10762 Jim_FreeHashTable(&cf
->vars
);
10765 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
10767 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
10769 while (he
!= NULL
) {
10770 Jim_HashEntry
*nextEntry
= he
->next
;
10771 Jim_Var
*varPtr
= (void *)he
->u
.val
;
10773 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
10774 Jim_Free(he
->u
.val
);
10775 Jim_Free((void *)he
->key
); /* ATTENTION: const cast */
10783 cf
->nextFramePtr
= interp
->freeFramesList
;
10784 interp
->freeFramesList
= cf
;
10787 /* -----------------------------------------------------------------------------
10789 * ---------------------------------------------------------------------------*/
10790 #ifdef JIM_REFERENCES
10792 /* References HashTable Type.
10794 * Keys are jim_wide integers, dynamically allocated for now but in the
10795 * future it's worth to cache this 8 bytes objects. Values are poitners
10796 * to Jim_References. */
10797 static void JimReferencesHTValDestructor(void *interp
, void *val
)
10799 Jim_Reference
*refPtr
= (void *)val
;
10801 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
10802 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
10803 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
10808 static unsigned int JimReferencesHTHashFunction(const void *key
)
10810 /* Only the least significant bits are used. */
10811 const jim_wide
*widePtr
= key
;
10812 unsigned int intValue
= (unsigned int)*widePtr
;
10814 return Jim_IntHashFunction(intValue
);
10817 static const void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
10819 void *copy
= Jim_Alloc(sizeof(jim_wide
));
10821 JIM_NOTUSED(privdata
);
10823 memcpy(copy
, key
, sizeof(jim_wide
));
10827 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
10829 JIM_NOTUSED(privdata
);
10831 return memcmp(key1
, key2
, sizeof(jim_wide
)) == 0;
10834 static void JimReferencesHTKeyDestructor(void *privdata
, const void *key
)
10836 JIM_NOTUSED(privdata
);
10838 Jim_Free((void *)key
);
10841 static const Jim_HashTableType JimReferencesHashTableType
= {
10842 JimReferencesHTHashFunction
, /* hash function */
10843 JimReferencesHTKeyDup
, /* key dup */
10844 NULL
, /* val dup */
10845 JimReferencesHTKeyCompare
, /* key compare */
10846 JimReferencesHTKeyDestructor
, /* key destructor */
10847 JimReferencesHTValDestructor
/* val destructor */
10850 /* -----------------------------------------------------------------------------
10851 * Reference object type and References API
10852 * ---------------------------------------------------------------------------*/
10854 /* The string representation of references has two features in order
10855 * to make the GC faster. The first is that every reference starts
10856 * with a non common character '<', in order to make the string matching
10857 * faster. The second is that the reference string rep is 42 characters
10858 * in length, this allows to avoid to check every object with a string
10859 * repr < 42, and usually there aren't many of these objects. */
10861 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
10863 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, jim_wide id
)
10865 const char *fmt
= "<reference.<%s>.%020" JIM_WIDE_MODIFIER
">";
10867 sprintf(buf
, fmt
, refPtr
->tag
, id
);
10868 return JIM_REFERENCE_SPACE
;
10871 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
10873 static const Jim_ObjType referenceObjType
= {
10877 UpdateStringOfReference
,
10878 JIM_TYPE_REFERENCES
,
10881 void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
10884 char buf
[JIM_REFERENCE_SPACE
+ 1];
10885 Jim_Reference
*refPtr
;
10887 refPtr
= objPtr
->internalRep
.refValue
.refPtr
;
10888 len
= JimFormatReference(buf
, refPtr
, objPtr
->internalRep
.refValue
.id
);
10889 objPtr
->bytes
= Jim_Alloc(len
+ 1);
10890 memcpy(objPtr
->bytes
, buf
, len
+ 1);
10891 objPtr
->length
= len
;
10894 /* returns true if 'c' is a valid reference tag character.
10895 * i.e. inside the range [_a-zA-Z0-9] */
10896 static int isrefchar(int c
)
10898 return (c
== '_' || isalnum(c
));
10901 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10903 jim_wide wideValue
;
10905 const char *str
, *start
, *end
;
10907 Jim_Reference
*refPtr
;
10910 /* Get the string representation */
10911 str
= Jim_GetString(objPtr
, &len
);
10912 /* Check if it looks like a reference */
10913 if (len
< JIM_REFERENCE_SPACE
)
10917 end
= str
+ len
- 1;
10918 while (*start
== ' ')
10920 while (*end
== ' ' && end
> start
)
10922 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
10924 /* <reference.<1234567>.%020> */
10925 if (memcmp(start
, "<reference.<", 12) != 0)
10927 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
10929 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
10930 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
10931 if (!isrefchar(start
[12 + i
]))
10934 /* Extract info from the reference. */
10935 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
10937 /* Try to convert the ID into a jim_wide */
10938 if (Jim_StringToWide(refId
, &wideValue
, 10) != JIM_OK
)
10940 /* Check if the reference really exists! */
10941 he
= Jim_FindHashEntry(&interp
->references
, &wideValue
);
10943 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
10946 refPtr
= he
->u
.val
;
10947 /* Free the old internal repr and set the new one. */
10948 Jim_FreeIntRep(interp
, objPtr
);
10949 objPtr
->typePtr
= &referenceObjType
;
10950 objPtr
->internalRep
.refValue
.id
= wideValue
;
10951 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
10955 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
10959 /* Returns a new reference pointing to objPtr, having cmdNamePtr
10960 * as finalizer command (or NULL if there is no finalizer).
10961 * The returned reference object has refcount = 0. */
10962 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
10964 struct Jim_Reference
*refPtr
;
10965 jim_wide wideValue
= interp
->referenceNextId
;
10966 Jim_Obj
*refObjPtr
;
10970 /* Perform the Garbage Collection if needed. */
10971 Jim_CollectIfNeeded(interp
);
10973 refPtr
= Jim_Alloc(sizeof(*refPtr
));
10974 refPtr
->objPtr
= objPtr
;
10975 Jim_IncrRefCount(objPtr
);
10976 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
10978 Jim_IncrRefCount(cmdNamePtr
);
10979 Jim_AddHashEntry(&interp
->references
, &wideValue
, refPtr
);
10980 refObjPtr
= Jim_NewObj(interp
);
10981 refObjPtr
->typePtr
= &referenceObjType
;
10982 refObjPtr
->bytes
= NULL
;
10983 refObjPtr
->internalRep
.refValue
.id
= interp
->referenceNextId
;
10984 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
10985 interp
->referenceNextId
++;
10986 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
10987 * that does not pass the 'isrefchar' test is replaced with '_' */
10988 tag
= Jim_GetString(tagPtr
, &tagLen
);
10989 if (tagLen
> JIM_REFERENCE_TAGLEN
)
10990 tagLen
= JIM_REFERENCE_TAGLEN
;
10991 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
10992 if (i
< tagLen
&& isrefchar(tag
[i
]))
10993 refPtr
->tag
[i
] = tag
[i
];
10995 refPtr
->tag
[i
] = '_';
10997 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
11001 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11003 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
11005 return objPtr
->internalRep
.refValue
.refPtr
;
11008 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
11010 Jim_Reference
*refPtr
;
11012 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
11014 Jim_IncrRefCount(cmdNamePtr
);
11015 if (refPtr
->finalizerCmdNamePtr
)
11016 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
11017 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
11021 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
11023 Jim_Reference
*refPtr
;
11025 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
11027 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
11031 /* -----------------------------------------------------------------------------
11032 * References Garbage Collection
11033 * ---------------------------------------------------------------------------*/
11035 /* This the hash table type for the "MARK" phase of the GC */
11036 static const Jim_HashTableType JimRefMarkHashTableType
= {
11037 JimReferencesHTHashFunction
, /* hash function */
11038 JimReferencesHTKeyDup
, /* key dup */
11039 NULL
, /* val dup */
11040 JimReferencesHTKeyCompare
, /* key compare */
11041 JimReferencesHTKeyDestructor
, /* key destructor */
11042 NULL
/* val destructor */
11045 /* Performs the garbage collection. */
11046 int Jim_Collect(Jim_Interp
*interp
)
11048 Jim_HashTable marks
;
11049 Jim_HashTableIterator
*htiter
;
11054 /* Avoid recursive calls */
11055 if (interp
->lastCollectId
== -1) {
11056 /* Jim_Collect() already running. Return just now. */
11059 interp
->lastCollectId
= -1;
11061 /* Mark all the references found into the 'mark' hash table.
11062 * The references are searched in every live object that
11063 * is of a type that can contain references. */
11064 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
11065 objPtr
= interp
->liveList
;
11067 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
11068 const char *str
, *p
;
11071 /* If the object is of type reference, to get the
11072 * Id is simple... */
11073 if (objPtr
->typePtr
== &referenceObjType
) {
11074 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
11075 #ifdef JIM_DEBUG_GC
11076 printf("MARK (reference): %d refcount: %d" JIM_NL
,
11077 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
11079 objPtr
= objPtr
->nextObjPtr
;
11082 /* Get the string repr of the object we want
11083 * to scan for references. */
11084 p
= str
= Jim_GetString(objPtr
, &len
);
11085 /* Skip objects too little to contain references. */
11086 if (len
< JIM_REFERENCE_SPACE
) {
11087 objPtr
= objPtr
->nextObjPtr
;
11090 /* Extract references from the object string repr. */
11096 if ((p
= strstr(p
, "<reference.<")) == NULL
)
11098 /* Check if it's a valid reference. */
11099 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
11101 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
11103 for (i
= 21; i
<= 40; i
++)
11104 if (!isdigit(UCHAR(p
[i
])))
11107 memcpy(buf
, p
+ 21, 20);
11109 Jim_StringToWide(buf
, &id
, 10);
11111 /* Ok, a reference for the given ID
11112 * was found. Mark it. */
11113 Jim_AddHashEntry(&marks
, &id
, NULL
);
11114 #ifdef JIM_DEBUG_GC
11115 printf("MARK: %d" JIM_NL
, (int)id
);
11117 p
+= JIM_REFERENCE_SPACE
;
11120 objPtr
= objPtr
->nextObjPtr
;
11123 /* Run the references hash table to destroy every reference that
11124 * is not referenced outside (not present in the mark HT). */
11125 htiter
= Jim_GetHashTableIterator(&interp
->references
);
11126 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
11127 const jim_wide
*refId
;
11128 Jim_Reference
*refPtr
;
11131 /* Check if in the mark phase we encountered
11132 * this reference. */
11133 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
11134 #ifdef JIM_DEBUG_GC
11135 printf("COLLECTING %d" JIM_NL
, (int)*refId
);
11138 /* Drop the reference, but call the
11139 * finalizer first if registered. */
11140 refPtr
= he
->u
.val
;
11141 if (refPtr
->finalizerCmdNamePtr
) {
11142 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
11143 Jim_Obj
*objv
[3], *oldResult
;
11145 JimFormatReference(refstr
, refPtr
, *refId
);
11147 objv
[0] = refPtr
->finalizerCmdNamePtr
;
11148 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, 32);
11149 objv
[2] = refPtr
->objPtr
;
11150 Jim_IncrRefCount(objv
[0]);
11151 Jim_IncrRefCount(objv
[1]);
11152 Jim_IncrRefCount(objv
[2]);
11154 /* Drop the reference itself */
11155 Jim_DeleteHashEntry(&interp
->references
, refId
);
11157 /* Call the finalizer. Errors ignored. */
11158 oldResult
= interp
->result
;
11159 Jim_IncrRefCount(oldResult
);
11160 Jim_EvalObjVector(interp
, 3, objv
);
11161 Jim_SetResult(interp
, oldResult
);
11162 Jim_DecrRefCount(interp
, oldResult
);
11164 Jim_DecrRefCount(interp
, objv
[0]);
11165 Jim_DecrRefCount(interp
, objv
[1]);
11166 Jim_DecrRefCount(interp
, objv
[2]);
11169 Jim_DeleteHashEntry(&interp
->references
, refId
);
11173 Jim_FreeHashTableIterator(htiter
);
11174 Jim_FreeHashTable(&marks
);
11175 interp
->lastCollectId
= interp
->referenceNextId
;
11176 interp
->lastCollectTime
= time(NULL
);
11180 #define JIM_COLLECT_ID_PERIOD 5000
11181 #define JIM_COLLECT_TIME_PERIOD 300
11183 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
11185 jim_wide elapsedId
;
11188 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
11189 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
11192 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
11193 Jim_Collect(interp
);
11198 static int JimIsBigEndian(void)
11202 unsigned char c
[2];
11205 return uval
.c
[0] == 1;
11208 /* -----------------------------------------------------------------------------
11209 * Interpreter related functions
11210 * ---------------------------------------------------------------------------*/
11212 Jim_Interp
*Jim_CreateInterp(void)
11214 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
11216 memset(i
, 0, sizeof(*i
));
11218 i
->errorFileName
= Jim_StrDup("");
11219 i
->maxNestingDepth
= JIM_MAX_NESTING_DEPTH
;
11220 i
->lastCollectTime
= time(NULL
);
11222 /* Note that we can create objects only after the
11223 * interpreter liveList and freeList pointers are
11224 * initialized to NULL. */
11225 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
11226 #ifdef JIM_REFERENCES
11227 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
11229 Jim_InitHashTable(&i
->sharedStrings
, &JimSharedStringsHashTableType
, NULL
);
11230 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
11231 Jim_InitHashTable(&i
->packages
, &JimStringKeyValCopyHashTableType
, NULL
);
11232 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
);
11233 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
11234 i
->trueObj
= Jim_NewIntObj(i
, 1);
11235 i
->falseObj
= Jim_NewIntObj(i
, 0);
11236 i
->result
= i
->emptyObj
;
11237 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
11238 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
11239 i
->errorProc
= i
->emptyObj
;
11240 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
11241 Jim_IncrRefCount(i
->emptyObj
);
11242 Jim_IncrRefCount(i
->result
);
11243 Jim_IncrRefCount(i
->stackTrace
);
11244 Jim_IncrRefCount(i
->unknown
);
11245 Jim_IncrRefCount(i
->currentScriptObj
);
11246 Jim_IncrRefCount(i
->errorProc
);
11247 Jim_IncrRefCount(i
->trueObj
);
11248 Jim_IncrRefCount(i
->falseObj
);
11250 /* Initialize key variables every interpreter should contain */
11251 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
11252 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
11254 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
11255 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
11256 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
11257 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
11258 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
11259 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
11264 void Jim_FreeInterp(Jim_Interp
*i
)
11266 Jim_CallFrame
*cf
= i
->framePtr
, *prevcf
, *nextcf
;
11267 Jim_Obj
*objPtr
, *nextObjPtr
;
11269 Jim_DecrRefCount(i
, i
->emptyObj
);
11270 Jim_DecrRefCount(i
, i
->trueObj
);
11271 Jim_DecrRefCount(i
, i
->falseObj
);
11272 Jim_DecrRefCount(i
, i
->result
);
11273 Jim_DecrRefCount(i
, i
->stackTrace
);
11274 Jim_DecrRefCount(i
, i
->errorProc
);
11275 Jim_DecrRefCount(i
, i
->unknown
);
11276 Jim_Free((void *)i
->errorFileName
);
11277 Jim_DecrRefCount(i
, i
->currentScriptObj
);
11278 Jim_FreeHashTable(&i
->commands
);
11279 #ifdef JIM_REFERENCES
11280 Jim_FreeHashTable(&i
->references
);
11282 Jim_FreeHashTable(&i
->packages
);
11283 Jim_Free(i
->prngState
);
11284 Jim_FreeHashTable(&i
->assocData
);
11285 JimDeleteLocalProcs(i
);
11287 /* Free the call frames list */
11289 prevcf
= cf
->parentCallFrame
;
11290 JimFreeCallFrame(i
, cf
, JIM_FCF_NONE
);
11293 /* Check that the live object list is empty, otherwise
11294 * there is a memory leak. */
11295 if (i
->liveList
!= NULL
) {
11296 objPtr
= i
->liveList
;
11298 printf(JIM_NL
"-------------------------------------" JIM_NL
);
11299 printf("Objects still in the free list:" JIM_NL
);
11301 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
11303 printf("%p (%d) %-10s: '%.20s'" JIM_NL
,
11304 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
11305 if (objPtr
->typePtr
== &sourceObjType
) {
11306 printf("FILE %s LINE %d" JIM_NL
,
11307 objPtr
->internalRep
.sourceValue
.fileName
,
11308 objPtr
->internalRep
.sourceValue
.lineNumber
);
11310 objPtr
= objPtr
->nextObjPtr
;
11312 printf("-------------------------------------" JIM_NL JIM_NL
);
11313 JimPanic((1, i
, "Live list non empty freeing the interpreter! Leak?"));
11315 /* Free all the freed objects. */
11316 objPtr
= i
->freeList
;
11318 nextObjPtr
= objPtr
->nextObjPtr
;
11320 objPtr
= nextObjPtr
;
11322 /* Free cached CallFrame structures */
11323 cf
= i
->freeFramesList
;
11325 nextcf
= cf
->nextFramePtr
;
11326 if (cf
->vars
.table
!= NULL
)
11327 Jim_Free(cf
->vars
.table
);
11331 #ifdef jim_ext_load
11332 Jim_FreeLoadHandles(i
);
11335 /* Free the sharedString hash table. Make sure to free it
11336 * after every other Jim_Object was freed. */
11337 Jim_FreeHashTable(&i
->sharedStrings
);
11338 /* Free the interpreter structure. */
11342 /* Returns the call frame relative to the level represented by
11343 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
11345 * This function accepts the 'level' argument in the form
11346 * of the commands [uplevel] and [upvar].
11348 * For a function accepting a relative integer as level suitable
11349 * for implementation of [info level ?level?] check the
11350 * JimGetCallFrameByInteger() function.
11352 * Returns NULL on error.
11354 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
11358 Jim_CallFrame
*framePtr
;
11361 str
= Jim_String(levelObjPtr
);
11362 if (str
[0] == '#') {
11365 level
= strtol(str
+ 1, &endptr
, 0);
11366 if (str
[1] == '\0' || endptr
[0] != '\0') {
11371 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
11375 /* Convert from a relative to an absolute level */
11376 level
= interp
->framePtr
->level
- level
;
11381 str
= "1"; /* Needed to format the error message. */
11382 level
= interp
->framePtr
->level
- 1;
11386 return interp
->topFramePtr
;
11390 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parentCallFrame
) {
11391 if (framePtr
->level
== level
) {
11397 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
11401 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
11402 * as a relative integer like in the [info level ?level?] command.
11404 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
11407 Jim_CallFrame
*framePtr
;
11409 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
11411 /* Convert from a relative to an absolute level */
11412 level
= interp
->framePtr
->level
+ level
;
11416 return interp
->topFramePtr
;
11420 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parentCallFrame
) {
11421 if (framePtr
->level
== level
) {
11427 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11431 static void JimSetErrorFileName(Jim_Interp
*interp
, const char *filename
)
11433 Jim_Free((void *)interp
->errorFileName
);
11434 interp
->errorFileName
= Jim_StrDup(filename
);
11437 static void JimSetErrorLineNumber(Jim_Interp
*interp
, int linenr
)
11439 interp
->errorLine
= linenr
;
11442 static void JimResetStackTrace(Jim_Interp
*interp
)
11444 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11445 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
11446 Jim_IncrRefCount(interp
->stackTrace
);
11449 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
11453 /* Increment reference first in case these are the same object */
11454 Jim_IncrRefCount(stackTraceObj
);
11455 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11456 interp
->stackTrace
= stackTraceObj
;
11457 interp
->errorFlag
= 1;
11459 /* This is a bit ugly.
11460 * If the filename of the last entry of the stack trace is empty,
11461 * the next stack level should be added.
11463 len
= Jim_ListLength(interp
, interp
->stackTrace
);
11465 Jim_Obj
*filenameObj
;
11467 Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
, JIM_NONE
);
11469 Jim_GetString(filenameObj
, &len
);
11472 interp
->addStackTrace
= 1;
11477 /* Returns 1 if the stack trace information was used or 0 if not */
11478 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
11479 const char *filename
, int linenr
)
11481 if (strcmp(procname
, "unknown") == 0) {
11484 if (!*procname
&& !*filename
) {
11485 /* No useful info here */
11489 if (Jim_IsShared(interp
->stackTrace
)) {
11490 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11491 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
11492 Jim_IncrRefCount(interp
->stackTrace
);
11495 /* If we have no procname but the previous element did, merge with that frame */
11496 if (!*procname
&& *filename
) {
11497 /* Just a filename. Check the previous entry */
11498 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
11501 Jim_Obj
*procnameObj
;
11502 Jim_Obj
*filenameObj
;
11504 if (Jim_ListIndex(interp
, interp
->stackTrace
, len
- 3, &procnameObj
, JIM_NONE
) == JIM_OK
11505 && Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
,
11506 JIM_NONE
) == JIM_OK
) {
11508 const char *prev_procname
= Jim_String(procnameObj
);
11509 const char *prev_filename
= Jim_String(filenameObj
);
11511 if (*prev_procname
&& !*prev_filename
) {
11512 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, Jim_NewStringObj(interp
,
11514 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
),
11522 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
11523 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, filename
, -1));
11524 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
11527 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
11530 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
11532 assocEntryPtr
->delProc
= delProc
;
11533 assocEntryPtr
->data
= data
;
11534 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
11537 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
11539 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
11541 if (entryPtr
!= NULL
) {
11542 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) entryPtr
->u
.val
;
11544 return assocEntryPtr
->data
;
11549 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
11551 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
11554 int Jim_GetExitCode(Jim_Interp
*interp
)
11556 return interp
->exitCode
;
11559 /* -----------------------------------------------------------------------------
11561 * Every interpreter has an hash table where to put shared dynamically
11562 * allocate strings that are likely to be used a lot of times.
11563 * For example, in the 'source' object type, there is a pointer to
11564 * the filename associated with that object. Every script has a lot
11565 * of this objects with the identical file name, so it is wise to share
11568 * The API is trivial: Jim_GetSharedString(interp, "foobar")
11569 * returns the pointer to the shared string. Every time a reference
11570 * to the string is no longer used, the user should call
11571 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
11572 * a given string, it is removed from the hash table.
11573 * ---------------------------------------------------------------------------*/
11574 const char *Jim_GetSharedString(Jim_Interp
*interp
, const char *str
)
11576 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
11579 char *strCopy
= Jim_StrDup(str
);
11581 Jim_AddHashEntry(&interp
->sharedStrings
, strCopy
, NULL
);
11582 he
= Jim_FindHashEntry(&interp
->sharedStrings
, strCopy
);
11592 void Jim_ReleaseSharedString(Jim_Interp
*interp
, const char *str
)
11594 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
11596 JimPanic((he
== NULL
, interp
, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str
));
11598 if (--he
->u
.intval
== 0) {
11599 Jim_DeleteHashEntry(&interp
->sharedStrings
, str
);
11603 /* -----------------------------------------------------------------------------
11605 * ---------------------------------------------------------------------------*/
11606 #define JIM_INTEGER_SPACE 24
11608 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
11609 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
11611 static const Jim_ObjType intObjType
= {
11619 /* A coerced double is closer to an int than a double.
11620 * It is an int value temporarily masquerading as a double value.
11621 * i.e. it has the same string value as an int and Jim_GetWide()
11622 * succeeds, but also Jim_GetDouble() returns the value directly.
11624 static const Jim_ObjType coercedDoubleObjType
= {
11633 void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
11636 char buf
[JIM_INTEGER_SPACE
+ 1];
11638 len
= Jim_WideToString(buf
, JimWideValue(objPtr
));
11639 objPtr
->bytes
= Jim_Alloc(len
+ 1);
11640 memcpy(objPtr
->bytes
, buf
, len
+ 1);
11641 objPtr
->length
= len
;
11644 int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11646 jim_wide wideValue
;
11649 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11650 /* Simple switcheroo */
11651 objPtr
->typePtr
= &intObjType
;
11655 /* Get the string representation */
11656 str
= Jim_String(objPtr
);
11657 /* Try to convert into a jim_wide */
11658 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
11659 if (flags
& JIM_ERRMSG
) {
11660 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
11664 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
11665 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
11668 /* Free the old internal repr and set the new one. */
11669 Jim_FreeIntRep(interp
, objPtr
);
11670 objPtr
->typePtr
= &intObjType
;
11671 objPtr
->internalRep
.wideValue
= wideValue
;
11675 #ifdef JIM_OPTIMIZATION
11676 static int JimIsWide(Jim_Obj
*objPtr
)
11678 return objPtr
->typePtr
== &intObjType
;
11682 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
11684 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
11686 *widePtr
= JimWideValue(objPtr
);
11690 /* Get a wide but does not set an error if the format is bad. */
11691 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
11693 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
11695 *widePtr
= JimWideValue(objPtr
);
11699 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
11701 jim_wide wideValue
;
11704 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
11705 if (retval
== JIM_OK
) {
11706 *longPtr
= (long)wideValue
;
11712 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
11716 objPtr
= Jim_NewObj(interp
);
11717 objPtr
->typePtr
= &intObjType
;
11718 objPtr
->bytes
= NULL
;
11719 objPtr
->internalRep
.wideValue
= wideValue
;
11723 /* -----------------------------------------------------------------------------
11725 * ---------------------------------------------------------------------------*/
11726 #define JIM_DOUBLE_SPACE 30
11728 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
11729 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
11731 static const Jim_ObjType doubleObjType
= {
11735 UpdateStringOfDouble
,
11739 void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
11742 char buf
[JIM_DOUBLE_SPACE
+ 1];
11744 len
= Jim_DoubleToString(buf
, objPtr
->internalRep
.doubleValue
);
11745 objPtr
->bytes
= Jim_Alloc(len
+ 1);
11746 memcpy(objPtr
->bytes
, buf
, len
+ 1);
11747 objPtr
->length
= len
;
11750 int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11752 double doubleValue
;
11753 jim_wide wideValue
;
11756 /* Preserve the string representation.
11757 * Needed so we can convert back to int without loss
11759 str
= Jim_String(objPtr
);
11761 #ifdef HAVE_LONG_LONG
11762 /* Assume a 53 bit mantissa */
11763 #define MIN_INT_IN_DOUBLE -(1LL << 53)
11764 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
11766 if (objPtr
->typePtr
== &intObjType
11767 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
11768 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
11770 /* Direct conversion to coerced double */
11771 objPtr
->typePtr
= &coercedDoubleObjType
;
11776 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
11777 /* Managed to convert to an int, so we can use this as a cooerced double */
11778 Jim_FreeIntRep(interp
, objPtr
);
11779 objPtr
->typePtr
= &coercedDoubleObjType
;
11780 objPtr
->internalRep
.wideValue
= wideValue
;
11784 /* Try to convert into a double */
11785 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
11786 Jim_SetResultFormatted(interp
, "expected number but got \"%#s\"", objPtr
);
11789 /* Free the old internal repr and set the new one. */
11790 Jim_FreeIntRep(interp
, objPtr
);
11792 objPtr
->typePtr
= &doubleObjType
;
11793 objPtr
->internalRep
.doubleValue
= doubleValue
;
11797 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
11799 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11800 *doublePtr
= JimWideValue(objPtr
);
11803 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
11806 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11807 *doublePtr
= JimWideValue(objPtr
);
11810 *doublePtr
= objPtr
->internalRep
.doubleValue
;
11815 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
11819 objPtr
= Jim_NewObj(interp
);
11820 objPtr
->typePtr
= &doubleObjType
;
11821 objPtr
->bytes
= NULL
;
11822 objPtr
->internalRep
.doubleValue
= doubleValue
;
11826 /* -----------------------------------------------------------------------------
11828 * ---------------------------------------------------------------------------*/
11829 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
11830 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
11831 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
11832 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
11833 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
11835 /* Note that while the elements of the list may contain references,
11836 * the list object itself can't. This basically means that the
11837 * list object string representation as a whole can't contain references
11838 * that are not presents in the single elements. */
11839 static const Jim_ObjType listObjType
= {
11841 FreeListInternalRep
,
11842 DupListInternalRep
,
11843 UpdateStringOfList
,
11847 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11851 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
11852 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
11854 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
11857 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
11861 JIM_NOTUSED(interp
);
11863 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
11864 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
11865 dupPtr
->internalRep
.listValue
.ele
=
11866 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
11867 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
11868 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
11869 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
11870 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
11872 dupPtr
->typePtr
= &listObjType
;
11875 /* The following function checks if a given string can be encoded
11876 * into a list element without any kind of quoting, surrounded by braces,
11877 * or using escapes to quote. */
11878 #define JIM_ELESTR_SIMPLE 0
11879 #define JIM_ELESTR_BRACE 1
11880 #define JIM_ELESTR_QUOTE 2
11881 static int ListElementQuotingType(const char *s
, int len
)
11883 int i
, level
, trySimple
= 1;
11885 /* Try with the SIMPLE case */
11887 return JIM_ELESTR_BRACE
;
11889 return JIM_ELESTR_BRACE
;
11890 if (s
[0] == '"' || s
[0] == '{') {
11894 for (i
= 0; i
< len
; i
++) {
11914 return JIM_ELESTR_SIMPLE
;
11917 /* Test if it's possible to do with braces */
11918 if (s
[len
- 1] == '\\' || s
[len
- 1] == ']')
11919 return JIM_ELESTR_QUOTE
;
11921 for (i
= 0; i
< len
; i
++) {
11929 return JIM_ELESTR_QUOTE
;
11932 if (s
[i
+ 1] == '\n')
11933 return JIM_ELESTR_QUOTE
;
11934 else if (s
[i
+ 1] != '\0')
11941 return JIM_ELESTR_BRACE
;
11942 for (i
= 0; i
< len
; i
++) {
11956 return JIM_ELESTR_BRACE
;
11960 return JIM_ELESTR_SIMPLE
;
11962 return JIM_ELESTR_QUOTE
;
11965 /* Returns the malloc-ed representation of a string
11966 * using backslash to quote special chars. */
11967 static char *BackslashQuoteString(const char *s
, int len
, int *qlenPtr
)
11969 char *q
= Jim_Alloc(len
* 2 + 1), *p
;
12021 void UpdateStringOfList(struct Jim_Obj
*objPtr
)
12023 int i
, bufLen
, realLength
;
12024 const char *strRep
;
12027 Jim_Obj
**ele
= objPtr
->internalRep
.listValue
.ele
;
12029 /* (Over) Estimate the space needed. */
12030 quotingType
= Jim_Alloc(sizeof(int) * objPtr
->internalRep
.listValue
.len
+ 1);
12032 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
12035 strRep
= Jim_GetString(ele
[i
], &len
);
12036 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
12037 switch (quotingType
[i
]) {
12038 case JIM_ELESTR_SIMPLE
:
12041 case JIM_ELESTR_BRACE
:
12044 case JIM_ELESTR_QUOTE
:
12048 bufLen
++; /* elements separator. */
12052 /* Generate the string rep. */
12053 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
12055 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
12059 strRep
= Jim_GetString(ele
[i
], &len
);
12061 switch (quotingType
[i
]) {
12062 case JIM_ELESTR_SIMPLE
:
12063 memcpy(p
, strRep
, len
);
12067 case JIM_ELESTR_BRACE
:
12069 memcpy(p
, strRep
, len
);
12072 realLength
+= len
+ 2;
12074 case JIM_ELESTR_QUOTE
:
12075 q
= BackslashQuoteString(strRep
, len
, &qlen
);
12076 memcpy(p
, q
, qlen
);
12079 realLength
+= qlen
;
12082 /* Add a separating space */
12083 if (i
+ 1 != objPtr
->internalRep
.listValue
.len
) {
12088 *p
= '\0'; /* nul term. */
12089 objPtr
->length
= realLength
;
12090 Jim_Free(quotingType
);
12093 int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
12095 struct JimParserCtx parser
;
12098 const char *filename
= NULL
;
12101 /* Try to preserve information about filename / line number */
12102 if (objPtr
->typePtr
== &sourceObjType
) {
12103 filename
= Jim_GetSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
12104 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
12107 /* Get the string representation */
12108 str
= Jim_GetString(objPtr
, &strLen
);
12110 /* Free the old internal repr just now and initialize the
12111 * new one just now. The string->list conversion can't fail. */
12112 Jim_FreeIntRep(interp
, objPtr
);
12113 objPtr
->typePtr
= &listObjType
;
12114 objPtr
->internalRep
.listValue
.len
= 0;
12115 objPtr
->internalRep
.listValue
.maxLen
= 0;
12116 objPtr
->internalRep
.listValue
.ele
= NULL
;
12118 /* Convert into a list */
12119 JimParserInit(&parser
, str
, strLen
, linenr
);
12120 while (!parser
.eof
) {
12121 Jim_Obj
*elementPtr
;
12123 JimParseList(&parser
);
12124 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
12126 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
12127 JimSetSourceInfo(interp
, elementPtr
, filename
, parser
.tline
);
12128 ListAppendElement(objPtr
, elementPtr
);
12131 Jim_ReleaseSharedString(interp
, filename
);
12136 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
12141 objPtr
= Jim_NewObj(interp
);
12142 objPtr
->typePtr
= &listObjType
;
12143 objPtr
->bytes
= NULL
;
12144 objPtr
->internalRep
.listValue
.ele
= NULL
;
12145 objPtr
->internalRep
.listValue
.len
= 0;
12146 objPtr
->internalRep
.listValue
.maxLen
= 0;
12147 for (i
= 0; i
< len
; i
++) {
12148 ListAppendElement(objPtr
, elements
[i
]);
12153 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
12154 * length of the vector. Note that the user of this function should make
12155 * sure that the list object can't shimmer while the vector returned
12156 * is in use, this vector is the one stored inside the internal representation
12157 * of the list object. This function is not exported, extensions should
12158 * always access to the List object elements using Jim_ListIndex(). */
12159 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
12160 Jim_Obj
***listVec
)
12162 *listLen
= Jim_ListLength(interp
, listObj
);
12163 *listVec
= listObj
->internalRep
.listValue
.ele
;
12166 /* Sorting uses ints, but commands may return wide */
12167 static int JimSign(jim_wide w
)
12178 /* ListSortElements type values */
12179 struct lsort_info
{
12182 Jim_Interp
*interp
;
12192 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
12195 static struct lsort_info
*sort_info
;
12197 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12199 Jim_Obj
*lObj
, *rObj
;
12201 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
12202 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
12203 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
12205 return sort_info
->subfn(&lObj
, &rObj
);
12208 /* Sort the internal rep of a list. */
12209 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12211 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
12214 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12216 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
12219 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12221 jim_wide lhs
= 0, rhs
= 0;
12223 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
12224 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
12225 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
12228 return JimSign(lhs
- rhs
) * sort_info
->order
;
12231 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12233 Jim_Obj
*compare_script
;
12238 /* This must be a valid list */
12239 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
12240 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
12241 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
12243 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
12245 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
12246 longjmp(sort_info
->jmpbuf
, rc
);
12249 return JimSign(ret
) * sort_info
->order
;
12252 /* Sort a list *in place*. MUST be called with non-shared objects. */
12253 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
12255 struct lsort_info
*prev_info
;
12257 typedef int (qsort_comparator
) (const void *, const void *);
12258 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
12263 JimPanic((Jim_IsShared(listObjPtr
), interp
, "Jim_ListSortElements called with shared object"));
12264 if (!Jim_IsList(listObjPtr
))
12265 SetListFromAny(interp
, listObjPtr
);
12267 /* Allow lsort to be called reentrantly */
12268 prev_info
= sort_info
;
12271 vector
= listObjPtr
->internalRep
.listValue
.ele
;
12272 len
= listObjPtr
->internalRep
.listValue
.len
;
12273 switch (info
->type
) {
12274 case JIM_LSORT_ASCII
:
12275 fn
= ListSortString
;
12277 case JIM_LSORT_NOCASE
:
12278 fn
= ListSortStringNoCase
;
12280 case JIM_LSORT_INTEGER
:
12281 fn
= ListSortInteger
;
12283 case JIM_LSORT_COMMAND
:
12284 fn
= ListSortCommand
;
12287 fn
= NULL
; /* avoid warning */
12288 JimPanic((1, interp
, "ListSort called with invalid sort type"));
12291 if (info
->indexed
) {
12292 /* Need to interpose a "list index" function */
12294 fn
= ListSortIndexHelper
;
12297 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
12298 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
12300 Jim_InvalidateStringRep(listObjPtr
);
12301 sort_info
= prev_info
;
12306 /* This is the low-level function to insert elements into a list.
12307 * The higher-level Jim_ListInsertElements() performs shared object
12308 * check and invalidate the string repr. This version is used
12309 * in the internals of the List Object and is not exported.
12311 * NOTE: this function can be called only against objects
12312 * with internal type of List. */
12313 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
12315 int currentLen
= listPtr
->internalRep
.listValue
.len
;
12316 int requiredLen
= currentLen
+ elemc
;
12320 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
12321 int maxLen
= requiredLen
* 2;
12323 listPtr
->internalRep
.listValue
.ele
=
12324 Jim_Realloc(listPtr
->internalRep
.listValue
.ele
, sizeof(Jim_Obj
*) * maxLen
);
12325 listPtr
->internalRep
.listValue
.maxLen
= maxLen
;
12327 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
12328 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
12329 for (i
= 0; i
< elemc
; ++i
) {
12330 point
[i
] = elemVec
[i
];
12331 Jim_IncrRefCount(point
[i
]);
12333 listPtr
->internalRep
.listValue
.len
+= elemc
;
12336 /* Convenience call to ListInsertElements() to append a single element.
12338 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
12340 ListInsertElements(listPtr
, listPtr
->internalRep
.listValue
.len
, 1, &objPtr
);
12344 /* Appends every element of appendListPtr into listPtr.
12345 * Both have to be of the list type.
12346 * Convenience call to ListInsertElements()
12348 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
12350 ListInsertElements(listPtr
, listPtr
->internalRep
.listValue
.len
,
12351 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
12354 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
12356 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListAppendElement called with shared object"));
12357 if (!Jim_IsList(listPtr
))
12358 SetListFromAny(interp
, listPtr
);
12359 Jim_InvalidateStringRep(listPtr
);
12360 ListAppendElement(listPtr
, objPtr
);
12363 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
12365 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListAppendList called with shared object"));
12366 if (!Jim_IsList(listPtr
))
12367 SetListFromAny(interp
, listPtr
);
12368 Jim_InvalidateStringRep(listPtr
);
12369 ListAppendList(listPtr
, appendListPtr
);
12372 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
12374 if (!Jim_IsList(objPtr
))
12375 SetListFromAny(interp
, objPtr
);
12376 return objPtr
->internalRep
.listValue
.len
;
12379 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
12380 int objc
, Jim_Obj
*const *objVec
)
12382 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListInsertElement called with shared object"));
12383 if (!Jim_IsList(listPtr
))
12384 SetListFromAny(interp
, listPtr
);
12385 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
12386 idx
= listPtr
->internalRep
.listValue
.len
;
12389 Jim_InvalidateStringRep(listPtr
);
12390 ListInsertElements(listPtr
, idx
, objc
, objVec
);
12393 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
12395 if (!Jim_IsList(listPtr
))
12396 SetListFromAny(interp
, listPtr
);
12397 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
12398 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
12399 if (flags
& JIM_ERRMSG
) {
12400 Jim_SetResultString(interp
, "list index out of range", -1);
12406 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
12407 *objPtrPtr
= listPtr
->internalRep
.listValue
.ele
[idx
];
12411 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
12412 Jim_Obj
*newObjPtr
, int flags
)
12414 if (!Jim_IsList(listPtr
))
12415 SetListFromAny(interp
, listPtr
);
12416 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
12417 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
12418 if (flags
& JIM_ERRMSG
) {
12419 Jim_SetResultString(interp
, "list index out of range", -1);
12424 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
12425 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
12426 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
12427 Jim_IncrRefCount(newObjPtr
);
12431 /* Modify the list stored into the variable named 'varNamePtr'
12432 * setting the element specified by the 'indexc' indexes objects in 'indexv',
12433 * with the new element 'newObjptr'. */
12434 int Jim_SetListIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
12435 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
12437 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
12438 int shared
, i
, idx
;
12440 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
12441 if (objPtr
== NULL
)
12443 if ((shared
= Jim_IsShared(objPtr
)))
12444 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12445 for (i
= 0; i
< indexc
- 1; i
++) {
12446 listObjPtr
= objPtr
;
12447 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
12449 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
12452 if (Jim_IsShared(objPtr
)) {
12453 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12454 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
12456 Jim_InvalidateStringRep(listObjPtr
);
12458 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
12460 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
12462 Jim_InvalidateStringRep(objPtr
);
12463 Jim_InvalidateStringRep(varObjPtr
);
12464 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
12466 Jim_SetResult(interp
, varObjPtr
);
12470 Jim_FreeNewObj(interp
, varObjPtr
);
12475 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
12479 /* If all the objects in objv are lists,
12480 * it's possible to return a list as result, that's the
12481 * concatenation of all the lists. */
12482 for (i
= 0; i
< objc
; i
++) {
12483 if (!Jim_IsList(objv
[i
]))
12487 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12489 for (i
= 0; i
< objc
; i
++)
12490 Jim_ListAppendList(interp
, objPtr
, objv
[i
]);
12494 /* Else... we have to glue strings together */
12495 int len
= 0, objLen
;
12498 /* Compute the length */
12499 for (i
= 0; i
< objc
; i
++) {
12500 Jim_GetString(objv
[i
], &objLen
);
12505 /* Create the string rep, and a string object holding it. */
12506 p
= bytes
= Jim_Alloc(len
+ 1);
12507 for (i
= 0; i
< objc
; i
++) {
12508 const char *s
= Jim_GetString(objv
[i
], &objLen
);
12510 /* Remove leading space */
12511 while (objLen
&& (*s
== ' ' || *s
== '\t' || *s
== '\n')) {
12516 /* And trailing space */
12517 while (objLen
&& (s
[objLen
- 1] == ' ' ||
12518 s
[objLen
- 1] == '\n' || s
[objLen
- 1] == '\t')) {
12519 /* Handle trailing backslash-space case */
12520 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
12526 memcpy(p
, s
, objLen
);
12528 if (objLen
&& i
+ 1 != objc
) {
12531 else if (i
+ 1 != objc
) {
12532 /* Drop the space calcuated for this
12533 * element that is instead null. */
12538 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
12542 /* Returns a list composed of the elements in the specified range.
12543 * first and start are directly accepted as Jim_Objects and
12544 * processed for the end?-index? case. */
12545 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
12546 Jim_Obj
*lastObjPtr
)
12551 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
12552 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
12554 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
12555 first
= JimRelToAbsIndex(len
, first
);
12556 last
= JimRelToAbsIndex(len
, last
);
12557 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
12558 if (first
== 0 && last
== len
) {
12561 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
12564 /* -----------------------------------------------------------------------------
12566 * ---------------------------------------------------------------------------*/
12567 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
12568 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
12569 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
12570 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
12572 /* Dict HashTable Type.
12574 * Keys and Values are Jim objects. */
12576 static unsigned int JimObjectHTHashFunction(const void *key
)
12579 Jim_Obj
*objPtr
= (Jim_Obj
*)key
;
12582 str
= Jim_GetString(objPtr
, &len
);
12583 h
= Jim_GenHashFunction((unsigned char *)str
, len
);
12587 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
12589 JIM_NOTUSED(privdata
);
12591 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
12594 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
12596 Jim_Obj
*objPtr
= val
;
12598 Jim_DecrRefCount(interp
, objPtr
);
12601 static const Jim_HashTableType JimDictHashTableType
= {
12602 JimObjectHTHashFunction
, /* hash function */
12603 NULL
, /* key dup */
12604 NULL
, /* val dup */
12605 JimObjectHTKeyCompare
, /* key compare */
12606 (void (*)(void *, const void *)) /* ATTENTION: const cast */
12607 JimObjectHTKeyValDestructor
, /* key destructor */
12608 JimObjectHTKeyValDestructor
/* val destructor */
12611 /* Note that while the elements of the dict may contain references,
12612 * the list object itself can't. This basically means that the
12613 * dict object string representation as a whole can't contain references
12614 * that are not presents in the single elements. */
12615 static const Jim_ObjType dictObjType
= {
12617 FreeDictInternalRep
,
12618 DupDictInternalRep
,
12619 UpdateStringOfDict
,
12623 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
12625 JIM_NOTUSED(interp
);
12627 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
12628 Jim_Free(objPtr
->internalRep
.ptr
);
12631 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
12633 Jim_HashTable
*ht
, *dupHt
;
12634 Jim_HashTableIterator
*htiter
;
12637 /* Create a new hash table */
12638 ht
= srcPtr
->internalRep
.ptr
;
12639 dupHt
= Jim_Alloc(sizeof(*dupHt
));
12640 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
12642 Jim_ExpandHashTable(dupHt
, ht
->size
);
12643 /* Copy every element from the source to the dup hash table */
12644 htiter
= Jim_GetHashTableIterator(ht
);
12645 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
12646 const Jim_Obj
*keyObjPtr
= he
->key
;
12647 Jim_Obj
*valObjPtr
= he
->u
.val
;
12649 Jim_IncrRefCount((Jim_Obj
*)keyObjPtr
); /* ATTENTION: const cast */
12650 Jim_IncrRefCount(valObjPtr
);
12651 Jim_AddHashEntry(dupHt
, keyObjPtr
, valObjPtr
);
12653 Jim_FreeHashTableIterator(htiter
);
12655 dupPtr
->internalRep
.ptr
= dupHt
;
12656 dupPtr
->typePtr
= &dictObjType
;
12659 void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
12661 int i
, bufLen
, realLength
;
12662 const char *strRep
;
12664 int *quotingType
, objc
;
12666 Jim_HashTableIterator
*htiter
;
12670 /* Trun the hash table into a flat vector of Jim_Objects. */
12671 ht
= objPtr
->internalRep
.ptr
;
12672 objc
= ht
->used
* 2;
12673 objv
= Jim_Alloc(objc
* sizeof(Jim_Obj
*));
12674 htiter
= Jim_GetHashTableIterator(ht
);
12676 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
12677 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
12678 objv
[i
++] = he
->u
.val
;
12680 Jim_FreeHashTableIterator(htiter
);
12681 /* (Over) Estimate the space needed. */
12682 quotingType
= Jim_Alloc(sizeof(int) * objc
);
12684 for (i
= 0; i
< objc
; i
++) {
12687 strRep
= Jim_GetString(objv
[i
], &len
);
12688 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
12689 switch (quotingType
[i
]) {
12690 case JIM_ELESTR_SIMPLE
:
12693 case JIM_ELESTR_BRACE
:
12696 case JIM_ELESTR_QUOTE
:
12700 bufLen
++; /* elements separator. */
12704 /* Generate the string rep. */
12705 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
12707 for (i
= 0; i
< objc
; i
++) {
12711 strRep
= Jim_GetString(objv
[i
], &len
);
12713 switch (quotingType
[i
]) {
12714 case JIM_ELESTR_SIMPLE
:
12715 memcpy(p
, strRep
, len
);
12719 case JIM_ELESTR_BRACE
:
12721 memcpy(p
, strRep
, len
);
12724 realLength
+= len
+ 2;
12726 case JIM_ELESTR_QUOTE
:
12727 q
= BackslashQuoteString(strRep
, len
, &qlen
);
12728 memcpy(p
, q
, qlen
);
12731 realLength
+= qlen
;
12734 /* Add a separating space */
12735 if (i
+ 1 != objc
) {
12740 *p
= '\0'; /* nul term. */
12741 objPtr
->length
= realLength
;
12742 Jim_Free(quotingType
);
12746 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
12750 /* Get the string representation. Do this first so we don't
12751 * change order in case of fast conversion to dict.
12753 Jim_String(objPtr
);
12755 /* For simplicity, convert a non-list object to a list and then to a dict */
12756 listlen
= Jim_ListLength(interp
, objPtr
);
12758 Jim_SetResultString(interp
,
12759 "invalid dictionary value: must be a list with an even number of elements", -1);
12763 /* Now it is easy to convert to a dict from a list, and it can't fail */
12767 ht
= Jim_Alloc(sizeof(*ht
));
12768 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
12770 for (i
= 0; i
< listlen
; i
+= 2) {
12771 Jim_Obj
*keyObjPtr
;
12772 Jim_Obj
*valObjPtr
;
12774 Jim_ListIndex(interp
, objPtr
, i
, &keyObjPtr
, JIM_NONE
);
12775 Jim_ListIndex(interp
, objPtr
, i
+ 1, &valObjPtr
, JIM_NONE
);
12777 Jim_IncrRefCount(keyObjPtr
);
12778 Jim_IncrRefCount(valObjPtr
);
12780 if (Jim_AddHashEntry(ht
, keyObjPtr
, valObjPtr
) != JIM_OK
) {
12783 he
= Jim_FindHashEntry(ht
, keyObjPtr
);
12784 Jim_DecrRefCount(interp
, keyObjPtr
);
12785 /* ATTENTION: const cast */
12786 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->u
.val
);
12787 he
->u
.val
= valObjPtr
;
12791 Jim_FreeIntRep(interp
, objPtr
);
12792 objPtr
->typePtr
= &dictObjType
;
12793 objPtr
->internalRep
.ptr
= ht
;
12799 /* Dict object API */
12801 /* Add an element to a dict. objPtr must be of the "dict" type.
12802 * The higer-level exported function is Jim_DictAddElement().
12803 * If an element with the specified key already exists, the value
12804 * associated is replaced with the new one.
12806 * if valueObjPtr == NULL, the key is instead removed if it exists. */
12807 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
12808 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
12810 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
12812 if (valueObjPtr
== NULL
) { /* unset */
12813 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
12815 Jim_IncrRefCount(keyObjPtr
);
12816 Jim_IncrRefCount(valueObjPtr
);
12817 if (Jim_AddHashEntry(ht
, keyObjPtr
, valueObjPtr
) != JIM_OK
) {
12818 Jim_HashEntry
*he
= Jim_FindHashEntry(ht
, keyObjPtr
);
12820 Jim_DecrRefCount(interp
, keyObjPtr
);
12821 /* ATTENTION: const cast */
12822 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->u
.val
);
12823 he
->u
.val
= valueObjPtr
;
12828 /* Add an element, higher-level interface for DictAddElement().
12829 * If valueObjPtr == NULL, the key is removed if it exists. */
12830 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
12831 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
12835 JimPanic((Jim_IsShared(objPtr
), interp
, "Jim_DictAddElement called with shared object"));
12836 if (objPtr
->typePtr
!= &dictObjType
) {
12837 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
)
12840 retcode
= DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
12841 Jim_InvalidateStringRep(objPtr
);
12845 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
12850 JimPanic((len
% 2, interp
, "Jim_NewDictObj() 'len' argument must be even"));
12852 objPtr
= Jim_NewObj(interp
);
12853 objPtr
->typePtr
= &dictObjType
;
12854 objPtr
->bytes
= NULL
;
12855 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
12856 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
12857 for (i
= 0; i
< len
; i
+= 2)
12858 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
12862 /* Return the value associated to the specified dict key
12863 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
12865 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
12866 Jim_Obj
**objPtrPtr
, int flags
)
12871 if (dictPtr
->typePtr
!= &dictObjType
) {
12872 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
12875 ht
= dictPtr
->internalRep
.ptr
;
12876 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
12877 if (flags
& JIM_ERRMSG
) {
12878 Jim_SetResultFormatted(interp
, "key \"%#s\" not found in dictionary", keyPtr
);
12882 *objPtrPtr
= he
->u
.val
;
12886 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
12887 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
12890 Jim_HashTableIterator
*htiter
;
12895 if (dictPtr
->typePtr
!= &dictObjType
) {
12896 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
12899 ht
= dictPtr
->internalRep
.ptr
;
12901 /* Turn the hash table into a flat vector of Jim_Objects. */
12902 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
12903 htiter
= Jim_GetHashTableIterator(ht
);
12905 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
12906 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
12907 objv
[i
++] = he
->u
.val
;
12910 Jim_FreeHashTableIterator(htiter
);
12916 /* Return the value associated to the specified dict keys */
12917 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
12918 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
12923 *objPtrPtr
= dictPtr
;
12927 for (i
= 0; i
< keyc
; i
++) {
12930 if (Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
)
12935 *objPtrPtr
= dictPtr
;
12939 /* Modify the dict stored into the variable named 'varNamePtr'
12940 * setting the element specified by the 'keyc' keys objects in 'keyv',
12941 * with the new value of the element 'newObjPtr'.
12943 * If newObjPtr == NULL the operation is to remove the given key
12944 * from the dictionary. */
12945 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
12946 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
)
12948 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
12951 varObjPtr
= objPtr
=
12952 Jim_GetVariable(interp
, varNamePtr
, newObjPtr
== NULL
? JIM_ERRMSG
: JIM_NONE
);
12953 if (objPtr
== NULL
) {
12954 if (newObjPtr
== NULL
) /* Cannot remove a key from non existing var */
12956 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
12957 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
12958 Jim_FreeNewObj(interp
, varObjPtr
);
12962 if ((shared
= Jim_IsShared(objPtr
)))
12963 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12964 for (i
= 0; i
< keyc
- 1; i
++) {
12965 dictObjPtr
= objPtr
;
12967 /* Check if it's a valid dictionary */
12968 if (dictObjPtr
->typePtr
!= &dictObjType
) {
12969 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
)
12972 /* Check if the given key exists. */
12973 Jim_InvalidateStringRep(dictObjPtr
);
12974 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
12975 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
12976 /* This key exists at the current level.
12977 * Make sure it's not shared!. */
12978 if (Jim_IsShared(objPtr
)) {
12979 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12980 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
12984 /* Key not found. If it's an [unset] operation
12985 * this is an error. Only the last key may not
12987 if (newObjPtr
== NULL
)
12989 /* Otherwise set an empty dictionary
12990 * as key's value. */
12991 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
12992 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
12995 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
12998 Jim_InvalidateStringRep(objPtr
);
12999 Jim_InvalidateStringRep(varObjPtr
);
13000 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
13002 Jim_SetResult(interp
, varObjPtr
);
13006 Jim_FreeNewObj(interp
, varObjPtr
);
13011 /* -----------------------------------------------------------------------------
13013 * ---------------------------------------------------------------------------*/
13014 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
13015 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
13017 static const Jim_ObjType indexObjType
= {
13021 UpdateStringOfIndex
,
13025 void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
13028 char buf
[JIM_INTEGER_SPACE
+ 1];
13030 if (objPtr
->internalRep
.indexValue
>= 0)
13031 len
= sprintf(buf
, "%d", objPtr
->internalRep
.indexValue
);
13032 else if (objPtr
->internalRep
.indexValue
== -1)
13033 len
= sprintf(buf
, "end");
13035 len
= sprintf(buf
, "end%d", objPtr
->internalRep
.indexValue
+ 1);
13037 objPtr
->bytes
= Jim_Alloc(len
+ 1);
13038 memcpy(objPtr
->bytes
, buf
, len
+ 1);
13039 objPtr
->length
= len
;
13042 int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
13048 /* Get the string representation */
13049 str
= Jim_String(objPtr
);
13051 /* Try to convert into an index */
13052 if (strncmp(str
, "end", 3) == 0) {
13058 idx
= strtol(str
, &endptr
, 10);
13060 if (endptr
== str
) {
13066 /* Now str may include or +<num> or -<num> */
13067 if (*str
== '+' || *str
== '-') {
13068 int sign
= (*str
== '+' ? 1 : -1);
13070 idx
+= sign
* strtol(++str
, &endptr
, 10);
13071 if (str
== endptr
|| *endptr
) {
13076 /* The only thing left should be spaces */
13077 while (isspace(UCHAR(*str
))) {
13088 /* end-1 is repesented as -2 */
13092 else if (idx
< 0) {
13096 /* Free the old internal repr and set the new one. */
13097 Jim_FreeIntRep(interp
, objPtr
);
13098 objPtr
->typePtr
= &indexObjType
;
13099 objPtr
->internalRep
.indexValue
= idx
;
13103 Jim_SetResultFormatted(interp
,
13104 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
13108 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
13110 /* Avoid shimmering if the object is an integer. */
13111 if (objPtr
->typePtr
== &intObjType
) {
13112 jim_wide val
= JimWideValue(objPtr
);
13114 if (!(val
< LONG_MIN
) && !(val
> LONG_MAX
)) {
13115 *indexPtr
= (val
< 0) ? -INT_MAX
: (long)val
;;
13119 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
13121 *indexPtr
= objPtr
->internalRep
.indexValue
;
13125 /* -----------------------------------------------------------------------------
13126 * Return Code Object.
13127 * ---------------------------------------------------------------------------*/
13129 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
13130 static const char * const jimReturnCodes
[] = {
13132 [JIM_ERR
] = "error",
13133 [JIM_RETURN
] = "return",
13134 [JIM_BREAK
] = "break",
13135 [JIM_CONTINUE
] = "continue",
13136 [JIM_SIGNAL
] = "signal",
13137 [JIM_EXIT
] = "exit",
13138 [JIM_EVAL
] = "eval",
13142 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
13144 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
13146 static const Jim_ObjType returnCodeObjType
= {
13154 /* Converts a (standard) return code to a string. Returns "?" for
13155 * non-standard return codes.
13157 const char *Jim_ReturnCode(int code
)
13159 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
13163 return jimReturnCodes
[code
];
13167 int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
13170 jim_wide wideValue
;
13172 /* Try to convert into an integer */
13173 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
13174 returnCode
= (int)wideValue
;
13175 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
13176 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
13179 /* Free the old internal repr and set the new one. */
13180 Jim_FreeIntRep(interp
, objPtr
);
13181 objPtr
->typePtr
= &returnCodeObjType
;
13182 objPtr
->internalRep
.returnCode
= returnCode
;
13186 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
13188 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
13190 *intPtr
= objPtr
->internalRep
.returnCode
;
13194 /* -----------------------------------------------------------------------------
13195 * Expression Parsing
13196 * ---------------------------------------------------------------------------*/
13197 static int JimParseExprOperator(struct JimParserCtx
*pc
);
13198 static int JimParseExprNumber(struct JimParserCtx
*pc
);
13199 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
13201 /* Exrp's Stack machine operators opcodes. */
13203 /* Binary operators (numbers) */
13206 /* Continues on from the JIM_TT_ space */
13208 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 15 */
13223 JIM_EXPROP_BITAND
, /* 30 */
13227 /* Note must keep these together */
13228 JIM_EXPROP_LOGICAND
, /* 33 */
13229 JIM_EXPROP_LOGICAND_LEFT
,
13230 JIM_EXPROP_LOGICAND_RIGHT
,
13233 JIM_EXPROP_LOGICOR
, /* 36 */
13234 JIM_EXPROP_LOGICOR_LEFT
,
13235 JIM_EXPROP_LOGICOR_RIGHT
,
13238 /* Ternary operators */
13239 JIM_EXPROP_TERNARY
, /* 39 */
13240 JIM_EXPROP_TERNARY_LEFT
,
13241 JIM_EXPROP_TERNARY_RIGHT
,
13244 JIM_EXPROP_COLON
, /* 42 */
13245 JIM_EXPROP_COLON_LEFT
,
13246 JIM_EXPROP_COLON_RIGHT
,
13248 JIM_EXPROP_POW
, /* 45 */
13250 /* Binary operators (strings) */
13256 /* Unary operators (numbers) */
13259 JIM_EXPROP_UNARYMINUS
,
13260 JIM_EXPROP_UNARYPLUS
,
13263 JIM_EXPROP_FUNC_FIRST
,
13264 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
13265 JIM_EXPROP_FUNC_ABS
,
13266 JIM_EXPROP_FUNC_DOUBLE
,
13267 JIM_EXPROP_FUNC_ROUND
,
13268 JIM_EXPROP_FUNC_RAND
,
13269 JIM_EXPROP_FUNC_SRAND
,
13271 #ifdef JIM_MATH_FUNCTIONS
13272 /* math functions from libm */
13273 JIM_EXPROP_FUNC_SIN
,
13274 JIM_EXPROP_FUNC_COS
,
13275 JIM_EXPROP_FUNC_TAN
,
13276 JIM_EXPROP_FUNC_ASIN
,
13277 JIM_EXPROP_FUNC_ACOS
,
13278 JIM_EXPROP_FUNC_ATAN
,
13279 JIM_EXPROP_FUNC_SINH
,
13280 JIM_EXPROP_FUNC_COSH
,
13281 JIM_EXPROP_FUNC_TANH
,
13282 JIM_EXPROP_FUNC_CEIL
,
13283 JIM_EXPROP_FUNC_FLOOR
,
13284 JIM_EXPROP_FUNC_EXP
,
13285 JIM_EXPROP_FUNC_LOG
,
13286 JIM_EXPROP_FUNC_LOG10
,
13287 JIM_EXPROP_FUNC_SQRT
,
13291 struct JimExprState
13299 /* Operators table */
13300 typedef struct Jim_ExprOperator
13305 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
13307 } Jim_ExprOperator
;
13309 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
13311 Jim_IncrRefCount(obj
);
13312 e
->stack
[e
->stacklen
++] = obj
;
13315 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
13317 return e
->stack
[--e
->stacklen
];
13320 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13324 Jim_Obj
*A
= ExprPop(e
);
13326 jim_wide wA
, wC
= 0;
13328 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
13331 switch (e
->opcode
) {
13332 case JIM_EXPROP_FUNC_INT
:
13335 case JIM_EXPROP_FUNC_ROUND
:
13338 case JIM_EXPROP_FUNC_DOUBLE
:
13342 case JIM_EXPROP_FUNC_ABS
:
13343 wC
= wA
>= 0 ? wA
: -wA
;
13345 case JIM_EXPROP_UNARYMINUS
:
13348 case JIM_EXPROP_UNARYPLUS
:
13351 case JIM_EXPROP_NOT
:
13358 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
13359 switch (e
->opcode
) {
13360 case JIM_EXPROP_FUNC_INT
:
13364 case JIM_EXPROP_FUNC_ROUND
:
13365 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
13368 case JIM_EXPROP_FUNC_DOUBLE
:
13371 case JIM_EXPROP_FUNC_ABS
:
13372 dC
= dA
>= 0 ? dA
: -dA
;
13374 case JIM_EXPROP_UNARYMINUS
:
13377 case JIM_EXPROP_UNARYPLUS
:
13380 case JIM_EXPROP_NOT
:
13389 if (rc
== JIM_OK
) {
13391 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13394 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13398 Jim_DecrRefCount(interp
, A
);
13403 static double JimRandDouble(Jim_Interp
*interp
)
13406 JimRandomBytes(interp
, &x
, sizeof(x
));
13408 return (double)x
/ (unsigned long)~0;
13411 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13413 Jim_Obj
*A
= ExprPop(e
);
13416 int rc
= Jim_GetWide(interp
, A
, &wA
);
13417 if (rc
== JIM_OK
) {
13418 switch (e
->opcode
) {
13419 case JIM_EXPROP_BITNOT
:
13420 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
13422 case JIM_EXPROP_FUNC_SRAND
:
13423 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
13424 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
13431 Jim_DecrRefCount(interp
, A
);
13436 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
13438 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
));
13440 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
13445 #ifdef JIM_MATH_FUNCTIONS
13446 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13449 Jim_Obj
*A
= ExprPop(e
);
13452 rc
= Jim_GetDouble(interp
, A
, &dA
);
13453 if (rc
== JIM_OK
) {
13454 switch (e
->opcode
) {
13455 case JIM_EXPROP_FUNC_SIN
:
13458 case JIM_EXPROP_FUNC_COS
:
13461 case JIM_EXPROP_FUNC_TAN
:
13464 case JIM_EXPROP_FUNC_ASIN
:
13467 case JIM_EXPROP_FUNC_ACOS
:
13470 case JIM_EXPROP_FUNC_ATAN
:
13473 case JIM_EXPROP_FUNC_SINH
:
13476 case JIM_EXPROP_FUNC_COSH
:
13479 case JIM_EXPROP_FUNC_TANH
:
13482 case JIM_EXPROP_FUNC_CEIL
:
13485 case JIM_EXPROP_FUNC_FLOOR
:
13488 case JIM_EXPROP_FUNC_EXP
:
13491 case JIM_EXPROP_FUNC_LOG
:
13494 case JIM_EXPROP_FUNC_LOG10
:
13497 case JIM_EXPROP_FUNC_SQRT
:
13503 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13506 Jim_DecrRefCount(interp
, A
);
13512 /* A binary operation on two ints */
13513 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13515 Jim_Obj
*B
= ExprPop(e
);
13516 Jim_Obj
*A
= ExprPop(e
);
13520 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
13525 switch (e
->opcode
) {
13526 case JIM_EXPROP_LSHIFT
:
13529 case JIM_EXPROP_RSHIFT
:
13532 case JIM_EXPROP_BITAND
:
13535 case JIM_EXPROP_BITXOR
:
13538 case JIM_EXPROP_BITOR
:
13541 case JIM_EXPROP_MOD
:
13544 Jim_SetResultString(interp
, "Division by zero", -1);
13551 * This code is tricky: C doesn't guarantee much
13552 * about the quotient or remainder, but Tcl does.
13553 * The remainder always has the same sign as the
13554 * divisor and a smaller absolute value.
13572 case JIM_EXPROP_ROTL
:
13573 case JIM_EXPROP_ROTR
:{
13574 /* uint32_t would be better. But not everyone has inttypes.h? */
13575 unsigned long uA
= (unsigned long)wA
;
13576 unsigned long uB
= (unsigned long)wB
;
13577 const unsigned int S
= sizeof(unsigned long) * 8;
13579 /* Shift left by the word size or more is undefined. */
13582 if (e
->opcode
== JIM_EXPROP_ROTR
) {
13585 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
13591 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13595 Jim_DecrRefCount(interp
, A
);
13596 Jim_DecrRefCount(interp
, B
);
13602 /* A binary operation on two ints or two doubles (or two strings for some ops) */
13603 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13607 double dA
, dB
, dC
= 0;
13608 jim_wide wA
, wB
, wC
= 0;
13610 Jim_Obj
*B
= ExprPop(e
);
13611 Jim_Obj
*A
= ExprPop(e
);
13613 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
13614 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
13615 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
13617 /* Both are ints */
13621 switch (e
->opcode
) {
13622 case JIM_EXPROP_POW
:
13623 wC
= JimPowWide(wA
, wB
);
13625 case JIM_EXPROP_ADD
:
13628 case JIM_EXPROP_SUB
:
13631 case JIM_EXPROP_MUL
:
13634 case JIM_EXPROP_DIV
:
13636 Jim_SetResultString(interp
, "Division by zero", -1);
13643 * This code is tricky: C doesn't guarantee much
13644 * about the quotient or remainder, but Tcl does.
13645 * The remainder always has the same sign as the
13646 * divisor and a smaller absolute value.
13658 case JIM_EXPROP_LT
:
13661 case JIM_EXPROP_GT
:
13664 case JIM_EXPROP_LTE
:
13667 case JIM_EXPROP_GTE
:
13670 case JIM_EXPROP_NUMEQ
:
13673 case JIM_EXPROP_NUMNE
:
13680 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
13681 switch (e
->opcode
) {
13682 case JIM_EXPROP_POW
:
13683 #ifdef JIM_MATH_FUNCTIONS
13686 Jim_SetResultString(interp
, "unsupported", -1);
13690 case JIM_EXPROP_ADD
:
13693 case JIM_EXPROP_SUB
:
13696 case JIM_EXPROP_MUL
:
13699 case JIM_EXPROP_DIV
:
13702 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
13704 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
13711 case JIM_EXPROP_LT
:
13715 case JIM_EXPROP_GT
:
13719 case JIM_EXPROP_LTE
:
13723 case JIM_EXPROP_GTE
:
13727 case JIM_EXPROP_NUMEQ
:
13731 case JIM_EXPROP_NUMNE
:
13740 /* Handle the string case */
13742 /* REVISIT: Could optimise the eq/ne case by checking lengths */
13743 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
13747 switch (e
->opcode
) {
13748 case JIM_EXPROP_LT
:
13751 case JIM_EXPROP_GT
:
13754 case JIM_EXPROP_LTE
:
13757 case JIM_EXPROP_GTE
:
13760 case JIM_EXPROP_NUMEQ
:
13763 case JIM_EXPROP_NUMNE
:
13772 if (rc
== JIM_OK
) {
13774 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13777 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13781 Jim_DecrRefCount(interp
, A
);
13782 Jim_DecrRefCount(interp
, B
);
13787 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
13792 listlen
= Jim_ListLength(interp
, listObjPtr
);
13793 for (i
= 0; i
< listlen
; i
++) {
13796 Jim_ListIndex(interp
, listObjPtr
, i
, &objPtr
, JIM_NONE
);
13798 if (Jim_StringEqObj(objPtr
, valObj
)) {
13805 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13807 Jim_Obj
*B
= ExprPop(e
);
13808 Jim_Obj
*A
= ExprPop(e
);
13812 switch (e
->opcode
) {
13813 case JIM_EXPROP_STREQ
:
13814 case JIM_EXPROP_STRNE
: {
13816 const char *sA
= Jim_GetString(A
, &Alen
);
13817 const char *sB
= Jim_GetString(B
, &Blen
);
13819 if (e
->opcode
== JIM_EXPROP_STREQ
) {
13820 wC
= (Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0);
13823 wC
= (Alen
!= Blen
|| memcmp(sA
, sB
, Alen
) != 0);
13827 case JIM_EXPROP_STRIN
:
13828 wC
= JimSearchList(interp
, B
, A
);
13830 case JIM_EXPROP_STRNI
:
13831 wC
= !JimSearchList(interp
, B
, A
);
13836 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13838 Jim_DecrRefCount(interp
, A
);
13839 Jim_DecrRefCount(interp
, B
);
13844 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
13849 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
13852 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
13858 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
13860 Jim_Obj
*skip
= ExprPop(e
);
13861 Jim_Obj
*A
= ExprPop(e
);
13864 switch (ExprBool(interp
, A
)) {
13866 /* false, so skip RHS opcodes with a 0 result */
13867 e
->skip
= JimWideValue(skip
);
13868 ExprPush(e
, Jim_NewIntObj(interp
, 0));
13872 /* true so continue */
13879 Jim_DecrRefCount(interp
, A
);
13880 Jim_DecrRefCount(interp
, skip
);
13885 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
13887 Jim_Obj
*skip
= ExprPop(e
);
13888 Jim_Obj
*A
= ExprPop(e
);
13891 switch (ExprBool(interp
, A
)) {
13893 /* false, so do nothing */
13897 /* true so skip RHS opcodes with a 1 result */
13898 e
->skip
= JimWideValue(skip
);
13899 ExprPush(e
, Jim_NewIntObj(interp
, 1));
13907 Jim_DecrRefCount(interp
, A
);
13908 Jim_DecrRefCount(interp
, skip
);
13913 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
13915 Jim_Obj
*A
= ExprPop(e
);
13918 switch (ExprBool(interp
, A
)) {
13920 ExprPush(e
, Jim_NewIntObj(interp
, 0));
13924 ExprPush(e
, Jim_NewIntObj(interp
, 1));
13932 Jim_DecrRefCount(interp
, A
);
13937 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
13939 Jim_Obj
*skip
= ExprPop(e
);
13940 Jim_Obj
*A
= ExprPop(e
);
13946 switch (ExprBool(interp
, A
)) {
13948 /* false, skip RHS opcodes */
13949 e
->skip
= JimWideValue(skip
);
13950 /* Push a dummy value */
13951 ExprPush(e
, Jim_NewIntObj(interp
, 0));
13955 /* true so do nothing */
13963 Jim_DecrRefCount(interp
, A
);
13964 Jim_DecrRefCount(interp
, skip
);
13969 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
13971 Jim_Obj
*skip
= ExprPop(e
);
13972 Jim_Obj
*B
= ExprPop(e
);
13973 Jim_Obj
*A
= ExprPop(e
);
13975 /* No need to check for A as non-boolean */
13976 if (ExprBool(interp
, A
)) {
13977 /* true, so skip RHS opcodes */
13978 e
->skip
= JimWideValue(skip
);
13979 /* Repush B as the answer */
13983 Jim_DecrRefCount(interp
, skip
);
13984 Jim_DecrRefCount(interp
, A
);
13985 Jim_DecrRefCount(interp
, B
);
13989 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
14002 /* name - precedence - arity - opcode */
14003 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
14004 [JIM_EXPROP_FUNC_INT
] = {"int", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14005 [JIM_EXPROP_FUNC_DOUBLE
] = {"double", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14006 [JIM_EXPROP_FUNC_ABS
] = {"abs", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14007 [JIM_EXPROP_FUNC_ROUND
] = {"round", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14008 [JIM_EXPROP_FUNC_RAND
] = {"rand", 400, 0, JimExprOpNone
, LAZY_NONE
},
14009 [JIM_EXPROP_FUNC_SRAND
] = {"srand", 400, 1, JimExprOpIntUnary
, LAZY_NONE
},
14011 #ifdef JIM_MATH_FUNCTIONS
14012 [JIM_EXPROP_FUNC_SIN
] = {"sin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14013 [JIM_EXPROP_FUNC_COS
] = {"cos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14014 [JIM_EXPROP_FUNC_TAN
] = {"tan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14015 [JIM_EXPROP_FUNC_ASIN
] = {"asin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14016 [JIM_EXPROP_FUNC_ACOS
] = {"acos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14017 [JIM_EXPROP_FUNC_ATAN
] = {"atan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14018 [JIM_EXPROP_FUNC_SINH
] = {"sinh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14019 [JIM_EXPROP_FUNC_COSH
] = {"cosh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14020 [JIM_EXPROP_FUNC_TANH
] = {"tanh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14021 [JIM_EXPROP_FUNC_CEIL
] = {"ceil", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14022 [JIM_EXPROP_FUNC_FLOOR
] = {"floor", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14023 [JIM_EXPROP_FUNC_EXP
] = {"exp", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14024 [JIM_EXPROP_FUNC_LOG
] = {"log", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14025 [JIM_EXPROP_FUNC_LOG10
] = {"log10", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14026 [JIM_EXPROP_FUNC_SQRT
] = {"sqrt", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14029 [JIM_EXPROP_NOT
] = {"!", 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14030 [JIM_EXPROP_BITNOT
] = {"~", 300, 1, JimExprOpIntUnary
, LAZY_NONE
},
14031 [JIM_EXPROP_UNARYMINUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14032 [JIM_EXPROP_UNARYPLUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14034 [JIM_EXPROP_POW
] = {"**", 250, 2, JimExprOpBin
, LAZY_NONE
},
14036 [JIM_EXPROP_MUL
] = {"*", 200, 2, JimExprOpBin
, LAZY_NONE
},
14037 [JIM_EXPROP_DIV
] = {"/", 200, 2, JimExprOpBin
, LAZY_NONE
},
14038 [JIM_EXPROP_MOD
] = {"%", 200, 2, JimExprOpIntBin
, LAZY_NONE
},
14040 [JIM_EXPROP_SUB
] = {"-", 100, 2, JimExprOpBin
, LAZY_NONE
},
14041 [JIM_EXPROP_ADD
] = {"+", 100, 2, JimExprOpBin
, LAZY_NONE
},
14043 [JIM_EXPROP_ROTL
] = {"<<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14044 [JIM_EXPROP_ROTR
] = {">>>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14045 [JIM_EXPROP_LSHIFT
] = {"<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14046 [JIM_EXPROP_RSHIFT
] = {">>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14048 [JIM_EXPROP_LT
] = {"<", 80, 2, JimExprOpBin
, LAZY_NONE
},
14049 [JIM_EXPROP_GT
] = {">", 80, 2, JimExprOpBin
, LAZY_NONE
},
14050 [JIM_EXPROP_LTE
] = {"<=", 80, 2, JimExprOpBin
, LAZY_NONE
},
14051 [JIM_EXPROP_GTE
] = {">=", 80, 2, JimExprOpBin
, LAZY_NONE
},
14053 [JIM_EXPROP_NUMEQ
] = {"==", 70, 2, JimExprOpBin
, LAZY_NONE
},
14054 [JIM_EXPROP_NUMNE
] = {"!=", 70, 2, JimExprOpBin
, LAZY_NONE
},
14056 [JIM_EXPROP_STREQ
] = {"eq", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
14057 [JIM_EXPROP_STRNE
] = {"ne", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
14059 [JIM_EXPROP_STRIN
] = {"in", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
14060 [JIM_EXPROP_STRNI
] = {"ni", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
14062 [JIM_EXPROP_BITAND
] = {"&", 50, 2, JimExprOpIntBin
, LAZY_NONE
},
14063 [JIM_EXPROP_BITXOR
] = {"^", 49, 2, JimExprOpIntBin
, LAZY_NONE
},
14064 [JIM_EXPROP_BITOR
] = {"|", 48, 2, JimExprOpIntBin
, LAZY_NONE
},
14066 [JIM_EXPROP_LOGICAND
] = {"&&", 10, 2, NULL
, LAZY_OP
},
14067 [JIM_EXPROP_LOGICOR
] = {"||", 9, 2, NULL
, LAZY_OP
},
14069 [JIM_EXPROP_TERNARY
] = {"?", 5, 2, JimExprOpNull
, LAZY_OP
},
14070 [JIM_EXPROP_COLON
] = {":", 5, 2, JimExprOpNull
, LAZY_OP
},
14072 /* private operators */
14073 [JIM_EXPROP_TERNARY_LEFT
] = {NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
},
14074 [JIM_EXPROP_TERNARY_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
14075 [JIM_EXPROP_COLON_LEFT
] = {NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
},
14076 [JIM_EXPROP_COLON_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
14077 [JIM_EXPROP_LOGICAND_LEFT
] = {NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
},
14078 [JIM_EXPROP_LOGICAND_RIGHT
] = {NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
14079 [JIM_EXPROP_LOGICOR_LEFT
] = {NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
},
14080 [JIM_EXPROP_LOGICOR_RIGHT
] = {NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
14083 #define JIM_EXPR_OPERATORS_NUM \
14084 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
14086 static int JimParseExpression(struct JimParserCtx
*pc
)
14088 /* Discard spaces and quoted newline */
14089 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
14094 if (pc
->len
== 0) {
14095 pc
->tstart
= pc
->tend
= pc
->p
;
14096 pc
->tline
= pc
->linenr
;
14097 pc
->tt
= JIM_TT_EOL
;
14101 switch (*(pc
->p
)) {
14103 pc
->tstart
= pc
->tend
= pc
->p
;
14104 pc
->tline
= pc
->linenr
;
14105 pc
->tt
= JIM_TT_SUBEXPR_START
;
14110 pc
->tstart
= pc
->tend
= pc
->p
;
14111 pc
->tline
= pc
->linenr
;
14112 pc
->tt
= JIM_TT_SUBEXPR_END
;
14117 return JimParseCmd(pc
);
14119 if (JimParseVar(pc
) == JIM_ERR
)
14120 return JimParseExprOperator(pc
);
14122 /* Don't allow expr sugar in expressions */
14123 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
14140 return JimParseExprNumber(pc
);
14142 return JimParseQuote(pc
);
14144 return JimParseBrace(pc
);
14150 if (JimParseExprIrrational(pc
) == JIM_ERR
)
14151 return JimParseExprOperator(pc
);
14154 return JimParseExprOperator(pc
);
14160 static int JimParseExprNumber(struct JimParserCtx
*pc
)
14165 /* Assume an integer for now */
14166 pc
->tt
= JIM_TT_EXPR_INT
;
14167 pc
->tstart
= pc
->p
;
14168 pc
->tline
= pc
->linenr
;
14169 while (isdigit(UCHAR(*pc
->p
))
14170 || (allowhex
&& isxdigit(UCHAR(*pc
->p
)))
14171 || (allowdot
&& *pc
->p
== '.')
14172 || (pc
->p
- pc
->tstart
== 1 && *pc
->tstart
== '0' && (*pc
->p
== 'x' || *pc
->p
== 'X'))
14174 if ((*pc
->p
== 'x') || (*pc
->p
== 'X')) {
14178 if (*pc
->p
== '.') {
14180 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14184 if (!allowhex
&& (*pc
->p
== 'e' || *pc
->p
== 'E') && (pc
->p
[1] == '-' || pc
->p
[1] == '+'
14185 || isdigit(UCHAR(pc
->p
[1])))) {
14188 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14191 pc
->tend
= pc
->p
- 1;
14195 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
14197 const char *Tokens
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
14198 const char **token
;
14200 for (token
= Tokens
; *token
!= NULL
; token
++) {
14201 int len
= strlen(*token
);
14203 if (strncmp(*token
, pc
->p
, len
) == 0) {
14204 pc
->tstart
= pc
->p
;
14205 pc
->tend
= pc
->p
+ len
- 1;
14208 pc
->tline
= pc
->linenr
;
14209 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14216 static int JimParseExprOperator(struct JimParserCtx
*pc
)
14219 int bestIdx
= -1, bestLen
= 0;
14221 /* Try to get the longest match. */
14222 for (i
= JIM_TT_EXPR_OP
; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
14223 const char *opname
;
14226 opname
= Jim_ExprOperators
[i
].name
;
14227 if (opname
== NULL
) {
14230 oplen
= strlen(opname
);
14232 if (strncmp(opname
, pc
->p
, oplen
) == 0 && oplen
> bestLen
) {
14237 if (bestIdx
== -1) {
14241 /* Validate paretheses around function arguments */
14242 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
14243 const char *p
= pc
->p
+ bestLen
;
14244 int len
= pc
->len
- bestLen
;
14246 while (len
&& isspace(UCHAR(*p
))) {
14254 pc
->tstart
= pc
->p
;
14255 pc
->tend
= pc
->p
+ bestLen
- 1;
14257 pc
->len
-= bestLen
;
14258 pc
->tline
= pc
->linenr
;
14264 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
14266 return &Jim_ExprOperators
[opcode
];
14269 const char *jim_tt_name(int type
)
14271 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
14272 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", "INT",
14274 if (type
< JIM_TT_EXPR_OP
) {
14275 return tt_names
[type
];
14278 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
14279 static char buf
[20];
14281 if (op
&& op
->name
) {
14284 sprintf(buf
, "(%d)", type
);
14289 /* -----------------------------------------------------------------------------
14290 * Expression Object
14291 * ---------------------------------------------------------------------------*/
14292 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
14293 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
14294 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
14296 static const Jim_ObjType exprObjType
= {
14298 FreeExprInternalRep
,
14299 DupExprInternalRep
,
14301 JIM_TYPE_REFERENCES
,
14304 /* Expr bytecode structure */
14305 typedef struct ExprByteCode
14307 int len
; /* Length as number of tokens. */
14308 ScriptToken
*token
; /* Tokens array. */
14309 int inUse
; /* Used for sharing. */
14312 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
14316 for (i
= 0; i
< expr
->len
; i
++) {
14317 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
14319 Jim_Free(expr
->token
);
14323 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14325 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
14328 if (--expr
->inUse
!= 0) {
14332 ExprFreeByteCode(interp
, expr
);
14336 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
14338 JIM_NOTUSED(interp
);
14339 JIM_NOTUSED(srcPtr
);
14341 /* Just returns an simple string. */
14342 dupPtr
->typePtr
= NULL
;
14345 /* Check if an expr program looks correct. */
14346 static int ExprCheckCorrectness(ExprByteCode
* expr
)
14352 /* Try to check if there are stack underflows,
14353 * and make sure at the end of the program there is
14354 * a single result on the stack. */
14355 for (i
= 0; i
< expr
->len
; i
++) {
14356 ScriptToken
*t
= &expr
->token
[i
];
14357 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
14360 stacklen
-= op
->arity
;
14361 if (stacklen
< 0) {
14364 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
14367 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
14372 /* All operations and operands add one to the stack */
14375 if (stacklen
!= 1 || ternary
!= 0) {
14381 /* This procedure converts every occurrence of || and && opereators
14382 * in lazy unary versions.
14384 * a b || is converted into:
14386 * a <offset> |L b |R
14388 * a b && is converted into:
14390 * a <offset> &L b &R
14392 * "|L" checks if 'a' is true:
14393 * 1) if it is true pushes 1 and skips <offset> instructions to reach
14394 * the opcode just after |R.
14395 * 2) if it is false does nothing.
14396 * "|R" checks if 'b' is true:
14397 * 1) if it is true pushes 1, otherwise pushes 0.
14399 * "&L" checks if 'a' is true:
14400 * 1) if it is true does nothing.
14401 * 2) If it is false pushes 0 and skips <offset> instructions to reach
14402 * the opcode just after &R
14403 * "&R" checks if 'a' is true:
14404 * if it is true pushes 1, otherwise pushes 0.
14406 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
14410 int leftindex
, arity
, offset
;
14412 /* Search for the end of the first operator */
14413 leftindex
= expr
->len
- 1;
14417 ScriptToken
*tt
= &expr
->token
[leftindex
];
14419 if (tt
->type
>= JIM_TT_EXPR_OP
) {
14420 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
14423 if (--leftindex
< 0) {
14430 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
14431 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
14433 offset
= (expr
->len
- leftindex
) - 1;
14435 /* Now we rely on the fact the the left and right version have opcodes
14436 * 1 and 2 after the main opcode respectively
14438 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
14439 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
14441 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
14442 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
14444 /* Now add the 'R' operator */
14445 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
14446 expr
->token
[expr
->len
].type
= t
->type
+ 2;
14449 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
14450 for (i
= leftindex
- 1; i
> 0; i
--) {
14451 if (JimExprOperatorInfoByOpcode(expr
->token
[i
].type
)->lazy
== LAZY_LEFT
) {
14452 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
14453 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
14460 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
14462 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
14464 if (JimExprOperatorInfoByOpcode(t
->type
)->lazy
== LAZY_OP
) {
14465 return ExprAddLazyOperator(interp
, expr
, t
);
14468 token
->objPtr
= interp
->emptyObj
;
14469 token
->type
= t
->type
;
14476 * Returns the index of the COLON_LEFT to the left of 'right_index'
14477 * taking into account nesting.
14479 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
14481 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
14483 int ternary_count
= 1;
14487 while (right_index
> 1) {
14488 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
14491 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
14494 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
14495 return right_index
;
14505 * Find the left/right indices for the ternary expression to the left of 'right_index'.
14507 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
14508 * Otherwise returns 0.
14510 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
14512 int i
= right_index
- 1;
14513 int ternary_count
= 1;
14516 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
14517 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
14518 *prev_right_index
= i
- 2;
14519 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
14523 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
14524 if (ternary_count
== 0) {
14535 * ExprTernaryReorderExpression description
14536 * ========================================
14538 * ?: is right-to-left associative which doesn't work with the stack-based
14539 * expression engine. The fix is to reorder the bytecode.
14545 * Has initial bytecode:
14547 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
14548 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
14550 * The fix involves simulating this expression instead:
14554 * With the following bytecode:
14556 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
14557 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
14559 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
14560 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
14561 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
14562 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
14564 * ExprTernaryReorderExpression works thus as follows :
14565 * - start from the end of the stack
14566 * - while walking towards the beginning of the stack
14567 * if token=JIM_EXPROP_COLON_RIGHT then
14568 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
14569 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
14570 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
14571 * if all found then
14572 * perform the rotation
14573 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
14577 * Note: care has to be taken for nested ternary constructs!!!
14579 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
14583 for (i
= expr
->len
- 1; i
> 1; i
--) {
14584 int prev_right_index
;
14585 int prev_left_index
;
14589 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
14593 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
14594 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
14599 ** rotate tokens down
14601 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
14610 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
14612 tmp
= expr
->token
[prev_right_index
];
14613 for (j
= prev_right_index
; j
< i
; j
++) {
14614 expr
->token
[j
] = expr
->token
[j
+ 1];
14616 expr
->token
[i
] = tmp
;
14618 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
14620 * This is 'colon left increment' = i - prev_right_index
14622 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
14623 * [prev_left_index-1] : skip_count
14626 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
14628 /* Adjust for i-- in the loop */
14633 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
)
14636 ExprByteCode
*expr
;
14639 int prevtt
= JIM_TT_NONE
;
14640 int have_ternary
= 0;
14643 int count
= tokenlist
->count
- 1;
14645 expr
= Jim_Alloc(sizeof(*expr
));
14649 Jim_InitStack(&stack
);
14651 /* Need extra bytecodes for lazy operators.
14652 * Also check for the ternary operator
14654 for (i
= 0; i
< tokenlist
->count
; i
++) {
14655 ParseToken
*t
= &tokenlist
->list
[i
];
14657 if (JimExprOperatorInfoByOpcode(t
->type
)->lazy
== LAZY_OP
) {
14659 /* Ternary is a lazy op but also needs reordering */
14660 if (t
->type
== JIM_EXPROP_TERNARY
) {
14666 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
14668 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
14669 ParseToken
*t
= &tokenlist
->list
[i
];
14671 /* Next token will be stored here */
14672 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
14674 if (t
->type
== JIM_TT_EOL
) {
14682 case JIM_TT_DICTSUGAR
:
14683 case JIM_TT_EXPRSUGAR
:
14685 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
14686 token
->type
= t
->type
;
14690 case JIM_TT_EXPR_INT
:
14691 token
->objPtr
= Jim_NewIntObj(interp
, strtoull(t
->token
, NULL
, 0));
14692 token
->type
= t
->type
;
14696 case JIM_TT_EXPR_DOUBLE
:
14697 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, NULL
));
14698 token
->type
= t
->type
;
14702 case JIM_TT_SUBEXPR_START
:
14703 Jim_StackPush(&stack
, t
);
14704 prevtt
= JIM_TT_NONE
;
14707 case JIM_TT_SUBEXPR_END
:
14709 while (Jim_StackLen(&stack
)) {
14710 ParseToken
*tt
= Jim_StackPop(&stack
);
14712 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
14717 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14722 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
14729 /* Must be an operator */
14730 const struct Jim_ExprOperator
*op
;
14733 /* Convert -/+ to unary minus or unary plus if necessary */
14734 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
14735 if (t
->type
== JIM_EXPROP_SUB
) {
14736 t
->type
= JIM_EXPROP_UNARYMINUS
;
14738 else if (t
->type
== JIM_EXPROP_ADD
) {
14739 t
->type
= JIM_EXPROP_UNARYPLUS
;
14743 op
= JimExprOperatorInfoByOpcode(t
->type
);
14745 /* Now handle precedence */
14746 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
14747 const struct Jim_ExprOperator
*tt_op
=
14748 JimExprOperatorInfoByOpcode(tt
->type
);
14750 /* Note that right-to-left associativity of ?: operator is handled later */
14752 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
14753 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14757 Jim_StackPop(&stack
);
14763 Jim_StackPush(&stack
, t
);
14770 /* Reduce any remaining subexpr */
14771 while (Jim_StackLen(&stack
)) {
14772 ParseToken
*tt
= Jim_StackPop(&stack
);
14774 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
14776 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
14779 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14785 if (have_ternary
) {
14786 ExprTernaryReorderExpression(interp
, expr
);
14790 /* Free the stack used for the compilation. */
14791 Jim_FreeStack(&stack
);
14793 for (i
= 0; i
< expr
->len
; i
++) {
14794 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
14798 ExprFreeByteCode(interp
, expr
);
14806 /* This method takes the string representation of an expression
14807 * and generates a program for the Expr's stack-based VM. */
14808 int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
14811 const char *exprText
;
14812 struct JimParserCtx parser
;
14813 struct ExprByteCode
*expr
;
14814 ParseTokenList tokenlist
;
14818 /* Try to get information about filename / line number */
14819 if (objPtr
->typePtr
== &sourceObjType
) {
14820 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
14823 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
14825 /* Initially tokenise the expression into tokenlist */
14826 ScriptTokenListInit(&tokenlist
);
14828 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
14829 while (!parser
.eof
) {
14830 if (JimParseExpression(&parser
) != JIM_OK
) {
14831 ScriptTokenListFree(&tokenlist
);
14833 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
14838 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
14842 #ifdef DEBUG_SHOW_EXPR_TOKENS
14845 printf("==== Expr Tokens ====\n");
14846 for (i
= 0; i
< tokenlist
.count
; i
++) {
14847 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
14848 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
14853 /* Now create the expression bytecode from the tokenlist */
14854 expr
= ExprCreateByteCode(interp
, &tokenlist
);
14856 /* No longer need the token list */
14857 ScriptTokenListFree(&tokenlist
);
14863 #ifdef DEBUG_SHOW_EXPR
14867 printf("==== Expr ====\n");
14868 for (i
= 0; i
< expr
->len
; i
++) {
14869 ScriptToken
*t
= &expr
->token
[i
];
14871 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
14876 /* Check program correctness. */
14877 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
14878 ExprFreeByteCode(interp
, expr
);
14885 /* Free the old internal rep and set the new one. */
14886 Jim_FreeIntRep(interp
, objPtr
);
14887 Jim_SetIntRepPtr(objPtr
, expr
);
14888 objPtr
->typePtr
= &exprObjType
;
14892 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14894 if (objPtr
->typePtr
!= &exprObjType
) {
14895 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
14899 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
14902 /* -----------------------------------------------------------------------------
14903 * Expressions evaluation.
14904 * Jim uses a specialized stack-based virtual machine for expressions,
14905 * that takes advantage of the fact that expr's operators
14906 * can't be redefined.
14908 * Jim_EvalExpression() uses the bytecode compiled by
14909 * SetExprFromAny() method of the "expression" object.
14911 * On success a Tcl Object containing the result of the evaluation
14912 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
14914 * On error the function returns a retcode != to JIM_OK and set a suitable
14915 * error on the interp.
14916 * ---------------------------------------------------------------------------*/
14917 #define JIM_EE_STATICSTACK_LEN 10
14919 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
14921 ExprByteCode
*expr
;
14922 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
14924 int retcode
= JIM_OK
;
14925 struct JimExprState e
;
14927 expr
= JimGetExpression(interp
, exprObjPtr
);
14929 return JIM_ERR
; /* error in expression. */
14932 #ifdef JIM_OPTIMIZATION
14933 /* Check for one of the following common expressions used by while/for
14938 * $a < CONST, $a < $b
14939 * $a <= CONST, $a <= $b
14940 * $a > CONST, $a > $b
14941 * $a >= CONST, $a >= $b
14942 * $a != CONST, $a != $b
14943 * $a == CONST, $a == $b
14948 /* STEP 1 -- Check if there are the conditions to run the specialized
14949 * version of while */
14951 switch (expr
->len
) {
14953 if (expr
->token
[0].type
== JIM_TT_EXPR_INT
) {
14954 *exprResultPtrPtr
= expr
->token
[0].objPtr
;
14955 Jim_IncrRefCount(*exprResultPtrPtr
);
14958 if (expr
->token
[0].type
== JIM_TT_VAR
) {
14959 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_ERRMSG
);
14961 *exprResultPtrPtr
= objPtr
;
14962 Jim_IncrRefCount(*exprResultPtrPtr
);
14969 if (expr
->token
[1].type
== JIM_EXPROP_NOT
&& expr
->token
[0].type
== JIM_TT_VAR
) {
14970 jim_wide wideValue
;
14972 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
14973 if (objPtr
&& JimIsWide(objPtr
)
14974 && Jim_GetWide(interp
, objPtr
, &wideValue
) == JIM_OK
) {
14975 *exprResultPtrPtr
= wideValue
? interp
->falseObj
: interp
->trueObj
;
14976 Jim_IncrRefCount(*exprResultPtrPtr
);
14983 if (expr
->token
[0].type
== JIM_TT_VAR
&& (expr
->token
[1].type
== JIM_TT_EXPR_INT
14984 || expr
->token
[1].type
== JIM_TT_VAR
)) {
14985 switch (expr
->token
[2].type
) {
14986 case JIM_EXPROP_LT
:
14987 case JIM_EXPROP_LTE
:
14988 case JIM_EXPROP_GT
:
14989 case JIM_EXPROP_GTE
:
14990 case JIM_EXPROP_NUMEQ
:
14991 case JIM_EXPROP_NUMNE
:{
14993 jim_wide wideValueA
;
14994 jim_wide wideValueB
;
14996 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
14997 if (objPtr
&& JimIsWide(objPtr
)
14998 && Jim_GetWide(interp
, objPtr
, &wideValueA
) == JIM_OK
) {
14999 if (expr
->token
[1].type
== JIM_TT_VAR
) {
15001 Jim_GetVariable(interp
, expr
->token
[1].objPtr
,
15005 objPtr
= expr
->token
[1].objPtr
;
15007 if (objPtr
&& JimIsWide(objPtr
)
15008 && Jim_GetWide(interp
, objPtr
, &wideValueB
) == JIM_OK
) {
15011 switch (expr
->token
[2].type
) {
15012 case JIM_EXPROP_LT
:
15013 cmpRes
= wideValueA
< wideValueB
;
15015 case JIM_EXPROP_LTE
:
15016 cmpRes
= wideValueA
<= wideValueB
;
15018 case JIM_EXPROP_GT
:
15019 cmpRes
= wideValueA
> wideValueB
;
15021 case JIM_EXPROP_GTE
:
15022 cmpRes
= wideValueA
>= wideValueB
;
15024 case JIM_EXPROP_NUMEQ
:
15025 cmpRes
= wideValueA
== wideValueB
;
15027 case JIM_EXPROP_NUMNE
:
15028 cmpRes
= wideValueA
!= wideValueB
;
15030 default: /*notreached */
15033 *exprResultPtrPtr
=
15034 cmpRes
? interp
->trueObj
: interp
->falseObj
;
15035 Jim_IncrRefCount(*exprResultPtrPtr
);
15047 /* In order to avoid that the internal repr gets freed due to
15048 * shimmering of the exprObjPtr's object, we make the internal rep
15052 /* The stack-based expr VM itself */
15054 /* Stack allocation. Expr programs have the feature that
15055 * a program of length N can't require a stack longer than
15057 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
15058 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
15060 e
.stack
= staticStack
;
15064 /* Execute every instruction */
15065 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
15068 switch (expr
->token
[i
].type
) {
15069 case JIM_TT_EXPR_INT
:
15070 case JIM_TT_EXPR_DOUBLE
:
15072 ExprPush(&e
, expr
->token
[i
].objPtr
);
15076 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
15078 ExprPush(&e
, objPtr
);
15085 case JIM_TT_DICTSUGAR
:
15086 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
15088 ExprPush(&e
, objPtr
);
15096 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
15097 if (retcode
== JIM_OK
) {
15098 ExprPush(&e
, objPtr
);
15103 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
15104 if (retcode
== JIM_OK
) {
15105 ExprPush(&e
, Jim_GetResult(interp
));
15110 /* Find and execute the operation */
15112 e
.opcode
= expr
->token
[i
].type
;
15114 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
15115 /* Skip some opcodes if necessary */
15124 if (retcode
== JIM_OK
) {
15125 *exprResultPtrPtr
= ExprPop(&e
);
15128 for (i
= 0; i
< e
.stacklen
; i
++) {
15129 Jim_DecrRefCount(interp
, e
.stack
[i
]);
15132 if (e
.stack
!= staticStack
) {
15138 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
15141 jim_wide wideValue
;
15142 double doubleValue
;
15143 Jim_Obj
*exprResultPtr
;
15145 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
15146 if (retcode
!= JIM_OK
)
15149 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
15150 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
15151 Jim_DecrRefCount(interp
, exprResultPtr
);
15155 Jim_DecrRefCount(interp
, exprResultPtr
);
15156 *boolPtr
= doubleValue
!= 0;
15160 *boolPtr
= wideValue
!= 0;
15162 Jim_DecrRefCount(interp
, exprResultPtr
);
15166 /* -----------------------------------------------------------------------------
15167 * ScanFormat String Object
15168 * ---------------------------------------------------------------------------*/
15170 /* This Jim_Obj will held a parsed representation of a format string passed to
15171 * the Jim_ScanString command. For error diagnostics, the scanformat string has
15172 * to be parsed in its entirely first and then, if correct, can be used for
15173 * scanning. To avoid endless re-parsing, the parsed representation will be
15174 * stored in an internal representation and re-used for performance reason. */
15176 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
15177 * scanformat string. This part will later be used to extract information
15178 * out from the string to be parsed by Jim_ScanString */
15180 typedef struct ScanFmtPartDescr
15182 char type
; /* Type of conversion (e.g. c, d, f) */
15183 char modifier
; /* Modify type (e.g. l - long, h - short */
15184 size_t width
; /* Maximal width of input to be converted */
15185 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
15186 char *arg
; /* Specification of a CHARSET conversion */
15187 char *prefix
; /* Prefix to be scanned literally before conversion */
15188 } ScanFmtPartDescr
;
15190 /* The ScanFmtStringObj will hold the internal representation of a scanformat
15191 * string parsed and separated in part descriptions. Furthermore it contains
15192 * the original string representation of the scanformat string to allow for
15193 * fast update of the Jim_Obj's string representation part.
15195 * As an add-on the internal object representation adds some scratch pad area
15196 * for usage by Jim_ScanString to avoid endless allocating and freeing of
15197 * memory for purpose of string scanning.
15199 * The error member points to a static allocated string in case of a mal-
15200 * formed scanformat string or it contains '0' (NULL) in case of a valid
15201 * parse representation.
15203 * The whole memory of the internal representation is allocated as a single
15204 * area of memory that will be internally separated. So freeing and duplicating
15205 * of such an object is cheap */
15207 typedef struct ScanFmtStringObj
15209 jim_wide size
; /* Size of internal repr in bytes */
15210 char *stringRep
; /* Original string representation */
15211 size_t count
; /* Number of ScanFmtPartDescr contained */
15212 size_t convCount
; /* Number of conversions that will assign */
15213 size_t maxPos
; /* Max position index if XPG3 is used */
15214 const char *error
; /* Ptr to error text (NULL if no error */
15215 char *scratch
; /* Some scratch pad used by Jim_ScanString */
15216 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
15217 } ScanFmtStringObj
;
15220 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
15221 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
15222 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
15224 static const Jim_ObjType scanFmtStringObjType
= {
15225 "scanformatstring",
15226 FreeScanFmtInternalRep
,
15227 DupScanFmtInternalRep
,
15228 UpdateStringOfScanFmt
,
15232 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
15234 JIM_NOTUSED(interp
);
15235 Jim_Free((char *)objPtr
->internalRep
.ptr
);
15236 objPtr
->internalRep
.ptr
= 0;
15239 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
15241 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
15242 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
15244 JIM_NOTUSED(interp
);
15245 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
15246 dupPtr
->internalRep
.ptr
= newVec
;
15247 dupPtr
->typePtr
= &scanFmtStringObjType
;
15250 void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
15252 char *bytes
= ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
;
15254 objPtr
->bytes
= Jim_StrDup(bytes
);
15255 objPtr
->length
= strlen(bytes
);
15258 /* SetScanFmtFromAny will parse a given string and create the internal
15259 * representation of the format specification. In case of an error
15260 * the error data member of the internal representation will be set
15261 * to an descriptive error text and the function will be left with
15262 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
15265 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
15267 ScanFmtStringObj
*fmtObj
;
15269 int maxCount
, i
, approxSize
, lastPos
= -1;
15270 const char *fmt
= objPtr
->bytes
;
15271 int maxFmtLen
= objPtr
->length
;
15272 const char *fmtEnd
= fmt
+ maxFmtLen
;
15275 Jim_FreeIntRep(interp
, objPtr
);
15276 /* Count how many conversions could take place maximally */
15277 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
15280 /* Calculate an approximation of the memory necessary */
15281 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
15282 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
15283 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
15284 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
15285 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
15286 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
15287 +1; /* safety byte */
15288 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
15289 memset(fmtObj
, 0, approxSize
);
15290 fmtObj
->size
= approxSize
;
15291 fmtObj
->maxPos
= 0;
15292 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
15293 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
15294 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
15295 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
15296 objPtr
->internalRep
.ptr
= fmtObj
;
15297 objPtr
->typePtr
= &scanFmtStringObjType
;
15298 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
15299 int width
= 0, skip
;
15300 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
15303 descr
->width
= 0; /* Assume width unspecified */
15304 /* Overread and store any "literal" prefix */
15305 if (*fmt
!= '%' || fmt
[1] == '%') {
15307 descr
->prefix
= &buffer
[i
];
15308 for (; fmt
< fmtEnd
; ++fmt
) {
15314 buffer
[i
++] = *fmt
;
15318 /* Skip the conversion introducing '%' sign */
15320 /* End reached due to non-conversion literal only? */
15323 descr
->pos
= 0; /* Assume "natural" positioning */
15325 descr
->pos
= -1; /* Okay, conversion will not be assigned */
15329 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
15330 /* Check if next token is a number (could be width or pos */
15331 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
15333 /* Was the number a XPG3 position specifier? */
15334 if (descr
->pos
!= -1 && *fmt
== '$') {
15338 descr
->pos
= width
;
15340 /* Look if "natural" postioning and XPG3 one was mixed */
15341 if ((lastPos
== 0 && descr
->pos
> 0)
15342 || (lastPos
> 0 && descr
->pos
== 0)) {
15343 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
15346 /* Look if this position was already used */
15347 for (prev
= 0; prev
< curr
; ++prev
) {
15348 if (fmtObj
->descr
[prev
].pos
== -1)
15350 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
15352 "variable is assigned by multiple \"%n$\" conversion specifiers";
15356 /* Try to find a width after the XPG3 specifier */
15357 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
15358 descr
->width
= width
;
15361 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
15362 fmtObj
->maxPos
= descr
->pos
;
15365 /* Number was not a XPG3, so it has to be a width */
15366 descr
->width
= width
;
15369 /* If positioning mode was undetermined yet, fix this */
15371 lastPos
= descr
->pos
;
15372 /* Handle CHARSET conversion type ... */
15374 int swapped
= 1, beg
= i
, end
, j
;
15377 descr
->arg
= &buffer
[i
];
15380 buffer
[i
++] = *fmt
++;
15382 buffer
[i
++] = *fmt
++;
15383 while (*fmt
&& *fmt
!= ']')
15384 buffer
[i
++] = *fmt
++;
15386 fmtObj
->error
= "unmatched [ in format string";
15391 /* In case a range fence was given "backwards", swap it */
15394 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
15395 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
15396 char tmp
= buffer
[j
- 1];
15398 buffer
[j
- 1] = buffer
[j
+ 1];
15399 buffer
[j
+ 1] = tmp
;
15406 /* Remember any valid modifier if given */
15407 if (strchr("hlL", *fmt
) != 0)
15408 descr
->modifier
= tolower((int)*fmt
++);
15410 descr
->type
= *fmt
;
15411 if (strchr("efgcsndoxui", *fmt
) == 0) {
15412 fmtObj
->error
= "bad scan conversion character";
15415 else if (*fmt
== 'c' && descr
->width
!= 0) {
15416 fmtObj
->error
= "field width may not be specified in %c " "conversion";
15419 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
15420 fmtObj
->error
= "unsigned wide not supported";
15430 /* Some accessor macros to allow lowlevel access to fields of internal repr */
15432 #define FormatGetCnvCount(_fo_) \
15433 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
15434 #define FormatGetMaxPos(_fo_) \
15435 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
15436 #define FormatGetError(_fo_) \
15437 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
15439 /* JimScanAString is used to scan an unspecified string that ends with
15440 * next WS, or a string that is specified via a charset.
15443 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
15445 char *buffer
= Jim_StrDup(str
);
15452 if (!sdescr
&& isspace(UCHAR(*str
)))
15453 break; /* EOS via WS if unspecified */
15455 n
= utf8_tounicode(str
, &c
);
15456 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
15462 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
15465 /* ScanOneEntry will scan one entry out of the string passed as argument.
15466 * It use the sscanf() function for this task. After extracting and
15467 * converting of the value, the count of scanned characters will be
15468 * returned of -1 in case of no conversion tool place and string was
15469 * already scanned thru */
15471 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
15472 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
15475 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
15476 size_t scanned
= 0;
15477 size_t anchor
= pos
;
15479 Jim_Obj
*tmpObj
= NULL
;
15481 /* First pessimistically assume, we will not scan anything :-) */
15483 if (descr
->prefix
) {
15484 /* There was a prefix given before the conversion, skip it and adjust
15485 * the string-to-be-parsed accordingly */
15486 /* XXX: Should be checking strLen, not str[pos] */
15487 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
15488 /* If prefix require, skip WS */
15489 if (isspace(UCHAR(descr
->prefix
[i
])))
15490 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
15492 else if (descr
->prefix
[i
] != str
[pos
])
15493 break; /* Prefix do not match here, leave the loop */
15495 ++pos
; /* Prefix matched so far, next round */
15497 if (pos
>= strLen
) {
15498 return -1; /* All of str consumed: EOF condition */
15500 else if (descr
->prefix
[i
] != 0)
15501 return 0; /* Not whole prefix consumed, no conversion possible */
15503 /* For all but following conversion, skip leading WS */
15504 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
15505 while (isspace(UCHAR(str
[pos
])))
15507 /* Determine how much skipped/scanned so far */
15508 scanned
= pos
- anchor
;
15510 /* %c is a special, simple case. no width */
15511 if (descr
->type
== 'n') {
15512 /* Return pseudo conversion means: how much scanned so far? */
15513 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
15515 else if (pos
>= strLen
) {
15516 /* Cannot scan anything, as str is totally consumed */
15519 else if (descr
->type
== 'c') {
15521 scanned
+= utf8_tounicode(&str
[pos
], &c
);
15522 *valObjPtr
= Jim_NewIntObj(interp
, c
);
15526 /* Processing of conversions follows ... */
15527 if (descr
->width
> 0) {
15528 /* Do not try to scan as fas as possible but only the given width.
15529 * To ensure this, we copy the part that should be scanned. */
15530 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
15531 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
15533 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
15534 tok
= tmpObj
->bytes
;
15537 /* As no width was given, simply refer to the original string */
15540 switch (descr
->type
) {
15546 char *endp
; /* Position where the number finished */
15549 int base
= descr
->type
== 'o' ? 8
15550 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
15552 /* Try to scan a number with the given base */
15553 w
= strtoull(tok
, &endp
, base
);
15554 if (endp
== tok
&& base
== 0) {
15555 /* If scanning failed, and base was undetermined, simply
15556 * put it to 10 and try once more. This should catch the
15557 * case where %i begin to parse a number prefix (e.g.
15558 * '0x' but no further digits follows. This will be
15559 * handled as a ZERO followed by a char 'x' by Tcl */
15560 w
= strtoull(tok
, &endp
, 10);
15564 /* There was some number sucessfully scanned! */
15565 *valObjPtr
= Jim_NewIntObj(interp
, w
);
15567 /* Adjust the number-of-chars scanned so far */
15568 scanned
+= endp
- tok
;
15571 /* Nothing was scanned. We have to determine if this
15572 * happened due to e.g. prefix mismatch or input str
15574 scanned
= *tok
? 0 : -1;
15580 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
15581 scanned
+= Jim_Length(*valObjPtr
);
15588 double value
= strtod(tok
, &endp
);
15591 /* There was some number sucessfully scanned! */
15592 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
15593 /* Adjust the number-of-chars scanned so far */
15594 scanned
+= endp
- tok
;
15597 /* Nothing was scanned. We have to determine if this
15598 * happened due to e.g. prefix mismatch or input str
15600 scanned
= *tok
? 0 : -1;
15605 /* If a substring was allocated (due to pre-defined width) do not
15606 * forget to free it */
15608 Jim_FreeNewObj(interp
, tmpObj
);
15614 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
15615 * string and returns all converted (and not ignored) values in a list back
15616 * to the caller. If an error occured, a NULL pointer will be returned */
15618 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
15622 const char *str
= Jim_String(strObjPtr
);
15623 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
15624 Jim_Obj
*resultList
= 0;
15625 Jim_Obj
**resultVec
= 0;
15627 Jim_Obj
*emptyStr
= 0;
15628 ScanFmtStringObj
*fmtObj
;
15630 /* This should never happen. The format object should already be of the correct type */
15631 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, interp
, "Jim_ScanString() for non-scan format"));
15633 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
15634 /* Check if format specification was valid */
15635 if (fmtObj
->error
!= 0) {
15636 if (flags
& JIM_ERRMSG
)
15637 Jim_SetResultString(interp
, fmtObj
->error
, -1);
15640 /* Allocate a new "shared" empty string for all unassigned conversions */
15641 emptyStr
= Jim_NewEmptyStringObj(interp
);
15642 Jim_IncrRefCount(emptyStr
);
15643 /* Create a list and fill it with empty strings up to max specified XPG3 */
15644 resultList
= Jim_NewListObj(interp
, 0, 0);
15645 if (fmtObj
->maxPos
> 0) {
15646 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
15647 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
15648 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
15650 /* Now handle every partial format description */
15651 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
15652 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
15653 Jim_Obj
*value
= 0;
15655 /* Only last type may be "literal" w/o conversion - skip it! */
15656 if (descr
->type
== 0)
15658 /* As long as any conversion could be done, we will proceed */
15660 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
15661 /* In case our first try results in EOF, we will leave */
15662 if (scanned
== -1 && i
== 0)
15664 /* Advance next pos-to-be-scanned for the amount scanned already */
15667 /* value == 0 means no conversion took place so take empty string */
15669 value
= Jim_NewEmptyStringObj(interp
);
15670 /* If value is a non-assignable one, skip it */
15671 if (descr
->pos
== -1) {
15672 Jim_FreeNewObj(interp
, value
);
15674 else if (descr
->pos
== 0)
15675 /* Otherwise append it to the result list if no XPG3 was given */
15676 Jim_ListAppendElement(interp
, resultList
, value
);
15677 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
15678 /* But due to given XPG3, put the value into the corr. slot */
15679 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
15680 Jim_IncrRefCount(value
);
15681 resultVec
[descr
->pos
- 1] = value
;
15684 /* Otherwise, the slot was already used - free obj and ERROR */
15685 Jim_FreeNewObj(interp
, value
);
15689 Jim_DecrRefCount(interp
, emptyStr
);
15692 Jim_DecrRefCount(interp
, emptyStr
);
15693 Jim_FreeNewObj(interp
, resultList
);
15694 return (Jim_Obj
*)EOF
;
15696 Jim_DecrRefCount(interp
, emptyStr
);
15697 Jim_FreeNewObj(interp
, resultList
);
15701 /* -----------------------------------------------------------------------------
15702 * Pseudo Random Number Generation
15703 * ---------------------------------------------------------------------------*/
15704 /* Initialize the sbox with the numbers from 0 to 255 */
15705 static void JimPrngInit(Jim_Interp
*interp
)
15707 #define PRNG_SEED_SIZE 256
15709 unsigned int *seed
;
15710 time_t t
= time(NULL
);
15712 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
15714 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
15715 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
15716 seed
[i
] = (rand() ^ t
^ clock());
15718 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
15722 /* Generates N bytes of random data */
15723 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
15725 Jim_PrngState
*prng
;
15726 unsigned char *destByte
= (unsigned char *)dest
;
15727 unsigned int si
, sj
, x
;
15729 /* initialization, only needed the first time */
15730 if (interp
->prngState
== NULL
)
15731 JimPrngInit(interp
);
15732 prng
= interp
->prngState
;
15733 /* generates 'len' bytes of pseudo-random numbers */
15734 for (x
= 0; x
< len
; x
++) {
15735 prng
->i
= (prng
->i
+ 1) & 0xff;
15736 si
= prng
->sbox
[prng
->i
];
15737 prng
->j
= (prng
->j
+ si
) & 0xff;
15738 sj
= prng
->sbox
[prng
->j
];
15739 prng
->sbox
[prng
->i
] = sj
;
15740 prng
->sbox
[prng
->j
] = si
;
15741 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
15745 /* Re-seed the generator with user-provided bytes */
15746 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
15749 Jim_PrngState
*prng
;
15751 /* initialization, only needed the first time */
15752 if (interp
->prngState
== NULL
)
15753 JimPrngInit(interp
);
15754 prng
= interp
->prngState
;
15756 /* Set the sbox[i] with i */
15757 for (i
= 0; i
< 256; i
++)
15759 /* Now use the seed to perform a random permutation of the sbox */
15760 for (i
= 0; i
< seedLen
; i
++) {
15763 t
= prng
->sbox
[i
& 0xFF];
15764 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
15765 prng
->sbox
[seed
[i
]] = t
;
15767 prng
->i
= prng
->j
= 0;
15769 /* discard at least the first 256 bytes of stream.
15770 * borrow the seed buffer for this
15772 for (i
= 0; i
< 256; i
+= seedLen
) {
15773 JimRandomBytes(interp
, seed
, seedLen
);
15778 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15780 jim_wide wideValue
, increment
= 1;
15781 Jim_Obj
*intObjPtr
;
15783 if (argc
!= 2 && argc
!= 3) {
15784 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
15788 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
15791 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
15793 /* Set missing variable to 0 */
15796 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
15799 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
15800 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
15801 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
15802 Jim_FreeNewObj(interp
, intObjPtr
);
15807 /* Can do it the quick way */
15808 Jim_InvalidateStringRep(intObjPtr
);
15809 JimWideValue(intObjPtr
) = wideValue
+ increment
;
15811 /* The following step is required in order to invalidate the
15812 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
15813 if (argv
[1]->typePtr
!= &variableObjType
) {
15814 /* Note that this can't fail since GetVariable already succeeded */
15815 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
15818 Jim_SetResult(interp
, intObjPtr
);
15823 /* -----------------------------------------------------------------------------
15825 * ---------------------------------------------------------------------------*/
15826 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
15827 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
15829 /* Handle calls to the [unknown] command */
15830 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *filename
,
15833 Jim_Obj
**v
, *sv
[JIM_EVAL_SARGV_LEN
];
15836 /* If JimUnknown() is recursively called too many times...
15839 if (interp
->unknown_called
> 50) {
15843 /* If the [unknown] command does not exists returns
15845 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
15848 /* The object interp->unknown just contains
15849 * the "unknown" string, it is used in order to
15850 * avoid to lookup the unknown command every time
15851 * but instread to cache the result. */
15852 if (argc
+ 1 <= JIM_EVAL_SARGV_LEN
)
15855 v
= Jim_Alloc(sizeof(Jim_Obj
*) * (argc
+ 1));
15856 /* Make a copy of the arguments vector, but shifted on
15857 * the right of one position. The command name of the
15858 * command will be instead the first argument of the
15859 * [unknown] call. */
15860 memcpy(v
+ 1, argv
, sizeof(Jim_Obj
*) * argc
);
15861 v
[0] = interp
->unknown
;
15863 interp
->unknown_called
++;
15864 retCode
= JimEvalObjVector(interp
, argc
+ 1, v
, filename
, linenr
);
15865 interp
->unknown_called
--;
15873 /* Eval the object vector 'objv' composed of 'objc' elements.
15874 * Every element is used as single argument.
15875 * Jim_EvalObj() will call this function every time its object
15876 * argument is of "list" type, with no string representation.
15878 * This is possible because the string representation of a
15879 * list object generated by the UpdateStringOfList is made
15880 * in a way that ensures that every list element is a different
15881 * command argument. */
15882 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
15883 const char *filename
, int linenr
)
15888 /* Incr refcount of arguments. */
15889 for (i
= 0; i
< objc
; i
++)
15890 Jim_IncrRefCount(objv
[i
]);
15891 /* Command lookup */
15892 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
15893 if (cmdPtr
== NULL
) {
15894 retcode
= JimUnknown(interp
, objc
, objv
, filename
, linenr
);
15897 /* Call it -- Make sure result is an empty object. */
15898 JimIncrCmdRefCount(cmdPtr
);
15899 Jim_SetEmptyResult(interp
);
15900 if (cmdPtr
->isproc
) {
15901 retcode
= JimCallProcedure(interp
, cmdPtr
, filename
, linenr
, objc
, objv
);
15904 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
15905 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
15907 JimDecrCmdRefCount(interp
, cmdPtr
);
15909 /* Decr refcount of arguments and return the retcode */
15910 for (i
= 0; i
< objc
; i
++)
15911 Jim_DecrRefCount(interp
, objv
[i
]);
15916 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
15918 return JimEvalObjVector(interp
, objc
, objv
, NULL
, 0);
15922 * Invokes 'prefix' as a command with the objv array as arguments.
15924 int Jim_EvalObjPrefix(Jim_Interp
*interp
, const char *prefix
, int objc
, Jim_Obj
*const *objv
)
15928 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
15930 nargv
[0] = Jim_NewStringObj(interp
, prefix
, -1);
15931 for (i
= 0; i
< objc
; i
++) {
15932 nargv
[i
+ 1] = objv
[i
];
15934 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
15939 static void JimAddErrorToStack(Jim_Interp
*interp
, int retcode
, const char *filename
, int line
)
15943 if (rc
== JIM_ERR
&& !interp
->errorFlag
) {
15944 /* This is the first error, so save the file/line information and reset the stack */
15945 interp
->errorFlag
= 1;
15946 JimSetErrorFileName(interp
, filename
);
15947 JimSetErrorLineNumber(interp
, line
);
15949 JimResetStackTrace(interp
);
15950 /* Always add a level where the error first occurs */
15951 interp
->addStackTrace
++;
15954 /* Now if this is an "interesting" level, add it to the stack trace */
15955 if (rc
== JIM_ERR
&& interp
->addStackTrace
> 0) {
15956 /* Add the stack info for the current level */
15958 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), filename
, line
);
15960 /* Note: if we didn't have a filename for this level,
15961 * don't clear the addStackTrace flag
15962 * so we can pick it up at the next level
15965 interp
->addStackTrace
= 0;
15968 Jim_DecrRefCount(interp
, interp
->errorProc
);
15969 interp
->errorProc
= interp
->emptyObj
;
15970 Jim_IncrRefCount(interp
->errorProc
);
15972 else if (rc
== JIM_RETURN
&& interp
->returnCode
== JIM_ERR
) {
15973 /* Propagate the addStackTrace value through 'return -code error' */
15976 interp
->addStackTrace
= 0;
15980 /* And delete any local procs */
15981 static void JimDeleteLocalProcs(Jim_Interp
*interp
)
15983 if (interp
->localProcs
) {
15986 while ((procname
= Jim_StackPop(interp
->localProcs
)) != NULL
) {
15987 /* If there is a pushed command, find it */
15988 Jim_Cmd
*prevCmd
= NULL
;
15989 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, procname
);
15991 Jim_Cmd
*cmd
= (Jim_Cmd
*)he
->u
.val
;
15992 if (cmd
->isproc
&& cmd
->u
.proc
.prevCmd
) {
15993 prevCmd
= cmd
->u
.proc
.prevCmd
;
15994 cmd
->u
.proc
.prevCmd
= NULL
;
15998 /* Delete the local proc */
15999 Jim_DeleteCommand(interp
, procname
);
16002 /* And restore the pushed command */
16003 Jim_AddHashEntry(&interp
->commands
, procname
, prevCmd
);
16005 Jim_Free(procname
);
16007 Jim_FreeStack(interp
->localProcs
);
16008 Jim_Free(interp
->localProcs
);
16009 interp
->localProcs
= NULL
;
16013 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
16017 switch (token
->type
) {
16020 objPtr
= token
->objPtr
;
16023 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
16025 case JIM_TT_DICTSUGAR
:
16026 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
16028 case JIM_TT_EXPRSUGAR
:
16029 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
16032 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
16035 objPtr
= interp
->result
;
16038 /* Stop substituting */
16041 /* just skip this one */
16042 return JIM_CONTINUE
;
16048 JimPanic((1, interp
,
16049 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
16054 *objPtrPtr
= objPtr
;
16060 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
16061 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
16062 * The returned object has refcount = 0.
16064 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
16068 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
16072 if (tokens
<= JIM_EVAL_SINTV_LEN
)
16075 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
16077 /* Compute every token forming the argument
16078 * in the intv objects vector. */
16079 for (i
= 0; i
< tokens
; i
++) {
16080 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
16085 if (flags
& JIM_SUBST_FLAG
) {
16090 /* XXX: Should probably set an error about break outside loop */
16091 /* fall through to error */
16093 if (flags
& JIM_SUBST_FLAG
) {
16097 /* XXX: Ditto continue outside loop */
16098 /* fall through to error */
16101 Jim_DecrRefCount(interp
, intv
[i
]);
16103 if (intv
!= sintv
) {
16108 Jim_IncrRefCount(intv
[i
]);
16109 Jim_String(intv
[i
]);
16110 totlen
+= intv
[i
]->length
;
16113 /* Fast path return for a single token */
16114 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
16115 Jim_DecrRefCount(interp
, intv
[0]);
16119 /* Concatenate every token in an unique
16121 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
16123 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
16124 && token
[2].type
== JIM_TT_VAR
) {
16125 /* May be able to do fast interpolated object -> dictSubst */
16126 objPtr
->typePtr
= &interpolatedObjType
;
16127 objPtr
->internalRep
.twoPtrValue
.ptr1
= (void *)token
;
16128 objPtr
->internalRep
.twoPtrValue
.ptr2
= intv
[2];
16129 Jim_IncrRefCount(intv
[2]);
16132 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
16133 objPtr
->length
= totlen
;
16134 for (i
= 0; i
< tokens
; i
++) {
16136 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
16137 s
+= intv
[i
]->length
;
16138 Jim_DecrRefCount(interp
, intv
[i
]);
16141 objPtr
->bytes
[totlen
] = '\0';
16142 /* Free the intv vector if not static. */
16143 if (intv
!= sintv
) {
16151 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
16152 * Otherwise eval with Jim_EvalObj()
16154 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, const char *filename
, int linenr
)
16156 if (!Jim_IsList(listPtr
)) {
16157 return Jim_EvalObj(interp
, listPtr
);
16160 int retcode
= JIM_OK
;
16162 if (listPtr
->internalRep
.listValue
.len
) {
16163 Jim_IncrRefCount(listPtr
);
16164 retcode
= JimEvalObjVector(interp
,
16165 listPtr
->internalRep
.listValue
.len
,
16166 listPtr
->internalRep
.listValue
.ele
, filename
, linenr
);
16167 Jim_DecrRefCount(interp
, listPtr
);
16173 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
16177 ScriptToken
*token
;
16178 int retcode
= JIM_OK
;
16179 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
16182 interp
->errorFlag
= 0;
16184 /* If the object is of type "list", we can call
16185 * a specialized version of Jim_EvalObj() */
16186 if (Jim_IsList(scriptObjPtr
)) {
16187 return Jim_EvalObjList(interp
, scriptObjPtr
, NULL
, 0);
16190 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
16191 script
= Jim_GetScript(interp
, scriptObjPtr
);
16193 /* Reset the interpreter result. This is useful to
16194 * return the empty result in the case of empty program. */
16195 Jim_SetEmptyResult(interp
);
16197 #ifdef JIM_OPTIMIZATION
16198 /* Check for one of the following common scripts used by for, while
16203 if (script
->len
== 0) {
16204 Jim_DecrRefCount(interp
, scriptObjPtr
);
16207 if (script
->len
== 3
16208 && script
->token
[1].objPtr
->typePtr
== &commandObjType
16209 && script
->token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
16210 && script
->token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
16211 && script
->token
[2].objPtr
->typePtr
== &variableObjType
) {
16213 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, script
->token
[2].objPtr
, JIM_NONE
);
16215 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
16216 JimWideValue(objPtr
)++;
16217 Jim_InvalidateStringRep(objPtr
);
16218 Jim_DecrRefCount(interp
, scriptObjPtr
);
16219 Jim_SetResult(interp
, objPtr
);
16225 /* Now we have to make sure the internal repr will not be
16226 * freed on shimmering.
16228 * Think for example to this:
16230 * set x {llength $x; ... some more code ...}; eval $x
16232 * In order to preserve the internal rep, we increment the
16233 * inUse field of the script internal rep structure. */
16236 token
= script
->token
;
16239 /* Execute every command sequentially until the end of the script
16240 * or an error occurs.
16242 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
16247 /* First token of the line is always JIM_TT_LINE */
16248 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
16249 linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
16251 /* Allocate the arguments vector if required */
16252 if (argc
> JIM_EVAL_SARGV_LEN
)
16253 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
16255 /* Skip the JIM_TT_LINE token */
16258 /* Populate the arguments objects.
16259 * If an error occurs, retcode will be set and
16260 * 'j' will be set to the number of args expanded
16262 for (j
= 0; j
< argc
; j
++) {
16263 long wordtokens
= 1;
16265 Jim_Obj
*wordObjPtr
= NULL
;
16267 if (token
[i
].type
== JIM_TT_WORD
) {
16268 wordtokens
= JimWideValue(token
[i
++].objPtr
);
16269 if (wordtokens
< 0) {
16271 wordtokens
= -wordtokens
;
16275 if (wordtokens
== 1) {
16276 /* Fast path if the token does not
16277 * need interpolation */
16279 switch (token
[i
].type
) {
16282 wordObjPtr
= token
[i
].objPtr
;
16285 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
16287 case JIM_TT_EXPRSUGAR
:
16288 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
16290 case JIM_TT_DICTSUGAR
:
16291 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
16294 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
16295 if (retcode
== JIM_OK
) {
16296 wordObjPtr
= Jim_GetResult(interp
);
16300 JimPanic((1, interp
, "default token type reached " "in Jim_EvalObj()."));
16304 /* For interpolation we call a helper
16305 * function to do the work for us. */
16306 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
16310 if (retcode
== JIM_OK
) {
16316 Jim_IncrRefCount(wordObjPtr
);
16320 argv
[j
] = wordObjPtr
;
16323 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
16324 int len
= Jim_ListLength(interp
, wordObjPtr
);
16325 int newargc
= argc
+ len
- 1;
16329 if (argv
== sargv
) {
16330 if (newargc
> JIM_EVAL_SARGV_LEN
) {
16331 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
16332 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
16336 /* Need to realloc to make room for (len - 1) more entries */
16337 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
16341 /* Now copy in the expanded version */
16342 for (k
= 0; k
< len
; k
++) {
16343 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
16344 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
16347 /* The original object reference is no longer needed,
16348 * after the expansion it is no longer present on
16349 * the argument vector, but the single elements are
16351 Jim_DecrRefCount(interp
, wordObjPtr
);
16353 /* And update the indexes */
16359 if (retcode
== JIM_OK
&& argc
) {
16360 /* Lookup the command to call */
16361 cmd
= Jim_GetCommand(interp
, argv
[0], JIM_ERRMSG
);
16363 /* Call it -- Make sure result is an empty object. */
16364 JimIncrCmdRefCount(cmd
);
16365 Jim_SetEmptyResult(interp
);
16368 JimCallProcedure(interp
, cmd
, script
->fileName
, linenr
, argc
, argv
);
16370 interp
->cmdPrivData
= cmd
->u
.native
.privData
;
16371 retcode
= cmd
->u
.native
.cmdProc(interp
, argc
, argv
);
16373 JimDecrCmdRefCount(interp
, cmd
);
16376 /* Call [unknown] */
16377 retcode
= JimUnknown(interp
, argc
, argv
, script
->fileName
, linenr
);
16379 if (interp
->signal_level
&& interp
->sigmask
) {
16380 /* Check for a signal after each command */
16381 retcode
= JIM_SIGNAL
;
16385 /* Finished with the command, so decrement ref counts of each argument */
16387 Jim_DecrRefCount(interp
, argv
[j
]);
16390 if (argv
!= sargv
) {
16396 /* Possibly add to the error stack trace */
16397 JimAddErrorToStack(interp
, retcode
, script
->fileName
, linenr
);
16399 /* Note that we don't have to decrement inUse, because the
16400 * following code transfers our use of the reference again to
16401 * the script object. */
16402 Jim_FreeIntRep(interp
, scriptObjPtr
);
16403 scriptObjPtr
->typePtr
= &scriptObjType
;
16404 Jim_SetIntRepPtr(scriptObjPtr
, script
);
16405 Jim_DecrRefCount(interp
, scriptObjPtr
);
16410 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
16413 /* If argObjPtr begins with '&', do an automatic upvar */
16414 const char *varname
= Jim_String(argNameObj
);
16415 if (*varname
== '&') {
16416 /* First check that the target variable exists */
16418 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
16420 interp
->framePtr
= interp
->framePtr
->parentCallFrame
;
16421 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
16422 interp
->framePtr
= savedCallFrame
;
16427 /* It exists, so perform the binding. */
16428 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
16429 Jim_IncrRefCount(objPtr
);
16430 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parentCallFrame
);
16431 Jim_DecrRefCount(interp
, objPtr
);
16434 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
16439 /* Call a procedure implemented in Tcl.
16440 * It's possible to speed-up a lot this function, currently
16441 * the callframes are not cached, but allocated and
16442 * destroied every time. What is expecially costly is
16443 * to create/destroy the local vars hash table every time.
16445 * This can be fixed just implementing callframes caching
16446 * in JimCreateCallFrame() and JimFreeCallFrame(). */
16447 int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
, int argc
,
16448 Jim_Obj
*const *argv
)
16451 Jim_CallFrame
*callFramePtr
;
16452 Jim_Obj
*argObjPtr
;
16453 Jim_Obj
*procname
= argv
[0];
16454 Jim_Stack
*prevLocalProcs
;
16457 if (argc
- 1 < cmd
->u
.proc
.leftArity
+ cmd
->u
.proc
.rightArity
||
16458 (!cmd
->u
.proc
.args
&& argc
- 1 > cmd
->u
.proc
.leftArity
+ cmd
->u
.proc
.rightArity
+ cmd
->u
.proc
.optionalArgs
)) {
16459 /* Create a nice error message, consistent with Tcl 8.5 */
16460 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
16461 int arglen
= Jim_ListLength(interp
, cmd
->u
.proc
.argListObjPtr
);
16463 for (i
= 0; i
< arglen
; i
++) {
16465 Jim_ListIndex(interp
, cmd
->u
.proc
.argListObjPtr
, i
, &argObjPtr
, JIM_NONE
);
16467 Jim_AppendString(interp
, argmsg
, " ", 1);
16469 if (i
< cmd
->u
.proc
.leftArity
|| i
>= arglen
- cmd
->u
.proc
.rightArity
) {
16470 Jim_AppendObj(interp
, argmsg
, argObjPtr
);
16472 else if (i
== arglen
- cmd
->u
.proc
.rightArity
- cmd
->u
.proc
.args
) {
16473 if (Jim_ListLength(interp
, argObjPtr
) == 1) {
16474 /* We have plain args */
16475 Jim_AppendString(interp
, argmsg
, "?argument ...?", -1);
16478 Jim_AppendString(interp
, argmsg
, "?", 1);
16479 Jim_ListIndex(interp
, argObjPtr
, 1, &objPtr
, JIM_NONE
);
16480 Jim_AppendObj(interp
, argmsg
, objPtr
);
16481 Jim_AppendString(interp
, argmsg
, " ...?", -1);
16485 Jim_AppendString(interp
, argmsg
, "?", 1);
16486 Jim_ListIndex(interp
, argObjPtr
, 0, &objPtr
, JIM_NONE
);
16487 Jim_AppendObj(interp
, argmsg
, objPtr
);
16488 Jim_AppendString(interp
, argmsg
, "?", 1);
16491 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procname
, argmsg
);
16492 Jim_FreeNewObj(interp
, argmsg
);
16496 /* Check if there are too nested calls */
16497 if (interp
->framePtr
->level
== interp
->maxNestingDepth
) {
16498 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
16502 /* Create a new callframe */
16503 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
);
16504 callFramePtr
->argv
= argv
;
16505 callFramePtr
->argc
= argc
;
16506 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
16507 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
16508 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
16509 callFramePtr
->filename
= filename
;
16510 callFramePtr
->line
= linenr
;
16511 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
16512 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
16513 interp
->framePtr
= callFramePtr
;
16515 /* Simplify arg counting */
16519 /* Set arguments */
16521 /* Assign in this order:
16522 * leftArity required args.
16523 * rightArity required args (but actually do it last for simplicity)
16524 * optionalArgs optional args
16525 * remaining args into 'args' if 'args'
16528 /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */
16530 /* leftArity required args */
16531 for (d
= 0; d
< cmd
->u
.proc
.leftArity
; d
++) {
16532 Jim_ListIndex(interp
, cmd
->u
.proc
.argListObjPtr
, d
, &argObjPtr
, JIM_NONE
);
16533 retcode
= JimSetProcArg(interp
, argObjPtr
, *argv
++);
16534 if (retcode
!= JIM_OK
) {
16540 /* Shorten our idea of the number of supplied args */
16541 argc
-= cmd
->u
.proc
.rightArity
;
16543 /* optionalArgs optional args */
16544 for (i
= 0; i
< cmd
->u
.proc
.optionalArgs
; i
++) {
16545 Jim_Obj
*nameObjPtr
;
16546 Jim_Obj
*valueObjPtr
;
16548 Jim_ListIndex(interp
, cmd
->u
.proc
.argListObjPtr
, d
++, &argObjPtr
, JIM_NONE
);
16550 /* The name is the first element of the list */
16551 Jim_ListIndex(interp
, argObjPtr
, 0, &nameObjPtr
, JIM_NONE
);
16553 valueObjPtr
= *argv
++;
16557 /* No more values, so use default */
16558 /* The value is the second element of the list */
16559 Jim_ListIndex(interp
, argObjPtr
, 1, &valueObjPtr
, JIM_NONE
);
16561 Jim_SetVariable(interp
, nameObjPtr
, valueObjPtr
);
16564 /* Any remaining args go to 'args' */
16565 if (cmd
->u
.proc
.args
) {
16566 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
16568 /* Get the 'args' name from the procedure args */
16569 Jim_ListIndex(interp
, cmd
->u
.proc
.argListObjPtr
, d
, &argObjPtr
, JIM_NONE
);
16571 /* It is possible to rename args. */
16572 i
= Jim_ListLength(interp
, argObjPtr
);
16574 Jim_ListIndex(interp
, argObjPtr
, 1, &argObjPtr
, JIM_NONE
);
16577 Jim_SetVariable(interp
, argObjPtr
, listObjPtr
);
16582 /* rightArity required args */
16583 for (i
= 0; i
< cmd
->u
.proc
.rightArity
; i
++) {
16584 Jim_ListIndex(interp
, cmd
->u
.proc
.argListObjPtr
, d
++, &argObjPtr
, JIM_NONE
);
16585 retcode
= JimSetProcArg(interp
, argObjPtr
, *argv
++);
16586 if (retcode
!= JIM_OK
) {
16591 /* Install a new stack for local procs */
16592 prevLocalProcs
= interp
->localProcs
;
16593 interp
->localProcs
= NULL
;
16595 /* Eval the body */
16596 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
16598 /* Delete any local procs */
16599 JimDeleteLocalProcs(interp
);
16600 interp
->localProcs
= prevLocalProcs
;
16603 /* Destroy the callframe */
16604 interp
->framePtr
= interp
->framePtr
->parentCallFrame
;
16605 if (callFramePtr
->vars
.size
!= JIM_HT_INITIAL_SIZE
) {
16606 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NONE
);
16609 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NOHT
);
16611 /* Handle the JIM_EVAL return code */
16612 while (retcode
== JIM_EVAL
) {
16613 Jim_Obj
*resultScriptObjPtr
= Jim_GetResult(interp
);
16615 Jim_IncrRefCount(resultScriptObjPtr
);
16616 /* Should be a list! */
16617 retcode
= Jim_EvalObjList(interp
, resultScriptObjPtr
, filename
, linenr
);
16618 Jim_DecrRefCount(interp
, resultScriptObjPtr
);
16620 /* Handle the JIM_RETURN return code */
16621 if (retcode
== JIM_RETURN
) {
16622 if (--interp
->returnLevel
<= 0) {
16623 retcode
= interp
->returnCode
;
16624 interp
->returnCode
= JIM_OK
;
16625 interp
->returnLevel
= 0;
16628 else if (retcode
== JIM_ERR
) {
16629 interp
->addStackTrace
++;
16630 Jim_DecrRefCount(interp
, interp
->errorProc
);
16631 interp
->errorProc
= procname
;
16632 Jim_IncrRefCount(interp
->errorProc
);
16637 int Jim_Eval_Named(Jim_Interp
*interp
, const char *script
, const char *filename
, int lineno
)
16640 Jim_Obj
*scriptObjPtr
;
16642 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
16643 Jim_IncrRefCount(scriptObjPtr
);
16647 Jim_Obj
*prevScriptObj
;
16649 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, lineno
);
16651 prevScriptObj
= interp
->currentScriptObj
;
16652 interp
->currentScriptObj
= scriptObjPtr
;
16654 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
16656 interp
->currentScriptObj
= prevScriptObj
;
16659 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
16661 Jim_DecrRefCount(interp
, scriptObjPtr
);
16665 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
16667 return Jim_Eval_Named(interp
, script
, NULL
, 0);
16670 /* Execute script in the scope of the global level */
16671 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
16674 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
16676 interp
->framePtr
= interp
->topFramePtr
;
16677 retval
= Jim_Eval(interp
, script
);
16678 interp
->framePtr
= savedFramePtr
;
16683 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
16686 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
16688 interp
->framePtr
= interp
->topFramePtr
;
16689 retval
= Jim_EvalFile(interp
, filename
);
16690 interp
->framePtr
= savedFramePtr
;
16695 #include <sys/stat.h>
16697 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
16701 Jim_Obj
*scriptObjPtr
;
16702 Jim_Obj
*prevScriptObj
;
16703 Jim_Stack
*prevLocalProcs
;
16707 struct JimParseResult result
;
16709 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
16710 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
16713 if (sb
.st_size
== 0) {
16718 buf
= Jim_Alloc(sb
.st_size
+ 1);
16719 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
16723 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
16729 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
16730 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, 1);
16731 Jim_IncrRefCount(scriptObjPtr
);
16733 /* Now check the script for unmatched braces, etc. */
16734 if (SetScriptFromAny(interp
, scriptObjPtr
, &result
) == JIM_ERR
) {
16738 switch (result
.missing
) {
16740 msg
= "unmatched \"[\"";
16743 msg
= "missing close-brace";
16747 msg
= "missing quote";
16751 snprintf(linebuf
, sizeof(linebuf
), "%d", result
.line
);
16753 Jim_SetResultFormatted(interp
, "%s in \"%s\" at line %s",
16754 msg
, filename
, linebuf
);
16755 Jim_DecrRefCount(interp
, scriptObjPtr
);
16759 prevScriptObj
= interp
->currentScriptObj
;
16760 interp
->currentScriptObj
= scriptObjPtr
;
16762 /* Install a new stack for local procs */
16763 prevLocalProcs
= interp
->localProcs
;
16764 interp
->localProcs
= NULL
;
16766 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
16768 /* Delete any local procs */
16769 JimDeleteLocalProcs(interp
);
16770 interp
->localProcs
= prevLocalProcs
;
16772 /* Handle the JIM_RETURN return code */
16773 if (retcode
== JIM_RETURN
) {
16774 if (--interp
->returnLevel
<= 0) {
16775 retcode
= interp
->returnCode
;
16776 interp
->returnCode
= JIM_OK
;
16777 interp
->returnLevel
= 0;
16780 if (retcode
== JIM_ERR
) {
16781 /* EvalFile changes context, so add a stack frame here */
16782 interp
->addStackTrace
++;
16785 interp
->currentScriptObj
= prevScriptObj
;
16787 Jim_DecrRefCount(interp
, scriptObjPtr
);
16792 /* -----------------------------------------------------------------------------
16794 * ---------------------------------------------------------------------------*/
16795 static int JimParseSubstStr(struct JimParserCtx
*pc
)
16797 pc
->tstart
= pc
->p
;
16798 pc
->tline
= pc
->linenr
;
16799 while (pc
->len
&& *pc
->p
!= '$' && *pc
->p
!= '[') {
16800 if (*pc
->p
== '\\' && pc
->len
> 1) {
16807 pc
->tend
= pc
->p
- 1;
16808 pc
->tt
= JIM_TT_ESC
;
16812 static int JimParseSubst(struct JimParserCtx
*pc
, int flags
)
16816 if (pc
->len
== 0) {
16817 pc
->tstart
= pc
->tend
= pc
->p
;
16818 pc
->tline
= pc
->linenr
;
16819 pc
->tt
= JIM_TT_EOL
;
16825 retval
= JimParseCmd(pc
);
16826 if (flags
& JIM_SUBST_NOCMD
) {
16829 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
16834 if (JimParseVar(pc
) == JIM_ERR
) {
16835 pc
->tstart
= pc
->tend
= pc
->p
++;
16837 pc
->tline
= pc
->linenr
;
16838 pc
->tt
= JIM_TT_STR
;
16841 if (flags
& JIM_SUBST_NOVAR
) {
16843 if (flags
& JIM_SUBST_NOESC
)
16844 pc
->tt
= JIM_TT_STR
;
16846 pc
->tt
= JIM_TT_ESC
;
16847 if (*pc
->tstart
== '{') {
16849 if (*(pc
->tend
+ 1))
16856 retval
= JimParseSubstStr(pc
);
16857 if (flags
& JIM_SUBST_NOESC
)
16858 pc
->tt
= JIM_TT_STR
;
16865 /* The subst object type reuses most of the data structures and functions
16866 * of the script object. Script's data structures are a bit more complex
16867 * for what is needed for [subst]itution tasks, but the reuse helps to
16868 * deal with a single data structure at the cost of some more memory
16869 * usage for substitutions. */
16871 /* This method takes the string representation of an object
16872 * as a Tcl string where to perform [subst]itution, and generates
16873 * the pre-parsed internal representation. */
16874 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
16877 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
16878 struct JimParserCtx parser
;
16879 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
16880 ParseTokenList tokenlist
;
16882 /* Initially parse the subst into tokens (in tokenlist) */
16883 ScriptTokenListInit(&tokenlist
);
16885 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
16887 JimParseSubst(&parser
, flags
);
16889 /* Note that subst doesn't need the EOL token */
16892 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
16896 /* Create the "real" subst/script tokens from the initial token list */
16898 script
->substFlags
= flags
;
16899 script
->fileName
= NULL
;
16900 SubstObjAddTokens(interp
, script
, &tokenlist
);
16902 /* No longer need the token list */
16903 ScriptTokenListFree(&tokenlist
);
16905 #ifdef DEBUG_SHOW_SUBST
16909 printf("==== Subst ====\n");
16910 for (i
= 0; i
< script
->len
; i
++) {
16911 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
16912 Jim_String(script
->token
[i
].objPtr
));
16917 /* Free the old internal rep and set the new one. */
16918 Jim_FreeIntRep(interp
, objPtr
);
16919 Jim_SetIntRepPtr(objPtr
, script
);
16920 objPtr
->typePtr
= &scriptObjType
;
16924 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
16926 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
16927 SetSubstFromAny(interp
, objPtr
, flags
);
16928 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
16931 /* Performs commands,variables,blackslashes substitution,
16932 * storing the result object (with refcount 0) into
16934 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
16936 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
16938 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
16939 /* In order to preserve the internal rep, we increment the
16940 * inUse field of the script internal rep structure. */
16943 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
16946 Jim_DecrRefCount(interp
, substObjPtr
);
16947 if (*resObjPtrPtr
== NULL
) {
16953 /* -----------------------------------------------------------------------------
16954 * Core commands utility functions
16955 * ---------------------------------------------------------------------------*/
16956 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
16959 Jim_Obj
*objPtr
= Jim_NewEmptyStringObj(interp
);
16961 Jim_AppendString(interp
, objPtr
, "wrong # args: should be \"", -1);
16962 for (i
= 0; i
< argc
; i
++) {
16963 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
16964 if (!(i
+ 1 == argc
&& msg
[0] == '\0'))
16965 Jim_AppendString(interp
, objPtr
, " ", 1);
16967 Jim_AppendString(interp
, objPtr
, msg
, -1);
16968 Jim_AppendString(interp
, objPtr
, "\"", 1);
16969 Jim_SetResult(interp
, objPtr
);
16972 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
16974 /* type is: 0=commands, 1=procs, 2=channels */
16975 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
16977 Jim_HashTableIterator
*htiter
;
16979 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
16981 /* Check for the non-pattern case. We can do this much more efficiently. */
16982 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
16983 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, patternObjPtr
, JIM_NONE
);
16985 if (type
== 1 && !cmdPtr
->isproc
) {
16988 else if (type
== 2 && !Jim_AioFilehandle(interp
, patternObjPtr
)) {
16989 /* not a channel */
16992 Jim_ListAppendElement(interp
, listObjPtr
, patternObjPtr
);
16998 htiter
= Jim_GetHashTableIterator(&interp
->commands
);
16999 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
17000 Jim_Cmd
*cmdPtr
= he
->u
.val
;
17001 Jim_Obj
*cmdNameObj
;
17003 if (type
== 1 && !cmdPtr
->isproc
) {
17007 if (patternObjPtr
&& !JimStringMatch(interp
, patternObjPtr
, he
->key
, 0))
17010 cmdNameObj
= Jim_NewStringObj(interp
, he
->key
, -1);
17012 /* Is it a channel? */
17013 if (type
== 2 && !Jim_AioFilehandle(interp
, cmdNameObj
)) {
17014 Jim_FreeNewObj(interp
, cmdNameObj
);
17018 Jim_ListAppendElement(interp
, listObjPtr
, cmdNameObj
);
17020 Jim_FreeHashTableIterator(htiter
);
17024 /* Keep this in order */
17025 #define JIM_VARLIST_GLOBALS 0
17026 #define JIM_VARLIST_LOCALS 1
17027 #define JIM_VARLIST_VARS 2
17029 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
17031 Jim_HashTableIterator
*htiter
;
17033 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
17035 if (mode
== JIM_VARLIST_GLOBALS
) {
17036 htiter
= Jim_GetHashTableIterator(&interp
->topFramePtr
->vars
);
17039 /* For [info locals], if we are at top level an emtpy list
17040 * is returned. I don't agree, but we aim at compatibility (SS) */
17041 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
)
17043 htiter
= Jim_GetHashTableIterator(&interp
->framePtr
->vars
);
17045 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
17046 Jim_Var
*varPtr
= (Jim_Var
*)he
->u
.val
;
17048 if (mode
== JIM_VARLIST_LOCALS
) {
17049 if (varPtr
->linkFramePtr
!= NULL
)
17052 if (patternObjPtr
&& !JimStringMatch(interp
, patternObjPtr
, he
->key
, 0))
17054 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
17056 Jim_FreeHashTableIterator(htiter
);
17060 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
17061 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
17063 Jim_CallFrame
*targetCallFrame
;
17065 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
17066 if (targetCallFrame
== NULL
) {
17069 /* No proc call at toplevel callframe */
17070 if (targetCallFrame
== interp
->topFramePtr
) {
17071 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
17074 if (info_level_cmd
) {
17075 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
17078 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
17080 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
17081 Jim_ListAppendElement(interp
, listObj
, Jim_NewStringObj(interp
,
17082 targetCallFrame
->filename
? targetCallFrame
->filename
: "", -1));
17083 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
17084 *objPtrPtr
= listObj
;
17089 /* -----------------------------------------------------------------------------
17091 * ---------------------------------------------------------------------------*/
17093 /* fake [puts] -- not the real puts, just for debugging. */
17094 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17096 if (argc
!= 2 && argc
!= 3) {
17097 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
17101 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
17102 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
17106 fputs(Jim_String(argv
[2]), stdout
);
17110 puts(Jim_String(argv
[1]));
17115 /* Helper for [+] and [*] */
17116 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
17118 jim_wide wideValue
, res
;
17119 double doubleValue
, doubleRes
;
17122 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
17124 for (i
= 1; i
< argc
; i
++) {
17125 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
17127 if (op
== JIM_EXPROP_ADD
)
17132 Jim_SetResultInt(interp
, res
);
17135 doubleRes
= (double)res
;
17136 for (; i
< argc
; i
++) {
17137 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
17139 if (op
== JIM_EXPROP_ADD
)
17140 doubleRes
+= doubleValue
;
17142 doubleRes
*= doubleValue
;
17144 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17148 /* Helper for [-] and [/] */
17149 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
17151 jim_wide wideValue
, res
= 0;
17152 double doubleValue
, doubleRes
= 0;
17156 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
17159 else if (argc
== 2) {
17160 /* The arity = 2 case is different. For [- x] returns -x,
17161 * while [/ x] returns 1/x. */
17162 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
17163 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
17167 if (op
== JIM_EXPROP_SUB
)
17168 doubleRes
= -doubleValue
;
17170 doubleRes
= 1.0 / doubleValue
;
17171 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17175 if (op
== JIM_EXPROP_SUB
) {
17177 Jim_SetResultInt(interp
, res
);
17180 doubleRes
= 1.0 / wideValue
;
17181 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17186 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
17187 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
17196 for (i
= 2; i
< argc
; i
++) {
17197 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
17198 doubleRes
= (double)res
;
17201 if (op
== JIM_EXPROP_SUB
)
17206 Jim_SetResultInt(interp
, res
);
17209 for (; i
< argc
; i
++) {
17210 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
17212 if (op
== JIM_EXPROP_SUB
)
17213 doubleRes
-= doubleValue
;
17215 doubleRes
/= doubleValue
;
17217 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17223 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17225 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
17229 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17231 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
17235 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17237 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
17241 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17243 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
17247 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17249 if (argc
!= 2 && argc
!= 3) {
17250 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
17256 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
17259 Jim_SetResult(interp
, objPtr
);
17262 /* argc == 3 case. */
17263 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
17265 Jim_SetResult(interp
, argv
[2]);
17271 * unset ?-nocomplain? ?--? ?varName ...?
17273 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17279 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
17283 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
17292 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
17302 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17305 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
17309 /* The general purpose implementation of while starts here */
17311 int boolean
, retval
;
17313 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
17318 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
17332 Jim_SetEmptyResult(interp
);
17337 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17341 Jim_Obj
*varNamePtr
= NULL
;
17342 Jim_Obj
*stopVarNamePtr
= NULL
;
17345 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
17349 /* Do the initialisation */
17350 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
17354 /* And do the first test now. Better for optimisation
17355 * if we can do next/test at the bottom of the loop
17357 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
17359 /* Ready to do the body as follows:
17361 * body // check retcode
17362 * next // check retcode
17363 * test // check retcode/test bool
17367 #ifdef JIM_OPTIMIZATION
17368 /* Check if the for is on the form:
17369 * for ... {$i < CONST} {incr i}
17370 * for ... {$i < $j} {incr i}
17372 if (retval
== JIM_OK
&& boolean
) {
17373 ScriptObj
*incrScript
;
17374 ExprByteCode
*expr
;
17375 jim_wide stop
, currentVal
;
17376 unsigned jim_wide procEpoch
;
17380 /* Do it only if there aren't shared arguments */
17381 expr
= JimGetExpression(interp
, argv
[2]);
17382 incrScript
= Jim_GetScript(interp
, argv
[3]);
17384 /* Ensure proper lengths to start */
17385 if (incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
17388 /* Ensure proper token types. */
17389 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
17390 expr
->token
[0].type
!= JIM_TT_VAR
||
17391 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
17395 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
17398 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
17405 /* Update command must be incr */
17406 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
17410 /* incr, expression must be about the same variable */
17411 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
17415 /* Get the stop condition (must be a variable or integer) */
17416 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
17417 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
17422 stopVarNamePtr
= expr
->token
[1].objPtr
;
17423 Jim_IncrRefCount(stopVarNamePtr
);
17424 /* Keep the compiler happy */
17428 /* Initialization */
17429 procEpoch
= interp
->procEpoch
;
17430 varNamePtr
= expr
->token
[0].objPtr
;
17431 Jim_IncrRefCount(varNamePtr
);
17433 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
17434 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
17438 /* --- OPTIMIZED FOR --- */
17439 while (retval
== JIM_OK
) {
17440 /* === Check condition === */
17441 /* Note that currentVal is already set here */
17443 /* Immediate or Variable? get the 'stop' value if the latter. */
17444 if (stopVarNamePtr
) {
17445 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
17446 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
17451 if (currentVal
>= stop
+ cmpOffset
) {
17456 retval
= Jim_EvalObj(interp
, argv
[4]);
17457 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17459 /* If there was a change in procedures/command continue
17460 * with the usual [for] command implementation */
17461 if (procEpoch
!= interp
->procEpoch
) {
17465 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
17468 if (objPtr
== NULL
) {
17472 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
17473 currentVal
= ++JimWideValue(objPtr
);
17474 Jim_InvalidateStringRep(objPtr
);
17477 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
17478 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
17479 ++currentVal
)) != JIM_OK
) {
17490 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
17492 retval
= Jim_EvalObj(interp
, argv
[4]);
17494 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17497 retval
= Jim_EvalObj(interp
, argv
[3]);
17498 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17501 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
17506 if (stopVarNamePtr
) {
17507 Jim_DecrRefCount(interp
, stopVarNamePtr
);
17510 Jim_DecrRefCount(interp
, varNamePtr
);
17513 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
17514 Jim_SetEmptyResult(interp
);
17522 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17528 Jim_Obj
*bodyObjPtr
;
17530 if (argc
!= 5 && argc
!= 6) {
17531 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
17535 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
17536 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
17537 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
17540 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
17542 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
17544 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
17545 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
17546 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17547 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
17554 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
17555 if (argv
[1]->typePtr
!= &variableObjType
) {
17556 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
17560 JimWideValue(objPtr
) = i
;
17561 Jim_InvalidateStringRep(objPtr
);
17563 /* The following step is required in order to invalidate the
17564 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
17565 if (argv
[1]->typePtr
!= &variableObjType
) {
17566 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
17573 objPtr
= Jim_NewIntObj(interp
, i
);
17574 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
17575 if (retval
!= JIM_OK
) {
17576 Jim_FreeNewObj(interp
, objPtr
);
17582 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
17583 Jim_SetEmptyResult(interp
);
17589 /* foreach + lmap implementation. */
17590 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
17592 int result
= JIM_ERR
, i
, nbrOfLists
, *listsIdx
, *listsEnd
;
17593 int nbrOfLoops
= 0;
17594 Jim_Obj
*emptyStr
, *script
, *mapRes
= NULL
;
17596 if (argc
< 4 || argc
% 2 != 0) {
17597 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
17601 mapRes
= Jim_NewListObj(interp
, NULL
, 0);
17602 Jim_IncrRefCount(mapRes
);
17604 emptyStr
= Jim_NewEmptyStringObj(interp
);
17605 Jim_IncrRefCount(emptyStr
);
17606 script
= argv
[argc
- 1]; /* Last argument is a script */
17607 nbrOfLists
= (argc
- 1 - 1) / 2; /* argc - 'foreach' - script */
17608 listsIdx
= (int *)Jim_Alloc(nbrOfLists
* sizeof(int));
17609 listsEnd
= (int *)Jim_Alloc(nbrOfLists
* 2 * sizeof(int));
17610 /* Initialize iterators and remember max nbr elements each list */
17611 memset(listsIdx
, 0, nbrOfLists
* sizeof(int));
17612 /* Remember lengths of all lists and calculate how much rounds to loop */
17613 for (i
= 0; i
< nbrOfLists
* 2; i
+= 2) {
17617 listsEnd
[i
] = Jim_ListLength(interp
, argv
[i
+ 1]);
17618 listsEnd
[i
+ 1] = Jim_ListLength(interp
, argv
[i
+ 2]);
17619 if (listsEnd
[i
] == 0) {
17620 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
17623 cnt
= div(listsEnd
[i
+ 1], listsEnd
[i
]);
17624 count
= cnt
.quot
+ (cnt
.rem
? 1 : 0);
17625 if (count
> nbrOfLoops
)
17626 nbrOfLoops
= count
;
17628 for (; nbrOfLoops
-- > 0;) {
17629 for (i
= 0; i
< nbrOfLists
; ++i
) {
17630 int varIdx
= 0, var
= i
* 2;
17632 while (varIdx
< listsEnd
[var
]) {
17633 Jim_Obj
*varName
, *ele
;
17634 int lst
= i
* 2 + 1;
17636 /* List index operations below can't fail */
17637 Jim_ListIndex(interp
, argv
[var
+ 1], varIdx
, &varName
, JIM_NONE
);
17638 if (listsIdx
[i
] < listsEnd
[lst
]) {
17639 Jim_ListIndex(interp
, argv
[lst
+ 1], listsIdx
[i
], &ele
, JIM_NONE
);
17640 /* Avoid shimmering */
17641 Jim_IncrRefCount(ele
);
17642 result
= Jim_SetVariable(interp
, varName
, ele
);
17643 Jim_DecrRefCount(interp
, ele
);
17644 if (result
== JIM_OK
) {
17645 ++listsIdx
[i
]; /* Remember next iterator of current list */
17646 ++varIdx
; /* Next variable */
17650 else if (Jim_SetVariable(interp
, varName
, emptyStr
) == JIM_OK
) {
17651 ++varIdx
; /* Next variable */
17657 switch (result
= Jim_EvalObj(interp
, script
)) {
17660 Jim_ListAppendElement(interp
, mapRes
, interp
->result
);
17674 Jim_SetResult(interp
, mapRes
);
17676 Jim_SetEmptyResult(interp
);
17679 Jim_DecrRefCount(interp
, mapRes
);
17680 Jim_DecrRefCount(interp
, emptyStr
);
17681 Jim_Free(listsIdx
);
17682 Jim_Free(listsEnd
);
17687 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17689 return JimForeachMapHelper(interp
, argc
, argv
, 0);
17693 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17695 return JimForeachMapHelper(interp
, argc
, argv
, 1);
17699 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17701 int boolean
, retval
, current
= 1, falsebody
= 0;
17705 /* Far not enough arguments given! */
17706 if (current
>= argc
)
17708 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
17711 /* There lacks something, isn't it? */
17712 if (current
>= argc
)
17714 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
17716 /* Tsk tsk, no then-clause? */
17717 if (current
>= argc
)
17720 return Jim_EvalObj(interp
, argv
[current
]);
17721 /* Ok: no else-clause follows */
17722 if (++current
>= argc
) {
17723 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
17726 falsebody
= current
++;
17727 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
17728 /* IIICKS - else-clause isn't last cmd? */
17729 if (current
!= argc
- 1)
17731 return Jim_EvalObj(interp
, argv
[current
]);
17733 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
17734 /* Ok: elseif follows meaning all the stuff
17735 * again (how boring...) */
17737 /* OOPS - else-clause is not last cmd? */
17738 else if (falsebody
!= argc
- 1)
17740 return Jim_EvalObj(interp
, argv
[falsebody
]);
17745 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
17750 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
17751 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
17752 Jim_Obj
*stringObj
, int nocase
)
17759 parms
[argc
++] = commandObj
;
17761 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
17763 parms
[argc
++] = patternObj
;
17764 parms
[argc
++] = stringObj
;
17766 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
17768 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
17776 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
17779 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17781 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
17782 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
17783 Jim_Obj
*script
= 0;
17787 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
17788 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
17791 for (opt
= 1; opt
< argc
; ++opt
) {
17792 const char *option
= Jim_GetString(argv
[opt
], 0);
17794 if (*option
!= '-')
17796 else if (strncmp(option
, "--", 2) == 0) {
17800 else if (strncmp(option
, "-exact", 2) == 0)
17801 matchOpt
= SWITCH_EXACT
;
17802 else if (strncmp(option
, "-glob", 2) == 0)
17803 matchOpt
= SWITCH_GLOB
;
17804 else if (strncmp(option
, "-regexp", 2) == 0)
17805 matchOpt
= SWITCH_RE
;
17806 else if (strncmp(option
, "-command", 2) == 0) {
17807 matchOpt
= SWITCH_CMD
;
17808 if ((argc
- opt
) < 2)
17810 command
= argv
[++opt
];
17813 Jim_SetResultFormatted(interp
,
17814 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
17818 if ((argc
- opt
) < 2)
17821 strObj
= argv
[opt
++];
17822 patCount
= argc
- opt
;
17823 if (patCount
== 1) {
17826 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
17830 caseList
= &argv
[opt
];
17831 if (patCount
== 0 || patCount
% 2 != 0)
17833 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
17834 Jim_Obj
*patObj
= caseList
[i
];
17836 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
17837 || i
< (patCount
- 2)) {
17838 switch (matchOpt
) {
17840 if (Jim_StringEqObj(strObj
, patObj
))
17841 script
= caseList
[i
+ 1];
17844 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
17845 script
= caseList
[i
+ 1];
17848 command
= Jim_NewStringObj(interp
, "regexp", -1);
17849 /* Fall thru intentionally */
17851 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
17853 /* After the execution of a command we need to
17854 * make sure to reconvert the object into a list
17855 * again. Only for the single-list style [switch]. */
17856 if (argc
- opt
== 1) {
17859 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
17862 /* command is here already decref'd */
17867 script
= caseList
[i
+ 1];
17873 script
= caseList
[i
+ 1];
17876 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
17877 script
= caseList
[i
+ 1];
17878 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
17879 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
17882 Jim_SetEmptyResult(interp
);
17884 return Jim_EvalObj(interp
, script
);
17890 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17892 Jim_Obj
*listObjPtr
;
17894 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
17895 Jim_SetResult(interp
, listObjPtr
);
17900 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17902 Jim_Obj
*objPtr
, *listObjPtr
;
17907 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?...?");
17911 Jim_IncrRefCount(objPtr
);
17912 for (i
= 2; i
< argc
; i
++) {
17913 listObjPtr
= objPtr
;
17914 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
17915 Jim_DecrRefCount(interp
, listObjPtr
);
17918 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
17919 /* Returns an empty object if the index
17920 * is out of range. */
17921 Jim_DecrRefCount(interp
, listObjPtr
);
17922 Jim_SetEmptyResult(interp
);
17925 Jim_IncrRefCount(objPtr
);
17926 Jim_DecrRefCount(interp
, listObjPtr
);
17928 Jim_SetResult(interp
, objPtr
);
17929 Jim_DecrRefCount(interp
, objPtr
);
17934 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17937 Jim_WrongNumArgs(interp
, 1, argv
, "list");
17940 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
17945 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17947 static const char * const options
[] = {
17948 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
17952 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
17957 int opt_nocase
= 0;
17959 int opt_inline
= 0;
17960 int opt_match
= OPT_EXACT
;
17963 Jim_Obj
*listObjPtr
= NULL
;
17964 Jim_Obj
*commandObj
= NULL
;
17968 Jim_WrongNumArgs(interp
, 1, argv
,
17969 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
17973 for (i
= 1; i
< argc
- 2; i
++) {
17976 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
17998 if (i
>= argc
- 2) {
18001 commandObj
= argv
[++i
];
18006 opt_match
= option
;
18014 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18016 if (opt_match
== OPT_REGEXP
) {
18017 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
18020 Jim_IncrRefCount(commandObj
);
18023 listlen
= Jim_ListLength(interp
, argv
[0]);
18024 for (i
= 0; i
< listlen
; i
++) {
18028 Jim_ListIndex(interp
, argv
[0], i
, &objPtr
, JIM_NONE
);
18029 switch (opt_match
) {
18031 eq
= Jim_StringCompareObj(interp
, objPtr
, argv
[1], opt_nocase
) == 0;
18035 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
18040 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
18043 Jim_FreeNewObj(interp
, listObjPtr
);
18051 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
18052 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
18056 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
18057 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
18058 Jim_Obj
*resultObj
;
18061 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
18063 else if (!opt_inline
) {
18064 resultObj
= Jim_NewIntObj(interp
, i
);
18067 resultObj
= objPtr
;
18071 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
18074 Jim_SetResult(interp
, resultObj
);
18081 Jim_SetResult(interp
, listObjPtr
);
18086 Jim_SetResultBool(interp
, opt_not
);
18088 else if (!opt_inline
) {
18089 Jim_SetResultInt(interp
, -1);
18095 Jim_DecrRefCount(interp
, commandObj
);
18101 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18103 Jim_Obj
*listObjPtr
;
18107 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
18110 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
18112 /* Create the list if it does not exists */
18113 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18114 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
18115 Jim_FreeNewObj(interp
, listObjPtr
);
18119 shared
= Jim_IsShared(listObjPtr
);
18121 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
18122 for (i
= 2; i
< argc
; i
++)
18123 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
18124 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
18126 Jim_FreeNewObj(interp
, listObjPtr
);
18129 Jim_SetResult(interp
, listObjPtr
);
18134 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18140 Jim_WrongNumArgs(interp
, 1, argv
, "list index element " "?element ...?");
18144 if (Jim_IsShared(listPtr
))
18145 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
18146 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
18148 len
= Jim_ListLength(interp
, listPtr
);
18152 idx
= len
+ idx
+ 1;
18153 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
18154 Jim_SetResult(interp
, listPtr
);
18157 if (listPtr
!= argv
[1]) {
18158 Jim_FreeNewObj(interp
, listPtr
);
18164 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18166 int first
, last
, len
, rangeLen
;
18168 Jim_Obj
*newListObj
;
18173 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element element ...?");
18176 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
18177 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
18182 len
= Jim_ListLength(interp
, listObj
);
18184 first
= JimRelToAbsIndex(len
, first
);
18185 last
= JimRelToAbsIndex(len
, last
);
18186 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
18188 /* Now construct a new list which consists of:
18189 * <elements before first> <supplied elements> <elements after last>
18192 /* Check to see if trying to replace past the end of the list */
18194 /* OK. Not past the end */
18196 else if (len
== 0) {
18197 /* Special for empty list, adjust first to 0 */
18201 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
18202 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
18206 newListObj
= Jim_NewListObj(interp
, NULL
, 0);
18208 shared
= Jim_IsShared(listObj
);
18210 listObj
= Jim_DuplicateObj(interp
, listObj
);
18213 /* Add the first set of elements */
18214 for (i
= 0; i
< first
; i
++) {
18215 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
18218 /* Add supplied elements */
18219 for (i
= 4; i
< argc
; i
++) {
18220 Jim_ListAppendElement(interp
, newListObj
, argv
[i
]);
18223 /* Add the remaining elements */
18224 for (i
= first
+ rangeLen
; i
< len
; i
++) {
18225 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
18227 Jim_SetResult(interp
, newListObj
);
18229 Jim_FreeNewObj(interp
, listObj
);
18235 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18238 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
18241 else if (argc
== 3) {
18242 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
18244 Jim_SetResult(interp
, argv
[2]);
18247 if (Jim_SetListIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1])
18254 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
18256 const char *options
[] = {
18257 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
18260 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_INDEX
};
18265 struct lsort_info info
;
18268 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
18272 info
.type
= JIM_LSORT_ASCII
;
18275 info
.command
= NULL
;
18276 info
.interp
= interp
;
18278 for (i
= 1; i
< (argc
- 1); i
++) {
18281 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
)
18286 info
.type
= JIM_LSORT_ASCII
;
18289 info
.type
= JIM_LSORT_NOCASE
;
18292 info
.type
= JIM_LSORT_INTEGER
;
18294 case OPT_INCREASING
:
18297 case OPT_DECREASING
:
18301 if (i
>= (argc
- 2)) {
18302 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
18305 info
.type
= JIM_LSORT_COMMAND
;
18306 info
.command
= argv
[i
+ 1];
18310 if (i
>= (argc
- 2)) {
18311 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
18314 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
18322 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
18323 retCode
= ListSortElements(interp
, resObj
, &info
);
18324 if (retCode
== JIM_OK
) {
18325 Jim_SetResult(interp
, resObj
);
18328 Jim_FreeNewObj(interp
, resObj
);
18334 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18336 Jim_Obj
*stringObjPtr
;
18340 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
18344 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
18350 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
18351 if (!stringObjPtr
) {
18352 /* Create the string if it doesn't exist */
18353 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
18356 else if (Jim_IsShared(stringObjPtr
)) {
18358 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
18360 for (i
= 2; i
< argc
; i
++) {
18361 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
18363 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
18365 Jim_FreeNewObj(interp
, stringObjPtr
);
18370 Jim_SetResult(interp
, stringObjPtr
);
18375 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18377 #ifdef JIM_DEBUG_COMMAND
18378 const char *options
[] = {
18379 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
18385 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
18386 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
18391 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
18394 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
18396 if (option
== OPT_REFCOUNT
) {
18398 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18401 Jim_SetResultInt(interp
, argv
[2]->refCount
);
18404 else if (option
== OPT_OBJCOUNT
) {
18405 int freeobj
= 0, liveobj
= 0;
18410 Jim_WrongNumArgs(interp
, 2, argv
, "");
18413 /* Count the number of free objects. */
18414 objPtr
= interp
->freeList
;
18417 objPtr
= objPtr
->nextObjPtr
;
18419 /* Count the number of live objects. */
18420 objPtr
= interp
->liveList
;
18423 objPtr
= objPtr
->nextObjPtr
;
18425 /* Set the result string and return. */
18426 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
18427 Jim_SetResultString(interp
, buf
, -1);
18430 else if (option
== OPT_OBJECTS
) {
18431 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
18433 /* Count the number of live objects. */
18434 objPtr
= interp
->liveList
;
18435 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18438 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
18440 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18441 sprintf(buf
, "%p", objPtr
);
18442 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
18443 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
18444 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
18445 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
18446 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
18447 objPtr
= objPtr
->nextObjPtr
;
18449 Jim_SetResult(interp
, listObjPtr
);
18452 else if (option
== OPT_INVSTR
) {
18456 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18460 if (objPtr
->typePtr
!= NULL
)
18461 Jim_InvalidateStringRep(objPtr
);
18462 Jim_SetEmptyResult(interp
);
18465 else if (option
== OPT_SHOW
) {
18470 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18473 s
= Jim_GetString(argv
[2], &len
);
18474 charlen
= Jim_Utf8Length(interp
, argv
[2]);
18475 printf("chars (%d): <<%s>>\n", charlen
, s
);
18476 printf("bytes (%d):", len
);
18478 printf(" %02x", (unsigned char)*s
++);
18483 else if (option
== OPT_SCRIPTLEN
) {
18487 Jim_WrongNumArgs(interp
, 2, argv
, "script");
18490 script
= Jim_GetScript(interp
, argv
[2]);
18491 Jim_SetResultInt(interp
, script
->len
);
18494 else if (option
== OPT_EXPRLEN
) {
18495 ExprByteCode
*expr
;
18498 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
18501 expr
= JimGetExpression(interp
, argv
[2]);
18504 Jim_SetResultInt(interp
, expr
->len
);
18507 else if (option
== OPT_EXPRBC
) {
18509 ExprByteCode
*expr
;
18513 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
18516 expr
= JimGetExpression(interp
, argv
[2]);
18519 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
18520 for (i
= 0; i
< expr
->len
; i
++) {
18522 const Jim_ExprOperator
*op
;
18523 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
18525 switch (expr
->token
[i
].type
) {
18526 case JIM_TT_EXPR_INT
:
18529 case JIM_TT_EXPR_DOUBLE
:
18538 case JIM_TT_DICTSUGAR
:
18539 type
= "dictsugar";
18541 case JIM_TT_EXPRSUGAR
:
18542 type
= "exprsugar";
18551 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
18558 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
18561 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
18562 Jim_ListAppendElement(interp
, objPtr
, obj
);
18564 Jim_SetResult(interp
, objPtr
);
18568 Jim_SetResultString(interp
,
18569 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
18574 Jim_SetResultString(interp
, "unsupported", -1);
18580 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18583 Jim_Stack
*prevLocalProcs
;
18586 Jim_WrongNumArgs(interp
, 1, argv
, "script ?...?");
18590 /* Install a new stack for local procs */
18591 prevLocalProcs
= interp
->localProcs
;
18592 interp
->localProcs
= NULL
;
18595 rc
= Jim_EvalObj(interp
, argv
[1]);
18598 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
18601 /* Delete any local procs */
18602 JimDeleteLocalProcs(interp
);
18603 interp
->localProcs
= prevLocalProcs
;
18605 if (rc
== JIM_ERR
) {
18606 /* eval is "interesting", so add a stack frame here */
18607 interp
->addStackTrace
++;
18613 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18617 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
18621 /* Save the old callframe pointer */
18622 savedCallFrame
= interp
->framePtr
;
18624 /* Lookup the target frame pointer */
18625 str
= Jim_String(argv
[1]);
18626 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
18627 targetCallFrame
=Jim_GetCallFrameByLevel(interp
, argv
[1]);
18632 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
18634 if (targetCallFrame
== NULL
) {
18639 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
18642 /* Eval the code in the target callframe. */
18643 interp
->framePtr
= targetCallFrame
;
18645 retcode
= Jim_EvalObj(interp
, argv
[1]);
18648 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
18649 Jim_IncrRefCount(objPtr
);
18650 retcode
= Jim_EvalObj(interp
, objPtr
);
18651 Jim_DecrRefCount(interp
, objPtr
);
18653 interp
->framePtr
= savedCallFrame
;
18657 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
18663 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18665 Jim_Obj
*exprResultPtr
;
18669 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
18671 else if (argc
> 2) {
18674 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
18675 Jim_IncrRefCount(objPtr
);
18676 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
18677 Jim_DecrRefCount(interp
, objPtr
);
18680 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
18683 if (retcode
!= JIM_OK
)
18685 Jim_SetResult(interp
, exprResultPtr
);
18686 Jim_DecrRefCount(interp
, exprResultPtr
);
18691 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18694 Jim_WrongNumArgs(interp
, 1, argv
, "");
18701 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18704 Jim_WrongNumArgs(interp
, 1, argv
, "");
18707 return JIM_CONTINUE
;
18711 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18714 Jim_Obj
*stackTraceObj
= NULL
;
18715 Jim_Obj
*errorCodeObj
= NULL
;
18716 int returnCode
= JIM_OK
;
18719 for (i
= 1; i
< argc
- 1; i
+= 2) {
18720 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
18721 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
18725 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
18726 stackTraceObj
= argv
[i
+ 1];
18728 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
18729 errorCodeObj
= argv
[i
+ 1];
18731 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
18732 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
18733 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
18742 if (i
!= argc
- 1 && i
!= argc
) {
18743 Jim_WrongNumArgs(interp
, 1, argv
,
18744 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
18747 /* If a stack trace is supplied and code is error, set the stack trace */
18748 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
18749 JimSetStackTrace(interp
, stackTraceObj
);
18751 /* If an error code list is supplied, set the global $errorCode */
18752 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
18753 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
18755 interp
->returnCode
= returnCode
;
18756 interp
->returnLevel
= level
;
18758 if (i
== argc
- 1) {
18759 Jim_SetResult(interp
, argv
[i
]);
18765 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18769 objPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
18770 Jim_SetResult(interp
, objPtr
);
18775 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18778 int leftArity
, rightArity
;
18780 int optionalArgs
= 0;
18783 if (argc
!= 4 && argc
!= 5) {
18784 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
18788 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
18792 argListLen
= Jim_ListLength(interp
, argv
[2]);
18796 /* Examine the argument list for default parameters and 'args' */
18797 for (i
= 0; i
< argListLen
; i
++) {
18801 /* Examine a parameter */
18802 Jim_ListIndex(interp
, argv
[2], i
, &argPtr
, JIM_NONE
);
18803 len
= Jim_ListLength(interp
, argPtr
);
18805 Jim_SetResultString(interp
, "procedure has argument with no name", -1);
18809 Jim_SetResultString(interp
, "procedure has argument with too many fields", -1);
18814 /* May be {args newname} */
18815 Jim_ListIndex(interp
, argPtr
, 0, &argPtr
, JIM_NONE
);
18818 if (Jim_CompareStringImmediate(interp
, argPtr
, "args")) {
18820 Jim_SetResultString(interp
, "procedure has 'args' specified more than once", -1);
18824 Jim_SetResultString(interp
, "procedure has 'args' in invalid position", -1);
18831 /* Does this parameter have a default? */
18833 /* A required arg. Is it part of leftArity or rightArity? */
18834 if (optionalArgs
|| args
) {
18842 /* Optional arg. Can't be after rightArity */
18843 if (rightArity
|| args
) {
18844 Jim_SetResultString(interp
, "procedure has optional arg in invalid position", -1);
18852 return JimCreateProcedure(interp
, Jim_String(argv
[1]),
18853 argv
[2], NULL
, argv
[3], leftArity
, optionalArgs
, args
, rightArity
);
18856 return JimCreateProcedure(interp
, Jim_String(argv
[1]),
18857 argv
[2], argv
[3], argv
[4], leftArity
, optionalArgs
, args
, rightArity
);
18862 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18866 /* Evaluate the arguments with 'local' in force */
18868 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
18872 /* If OK, and the result is a proc, add it to the list of local procs */
18873 if (retcode
== 0) {
18874 const char *procname
= Jim_String(Jim_GetResult(interp
));
18876 if (Jim_FindHashEntry(&interp
->commands
, procname
) == NULL
) {
18877 Jim_SetResultFormatted(interp
, "not a proc: \"%s\"", procname
);
18880 if (interp
->localProcs
== NULL
) {
18881 interp
->localProcs
= Jim_Alloc(sizeof(*interp
->localProcs
));
18882 Jim_InitStack(interp
->localProcs
);
18884 Jim_StackPush(interp
->localProcs
, Jim_StrDup(procname
));
18891 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18894 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
18900 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
18901 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->u
.proc
.prevCmd
) {
18902 Jim_SetResultFormatted(interp
, "no previous proc: \"%#s\"", argv
[1]);
18905 /* OK. Mark this command as being in an upcall */
18906 cmdPtr
->u
.proc
.upcall
++;
18907 JimIncrCmdRefCount(cmdPtr
);
18909 /* Invoke the command as normal */
18910 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
18912 /* No longer in an upcall */
18913 cmdPtr
->u
.proc
.upcall
--;
18914 JimDecrCmdRefCount(interp
, cmdPtr
);
18921 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18923 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
18928 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18931 Jim_CallFrame
*targetCallFrame
;
18933 /* Lookup the target frame pointer */
18934 if (argc
> 3 && (argc
% 2 == 0)) {
18935 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
18940 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
18942 if (targetCallFrame
== NULL
) {
18946 /* Check for arity */
18948 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
18952 /* Now... for every other/local couple: */
18953 for (i
= 1; i
< argc
; i
+= 2) {
18954 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
18961 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18966 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
18969 /* Link every var to the toplevel having the same name */
18970 if (interp
->framePtr
->level
== 0)
18971 return JIM_OK
; /* global at toplevel... */
18972 for (i
= 1; i
< argc
; i
++) {
18973 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
18979 /* does the [string map] operation. On error NULL is returned,
18980 * otherwise a new string object with the result, having refcount = 0,
18982 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
18983 Jim_Obj
*objPtr
, int nocase
)
18986 const char *str
, *noMatchStart
= NULL
;
18988 Jim_Obj
*resultObjPtr
;
18990 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
18992 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
18996 str
= Jim_String(objPtr
);
18997 strLen
= Jim_Utf8Length(interp
, objPtr
);
19000 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
19002 for (i
= 0; i
< numMaps
; i
+= 2) {
19007 Jim_ListIndex(interp
, mapListObjPtr
, i
, &objPtr
, JIM_NONE
);
19008 k
= Jim_String(objPtr
);
19009 kl
= Jim_Utf8Length(interp
, objPtr
);
19011 if (strLen
>= kl
&& kl
) {
19014 rc
= JimStringCompareNoCase(str
, k
, kl
);
19017 rc
= JimStringCompare(str
, kl
, k
, kl
);
19020 if (noMatchStart
) {
19021 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
19022 noMatchStart
= NULL
;
19024 Jim_ListIndex(interp
, mapListObjPtr
, i
+ 1, &objPtr
, JIM_NONE
);
19025 Jim_AppendObj(interp
, resultObjPtr
, objPtr
);
19026 str
+= utf8_index(str
, kl
);
19032 if (i
== numMaps
) { /* no match */
19034 if (noMatchStart
== NULL
)
19035 noMatchStart
= str
;
19036 str
+= utf8_tounicode(str
, &c
);
19040 if (noMatchStart
) {
19041 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
19043 return resultObjPtr
;
19047 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19052 static const char * const options
[] = {
19053 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "map",
19054 "repeat", "reverse", "index", "first", "last",
19055 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
19059 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_MAP
,
19060 OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
,
19061 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
19063 static const char * const nocase_options
[] = {
19068 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
19071 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
19072 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
19077 case OPT_BYTELENGTH
:
19079 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19082 if (option
== OPT_LENGTH
) {
19083 len
= Jim_Utf8Length(interp
, argv
[2]);
19086 len
= Jim_Length(argv
[2]);
19088 Jim_SetResultInt(interp
, len
);
19095 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19096 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19097 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? string1 string2");
19100 if (opt_case
== 0) {
19103 if (option
== OPT_COMPARE
|| !opt_case
) {
19104 Jim_SetResultInt(interp
, Jim_StringCompareObj(interp
, argv
[2], argv
[3], !opt_case
));
19107 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[2], argv
[3]));
19114 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19115 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19116 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
19119 if (opt_case
== 0) {
19122 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
19130 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19131 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19132 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
19136 if (opt_case
== 0) {
19139 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
19140 if (objPtr
== NULL
) {
19143 Jim_SetResult(interp
, objPtr
);
19148 case OPT_BYTERANGE
:{
19152 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
19155 if (option
== OPT_RANGE
) {
19156 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
19160 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
19163 if (objPtr
== NULL
) {
19166 Jim_SetResult(interp
, objPtr
);
19175 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
19178 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
19181 objPtr
= Jim_NewStringObj(interp
, "", 0);
19184 Jim_AppendObj(interp
, objPtr
, argv
[2]);
19187 Jim_SetResult(interp
, objPtr
);
19198 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19202 str
= Jim_GetString(argv
[2], &len
);
19207 buf
= Jim_Alloc(len
+ 1);
19210 for (i
= 0; i
< len
; ) {
19212 int l
= utf8_tounicode(str
, &c
);
19213 memcpy(p
- l
, str
, l
);
19218 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
19227 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
19230 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
19233 str
= Jim_String(argv
[2]);
19234 len
= Jim_Utf8Length(interp
, argv
[2]);
19235 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
19236 idx
= JimRelToAbsIndex(len
, idx
);
19238 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
19239 Jim_SetResultString(interp
, "", 0);
19241 else if (len
== Jim_Length(argv
[2])) {
19242 /* ASCII optimisation */
19243 Jim_SetResultString(interp
, str
+ idx
, 1);
19247 int i
= utf8_index(str
, idx
);
19248 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
19255 int idx
= 0, l1
, l2
;
19256 const char *s1
, *s2
;
19258 if (argc
!= 4 && argc
!= 5) {
19259 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
19262 s1
= Jim_String(argv
[2]);
19263 s2
= Jim_String(argv
[3]);
19264 l1
= Jim_Utf8Length(interp
, argv
[2]);
19265 l2
= Jim_Utf8Length(interp
, argv
[3]);
19267 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
19270 idx
= JimRelToAbsIndex(l2
, idx
);
19272 else if (option
== OPT_LAST
) {
19275 if (option
== OPT_FIRST
) {
19276 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
19280 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
19282 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
19290 case OPT_TRIMRIGHT
:{
19291 Jim_Obj
*trimchars
;
19293 if (argc
!= 3 && argc
!= 4) {
19294 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
19297 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
19298 if (option
== OPT_TRIM
) {
19299 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
19301 else if (option
== OPT_TRIMLEFT
) {
19302 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
19304 else if (option
== OPT_TRIMRIGHT
) {
19305 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
19313 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19316 if (option
== OPT_TOLOWER
) {
19317 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
19320 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
19325 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
19326 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
19328 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
19335 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19338 jim_wide start
, elapsed
;
19340 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
19343 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
19347 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
19353 start
= JimClock();
19357 retval
= Jim_EvalObj(interp
, argv
[1]);
19358 if (retval
!= JIM_OK
) {
19362 elapsed
= JimClock() - start
;
19363 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
19364 Jim_SetResultString(interp
, buf
, -1);
19369 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19374 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
19378 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
19381 interp
->exitCode
= exitCode
;
19386 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19392 /* Which return codes are caught? These are the defaults */
19394 (1 << JIM_OK
| 1 << JIM_ERR
| 1 << JIM_BREAK
| 1 << JIM_CONTINUE
| 1 << JIM_RETURN
);
19396 /* Reset the error code before catch.
19397 * Note that this is not strictly correct.
19399 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
19401 for (i
= 1; i
< argc
- 1; i
++) {
19402 const char *arg
= Jim_String(argv
[i
]);
19406 /* It's a pity we can't use Jim_GetEnum here :-( */
19407 if (strcmp(arg
, "--") == 0) {
19415 if (strncmp(arg
, "-no", 3) == 0) {
19424 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
19428 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
19435 mask
|= (1 << option
);
19438 mask
&= ~(1 << option
);
19443 if (argc
< 1 || argc
> 3) {
19445 Jim_WrongNumArgs(interp
, 1, argv
,
19446 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
19451 if (mask
& (1 << JIM_SIGNAL
)) {
19455 interp
->signal_level
+= sig
;
19456 if (interp
->signal_level
&& interp
->sigmask
) {
19457 /* If a signal is set, don't even try to execute the body */
19458 exitCode
= JIM_SIGNAL
;
19461 exitCode
= Jim_EvalObj(interp
, argv
[0]);
19463 interp
->signal_level
-= sig
;
19465 /* Catch or pass through? Only the first 64 codes can be passed through */
19466 if (exitCode
>= 0 && exitCode
< (int)sizeof(mask
) && ((1 << exitCode
) & mask
) == 0) {
19467 /* Not caught, pass it up */
19471 if (sig
&& exitCode
== JIM_SIGNAL
) {
19472 /* Catch the signal at this level */
19473 if (interp
->signal_set_result
) {
19474 interp
->signal_set_result(interp
, interp
->sigmask
);
19477 Jim_SetResultInt(interp
, interp
->sigmask
);
19479 interp
->sigmask
= 0;
19483 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
19487 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
19489 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
19490 Jim_ListAppendElement(interp
, optListObj
,
19491 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
19492 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
19493 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
19494 if (exitCode
== JIM_ERR
) {
19495 Jim_Obj
*errorCode
;
19496 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
19498 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
19500 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
19502 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
19503 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
19506 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
19511 Jim_SetResultInt(interp
, exitCode
);
19515 #ifdef JIM_REFERENCES
19518 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19520 if (argc
!= 3 && argc
!= 4) {
19521 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
19525 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
19528 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
19534 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19536 Jim_Reference
*refPtr
;
19539 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
19542 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
19544 Jim_SetResult(interp
, refPtr
->objPtr
);
19549 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19551 Jim_Reference
*refPtr
;
19554 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
19557 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
19559 Jim_IncrRefCount(argv
[2]);
19560 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
19561 refPtr
->objPtr
= argv
[2];
19562 Jim_SetResult(interp
, argv
[2]);
19567 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19570 Jim_WrongNumArgs(interp
, 1, argv
, "");
19573 Jim_SetResultInt(interp
, Jim_Collect(interp
));
19575 /* Free all the freed objects. */
19576 while (interp
->freeList
) {
19577 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
19578 Jim_Free(interp
->freeList
);
19579 interp
->freeList
= nextObjPtr
;
19585 /* [finalize] reference ?newValue? */
19586 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19588 if (argc
!= 2 && argc
!= 3) {
19589 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
19593 Jim_Obj
*cmdNamePtr
;
19595 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
19597 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
19598 Jim_SetResult(interp
, cmdNamePtr
);
19601 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
19603 Jim_SetResult(interp
, argv
[2]);
19608 /* [info references] */
19609 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19611 Jim_Obj
*listObjPtr
;
19612 Jim_HashTableIterator
*htiter
;
19615 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
19617 htiter
= Jim_GetHashTableIterator(&interp
->references
);
19618 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
19619 char buf
[JIM_REFERENCE_SPACE
];
19620 Jim_Reference
*refPtr
= he
->u
.val
;
19621 const jim_wide
*refId
= he
->key
;
19623 JimFormatReference(buf
, refPtr
, *refId
);
19624 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
19626 Jim_FreeHashTableIterator(htiter
);
19627 Jim_SetResult(interp
, listObjPtr
);
19633 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19635 const char *oldName
, *newName
;
19638 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
19642 if (JimValidName(interp
, "new procedure", argv
[2])) {
19646 oldName
= Jim_String(argv
[1]);
19647 newName
= Jim_String(argv
[2]);
19648 return Jim_RenameCommand(interp
, oldName
, newName
);
19651 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObj
)
19655 Jim_Obj
*resultObj
;
19657 Jim_Obj
**dictValuesObj
;
19659 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
19663 /* XXX: Could make the exact-match case much more efficient here.
19664 * See JimCommandsList()
19666 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
19670 /* Only return the matching values */
19671 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
19673 for (i
= 0; i
< len
; i
+= 2) {
19674 if (patternObj
== NULL
|| Jim_StringMatchObj(interp
, patternObj
, dictValuesObj
[i
], 0)) {
19675 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
]);
19678 Jim_Free(dictValuesObj
);
19680 Jim_SetResult(interp
, resultObj
);
19684 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
19686 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
19689 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
19693 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19697 const char *options
[] = {
19698 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
19702 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXIST
, OPT_KEYS
, OPT_MERGE
, OPT_SIZE
, OPT_WITH
,
19706 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
19710 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
19717 Jim_WrongNumArgs(interp
, 2, argv
, "varName ?key ...?");
19720 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
19721 JIM_ERRMSG
) != JIM_OK
) {
19724 Jim_SetResult(interp
, objPtr
);
19729 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
19732 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1]);
19736 Jim_WrongNumArgs(interp
, 2, argv
, "varName ?key ...?");
19739 Jim_SetResultBool(interp
, Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3,
19740 &objPtr
, JIM_ERRMSG
) == JIM_OK
);
19745 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
19748 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
);
19751 if (argc
!= 3 && argc
!= 4) {
19752 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?pattern?");
19755 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
19761 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar");
19765 size
= Jim_DictSize(interp
, argv
[2]);
19769 Jim_SetResultInt(interp
, size
);
19777 else if (argv
[2]->typePtr
!= &dictObjType
&& SetDictFromAny(interp
, argv
[2]) != JIM_OK
) {
19781 return Jim_EvalObjPrefix(interp
, "dict merge", argc
- 2, argv
+ 2);
19786 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?key ...? script");
19789 else if (Jim_GetVariable(interp
, argv
[2], JIM_ERRMSG
) == NULL
) {
19793 return Jim_EvalObjPrefix(interp
, "dict with", argc
- 2, argv
+ 2);
19798 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
19801 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
19802 Jim_SetResult(interp
, objPtr
);
19811 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19813 const char *options
[] = {
19814 "-nobackslashes", "-nocommands", "-novariables", NULL
19817 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
19819 int flags
= JIM_SUBST_FLAG
;
19823 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
19826 for (i
= 1; i
< (argc
- 1); i
++) {
19829 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
19830 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
19834 case OPT_NOBACKSLASHES
:
19835 flags
|= JIM_SUBST_NOESC
;
19837 case OPT_NOCOMMANDS
:
19838 flags
|= JIM_SUBST_NOCMD
;
19840 case OPT_NOVARIABLES
:
19841 flags
|= JIM_SUBST_NOVAR
;
19845 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
19848 Jim_SetResult(interp
, objPtr
);
19853 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19859 static const char * const commands
[] = {
19860 "body", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
19861 "vars", "version", "patchlevel", "complete", "args", "hostname",
19862 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
19866 { INFO_BODY
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
19867 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
19868 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
19869 INFO_RETURNCODES
, INFO_REFERENCES
,
19873 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
19876 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
19881 /* Test for the the most common commands first, just in case it makes a difference */
19885 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
19888 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
19892 case INFO_CHANNELS
:
19893 #ifndef jim_ext_aio
19894 Jim_SetResultString(interp
, "aio not enabled", -1);
19897 case INFO_COMMANDS
:
19899 if (argc
!= 2 && argc
!= 3) {
19900 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
19903 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
,
19904 (cmd
- INFO_COMMANDS
)));
19908 mode
++; /* JIM_VARLIST_VARS */
19910 mode
++; /* JIM_VARLIST_LOCALS */
19912 /* mode 0 => JIM_VARLIST_GLOBALS */
19913 if (argc
!= 2 && argc
!= 3) {
19914 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
19917 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
19922 Jim_WrongNumArgs(interp
, 2, argv
, "");
19925 Jim_SetResultString(interp
, Jim_GetScript(interp
, interp
->currentScriptObj
)->fileName
,
19930 const char *filename
= "";
19932 Jim_Obj
*resObjPtr
;
19935 Jim_WrongNumArgs(interp
, 2, argv
, "source");
19938 if (argv
[2]->typePtr
== &sourceObjType
) {
19939 filename
= argv
[2]->internalRep
.sourceValue
.fileName
;
19940 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
19942 else if (argv
[2]->typePtr
== &scriptObjType
) {
19943 ScriptObj
*script
= Jim_GetScript(interp
, argv
[2]);
19944 filename
= script
->fileName
;
19945 line
= script
->line
;
19947 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
19948 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObj(interp
, filename
, -1));
19949 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
19950 Jim_SetResult(interp
, resObjPtr
);
19954 case INFO_STACKTRACE
:
19955 Jim_SetResult(interp
, interp
->stackTrace
);
19962 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
19966 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
19969 Jim_SetResult(interp
, objPtr
);
19973 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
19983 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
19986 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
19989 if (!cmdPtr
->isproc
) {
19990 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
19993 Jim_SetResult(interp
,
19994 cmd
== INFO_BODY
? cmdPtr
->u
.proc
.bodyObjPtr
: cmdPtr
->u
.proc
.argListObjPtr
);
19999 case INFO_PATCHLEVEL
:{
20000 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
20002 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
20003 Jim_SetResultString(interp
, buf
, -1);
20007 case INFO_COMPLETE
:
20008 if (argc
!= 3 && argc
!= 4) {
20009 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
20014 const char *s
= Jim_GetString(argv
[2], &len
);
20017 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
20018 if (missing
!= ' ' && argc
== 4) {
20019 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
20024 case INFO_HOSTNAME
:
20025 /* Redirect to os.gethostname if it exists */
20026 return Jim_Eval(interp
, "os.gethostname");
20028 case INFO_NAMEOFEXECUTABLE
:
20029 /* Redirect to Tcl proc */
20030 return Jim_Eval(interp
, "{info nameofexecutable}");
20032 case INFO_RETURNCODES
:
20035 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20037 for (i
= 0; jimReturnCodes
[i
]; i
++) {
20038 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
20039 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
20040 jimReturnCodes
[i
], -1));
20043 Jim_SetResult(interp
, listObjPtr
);
20045 else if (argc
== 3) {
20049 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
20052 name
= Jim_ReturnCode(code
);
20053 if (*name
== '?') {
20054 Jim_SetResultInt(interp
, code
);
20057 Jim_SetResultString(interp
, name
, -1);
20061 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
20065 case INFO_REFERENCES
:
20066 #ifdef JIM_REFERENCES
20067 return JimInfoReferences(interp
, argc
, argv
);
20069 Jim_SetResultString(interp
, "not supported", -1);
20077 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20081 static const char * const options
[] = {
20082 "-command", "-proc", "-var", NULL
20086 OPT_COMMAND
, OPT_PROC
, OPT_VAR
20094 else if (argc
== 3) {
20095 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
20101 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
20105 /* Test for the the most common commands first, just in case it makes a difference */
20108 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, objPtr
, 0) != NULL
);
20113 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
20114 Jim_SetResultBool(interp
, cmd
!= NULL
&& (option
== OPT_COMMAND
|| cmd
->isproc
));
20122 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20124 const char *str
, *splitChars
, *noMatchStart
;
20125 int splitLen
, strLen
;
20126 Jim_Obj
*resObjPtr
;
20130 if (argc
!= 2 && argc
!= 3) {
20131 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
20135 str
= Jim_GetString(argv
[1], &len
);
20139 strLen
= Jim_Utf8Length(interp
, argv
[1]);
20143 splitChars
= " \n\t\r";
20147 splitChars
= Jim_String(argv
[2]);
20148 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
20151 noMatchStart
= str
;
20152 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20158 const char *sc
= splitChars
;
20159 int scLen
= splitLen
;
20160 int sl
= utf8_tounicode(str
, &c
);
20163 sc
+= utf8_tounicode(sc
, &pc
);
20165 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
20166 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
20167 noMatchStart
= str
+ sl
;
20173 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
20174 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
20177 /* This handles the special case of splitchars eq {}
20178 * Optimise by sharing common (ASCII) characters
20180 Jim_Obj
**commonObj
= NULL
;
20181 #define NUM_COMMON (128 - 9)
20183 int n
= utf8_tounicode(str
, &c
);
20184 #ifdef JIM_OPTIMIZATION
20185 if (c
>= 9 && c
< 128) {
20186 /* Common ASCII char. Note that 9 is the tab character */
20189 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
20190 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
20192 if (!commonObj
[c
]) {
20193 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
20195 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
20200 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
20203 Jim_Free(commonObj
);
20206 Jim_SetResult(interp
, resObjPtr
);
20211 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20213 const char *joinStr
;
20214 int joinStrLen
, i
, listLen
;
20215 Jim_Obj
*resObjPtr
;
20217 if (argc
!= 2 && argc
!= 3) {
20218 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
20227 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
20229 listLen
= Jim_ListLength(interp
, argv
[1]);
20230 resObjPtr
= Jim_NewStringObj(interp
, NULL
, 0);
20232 for (i
= 0; i
< listLen
; i
++) {
20233 Jim_Obj
*objPtr
= 0;
20235 Jim_ListIndex(interp
, argv
[1], i
, &objPtr
, JIM_NONE
);
20236 Jim_AppendObj(interp
, resObjPtr
, objPtr
);
20237 if (i
+ 1 != listLen
) {
20238 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
20241 Jim_SetResult(interp
, resObjPtr
);
20246 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20251 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
20254 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
20255 if (objPtr
== NULL
)
20257 Jim_SetResult(interp
, objPtr
);
20262 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20264 Jim_Obj
*listPtr
, **outVec
;
20268 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
20271 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
20272 SetScanFmtFromAny(interp
, argv
[2]);
20273 if (FormatGetError(argv
[2]) != 0) {
20274 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
20278 int maxPos
= FormatGetMaxPos(argv
[2]);
20279 int count
= FormatGetCnvCount(argv
[2]);
20281 if (maxPos
> argc
- 3) {
20282 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
20285 else if (count
> argc
- 3) {
20286 Jim_SetResultString(interp
, "different numbers of variable names and "
20287 "field specifiers", -1);
20290 else if (count
< argc
- 3) {
20291 Jim_SetResultString(interp
, "variable is not assigned by any "
20292 "conversion specifiers", -1);
20296 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
20303 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
20304 int len
= Jim_ListLength(interp
, listPtr
);
20307 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
20308 for (i
= 0; i
< outc
; ++i
) {
20309 if (Jim_Length(outVec
[i
]) > 0) {
20311 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
20317 Jim_FreeNewObj(interp
, listPtr
);
20322 if (rc
== JIM_OK
) {
20323 Jim_SetResultInt(interp
, count
);
20328 if (listPtr
== (Jim_Obj
*)EOF
) {
20329 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
20332 Jim_SetResult(interp
, listPtr
);
20338 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20340 if (argc
!= 2 && argc
!= 3) {
20341 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
20344 Jim_SetResult(interp
, argv
[1]);
20346 JimSetStackTrace(interp
, argv
[2]);
20349 interp
->addStackTrace
++;
20354 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20359 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
20362 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
20364 Jim_SetResult(interp
, objPtr
);
20369 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20374 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
20375 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
20379 if (count
== 0 || argc
== 2) {
20386 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
20390 for (i
= 0; i
< argc
; i
++) {
20391 ListAppendElement(objPtr
, argv
[i
]);
20395 Jim_SetResult(interp
, objPtr
);
20399 char **Jim_GetEnviron(void)
20401 #if defined(HAVE__NSGETENVIRON)
20402 return *_NSGetEnviron();
20404 #if !defined(NO_ENVIRON_EXTERN)
20405 extern char **environ
;
20412 void Jim_SetEnviron(char **env
)
20414 #if defined(HAVE__NSGETENVIRON)
20415 *_NSGetEnviron() = env
;
20417 #if !defined(NO_ENVIRON_EXTERN)
20418 extern char **environ
;
20426 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20432 char **e
= Jim_GetEnviron();
20435 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20437 for (i
= 0; e
[i
]; i
++) {
20438 const char *equals
= strchr(e
[i
], '=');
20441 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
20443 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
20447 Jim_SetResult(interp
, listObjPtr
);
20452 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
20455 key
= Jim_String(argv
[1]);
20459 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
20462 val
= Jim_String(argv
[2]);
20464 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
20469 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20474 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
20477 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
20478 if (retval
== JIM_RETURN
)
20484 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20486 Jim_Obj
*revObjPtr
, **ele
;
20490 Jim_WrongNumArgs(interp
, 1, argv
, "list");
20493 JimListGetElements(interp
, argv
[1], &len
, &ele
);
20495 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20497 ListAppendElement(revObjPtr
, ele
[len
--]);
20498 Jim_SetResult(interp
, revObjPtr
);
20502 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
20510 else if (step
> 0 && start
> end
)
20512 else if (step
< 0 && end
> start
)
20516 len
= -len
; /* abs(len) */
20518 step
= -step
; /* abs(step) */
20519 len
= 1 + ((len
- 1) / step
);
20520 /* We can truncate safely to INT_MAX, the range command
20521 * will always return an error for a such long range
20522 * because Tcl lists can't be so long. */
20525 return (int)((len
< 0) ? -1 : len
);
20529 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20531 jim_wide start
= 0, end
, step
= 1;
20535 if (argc
< 2 || argc
> 4) {
20536 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
20540 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
20544 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
20545 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
20547 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
20550 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
20551 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
20554 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
20555 for (i
= 0; i
< len
; i
++)
20556 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
20557 Jim_SetResult(interp
, objPtr
);
20562 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20564 jim_wide min
= 0, max
= 0, len
, maxMul
;
20566 if (argc
< 1 || argc
> 3) {
20567 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
20571 max
= JIM_WIDE_MAX
;
20572 } else if (argc
== 2) {
20573 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
20575 } else if (argc
== 3) {
20576 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
20577 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
20582 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
20585 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
20589 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
20590 if (r
< 0 || r
>= maxMul
) continue;
20591 r
= (len
== 0) ? 0 : r
%len
;
20592 Jim_SetResultInt(interp
, min
+r
);
20597 static const struct {
20599 Jim_CmdProc cmdProc
;
20600 } Jim_CoreCommandsTable
[] = {
20601 {"set", Jim_SetCoreCommand
},
20602 {"unset", Jim_UnsetCoreCommand
},
20603 {"puts", Jim_PutsCoreCommand
},
20604 {"+", Jim_AddCoreCommand
},
20605 {"*", Jim_MulCoreCommand
},
20606 {"-", Jim_SubCoreCommand
},
20607 {"/", Jim_DivCoreCommand
},
20608 {"incr", Jim_IncrCoreCommand
},
20609 {"while", Jim_WhileCoreCommand
},
20610 {"loop", Jim_LoopCoreCommand
},
20611 {"for", Jim_ForCoreCommand
},
20612 {"foreach", Jim_ForeachCoreCommand
},
20613 {"lmap", Jim_LmapCoreCommand
},
20614 {"if", Jim_IfCoreCommand
},
20615 {"switch", Jim_SwitchCoreCommand
},
20616 {"list", Jim_ListCoreCommand
},
20617 {"lindex", Jim_LindexCoreCommand
},
20618 {"lset", Jim_LsetCoreCommand
},
20619 {"lsearch", Jim_LsearchCoreCommand
},
20620 {"llength", Jim_LlengthCoreCommand
},
20621 {"lappend", Jim_LappendCoreCommand
},
20622 {"linsert", Jim_LinsertCoreCommand
},
20623 {"lreplace", Jim_LreplaceCoreCommand
},
20624 {"lsort", Jim_LsortCoreCommand
},
20625 {"append", Jim_AppendCoreCommand
},
20626 {"debug", Jim_DebugCoreCommand
},
20627 {"eval", Jim_EvalCoreCommand
},
20628 {"uplevel", Jim_UplevelCoreCommand
},
20629 {"expr", Jim_ExprCoreCommand
},
20630 {"break", Jim_BreakCoreCommand
},
20631 {"continue", Jim_ContinueCoreCommand
},
20632 {"proc", Jim_ProcCoreCommand
},
20633 {"concat", Jim_ConcatCoreCommand
},
20634 {"return", Jim_ReturnCoreCommand
},
20635 {"upvar", Jim_UpvarCoreCommand
},
20636 {"global", Jim_GlobalCoreCommand
},
20637 {"string", Jim_StringCoreCommand
},
20638 {"time", Jim_TimeCoreCommand
},
20639 {"exit", Jim_ExitCoreCommand
},
20640 {"catch", Jim_CatchCoreCommand
},
20641 #ifdef JIM_REFERENCES
20642 {"ref", Jim_RefCoreCommand
},
20643 {"getref", Jim_GetrefCoreCommand
},
20644 {"setref", Jim_SetrefCoreCommand
},
20645 {"finalize", Jim_FinalizeCoreCommand
},
20646 {"collect", Jim_CollectCoreCommand
},
20648 {"rename", Jim_RenameCoreCommand
},
20649 {"dict", Jim_DictCoreCommand
},
20650 {"subst", Jim_SubstCoreCommand
},
20651 {"info", Jim_InfoCoreCommand
},
20652 {"exists", Jim_ExistsCoreCommand
},
20653 {"split", Jim_SplitCoreCommand
},
20654 {"join", Jim_JoinCoreCommand
},
20655 {"format", Jim_FormatCoreCommand
},
20656 {"scan", Jim_ScanCoreCommand
},
20657 {"error", Jim_ErrorCoreCommand
},
20658 {"lrange", Jim_LrangeCoreCommand
},
20659 {"lrepeat", Jim_LrepeatCoreCommand
},
20660 {"env", Jim_EnvCoreCommand
},
20661 {"source", Jim_SourceCoreCommand
},
20662 {"lreverse", Jim_LreverseCoreCommand
},
20663 {"range", Jim_RangeCoreCommand
},
20664 {"rand", Jim_RandCoreCommand
},
20665 {"tailcall", Jim_TailcallCoreCommand
},
20666 {"local", Jim_LocalCoreCommand
},
20667 {"upcall", Jim_UpcallCoreCommand
},
20671 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
20675 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
20676 Jim_CreateCommand(interp
,
20677 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
20682 /* -----------------------------------------------------------------------------
20683 * Interactive prompt
20684 * ---------------------------------------------------------------------------*/
20685 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
20689 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
20690 argv
[1] = interp
->result
;
20692 Jim_EvalObjVector(interp
, 2, argv
);
20695 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
20696 const char *prefix
, const char *const *tablePtr
, const char *name
)
20699 char **tablePtrSorted
;
20702 for (count
= 0; tablePtr
[count
]; count
++) {
20705 if (name
== NULL
) {
20709 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
20710 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
20711 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
20712 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
20713 for (i
= 0; i
< count
; i
++) {
20714 if (i
+ 1 == count
&& count
> 1) {
20715 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
20717 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
20718 if (i
+ 1 != count
) {
20719 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
20722 Jim_Free(tablePtrSorted
);
20725 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
20726 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
20728 const char *bad
= "bad ";
20729 const char *const *entryPtr
= NULL
;
20733 const char *arg
= Jim_GetString(objPtr
, &arglen
);
20737 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
20738 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
20739 /* Found an exact match */
20743 if (flags
& JIM_ENUM_ABBREV
) {
20744 /* Accept an unambiguous abbreviation.
20745 * Note that '-' doesnt' consitute a valid abbreviation
20747 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
20748 if (*arg
== '-' && arglen
== 1) {
20752 bad
= "ambiguous ";
20760 /* If we had an unambiguous partial match */
20767 if (flags
& JIM_ERRMSG
) {
20768 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
20773 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
20777 for (i
= 0; i
< (int)len
; i
++) {
20778 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
20785 int Jim_IsDict(Jim_Obj
*objPtr
)
20787 return objPtr
->typePtr
== &dictObjType
;
20790 int Jim_IsList(Jim_Obj
*objPtr
)
20792 return objPtr
->typePtr
== &listObjType
;
20796 * Very simple printf-like formatting, designed for error messages.
20798 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
20799 * The resulting string is created and set as the result.
20801 * Each '%s' should correspond to a regular string parameter.
20802 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
20803 * Any other printf specifier is not allowed (but %% is allowed for the % character).
20805 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
20807 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
20809 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
20811 /* Initial space needed */
20812 int len
= strlen(format
);
20815 const char *params
[5];
20820 va_start(args
, format
);
20822 for (i
= 0; i
< len
&& n
< 5; i
++) {
20825 if (strncmp(format
+ i
, "%s", 2) == 0) {
20826 params
[n
] = va_arg(args
, char *);
20828 l
= strlen(params
[n
]);
20830 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
20831 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
20833 params
[n
] = Jim_GetString(objPtr
, &l
);
20836 if (format
[i
] == '%') {
20846 buf
= Jim_Alloc(len
+ 1);
20847 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
20849 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
20853 #ifndef jim_ext_package
20854 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
20859 #ifndef jim_ext_aio
20860 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
20862 Jim_SetResultString(interp
, "aio not enabled", -1);
20869 * Local Variables: ***
20870 * c-basic-offset: 4 ***
20875 #include <string.h>
20879 * Implements the common 'commands' subcommand
20881 static int subcmd_null(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20883 /* Nothing to do, since the result has already been created */
20888 * Do-nothing command to support -commands and -usage
20890 static const jim_subcmd_type dummy_subcmd
= {
20892 .function
= subcmd_null
,
20893 .flags
= JIM_MODFLAG_HIDDEN
,
20896 static void add_commands(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, const char *sep
)
20898 const char *s
= "";
20900 for (; ct
->cmd
; ct
++) {
20901 if (!(ct
->flags
& JIM_MODFLAG_HIDDEN
)) {
20902 Jim_AppendStrings(interp
, Jim_GetResult(interp
), s
, ct
->cmd
, NULL
);
20908 static void bad_subcmd(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, const char *type
,
20909 Jim_Obj
*cmd
, Jim_Obj
*subcmd
)
20911 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20912 Jim_AppendStrings(interp
, Jim_GetResult(interp
), Jim_String(cmd
), ", ", type
,
20913 " command \"", Jim_String(subcmd
), "\": should be ", NULL
);
20914 add_commands(interp
, command_table
, ", ");
20917 static void show_cmd_usage(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, int argc
,
20918 Jim_Obj
*const *argv
)
20920 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20921 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "Usage: \"", Jim_String(argv
[0]),
20922 " command ... \", where command is one of: ", NULL
);
20923 add_commands(interp
, command_table
, ", ");
20926 static void add_cmd_usage(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, Jim_Obj
*cmd
)
20929 Jim_AppendStrings(interp
, Jim_GetResult(interp
), Jim_String(cmd
), " ", NULL
);
20931 Jim_AppendStrings(interp
, Jim_GetResult(interp
), ct
->cmd
, NULL
);
20932 if (ct
->args
&& *ct
->args
) {
20933 Jim_AppendStrings(interp
, Jim_GetResult(interp
), " ", ct
->args
, NULL
);
20937 static void show_full_usage(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, int argc
,
20938 Jim_Obj
*const *argv
)
20940 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20941 for (; ct
->cmd
; ct
++) {
20942 if (!(ct
->flags
& JIM_MODFLAG_HIDDEN
)) {
20944 add_cmd_usage(interp
, ct
, argv
[0]);
20945 if (ct
->description
) {
20946 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n ", ct
->description
, NULL
);
20948 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", NULL
);
20953 static void set_wrong_args(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, Jim_Obj
*subcmd
)
20955 Jim_SetResultString(interp
, "wrong # args: must be \"", -1);
20956 add_cmd_usage(interp
, command_table
, subcmd
);
20957 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\"", NULL
);
20960 const jim_subcmd_type
*Jim_ParseSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
,
20961 int argc
, Jim_Obj
*const *argv
)
20963 const jim_subcmd_type
*ct
;
20964 const jim_subcmd_type
*partial
= 0;
20967 const char *cmdstr
;
20968 const char *cmdname
;
20971 cmdname
= Jim_String(argv
[0]);
20974 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20975 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "wrong # args: should be \"", cmdname
,
20976 " command ...\"\n", NULL
);
20977 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "Use \"", cmdname
, " -help\" or \"",
20978 cmdname
, " -help command\" for help", NULL
);
20984 if (argc
== 2 && Jim_CompareStringImmediate(interp
, cmd
, "-usage")) {
20985 /* Show full usage */
20986 show_full_usage(interp
, command_table
, argc
, argv
);
20987 return &dummy_subcmd
;
20990 /* Check for the help command */
20991 if (Jim_CompareStringImmediate(interp
, cmd
, "-help")) {
20993 /* Usage for the command, not the subcommand */
20994 show_cmd_usage(interp
, command_table
, argc
, argv
);
20995 return &dummy_subcmd
;
20999 /* Skip the 'help' command */
21003 /* Check for special builtin '-commands' command first */
21004 if (Jim_CompareStringImmediate(interp
, cmd
, "-commands")) {
21005 /* Build the result here */
21006 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
21007 add_commands(interp
, command_table
, " ");
21008 return &dummy_subcmd
;
21011 cmdstr
= Jim_GetString(cmd
, &cmdlen
);
21013 for (ct
= command_table
; ct
->cmd
; ct
++) {
21014 if (Jim_CompareStringImmediate(interp
, cmd
, ct
->cmd
)) {
21015 /* Found an exact match */
21018 if (strncmp(cmdstr
, ct
->cmd
, cmdlen
) == 0) {
21022 /* Just show the top level help here */
21023 show_cmd_usage(interp
, command_table
, argc
, argv
);
21024 return &dummy_subcmd
;
21026 bad_subcmd(interp
, command_table
, "ambiguous", argv
[0], argv
[1 + help
]);
21034 /* If we had an unambiguous partial match */
21035 if (partial
&& !ct
->cmd
) {
21040 /* No matching command */
21042 /* Just show the top level help here */
21043 show_cmd_usage(interp
, command_table
, argc
, argv
);
21044 return &dummy_subcmd
;
21046 bad_subcmd(interp
, command_table
, "unknown", argv
[0], argv
[1 + help
]);
21051 Jim_SetResultString(interp
, "Usage: ", -1);
21053 add_cmd_usage(interp
, ct
, argv
[0]);
21054 if (ct
->description
) {
21055 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", ct
->description
, NULL
);
21057 return &dummy_subcmd
;
21060 /* Check the number of args */
21061 if (argc
- 2 < ct
->minargs
|| (ct
->maxargs
>= 0 && argc
- 2 > ct
->maxargs
)) {
21062 Jim_SetResultString(interp
, "wrong # args: must be \"", -1);
21064 add_cmd_usage(interp
, ct
, argv
[0]);
21065 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\"", NULL
);
21074 int Jim_CallSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, int argc
, Jim_Obj
*const *argv
)
21079 if (ct
->flags
& JIM_MODFLAG_FULLARGV
) {
21080 ret
= ct
->function(interp
, argc
, argv
);
21083 ret
= ct
->function(interp
, argc
- 2, argv
+ 2);
21086 set_wrong_args(interp
, ct
, argv
[0]);
21093 int Jim_SubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
21095 const jim_subcmd_type
*ct
=
21096 Jim_ParseSubCmd(interp
, (const jim_subcmd_type
*)Jim_CmdPrivData(interp
), argc
, argv
);
21098 return Jim_CallSubCmd(interp
, ct
, argc
, argv
);
21101 /* The following two functions are for normal commands */
21103 Jim_CheckCmdUsage(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, int argc
,
21104 Jim_Obj
*const *argv
)
21106 /* -usage or -help */
21108 if (Jim_CompareStringImmediate(interp
, argv
[1], "-usage")
21109 || Jim_CompareStringImmediate(interp
, argv
[1], "-help")) {
21110 Jim_SetResultString(interp
, "Usage: ", -1);
21111 add_cmd_usage(interp
, command_table
, NULL
);
21112 if (command_table
->description
) {
21113 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", command_table
->description
,
21119 if (argc
>= 2 && command_table
->function
) {
21120 /* This is actually a sub command table */
21124 const char *subcmd
= NULL
;
21126 if (Jim_CompareStringImmediate(interp
, argv
[1], "-subcommands")) {
21127 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
21128 add_commands(interp
, (jim_subcmd_type
*) command_table
->function
, " ");
21132 if (Jim_CompareStringImmediate(interp
, argv
[1], "-subhelp")
21133 || Jim_CompareStringImmediate(interp
, argv
[1], "-help")) {
21136 else if (Jim_CompareStringImmediate(interp
, argv
[1], "-subusage")) {
21141 nargv
[nargc
++] = Jim_NewStringObj(interp
, "$handle", -1);
21142 nargv
[nargc
++] = Jim_NewStringObj(interp
, subcmd
, -1);
21144 nargv
[nargc
++] = argv
[2];
21146 Jim_ParseSubCmd(interp
, (jim_subcmd_type
*) command_table
->function
, nargc
, nargv
);
21147 Jim_FreeNewObj(interp
, nargv
[0]);
21148 Jim_FreeNewObj(interp
, nargv
[1]);
21153 /* Check the number of args */
21154 if (argc
- 1 < command_table
->minargs
|| (command_table
->maxargs
>= 0
21155 && argc
- 1 > command_table
->maxargs
)) {
21156 set_wrong_args(interp
, command_table
, NULL
);
21157 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\nUse \"", Jim_String(argv
[0]),
21158 " -help\" for help", NULL
);
21162 /* Not usage, but passed arg checking */
21166 * UTF-8 utility functions
21168 * (c) 2010 Steve Bennett <steveb@workware.net.au>
21170 * See LICENCE for licence details.
21174 #include <stdlib.h>
21175 #include <string.h>
21177 #include <assert.h>
21179 /* This one is always implemented */
21180 int utf8_fromunicode(char *p
, unsigned short uc
)
21186 else if (uc
<= 0x7ff) {
21187 *p
++ = 0xc0 | ((uc
& 0x7c0) >> 6);
21188 *p
= 0x80 | (uc
& 0x3f);
21192 *p
++ = 0xe0 | ((uc
& 0xf000) >> 12);
21193 *p
++ = 0x80 | ((uc
& 0xfc0) >> 6);
21194 *p
= 0x80 | (uc
& 0x3f);
21200 int utf8_charlen(int c
)
21202 if ((c
& 0x80) == 0) {
21205 if ((c
& 0xe0) == 0xc0) {
21208 if ((c
& 0xf0) == 0xe0) {
21211 if ((c
& 0xf8) == 0xf0) {
21214 /* Invalid sequence */
21218 int utf8_strlen(const char *str
, int bytelen
)
21222 bytelen
= strlen(str
);
21226 int l
= utf8_tounicode(str
, &c
);
21234 int utf8_index(const char *str
, int index
)
21236 const char *s
= str
;
21239 s
+= utf8_tounicode(s
, &c
);
21244 int utf8_charequal(const char *s1
, const char *s2
)
21248 utf8_tounicode(s1
, &c1
);
21249 utf8_tounicode(s2
, &c2
);
21254 int utf8_prev_len(const char *str
, int len
)
21260 /* Look up to len chars backward for a start-of-char byte */
21262 if ((str
[-n
] & 0x80) == 0) {
21263 /* Start of a 1-byte char */
21266 if ((str
[-n
] & 0xc0) == 0xc0) {
21267 /* Start of a multi-byte char */
21275 int utf8_tounicode(const char *str
, int *uc
)
21277 unsigned const char *s
= (unsigned const char *)str
;
21284 if ((s
[1] & 0xc0) == 0x80) {
21285 *uc
= ((s
[0] & ~0xc0) << 6) | (s
[1] & ~0x80);
21289 else if (s
[0] < 0xf0) {
21290 if (((str
[1] & 0xc0) == 0x80) && ((str
[2] & 0xc0) == 0x80)) {
21291 *uc
= ((s
[0] & ~0xe0) << 12) | ((s
[1] & ~0x80) << 6) | (s
[2] & ~0x80);
21296 /* Invalid sequence, so just return the byte */
21302 unsigned short code
; /* code point */
21303 signed char lowerdelta
; /* add for lowercase, or if -128 use the ext table */
21304 signed char upperdelta
; /* add for uppercase, or offset into the ext table */
21307 /* Extended table for codepoints where |delta| > 127 */
21308 struct caseextmap
{
21309 unsigned short lower
;
21310 unsigned short upper
;
21313 /* Generated mapping tables */
21314 #include "unicode_mapping.c"
21316 #define NUMCASEMAP sizeof(unicode_case_mapping) / sizeof(*unicode_case_mapping)
21318 static int cmp_casemap(const void *key
, const void *cm
)
21320 return *(int *)key
- (int)((const struct casemap
*)cm
)->code
;
21323 static int utf8_map_case(int uc
, int upper
)
21325 const struct casemap
*cm
= bsearch(&uc
, unicode_case_mapping
, NUMCASEMAP
, sizeof(*unicode_case_mapping
), cmp_casemap
);
21328 if (cm
->lowerdelta
== -128) {
21329 uc
= upper
? unicode_extmap
[cm
->upperdelta
].upper
: unicode_extmap
[cm
->upperdelta
].lower
;
21332 uc
+= upper
? cm
->upperdelta
: cm
->lowerdelta
;
21338 int utf8_upper(int uc
)
21341 return toupper(uc
);
21343 return utf8_map_case(uc
, 1);
21346 int utf8_lower(int uc
)
21349 return tolower(uc
);
21352 return utf8_map_case(uc
, 0);
21357 #include <string.h>
21359 #ifdef USE_LINENOISE
21360 #include "linenoise.h"
21363 #define MAX_LINE_LEN 512
21365 static char *linenoise(const char *prompt
)
21367 char *line
= malloc(MAX_LINE_LEN
);
21369 fputs(prompt
, stdout
);
21372 if (fgets(line
, MAX_LINE_LEN
, stdin
) == NULL
) {
21380 int Jim_InteractivePrompt(Jim_Interp
*interp
)
21382 int retcode
= JIM_OK
;
21383 char *history_file
= NULL
;
21384 #ifdef USE_LINENOISE
21387 home
= getenv("HOME");
21389 int history_len
= strlen(home
) + sizeof("/.jim_history");
21390 history_file
= Jim_Alloc(history_len
);
21391 snprintf(history_file
, history_len
, "%s/.jim_history", home
);
21392 linenoiseHistoryLoad(history_file
);
21396 printf("Welcome to Jim version %d.%d" JIM_NL
,
21397 JIM_VERSION
/ 100, JIM_VERSION
% 100);
21398 Jim_SetVariableStrWithStr(interp
, JIM_INTERACTIVE
, "1");
21401 Jim_Obj
*scriptObjPtr
;
21402 const char *result
;
21407 if (retcode
!= 0) {
21408 const char *retcodestr
= Jim_ReturnCode(retcode
);
21410 if (*retcodestr
== '?') {
21411 snprintf(prompt
, sizeof(prompt
) - 3, "[%d] ", retcode
);
21414 snprintf(prompt
, sizeof(prompt
) - 3, "[%s] ", retcodestr
);
21420 strcat(prompt
, ". ");
21422 scriptObjPtr
= Jim_NewStringObj(interp
, "", 0);
21423 Jim_IncrRefCount(scriptObjPtr
);
21429 line
= linenoise(prompt
);
21430 if (line
== NULL
) {
21431 if (errno
== EINTR
) {
21434 Jim_DecrRefCount(interp
, scriptObjPtr
);
21437 if (Jim_Length(scriptObjPtr
) != 0) {
21438 Jim_AppendString(interp
, scriptObjPtr
, "\n", 1);
21440 Jim_AppendString(interp
, scriptObjPtr
, line
, -1);
21442 str
= Jim_GetString(scriptObjPtr
, &len
);
21446 if (Jim_ScriptIsComplete(str
, len
, &state
))
21449 snprintf(prompt
, sizeof(prompt
), "%c> ", state
);
21451 #ifdef USE_LINENOISE
21452 if (strcmp(str
, "h") == 0) {
21453 /* built-in history command */
21456 char **history
= linenoiseHistory(&len
);
21457 for (i
= 0; i
< len
; i
++) {
21458 printf("%4d %s\n", i
+ 1, history
[i
]);
21460 Jim_DecrRefCount(interp
, scriptObjPtr
);
21464 linenoiseHistoryAdd(Jim_String(scriptObjPtr
));
21465 linenoiseHistorySave(history_file
);
21467 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
21468 Jim_DecrRefCount(interp
, scriptObjPtr
);
21472 if (retcode
== JIM_EXIT
) {
21473 Jim_Free(history_file
);
21476 if (retcode
== JIM_ERR
) {
21477 Jim_MakeErrorMessage(interp
);
21479 result
= Jim_GetString(Jim_GetResult(interp
), &reslen
);
21481 printf("%s\n", result
);
21485 Jim_Free(history_file
);
21489 * Implements the internals of the format command for jim
21491 * The FreeBSD license
21493 * Redistribution and use in source and binary forms, with or without
21494 * modification, are permitted provided that the following conditions
21497 * 1. Redistributions of source code must retain the above copyright
21498 * notice, this list of conditions and the following disclaimer.
21499 * 2. Redistributions in binary form must reproduce the above
21500 * copyright notice, this list of conditions and the following
21501 * disclaimer in the documentation and/or other materials
21502 * provided with the distribution.
21504 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
21505 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
21506 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
21507 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
21508 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
21509 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
21510 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
21511 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21512 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
21513 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
21514 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
21515 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
21517 * The views and conclusions contained in the software and documentation
21518 * are those of the authors and should not be interpreted as representing
21519 * official policies, either expressed or implied, of the Jim Tcl Project.
21521 * Based on code originally from Tcl 8.5:
21523 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
21524 * Copyright (c) 1999 by Scriptics Corporation.
21526 * See the file "tcl.license.terms" for information on usage and redistribution of
21527 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
21530 #include <string.h>
21533 #define JIM_UTF_MAX 3
21534 #define JIM_INTEGER_SPACE 24
21535 #define MAX_FLOAT_WIDTH 320
21538 * Apply the printf-like format in fmtObjPtr with the given arguments.
21540 * Returns a new object with zero reference count if OK, or NULL on error.
21542 Jim_Obj
*Jim_FormatString(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
, int objc
, Jim_Obj
*const *objv
)
21544 const char *span
, *format
, *formatEnd
, *msg
;
21545 int numBytes
= 0, objIndex
= 0, gotXpg
= 0, gotSequential
= 0;
21546 static const char *mixedXPG
=
21547 "cannot mix \"%\" and \"%n$\" conversion specifiers";
21548 static const char *badIndex
[2] = {
21549 "not enough arguments for all format specifiers",
21550 "\"%n$\" argument index out of range"
21553 Jim_Obj
*resultPtr
;
21555 /* A single buffer is used to store numeric fields (with sprintf())
21556 * This buffer is allocated/reallocated as necessary
21558 char *num_buffer
= NULL
;
21559 int num_buffer_size
= 0;
21561 span
= format
= Jim_GetString(fmtObjPtr
, &formatLen
);
21562 formatEnd
= format
+ formatLen
;
21563 resultPtr
= Jim_NewStringObj(interp
, "", 0);
21565 while (format
!= formatEnd
) {
21567 int gotMinus
, sawFlag
;
21568 int gotPrecision
, useShort
;
21569 long width
, precision
;
21575 char spec
[2*JIM_INTEGER_SPACE
+ 12];
21578 int formatted_chars
;
21579 int formatted_bytes
;
21580 const char *formatted_buf
;
21582 step
= utf8_tounicode(format
, &ch
);
21589 Jim_AppendString(interp
, resultPtr
, span
, numBytes
);
21594 * Saw a % : process the format specifier.
21596 * Step 0. Handle special case of escaped format marker (i.e., %%).
21599 step
= utf8_tounicode(format
, &ch
);
21608 * Step 1. XPG3 position specifier
21613 int position
= strtoul(format
, &end
, 10);
21616 objIndex
= position
- 1;
21618 step
= utf8_tounicode(format
, &ch
);
21622 if (gotSequential
) {
21634 if ((objIndex
< 0) || (objIndex
>= objc
)) {
21635 msg
= badIndex
[gotXpg
];
21640 * Step 2. Set of flags. Also build up the sprintf spec.
21665 step
= utf8_tounicode(format
, &ch
);
21669 * Step 3. Minimum field width.
21674 width
= strtoul(format
, &end
, 10);
21676 step
= utf8_tounicode(format
, &ch
);
21677 } else if (ch
== '*') {
21678 if (objIndex
>= objc
- 1) {
21679 msg
= badIndex
[gotXpg
];
21682 if (Jim_GetLong(interp
, objv
[objIndex
], &width
) != JIM_OK
) {
21694 step
= utf8_tounicode(format
, &ch
);
21698 * Step 4. Precision.
21701 gotPrecision
= precision
= 0;
21705 step
= utf8_tounicode(format
, &ch
);
21708 precision
= strtoul(format
, &end
, 10);
21710 step
= utf8_tounicode(format
, &ch
);
21711 } else if (ch
== '*') {
21712 if (objIndex
>= objc
- 1) {
21713 msg
= badIndex
[gotXpg
];
21716 if (Jim_GetLong(interp
, objv
[objIndex
], &precision
) != JIM_OK
) {
21721 * TODO: Check this truncation logic.
21724 if (precision
< 0) {
21729 step
= utf8_tounicode(format
, &ch
);
21733 * Step 5. Length modifier.
21740 step
= utf8_tounicode(format
, &ch
);
21741 } else if (ch
== 'l') {
21742 /* Just for compatibility. All non-short integers are wide. */
21744 step
= utf8_tounicode(format
, &ch
);
21747 step
= utf8_tounicode(format
, &ch
);
21755 * Step 6. The actual conversion character.
21764 /* Each valid conversion will set:
21765 * formatted_buf - the result to be added
21766 * formatted_chars - the length of formatted_buf in characters
21767 * formatted_bytes - the length of formatted_buf in bytes
21771 msg
= "format string ended in middle of field specifier";
21774 formatted_buf
= Jim_GetString(objv
[objIndex
], &formatted_bytes
);
21775 formatted_chars
= Jim_Utf8Length(interp
, objv
[objIndex
]);
21776 if (gotPrecision
&& (precision
< formatted_chars
)) {
21777 /* Need to build a (null terminated) truncated string */
21778 formatted_chars
= precision
;
21779 formatted_bytes
= utf8_index(formatted_buf
, precision
);
21786 if (Jim_GetWide(interp
, objv
[objIndex
], &code
) != JIM_OK
) {
21789 /* Just store the value in the 'spec' buffer */
21790 formatted_bytes
= utf8_fromunicode(spec
, code
);
21791 formatted_buf
= spec
;
21792 formatted_chars
= 1;
21812 /* Fill in the width and precision */
21814 p
+= sprintf(p
, "%ld", width
);
21816 if (gotPrecision
) {
21817 p
+= sprintf(p
, ".%ld", precision
);
21820 /* Now the modifier, and get the actual value here */
21822 if (Jim_GetDouble(interp
, objv
[objIndex
], &d
) != JIM_OK
) {
21825 length
= MAX_FLOAT_WIDTH
;
21828 if (Jim_GetWide(interp
, objv
[objIndex
], &w
) != JIM_OK
) {
21831 length
= JIM_INTEGER_SPACE
;
21838 w
= (unsigned short)w
;
21843 #ifdef HAVE_LONG_LONG
21844 if (sizeof(long long) == sizeof(jim_wide
)) {
21854 /* Adjust length for width and precision */
21855 if (width
> length
) {
21858 if (gotPrecision
) {
21859 length
+= precision
;
21862 /* Increase the size of the buffer if needed */
21863 if (num_buffer_size
< length
+ 1) {
21864 num_buffer_size
= length
+ 1;
21865 num_buffer
= Jim_Realloc(num_buffer
, num_buffer_size
);
21869 snprintf(num_buffer
, length
+ 1, spec
, d
);
21872 formatted_bytes
= snprintf(num_buffer
, length
+ 1, spec
, w
);
21874 formatted_chars
= formatted_bytes
= strlen(num_buffer
);
21875 formatted_buf
= num_buffer
;
21880 /* Just reuse the 'spec' buffer */
21883 Jim_SetResultFormatted(interp
, "bad field specifier \"%s\"", spec
);
21889 while (formatted_chars
< width
) {
21890 Jim_AppendString(interp
, resultPtr
, &pad
, 1);
21895 Jim_AppendString(interp
, resultPtr
, formatted_buf
, formatted_bytes
);
21897 while (formatted_chars
< width
) {
21898 Jim_AppendString(interp
, resultPtr
, &pad
, 1);
21902 objIndex
+= gotSequential
;
21905 Jim_AppendString(interp
, resultPtr
, span
, numBytes
);
21908 Jim_Free(num_buffer
);
21912 Jim_SetResultString(interp
, msg
, -1);
21914 Jim_FreeNewObj(interp
, resultPtr
);
21915 Jim_Free(num_buffer
);
21919 * regcomp and regexec -- regsub and regerror are elsewhere
21921 * Copyright (c) 1986 by University of Toronto.
21922 * Written by Henry Spencer. Not derived from licensed software.
21924 * Permission is granted to anyone to use this software for any
21925 * purpose on any computer system, and to redistribute it freely,
21926 * subject to the following restrictions:
21928 * 1. The author is not responsible for the consequences of use of
21929 * this software, no matter how awful, even if they arise
21930 * from defects in it.
21932 * 2. The origin of this software must not be misrepresented, either
21933 * by explicit claim or by omission.
21935 * 3. Altered versions must be plainly marked as such, and must not
21936 * be misrepresented as being the original software.
21937 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21938 *** hoptoad!gnu, on 27 Dec 1986, to add \n as an alternative to |
21939 *** to assist in implementing egrep.
21940 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21941 *** hoptoad!gnu, on 27 Dec 1986, to add \< and \> for word-matching
21942 *** as in BSD grep and ex.
21943 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21944 *** hoptoad!gnu, on 28 Dec 1986, to optimize characters quoted with \.
21945 *** THIS IS AN ALTERED VERSION. It was altered by James A. Woods,
21946 *** ames!jaw, on 19 June 1987, to quash a regcomp() redundancy.
21947 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21948 *** seiwald@vix.com, on 28 August 1993, for use in jam. Regmagic.h
21949 *** was moved into regexp.h, and the include of regexp.h now uses "'s
21950 *** to avoid conflicting with the system regexp.h. Const, bless its
21951 *** soul, was removed so it can compile everywhere. The declaration
21952 *** of strchr() was in conflict on AIX, so it was removed (as it is
21953 *** happily defined in string.h).
21954 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21955 *** seiwald@perforce.com, on 20 January 2000, to use function prototypes.
21956 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21957 *** seiwald@perforce.com, on 05 November 2002, to const string literals.
21959 * THIS IS AN ALTERED VERSION. It was altered by Steve Bennett <steveb@workware.net.au>
21960 * on 16 October 2010, to remove static state and add better Tcl ARE compatibility.
21961 * This includes counted repetitions, UTF-8 support, character classes,
21962 * shorthand character classes, increased number of parentheses to 100,
21963 * backslash escape sequences. It also removes \n as an alternative to |.
21965 * Beware that some of this code is subtly aware of the way operator
21966 * precedence is structured in regular expressions. Serious changes in
21967 * regular-expression syntax might require a total rethink.
21971 #include <stdlib.h>
21972 #include <string.h>
21975 #if !defined(HAVE_REGCOMP) || defined(JIM_REGEXP)
21978 * Structure for regexp "program". This is essentially a linear encoding
21979 * of a nondeterministic finite-state machine (aka syntax charts or
21980 * "railroad normal form" in parsing technology). Each node is an opcode
21981 * plus a "next" pointer, possibly plus an operand. "Next" pointers of
21982 * all nodes except BRANCH implement concatenation; a "next" pointer with
21983 * a BRANCH on both ends of it is connecting two alternatives. (Here we
21984 * have one of the subtle syntax dependencies: an individual BRANCH (as
21985 * opposed to a collection of them) is never concatenated with anything
21986 * because of operator precedence.) The operand of some types of node is
21987 * a literal string; for others, it is a node leading into a sub-FSM. In
21988 * particular, the operand of a BRANCH node is the first node of the branch.
21989 * (NB this is *not* a tree structure: the tail of the branch connects
21990 * to the thing following the set of BRANCHes.) The opcodes are:
21993 /* This *MUST* be less than (255-20)/2=117 */
21994 #define REG_MAX_PAREN 100
21996 /* definition number opnd? meaning */
21997 #define END 0 /* no End of program. */
21998 #define BOL 1 /* no Match "" at beginning of line. */
21999 #define EOL 2 /* no Match "" at end of line. */
22000 #define ANY 3 /* no Match any one character. */
22001 #define ANYOF 4 /* str Match any character in this string. */
22002 #define ANYBUT 5 /* str Match any character not in this string. */
22003 #define BRANCH 6 /* node Match this alternative, or the next... */
22004 #define BACK 7 /* no Match "", "next" ptr points backward. */
22005 #define EXACTLY 8 /* str Match this string. */
22006 #define NOTHING 9 /* no Match empty string. */
22007 #define REP 10 /* max,min Match this (simple) thing [min,max] times. */
22008 #define REPMIN 11 /* max,min Match this (simple) thing [min,max] times, mininal match. */
22009 #define REPX 12 /* max,min Match this (complex) thing [min,max] times. */
22010 #define REPXMIN 13 /* max,min Match this (complex) thing [min,max] times, minimal match. */
22012 #define WORDA 15 /* no Match "" at wordchar, where prev is nonword */
22013 #define WORDZ 16 /* no Match "" at nonwordchar, where prev is word */
22014 #define OPEN 20 /* no Mark this point in input as start of #n. */
22015 /* OPEN+1 is number 1, etc. */
22016 #define CLOSE (OPEN+REG_MAX_PAREN) /* no Analogous to OPEN. */
22017 #define CLOSE_END (CLOSE+REG_MAX_PAREN)
22020 * The first byte of the regexp internal "program" is actually this magic
22021 * number; the start node begins in the second byte.
22023 #define REG_MAGIC 0xFADED00D
22028 * BRANCH The set of branches constituting a single choice are hooked
22029 * together with their "next" pointers, since precedence prevents
22030 * anything being concatenated to any individual branch. The
22031 * "next" pointer of the last BRANCH in a choice points to the
22032 * thing following the whole choice. This is also where the
22033 * final "next" pointer of each individual branch points; each
22034 * branch starts with the operand node of a BRANCH node.
22036 * BACK Normal "next" pointers all implicitly point forward; BACK
22037 * exists to make loop structures possible.
22039 * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
22040 * BRANCH structures using BACK. Simple cases (one character
22041 * per match) are implemented with STAR and PLUS for speed
22042 * and to minimize recursive plunges.
22044 * OPEN,CLOSE ...are numbered at compile time.
22048 * A node is one char of opcode followed by two chars of "next" pointer.
22049 * "Next" pointers are stored as two 8-bit pieces, high order first. The
22050 * value is a positive offset from the opcode of the node containing it.
22051 * An operand, if any, simply follows the node. (Note that much of the
22052 * code generation knows about this implicit relationship.)
22054 * Using two bytes for the "next" pointer is vast overkill for most things,
22055 * but allows patterns to get big without disasters.
22057 #define OP(preg, p) (preg->program[p])
22058 #define NEXT(preg, p) (preg->program[p + 1])
22059 #define OPERAND(p) ((p) + 2)
22062 * See regmagic.h for one further detail of program structure.
22067 * Utility definitions.
22070 #define FAIL(R,M) { (R)->err = (M); return (M); }
22071 #define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?' || (c) == '{')
22072 #define META "^$.[()|?{+*"
22075 * Flags to be passed up and down.
22077 #define HASWIDTH 01 /* Known never to match null string. */
22078 #define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */
22079 #define SPSTART 04 /* Starts with * or +. */
22080 #define WORST 0 /* Worst case. */
22082 #define MAX_REP_COUNT 1000000
22085 * Forward declarations for regcomp()'s friends.
22087 static int reg(regex_t
*preg
, int paren
/* Parenthesized? */, int *flagp
);
22088 static int regpiece(regex_t
*preg
, int *flagp
);
22089 static int regbranch(regex_t
*preg
, int *flagp
);
22090 static int regatom(regex_t
*preg
, int *flagp
);
22091 static int regnode(regex_t
*preg
, int op
);
22092 static int regnext(regex_t
*preg
, int p
);
22093 static void regc(regex_t
*preg
, int b
);
22094 static int reginsert(regex_t
*preg
, int op
, int size
, int opnd
);
22095 static void regtail_(regex_t
*preg
, int p
, int val
, int line
);
22096 static void regoptail(regex_t
*preg
, int p
, int val
);
22097 #define regtail(PREG, P, VAL) regtail_(PREG, P, VAL, __LINE__)
22099 static int reg_range_find(const int *string
, int c
);
22100 static const char *str_find(const char *string
, int c
, int nocase
);
22101 static int prefix_cmp(const int *prog
, int proglen
, const char *string
, int nocase
);
22105 int regnarrate
= 0;
22106 static void regdump(regex_t
*preg
);
22107 static const char *regprop( int op
);
22112 * Returns the length of the null-terminated integer sequence.
22114 static int str_int_len(const int *seq
)
22124 - regcomp - compile a regular expression into internal code
22126 * We can't allocate space until we know how big the compiled form will be,
22127 * but we can't compile it (and thus know how big it is) until we've got a
22128 * place to put the code. So we cheat: we compile it twice, once with code
22129 * generation turned off and size counting turned on, and once "for real".
22130 * This also means that we don't allocate space until we are sure that the
22131 * thing really will compile successfully, and we never have to move the
22132 * code and thus invalidate pointers into it. (Note that it has to be in
22133 * one piece because free() must be able to free it all.)
22135 * Beware that the optimization-preparation code in here knows about some
22136 * of the structure of the compiled regexp.
22138 int regcomp(regex_t
*preg
, const char *exp
, int cflags
)
22146 fprintf(stderr
, "Compiling: '%s'\n", exp
);
22148 memset(preg
, 0, sizeof(*preg
));
22151 FAIL(preg
, REG_ERR_NULL_ARGUMENT
);
22153 /* First pass: determine size, legality. */
22154 preg
->cflags
= cflags
;
22155 preg
->regparse
= exp
;
22156 /* XXX: For now, start unallocated */
22157 preg
->program
= NULL
;
22161 /* Allocate space. */
22162 preg
->proglen
= (strlen(exp
) + 1) * 5;
22163 preg
->program
= malloc(preg
->proglen
* sizeof(int));
22164 if (preg
->program
== NULL
)
22165 FAIL(preg
, REG_ERR_NOMEM
);
22168 /* Note that since we store a magic value as the first item in the program,
22169 * program offsets will never be 0
22171 regc(preg
, REG_MAGIC
);
22172 if (reg(preg
, 0, &flags
) == 0) {
22176 /* Small enough for pointer-storage convention? */
22177 if (preg
->re_nsub
>= REG_MAX_PAREN
) /* Probably could be 65535L. */
22178 FAIL(preg
,REG_ERR_TOO_BIG
);
22180 /* Dig out information for optimizations. */
22181 preg
->regstart
= 0; /* Worst-case defaults. */
22185 scan
= 1; /* First BRANCH. */
22186 if (OP(preg
, regnext(preg
, scan
)) == END
) { /* Only one top-level choice. */
22187 scan
= OPERAND(scan
);
22189 /* Starting-point info. */
22190 if (OP(preg
, scan
) == EXACTLY
) {
22191 preg
->regstart
= preg
->program
[OPERAND(scan
)];
22193 else if (OP(preg
, scan
) == BOL
)
22197 * If there's something expensive in the r.e., find the
22198 * longest literal string that must appear and make it the
22199 * regmust. Resolve ties in favor of later strings, since
22200 * the regstart check works with the beginning of the r.e.
22201 * and avoiding duplication strengthens checking. Not a
22202 * strong reason, but sufficient in the absence of others.
22204 if (flags
&SPSTART
) {
22207 for (; scan
!= 0; scan
= regnext(preg
, scan
)) {
22208 if (OP(preg
, scan
) == EXACTLY
) {
22209 int plen
= str_int_len(preg
->program
+ OPERAND(scan
));
22211 longest
= OPERAND(scan
);
22216 preg
->regmust
= longest
;
22217 preg
->regmlen
= len
;
22229 - reg - regular expression, i.e. main body or parenthesized thing
22231 * Caller must absorb opening parenthesis.
22233 * Combining parenthesis handling with the base level of regular expression
22234 * is a trifle forced, but the need to tie the tails of the branches to what
22235 * follows makes it hard to avoid.
22237 static int reg(regex_t
*preg
, int paren
/* Parenthesized? */, int *flagp
)
22245 *flagp
= HASWIDTH
; /* Tentatively. */
22247 /* Make an OPEN node, if parenthesized. */
22249 parno
= ++preg
->re_nsub
;
22250 ret
= regnode(preg
, OPEN
+parno
);
22254 /* Pick up the branches, linking them together. */
22255 br
= regbranch(preg
, &flags
);
22259 regtail(preg
, ret
, br
); /* OPEN -> first. */
22262 if (!(flags
&HASWIDTH
))
22263 *flagp
&= ~HASWIDTH
;
22264 *flagp
|= flags
&SPSTART
;
22265 while (*preg
->regparse
== '|') {
22267 br
= regbranch(preg
, &flags
);
22270 regtail(preg
, ret
, br
); /* BRANCH -> BRANCH. */
22271 if (!(flags
&HASWIDTH
))
22272 *flagp
&= ~HASWIDTH
;
22273 *flagp
|= flags
&SPSTART
;
22276 /* Make a closing node, and hook it on the end. */
22277 ender
= regnode(preg
, (paren
) ? CLOSE
+parno
: END
);
22278 regtail(preg
, ret
, ender
);
22280 /* Hook the tails of the branches to the closing node. */
22281 for (br
= ret
; br
!= 0; br
= regnext(preg
, br
))
22282 regoptail(preg
, br
, ender
);
22284 /* Check for proper termination. */
22285 if (paren
&& *preg
->regparse
++ != ')') {
22286 preg
->err
= REG_ERR_UNMATCHED_PAREN
;
22288 } else if (!paren
&& *preg
->regparse
!= '\0') {
22289 if (*preg
->regparse
== ')') {
22290 preg
->err
= REG_ERR_UNMATCHED_PAREN
;
22293 preg
->err
= REG_ERR_JUNK_ON_END
;
22302 - regbranch - one alternative of an | operator
22304 * Implements the concatenation operator.
22306 static int regbranch(regex_t
*preg
, int *flagp
)
22313 *flagp
= WORST
; /* Tentatively. */
22315 ret
= regnode(preg
, BRANCH
);
22317 while (*preg
->regparse
!= '\0' && *preg
->regparse
!= ')' &&
22318 *preg
->regparse
!= '|') {
22319 latest
= regpiece(preg
, &flags
);
22322 *flagp
|= flags
&HASWIDTH
;
22323 if (chain
== 0) {/* First piece. */
22324 *flagp
|= flags
&SPSTART
;
22327 regtail(preg
, chain
, latest
);
22331 if (chain
== 0) /* Loop ran zero times. */
22332 (void) regnode(preg
, NOTHING
);
22338 - regpiece - something followed by possible [*+?]
22340 * Note that the branching code sequences used for ? and the general cases
22341 * of * and + are somewhat optimized: they use the same NOTHING node as
22342 * both the endmarker for their branch list and the body of the last branch.
22343 * It might seem that this node could be dispensed with entirely, but the
22344 * endmarker role is not redundant.
22346 static int regpiece(regex_t
*preg
, int *flagp
)
22356 ret
= regatom(preg
, &flags
);
22360 op
= *preg
->regparse
;
22366 if (!(flags
&HASWIDTH
) && op
!= '?') {
22367 preg
->err
= REG_ERR_OPERAND_COULD_BE_EMPTY
;
22371 /* Handle braces (counted repetition) by expansion */
22375 min
= strtoul(preg
->regparse
+ 1, &end
, 10);
22376 if (end
== preg
->regparse
+ 1) {
22377 preg
->err
= REG_ERR_BAD_COUNT
;
22384 preg
->regparse
= end
;
22385 max
= strtoul(preg
->regparse
+ 1, &end
, 10);
22387 preg
->err
= REG_ERR_UNMATCHED_BRACES
;
22391 if (end
== preg
->regparse
+ 1) {
22392 max
= MAX_REP_COUNT
;
22394 else if (max
< min
|| max
>= 100) {
22395 preg
->err
= REG_ERR_BAD_COUNT
;
22399 preg
->err
= REG_ERR_BAD_COUNT
;
22403 preg
->regparse
= strchr(preg
->regparse
, '}');
22407 max
= (op
== '?' ? 1 : MAX_REP_COUNT
);
22410 if (preg
->regparse
[1] == '?') {
22412 next
= reginsert(preg
, flags
& SIMPLE
? REPMIN
: REPXMIN
, 5, ret
);
22415 next
= reginsert(preg
, flags
& SIMPLE
? REP
: REPX
, 5, ret
);
22417 preg
->program
[ret
+ 2] = max
;
22418 preg
->program
[ret
+ 3] = min
;
22419 preg
->program
[ret
+ 4] = 0;
22421 *flagp
= (min
) ? (WORST
|HASWIDTH
) : (WORST
|SPSTART
);
22423 if (!(flags
& SIMPLE
)) {
22424 int back
= regnode(preg
, BACK
);
22425 regtail(preg
, back
, ret
);
22426 regtail(preg
, next
, back
);
22430 if (ISMULT(*preg
->regparse
)) {
22431 preg
->err
= REG_ERR_NESTED_COUNT
;
22435 return chain
? chain
: ret
;
22439 * Add all characters in the inclusive range between lower and upper.
22441 * Handles a swapped range (upper < lower).
22443 static void reg_addrange(regex_t
*preg
, int lower
, int upper
)
22445 if (lower
> upper
) {
22446 reg_addrange(preg
, upper
, lower
);
22448 /* Add a range as length, start */
22449 regc(preg
, upper
- lower
+ 1);
22454 * Add a null-terminated literal string as a set of ranges.
22456 static void reg_addrange_str(regex_t
*preg
, const char *str
)
22459 reg_addrange(preg
, *str
, *str
);
22465 * Extracts the next unicode char from utf8.
22467 * If 'upper' is set, converts the char to uppercase.
22469 static int reg_utf8_tounicode_case(const char *s
, int *uc
, int upper
)
22471 int l
= utf8_tounicode(s
, uc
);
22473 *uc
= utf8_upper(*uc
);
22479 * Converts a hex digit to decimal.
22481 * Returns -1 for an invalid hex digit.
22483 static int hexdigitval(int c
)
22485 if (c
>= '0' && c
<= '9')
22487 if (c
>= 'a' && c
<= 'f')
22488 return c
- 'a' + 10;
22489 if (c
>= 'A' && c
<= 'F')
22490 return c
- 'A' + 10;
22495 * Parses up to 'n' hex digits at 's' and stores the result in *uc.
22497 * Returns the number of hex digits parsed.
22498 * If there are no hex digits, returns 0 and stores nothing.
22500 static int parse_hex(const char *s
, int n
, int *uc
)
22505 for (k
= 0; k
< n
; k
++) {
22506 int c
= hexdigitval(*s
++);
22510 val
= (val
<< 4) | c
;
22519 * Call for chars after a backlash to decode the escape sequence.
22521 * Stores the result in *ch.
22523 * Returns the number of bytes consumed.
22525 static int reg_decode_escape(const char *s
, int *ch
)
22528 const char *s0
= s
;
22533 case 'b': *ch
= '\b'; break;
22534 case 'e': *ch
= 27; break;
22535 case 'f': *ch
= '\f'; break;
22536 case 'n': *ch
= '\n'; break;
22537 case 'r': *ch
= '\r'; break;
22538 case 't': *ch
= '\t'; break;
22539 case 'v': *ch
= '\v'; break;
22541 if ((n
= parse_hex(s
, 4, ch
)) > 0) {
22546 if ((n
= parse_hex(s
, 2, ch
)) > 0) {
22559 - regatom - the lowest level
22561 * Optimization: gobbles an entire sequence of ordinary characters so that
22562 * it can turn them into a single node, which is smaller to store and
22563 * faster to run. Backslashed characters are exceptions, each becoming a
22564 * separate node; the code is simpler that way and it's not worth fixing.
22566 static int regatom(regex_t
*preg
, int *flagp
)
22570 int nocase
= (preg
->cflags
& REG_ICASE
);
22573 int n
= reg_utf8_tounicode_case(preg
->regparse
, &ch
, nocase
);
22575 *flagp
= WORST
; /* Tentatively. */
22577 preg
->regparse
+= n
;
22579 /* FIXME: these chars only have meaning at beg/end of pat? */
22581 ret
= regnode(preg
, BOL
);
22584 ret
= regnode(preg
, EOL
);
22587 ret
= regnode(preg
, ANY
);
22588 *flagp
|= HASWIDTH
|SIMPLE
;
22591 const char *pattern
= preg
->regparse
;
22593 if (*pattern
== '^') { /* Complement of range. */
22594 ret
= regnode(preg
, ANYBUT
);
22597 ret
= regnode(preg
, ANYOF
);
22599 /* Special case. If the first char is ']' or '-', it is part of the set */
22600 if (*pattern
== ']' || *pattern
== '-') {
22601 reg_addrange(preg
, *pattern
, *pattern
);
22605 while (*pattern
&& *pattern
!= ']') {
22606 /* Is this a range? a-z */
22610 pattern
+= reg_utf8_tounicode_case(pattern
, &start
, nocase
);
22611 if (start
== '\\') {
22612 pattern
+= reg_decode_escape(pattern
, &start
);
22614 preg
->err
= REG_ERR_NULL_CHAR
;
22618 if (pattern
[0] == '-' && pattern
[1]) {
22620 pattern
+= utf8_tounicode(pattern
, &end
);
22621 pattern
+= reg_utf8_tounicode_case(pattern
, &end
, nocase
);
22623 pattern
+= reg_decode_escape(pattern
, &end
);
22625 preg
->err
= REG_ERR_NULL_CHAR
;
22630 reg_addrange(preg
, start
, end
);
22633 if (start
== '[') {
22634 if (strncmp(pattern
, ":alpha:]", 8) == 0) {
22635 if ((preg
->cflags
& REG_ICASE
) == 0) {
22636 reg_addrange(preg
, 'a', 'z');
22638 reg_addrange(preg
, 'A', 'Z');
22642 if (strncmp(pattern
, ":alnum:]", 8) == 0) {
22643 if ((preg
->cflags
& REG_ICASE
) == 0) {
22644 reg_addrange(preg
, 'a', 'z');
22646 reg_addrange(preg
, 'A', 'Z');
22647 reg_addrange(preg
, '0', '9');
22651 if (strncmp(pattern
, ":space:]", 8) == 0) {
22652 reg_addrange_str(preg
, " \t\r\n\f\v");
22657 /* Not a range, so just add the char */
22658 reg_addrange(preg
, start
, start
);
22665 preg
->regparse
= pattern
;
22667 *flagp
|= HASWIDTH
|SIMPLE
;
22671 ret
= reg(preg
, 1, &flags
);
22674 *flagp
|= flags
&(HASWIDTH
|SPSTART
);
22679 preg
->err
= REG_ERR_INTERNAL
;
22680 return 0; /* Supposed to be caught earlier. */
22685 preg
->err
= REG_ERR_COUNT_FOLLOWS_NOTHING
;
22688 switch (*preg
->regparse
++) {
22690 preg
->err
= REG_ERR_TRAILING_BACKSLASH
;
22694 ret
= regnode(preg
, WORDA
);
22698 ret
= regnode(preg
, WORDZ
);
22701 ret
= regnode(preg
, ANYOF
);
22702 reg_addrange(preg
, '0', '9');
22704 *flagp
|= HASWIDTH
|SIMPLE
;
22707 ret
= regnode(preg
, ANYOF
);
22708 if ((preg
->cflags
& REG_ICASE
) == 0) {
22709 reg_addrange(preg
, 'a', 'z');
22711 reg_addrange(preg
, 'A', 'Z');
22712 reg_addrange(preg
, '0', '9');
22713 reg_addrange(preg
, '_', '_');
22715 *flagp
|= HASWIDTH
|SIMPLE
;
22718 ret
= regnode(preg
, ANYOF
);
22719 reg_addrange_str(preg
," \t\r\n\f\v");
22721 *flagp
|= HASWIDTH
|SIMPLE
;
22723 /* FIXME: Someday handle \1, \2, ... */
22725 /* Handle general quoted chars in exact-match routine */
22726 /* Back up to include the backslash */
22734 * Encode a string of characters to be matched exactly.
22738 /* Back up to pick up the first char of interest */
22739 preg
->regparse
-= n
;
22741 ret
= regnode(preg
, EXACTLY
);
22743 /* Note that a META operator such as ? or * consumes the
22745 * Thus we must be careful to look ahead by 2 and add the
22746 * last char as it's own EXACTLY if necessary
22749 /* Until end of string or a META char is reached */
22750 while (*preg
->regparse
&& strchr(META
, *preg
->regparse
) == NULL
) {
22751 n
= reg_utf8_tounicode_case(preg
->regparse
, &ch
, (preg
->cflags
& REG_ICASE
));
22752 if (ch
== '\\' && preg
->regparse
[n
]) {
22753 /* Non-trailing backslash.
22754 * Is this a special escape, or a regular escape?
22756 if (strchr("<>mMwds", preg
->regparse
[n
])) {
22757 /* A special escape. All done with EXACTLY */
22760 /* Decode it. Note that we add the length for the escape
22761 * sequence to the length for the backlash so we can skip
22762 * the entire sequence, or not as required.
22764 n
+= reg_decode_escape(preg
->regparse
+ n
, &ch
);
22766 preg
->err
= REG_ERR_NULL_CHAR
;
22771 /* Now we have one char 'ch' of length 'n'.
22772 * Check to see if the following char is a MULT
22775 if (ISMULT(preg
->regparse
[n
])) {
22776 /* Yes. But do we already have some EXACTLY chars? */
22778 /* Yes, so return what we have and pick up the current char next time around */
22781 /* No, so add this single char and finish */
22784 preg
->regparse
+= n
;
22788 /* No, so just add this char normally */
22791 preg
->regparse
+= n
;
22795 *flagp
|= HASWIDTH
;
22806 static void reg_grow(regex_t
*preg
, int n
)
22808 if (preg
->p
+ n
>= preg
->proglen
) {
22809 preg
->proglen
= (preg
->p
+ n
) * 2;
22810 preg
->program
= realloc(preg
->program
, preg
->proglen
* sizeof(int));
22815 - regnode - emit a node
22818 static int regnode(regex_t
*preg
, int op
)
22822 preg
->program
[preg
->p
++] = op
;
22823 preg
->program
[preg
->p
++] = 0;
22825 /* Return the start of the node */
22826 return preg
->p
- 2;
22830 - regc - emit (if appropriate) a byte of code
22832 static void regc(regex_t
*preg
, int b
)
22835 preg
->program
[preg
->p
++] = b
;
22839 - reginsert - insert an operator in front of already-emitted operand
22841 * Means relocating the operand.
22842 * Returns the new location of the original operand.
22844 static int reginsert(regex_t
*preg
, int op
, int size
, int opnd
)
22846 reg_grow(preg
, size
);
22848 /* Move everything from opnd up */
22849 memmove(preg
->program
+ opnd
+ size
, preg
->program
+ opnd
, sizeof(int) * (preg
->p
- opnd
));
22850 /* Zero out the new space */
22851 memset(preg
->program
+ opnd
, 0, sizeof(int) * size
);
22853 preg
->program
[opnd
] = op
;
22857 return opnd
+ size
;
22861 - regtail - set the next-pointer at the end of a node chain
22863 static void regtail_(regex_t
*preg
, int p
, int val
, int line
)
22869 /* Find last node. */
22872 temp
= regnext(preg
, scan
);
22878 if (OP(preg
, scan
) == BACK
)
22879 offset
= scan
- val
;
22881 offset
= val
- scan
;
22883 preg
->program
[scan
+ 1] = offset
;
22887 - regoptail - regtail on operand of first argument; nop if operandless
22890 static void regoptail(regex_t
*preg
, int p
, int val
)
22892 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
22893 if (p
!= 0 && OP(preg
, p
) == BRANCH
) {
22894 regtail(preg
, OPERAND(p
), val
);
22899 * regexec and friends
22905 static int regtry(regex_t
*preg
, const char *string
);
22906 static int regmatch(regex_t
*preg
, int prog
);
22907 static int regrepeat(regex_t
*preg
, int p
, int max
);
22910 - regexec - match a regexp against a string
22912 int regexec(regex_t
*preg
, const char *string
, size_t nmatch
, regmatch_t pmatch
[], int eflags
)
22917 /* Be paranoid... */
22918 if (preg
== NULL
|| preg
->program
== NULL
|| string
== NULL
) {
22919 return REG_ERR_NULL_ARGUMENT
;
22922 /* Check validity of program. */
22923 if (*preg
->program
!= REG_MAGIC
) {
22924 return REG_ERR_CORRUPTED
;
22928 fprintf(stderr
, "regexec: %s\n", string
);
22932 preg
->eflags
= eflags
;
22933 preg
->pmatch
= pmatch
;
22934 preg
->nmatch
= nmatch
;
22935 preg
->start
= string
; /* All offsets are computed from here */
22937 /* Must clear out the embedded repeat counts */
22938 for (scan
= OPERAND(1); scan
!= 0; scan
= regnext(preg
, scan
)) {
22939 switch (OP(preg
, scan
)) {
22944 preg
->program
[scan
+ 4] = 0;
22949 /* If there is a "must appear" string, look for it. */
22950 if (preg
->regmust
!= 0) {
22952 while ((s
= str_find(s
, preg
->program
[preg
->regmust
], preg
->cflags
& REG_ICASE
)) != NULL
) {
22953 if (prefix_cmp(preg
->program
+ preg
->regmust
, preg
->regmlen
, s
, preg
->cflags
& REG_ICASE
) >= 0) {
22958 if (s
== NULL
) /* Not present. */
22959 return REG_NOMATCH
;
22962 /* Mark beginning of line for ^ . */
22963 preg
->regbol
= string
;
22965 /* Simplest case: anchored match need be tried only once (maybe per line). */
22966 if (preg
->reganch
) {
22967 if (eflags
& REG_NOTBOL
) {
22968 /* This is an anchored search, but not an BOL, so possibly skip to the next line */
22972 int ret
= regtry(preg
, string
);
22974 return REG_NOERROR
;
22978 if (preg
->cflags
& REG_NEWLINE
) {
22979 /* Try the next anchor? */
22980 string
= strchr(string
, '\n');
22982 preg
->regbol
= ++string
;
22987 return REG_NOMATCH
;
22991 /* Messy cases: unanchored match. */
22993 if (preg
->regstart
!= '\0') {
22994 /* We know what char it must start with. */
22995 while ((s
= str_find(s
, preg
->regstart
, preg
->cflags
& REG_ICASE
)) != NULL
) {
22996 if (regtry(preg
, s
))
22997 return REG_NOERROR
;
23002 /* We don't -- general case. */
23004 if (regtry(preg
, s
))
23005 return REG_NOERROR
;
23009 s
+= utf8_charlen(*s
);
23013 return REG_NOMATCH
;
23017 - regtry - try match at specific point
23019 /* 0 failure, 1 success */
23020 static int regtry( regex_t
*preg
, const char *string
)
23024 preg
->reginput
= string
;
23026 for (i
= 0; i
< preg
->nmatch
; i
++) {
23027 preg
->pmatch
[i
].rm_so
= -1;
23028 preg
->pmatch
[i
].rm_eo
= -1;
23030 if (regmatch(preg
, 1)) {
23031 preg
->pmatch
[0].rm_so
= string
- preg
->start
;
23032 preg
->pmatch
[0].rm_eo
= preg
->reginput
- preg
->start
;
23039 * Returns bytes matched if 'pattern' is a prefix of 'string'.
23041 * If 'nocase' is non-zero, does a case-insensitive match.
23043 * Returns -1 on not found.
23045 static int prefix_cmp(const int *prog
, int proglen
, const char *string
, int nocase
)
23047 const char *s
= string
;
23048 while (proglen
&& *s
) {
23050 int n
= reg_utf8_tounicode_case(s
, &ch
, nocase
);
23058 if (proglen
== 0) {
23065 * Searchs for 'c' in the range 'range'.
23067 * Returns 1 if found, or 0 if not.
23069 static int reg_range_find(const int *range
, int c
)
23072 /*printf("Checking %d in range [%d,%d]\n", c, range[1], (range[0] + range[1] - 1));*/
23073 if (c
>= range
[1] && c
<= (range
[0] + range
[1] - 1)) {
23082 * Search for the character 'c' in the utf-8 string 'string'.
23084 * If 'nocase' is set, the 'string' is assumed to be uppercase
23085 * and 'c' is converted to uppercase before matching.
23087 * Returns the byte position in the string where the 'c' was found, or
23088 * NULL if not found.
23090 static const char *str_find(const char *string
, int c
, int nocase
)
23093 /* The "string" should already be converted to uppercase */
23098 int n
= reg_utf8_tounicode_case(string
, &ch
, nocase
);
23108 * Returns true if 'ch' is an end-of-line char.
23110 * In REG_NEWLINE mode, \n is considered EOL in
23113 static int reg_iseol(regex_t
*preg
, int ch
)
23115 if (preg
->cflags
& REG_NEWLINE
) {
23116 return ch
== '\0' || ch
== '\n';
23123 static int regmatchsimplerepeat(regex_t
*preg
, int scan
, int matchmin
)
23130 int max
= preg
->program
[scan
+ 2];
23131 int min
= preg
->program
[scan
+ 3];
23132 int next
= regnext(preg
, scan
);
23135 * Lookahead to avoid useless match attempts
23136 * when we know what character comes next.
23138 if (OP(preg
, next
) == EXACTLY
) {
23139 nextch
= preg
->program
[OPERAND(next
)];
23141 save
= preg
->reginput
;
23142 no
= regrepeat(preg
, scan
+ 5, max
);
23147 /* from min up to no */
23151 /* else from no down to min */
23163 preg
->reginput
= save
+ utf8_index(save
, no
);
23164 reg_utf8_tounicode_case(preg
->reginput
, &c
, (preg
->cflags
& REG_ICASE
));
23165 /* If it could work, try it. */
23166 if (reg_iseol(preg
, nextch
) || c
== nextch
) {
23167 if (regmatch(preg
, next
)) {
23172 /* Couldn't or didn't, add one more */
23176 /* Couldn't or didn't -- back up. */
23183 static int regmatchrepeat(regex_t
*preg
, int scan
, int matchmin
)
23185 int *scanpt
= preg
->program
+ scan
;
23187 int max
= scanpt
[2];
23188 int min
= scanpt
[3];
23190 /* Have we reached min? */
23191 if (scanpt
[4] < min
) {
23192 /* No, so get another one */
23194 if (regmatch(preg
, scan
+ 5)) {
23200 if (scanpt
[4] > max
) {
23205 /* minimal, so try other branch first */
23206 if (regmatch(preg
, regnext(preg
, scan
))) {
23209 /* No, so try one more */
23211 if (regmatch(preg
, scan
+ 5)) {
23217 /* maximal, so try this branch again */
23218 if (scanpt
[4] < max
) {
23220 if (regmatch(preg
, scan
+ 5)) {
23225 /* At this point we are at max with no match. Try the other branch */
23226 return regmatch(preg
, regnext(preg
, scan
));
23230 - regmatch - main matching routine
23232 * Conceptually the strategy is simple: check to see whether the current
23233 * node matches, call self recursively to see whether the rest matches,
23234 * and then act accordingly. In practice we make some effort to avoid
23235 * recursion, in particular by going through "ordinary" nodes (that don't
23236 * need to know whether the rest of the match failed) by a loop instead of
23239 /* 0 failure, 1 success */
23240 static int regmatch(regex_t
*preg
, int prog
)
23242 int scan
; /* Current node. */
23243 int next
; /* Next node. */
23248 if (scan
!= 0 && regnarrate
)
23249 fprintf(stderr
, "%s(\n", regprop(scan
));
23251 while (scan
!= 0) {
23256 //fprintf(stderr, "%s...\n", regprop(scan));
23257 fprintf(stderr
, "%3d: %s...\n", scan
, regprop(OP(preg
, scan
))); /* Where, what. */
23260 next
= regnext(preg
, scan
);
23261 n
= reg_utf8_tounicode_case(preg
->reginput
, &c
, (preg
->cflags
& REG_ICASE
));
23263 switch (OP(preg
, scan
)) {
23265 if (preg
->reginput
!= preg
->regbol
)
23269 if (!reg_iseol(preg
, c
)) {
23274 /* Must be looking at a letter, digit, or _ */
23275 if ((!isalnum(UCHAR(c
))) && c
!= '_')
23277 /* Prev must be BOL or nonword */
23278 if (preg
->reginput
> preg
->regbol
&&
23279 (isalnum(UCHAR(preg
->reginput
[-1])) || preg
->reginput
[-1] == '_'))
23283 /* Can't match at BOL */
23284 if (preg
->reginput
> preg
->regbol
) {
23285 /* Current must be EOL or nonword */
23286 if (reg_iseol(preg
, c
) || !isalnum(UCHAR(c
)) || c
!= '_') {
23287 c
= preg
->reginput
[-1];
23288 /* Previous must be word */
23289 if (isalnum(UCHAR(c
)) || c
== '_') {
23298 if (reg_iseol(preg
, c
))
23300 preg
->reginput
+= n
;
23307 opnd
= OPERAND(scan
);
23308 len
= str_int_len(preg
->program
+ opnd
);
23310 slen
= prefix_cmp(preg
->program
+ opnd
, len
, preg
->reginput
, preg
->cflags
& REG_ICASE
);
23314 preg
->reginput
+= slen
;
23318 if (reg_iseol(preg
, c
) || reg_range_find(preg
->program
+ OPERAND(scan
), c
) == 0) {
23321 preg
->reginput
+= n
;
23324 if (reg_iseol(preg
, c
) || reg_range_find(preg
->program
+ OPERAND(scan
), c
) != 0) {
23327 preg
->reginput
+= n
;
23336 if (OP(preg
, next
) != BRANCH
) /* No choice. */
23337 next
= OPERAND(scan
); /* Avoid recursion. */
23340 save
= preg
->reginput
;
23341 if (regmatch(preg
, OPERAND(scan
))) {
23344 preg
->reginput
= save
;
23345 scan
= regnext(preg
, scan
);
23346 } while (scan
!= 0 && OP(preg
, scan
) == BRANCH
);
23354 return regmatchsimplerepeat(preg
, scan
, OP(preg
, scan
) == REPMIN
);
23358 return regmatchrepeat(preg
, scan
, OP(preg
, scan
) == REPXMIN
);
23361 return(1); /* Success! */
23364 if (OP(preg
, scan
) >= OPEN
+1 && OP(preg
, scan
) < CLOSE_END
) {
23367 save
= preg
->reginput
;
23369 if (regmatch(preg
, next
)) {
23372 * Don't set startp if some later
23373 * invocation of the same parentheses
23376 if (OP(preg
, scan
) < CLOSE
) {
23377 no
= OP(preg
, scan
) - OPEN
;
23378 if (no
< preg
->nmatch
&& preg
->pmatch
[no
].rm_so
== -1) {
23379 preg
->pmatch
[no
].rm_so
= save
- preg
->start
;
23383 no
= OP(preg
, scan
) - CLOSE
;
23384 if (no
< preg
->nmatch
&& preg
->pmatch
[no
].rm_eo
== -1) {
23385 preg
->pmatch
[no
].rm_eo
= save
- preg
->start
;
23392 return REG_ERR_INTERNAL
;
23399 * We get here only if there's trouble -- normally "case END" is
23400 * the terminating point.
23402 return REG_ERR_INTERNAL
;
23406 - regrepeat - repeatedly match something simple, report how many
23408 static int regrepeat(regex_t
*preg
, int p
, int max
)
23416 scan
= preg
->reginput
;
23418 switch (OP(preg
, p
)) {
23420 /* No need to handle utf8 specially here */
23421 while (!reg_iseol(preg
, *scan
) && count
< max
) {
23427 while (count
< max
) {
23428 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23429 if (preg
->program
[opnd
] != ch
) {
23437 while (count
< max
) {
23438 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23439 if (reg_iseol(preg
, ch
) || reg_range_find(preg
->program
+ opnd
, ch
) == 0) {
23447 while (count
< max
) {
23448 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23449 if (reg_iseol(preg
, ch
) || reg_range_find(preg
->program
+ opnd
, ch
) != 0) {
23456 default: /* Oh dear. Called inappropriately. */
23457 preg
->err
= REG_ERR_INTERNAL
;
23458 count
= 0; /* Best compromise. */
23461 preg
->reginput
= scan
;
23467 - regnext - dig the "next" pointer out of a node
23469 static int regnext(regex_t
*preg
, int p
)
23473 offset
= NEXT(preg
, p
);
23478 if (OP(preg
, p
) == BACK
)
23487 - regdump - dump a regexp onto stdout in vaguely comprehensible form
23489 static void regdump(regex_t
*preg
)
23492 int op
= EXACTLY
; /* Arbitrary non-END op. */
23497 for (i
= 1; i
< preg
->p
; i
++) {
23498 printf("%02x ", preg
->program
[i
]);
23499 if (i
% 16 == 15) {
23506 while (op
!= END
&& s
< preg
->p
) { /* While that wasn't END last time... */
23508 printf("%3d: %s", s
, regprop(op
)); /* Where, what. */
23509 next
= regnext(preg
, s
);
23510 if (next
== 0) /* Next ptr. */
23513 printf("(%d)", next
);
23515 if (op
== REP
|| op
== REPMIN
|| op
== REPX
|| op
== REPXMIN
) {
23516 int max
= preg
->program
[s
];
23517 int min
= preg
->program
[s
+ 1];
23518 if (max
== 65535) {
23519 printf("{%d,*}", min
);
23522 printf("{%d,%d}", min
, max
);
23524 printf(" %d", preg
->program
[s
+ 2]);
23527 else if (op
== ANYOF
|| op
== ANYBUT
) {
23528 /* set of ranges */
23530 while (preg
->program
[s
]) {
23531 int len
= preg
->program
[s
++];
23532 int first
= preg
->program
[s
++];
23533 buf
[utf8_fromunicode(buf
, first
)] = 0;
23536 buf
[utf8_fromunicode(buf
, first
+ len
- 1)] = 0;
23537 printf("-%s", buf
);
23542 else if (op
== EXACTLY
) {
23543 /* Literal string, where present. */
23545 while (preg
->program
[s
]) {
23546 buf
[utf8_fromunicode(buf
, preg
->program
[s
])] = 0;
23556 /* Header fields of interest. */
23557 if (preg
->regstart
) {
23558 buf
[utf8_fromunicode(buf
, preg
->regstart
)] = 0;
23559 printf("start '%s' ", buf
);
23562 printf("anchored ");
23563 if (preg
->regmust
!= 0) {
23565 printf("must have:");
23566 for (i
= 0; i
< preg
->regmlen
; i
++) {
23567 putchar(preg
->program
[preg
->regmust
+ i
]);
23576 - regprop - printable representation of opcode
23578 static const char *regprop( int op
)
23580 static char buf
[50];
23616 if (op
>= OPEN
&& op
< CLOSE
) {
23617 snprintf(buf
, sizeof(buf
), "OPEN%d", op
-OPEN
);
23619 else if (op
>= CLOSE
&& op
< CLOSE_END
) {
23620 snprintf(buf
, sizeof(buf
), "CLOSE%d", op
-CLOSE
);
23623 snprintf(buf
, sizeof(buf
), "?%d?\n", op
);
23630 size_t regerror(int errcode
, const regex_t
*preg
, char *errbuf
, size_t errbuf_size
)
23632 static const char *error_strings
[] = {
23641 "parentheses () not balanced",
23642 "braces {} not balanced",
23643 "invalid repetition count(s)",
23644 "extra characters",
23645 "*+ of empty atom",
23648 "count follows nothing",
23649 "trailing backslash",
23650 "corrupted program",
23651 "contains null char",
23655 if (errcode
< 0 || errcode
>= REG_ERR_NUM
) {
23656 err
= "Bad error code";
23659 err
= error_strings
[errcode
];
23662 return snprintf(errbuf
, errbuf_size
, "%s", err
);
23665 void regfree(regex_t
*preg
)
23667 free(preg
->program
);
23672 /* Jimsh - An interactive shell for Jim
23673 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
23674 * Copyright 2009 Steve Bennett <steveb@workware.net.au>
23676 * Licensed under the Apache License, Version 2.0 (the "License");
23677 * you may not use this file except in compliance with the License.
23678 * You may obtain a copy of the License at
23680 * http://www.apache.org/licenses/LICENSE-2.0
23682 * A copy of the license is also included in the source distribution
23683 * of Jim, as a TXT file name called LICENSE.
23685 * Unless required by applicable law or agreed to in writing, software
23686 * distributed under the License is distributed on an "AS IS" BASIS,
23687 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
23688 * See the License for the specific language governing permissions and
23689 * limitations under the License.
23693 #include <stdlib.h>
23694 #include <string.h>
23697 /* Script to help initialise jimsh */
23698 static const char jimsh_init
[] = \
23699 "proc _init {} {\n"
23700 "\trename _init {}\n"
23701 /* XXX This is a big ugly */
23702 #if defined(__MINGW32__)
23703 "\tlappend p {*}[split [env JIMLIB {}] {;}]\n"
23705 "\tlappend p {*}[split [env JIMLIB {}] :]\n"
23707 "\tlappend p {*}$::auto_path\n"
23708 "\tlappend p [file dirname [info nameofexecutable]]\n"
23709 "\tset ::auto_path $p\n"
23711 "\tif {$::tcl_interactive && [env HOME {}] ne \"\"} {\n"
23712 "\t\tforeach src {.jimrc jimrc.tcl} {\n"
23713 "\t\t\tif {[file exists [env HOME]/$src]} {\n"
23714 "\t\t\t\tuplevel #0 source [env HOME]/$src\n"
23720 /* XXX This is a big ugly */
23721 #if defined(__MINGW32__)
23722 "set jim_argv0 [string map {\\\\ /} $jim_argv0]\n"
23726 static void JimSetArgv(Jim_Interp
*interp
, int argc
, char *const argv
[])
23729 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
23731 /* Populate argv global var */
23732 for (n
= 0; n
< argc
; n
++) {
23733 Jim_Obj
*obj
= Jim_NewStringObj(interp
, argv
[n
], -1);
23735 Jim_ListAppendElement(interp
, listObj
, obj
);
23738 Jim_SetVariableStr(interp
, "argv", listObj
);
23739 Jim_SetVariableStr(interp
, "argc", Jim_NewIntObj(interp
, argc
));
23742 int main(int argc
, char *const argv
[])
23745 Jim_Interp
*interp
;
23747 if (argc
> 1 && strcmp(argv
[1], "--version") == 0) {
23748 printf("%d.%d\n", JIM_VERSION
/ 100, JIM_VERSION
% 100);
23752 /* Create and initialize the interpreter */
23753 interp
= Jim_CreateInterp();
23754 Jim_RegisterCoreCommands(interp
);
23756 /* Register static extensions */
23757 if (Jim_InitStaticExtensions(interp
) != JIM_OK
) {
23758 Jim_MakeErrorMessage(interp
);
23759 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23762 Jim_SetVariableStrWithStr(interp
, "jim_argv0", argv
[0]);
23763 Jim_SetVariableStrWithStr(interp
, JIM_INTERACTIVE
, argc
== 1 ? "1" : "0");
23764 retcode
= Jim_Eval(interp
, jimsh_init
);
23767 if (retcode
== JIM_ERR
) {
23768 Jim_MakeErrorMessage(interp
);
23769 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23771 if (retcode
!= JIM_EXIT
) {
23772 JimSetArgv(interp
, 0, NULL
);
23773 retcode
= Jim_InteractivePrompt(interp
);
23777 if (argc
> 2 && strcmp(argv
[1], "-e") == 0) {
23778 JimSetArgv(interp
, argc
- 3, argv
+ 3);
23779 retcode
= Jim_Eval(interp
, argv
[2]);
23780 if (retcode
!= JIM_ERR
) {
23781 printf("%s\n", Jim_String(Jim_GetResult(interp
)));
23785 Jim_SetVariableStr(interp
, "argv0", Jim_NewStringObj(interp
, argv
[1], -1));
23786 JimSetArgv(interp
, argc
- 2, argv
+ 2);
23787 retcode
= Jim_EvalFile(interp
, argv
[1]);
23789 if (retcode
== JIM_ERR
) {
23790 Jim_MakeErrorMessage(interp
);
23791 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23794 if (retcode
== JIM_EXIT
) {
23795 retcode
= Jim_GetExitCode(interp
);
23797 else if (retcode
== JIM_ERR
) {
23803 Jim_FreeInterp(interp
);