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 TCL_PLATFORM_PATH_SEPARATOR ";"
25 #define HAVE_MKDIR_ONE_ARG
28 #define TCL_PLATFORM_OS "unknown"
29 #define TCL_PLATFORM_PLATFORM "unix"
30 #define TCL_PLATFORM_PATH_SEPARATOR ":"
37 * UTF-8 utility functions
39 * (c) 2010 Steve Bennett <steveb@workware.net.au>
41 * See LICENCE for licence details.
45 * Converts the given unicode codepoint (0 - 0xffff) to utf-8
46 * and stores the result at 'p'.
48 * Returns the number of utf-8 characters (1-3).
50 int utf8_fromunicode(char *p
, unsigned short uc
);
55 /* No utf-8 support. 1 byte = 1 char */
56 #define utf8_strlen(S, B) (B) < 0 ? strlen(S) : (B)
57 #define utf8_tounicode(S, CP) (*(CP) = *(S), 1)
58 #define utf8_upper(C) toupper(C)
59 #define utf8_lower(C) tolower(C)
60 #define utf8_index(C, I) (I)
61 #define utf8_charlen(C) 1
62 #define utf8_prev_len(S, L) 1
66 * Returns the length of the utf-8 sequence starting with 'c'.
68 * Returns 1-4, or -1 if this is not a valid start byte.
70 * Note that charlen=4 is not supported by the rest of the API.
72 int utf8_charlen(int c
);
75 * Returns the number of characters in the utf-8
76 * string of the given byte length.
78 * Any bytes which are not part of an valid utf-8
79 * sequence are treated as individual characters.
81 * The string *must* be null terminated.
83 * Does not support unicode code points > \uffff
85 int utf8_strlen(const char *str
, int bytelen
);
88 * Returns the byte index of the given character in the utf-8 string.
90 * The string *must* be null terminated.
92 * This will return the byte length of a utf-8 string
93 * if given the char length.
95 int utf8_index(const char *str
, int charindex
);
98 * Returns the unicode codepoint corresponding to the
99 * utf-8 sequence 'str'.
101 * Stores the result in *uc and returns the number of bytes
104 * If 'str' is null terminated, then an invalid utf-8 sequence
105 * at the end of the string will be returned as individual bytes.
107 * If it is not null terminated, the length *must* be checked first.
109 * Does not support unicode code points > \uffff
111 int utf8_tounicode(const char *str
, int *uc
);
114 * Returns the number of bytes before 'str' that the previous
115 * utf-8 character sequence starts (which may be the middle of a sequence).
117 * Looks back at most 'len' bytes backwards, which must be > 0.
118 * If no start char is found, returns -len
120 int utf8_prev_len(const char *str
, int len
);
123 * Returns the upper-case variant of the given unicode codepoint.
125 * Does not support unicode code points > \uffff
127 int utf8_upper(int uc
);
130 * Returns the lower-case variant of the given unicode codepoint.
132 * NOTE: Use utf8_upper() in preference for case-insensitive matching.
134 * Does not support unicode code points > \uffff
136 int utf8_lower(int uc
);
141 /* Jim - A small embeddable Tcl interpreter
143 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
144 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
145 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
146 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
147 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
148 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
149 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
151 * Redistribution and use in source and binary forms, with or without
152 * modification, are permitted provided that the following conditions
155 * 1. Redistributions of source code must retain the above copyright
156 * notice, this list of conditions and the following disclaimer.
157 * 2. Redistributions in binary form must reproduce the above
158 * copyright notice, this list of conditions and the following
159 * disclaimer in the documentation and/or other materials
160 * provided with the distribution.
162 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
163 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
164 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
165 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
166 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
167 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
168 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
169 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
170 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
171 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
172 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
173 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
175 * The views and conclusions contained in the software and documentation
176 * are those of the authors and should not be interpreted as representing
177 * official policies, either expressed or implied, of the Jim Tcl Project.
179 *--- Inline Header File Documentation ---
180 * [By Duane Ellis, openocd@duaneellis.com, 8/18/8]
182 * Belief is "Jim" would greatly benifit if Jim Internals where
183 * documented in some way - form whatever, and perhaps - the package:
184 * 'doxygen' is the correct approach to do that.
186 * Details, see: http://www.stack.nl/~dimitri/doxygen/
188 * To that end please follow these guide lines:
190 * (A) Document the PUBLIC api in the .H file.
192 * (B) Document JIM Internals, in the .C file.
194 * (C) Remember JIM is embedded in other packages, to that end do
195 * not assume that your way of documenting is the right way, Jim's
196 * public documentation should be agnostic, such that it is some
197 * what agreeable with the "package" that is embedding JIM inside
198 * of it's own doxygen documentation.
200 * (D) Use minimal Doxygen tags.
202 * This will be an "ongoing work in progress" for some time.
214 #include <stdio.h> /* for the FILE typedef definition */
215 #include <stdlib.h> /* In order to export the Jim_Free() macro */
216 #include <stdarg.h> /* In order to get type va_list */
218 /* -----------------------------------------------------------------------------
219 * System configuration
220 * autoconf (configure) will set these
221 * ---------------------------------------------------------------------------*/
223 #ifndef HAVE_NO_AUTOCONF
226 /* -----------------------------------------------------------------------------
227 * Compiler specific fixes.
228 * ---------------------------------------------------------------------------*/
230 /* Long Long type and related issues */
232 # ifdef HAVE_LONG_LONG
233 # define jim_wide long long
235 # define LLONG_MAX 9223372036854775807LL
238 # define LLONG_MIN (-LLONG_MAX - 1LL)
240 # define JIM_WIDE_MIN LLONG_MIN
241 # define JIM_WIDE_MAX LLONG_MAX
243 # define jim_wide long
244 # define JIM_WIDE_MIN LONG_MIN
245 # define JIM_WIDE_MAX LONG_MAX
248 /* -----------------------------------------------------------------------------
249 * LIBC specific fixes
250 * ---------------------------------------------------------------------------*/
252 # ifdef HAVE_LONG_LONG
253 # define JIM_WIDE_MODIFIER "lld"
255 # define JIM_WIDE_MODIFIER "ld"
256 # define strtoull strtoul
260 #define UCHAR(c) ((unsigned char)(c))
262 /* -----------------------------------------------------------------------------
264 * ---------------------------------------------------------------------------*/
266 /* Jim version numbering: every version of jim is marked with a
267 * successive integer number. This is version 0. The first
268 * stable version will be 1, then 2, 3, and so on. */
269 #define JIM_VERSION 71
275 #define JIM_CONTINUE 4
278 /* The following are internal codes and should never been seen/used */
281 #define JIM_MAX_NESTING_DEPTH 1000 /* default max nesting depth */
283 /* Some function get an integer argument with flags to change
285 #define JIM_NONE 0 /* no flags set */
286 #define JIM_ERRMSG 1 /* set an error message in the interpreter. */
288 #define JIM_UNSHARED 4 /* Flag to Jim_GetVariable() */
290 /* Flags for Jim_SubstObj() */
291 #define JIM_SUBST_NOVAR 1 /* don't perform variables substitutions */
292 #define JIM_SUBST_NOCMD 2 /* don't perform command substitutions */
293 #define JIM_SUBST_NOESC 4 /* don't perform escapes substitutions */
294 #define JIM_SUBST_FLAG 128 /* flag to indicate that this is a real substition object */
296 /* Unused arguments generate annoying warnings... */
297 #define JIM_NOTUSED(V) ((void) V)
299 /* Flags for Jim_GetEnum() */
300 #define JIM_ENUM_ABBREV 2 /* Allow unambiguous abbreviation */
302 /* Flags used by API calls getting a 'nocase' argument. */
303 #define JIM_CASESENS 0 /* case sensitive */
304 #define JIM_NOCASE 1 /* no case */
306 /* Filesystem related */
307 #define JIM_PATH_LEN 1024
309 /* Newline, some embedded system may need -DJIM_CRLF */
311 #define JIM_NL "\r\n"
316 #define JIM_LIBPATH "auto_path"
317 #define JIM_INTERACTIVE "tcl_interactive"
319 /* -----------------------------------------------------------------------------
321 * ---------------------------------------------------------------------------*/
323 typedef struct Jim_Stack
{
329 /* -----------------------------------------------------------------------------
331 * ---------------------------------------------------------------------------*/
333 typedef struct Jim_HashEntry
{
339 struct Jim_HashEntry
*next
;
342 typedef struct Jim_HashTableType
{
343 unsigned int (*hashFunction
)(const void *key
);
344 const void *(*keyDup
)(void *privdata
, const void *key
);
345 void *(*valDup
)(void *privdata
, const void *obj
);
346 int (*keyCompare
)(void *privdata
, const void *key1
, const void *key2
);
347 void (*keyDestructor
)(void *privdata
, const void *key
);
348 void (*valDestructor
)(void *privdata
, void *obj
);
351 typedef struct Jim_HashTable
{
352 Jim_HashEntry
**table
;
353 const Jim_HashTableType
*type
;
355 unsigned int sizemask
;
357 unsigned int collisions
;
361 typedef struct Jim_HashTableIterator
{
364 Jim_HashEntry
*entry
, *nextEntry
;
365 } Jim_HashTableIterator
;
367 /* This is the initial size of every hash table */
368 #define JIM_HT_INITIAL_SIZE 16
370 /* ------------------------------- Macros ------------------------------------*/
371 #define Jim_FreeEntryVal(ht, entry) \
372 if ((ht)->type->valDestructor) \
373 (ht)->type->valDestructor((ht)->privdata, (entry)->u.val)
375 #define Jim_SetHashVal(ht, entry, _val_) do { \
376 if ((ht)->type->valDup) \
377 entry->u.val = (ht)->type->valDup((ht)->privdata, _val_); \
379 entry->u.val = (_val_); \
382 #define Jim_FreeEntryKey(ht, entry) \
383 if ((ht)->type->keyDestructor) \
384 (ht)->type->keyDestructor((ht)->privdata, (entry)->key)
386 #define Jim_SetHashKey(ht, entry, _key_) do { \
387 if ((ht)->type->keyDup) \
388 entry->key = (ht)->type->keyDup((ht)->privdata, _key_); \
390 entry->key = (_key_); \
393 #define Jim_CompareHashKeys(ht, key1, key2) \
394 (((ht)->type->keyCompare) ? \
395 (ht)->type->keyCompare((ht)->privdata, key1, key2) : \
398 #define Jim_HashKey(ht, key) (ht)->type->hashFunction(key)
400 #define Jim_GetHashEntryKey(he) ((he)->key)
401 #define Jim_GetHashEntryVal(he) ((he)->val)
402 #define Jim_GetHashTableCollisions(ht) ((ht)->collisions)
403 #define Jim_GetHashTableSize(ht) ((ht)->size)
404 #define Jim_GetHashTableUsed(ht) ((ht)->used)
406 /* -----------------------------------------------------------------------------
408 * ---------------------------------------------------------------------------*/
410 /* -----------------------------------------------------------------------------
411 * Jim object. This is mostly the same as Tcl_Obj itself,
412 * with the addition of the 'prev' and 'next' pointers.
413 * In Jim all the objects are stored into a linked list for GC purposes,
414 * so that it's possible to access every object living in a given interpreter
415 * sequentially. When an object is freed, it's moved into a different
416 * linked list, used as object pool.
418 * The refcount of a freed object is always -1.
419 * ---------------------------------------------------------------------------*/
420 typedef struct Jim_Obj
{
421 int refCount
; /* reference count */
422 char *bytes
; /* string representation buffer. NULL = no string repr. */
423 int length
; /* number of bytes in 'bytes', not including the numterm. */
424 const struct Jim_ObjType
*typePtr
; /* object type. */
425 /* Internal representation union */
427 /* integer number type */
429 /* hashed object type value */
433 /* return code type */
435 /* double number type */
437 /* Generic pointer */
439 /* Generic two pointers value */
444 /* Variable object */
446 unsigned jim_wide callFrameId
;
447 struct Jim_Var
*varPtr
;
451 unsigned jim_wide procEpoch
;
452 struct Jim_Cmd
*cmdPtr
;
456 struct Jim_Obj
**ele
; /* Elements vector */
457 int len
; /* Length */
458 int maxLen
; /* Allocated 'ele' length */
463 int charLength
; /* utf-8 char length. -1 if unknown */
468 struct Jim_Reference
*refPtr
;
472 const char *fileName
;
475 /* Dict substitution type */
477 struct Jim_Obj
*varNameObjPtr
;
478 struct Jim_Obj
*indexObjPtr
;
480 /* tagged binary type */
485 /* Regular expression pattern */
488 void *compre
; /* really an allocated (regex_t *) */
495 /* This are 8 or 16 bytes more for every object
496 * but this is required for efficient garbage collection
497 * of Jim references. */
498 struct Jim_Obj
*prevObjPtr
; /* pointer to the prev object. */
499 struct Jim_Obj
*nextObjPtr
; /* pointer to the next object. */
502 /* Jim_Obj related macros */
503 #define Jim_IncrRefCount(objPtr) \
505 #define Jim_DecrRefCount(interp, objPtr) \
506 if (--(objPtr)->refCount <= 0) Jim_FreeObj(interp, objPtr)
507 #define Jim_IsShared(objPtr) \
508 ((objPtr)->refCount > 1)
510 /* This macro is used when we allocate a new object using
511 * Jim_New...Obj(), but for some error we need to destroy it.
512 * Instead to use Jim_IncrRefCount() + Jim_DecrRefCount() we
513 * can just call Jim_FreeNewObj. To call Jim_Free directly
514 * seems too raw, the object handling may change and we want
515 * that Jim_FreeNewObj() can be called only against objects
516 * that are belived to have refcount == 0. */
517 #define Jim_FreeNewObj Jim_FreeObj
519 /* Free the internal representation of the object. */
520 #define Jim_FreeIntRep(i,o) \
521 if ((o)->typePtr && (o)->typePtr->freeIntRepProc) \
522 (o)->typePtr->freeIntRepProc(i, o)
524 /* Get the internal representation pointer */
525 #define Jim_GetIntRepPtr(o) (o)->internalRep.ptr
527 /* Set the internal representation pointer */
528 #define Jim_SetIntRepPtr(o, p) \
529 (o)->internalRep.ptr = (p)
531 /* The object type structure.
532 * There are four methods.
534 * - FreeIntRep is used to free the internal representation of the object.
535 * Can be NULL if there is nothing to free.
536 * - DupIntRep is used to duplicate the internal representation of the object.
537 * If NULL, when an object is duplicated, the internalRep union is
538 * directly copied from an object to another.
539 * Note that it's up to the caller to free the old internal repr of the
540 * object before to call the Dup method.
541 * - UpdateString is used to create the string from the internal repr.
542 * - setFromAny is used to convert the current object into one of this type.
547 typedef void (Jim_FreeInternalRepProc
)(struct Jim_Interp
*interp
,
548 struct Jim_Obj
*objPtr
);
549 typedef void (Jim_DupInternalRepProc
)(struct Jim_Interp
*interp
,
550 struct Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
551 typedef void (Jim_UpdateStringProc
)(struct Jim_Obj
*objPtr
);
553 typedef struct Jim_ObjType
{
554 const char *name
; /* The name of the type. */
555 Jim_FreeInternalRepProc
*freeIntRepProc
;
556 Jim_DupInternalRepProc
*dupIntRepProc
;
557 Jim_UpdateStringProc
*updateStringProc
;
561 /* Jim_ObjType flags */
562 #define JIM_TYPE_NONE 0 /* No flags */
563 #define JIM_TYPE_REFERENCES 1 /* The object may contain referneces. */
565 /* Starting from 1 << 20 flags are reserved for private uses of
566 * different calls. This way the same 'flags' argument may be used
567 * to pass both global flags and private flags. */
568 #define JIM_PRIV_FLAG_SHIFT 20
570 /* -----------------------------------------------------------------------------
571 * Call frame, vars, commands structures
572 * ---------------------------------------------------------------------------*/
575 typedef struct Jim_CallFrame
{
576 unsigned jim_wide id
; /* Call Frame ID. Used for caching. */
577 int level
; /* Level of this call frame. 0 = global */
578 struct Jim_HashTable vars
; /* Where local vars are stored */
579 struct Jim_HashTable
*staticVars
; /* pointer to procedure static vars */
580 struct Jim_CallFrame
*parentCallFrame
;
581 Jim_Obj
*const *argv
; /* object vector of the current procedure call. */
582 int argc
; /* number of args of the current procedure call. */
583 Jim_Obj
*procArgsObjPtr
; /* arglist object of the running procedure */
584 Jim_Obj
*procBodyObjPtr
; /* body object of the running procedure */
585 struct Jim_CallFrame
*nextFramePtr
;
586 const char *filename
; /* file and line of caller of this proc (if available) */
590 /* The var structure. It just holds the pointer of the referenced
591 * object. If linkFramePtr is not NULL the variable is a link
592 * to a variable of name store on objPtr living on the given callframe
593 * (this happens when the [global] or [upvar] command is used).
594 * The interp in order to always know how to free the Jim_Obj associated
595 * with a given variable because In Jim objects memory managment is
596 * bound to interpreters. */
597 typedef struct Jim_Var
{
599 struct Jim_CallFrame
*linkFramePtr
;
602 /* The cmd structure. */
603 typedef int (*Jim_CmdProc
)(struct Jim_Interp
*interp
, int argc
,
604 Jim_Obj
*const *argv
);
605 typedef void (*Jim_DelCmdProc
)(struct Jim_Interp
*interp
, void *privData
);
609 /* A command is implemented in C if funcPtr is != NULL, otherwise
610 * it's a Tcl procedure with the arglist and body represented by the
611 * two objects referenced by arglistObjPtr and bodyoObjPtr. */
612 typedef struct Jim_Cmd
{
613 int inUse
; /* Reference count */
614 int isproc
; /* Is this a procedure? */
617 /* native (C) command */
618 Jim_CmdProc cmdProc
; /* The command implementation */
619 Jim_DelCmdProc delProc
; /* Called when the command is deleted if != NULL */
620 void *privData
; /* command-private data available via Jim_CmdPrivData() */
624 Jim_Obj
*argListObjPtr
;
626 Jim_HashTable
*staticVars
; /* Static vars hash table. NULL if no statics. */
627 struct Jim_Cmd
*prevCmd
; /* Previous command defn if proc created 'local' */
628 int argListLen
; /* Length of argListObjPtr */
629 int reqArity
; /* Number of required parameters */
630 int optArity
; /* Number of optional parameters */
631 int argsPos
; /* Position of 'args', if specified, or -1 */
632 int upcall
; /* True if proc is currently in upcall */
634 Jim_Obj
*nameObjPtr
; /* Name of this arg */
635 Jim_Obj
*defaultObjPtr
; /* Default value, (or rename for $args) */
641 /* Pseudo Random Number Generator State structure */
642 typedef struct Jim_PrngState
{
643 unsigned char sbox
[256];
647 /* -----------------------------------------------------------------------------
648 * Jim interpreter structure.
649 * Fields similar to the real Tcl interpreter structure have the same names.
650 * ---------------------------------------------------------------------------*/
651 typedef struct Jim_Interp
{
652 Jim_Obj
*result
; /* object returned by the last command called. */
653 int errorLine
; /* Error line where an error occurred. */
654 char *errorFileName
; /* Error file where an error occurred. */
655 int addStackTrace
; /* > 0 If a level should be added to the stack trace */
656 int maxNestingDepth
; /* Used for infinite loop detection. */
657 int returnCode
; /* Completion code to return on JIM_RETURN. */
658 int returnLevel
; /* Current level of 'return -level' */
659 int exitCode
; /* Code to return to the OS on JIM_EXIT. */
660 long id
; /* Hold unique id for various purposes */
661 int signal_level
; /* A nesting level of catch -signal */
662 jim_wide sigmask
; /* Bit mask of caught signals, or 0 if none */
663 int (*signal_set_result
)(struct Jim_Interp
*interp
, jim_wide sigmask
); /* Set a result for the sigmask */
664 Jim_CallFrame
*framePtr
; /* Pointer to the current call frame */
665 Jim_CallFrame
*topFramePtr
; /* toplevel/global frame pointer. */
666 struct Jim_HashTable commands
; /* Commands hash table */
667 unsigned jim_wide procEpoch
; /* Incremented every time the result
668 of procedures names lookup caching
669 may no longer be valid. */
670 unsigned jim_wide callFrameEpoch
; /* Incremented every time a new
671 callframe is created. This id is used for the
672 'ID' field contained in the Jim_CallFrame
674 int local
; /* If 'local' is in effect, newly defined procs keep a reference to the old defn */
675 Jim_Obj
*liveList
; /* Linked list of all the live objects. */
676 Jim_Obj
*freeList
; /* Linked list of all the unused objects. */
677 Jim_Obj
*currentScriptObj
; /* Script currently in execution. */
678 Jim_Obj
*emptyObj
; /* Shared empty string object. */
679 Jim_Obj
*trueObj
; /* Shared true int object. */
680 Jim_Obj
*falseObj
; /* Shared false int object. */
681 unsigned jim_wide referenceNextId
; /* Next id for reference. */
682 struct Jim_HashTable references
; /* References hash table. */
683 jim_wide lastCollectId
; /* reference max Id of the last GC
684 execution. It's set to -1 while the collection
685 is running as sentinel to avoid to recursive
686 calls via the [collect] command inside
688 time_t lastCollectTime
; /* unix time of the last GC execution */
689 struct Jim_HashTable sharedStrings
; /* Shared Strings hash table */
690 Jim_Obj
*stackTrace
; /* Stack trace object. */
691 Jim_Obj
*errorProc
; /* Name of last procedure which returned an error */
692 Jim_Obj
*unknown
; /* Unknown command cache */
693 int unknown_called
; /* The unknown command has been invoked */
694 int errorFlag
; /* Set if an error occurred during execution. */
695 void *cmdPrivData
; /* Used to pass the private data pointer to
696 a command. It is set to what the user specified
697 via Jim_CreateCommand(). */
699 struct Jim_CallFrame
*freeFramesList
; /* list of CallFrame structures. */
700 struct Jim_HashTable assocData
; /* per-interp storage for use by packages */
701 Jim_PrngState
*prngState
; /* per interpreter Random Number Gen. state. */
702 struct Jim_HashTable packages
; /* Provided packages hash table */
703 Jim_Stack
*localProcs
; /* procs to be destroyed on end of evaluation */
704 Jim_Stack
*loadHandles
; /* handles of loaded modules [load] */
707 /* Currently provided as macro that performs the increment.
708 * At some point may be a real function doing more work.
709 * The proc epoch is used in order to know when a command lookup
710 * cached can no longer considered valid. */
711 #define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++
712 #define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l))
713 #define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval))
714 /* Note: Using trueObj and falseObj here makes some things slower...*/
715 #define Jim_SetResultBool(i,b) Jim_SetResultInt(i, b)
716 #define Jim_SetEmptyResult(i) Jim_SetResult(i, (i)->emptyObj)
717 #define Jim_GetResult(i) ((i)->result)
718 #define Jim_CmdPrivData(i) ((i)->cmdPrivData)
719 #define Jim_String(o) Jim_GetString((o), NULL)
721 /* Note that 'o' is expanded only one time inside this macro,
722 * so it's safe to use side effects. */
723 #define Jim_SetResult(i,o) do { \
724 Jim_Obj *_resultObjPtr_ = (o); \
725 Jim_IncrRefCount(_resultObjPtr_); \
726 Jim_DecrRefCount(i,(i)->result); \
727 (i)->result = _resultObjPtr_; \
730 /* Use this for filehandles, etc. which need a unique id */
731 #define Jim_GetId(i) (++(i)->id)
733 /* Reference structure. The interpreter pointer is held within privdata member in HashTable */
734 #define JIM_REFERENCE_TAGLEN 7 /* The tag is fixed-length, because the reference
735 string representation must be fixed length. */
736 typedef struct Jim_Reference
{
738 Jim_Obj
*finalizerCmdNamePtr
;
739 char tag
[JIM_REFERENCE_TAGLEN
+1];
742 /* -----------------------------------------------------------------------------
743 * Exported API prototypes.
744 * ---------------------------------------------------------------------------*/
746 /* Macros that are common for extensions and core. */
747 #define Jim_NewEmptyStringObj(i) Jim_NewStringObj(i, "", 0)
749 /* The core includes real prototypes, extensions instead
750 * include a global function pointer for every function exported.
751 * Once the extension calls Jim_InitExtension(), the global
752 * functon pointers are set to the value of the STUB table
753 * contained in the Jim_Interp structure.
755 * This makes Jim able to load extensions even if it is statically
756 * linked itself, and to load extensions compiled with different
757 * versions of Jim (as long as the API is still compatible.) */
759 /* Macros are common for core and extensions */
760 #define Jim_FreeHashTableIterator(iter) Jim_Free(iter)
764 /* Memory allocation */
765 JIM_EXPORT
void *Jim_Alloc (int size
);
766 JIM_EXPORT
void *Jim_Realloc(void *ptr
, int size
);
767 JIM_EXPORT
void Jim_Free (void *ptr
);
768 JIM_EXPORT
char * Jim_StrDup (const char *s
);
769 JIM_EXPORT
char *Jim_StrDupLen(const char *s
, int l
);
772 JIM_EXPORT
char **Jim_GetEnviron(void);
773 JIM_EXPORT
void Jim_SetEnviron(char **env
);
776 JIM_EXPORT
int Jim_Eval(Jim_Interp
*interp
, const char *script
);
777 /* in C code, you can do this and get better error messages */
778 /* Jim_Eval_Named( interp, "some tcl commands", __FILE__, __LINE__ ); */
779 JIM_EXPORT
int Jim_Eval_Named(Jim_Interp
*interp
, const char *script
,const char *filename
, int lineno
);
780 JIM_EXPORT
int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
);
781 JIM_EXPORT
int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
);
782 JIM_EXPORT
int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
);
783 JIM_EXPORT
int Jim_EvalObj (Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
);
784 JIM_EXPORT
int Jim_EvalObjVector (Jim_Interp
*interp
, int objc
,
785 Jim_Obj
*const *objv
);
786 JIM_EXPORT
int Jim_EvalObjPrefix(Jim_Interp
*interp
, const char *prefix
,
787 int objc
, Jim_Obj
*const *objv
);
788 JIM_EXPORT
int Jim_SubstObj (Jim_Interp
*interp
, Jim_Obj
*substObjPtr
,
789 Jim_Obj
**resObjPtrPtr
, int flags
);
792 JIM_EXPORT
void Jim_InitStack(Jim_Stack
*stack
);
793 JIM_EXPORT
void Jim_FreeStack(Jim_Stack
*stack
);
794 JIM_EXPORT
int Jim_StackLen(Jim_Stack
*stack
);
795 JIM_EXPORT
void Jim_StackPush(Jim_Stack
*stack
, void *element
);
796 JIM_EXPORT
void * Jim_StackPop(Jim_Stack
*stack
);
797 JIM_EXPORT
void * Jim_StackPeek(Jim_Stack
*stack
);
798 JIM_EXPORT
void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
)(void *ptr
));
801 JIM_EXPORT
int Jim_InitHashTable (Jim_HashTable
*ht
,
802 const Jim_HashTableType
*type
, void *privdata
);
803 JIM_EXPORT
int Jim_ExpandHashTable (Jim_HashTable
*ht
,
805 JIM_EXPORT
int Jim_AddHashEntry (Jim_HashTable
*ht
, const void *key
,
807 JIM_EXPORT
int Jim_ReplaceHashEntry (Jim_HashTable
*ht
,
808 const void *key
, void *val
);
809 JIM_EXPORT
int Jim_DeleteHashEntry (Jim_HashTable
*ht
,
811 JIM_EXPORT
int Jim_FreeHashTable (Jim_HashTable
*ht
);
812 JIM_EXPORT Jim_HashEntry
* Jim_FindHashEntry (Jim_HashTable
*ht
,
814 JIM_EXPORT
int Jim_ResizeHashTable (Jim_HashTable
*ht
);
815 JIM_EXPORT Jim_HashTableIterator
*Jim_GetHashTableIterator
817 JIM_EXPORT Jim_HashEntry
* Jim_NextHashEntry
818 (Jim_HashTableIterator
*iter
);
821 JIM_EXPORT Jim_Obj
* Jim_NewObj (Jim_Interp
*interp
);
822 JIM_EXPORT
void Jim_FreeObj (Jim_Interp
*interp
, Jim_Obj
*objPtr
);
823 JIM_EXPORT
void Jim_InvalidateStringRep (Jim_Obj
*objPtr
);
824 JIM_EXPORT
void Jim_InitStringRep (Jim_Obj
*objPtr
, const char *bytes
,
826 JIM_EXPORT Jim_Obj
* Jim_DuplicateObj (Jim_Interp
*interp
,
828 JIM_EXPORT
const char * Jim_GetString(Jim_Obj
*objPtr
,
830 JIM_EXPORT
int Jim_Length(Jim_Obj
*objPtr
);
833 JIM_EXPORT Jim_Obj
* Jim_NewStringObj (Jim_Interp
*interp
,
834 const char *s
, int len
);
835 JIM_EXPORT Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
,
836 const char *s
, int charlen
);
837 JIM_EXPORT Jim_Obj
* Jim_NewStringObjNoAlloc (Jim_Interp
*interp
,
839 JIM_EXPORT
void Jim_AppendString (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
840 const char *str
, int len
);
841 JIM_EXPORT
void Jim_AppendObj (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
842 Jim_Obj
*appendObjPtr
);
843 JIM_EXPORT
void Jim_AppendStrings (Jim_Interp
*interp
,
844 Jim_Obj
*objPtr
, ...);
845 JIM_EXPORT
int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
);
846 JIM_EXPORT
int Jim_StringMatchObj (Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
,
847 Jim_Obj
*objPtr
, int nocase
);
848 JIM_EXPORT Jim_Obj
* Jim_StringRangeObj (Jim_Interp
*interp
,
849 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
,
850 Jim_Obj
*lastObjPtr
);
851 JIM_EXPORT Jim_Obj
* Jim_FormatString (Jim_Interp
*interp
,
852 Jim_Obj
*fmtObjPtr
, int objc
, Jim_Obj
*const *objv
);
853 JIM_EXPORT Jim_Obj
* Jim_ScanString (Jim_Interp
*interp
, Jim_Obj
*strObjPtr
,
854 Jim_Obj
*fmtObjPtr
, int flags
);
855 JIM_EXPORT
int Jim_CompareStringImmediate (Jim_Interp
*interp
,
856 Jim_Obj
*objPtr
, const char *str
);
857 JIM_EXPORT
int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
,
858 Jim_Obj
*secondObjPtr
, int nocase
);
859 JIM_EXPORT
int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
861 /* reference object */
862 JIM_EXPORT Jim_Obj
* Jim_NewReference (Jim_Interp
*interp
,
863 Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
);
864 JIM_EXPORT Jim_Reference
* Jim_GetReference (Jim_Interp
*interp
,
866 JIM_EXPORT
int Jim_SetFinalizer (Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
);
867 JIM_EXPORT
int Jim_GetFinalizer (Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
);
870 JIM_EXPORT Jim_Interp
* Jim_CreateInterp (void);
871 JIM_EXPORT
void Jim_FreeInterp (Jim_Interp
*i
);
872 JIM_EXPORT
int Jim_GetExitCode (Jim_Interp
*interp
);
873 JIM_EXPORT
const char *Jim_ReturnCode(int code
);
874 JIM_EXPORT
void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...);
877 JIM_EXPORT
void Jim_RegisterCoreCommands (Jim_Interp
*interp
);
878 JIM_EXPORT
int Jim_CreateCommand (Jim_Interp
*interp
,
879 const char *cmdName
, Jim_CmdProc cmdProc
, void *privData
,
880 Jim_DelCmdProc delProc
);
881 JIM_EXPORT
int Jim_DeleteCommand (Jim_Interp
*interp
,
882 const char *cmdName
);
883 JIM_EXPORT
int Jim_RenameCommand (Jim_Interp
*interp
,
884 const char *oldName
, const char *newName
);
885 JIM_EXPORT Jim_Cmd
* Jim_GetCommand (Jim_Interp
*interp
,
886 Jim_Obj
*objPtr
, int flags
);
887 JIM_EXPORT
int Jim_SetVariable (Jim_Interp
*interp
,
888 Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
);
889 JIM_EXPORT
int Jim_SetVariableStr (Jim_Interp
*interp
,
890 const char *name
, Jim_Obj
*objPtr
);
891 JIM_EXPORT
int Jim_SetGlobalVariableStr (Jim_Interp
*interp
,
892 const char *name
, Jim_Obj
*objPtr
);
893 JIM_EXPORT
int Jim_SetVariableStrWithStr (Jim_Interp
*interp
,
894 const char *name
, const char *val
);
895 JIM_EXPORT
int Jim_SetVariableLink (Jim_Interp
*interp
,
896 Jim_Obj
*nameObjPtr
, Jim_Obj
*targetNameObjPtr
,
897 Jim_CallFrame
*targetCallFrame
);
898 JIM_EXPORT Jim_Obj
* Jim_GetVariable (Jim_Interp
*interp
,
899 Jim_Obj
*nameObjPtr
, int flags
);
900 JIM_EXPORT Jim_Obj
* Jim_GetGlobalVariable (Jim_Interp
*interp
,
901 Jim_Obj
*nameObjPtr
, int flags
);
902 JIM_EXPORT Jim_Obj
* Jim_GetVariableStr (Jim_Interp
*interp
,
903 const char *name
, int flags
);
904 JIM_EXPORT Jim_Obj
* Jim_GetGlobalVariableStr (Jim_Interp
*interp
,
905 const char *name
, int flags
);
906 JIM_EXPORT
int Jim_UnsetVariable (Jim_Interp
*interp
,
907 Jim_Obj
*nameObjPtr
, int flags
);
910 JIM_EXPORT Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
,
911 Jim_Obj
*levelObjPtr
);
913 /* garbage collection */
914 JIM_EXPORT
int Jim_Collect (Jim_Interp
*interp
);
915 JIM_EXPORT
void Jim_CollectIfNeeded (Jim_Interp
*interp
);
918 JIM_EXPORT
int Jim_GetIndex (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
922 JIM_EXPORT Jim_Obj
* Jim_NewListObj (Jim_Interp
*interp
,
923 Jim_Obj
*const *elements
, int len
);
924 JIM_EXPORT
void Jim_ListInsertElements (Jim_Interp
*interp
,
925 Jim_Obj
*listPtr
, int listindex
, int objc
, Jim_Obj
*const *objVec
);
926 JIM_EXPORT
void Jim_ListAppendElement (Jim_Interp
*interp
,
927 Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
928 JIM_EXPORT
void Jim_ListAppendList (Jim_Interp
*interp
,
929 Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
);
930 JIM_EXPORT
int Jim_ListLength (Jim_Interp
*interp
, Jim_Obj
*objPtr
);
931 JIM_EXPORT
int Jim_ListIndex (Jim_Interp
*interp
, Jim_Obj
*listPrt
,
932 int listindex
, Jim_Obj
**objPtrPtr
, int seterr
);
933 JIM_EXPORT
int Jim_SetListIndex (Jim_Interp
*interp
,
934 Jim_Obj
*varNamePtr
, Jim_Obj
*const *indexv
, int indexc
,
936 JIM_EXPORT Jim_Obj
* Jim_ConcatObj (Jim_Interp
*interp
, int objc
,
937 Jim_Obj
*const *objv
);
940 JIM_EXPORT Jim_Obj
* Jim_NewDictObj (Jim_Interp
*interp
,
941 Jim_Obj
*const *elements
, int len
);
942 JIM_EXPORT
int Jim_DictKey (Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
943 Jim_Obj
*keyPtr
, Jim_Obj
**objPtrPtr
, int flags
);
944 JIM_EXPORT
int Jim_DictKeysVector (Jim_Interp
*interp
,
945 Jim_Obj
*dictPtr
, Jim_Obj
*const *keyv
, int keyc
,
946 Jim_Obj
**objPtrPtr
, int flags
);
947 JIM_EXPORT
int Jim_SetDictKeysVector (Jim_Interp
*interp
,
948 Jim_Obj
*varNamePtr
, Jim_Obj
*const *keyv
, int keyc
,
950 JIM_EXPORT
int Jim_DictPairs(Jim_Interp
*interp
,
951 Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
);
952 JIM_EXPORT
int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
953 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
);
954 JIM_EXPORT
int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObj
);
955 JIM_EXPORT
int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
957 /* return code object */
958 JIM_EXPORT
int Jim_GetReturnCode (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
961 /* expression object */
962 JIM_EXPORT
int Jim_EvalExpression (Jim_Interp
*interp
,
963 Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
);
964 JIM_EXPORT
int Jim_GetBoolFromExpr (Jim_Interp
*interp
,
965 Jim_Obj
*exprObjPtr
, int *boolPtr
);
968 JIM_EXPORT
int Jim_GetWide (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
970 JIM_EXPORT
int Jim_GetLong (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
972 #define Jim_NewWideObj Jim_NewIntObj
973 JIM_EXPORT Jim_Obj
* Jim_NewIntObj (Jim_Interp
*interp
,
977 JIM_EXPORT
int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
979 JIM_EXPORT
void Jim_SetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
981 JIM_EXPORT Jim_Obj
* Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
);
984 JIM_EXPORT
const char * Jim_GetSharedString (Jim_Interp
*interp
,
986 JIM_EXPORT
void Jim_ReleaseSharedString (Jim_Interp
*interp
,
989 /* commands utilities */
990 JIM_EXPORT
void Jim_WrongNumArgs (Jim_Interp
*interp
, int argc
,
991 Jim_Obj
*const *argv
, const char *msg
);
992 JIM_EXPORT
int Jim_GetEnum (Jim_Interp
*interp
, Jim_Obj
*objPtr
,
993 const char * const *tablePtr
, int *indexPtr
, const char *name
, int flags
);
994 JIM_EXPORT
int Jim_ScriptIsComplete (const char *s
, int len
,
997 * Find a matching name in the array of the given length.
999 * NULL entries are ignored.
1001 * Returns the matching index if found, or -1 if not.
1003 JIM_EXPORT
int Jim_FindByName(const char *name
, const char * const array
[], size_t len
);
1005 /* package utilities */
1006 typedef void (Jim_InterpDeleteProc
)(Jim_Interp
*interp
, void *data
);
1007 JIM_EXPORT
void * Jim_GetAssocData(Jim_Interp
*interp
, const char *key
);
1008 JIM_EXPORT
int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
,
1009 Jim_InterpDeleteProc
*delProc
, void *data
);
1010 JIM_EXPORT
int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
);
1012 /* Packages C API */
1014 JIM_EXPORT
int Jim_PackageProvide (Jim_Interp
*interp
,
1015 const char *name
, const char *ver
, int flags
);
1016 JIM_EXPORT
int Jim_PackageRequire (Jim_Interp
*interp
,
1017 const char *name
, int flags
);
1019 /* error messages */
1020 JIM_EXPORT
void Jim_MakeErrorMessage (Jim_Interp
*interp
);
1022 /* interactive mode */
1023 JIM_EXPORT
int Jim_InteractivePrompt (Jim_Interp
*interp
);
1026 JIM_EXPORT
int Jim_InitStaticExtensions(Jim_Interp
*interp
);
1027 JIM_EXPORT
int Jim_StringToWide(const char *str
, jim_wide
*widePtr
, int base
);
1030 JIM_EXPORT
int Jim_LoadLibrary(Jim_Interp
*interp
, const char *pathName
);
1031 JIM_EXPORT
void Jim_FreeLoadHandles(Jim_Interp
*interp
);
1034 JIM_EXPORT
FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*command
);
1037 /* type inspection - avoid where possible */
1038 JIM_EXPORT
int Jim_IsDict(Jim_Obj
*objPtr
);
1039 JIM_EXPORT
int Jim_IsList(Jim_Obj
*objPtr
);
1045 #endif /* __JIM__H */
1048 * Local Variables: ***
1049 * c-basic-offset: 4 ***
1053 /* Provides a common approach to implementing Tcl commands
1054 * which implement subcommands
1056 #ifndef JIM_SUBCMD_H
1057 #define JIM_SUBCMD_H
1060 #define JIM_MODFLAG_HIDDEN 0x0001 /* Don't show the subcommand in usage or commands */
1061 #define JIM_MODFLAG_FULLARGV 0x0002 /* Subcmd proc gets called with full argv */
1063 /* Custom flags start at 0x0100 */
1066 * Returns JIM_OK if OK, JIM_ERR (etc.) on error, break, continue, etc.
1067 * Returns -1 if invalid args.
1069 typedef int tclmod_cmd_function(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1072 const char *cmd
; /* Name of the (sub)command */
1073 const char *args
; /* Textual description of allowed args */
1074 tclmod_cmd_function
*function
; /* Function implementing the subcommand */
1075 short minargs
; /* Minimum required arguments */
1076 short maxargs
; /* Maximum allowed arguments or -1 if no limit */
1077 unsigned flags
; /* JIM_MODFLAG_... plus custom flags */
1078 const char *description
; /* Description of the subcommand */
1082 * Looks up the appropriate subcommand in the given command table and return
1083 * the command function which implements the subcommand.
1084 * NULL will be returned and an appropriate error will be set if the subcommand or
1085 * arguments are invalid.
1089 * const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, command_table, argc, argv);
1091 * return Jim_CallSubCmd(interp, ct, argc, argv);
1095 const jim_subcmd_type
*
1096 Jim_ParseSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
*command_table
, int argc
, Jim_Obj
*const *argv
);
1099 * Parses the args against the given command table and executes the subcommand if found
1100 * or sets an appropriate error if the subcommand or arguments is invalid.
1102 * Can be used directly with Jim_CreateCommand() where the ClientData is the command table.
1104 * e.g. Jim_CreateCommand(interp, "mycmd", Jim_SubCmdProc, command_table, NULL);
1106 int Jim_SubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1109 * Invokes the given subcmd with the given args as returned
1110 * by Jim_ParseSubCmd()
1112 * If ct is NULL, returns JIM_ERR, leaving any message.
1113 * Otherwise invokes ct->function
1115 * If ct->function returns -1, sets an error message and returns JIM_ERR.
1116 * Otherwise returns the result of ct->function.
1118 int Jim_CallSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
*ct
, int argc
, Jim_Obj
*const *argv
);
1121 * Standard processing for a command.
1123 * This does the '-help' and '-usage' check and the number of args checks.
1124 * for a top level command against a single 'jim_subcmd_type' structure.
1126 * Additionally, if command_table->function is set, it should point to a sub command table
1127 * and '-subhelp ?subcmd?', '-subusage' and '-subcommands' are then also recognised.
1129 * Returns 0 if user requested usage, -1 on arg error, 1 if OK to process.
1132 Jim_CheckCmdUsage(Jim_Interp
*interp
, const jim_subcmd_type
*command_table
, int argc
, Jim_Obj
*const *argv
);
1138 #ifndef _JIMAUTOCONF_H
1139 #error Need jimautoconf.h
1142 #if defined(HAVE_REGCOMP) && !defined(JIM_REGEXP)
1143 /* Use POSIX regex */
1151 * Definitions etc. for regexp(3) routines.
1153 * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
1154 * not the System V one.
1156 * 11/04/02 (seiwald) - const-ing for string literals
1165 * The "internal use only" fields in regexp.h are present to pass info from
1166 * compile to execute that permits the execute phase to run lots faster on
1167 * simple cases. They are:
1169 * regstart char that must begin a match; '\0' if none obvious
1170 * reganch is the match anchored (at beginning-of-line only)?
1171 * regmust string (pointer into program) that match must include, or NULL
1172 * regmlen length of regmust string
1174 * Regstart and reganch permit very fast decisions on suitable starting points
1175 * for a match, cutting down the work a lot. Regmust permits fast rejection
1176 * of lines that cannot possibly match. The regmust tests are costly enough
1177 * that regcomp() supplies a regmust only if the r.e. contains something
1178 * potentially expensive (at present, the only such thing detected is * or +
1179 * at the start of the r.e., which can involve a lot of backup). Regmlen is
1180 * supplied because the test in regexec() needs it and regcomp() is computing
1184 typedef struct regexp
{
1186 int re_nsub
; /* number of parenthesized subexpressions */
1189 int cflags
; /* Flags used when compiling */
1190 int err
; /* Any error which occurred during compile */
1191 int regstart
; /* Internal use only. */
1192 int reganch
; /* Internal use only. */
1193 int regmust
; /* Internal use only. */
1194 int regmlen
; /* Internal use only. */
1195 int *program
; /* Allocated */
1197 /* working state - compile */
1198 const char *regparse
; /* Input-scan pointer. */
1199 int p
; /* Current output pos in program */
1200 int proglen
; /* Allocated program size */
1202 /* working state - exec */
1203 int eflags
; /* Flags used when executing */
1204 const char *start
; /* Initial string pointer. */
1205 const char *reginput
; /* Current input pointer. */
1206 const char *regbol
; /* Beginning of input, for ^ check. */
1208 /* Input to regexec() */
1209 regmatch_t
*pmatch
; /* submatches will be stored here */
1210 int nmatch
; /* size of pmatch[] */
1213 typedef regexp regex_t
;
1215 #define REG_EXTENDED 0
1216 #define REG_NEWLINE 1
1219 #define REG_NOTBOL 16
1222 REG_NOERROR
, /* Success. */
1223 REG_NOMATCH
, /* Didn't find a match (for regexec). */
1224 REG_BADPAT
, /* >= REG_BADPAT is an error */
1225 REG_ERR_NULL_ARGUMENT
,
1229 REG_ERR_TOO_MANY_PAREN
,
1230 REG_ERR_UNMATCHED_PAREN
,
1231 REG_ERR_UNMATCHED_BRACES
,
1233 REG_ERR_JUNK_ON_END
,
1234 REG_ERR_OPERAND_COULD_BE_EMPTY
,
1235 REG_ERR_NESTED_COUNT
,
1237 REG_ERR_COUNT_FOLLOWS_NOTHING
,
1238 REG_ERR_TRAILING_BACKSLASH
,
1244 int regcomp(regex_t
*preg
, const char *regex
, int cflags
);
1245 int regexec(regex_t
*preg
, const char *string
, size_t nmatch
, regmatch_t pmatch
[], int eflags
);
1246 size_t regerror(int errcode
, const regex_t
*preg
, char *errbuf
, size_t errbuf_size
);
1247 void regfree(regex_t
*preg
);
1252 int Jim_bootstrapInit(Jim_Interp
*interp
)
1254 if (Jim_PackageProvide(interp
, "bootstrap", "1.0", JIM_ERRMSG
))
1257 return Jim_Eval_Named(interp
,
1260 "proc package {args} {}\n"
1261 ,"bootstrap.tcl", 1);
1263 int Jim_initjimshInit(Jim_Interp
*interp
)
1265 if (Jim_PackageProvide(interp
, "initjimsh", "1.0", JIM_ERRMSG
))
1268 return Jim_Eval_Named(interp
,
1272 "proc _jimsh_init {} {\n"
1273 " rename _jimsh_init {}\n"
1276 " lappend p {*}[split [env JIMLIB {}] $::tcl_platform(pathSeparator)]\n"
1277 " lappend p {*}$::auto_path\n"
1278 " lappend p [file dirname [info nameofexecutable]]\n"
1279 " set ::auto_path $p\n"
1281 " if {$::tcl_interactive && [env HOME {}] ne \"\"} {\n"
1282 " foreach src {.jimrc jimrc.tcl} {\n"
1283 " if {[file exists [env HOME]/$src]} {\n"
1284 " uplevel #0 source [env HOME]/$src\n"
1291 "if {$tcl_platform(platform) eq \"windows\"} {\n"
1292 " set jim_argv0 [string map {\\\\ /} $jim_argv0]\n"
1296 ,"initjimsh.tcl", 1);
1298 int Jim_globInit(Jim_Interp
*interp
)
1300 if (Jim_PackageProvide(interp
, "glob", "1.0", JIM_ERRMSG
))
1303 return Jim_Eval_Named(interp
,
1310 "package require readdir\n"
1323 "proc glob {args} {\n"
1328 " local proc glob.readdir_pattern {dir pattern} {\n"
1332 " if {$pattern in {. ..}} {\n"
1333 " return $pattern\n"
1337 " if {[string match {*[*?]*} $pattern]} {\n"
1339 " set files [readdir -nocomplain $dir]\n"
1340 " } elseif {[file isdir $dir] && [file exists $dir/$pattern]} {\n"
1341 " set files [list $pattern]\n"
1346 " foreach name $files {\n"
1347 " if {[string match $pattern $name]} {\n"
1349 " if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n"
1352 " lappend result $name\n"
1363 " proc glob.expandbraces {pattern} {\n"
1366 " if {[set fb [string first \"\\{\" $pattern]] < 0} {\n"
1367 " return $pattern\n"
1369 " if {[set nb [string first \"\\}\" $pattern $fb]] < 0} {\n"
1370 " return $pattern\n"
1372 " set before [string range $pattern 0 $fb-1]\n"
1373 " set braced [string range $pattern $fb+1 $nb-1]\n"
1374 " set after [string range $pattern $nb+1 end]\n"
1376 " lmap part [split $braced ,] {\n"
1377 " set pat $before$part$after\n"
1382 " proc glob.glob {pattern} {\n"
1383 " set dir [file dirname $pattern]\n"
1384 " if {$dir eq $pattern} {\n"
1386 " return [list $dir]\n"
1390 " set dirlist [glob.glob $dir]\n"
1391 " set pattern [file tail $pattern]\n"
1395 " foreach dir $dirlist {\n"
1396 " set globdir $dir\n"
1397 " if {[string match \"*/\" $dir]} {\n"
1399 " } elseif {$dir eq \".\"} {\n"
1400 " set globdir \"\"\n"
1405 " foreach pat [glob.expandbraces $pattern] {\n"
1406 " foreach name [glob.readdir_pattern $dir $pat] {\n"
1407 " lappend result $globdir$sep$name\n"
1415 " set nocomplain 0\n"
1417 " if {[lindex $args 0] eq \"-nocomplain\"} {\n"
1418 " set nocomplain 1\n"
1419 " set args [lrange $args 1 end]\n"
1423 " foreach pattern $args {\n"
1424 " lappend result {*}[glob.glob $pattern]\n"
1427 " if {$nocomplain == 0 && [llength $result] == 0} {\n"
1428 " return -code error \"no files matched glob patterns\"\n"
1435 int Jim_stdlibInit(Jim_Interp
*interp
)
1437 if (Jim_PackageProvide(interp
, "stdlib", "1.0", JIM_ERRMSG
))
1440 return Jim_Eval_Named(interp
,
1444 "proc alias {name args} {\n"
1445 " set prefix $args\n"
1446 " proc $name args prefix {\n"
1447 " tailcall {*}$prefix {*}$args\n"
1452 "proc lambda {arglist args} {\n"
1453 " set name [ref {} function lambda.finalizer]\n"
1454 " tailcall proc $name $arglist {*}$args\n"
1457 "proc lambda.finalizer {name val} {\n"
1458 " rename $name {}\n"
1462 "proc curry {args} {\n"
1463 " set prefix $args\n"
1464 " lambda args prefix {\n"
1465 " tailcall {*}$prefix {*}$args\n"
1477 "proc function {value} {\n"
1482 "proc lassign {list args} {\n"
1484 " lappend list {}\n"
1485 " uplevel 1 [list foreach $args $list break]\n"
1486 " lrange $list [llength $args] end-1\n"
1492 "proc stacktrace {} {\n"
1494 " foreach level [range 1 [info level]] {\n"
1495 " lassign [info frame -$level] p f l\n"
1496 " lappend trace $p $f $l\n"
1502 "proc stackdump {stacktrace} {\n"
1505 " foreach {l f p} [lreverse $stacktrace] {\n"
1507 " append result \\n\n"
1510 " if {$p ne \"\"} {\n"
1511 " append result \"in procedure '$p' \"\n"
1512 " if {$f ne \"\"} {\n"
1513 " append result \"called \"\n"
1516 " if {$f ne \"\"} {\n"
1517 " append result \"at file \\\"$f\\\", line $l\"\n"
1525 "proc errorInfo {msg {stacktrace \"\"}} {\n"
1526 " if {$stacktrace eq \"\"} {\n"
1527 " set stacktrace [info stacktrace]\n"
1529 " lassign $stacktrace p f l\n"
1530 " if {$f ne \"\"} {\n"
1531 " set result \"Runtime Error: $f:$l: \"\n"
1533 " append result \"$msg\\n\"\n"
1534 " append result [stackdump $stacktrace]\n"
1537 " string trim $result\n"
1542 "proc {info nameofexecutable} {} {\n"
1543 " if {[info exists ::jim_argv0]} {\n"
1544 " if {[string match \"*/*\" $::jim_argv0]} {\n"
1545 " return [file join [pwd] $::jim_argv0]\n"
1547 " foreach path [split [env PATH \"\"] $::tcl_platform(pathSeparator)] {\n"
1548 " set exec [file join [pwd] $path $::jim_argv0]\n"
1549 " if {[file executable $exec]} {\n"
1558 "proc {dict with} {dictVar args script} {\n"
1559 " upvar $dictVar dict\n"
1561 " foreach {n v} [dict get $dict {*}$args] {\n"
1562 " upvar $n var_$n\n"
1564 " lappend keys $n\n"
1566 " catch {uplevel 1 $script} msg opts\n"
1567 " if {[info exists dict] && [dict exists $dict {*}$args]} {\n"
1568 " foreach n $keys {\n"
1569 " if {[info exists var_$n]} {\n"
1570 " dict set dict {*}$args $n [set var_$n]\n"
1572 " dict unset dict {*}$args $n\n"
1576 " return {*}$opts $msg\n"
1581 "proc {dict merge} {dict args} {\n"
1582 " foreach d $args {\n"
1585 " foreach {k v} $d {\n"
1586 " dict set dict $k $v\n"
1593 int Jim_tclcompatInit(Jim_Interp
*interp
)
1595 if (Jim_PackageProvide(interp
, "tclcompat", "1.0", JIM_ERRMSG
))
1598 return Jim_Eval_Named(interp
,
1608 "if {[info commands stdout] ne \"\"} {\n"
1610 " foreach p {gets flush close eof seek tell} {\n"
1611 " proc $p {chan args} {p} {\n"
1612 " tailcall $chan $p {*}$args\n"
1619 " proc puts {{-nonewline {}} {chan stdout} msg} {\n"
1620 " if {${-nonewline} ni {-nonewline {}}} {\n"
1621 " tailcall ${-nonewline} puts $msg\n"
1623 " tailcall $chan puts {*}${-nonewline} $msg\n"
1630 " proc read {{-nonewline {}} chan} {\n"
1631 " if {${-nonewline} ni {-nonewline {}}} {\n"
1632 " tailcall ${-nonewline} read {*}${chan}\n"
1634 " tailcall $chan read {*}${-nonewline}\n"
1637 " proc fconfigure {f args} {\n"
1638 " foreach {n v} $args {\n"
1639 " switch -glob -- $n {\n"
1644 " $f buffering $v\n"
1650 " return -code error \"fconfigure: unknown option $n\"\n"
1658 "proc case {var args} {\n"
1660 " if {[lindex $args 0] eq \"in\"} {\n"
1661 " set args [lrange $args 1 end]\n"
1665 " if {[llength $args] == 1} {\n"
1666 " set args [lindex $args 0]\n"
1670 " if {[llength $args] % 2 != 0} {\n"
1671 " return -code error \"extra case pattern with no body\"\n"
1675 " local proc case.checker {value pattern} {\n"
1676 " string match $pattern $value\n"
1679 " foreach {value action} $args {\n"
1680 " if {$value eq \"default\"} {\n"
1681 " set do_action $action\n"
1683 " } elseif {[lsearch -bool -command case.checker $value $var]} {\n"
1684 " set do_action $action\n"
1689 " if {[info exists do_action]} {\n"
1690 " set rc [catch [list uplevel 1 $do_action] result opts]\n"
1692 " incr opts(-level)\n"
1694 " return {*}$opts $result\n"
1699 "proc fileevent {args} {\n"
1700 " tailcall {*}$args\n"
1706 "proc parray {arrayname {pattern *} {puts puts}} {\n"
1707 " upvar $arrayname a\n"
1710 " foreach name [array names a $pattern]] {\n"
1711 " if {[string length $name] > $max} {\n"
1712 " set max [string length $name]\n"
1715 " incr max [string length $arrayname]\n"
1717 " foreach name [lsort [array names a $pattern]] {\n"
1718 " $puts [format \"%-${max}s = %s\" $arrayname\\($name\\) $a($name)]\n"
1723 "proc {file copy} {{force {}} source target} {\n"
1725 " if {$force ni {{} -force}} {\n"
1726 " error \"bad option \\\"$force\\\": should be -force\"\n"
1729 " set in [open $source]\n"
1731 " if {$force eq \"\" && [file exists $target]} {\n"
1733 " error \"error copying \\\"$source\\\" to \\\"$target\\\": file already exists\"\n"
1735 " set out [open $target w]\n"
1736 " $in copyto $out\n"
1738 " } on error {msg opts} {\n"
1739 " incr opts(-level)\n"
1740 " return {*}$opts $msg\n"
1742 " catch {$in close}\n"
1748 "proc popen {cmd {mode r}} {\n"
1749 " lassign [socket pipe] r w\n"
1751 " if {[string match \"w*\" $mode]} {\n"
1752 " lappend cmd <@$r &\n"
1753 " set pids [exec {*}$cmd]\n"
1757 " lappend cmd >@$w &\n"
1758 " set pids [exec {*}$cmd]\n"
1762 " lambda {cmd args} {f pids} {\n"
1763 " if {$cmd eq \"pid\"} {\n"
1766 " if {$cmd eq \"close\"} {\n"
1769 " foreach p $pids { os.wait $p }\n"
1772 " tailcall $f $cmd {*}$args\n"
1774 " } on error {error opts} {\n"
1782 "local proc pid {{chan {}}} {\n"
1783 " if {$chan eq \"\"} {\n"
1784 " tailcall upcall pid\n"
1786 " if {[catch {$chan tell}]} {\n"
1787 " return -code error \"can not find channel named \\\"$chan\\\"\"\n"
1789 " if {[catch {$chan pid} pids]} {\n"
1808 "proc try {args} {\n"
1809 " set catchopts {}\n"
1810 " while {[string match -* [lindex $args 0]]} {\n"
1811 " set args [lassign $args opt]\n"
1812 " if {$opt eq \"--\"} {\n"
1815 " lappend catchopts $opt\n"
1817 " if {[llength $args] == 0} {\n"
1818 " return -code error {wrong # args: should be \"try ?options? script ?argument ...?\"}\n"
1820 " set args [lassign $args script]\n"
1821 " set code [catch -eval {*}$catchopts [list uplevel 1 $script] msg opts]\n"
1825 " foreach {on codes vars script} $args {\n"
1826 " switch -- $on \\\n"
1828 " if {!$handled && ($codes eq \"*\" || [info returncode $code] in $codes)} {\n"
1829 " lassign $vars msgvar optsvar\n"
1830 " if {$msgvar ne \"\"} {\n"
1831 " upvar $msgvar hmsg\n"
1834 " if {$optsvar ne \"\"} {\n"
1835 " upvar $optsvar hopts\n"
1836 " set hopts $opts\n"
1839 " set code [catch [list uplevel 1 $script] msg opts]\n"
1844 " set finalcode [catch [list uplevel 1 $codes] finalmsg finalopts]\n"
1845 " if {$finalcode} {\n"
1847 " set code $finalcode\n"
1848 " set msg $finalmsg\n"
1849 " set opts $finalopts\n"
1854 " return -code error \"try: expected 'on' or 'finally', got '$on'\"\n"
1859 " incr opts(-level)\n"
1860 " return {*}$opts $msg\n"
1867 "proc throw {code {msg \"\"}} {\n"
1868 " return -code $code $msg\n"
1872 "proc {file delete force} {path} {\n"
1873 " foreach e [readdir $path] {\n"
1874 " file delete -force $path/$e\n"
1876 " file delete $path\n"
1878 ,"tclcompat.tcl", 1);
1881 /* Jim - A small embeddable Tcl interpreter
1883 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
1884 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
1885 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
1886 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
1887 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
1888 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
1889 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
1891 * Redistribution and use in source and binary forms, with or without
1892 * modification, are permitted provided that the following conditions
1895 * 1. Redistributions of source code must retain the above copyright
1896 * notice, this list of conditions and the following disclaimer.
1897 * 2. Redistributions in binary form must reproduce the above
1898 * copyright notice, this list of conditions and the following
1899 * disclaimer in the documentation and/or other materials
1900 * provided with the distribution.
1902 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
1903 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
1904 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
1905 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1906 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
1907 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1908 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1909 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1910 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1911 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
1912 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
1913 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1915 * The views and conclusions contained in the software and documentation
1916 * are those of the authors and should not be interpreted as representing
1917 * official policies, either expressed or implied, of the Jim Tcl Project.
1927 #if defined(HAVE_SYS_SOCKET_H) && defined(HAVE_SELECT) && defined(HAVE_NETINET_IN_H) && defined(HAVE_NETDB_H) && defined(HAVE_ARPA_INET_H)
1928 #include <sys/socket.h>
1929 #include <netinet/in.h>
1930 #include <arpa/inet.h>
1932 #ifdef HAVE_SYS_UN_H
1940 #define AIO_CMD_LEN 32 /* e.g. aio.handleXXXXXX */
1941 #define AIO_BUF_LEN 256 /* Can keep this small and rely on stdio buffering */
1943 #define AIO_KEEPOPEN 1
1945 #if defined(JIM_IPV6)
1955 union sockaddr_any
{
1957 struct sockaddr_in sin
;
1959 struct sockaddr_in6 sin6
;
1963 #ifndef HAVE_INET_NTOP
1964 const char *inet_ntop(int af
, const void *src
, char *dst
, int size
)
1966 if (af
!= PF_INET
) {
1969 snprintf(dst
, size
, "%s", inet_ntoa(((struct sockaddr_in
*)src
)->sin_addr
));
1975 typedef struct AioFile
1980 int OpenFlags
; /* AIO_KEEPOPEN? keep FILE* */
1993 static int JimAioSubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
);
1996 static int JimParseIPv6Address(Jim_Interp
*interp
, const char *hostport
, union sockaddr_any
*sa
, int *salen
)
2000 * An IPv6 addr/port looks like:
2003 * [fe80::223:6cff:fe95:bdc0%en1]:2000
2007 * Note that the "any" address is ::, which is the same as when no address is specified.
2009 char *sthost
= NULL
;
2012 struct addrinfo req
;
2013 struct addrinfo
*ai
;
2015 stport
= strrchr(hostport
, ':');
2017 /* No : so, the whole thing is the port */
2020 sthost
= Jim_StrDup(hostport
);
2026 if (*hostport
== '[') {
2027 /* This is a numeric ipv6 address */
2028 char *pt
= strchr(++hostport
, ']');
2030 sthost
= Jim_StrDupLen(hostport
, pt
- hostport
);
2035 sthost
= Jim_StrDupLen(hostport
, stport
- hostport
- 1);
2038 memset(&req
, '\0', sizeof(req
));
2039 req
.ai_family
= PF_INET6
;
2041 if (getaddrinfo(sthost
, NULL
, &req
, &ai
)) {
2042 Jim_SetResultFormatted(interp
, "Not a valid address: %s", hostport
);
2046 memcpy(&sa
->sin
, ai
->ai_addr
, ai
->ai_addrlen
);
2047 *salen
= ai
->ai_addrlen
;
2049 sa
->sin
.sin_port
= htons(atoi(stport
));
2057 Jim_SetResultString(interp
, "ipv6 not supported", -1);
2062 static int JimParseIpAddress(Jim_Interp
*interp
, const char *hostport
, union sockaddr_any
*sa
, int *salen
)
2064 /* An IPv4 addr/port looks like:
2069 * If the address is missing, INADDR_ANY is used.
2070 * If the port is missing, 0 is used (only useful for server sockets).
2072 char *sthost
= NULL
;
2076 stport
= strrchr(hostport
, ':');
2078 /* No : so, the whole thing is the port */
2080 sthost
= Jim_StrDup("0.0.0.0");
2083 sthost
= Jim_StrDupLen(hostport
, stport
- hostport
);
2088 #ifdef HAVE_GETADDRINFO
2089 struct addrinfo req
;
2090 struct addrinfo
*ai
;
2091 memset(&req
, '\0', sizeof(req
));
2092 req
.ai_family
= PF_INET
;
2094 if (getaddrinfo(sthost
, NULL
, &req
, &ai
)) {
2098 memcpy(&sa
->sin
, ai
->ai_addr
, ai
->ai_addrlen
);
2099 *salen
= ai
->ai_addrlen
;
2107 if ((he
= gethostbyname(sthost
)) != NULL
) {
2108 if (he
->h_length
== sizeof(sa
->sin
.sin_addr
)) {
2109 *salen
= sizeof(sa
->sin
);
2110 sa
->sin
.sin_family
= he
->h_addrtype
;
2111 memcpy(&sa
->sin
.sin_addr
, he
->h_addr
, he
->h_length
); /* set address */
2117 sa
->sin
.sin_port
= htons(atoi(stport
));
2121 if (ret
!= JIM_OK
) {
2122 Jim_SetResultFormatted(interp
, "Not a valid address: %s", hostport
);
2128 #ifdef HAVE_SYS_UN_H
2129 static int JimParseDomainAddress(Jim_Interp
*interp
, const char *path
, struct sockaddr_un
*sa
)
2131 sa
->sun_family
= PF_UNIX
;
2132 snprintf(sa
->sun_path
, sizeof(sa
->sun_path
), "%s", path
);
2139 static void JimAioSetError(Jim_Interp
*interp
, Jim_Obj
*name
)
2142 Jim_SetResultFormatted(interp
, "%#s: %s", name
, strerror(errno
));
2145 Jim_SetResultString(interp
, strerror(errno
), -1);
2149 static void JimAioDelProc(Jim_Interp
*interp
, void *privData
)
2151 AioFile
*af
= privData
;
2153 JIM_NOTUSED(interp
);
2155 Jim_DecrRefCount(interp
, af
->filename
);
2157 if (!(af
->OpenFlags
& AIO_KEEPOPEN
)) {
2160 #ifdef jim_ext_eventloop
2161 /* remove existing EventHandlers */
2163 Jim_DeleteFileHandler(interp
, af
->fp
);
2166 Jim_DeleteFileHandler(interp
, af
->fp
);
2169 Jim_DeleteFileHandler(interp
, af
->fp
);
2175 static int aio_cmd_read(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2177 AioFile
*af
= Jim_CmdPrivData(interp
);
2178 char buf
[AIO_BUF_LEN
];
2181 int neededLen
= -1; /* -1 is "read as much as possible" */
2183 if (argc
&& Jim_CompareStringImmediate(interp
, argv
[0], "-nonewline")) {
2191 if (Jim_GetWide(interp
, argv
[0], &wideValue
) != JIM_OK
)
2193 if (wideValue
< 0) {
2194 Jim_SetResultString(interp
, "invalid parameter: negative len", -1);
2197 neededLen
= (int)wideValue
;
2202 objPtr
= Jim_NewStringObj(interp
, NULL
, 0);
2203 while (neededLen
!= 0) {
2207 if (neededLen
== -1) {
2208 readlen
= AIO_BUF_LEN
;
2211 readlen
= (neededLen
> AIO_BUF_LEN
? AIO_BUF_LEN
: neededLen
);
2213 retval
= fread(buf
, 1, readlen
, af
->fp
);
2215 Jim_AppendString(interp
, objPtr
, buf
, retval
);
2216 if (neededLen
!= -1) {
2217 neededLen
-= retval
;
2220 if (retval
!= readlen
)
2223 /* Check for error conditions */
2224 if (ferror(af
->fp
)) {
2226 /* eof and EAGAIN are not error conditions */
2227 if (!feof(af
->fp
) && errno
!= EAGAIN
) {
2229 Jim_FreeNewObj(interp
, objPtr
);
2230 JimAioSetError(interp
, af
->filename
);
2236 const char *s
= Jim_GetString(objPtr
, &len
);
2238 if (len
> 0 && s
[len
- 1] == '\n') {
2240 objPtr
->bytes
[objPtr
->length
] = '\0';
2243 Jim_SetResult(interp
, objPtr
);
2247 static int aio_cmd_copy(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2249 AioFile
*af
= Jim_CmdPrivData(interp
);
2251 long maxlen
= LONG_MAX
;
2252 FILE *outfh
= Jim_AioFilehandle(interp
, argv
[0]);
2254 if (outfh
== NULL
) {
2259 if (Jim_GetLong(interp
, argv
[1], &maxlen
) != JIM_OK
) {
2264 while (count
< maxlen
) {
2265 int ch
= fgetc(af
->fp
);
2267 if (ch
== EOF
|| fputc(ch
, outfh
) == EOF
) {
2273 if (ferror(af
->fp
)) {
2274 Jim_SetResultFormatted(interp
, "error while reading: %s", strerror(errno
));
2279 if (ferror(outfh
)) {
2280 Jim_SetResultFormatted(interp
, "error while writing: %s", strerror(errno
));
2285 Jim_SetResultInt(interp
, count
);
2290 static int aio_cmd_gets(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2292 AioFile
*af
= Jim_CmdPrivData(interp
);
2293 char buf
[AIO_BUF_LEN
];
2298 objPtr
= Jim_NewStringObj(interp
, NULL
, 0);
2302 buf
[AIO_BUF_LEN
- 1] = '_';
2303 if (fgets(buf
, AIO_BUF_LEN
, af
->fp
) == NULL
)
2305 if (buf
[AIO_BUF_LEN
- 1] == '\0' && buf
[AIO_BUF_LEN
- 2] != '\n')
2308 Jim_AppendString(interp
, objPtr
, buf
, AIO_BUF_LEN
- 1);
2311 int len
= strlen(buf
);
2314 int hasnl
= (buf
[len
- 1] == '\n');
2317 Jim_AppendString(interp
, objPtr
, buf
, strlen(buf
) - hasnl
);
2323 if (ferror(af
->fp
) && errno
!= EAGAIN
&& errno
!= EINTR
) {
2325 Jim_FreeNewObj(interp
, objPtr
);
2326 JimAioSetError(interp
, af
->filename
);
2330 /* On EOF returns -1 if varName was specified, or the empty string. */
2331 if (feof(af
->fp
) && Jim_Length(objPtr
) == 0) {
2332 Jim_FreeNewObj(interp
, objPtr
);
2334 Jim_SetResultInt(interp
, -1);
2341 Jim_GetString(objPtr
, &totLen
);
2342 if (Jim_SetVariable(interp
, argv
[0], objPtr
) != JIM_OK
) {
2343 Jim_FreeNewObj(interp
, objPtr
);
2346 Jim_SetResultInt(interp
, totLen
);
2349 Jim_SetResult(interp
, objPtr
);
2354 static int aio_cmd_puts(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2356 AioFile
*af
= Jim_CmdPrivData(interp
);
2362 if (!Jim_CompareStringImmediate(interp
, argv
[0], "-nonewline")) {
2371 wdata
= Jim_GetString(strObj
, &wlen
);
2372 if (fwrite(wdata
, 1, wlen
, af
->fp
) == (unsigned)wlen
) {
2373 if (argc
== 2 || putc('\n', af
->fp
) != EOF
) {
2377 JimAioSetError(interp
, af
->filename
);
2382 static int aio_cmd_recvfrom(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2384 AioFile
*af
= Jim_CmdPrivData(interp
);
2386 union sockaddr_any sa
;
2388 socklen_t salen
= sizeof(sa
);
2391 if (Jim_GetLong(interp
, argv
[0], &len
) != JIM_OK
) {
2395 buf
= Jim_Alloc(len
+ 1);
2397 rlen
= recvfrom(fileno(af
->fp
), buf
, len
, 0, &sa
.sa
, &salen
);
2400 JimAioSetError(interp
, NULL
);
2404 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, rlen
));
2407 /* INET6_ADDRSTRLEN is 46. Add some for [] and port */
2411 if (sa
.sa
.sa_family
== PF_INET6
) {
2413 /* Allow 9 for []:65535\0 */
2414 inet_ntop(sa
.sa
.sa_family
, &sa
.sin6
.sin6_addr
, addrbuf
+ 1, sizeof(addrbuf
) - 9);
2415 snprintf(addrbuf
+ strlen(addrbuf
), 8, "]:%d", ntohs(sa
.sin
.sin_port
));
2420 /* Allow 7 for :65535\0 */
2421 inet_ntop(sa
.sa
.sa_family
, &sa
.sin
.sin_addr
, addrbuf
, sizeof(addrbuf
) - 7);
2422 snprintf(addrbuf
+ strlen(addrbuf
), 7, ":%d", ntohs(sa
.sin
.sin_port
));
2425 if (Jim_SetVariable(interp
, argv
[1], Jim_NewStringObj(interp
, addrbuf
, -1)) != JIM_OK
) {
2434 static int aio_cmd_sendto(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2436 AioFile
*af
= Jim_CmdPrivData(interp
);
2440 union sockaddr_any sa
;
2441 const char *addr
= Jim_String(argv
[1]);
2444 if (IPV6
&& af
->addr_family
== PF_INET6
) {
2445 if (JimParseIPv6Address(interp
, addr
, &sa
, &salen
) != JIM_OK
) {
2449 else if (JimParseIpAddress(interp
, addr
, &sa
, &salen
) != JIM_OK
) {
2452 wdata
= Jim_GetString(argv
[0], &wlen
);
2454 /* Note that we don't validate the socket type. Rely on sendto() failing if appropriate */
2455 len
= sendto(fileno(af
->fp
), wdata
, wlen
, 0, &sa
.sa
, salen
);
2457 JimAioSetError(interp
, NULL
);
2460 Jim_SetResultInt(interp
, len
);
2464 static int aio_cmd_accept(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2466 AioFile
*serv_af
= Jim_CmdPrivData(interp
);
2468 union sockaddr_any sa
;
2469 socklen_t addrlen
= sizeof(sa
);
2471 char buf
[AIO_CMD_LEN
];
2473 sock
= accept(serv_af
->fd
, &sa
.sa
, &addrlen
);
2477 /* Create the file command */
2478 af
= Jim_Alloc(sizeof(*af
));
2481 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2483 af
->filename
= Jim_NewStringObj(interp
, "accept", -1);
2484 Jim_IncrRefCount(af
->filename
);
2485 af
->fp
= fdopen(sock
, "r+");
2489 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2494 af
->addr_family
= serv_af
->addr_family
;
2495 snprintf(buf
, sizeof(buf
), "aio.sockstream%ld", Jim_GetId(interp
));
2496 Jim_CreateCommand(interp
, buf
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2497 Jim_SetResultString(interp
, buf
, -1);
2503 static int aio_cmd_flush(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2505 AioFile
*af
= Jim_CmdPrivData(interp
);
2507 if (fflush(af
->fp
) == EOF
) {
2508 JimAioSetError(interp
, af
->filename
);
2514 static int aio_cmd_eof(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2516 AioFile
*af
= Jim_CmdPrivData(interp
);
2518 Jim_SetResultInt(interp
, feof(af
->fp
));
2522 static int aio_cmd_close(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2524 Jim_DeleteCommand(interp
, Jim_String(argv
[0]));
2528 static int aio_cmd_seek(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2530 AioFile
*af
= Jim_CmdPrivData(interp
);
2531 int orig
= SEEK_SET
;
2535 if (Jim_CompareStringImmediate(interp
, argv
[1], "start"))
2537 else if (Jim_CompareStringImmediate(interp
, argv
[1], "current"))
2539 else if (Jim_CompareStringImmediate(interp
, argv
[1], "end"))
2545 if (Jim_GetLong(interp
, argv
[0], &offset
) != JIM_OK
) {
2548 if (fseek(af
->fp
, offset
, orig
) == -1) {
2549 JimAioSetError(interp
, af
->filename
);
2555 static int aio_cmd_tell(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2557 AioFile
*af
= Jim_CmdPrivData(interp
);
2559 Jim_SetResultInt(interp
, ftell(af
->fp
));
2563 static int aio_cmd_filename(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2565 AioFile
*af
= Jim_CmdPrivData(interp
);
2567 Jim_SetResult(interp
, af
->filename
);
2572 static int aio_cmd_ndelay(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2574 AioFile
*af
= Jim_CmdPrivData(interp
);
2576 int fmode
= af
->flags
;
2581 if (Jim_GetLong(interp
, argv
[0], &nb
) != JIM_OK
) {
2590 fcntl(af
->fd
, F_SETFL
, fmode
);
2593 Jim_SetResultInt(interp
, (fmode
& O_NONBLOCK
) ? 1 : 0);
2598 static int aio_cmd_buffering(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2600 AioFile
*af
= Jim_CmdPrivData(interp
);
2602 static const char * const options
[] = {
2616 if (Jim_GetEnum(interp
, argv
[0], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
2621 setvbuf(af
->fp
, NULL
, _IONBF
, 0);
2624 setvbuf(af
->fp
, NULL
, _IOLBF
, BUFSIZ
);
2627 setvbuf(af
->fp
, NULL
, _IOFBF
, BUFSIZ
);
2633 #ifdef jim_ext_eventloop
2634 static void JimAioFileEventFinalizer(Jim_Interp
*interp
, void *clientData
)
2636 Jim_Obj
*objPtr
= clientData
;
2638 Jim_DecrRefCount(interp
, objPtr
);
2641 static int JimAioFileEventHandler(Jim_Interp
*interp
, void *clientData
, int mask
)
2643 Jim_Obj
*objPtr
= clientData
;
2645 return Jim_EvalObjBackground(interp
, objPtr
);
2648 static int aio_eventinfo(Jim_Interp
*interp
, AioFile
* af
, unsigned mask
, Jim_Obj
**scriptHandlerObj
,
2649 int argc
, Jim_Obj
* const *argv
)
2654 /* Return current script */
2655 if (*scriptHandlerObj
) {
2656 Jim_SetResult(interp
, *scriptHandlerObj
);
2661 if (*scriptHandlerObj
) {
2662 /* Delete old handler */
2663 Jim_DeleteFileHandler(interp
, af
->fp
);
2664 *scriptHandlerObj
= NULL
;
2667 /* Now possibly add the new script(s) */
2668 Jim_GetString(argv
[0], &scriptlen
);
2669 if (scriptlen
== 0) {
2670 /* Empty script, so done */
2674 /* A new script to add */
2675 Jim_IncrRefCount(argv
[0]);
2676 *scriptHandlerObj
= argv
[0];
2678 Jim_CreateFileHandler(interp
, af
->fp
, mask
,
2679 JimAioFileEventHandler
, *scriptHandlerObj
, JimAioFileEventFinalizer
);
2684 static int aio_cmd_readable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2686 AioFile
*af
= Jim_CmdPrivData(interp
);
2688 return aio_eventinfo(interp
, af
, JIM_EVENT_READABLE
, &af
->rEvent
, argc
, argv
);
2691 static int aio_cmd_writable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2693 AioFile
*af
= Jim_CmdPrivData(interp
);
2695 return aio_eventinfo(interp
, af
, JIM_EVENT_WRITABLE
, &af
->wEvent
, argc
, argv
);
2698 static int aio_cmd_onexception(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2700 AioFile
*af
= Jim_CmdPrivData(interp
);
2702 return aio_eventinfo(interp
, af
, JIM_EVENT_EXCEPTION
, &af
->wEvent
, argc
, argv
);
2706 static const jim_subcmd_type aio_command_table
[] = {
2708 .args
= "?-nonewline? ?len?",
2709 .function
= aio_cmd_read
,
2712 .description
= "Read and return bytes from the stream. To eof if no len."
2715 .args
= "handle ?size?",
2716 .function
= aio_cmd_copy
,
2719 .description
= "Copy up to 'size' bytes to the given filehandle, or to eof if no size."
2723 .function
= aio_cmd_gets
,
2726 .description
= "Read one line and return it or store it in the var"
2729 .args
= "?-nonewline? str",
2730 .function
= aio_cmd_puts
,
2733 .description
= "Write the string, with newline unless -nonewline"
2736 { .cmd
= "recvfrom",
2737 .args
= "len ?addrvar?",
2738 .function
= aio_cmd_recvfrom
,
2741 .description
= "Receive up to 'len' bytes on the socket. Sets 'addrvar' with receive address, if set"
2744 .args
= "str address",
2745 .function
= aio_cmd_sendto
,
2748 .description
= "Send 'str' to the given address (dgram only)"
2751 .function
= aio_cmd_accept
,
2752 .description
= "Server socket only: Accept a connection and return stream"
2756 .function
= aio_cmd_flush
,
2757 .description
= "Flush the stream"
2760 .function
= aio_cmd_eof
,
2761 .description
= "Returns 1 if stream is at eof"
2764 .flags
= JIM_MODFLAG_FULLARGV
,
2765 .function
= aio_cmd_close
,
2766 .description
= "Closes the stream"
2769 .args
= "offset ?start|current|end",
2770 .function
= aio_cmd_seek
,
2773 .description
= "Seeks in the stream (default 'current')"
2776 .function
= aio_cmd_tell
,
2777 .description
= "Returns the current seek position"
2779 { .cmd
= "filename",
2780 .function
= aio_cmd_filename
,
2781 .description
= "Returns the original filename"
2786 .function
= aio_cmd_ndelay
,
2789 .description
= "Set O_NDELAY (if arg). Returns current/new setting."
2792 { .cmd
= "buffering",
2793 .args
= "none|line|full",
2794 .function
= aio_cmd_buffering
,
2797 .description
= "Sets buffering"
2799 #ifdef jim_ext_eventloop
2800 { .cmd
= "readable",
2801 .args
= "?readable-script?",
2804 .function
= aio_cmd_readable
,
2805 .description
= "Returns script, or invoke readable-script when readable, {} to remove",
2807 { .cmd
= "writable",
2808 .args
= "?writable-script?",
2811 .function
= aio_cmd_writable
,
2812 .description
= "Returns script, or invoke writable-script when writable, {} to remove",
2814 { .cmd
= "onexception",
2815 .args
= "?exception-script?",
2818 .function
= aio_cmd_onexception
,
2819 .description
= "Returns script, or invoke exception-script when oob data, {} to remove",
2825 static int JimAioSubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2827 return Jim_CallSubCmd(interp
, Jim_ParseSubCmd(interp
, aio_command_table
, argc
, argv
), argc
, argv
);
2830 static int JimAioOpenCommand(Jim_Interp
*interp
, int argc
,
2831 Jim_Obj
*const *argv
)
2835 char buf
[AIO_CMD_LEN
];
2837 const char *cmdname
;
2839 if (argc
!= 2 && argc
!= 3) {
2840 Jim_WrongNumArgs(interp
, 1, argv
, "filename ?mode?");
2843 cmdname
= Jim_String(argv
[1]);
2844 if (Jim_CompareStringImmediate(interp
, argv
[1], "stdin")) {
2845 OpenFlags
|= AIO_KEEPOPEN
;
2848 else if (Jim_CompareStringImmediate(interp
, argv
[1], "stdout")) {
2849 OpenFlags
|= AIO_KEEPOPEN
;
2852 else if (Jim_CompareStringImmediate(interp
, argv
[1], "stderr")) {
2853 OpenFlags
|= AIO_KEEPOPEN
;
2857 const char *mode
= (argc
== 3) ? Jim_String(argv
[2]) : "r";
2858 const char *filename
= Jim_String(argv
[1]);
2860 #ifdef jim_ext_tclcompat
2861 /* If the filename starts with '|', use popen instead */
2862 if (*filename
== '|') {
2863 Jim_Obj
*evalObj
[3];
2865 evalObj
[0] = Jim_NewStringObj(interp
, "popen", -1);
2866 evalObj
[1] = Jim_NewStringObj(interp
, filename
+ 1, -1);
2867 evalObj
[2] = Jim_NewStringObj(interp
, mode
, -1);
2869 return Jim_EvalObjVector(interp
, 3, evalObj
);
2872 fp
= fopen(filename
, mode
);
2874 JimAioSetError(interp
, argv
[1]);
2877 /* Get the next file id */
2878 snprintf(buf
, sizeof(buf
), "aio.handle%ld", Jim_GetId(interp
));
2882 /* Create the file command */
2883 af
= Jim_Alloc(sizeof(*af
));
2885 af
->fd
= fileno(fp
);
2887 if ((OpenFlags
& AIO_KEEPOPEN
) == 0) {
2888 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2892 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2894 af
->filename
= argv
[1];
2895 Jim_IncrRefCount(af
->filename
);
2896 af
->OpenFlags
= OpenFlags
;
2900 Jim_CreateCommand(interp
, cmdname
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2901 Jim_SetResultString(interp
, cmdname
, -1);
2908 * Creates a channel for fd.
2910 * hdlfmt is a sprintf format for the filehandle. Anything with %ld at the end will do.
2911 * mode is usual "r+", but may be another fdopen() mode as required.
2913 * Creates the command and lappends the name of the command to the current result.
2916 static int JimMakeChannel(Jim_Interp
*interp
, Jim_Obj
*filename
, const char *hdlfmt
, int fd
, int family
,
2920 char buf
[AIO_CMD_LEN
];
2922 FILE *fp
= fdopen(fd
, mode
);
2926 JimAioSetError(interp
, NULL
);
2930 /* Create the file command */
2931 af
= Jim_Alloc(sizeof(*af
));
2934 fcntl(af
->fd
, F_SETFD
, FD_CLOEXEC
);
2936 af
->filename
= filename
;
2937 Jim_IncrRefCount(af
->filename
);
2939 af
->flags
= fcntl(af
->fd
, F_GETFL
);
2944 af
->addr_family
= family
;
2945 snprintf(buf
, sizeof(buf
), hdlfmt
, Jim_GetId(interp
));
2946 Jim_CreateCommand(interp
, buf
, JimAioSubCmdProc
, af
, JimAioDelProc
);
2948 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
, buf
, -1));
2953 static int JimAioSockCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
2955 const char *hdlfmt
= "aio.unknown%ld";
2956 const char *socktypes
[] = {
2977 SOCK_STREAM6_CLIENT
,
2978 SOCK_STREAM6_SERVER
,
2982 const char *hostportarg
= NULL
;
2985 const char *mode
= "r+";
2986 int family
= PF_INET
;
2987 Jim_Obj
*argv0
= argv
[0];
2990 if (argc
> 1 && Jim_CompareStringImmediate(interp
, argv
[1], "-ipv6")) {
2992 Jim_SetResultString(interp
, "ipv6 not supported", -1);
3003 Jim_WrongNumArgs(interp
, 1, &argv0
, "?-ipv6? type ?address?");
3007 if (Jim_GetEnum(interp
, argv
[1], socktypes
, &socktype
, "socket type", JIM_ERRMSG
) != JIM_OK
)
3010 Jim_SetResultString(interp
, "", 0);
3012 hdlfmt
= "aio.sock%ld";
3015 hostportarg
= Jim_String(argv
[2]);
3019 case SOCK_DGRAM_CLIENT
:
3021 /* No address, so an unconnected dgram socket */
3022 sock
= socket(family
, SOCK_DGRAM
, 0);
3024 JimAioSetError(interp
, NULL
);
3030 case SOCK_STREAM_CLIENT
:
3032 union sockaddr_any sa
;
3040 if (JimParseIPv6Address(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3044 else if (JimParseIpAddress(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3047 sock
= socket(family
, (socktype
== SOCK_DGRAM_CLIENT
) ? SOCK_DGRAM
: SOCK_STREAM
, 0);
3049 JimAioSetError(interp
, NULL
);
3052 res
= connect(sock
, &sa
.sa
, salen
);
3054 JimAioSetError(interp
, argv
[2]);
3061 case SOCK_STREAM_SERVER
:
3062 case SOCK_DGRAM_SERVER
:
3064 union sockaddr_any sa
;
3072 if (JimParseIPv6Address(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3076 else if (JimParseIpAddress(interp
, hostportarg
, &sa
, &salen
) != JIM_OK
) {
3079 sock
= socket(family
, (socktype
== SOCK_DGRAM_SERVER
) ? SOCK_DGRAM
: SOCK_STREAM
, 0);
3081 JimAioSetError(interp
, NULL
);
3085 /* Enable address reuse */
3086 setsockopt(sock
, SOL_SOCKET
, SO_REUSEADDR
, (void *)&on
, sizeof(on
));
3088 res
= bind(sock
, &sa
.sa
, salen
);
3090 JimAioSetError(interp
, argv
[2]);
3094 if (socktype
== SOCK_STREAM_SERVER
) {
3095 res
= listen(sock
, 5);
3097 JimAioSetError(interp
, NULL
);
3102 hdlfmt
= "aio.socksrv%ld";
3106 #ifdef HAVE_SYS_UN_H
3109 struct sockaddr_un sa
;
3112 if (argc
!= 3 || ipv6
) {
3116 if (JimParseDomainAddress(interp
, hostportarg
, &sa
) != JIM_OK
) {
3117 JimAioSetError(interp
, argv
[2]);
3121 sock
= socket(PF_UNIX
, SOCK_STREAM
, 0);
3123 JimAioSetError(interp
, NULL
);
3126 len
= strlen(sa
.sun_path
) + 1 + sizeof(sa
.sun_family
);
3127 res
= connect(sock
, (struct sockaddr
*)&sa
, len
);
3129 JimAioSetError(interp
, argv
[2]);
3133 hdlfmt
= "aio.sockunix%ld";
3137 case SOCK_UNIX_SERVER
:
3139 struct sockaddr_un sa
;
3142 if (argc
!= 3 || ipv6
) {
3146 if (JimParseDomainAddress(interp
, hostportarg
, &sa
) != JIM_OK
) {
3147 JimAioSetError(interp
, argv
[2]);
3151 sock
= socket(PF_UNIX
, SOCK_STREAM
, 0);
3153 JimAioSetError(interp
, NULL
);
3156 len
= strlen(sa
.sun_path
) + 1 + sizeof(sa
.sun_family
);
3157 res
= bind(sock
, (struct sockaddr
*)&sa
, len
);
3159 JimAioSetError(interp
, argv
[2]);
3163 res
= listen(sock
, 5);
3165 JimAioSetError(interp
, NULL
);
3169 hdlfmt
= "aio.sockunixsrv%ld";
3175 case SOCK_STREAM_PIPE
:
3179 if (argc
!= 2 || ipv6
) {
3184 JimAioSetError(interp
, NULL
);
3188 hdlfmt
= "aio.pipe%ld";
3189 if (JimMakeChannel(interp
, argv
[1], hdlfmt
, p
[0], family
, "r") != JIM_OK
) {
3192 JimAioSetError(interp
, NULL
);
3195 /* Note, if this fails it will leave p[0] open, but this should never happen */
3202 Jim_SetResultString(interp
, "Unsupported socket type", -1);
3206 return JimMakeChannel(interp
, argv
[1], hdlfmt
, sock
, family
, mode
);
3210 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*command
)
3212 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, command
, JIM_ERRMSG
);
3214 if (cmdPtr
&& !cmdPtr
->isproc
&& cmdPtr
->u
.native
.cmdProc
== JimAioSubCmdProc
) {
3215 return ((AioFile
*) cmdPtr
->u
.native
.privData
)->fp
;
3217 Jim_SetResultFormatted(interp
, "Not a filehandle: \"%#s\"", command
);
3221 int Jim_aioInit(Jim_Interp
*interp
)
3223 if (Jim_PackageProvide(interp
, "aio", "1.0", JIM_ERRMSG
))
3226 Jim_CreateCommand(interp
, "open", JimAioOpenCommand
, NULL
, NULL
);
3228 Jim_CreateCommand(interp
, "socket", JimAioSockCommand
, NULL
, NULL
);
3231 /* Takeover stdin, stdout and stderr */
3232 Jim_EvalGlobal(interp
, "open stdin; open stdout; open stderr");
3238 * Tcl readdir command.
3240 * (c) 2008 Steve Bennett <steveb@worware.net.au>
3242 * Redistribution and use in source and binary forms, with or without
3243 * modification, are permitted provided that the following conditions
3246 * 1. Redistributions of source code must retain the above copyright
3247 * notice, this list of conditions and the following disclaimer.
3248 * 2. Redistributions in binary form must reproduce the above
3249 * copyright notice, this list of conditions and the following
3250 * disclaimer in the documentation and/or other materials
3251 * provided with the distribution.
3253 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3254 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3255 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3256 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3257 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3258 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3259 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3260 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3261 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3262 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3263 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3264 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3266 * The views and conclusions contained in the software and documentation
3267 * are those of the authors and should not be interpreted as representing
3268 * official policies, either expressed or implied, of the Jim Tcl Project.
3270 * Based on original work by:
3271 *-----------------------------------------------------------------------------
3272 * Copyright 1991-1994 Karl Lehenbauer and Mark Diekhans.
3274 * Permission to use, copy, modify, and distribute this software and its
3275 * documentation for any purpose and without fee is hereby granted, provided
3276 * that the above copyright notice appear in all copies. Karl Lehenbauer and
3277 * Mark Diekhans make no representations about the suitability of this
3278 * software for any purpose. It is provided "as is" without express or
3280 *-----------------------------------------------------------------------------
3290 *-----------------------------------------------------------------------------
3293 * Implements the rename TCL command:
3294 * readdir ?-nocomplain? dirPath
3297 * Standard TCL result.
3298 *-----------------------------------------------------------------------------
3300 int Jim_ReaddirCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3302 const char *dirPath
;
3304 struct dirent
*entryPtr
;
3307 if (argc
== 3 && Jim_CompareStringImmediate(interp
, argv
[1], "-nocomplain")) {
3310 if (argc
!= 2 && !nocomplain
) {
3311 Jim_WrongNumArgs(interp
, 1, argv
, "?-nocomplain? dirPath");
3315 dirPath
= Jim_String(argv
[1 + nocomplain
]);
3317 dirPtr
= opendir(dirPath
);
3318 if (dirPtr
== NULL
) {
3322 Jim_SetResultString(interp
, strerror(errno
), -1);
3325 Jim_SetResultString(interp
, strerror(errno
), -1);
3327 Jim_SetResult(interp
, Jim_NewListObj(interp
, NULL
, 0));
3329 while ((entryPtr
= readdir(dirPtr
)) != NULL
) {
3330 if (entryPtr
->d_name
[0] == '.') {
3331 if (entryPtr
->d_name
[1] == '\0') {
3334 if ((entryPtr
->d_name
[1] == '.') && (entryPtr
->d_name
[2] == '\0'))
3337 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
,
3338 entryPtr
->d_name
, -1));
3345 int Jim_readdirInit(Jim_Interp
*interp
)
3347 if (Jim_PackageProvide(interp
, "readdir", "1.0", JIM_ERRMSG
))
3350 Jim_CreateCommand(interp
, "readdir", Jim_ReaddirCmd
, NULL
, NULL
);
3354 * Implements the regexp and regsub commands for Jim
3356 * (c) 2008 Steve Bennett <steveb@workware.net.au>
3358 * Uses C library regcomp()/regexec() for the matching.
3360 * Redistribution and use in source and binary forms, with or without
3361 * modification, are permitted provided that the following conditions
3364 * 1. Redistributions of source code must retain the above copyright
3365 * notice, this list of conditions and the following disclaimer.
3366 * 2. Redistributions in binary form must reproduce the above
3367 * copyright notice, this list of conditions and the following
3368 * disclaimer in the documentation and/or other materials
3369 * provided with the distribution.
3371 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3372 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3373 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3374 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3375 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3376 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3377 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3378 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3379 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3380 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3381 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3382 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3384 * The views and conclusions contained in the software and documentation
3385 * are those of the authors and should not be interpreted as representing
3386 * official policies, either expressed or implied, of the Jim Tcl Project.
3388 * Based on code originally from Tcl 6.7:
3390 * Copyright 1987-1991 Regents of the University of California
3391 * Permission to use, copy, modify, and distribute this
3392 * software and its documentation for any purpose and without
3393 * fee is hereby granted, provided that the above copyright
3394 * notice appear in all copies. The University of California
3395 * makes no representations about the suitability of this
3396 * software for any purpose. It is provided "as is" without
3397 * express or implied warranty.
3404 static void FreeRegexpInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3406 regfree(objPtr
->internalRep
.regexpValue
.compre
);
3407 Jim_Free(objPtr
->internalRep
.regexpValue
.compre
);
3410 static const Jim_ObjType regexpObjType
= {
3412 FreeRegexpInternalRep
,
3418 static regex_t
*SetRegexpFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, unsigned flags
)
3421 const char *pattern
;
3424 /* Check if the object is already an uptodate variable */
3425 if (objPtr
->typePtr
== ®expObjType
&&
3426 objPtr
->internalRep
.regexpValue
.compre
&& objPtr
->internalRep
.regexpValue
.flags
== flags
) {
3428 return objPtr
->internalRep
.regexpValue
.compre
;
3431 /* Not a regexp or the flags do not match */
3432 if (objPtr
->typePtr
== ®expObjType
) {
3433 FreeRegexpInternalRep(interp
, objPtr
);
3434 objPtr
->typePtr
= NULL
;
3437 /* Get the string representation */
3438 pattern
= Jim_String(objPtr
);
3439 compre
= Jim_Alloc(sizeof(regex_t
));
3441 if ((ret
= regcomp(compre
, pattern
, REG_EXTENDED
| flags
)) != 0) {
3444 regerror(ret
, compre
, buf
, sizeof(buf
));
3445 Jim_SetResultFormatted(interp
, "couldn't compile regular expression pattern: %s", buf
);
3451 objPtr
->typePtr
= ®expObjType
;
3452 objPtr
->internalRep
.regexpValue
.flags
= flags
;
3453 objPtr
->internalRep
.regexpValue
.compre
= compre
;
3458 int Jim_RegexpCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3460 int opt_indices
= 0;
3466 regmatch_t
*pmatch
= NULL
;
3468 int result
= JIM_OK
;
3469 const char *pattern
;
3470 const char *source_str
;
3471 int num_matches
= 0;
3473 Jim_Obj
*resultListObj
= NULL
;
3474 int regcomp_flags
= 0;
3478 OPT_INDICES
, OPT_NOCASE
, OPT_LINE
, OPT_ALL
, OPT_INLINE
, OPT_START
, OPT_END
3480 static const char * const options
[] = {
3481 "-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL
3486 Jim_WrongNumArgs(interp
, 1, argv
,
3487 "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
3491 for (i
= 1; i
< argc
; i
++) {
3492 const char *opt
= Jim_String(argv
[i
]);
3497 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, "switch", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
3500 if (option
== OPT_END
) {
3510 regcomp_flags
|= REG_ICASE
;
3514 regcomp_flags
|= REG_NEWLINE
;
3529 if (Jim_GetIndex(interp
, argv
[i
], &offset
) != JIM_OK
) {
3539 regex
= SetRegexpFromAny(interp
, argv
[i
], regcomp_flags
);
3544 pattern
= Jim_String(argv
[i
]);
3545 source_str
= Jim_GetString(argv
[i
+ 1], &source_len
);
3547 num_vars
= argc
- i
- 2;
3551 Jim_SetResultString(interp
, "regexp match variables not allowed when using -inline",
3556 num_vars
= regex
->re_nsub
+ 1;
3559 pmatch
= Jim_Alloc((num_vars
+ 1) * sizeof(*pmatch
));
3561 /* If an offset has been specified, adjust for that now.
3562 * If it points past the end of the string, point to the terminating null
3566 offset
+= source_len
+ 1;
3568 if (offset
> source_len
) {
3569 source_str
+= source_len
;
3571 else if (offset
> 0) {
3572 source_str
+= offset
;
3574 eflags
|= REG_NOTBOL
;
3578 resultListObj
= Jim_NewListObj(interp
, NULL
, 0);
3582 match
= regexec(regex
, source_str
, num_vars
+ 1, pmatch
, eflags
);
3583 if (match
>= REG_BADPAT
) {
3586 regerror(match
, regex
, buf
, sizeof(buf
));
3587 Jim_SetResultFormatted(interp
, "error while matching pattern: %s", buf
);
3592 if (match
== REG_NOMATCH
) {
3598 if (opt_all
&& !opt_inline
) {
3599 /* Just count the number of matches, so skip the substitution h */
3600 goto try_next_match
;
3604 * If additional variable names have been specified, return
3605 * index information in those variables.
3609 for (i
+= 2; opt_inline
? j
< num_vars
: i
< argc
; i
++, j
++) {
3613 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
3616 resultObj
= Jim_NewStringObj(interp
, "", 0);
3619 if (pmatch
[j
].rm_so
== -1) {
3621 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
, -1));
3622 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
, -1));
3626 int len
= pmatch
[j
].rm_eo
- pmatch
[j
].rm_so
;
3629 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
,
3630 offset
+ pmatch
[j
].rm_so
));
3631 Jim_ListAppendElement(interp
, resultObj
, Jim_NewIntObj(interp
,
3632 offset
+ pmatch
[j
].rm_so
+ len
- 1));
3635 Jim_AppendString(interp
, resultObj
, source_str
+ pmatch
[j
].rm_so
, len
);
3640 Jim_ListAppendElement(interp
, resultListObj
, resultObj
);
3643 /* And now set the result variable */
3644 result
= Jim_SetVariable(interp
, argv
[i
], resultObj
);
3646 if (result
!= JIM_OK
) {
3647 Jim_FreeObj(interp
, resultObj
);
3654 if (opt_all
&& (pattern
[0] != '^' || (regcomp_flags
& REG_NEWLINE
)) && *source_str
) {
3655 if (pmatch
[0].rm_eo
) {
3656 offset
+= pmatch
[0].rm_eo
;
3657 source_str
+= pmatch
[0].rm_eo
;
3664 eflags
= REG_NOTBOL
;
3670 if (result
== JIM_OK
) {
3672 Jim_SetResult(interp
, resultListObj
);
3675 Jim_SetResultInt(interp
, num_matches
);
3683 #define MAX_SUB_MATCHES 50
3685 int Jim_RegsubCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
3687 int regcomp_flags
= 0;
3688 int regexec_flags
= 0;
3694 regmatch_t pmatch
[MAX_SUB_MATCHES
+ 1];
3695 int num_matches
= 0;
3700 const char *source_str
;
3702 const char *replace_str
;
3704 const char *pattern
;
3707 OPT_NOCASE
, OPT_LINE
, OPT_ALL
, OPT_START
, OPT_END
3709 static const char * const options
[] = {
3710 "-nocase", "-line", "-all", "-start", "--", NULL
3715 Jim_WrongNumArgs(interp
, 1, argv
,
3716 "?switches? exp string subSpec ?varName?");
3720 for (i
= 1; i
< argc
; i
++) {
3721 const char *opt
= Jim_String(argv
[i
]);
3726 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, "switch", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
3729 if (option
== OPT_END
) {
3735 regcomp_flags
|= REG_ICASE
;
3739 regcomp_flags
|= REG_NEWLINE
;
3750 if (Jim_GetIndex(interp
, argv
[i
], &offset
) != JIM_OK
) {
3756 if (argc
- i
!= 3 && argc
- i
!= 4) {
3760 regex
= SetRegexpFromAny(interp
, argv
[i
], regcomp_flags
);
3764 pattern
= Jim_String(argv
[i
]);
3766 source_str
= Jim_GetString(argv
[i
+ 1], &source_len
);
3767 replace_str
= Jim_GetString(argv
[i
+ 2], &replace_len
);
3768 varname
= argv
[i
+ 3];
3770 /* Create the result string */
3771 resultObj
= Jim_NewStringObj(interp
, "", 0);
3773 /* If an offset has been specified, adjust for that now.
3774 * If it points past the end of the string, point to the terminating null
3778 offset
+= source_len
+ 1;
3780 if (offset
> source_len
) {
3781 offset
= source_len
;
3783 else if (offset
< 0) {
3788 /* Copy the part before -start */
3789 Jim_AppendString(interp
, resultObj
, source_str
, offset
);
3792 * The following loop is to handle multiple matches within the
3793 * same source string; each iteration handles one match and its
3794 * corresponding substitution. If "-all" hasn't been specified
3795 * then the loop body only gets executed once.
3798 n
= source_len
- offset
;
3799 p
= source_str
+ offset
;
3801 int match
= regexec(regex
, p
, MAX_SUB_MATCHES
, pmatch
, regexec_flags
);
3803 if (match
>= REG_BADPAT
) {
3806 regerror(match
, regex
, buf
, sizeof(buf
));
3807 Jim_SetResultFormatted(interp
, "error while matching pattern: %s", buf
);
3810 if (match
== REG_NOMATCH
) {
3817 * Copy the portion of the source string before the match to the
3820 Jim_AppendString(interp
, resultObj
, p
, pmatch
[0].rm_so
);
3823 * Append the subSpec (replace_str) argument to the variable, making appropriate
3824 * substitutions. This code is a bit hairy because of the backslash
3825 * conventions and because the code saves up ranges of characters in
3826 * subSpec to reduce the number of calls to Jim_SetVar.
3829 for (j
= 0; j
< replace_len
; j
++) {
3831 int c
= replace_str
[j
];
3836 else if (c
== '\\' && j
< replace_len
) {
3837 c
= replace_str
[++j
];
3838 if ((c
>= '0') && (c
<= '9')) {
3841 else if ((c
== '\\') || (c
== '&')) {
3842 Jim_AppendString(interp
, resultObj
, replace_str
+ j
, 1);
3846 Jim_AppendString(interp
, resultObj
, replace_str
+ j
- 1, 2);
3851 Jim_AppendString(interp
, resultObj
, replace_str
+ j
, 1);
3854 if ((idx
< MAX_SUB_MATCHES
) && pmatch
[idx
].rm_so
!= -1 && pmatch
[idx
].rm_eo
!= -1) {
3855 Jim_AppendString(interp
, resultObj
, p
+ pmatch
[idx
].rm_so
,
3856 pmatch
[idx
].rm_eo
- pmatch
[idx
].rm_so
);
3860 p
+= pmatch
[0].rm_eo
;
3861 n
-= pmatch
[0].rm_eo
;
3863 /* If -all is not specified, or there is no source left, we are done */
3864 if (!opt_all
|| n
== 0) {
3868 /* An anchored pattern without -line must be done */
3869 if ((regcomp_flags
& REG_NEWLINE
) == 0 && pattern
[0] == '^') {
3873 /* If the pattern is empty, need to step forwards */
3874 if (pattern
[0] == '\0' && n
) {
3875 /* Need to copy the char we are moving over */
3876 Jim_AppendString(interp
, resultObj
, p
, 1);
3881 regexec_flags
|= REG_NOTBOL
;
3885 * Copy the portion of the string after the last match to the
3888 Jim_AppendString(interp
, resultObj
, p
, -1);
3890 /* And now set or return the result variable */
3891 if (argc
- i
== 4) {
3892 result
= Jim_SetVariable(interp
, varname
, resultObj
);
3894 if (result
== JIM_OK
) {
3895 Jim_SetResultInt(interp
, num_matches
);
3898 Jim_FreeObj(interp
, resultObj
);
3902 Jim_SetResult(interp
, resultObj
);
3909 int Jim_regexpInit(Jim_Interp
*interp
)
3911 if (Jim_PackageProvide(interp
, "regexp", "1.0", JIM_ERRMSG
))
3914 Jim_CreateCommand(interp
, "regexp", Jim_RegexpCmd
, NULL
, NULL
);
3915 Jim_CreateCommand(interp
, "regsub", Jim_RegsubCmd
, NULL
, NULL
);
3919 * Implements the file command for jim
3921 * (c) 2008 Steve Bennett <steveb@workware.net.au>
3923 * Redistribution and use in source and binary forms, with or without
3924 * modification, are permitted provided that the following conditions
3927 * 1. Redistributions of source code must retain the above copyright
3928 * notice, this list of conditions and the following disclaimer.
3929 * 2. Redistributions in binary form must reproduce the above
3930 * copyright notice, this list of conditions and the following
3931 * disclaimer in the documentation and/or other materials
3932 * provided with the distribution.
3934 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
3935 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
3936 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
3937 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
3938 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
3939 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
3940 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
3941 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
3942 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
3943 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
3944 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
3945 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
3947 * The views and conclusions contained in the software and documentation
3948 * are those of the authors and should not be interpreted as representing
3949 * official policies, either expressed or implied, of the Jim Tcl Project.
3951 * Based on code originally from Tcl 6.7:
3953 * Copyright 1987-1991 Regents of the University of California
3954 * Permission to use, copy, modify, and distribute this
3955 * software and its documentation for any purpose and without
3956 * fee is hereby granted, provided that the above copyright
3957 * notice appear in all copies. The University of California
3958 * makes no representations about the suitability of this
3959 * software for any purpose. It is provided "as is" without
3960 * express or implied warranty.
3969 #include <sys/stat.h>
3970 #include <sys/param.h>
3974 # define MAXPATHLEN JIM_PATH_LEN
3978 *----------------------------------------------------------------------
3982 * Given a mode word, returns a string identifying the type of a
3986 * A static text string giving the file type from mode.
3991 *----------------------------------------------------------------------
3994 static const char *JimGetFileType(int mode
)
3996 if (S_ISREG(mode
)) {
3999 else if (S_ISDIR(mode
)) {
4002 else if (S_ISCHR(mode
)) {
4003 return "characterSpecial";
4005 else if (S_ISBLK(mode
)) {
4006 return "blockSpecial";
4008 else if (S_ISFIFO(mode
)) {
4012 else if (S_ISLNK(mode
)) {
4017 else if (S_ISSOCK(mode
)) {
4025 *----------------------------------------------------------------------
4029 * This is a utility procedure that breaks out the fields of a
4030 * "stat" structure and stores them in textual form into the
4031 * elements of an associative array.
4034 * Returns a standard Tcl return value. If an error occurs then
4035 * a message is left in interp->result.
4038 * Elements of the associative array given by "varName" are modified.
4040 *----------------------------------------------------------------------
4043 static int set_array_int_value(Jim_Interp
*interp
, Jim_Obj
*container
, const char *key
,
4046 Jim_Obj
*nameobj
= Jim_NewStringObj(interp
, key
, -1);
4047 Jim_Obj
*valobj
= Jim_NewWideObj(interp
, value
);
4049 if (Jim_SetDictKeysVector(interp
, container
, &nameobj
, 1, valobj
) != JIM_OK
) {
4050 Jim_FreeObj(interp
, nameobj
);
4051 Jim_FreeObj(interp
, valobj
);
4057 static int set_array_string_value(Jim_Interp
*interp
, Jim_Obj
*container
, const char *key
,
4060 Jim_Obj
*nameobj
= Jim_NewStringObj(interp
, key
, -1);
4061 Jim_Obj
*valobj
= Jim_NewStringObj(interp
, value
, -1);
4063 if (Jim_SetDictKeysVector(interp
, container
, &nameobj
, 1, valobj
) != JIM_OK
) {
4064 Jim_FreeObj(interp
, nameobj
);
4065 Jim_FreeObj(interp
, valobj
);
4071 static int StoreStatData(Jim_Interp
*interp
, Jim_Obj
*varName
, const struct stat
*sb
)
4073 if (set_array_int_value(interp
, varName
, "dev", sb
->st_dev
) != JIM_OK
) {
4074 Jim_SetResultFormatted(interp
, "can't set \"%#s(dev)\": variables isn't array", varName
);
4077 set_array_int_value(interp
, varName
, "ino", sb
->st_ino
);
4078 set_array_int_value(interp
, varName
, "mode", sb
->st_mode
);
4079 set_array_int_value(interp
, varName
, "nlink", sb
->st_nlink
);
4080 set_array_int_value(interp
, varName
, "uid", sb
->st_uid
);
4081 set_array_int_value(interp
, varName
, "gid", sb
->st_gid
);
4082 set_array_int_value(interp
, varName
, "size", sb
->st_size
);
4083 set_array_int_value(interp
, varName
, "atime", sb
->st_atime
);
4084 set_array_int_value(interp
, varName
, "mtime", sb
->st_mtime
);
4085 set_array_int_value(interp
, varName
, "ctime", sb
->st_ctime
);
4086 set_array_string_value(interp
, varName
, "type", JimGetFileType((int)sb
->st_mode
));
4088 /* And also return the value */
4089 Jim_SetResult(interp
, Jim_GetVariable(interp
, varName
, 0));
4094 static int file_cmd_dirname(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4096 const char *path
= Jim_String(argv
[0]);
4097 const char *p
= strrchr(path
, '/');
4100 Jim_SetResultString(interp
, ".", -1);
4102 else if (p
== path
) {
4103 Jim_SetResultString(interp
, "/", -1);
4105 #if defined(__MINGW32__)
4106 else if (p
[-1] == ':') {
4108 Jim_SetResultString(interp
, path
, p
- path
+ 1);
4112 Jim_SetResultString(interp
, path
, p
- path
);
4117 static int file_cmd_rootname(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4119 const char *path
= Jim_String(argv
[0]);
4120 const char *lastSlash
= strrchr(path
, '/');
4121 const char *p
= strrchr(path
, '.');
4123 if (p
== NULL
|| (lastSlash
!= NULL
&& lastSlash
> p
)) {
4124 Jim_SetResult(interp
, argv
[0]);
4127 Jim_SetResultString(interp
, path
, p
- path
);
4132 static int file_cmd_extension(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4134 const char *path
= Jim_String(argv
[0]);
4135 const char *lastSlash
= strrchr(path
, '/');
4136 const char *p
= strrchr(path
, '.');
4138 if (p
== NULL
|| (lastSlash
!= NULL
&& lastSlash
>= p
)) {
4141 Jim_SetResultString(interp
, p
, -1);
4145 static int file_cmd_tail(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4147 const char *path
= Jim_String(argv
[0]);
4148 const char *lastSlash
= strrchr(path
, '/');
4151 Jim_SetResultString(interp
, lastSlash
+ 1, -1);
4154 Jim_SetResult(interp
, argv
[0]);
4159 static int file_cmd_normalize(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4161 #ifdef HAVE_REALPATH
4162 const char *path
= Jim_String(argv
[0]);
4163 char *newname
= Jim_Alloc(MAXPATHLEN
+ 1);
4165 if (realpath(path
, newname
)) {
4166 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, newname
, -1));
4170 Jim_SetResult(interp
, argv
[0]);
4174 Jim_SetResultString(interp
, "Not implemented", -1);
4179 static int file_cmd_join(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4182 char *newname
= Jim_Alloc(MAXPATHLEN
+ 1);
4183 char *last
= newname
;
4187 /* Simple implementation for now */
4188 for (i
= 0; i
< argc
; i
++) {
4190 const char *part
= Jim_GetString(argv
[i
], &len
);
4193 /* Absolute component, so go back to the start */
4196 #if defined(__MINGW32__)
4197 else if (strchr(part
, ':')) {
4198 /* Absolute compontent on mingw, so go back to the start */
4202 else if (part
[0] == '.') {
4203 if (part
[1] == '/') {
4207 else if (part
[1] == 0 && last
!= newname
) {
4208 /* Adding '.' to an existing path does nothing */
4213 /* Add a slash if needed */
4214 if (last
!= newname
&& last
[-1] != '/') {
4219 if (last
+ len
- newname
>= MAXPATHLEN
) {
4221 Jim_SetResultString(interp
, "Path too long", -1);
4224 memcpy(last
, part
, len
);
4228 /* Remove a slash if needed */
4229 if (last
> newname
+ 1 && last
[-1] == '/') {
4236 /* Probably need to handle some special cases ... */
4238 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, newname
, last
- newname
));
4243 static int file_access(Jim_Interp
*interp
, Jim_Obj
*filename
, int mode
)
4245 const char *path
= Jim_String(filename
);
4246 int rc
= access(path
, mode
);
4248 Jim_SetResultBool(interp
, rc
!= -1);
4253 static int file_cmd_readable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4255 return file_access(interp
, argv
[0], R_OK
);
4258 static int file_cmd_writable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4260 return file_access(interp
, argv
[0], W_OK
);
4263 static int file_cmd_executable(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4265 return file_access(interp
, argv
[0], X_OK
);
4268 static int file_cmd_exists(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4270 return file_access(interp
, argv
[0], F_OK
);
4273 static int file_cmd_delete(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4275 int force
= Jim_CompareStringImmediate(interp
, argv
[0], "-force");
4277 if (force
|| Jim_CompareStringImmediate(interp
, argv
[0], "--")) {
4283 const char *path
= Jim_String(argv
[0]);
4285 if (unlink(path
) == -1 && errno
!= ENOENT
) {
4286 if (rmdir(path
) == -1) {
4287 /* Maybe try using the script helper */
4288 if (!force
|| Jim_EvalObjPrefix(interp
, "file delete force", 1, argv
) != JIM_OK
) {
4289 Jim_SetResultFormatted(interp
, "couldn't delete file \"%s\": %s", path
,
4300 #ifdef HAVE_MKDIR_ONE_ARG
4301 #define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME)
4303 #define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME, 0755)
4307 * Create directory, creating all intermediate paths if necessary.
4309 * Returns 0 if OK or -1 on failure (and sets errno)
4311 * Note: The path may be modified.
4313 static int mkdir_all(char *path
)
4317 /* First time just try to make the dir */
4321 /* Must have failed the first time, so recursively make the parent and try again */
4322 char *slash
= strrchr(path
, '/');
4324 if (slash
&& slash
!= path
) {
4326 if (mkdir_all(path
) != 0) {
4332 if (MKDIR_DEFAULT(path
) == 0) {
4335 if (errno
== ENOENT
) {
4336 /* Create the parent and try again */
4339 /* Maybe it already exists as a directory */
4340 if (errno
== EEXIST
) {
4343 if (stat(path
, &sb
) == 0 && S_ISDIR(sb
.st_mode
)) {
4355 static int file_cmd_mkdir(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4358 char *path
= Jim_StrDup(Jim_String(argv
[0]));
4359 int rc
= mkdir_all(path
);
4363 Jim_SetResultFormatted(interp
, "can't create directory \"%#s\": %s", argv
[0],
4373 static int file_cmd_tempfile(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4377 const char *template = "/tmp/tcl.tmp.XXXXXX";
4380 template = Jim_String(argv
[0]);
4382 filename
= Jim_StrDup(template);
4384 fd
= mkstemp(filename
);
4386 Jim_SetResultString(interp
, "Failed to create tempfile", -1);
4391 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, filename
, -1));
4396 static int file_cmd_rename(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4403 if (!Jim_CompareStringImmediate(interp
, argv
[0], "-force")) {
4411 source
= Jim_String(argv
[0]);
4412 dest
= Jim_String(argv
[1]);
4414 if (!force
&& access(dest
, F_OK
) == 0) {
4415 Jim_SetResultFormatted(interp
, "error renaming \"%#s\" to \"%#s\": target exists", argv
[0],
4420 if (rename(source
, dest
) != 0) {
4421 Jim_SetResultFormatted(interp
, "error renaming \"%#s\" to \"%#s\": %s", argv
[0], argv
[1],
4429 static int file_stat(Jim_Interp
*interp
, Jim_Obj
*filename
, struct stat
*sb
)
4431 const char *path
= Jim_String(filename
);
4433 if (stat(path
, sb
) == -1) {
4434 Jim_SetResultFormatted(interp
, "could not read \"%#s\": %s", filename
, strerror(errno
));
4444 static int file_lstat(Jim_Interp
*interp
, Jim_Obj
*filename
, struct stat
*sb
)
4446 const char *path
= Jim_String(filename
);
4448 if (lstat(path
, sb
) == -1) {
4449 Jim_SetResultFormatted(interp
, "could not read \"%#s\": %s", filename
, strerror(errno
));
4455 static int file_cmd_atime(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4459 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4462 Jim_SetResultInt(interp
, sb
.st_atime
);
4466 static int file_cmd_mtime(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4470 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4473 Jim_SetResultInt(interp
, sb
.st_mtime
);
4477 static int file_cmd_copy(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4479 return Jim_EvalObjPrefix(interp
, "file copy", argc
, argv
);
4482 static int file_cmd_size(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4486 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4489 Jim_SetResultInt(interp
, sb
.st_size
);
4493 static int file_cmd_isdirectory(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4498 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4499 ret
= S_ISDIR(sb
.st_mode
);
4501 Jim_SetResultInt(interp
, ret
);
4505 static int file_cmd_isfile(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4510 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4511 ret
= S_ISREG(sb
.st_mode
);
4513 Jim_SetResultInt(interp
, ret
);
4518 static int file_cmd_owned(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4523 if (file_stat(interp
, argv
[0], &sb
) == JIM_OK
) {
4524 ret
= (geteuid() == sb
.st_uid
);
4526 Jim_SetResultInt(interp
, ret
);
4531 #if defined(HAVE_READLINK)
4532 static int file_cmd_readlink(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4534 const char *path
= Jim_String(argv
[0]);
4535 char *linkValue
= Jim_Alloc(MAXPATHLEN
+ 1);
4537 int linkLength
= readlink(path
, linkValue
, MAXPATHLEN
);
4539 if (linkLength
== -1) {
4540 Jim_Free(linkValue
);
4541 Jim_SetResultFormatted(interp
, "couldn't readlink \"%s\": %s", argv
[0], strerror(errno
));
4544 linkValue
[linkLength
] = 0;
4545 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, linkValue
, linkLength
));
4550 static int file_cmd_type(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4554 if (file_lstat(interp
, argv
[0], &sb
) != JIM_OK
) {
4557 Jim_SetResultString(interp
, JimGetFileType((int)sb
.st_mode
), -1);
4561 static int file_cmd_lstat(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4565 if (file_lstat(interp
, argv
[0], &sb
) != JIM_OK
) {
4568 return StoreStatData(interp
, argv
[1], &sb
);
4571 static int file_cmd_stat(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4575 if (file_stat(interp
, argv
[0], &sb
) != JIM_OK
) {
4578 return StoreStatData(interp
, argv
[1], &sb
);
4581 static const jim_subcmd_type file_command_table
[] = {
4584 .function
= file_cmd_atime
,
4587 .description
= "Last access time"
4591 .function
= file_cmd_mtime
,
4594 .description
= "Last modification time"
4597 .args
= "?-force? source dest",
4598 .function
= file_cmd_copy
,
4601 .description
= "Copy source file to destination file"
4605 .function
= file_cmd_dirname
,
4608 .description
= "Directory part of the name"
4610 { .cmd
= "rootname",
4612 .function
= file_cmd_rootname
,
4615 .description
= "Name without any extension"
4617 { .cmd
= "extension",
4619 .function
= file_cmd_extension
,
4622 .description
= "Last extension including the dot"
4626 .function
= file_cmd_tail
,
4629 .description
= "Last component of the name"
4631 { .cmd
= "normalize",
4633 .function
= file_cmd_normalize
,
4636 .description
= "Normalized path of name"
4639 .args
= "name ?name ...?",
4640 .function
= file_cmd_join
,
4643 .description
= "Join multiple path components"
4645 { .cmd
= "readable",
4647 .function
= file_cmd_readable
,
4650 .description
= "Is file readable"
4652 { .cmd
= "writable",
4654 .function
= file_cmd_writable
,
4657 .description
= "Is file writable"
4659 { .cmd
= "executable",
4661 .function
= file_cmd_executable
,
4664 .description
= "Is file executable"
4668 .function
= file_cmd_exists
,
4671 .description
= "Does file exist"
4674 .args
= "?-force|--? name ...",
4675 .function
= file_cmd_delete
,
4678 .description
= "Deletes the files or directories (must be empty unless -force)"
4682 .function
= file_cmd_mkdir
,
4685 .description
= "Creates the directories"
4688 { .cmd
= "tempfile",
4689 .args
= "?template?",
4690 .function
= file_cmd_tempfile
,
4693 .description
= "Creates a temporary filename"
4697 .args
= "?-force? source dest",
4698 .function
= file_cmd_rename
,
4701 .description
= "Renames a file"
4703 #if defined(HAVE_READLINK)
4704 { .cmd
= "readlink",
4706 .function
= file_cmd_readlink
,
4709 .description
= "Value of the symbolic link"
4714 .function
= file_cmd_size
,
4717 .description
= "Size of file"
4721 .function
= file_cmd_stat
,
4724 .description
= "Stores results of stat in var array"
4728 .function
= file_cmd_lstat
,
4731 .description
= "Stores results of lstat in var array"
4735 .function
= file_cmd_type
,
4738 .description
= "Returns type of the file"
4743 .function
= file_cmd_owned
,
4746 .description
= "Returns 1 if owned by the current owner"
4749 { .cmd
= "isdirectory",
4751 .function
= file_cmd_isdirectory
,
4754 .description
= "Returns 1 if name is a directory"
4758 .function
= file_cmd_isfile
,
4761 .description
= "Returns 1 if name is a file"
4768 static int Jim_CdCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4773 Jim_WrongNumArgs(interp
, 1, argv
, "dirname");
4777 path
= Jim_String(argv
[1]);
4779 if (chdir(path
) != 0) {
4780 Jim_SetResultFormatted(interp
, "couldn't change working directory to \"%s\": %s", path
,
4787 static int Jim_PwdCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
4789 const int cwd_len
= 2048;
4790 char *cwd
= malloc(cwd_len
);
4792 if (getcwd(cwd
, cwd_len
) == NULL
) {
4793 Jim_SetResultString(interp
, "Failed to get pwd", -1);
4796 #if defined(__MINGW32__)
4798 /* Try to keep backlashes out of paths */
4800 while ((p
= strchr(p
, '\\')) != NULL
) {
4806 Jim_SetResultString(interp
, cwd
, -1);
4812 int Jim_fileInit(Jim_Interp
*interp
)
4814 if (Jim_PackageProvide(interp
, "file", "1.0", JIM_ERRMSG
))
4817 Jim_CreateCommand(interp
, "file", Jim_SubCmdProc
, (void *)file_command_table
, NULL
);
4818 Jim_CreateCommand(interp
, "pwd", Jim_PwdCmd
, NULL
, NULL
);
4819 Jim_CreateCommand(interp
, "cd", Jim_CdCmd
, NULL
, NULL
);
4824 * (c) 2008 Steve Bennett <steveb@workware.net.au>
4826 * Implements the exec command for Jim
4828 * Based on code originally from Tcl 6.7 by John Ousterhout.
4831 * The Tcl_Fork and Tcl_WaitPids procedures are based on code
4832 * contributed by Karl Lehenbauer, Mark Diekhans and Peter
4835 * Copyright 1987-1991 Regents of the University of California
4836 * Permission to use, copy, modify, and distribute this
4837 * software and its documentation for any purpose and without
4838 * fee is hereby granted, provided that the above copyright
4839 * notice appear in all copies. The University of California
4840 * makes no representations about the suitability of this
4841 * software for any purpose. It is provided "as is" without
4842 * express or implied warranty.
4849 #if defined(HAVE_VFORK) && defined(HAVE_WAITPID)
4855 #include <sys/wait.h>
4857 #if defined(__GNUC__) && !defined(__clang__)
4858 #define IGNORE_RC(EXPR) ((EXPR) < 0 ? -1 : 0)
4860 #define IGNORE_RC(EXPR) EXPR
4863 /* These two could be moved into the Tcl core */
4864 static void Jim_SetResultErrno(Jim_Interp
*interp
, const char *msg
)
4866 Jim_SetResultFormatted(interp
, "%s: %s", msg
, strerror(errno
));
4869 static void Jim_RemoveTrailingNewline(Jim_Obj
*objPtr
)
4872 const char *s
= Jim_GetString(objPtr
, &len
);
4874 if (len
> 0 && s
[len
- 1] == '\n') {
4876 objPtr
->bytes
[objPtr
->length
] = '\0';
4881 * Read from 'fd' and append the data to strObj
4882 * Returns JIM_OK if OK, or JIM_ERR on error.
4884 static int JimAppendStreamToString(Jim_Interp
*interp
, int fd
, Jim_Obj
*strObj
)
4890 count
= read(fd
, buffer
, sizeof(buffer
));
4893 Jim_RemoveTrailingNewline(strObj
);
4899 Jim_AppendString(interp
, strObj
, buffer
, count
);
4904 * If the last character of the result is a newline, then remove
4905 * the newline character (the newline would just confuse things).
4907 * Note: Ideally we could do this by just reducing the length of stringrep
4908 * by 1, but there is no API for this :-(
4910 static void JimTrimTrailingNewline(Jim_Interp
*interp
)
4913 const char *p
= Jim_GetString(Jim_GetResult(interp
), &len
);
4915 if (len
> 0 && p
[len
- 1] == '\n') {
4916 Jim_SetResultString(interp
, p
, len
- 1);
4921 * Builds the environment array from $::env
4923 * If $::env is not set, simply returns environ.
4925 * Otherwise allocates the environ array from the contents of $::env
4927 * If the exec fails, memory can be freed via JimFreeEnv()
4929 static char **JimBuildEnv(Jim_Interp
*interp
)
4931 #ifdef jim_ext_tclcompat
4937 Jim_Obj
*objPtr
= Jim_GetGlobalVariableStr(interp
, "env", JIM_NONE
);
4940 return Jim_GetEnviron();
4943 /* Calculate the required size */
4944 len
= Jim_ListLength(interp
, objPtr
);
4949 env
= Jim_Alloc(sizeof(*env
) * (len
/ 2 + 1));
4952 for (i
= 0; i
< len
; i
+= 2) {
4954 const char *s1
, *s2
;
4957 Jim_ListIndex(interp
, objPtr
, i
, &elemObj
, JIM_NONE
);
4958 s1
= Jim_GetString(elemObj
, &l1
);
4959 Jim_ListIndex(interp
, objPtr
, i
+ 1, &elemObj
, JIM_NONE
);
4960 s2
= Jim_GetString(elemObj
, &l2
);
4962 env
[n
] = Jim_Alloc(l1
+ l2
+ 2);
4963 sprintf(env
[n
], "%s=%s", s1
, s2
);
4970 return Jim_GetEnviron();
4975 * Frees the environment allocated by JimBuildEnv()
4977 * Must pass original_environ.
4979 static void JimFreeEnv(Jim_Interp
*interp
, char **env
, char **original_environ
)
4981 #ifdef jim_ext_tclcompat
4982 if (env
!= original_environ
) {
4984 for (i
= 0; env
[i
]; i
++) {
4993 * Create error messages for unusual process exits. An
4994 * extra newline gets appended to each error message, but
4995 * it gets removed below (in the same fashion that an
4996 * extra newline in the command's output is removed).
4998 static int JimCheckWaitStatus(Jim_Interp
*interp
, int pid
, int waitStatus
)
5000 Jim_Obj
*errorCode
= Jim_NewListObj(interp
, NULL
, 0);
5003 if (WIFEXITED(waitStatus
)) {
5004 if (WEXITSTATUS(waitStatus
) == 0) {
5005 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "NONE", -1));
5009 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "CHILDSTATUS", -1));
5010 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
5011 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WEXITSTATUS(waitStatus
)));
5018 if (WIFSIGNALED(waitStatus
)) {
5019 type
= "CHILDKILLED";
5024 action
= "suspended";
5027 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, type
, -1));
5029 #ifdef jim_ext_signal
5030 Jim_SetResultFormatted(interp
, "child %s by signal %s", action
, Jim_SignalId(WTERMSIG(waitStatus
)));
5031 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, Jim_SignalId(WTERMSIG(waitStatus
)), -1));
5032 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
5033 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, Jim_SignalName(WTERMSIG(waitStatus
)), -1));
5035 Jim_SetResultFormatted(interp
, "child %s by signal %d", action
, WTERMSIG(waitStatus
));
5036 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WTERMSIG(waitStatus
)));
5037 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, pid
));
5038 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, WTERMSIG(waitStatus
)));
5041 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCode
);
5046 * Data structures of the following type are used by JimFork and
5047 * JimWaitPids to keep track of child processes.
5052 int pid
; /* Process id of child. */
5053 int status
; /* Status returned when child exited or suspended. */
5054 int flags
; /* Various flag bits; see below for definitions. */
5057 struct WaitInfoTable
{
5058 struct WaitInfo
*info
;
5064 * Flag bits in WaitInfo structures:
5066 * WI_DETACHED - Non-zero means no-one cares about the
5067 * process anymore. Ignore it until it
5068 * exits, then forget about it.
5071 #define WI_DETACHED 2
5073 #define WAIT_TABLE_GROW_BY 4
5075 static void JimFreeWaitInfoTable(struct Jim_Interp
*interp
, void *privData
)
5077 struct WaitInfoTable
*table
= privData
;
5079 Jim_Free(table
->info
);
5083 static struct WaitInfoTable
*JimAllocWaitInfoTable(void)
5085 struct WaitInfoTable
*table
= Jim_Alloc(sizeof(*table
));
5087 table
->size
= table
->used
= 0;
5092 static int Jim_CreatePipeline(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
,
5093 int **pidArrayPtr
, int *inPipePtr
, int *outPipePtr
, int *errFilePtr
);
5094 static void JimDetachPids(Jim_Interp
*interp
, int numPids
, const int *pidPtr
);
5095 static int Jim_CleanupChildren(Jim_Interp
*interp
, int numPids
, int *pidPtr
, int errorId
);
5097 static int Jim_ExecCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5099 int outputId
; /* File id for output pipe. -1
5100 * means command overrode. */
5101 int errorId
; /* File id for temporary file
5102 * containing error output. */
5104 int numPids
, result
;
5107 * See if the command is to be run in background; if so, create
5108 * the command, detach it, and return.
5110 if (argc
> 1 && Jim_CompareStringImmediate(interp
, argv
[argc
- 1], "&")) {
5115 numPids
= Jim_CreatePipeline(interp
, argc
- 1, argv
+ 1, &pidPtr
, NULL
, NULL
, NULL
);
5119 /* The return value is a list of the pids */
5120 listObj
= Jim_NewListObj(interp
, NULL
, 0);
5121 for (i
= 0; i
< numPids
; i
++) {
5122 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, pidPtr
[i
]));
5124 Jim_SetResult(interp
, listObj
);
5125 JimDetachPids(interp
, numPids
, pidPtr
);
5131 * Create the command's pipeline.
5134 Jim_CreatePipeline(interp
, argc
- 1, argv
+ 1, &pidPtr
, (int *)NULL
, &outputId
, &errorId
);
5140 * Read the child's output (if any) and put it into the result.
5142 Jim_SetResultString(interp
, "", 0);
5145 if (outputId
!= -1) {
5146 result
= JimAppendStreamToString(interp
, outputId
, Jim_GetResult(interp
));
5148 Jim_SetResultErrno(interp
, "error reading from output pipe");
5153 if (Jim_CleanupChildren(interp
, numPids
, pidPtr
, errorId
) != JIM_OK
) {
5159 void Jim_ReapDetachedPids(struct WaitInfoTable
*table
)
5161 struct WaitInfo
*waitPtr
;
5168 for (waitPtr
= table
->info
, count
= table
->used
; count
> 0; waitPtr
++, count
--) {
5169 if (waitPtr
->flags
& WI_DETACHED
) {
5171 int pid
= waitpid(waitPtr
->pid
, &status
, WNOHANG
);
5173 if (waitPtr
!= &table
->info
[table
->used
- 1]) {
5174 *waitPtr
= table
->info
[table
->used
- 1];
5183 * Does waitpid() on the given pid, and then removes the
5184 * entry from the wait table.
5186 * Returns the pid if OK and updates *statusPtr with the status,
5187 * or -1 if the pid was not in the table.
5189 static int JimWaitPid(struct WaitInfoTable
*table
, int pid
, int *statusPtr
)
5193 /* Find it in the table */
5194 for (i
= 0; i
< table
->used
; i
++) {
5195 if (pid
== table
->info
[i
].pid
) {
5197 waitpid(pid
, statusPtr
, 0);
5199 /* Remove it from the table */
5200 if (i
!= table
->used
- 1) {
5201 table
->info
[i
] = table
->info
[table
->used
- 1];
5213 *----------------------------------------------------------------------
5217 * This procedure is called to indicate that one or more child
5218 * processes have been placed in background and are no longer
5219 * cared about. These children can be cleaned up with JimReapDetachedPids().
5227 *----------------------------------------------------------------------
5230 static void JimDetachPids(Jim_Interp
*interp
, int numPids
, const int *pidPtr
)
5233 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5235 for (j
= 0; j
< numPids
; j
++) {
5236 /* Find it in the table */
5238 for (i
= 0; i
< table
->used
; i
++) {
5239 if (pidPtr
[j
] == table
->info
[i
].pid
) {
5240 table
->info
[i
].flags
|= WI_DETACHED
;
5248 *----------------------------------------------------------------------
5250 * Jim_CreatePipeline --
5252 * Given an argc/argv array, instantiate a pipeline of processes
5253 * as described by the argv.
5256 * The return value is a count of the number of new processes
5257 * created, or -1 if an error occurred while creating the pipeline.
5258 * *pidArrayPtr is filled in with the address of a dynamically
5259 * allocated array giving the ids of all of the processes. It
5260 * is up to the caller to free this array when it isn't needed
5261 * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
5262 * with the file id for the input pipe for the pipeline (if any):
5263 * the caller must eventually close this file. If outPipePtr
5264 * isn't NULL, then *outPipePtr is filled in with the file id
5265 * for the output pipe from the pipeline: the caller must close
5266 * this file. If errFilePtr isn't NULL, then *errFilePtr is filled
5267 * with a file id that may be used to read error output after the
5268 * pipeline completes.
5271 * Processes and pipes are created.
5273 *----------------------------------------------------------------------
5276 Jim_CreatePipeline(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int **pidArrayPtr
,
5277 int *inPipePtr
, int *outPipePtr
, int *errFilePtr
)
5279 int *pidPtr
= NULL
; /* Points to malloc-ed array holding all
5280 * the pids of child processes. */
5281 int numPids
= 0; /* Actual number of processes that exist
5282 * at *pidPtr right now. */
5283 int cmdCount
; /* Count of number of distinct commands
5284 * found in argc/argv. */
5285 const char *input
= NULL
; /* Describes input for pipeline, depending
5286 * on "inputFile". NULL means take input
5287 * from stdin/pipe. */
5289 #define FILE_NAME 0 /* input/output: filename */
5290 #define FILE_APPEND 1 /* output only: filename, append */
5291 #define FILE_HANDLE 2 /* input/output: filehandle */
5292 #define FILE_TEXT 3 /* input only: input is actual text */
5294 int inputFile
= FILE_NAME
; /* 1 means input is name of input file.
5295 * 2 means input is filehandle name.
5296 * 0 means input holds actual
5297 * text to be input to command. */
5299 int outputFile
= FILE_NAME
; /* 0 means output is the name of output file.
5300 * 1 means output is the name of output file, and append.
5301 * 2 means output is filehandle name.
5302 * All this is ignored if output is NULL
5304 int errorFile
= FILE_NAME
; /* 0 means error is the name of error file.
5305 * 1 means error is the name of error file, and append.
5306 * 2 means error is filehandle name.
5307 * All this is ignored if error is NULL
5309 const char *output
= NULL
; /* Holds name of output file to pipe to,
5310 * or NULL if output goes to stdout/pipe. */
5311 const char *error
= NULL
; /* Holds name of stderr file to pipe to,
5312 * or NULL if stderr goes to stderr/pipe. */
5313 int inputId
= -1; /* Readable file id input to current command in
5314 * pipeline (could be file or pipe). -1
5315 * means use stdin. */
5316 int outputId
= -1; /* Writable file id for output from current
5317 * command in pipeline (could be file or pipe).
5318 * -1 means use stdout. */
5319 int errorId
= -1; /* Writable file id for all standard error
5320 * output from all commands in pipeline. -1
5321 * means use stderr. */
5322 int lastOutputId
= -1; /* Write file id for output from last command
5323 * in pipeline (could be file or pipe).
5324 * -1 means use stdout. */
5325 int pipeIds
[2]; /* File ids for pipe that's being created. */
5326 int firstArg
, lastArg
; /* Indexes of first and last arguments in
5327 * current command. */
5331 char **orig_environ
;
5332 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5334 /* Holds the args which will be used to exec */
5335 char **arg_array
= Jim_Alloc(sizeof(*arg_array
) * (argc
+ 1));
5338 Jim_ReapDetachedPids(table
);
5340 if (inPipePtr
!= NULL
) {
5343 if (outPipePtr
!= NULL
) {
5346 if (errFilePtr
!= NULL
) {
5349 pipeIds
[0] = pipeIds
[1] = -1;
5352 * First, scan through all the arguments to figure out the structure
5353 * of the pipeline. Count the number of distinct processes (it's the
5354 * number of "|" arguments). If there are "<", "<<", or ">" arguments
5355 * then make note of input and output redirection and remove these
5356 * arguments and the arguments that follow them.
5360 for (i
= 0; i
< argc
; i
++) {
5361 const char *arg
= Jim_String(argv
[i
]);
5363 if (arg
[0] == '<') {
5364 inputFile
= FILE_NAME
;
5366 if (*input
== '<') {
5367 inputFile
= FILE_TEXT
;
5370 else if (*input
== '@') {
5371 inputFile
= FILE_HANDLE
;
5375 if (!*input
&& ++i
< argc
) {
5376 input
= Jim_String(argv
[i
]);
5379 else if (arg
[0] == '>') {
5382 outputFile
= FILE_NAME
;
5385 if (*output
== '>') {
5386 outputFile
= FILE_APPEND
;
5389 if (*output
== '&') {
5390 /* Redirect stderr too */
5394 if (*output
== '@') {
5395 outputFile
= FILE_HANDLE
;
5398 if (!*output
&& ++i
< argc
) {
5399 output
= Jim_String(argv
[i
]);
5402 errorFile
= outputFile
;
5406 else if (arg
[0] == '2' && arg
[1] == '>') {
5408 errorFile
= FILE_NAME
;
5410 if (*error
== '@') {
5411 errorFile
= FILE_HANDLE
;
5414 else if (*error
== '>') {
5415 errorFile
= FILE_APPEND
;
5418 if (!*error
&& ++i
< argc
) {
5419 error
= Jim_String(argv
[i
]);
5423 if (strcmp(arg
, "|") == 0 || strcmp(arg
, "|&") == 0) {
5424 if (i
== lastBar
+ 1 || i
== argc
- 1) {
5425 Jim_SetResultString(interp
, "illegal use of | or |& in command", -1);
5431 /* Either |, |& or a "normal" arg, so store it in the arg array */
5432 arg_array
[arg_count
++] = (char *)arg
;
5437 Jim_SetResultFormatted(interp
, "can't specify \"%s\" as last word in command", arg
);
5442 if (arg_count
== 0) {
5443 Jim_SetResultString(interp
, "didn't specify command to execute", -1);
5445 Jim_Free(arg_array
);
5449 /* Must do this before vfork(), so do it now */
5450 orig_environ
= Jim_GetEnviron();
5451 Jim_SetEnviron(JimBuildEnv(interp
));
5454 * Set up the redirected input source for the pipeline, if
5457 if (input
!= NULL
) {
5458 if (inputFile
== FILE_TEXT
) {
5460 * Immediate data in command. Create temporary file and
5461 * put data into file.
5464 #define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
5465 char inName
[sizeof(TMP_STDIN_NAME
) + 1];
5468 strcpy(inName
, TMP_STDIN_NAME
);
5469 inputId
= mkstemp(inName
);
5471 Jim_SetResultErrno(interp
, "couldn't create input file for command");
5474 length
= strlen(input
);
5475 if (write(inputId
, input
, length
) != length
) {
5476 Jim_SetResultErrno(interp
, "couldn't write file input for command");
5479 if (lseek(inputId
, 0L, SEEK_SET
) == -1 || unlink(inName
) == -1) {
5480 Jim_SetResultErrno(interp
, "couldn't reset or remove input file for command");
5484 else if (inputFile
== FILE_HANDLE
) {
5485 /* Should be a file descriptor */
5486 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, input
, -1);
5487 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5489 Jim_FreeNewObj(interp
, fhObj
);
5493 inputId
= dup(fileno(fh
));
5497 * File redirection. Just open the file.
5499 inputId
= open(input
, O_RDONLY
, 0);
5501 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", input
,
5507 else if (inPipePtr
!= NULL
) {
5508 if (pipe(pipeIds
) != 0) {
5509 Jim_SetResultErrno(interp
, "couldn't create input pipe for command");
5512 inputId
= pipeIds
[0];
5513 *inPipePtr
= pipeIds
[1];
5514 pipeIds
[0] = pipeIds
[1] = -1;
5518 * Set up the redirected output sink for the pipeline from one
5519 * of two places, if requested.
5521 if (output
!= NULL
) {
5522 if (outputFile
== FILE_HANDLE
) {
5523 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, output
, -1);
5524 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5526 Jim_FreeNewObj(interp
, fhObj
);
5531 lastOutputId
= dup(fileno(fh
));
5535 * Output is to go to a file.
5537 int mode
= O_WRONLY
| O_CREAT
| O_TRUNC
;
5539 if (outputFile
== FILE_APPEND
) {
5540 mode
= O_WRONLY
| O_CREAT
| O_APPEND
;
5543 lastOutputId
= open(output
, mode
, 0666);
5544 if (lastOutputId
< 0) {
5545 Jim_SetResultFormatted(interp
, "couldn't write file \"%s\": %s", output
,
5551 else if (outPipePtr
!= NULL
) {
5553 * Output is to go to a pipe.
5555 if (pipe(pipeIds
) != 0) {
5556 Jim_SetResultErrno(interp
, "couldn't create output pipe");
5559 lastOutputId
= pipeIds
[1];
5560 *outPipePtr
= pipeIds
[0];
5561 pipeIds
[0] = pipeIds
[1] = -1;
5564 /* If we are redirecting stderr with 2>filename or 2>@fileId, then we ignore errFilePtr */
5565 if (error
!= NULL
) {
5566 if (errorFile
== FILE_HANDLE
) {
5567 if (strcmp(error
, "1") == 0) {
5569 if (lastOutputId
>= 0) {
5570 errorId
= dup(lastOutputId
);
5573 /* No redirection of stdout, so just use 2>@stdout */
5578 Jim_Obj
*fhObj
= Jim_NewStringObj(interp
, error
, -1);
5579 FILE *fh
= Jim_AioFilehandle(interp
, fhObj
);
5581 Jim_FreeNewObj(interp
, fhObj
);
5586 errorId
= dup(fileno(fh
));
5591 * Output is to go to a file.
5593 int mode
= O_WRONLY
| O_CREAT
| O_TRUNC
;
5595 if (errorFile
== FILE_APPEND
) {
5596 mode
= O_WRONLY
| O_CREAT
| O_APPEND
;
5599 errorId
= open(error
, mode
, 0666);
5601 Jim_SetResultFormatted(interp
, "couldn't write file \"%s\": %s", error
,
5606 else if (errFilePtr
!= NULL
) {
5608 * Set up the standard error output sink for the pipeline, if
5609 * requested. Use a temporary file which is opened, then deleted.
5610 * Could potentially just use pipe, but if it filled up it could
5611 * cause the pipeline to deadlock: we'd be waiting for processes
5612 * to complete before reading stderr, and processes couldn't complete
5613 * because stderr was backed up.
5616 #define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
5617 char errName
[sizeof(TMP_STDERR_NAME
) + 1];
5619 strcpy(errName
, TMP_STDERR_NAME
);
5620 errorId
= mkstemp(errName
);
5623 Jim_SetResultErrno(interp
, "couldn't create error file for command");
5626 *errFilePtr
= open(errName
, O_RDONLY
, 0);
5627 if (*errFilePtr
< 0) {
5630 if (unlink(errName
) == -1) {
5631 Jim_SetResultErrno(interp
, "couldn't remove error file for command");
5637 * Scan through the argc array, forking off a process for each
5638 * group of arguments between "|" arguments.
5641 pidPtr
= (int *)Jim_Alloc(cmdCount
* sizeof(*pidPtr
));
5642 for (i
= 0; i
< numPids
; i
++) {
5645 for (firstArg
= 0; firstArg
< arg_count
; numPids
++, firstArg
= lastArg
+ 1) {
5646 int pipe_dup_err
= 0;
5647 int origErrorId
= errorId
;
5651 for (lastArg
= firstArg
; lastArg
< arg_count
; lastArg
++) {
5652 if (arg_array
[lastArg
][0] == '|') {
5653 if (arg_array
[lastArg
][1] == '&') {
5659 /* Replace | with NULL for execv() */
5660 arg_array
[lastArg
] = NULL
;
5661 if (lastArg
== arg_count
) {
5662 outputId
= lastOutputId
;
5665 if (pipe(pipeIds
) != 0) {
5666 Jim_SetResultErrno(interp
, "couldn't create pipe");
5669 outputId
= pipeIds
[1];
5671 execName
= arg_array
[firstArg
];
5673 /* Now fork the child */
5676 * Disable SIGPIPE signals: if they were allowed, this process
5677 * might go away unexpectedly if children misbehave. This code
5678 * can potentially interfere with other application code that
5679 * expects to handle SIGPIPEs; what's really needed is an
5680 * arbiter for signals to allow them to be "shared".
5682 if (table
->info
== NULL
) {
5683 (void)signal(SIGPIPE
, SIG_IGN
);
5686 /* Need to do this befor vfork() */
5691 /* Need to prep an error message before vfork(), just in case */
5692 snprintf(execerr
, sizeof(execerr
), "couldn't exec \"%s\"", execName
);
5693 execerrlen
= strlen(execerr
);
5696 * Make a new process and enter it into the table if the fork
5701 Jim_SetResultErrno(interp
, "couldn't fork child process");
5707 if (inputId
!= -1) dup2(inputId
, 0);
5708 if (outputId
!= -1) dup2(outputId
, 1);
5709 if (errorId
!= -1) dup2(errorId
, 2);
5711 for (i
= 3; (i
<= outputId
) || (i
<= inputId
) || (i
<= errorId
); i
++) {
5715 execvp(execName
, &arg_array
[firstArg
]);
5717 /* we really can ignore the error here! */
5718 IGNORE_RC(write(2, execerr
, execerrlen
));
5725 * Enlarge the wait table if there isn't enough space for a new
5728 if (table
->used
== table
->size
) {
5729 table
->size
+= WAIT_TABLE_GROW_BY
;
5730 table
->info
= Jim_Realloc(table
->info
, table
->size
* sizeof(*table
->info
));
5733 table
->info
[table
->used
].pid
= pid
;
5734 table
->info
[table
->used
].flags
= 0;
5737 pidPtr
[numPids
] = pid
;
5739 /* Restore in case of pipe_dup_err */
5740 errorId
= origErrorId
;
5743 * Close off our copies of file descriptors that were set up for
5744 * this child, then set up the input for the next child.
5747 if (inputId
!= -1) {
5750 if (outputId
!= -1) {
5753 inputId
= pipeIds
[0];
5754 pipeIds
[0] = pipeIds
[1] = -1;
5756 *pidArrayPtr
= pidPtr
;
5759 * All done. Cleanup open files lying around and then return.
5763 if (inputId
!= -1) {
5766 if (lastOutputId
!= -1) {
5767 close(lastOutputId
);
5769 if (errorId
!= -1) {
5772 Jim_Free(arg_array
);
5774 JimFreeEnv(interp
, Jim_GetEnviron(), orig_environ
);
5775 Jim_SetEnviron(orig_environ
);
5780 * An error occurred. There could have been extra files open, such
5781 * as pipes between children. Clean them all up. Detach any child
5782 * processes that have been created.
5786 if ((inPipePtr
!= NULL
) && (*inPipePtr
!= -1)) {
5790 if ((outPipePtr
!= NULL
) && (*outPipePtr
!= -1)) {
5794 if ((errFilePtr
!= NULL
) && (*errFilePtr
!= -1)) {
5798 if (pipeIds
[0] != -1) {
5801 if (pipeIds
[1] != -1) {
5804 if (pidPtr
!= NULL
) {
5805 for (i
= 0; i
< numPids
; i
++) {
5806 if (pidPtr
[i
] != -1) {
5807 JimDetachPids(interp
, 1, &pidPtr
[i
]);
5817 *----------------------------------------------------------------------
5819 * CleanupChildren --
5821 * This is a utility procedure used to wait for child processes
5822 * to exit, record information about abnormal exits, and then
5823 * collect any stderr output generated by them.
5826 * The return value is a standard Tcl result. If anything at
5827 * weird happened with the child processes, JIM_ERROR is returned
5828 * and a message is left in interp->result.
5831 * If the last character of interp->result is a newline, then it
5832 * is removed. File errorId gets closed, and pidPtr is freed
5833 * back to the storage allocator.
5835 *----------------------------------------------------------------------
5838 static int Jim_CleanupChildren(Jim_Interp
*interp
, int numPids
, int *pidPtr
, int errorId
)
5840 struct WaitInfoTable
*table
= Jim_CmdPrivData(interp
);
5841 int result
= JIM_OK
;
5844 for (i
= 0; i
< numPids
; i
++) {
5846 if (JimWaitPid(table
, pidPtr
[i
], &waitStatus
) > 0) {
5847 if (JimCheckWaitStatus(interp
, pidPtr
[i
], waitStatus
) != JIM_OK
) {
5855 * Read the standard error file. If there's anything there,
5856 * then add the file's contents to the result
5860 if (JimAppendStreamToString(interp
, errorId
, Jim_GetResult(interp
)) != JIM_OK
) {
5861 Jim_SetResultErrno(interp
, "error reading from stderr output file");
5867 JimTrimTrailingNewline(interp
);
5872 int Jim_execInit(Jim_Interp
*interp
)
5874 if (Jim_PackageProvide(interp
, "exec", "1.0", JIM_ERRMSG
))
5877 Jim_CreateCommand(interp
, "exec", Jim_ExecCmd
, JimAllocWaitInfoTable(), JimFreeWaitInfoTable
);
5881 /* e.g. Windows. Poor mans implementation of exec with system()
5882 * The system() call *may* do command line redirection, etc.
5883 * The standard output is not available.
5884 * Can't redirect filehandles.
5886 static int Jim_ExecCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5888 Jim_Obj
*cmdlineObj
= Jim_NewEmptyStringObj(interp
);
5892 /* Create a quoted command line */
5893 for (i
= 1; i
< argc
; i
++) {
5895 const char *arg
= Jim_GetString(argv
[i
], &len
);
5898 Jim_AppendString(interp
, cmdlineObj
, " ", 1);
5900 if (strpbrk(arg
, "\\\" ") == NULL
) {
5901 /* No quoting required */
5902 Jim_AppendString(interp
, cmdlineObj
, arg
, len
);
5906 Jim_AppendString(interp
, cmdlineObj
, "\"", 1);
5907 for (j
= 0; j
< len
; j
++) {
5908 if (arg
[j
] == '\\' || arg
[j
] == '"') {
5909 Jim_AppendString(interp
, cmdlineObj
, "\\", 1);
5911 Jim_AppendString(interp
, cmdlineObj
, &arg
[j
], 1);
5913 Jim_AppendString(interp
, cmdlineObj
, "\"", 1);
5915 rc
= system(Jim_String(cmdlineObj
));
5917 Jim_FreeNewObj(interp
, cmdlineObj
);
5920 Jim_Obj
*errorCode
= Jim_NewListObj(interp
, NULL
, 0);
5921 Jim_ListAppendElement(interp
, errorCode
, Jim_NewStringObj(interp
, "CHILDSTATUS", -1));
5922 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, 0));
5923 Jim_ListAppendElement(interp
, errorCode
, Jim_NewIntObj(interp
, rc
));
5924 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCode
);
5931 int Jim_execInit(Jim_Interp
*interp
)
5933 if (Jim_PackageProvide(interp
, "exec", "1.0", JIM_ERRMSG
))
5936 Jim_CreateCommand(interp
, "exec", Jim_ExecCmd
, NULL
, NULL
);
5944 * Implements the clock command
5947 /* For strptime() */
5948 #ifndef _XOPEN_SOURCE
5949 #define _XOPEN_SOURCE 500
5956 #include <sys/time.h>
5959 static int clock_cmd_format(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5961 /* How big is big enough? */
5966 const char *format
= "%a %b %d %H:%M:%S %Z %Y";
5968 if (argc
== 2 || (argc
== 3 && !Jim_CompareStringImmediate(interp
, argv
[1], "-format"))) {
5973 format
= Jim_String(argv
[2]);
5976 if (Jim_GetLong(interp
, argv
[0], &seconds
) != JIM_OK
) {
5981 strftime(buf
, sizeof(buf
), format
, localtime(&t
));
5983 Jim_SetResultString(interp
, buf
, -1);
5988 #ifdef HAVE_STRPTIME
5989 static int clock_cmd_scan(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
5993 time_t now
= time(0);
5995 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-format")) {
5999 /* Initialise with the current date/time */
6000 localtime_r(&now
, &tm
);
6002 pt
= strptime(Jim_String(argv
[0]), Jim_String(argv
[2]), &tm
);
6003 if (pt
== 0 || *pt
!= 0) {
6004 Jim_SetResultString(interp
, "Failed to parse time according to format", -1);
6008 /* Now convert into a time_t */
6009 Jim_SetResultInt(interp
, mktime(&tm
));
6015 static int clock_cmd_seconds(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6017 Jim_SetResultInt(interp
, time(NULL
));
6022 static int clock_cmd_micros(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6026 gettimeofday(&tv
, NULL
);
6028 Jim_SetResultInt(interp
, (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
);
6033 static int clock_cmd_millis(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6037 gettimeofday(&tv
, NULL
);
6039 Jim_SetResultInt(interp
, (jim_wide
) tv
.tv_sec
* 1000 + tv
.tv_usec
/ 1000);
6044 static const jim_subcmd_type clock_command_table
[] = {
6046 .function
= clock_cmd_seconds
,
6049 .description
= "Returns the current time as seconds since the epoch"
6052 .function
= clock_cmd_micros
,
6055 .description
= "Returns the current time in 'clicks'"
6057 { .cmd
= "microseconds",
6058 .function
= clock_cmd_micros
,
6061 .description
= "Returns the current time in microseconds"
6063 { .cmd
= "milliseconds",
6064 .function
= clock_cmd_millis
,
6067 .description
= "Returns the current time in milliseconds"
6070 .args
= "seconds ?-format format?",
6071 .function
= clock_cmd_format
,
6074 .description
= "Format the given time"
6076 #ifdef HAVE_STRPTIME
6078 .args
= "str -format format",
6079 .function
= clock_cmd_scan
,
6082 .description
= "Determine the time according to the given format"
6088 int Jim_clockInit(Jim_Interp
*interp
)
6090 if (Jim_PackageProvide(interp
, "clock", "1.0", JIM_ERRMSG
))
6093 Jim_CreateCommand(interp
, "clock", Jim_SubCmdProc
, (void *)clock_command_table
, NULL
);
6098 * Implements the array command for jim
6100 * (c) 2008 Steve Bennett <steveb@workware.net.au>
6102 * Redistribution and use in source and binary forms, with or without
6103 * modification, are permitted provided that the following conditions
6106 * 1. Redistributions of source code must retain the above copyright
6107 * notice, this list of conditions and the following disclaimer.
6108 * 2. Redistributions in binary form must reproduce the above
6109 * copyright notice, this list of conditions and the following
6110 * disclaimer in the documentation and/or other materials
6111 * provided with the distribution.
6113 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
6114 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
6115 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
6116 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
6117 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
6118 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
6119 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
6120 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
6121 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
6122 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
6123 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
6124 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
6126 * The views and conclusions contained in the software and documentation
6127 * are those of the authors and should not be interpreted as representing
6128 * official policies, either expressed or implied, of the Jim Tcl Project.
6130 * Based on code originally from Tcl 6.7:
6132 * Copyright 1987-1991 Regents of the University of California
6133 * Permission to use, copy, modify, and distribute this
6134 * software and its documentation for any purpose and without
6135 * fee is hereby granted, provided that the above copyright
6136 * notice appear in all copies. The University of California
6137 * makes no representations about the suitability of this
6138 * software for any purpose. It is provided "as is" without
6139 * express or implied warranty.
6150 static int array_cmd_exists(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6152 /* Just a regular [info exists] */
6153 Jim_SetResultInt(interp
, Jim_GetVariable(interp
, argv
[0], 0) != 0);
6157 static int array_cmd_get(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6163 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6165 Jim_Obj
**dictValuesObj
;
6171 if (argc
== 1 || Jim_CompareStringImmediate(interp
, argv
[1], "*")) {
6175 /* If it is a dictionary or list with an even number of elements, nothing else to do */
6177 if (Jim_IsDict(objPtr
) || (Jim_IsList(objPtr
) && Jim_ListLength(interp
, objPtr
) % 2 == 0)) {
6178 Jim_SetResult(interp
, objPtr
);
6183 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
6187 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
6192 /* Return the whole array */
6193 Jim_SetResult(interp
, dictObj
);
6196 /* Only return the matching values */
6197 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
6199 for (i
= 0; i
< len
; i
+= 2) {
6200 if (Jim_StringMatchObj(interp
, argv
[1], dictValuesObj
[i
], 0)) {
6201 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
]);
6202 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
+ 1]);
6206 Jim_SetResult(interp
, resultObj
);
6208 Jim_Free(dictValuesObj
);
6213 static int array_cmd_names(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6215 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6221 return Jim_DictKeys(interp
, objPtr
, argc
== 1 ? NULL
: argv
[1]);
6224 static int array_cmd_unset(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6231 Jim_Obj
**dictValuesObj
;
6233 if (argc
== 1 || Jim_CompareStringImmediate(interp
, argv
[1], "*")) {
6234 /* Unset the whole array */
6235 Jim_UnsetVariable(interp
, argv
[0], JIM_NONE
);
6239 objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6241 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
6245 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
6249 /* Create a new object with the values which don't match */
6250 resultObj
= Jim_NewDictObj(interp
, NULL
, 0);
6252 for (i
= 0; i
< len
; i
+= 2) {
6253 if (!Jim_StringMatchObj(interp
, argv
[1], dictValuesObj
[i
], 0)) {
6254 Jim_DictAddElement(interp
, resultObj
, dictValuesObj
[i
], dictValuesObj
[i
+ 1]);
6257 Jim_Free(dictValuesObj
);
6259 Jim_SetVariable(interp
, argv
[0], resultObj
);
6263 static int array_cmd_size(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6268 /* Not found means zero length */
6269 objPtr
= Jim_GetVariable(interp
, argv
[0], JIM_NONE
);
6271 len
= Jim_DictSize(interp
, objPtr
);
6277 Jim_SetResultInt(interp
, len
);
6282 static int array_cmd_set(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
6287 Jim_Obj
*listObj
= argv
[1];
6289 if (Jim_GetVariable(interp
, argv
[0], JIM_NONE
) == NULL
) {
6290 /* Doesn't exist, so just set the list directly */
6291 return Jim_SetVariable(interp
, argv
[0], listObj
);
6294 len
= Jim_ListLength(interp
, listObj
);
6296 Jim_SetResultString(interp
, "list must have an even number of elements", -1);
6299 for (i
= 0; i
< len
&& rc
== JIM_OK
; i
+= 2) {
6303 Jim_ListIndex(interp
, listObj
, i
, &nameObj
, JIM_NONE
);
6304 Jim_ListIndex(interp
, listObj
, i
+ 1, &valueObj
, JIM_NONE
);
6306 rc
= Jim_SetDictKeysVector(interp
, argv
[0], &nameObj
, 1, valueObj
);
6312 static const jim_subcmd_type array_command_table
[] = {
6314 .args
= "arrayName",
6315 .function
= array_cmd_exists
,
6318 .description
= "Does array exist?"
6321 .args
= "arrayName ?pattern?",
6322 .function
= array_cmd_get
,
6325 .description
= "Array contents as name value list"
6328 .args
= "arrayName ?pattern?",
6329 .function
= array_cmd_names
,
6332 .description
= "Array keys as a list"
6335 .args
= "arrayName list",
6336 .function
= array_cmd_set
,
6339 .description
= "Set array from list"
6342 .args
= "arrayName",
6343 .function
= array_cmd_size
,
6346 .description
= "Number of elements in array"
6349 .args
= "arrayName ?pattern?",
6350 .function
= array_cmd_unset
,
6353 .description
= "Unset elements of an array"
6359 int Jim_arrayInit(Jim_Interp
*interp
)
6361 if (Jim_PackageProvide(interp
, "array", "1.0", JIM_ERRMSG
))
6364 Jim_CreateCommand(interp
, "array", Jim_SubCmdProc
, (void *)array_command_table
, NULL
);
6367 int Jim_InitStaticExtensions(Jim_Interp
*interp
)
6369 extern int Jim_bootstrapInit(Jim_Interp
*);
6370 extern int Jim_aioInit(Jim_Interp
*);
6371 extern int Jim_readdirInit(Jim_Interp
*);
6372 extern int Jim_globInit(Jim_Interp
*);
6373 extern int Jim_regexpInit(Jim_Interp
*);
6374 extern int Jim_fileInit(Jim_Interp
*);
6375 extern int Jim_execInit(Jim_Interp
*);
6376 extern int Jim_clockInit(Jim_Interp
*);
6377 extern int Jim_arrayInit(Jim_Interp
*);
6378 extern int Jim_stdlibInit(Jim_Interp
*);
6379 extern int Jim_tclcompatInit(Jim_Interp
*);
6380 Jim_bootstrapInit(interp
);
6381 Jim_aioInit(interp
);
6382 Jim_readdirInit(interp
);
6383 Jim_globInit(interp
);
6384 Jim_regexpInit(interp
);
6385 Jim_fileInit(interp
);
6386 Jim_execInit(interp
);
6387 Jim_clockInit(interp
);
6388 Jim_arrayInit(interp
);
6389 Jim_stdlibInit(interp
);
6390 Jim_tclcompatInit(interp
);
6394 /* Jim - A small embeddable Tcl interpreter
6396 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
6397 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6398 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6399 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
6400 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
6401 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
6402 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
6403 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
6404 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
6405 * Copyright 2009 Zachary T Welch zw@superlucidity.net
6406 * Copyright 2009 David Brownell
6408 * Redistribution and use in source and binary forms, with or without
6409 * modification, are permitted provided that the following conditions
6412 * 1. Redistributions of source code must retain the above copyright
6413 * notice, this list of conditions and the following disclaimer.
6414 * 2. Redistributions in binary form must reproduce the above
6415 * copyright notice, this list of conditions and the following
6416 * disclaimer in the documentation and/or other materials
6417 * provided with the distribution.
6419 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
6420 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
6421 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
6422 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
6423 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
6424 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
6425 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
6426 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
6427 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
6428 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
6429 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
6430 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
6432 * The views and conclusions contained in the software and documentation
6433 * are those of the authors and should not be interpreted as representing
6434 * official policies, either expressed or implied, of the Jim Tcl Project.
6436 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
6451 #include <sys/time.h>
6454 #ifdef HAVE_BACKTRACE
6455 #include <execinfo.h>
6457 #ifdef HAVE_CRT_EXTERNS_H
6458 #include <crt_externs.h>
6461 /* For INFINITY, even if math functions are not enabled */
6464 /* We may decide to switch to using $[...] after all, so leave it as an option */
6465 /*#define EXPRSUGAR_BRACKET*/
6467 /* For the no-autoconf case */
6469 #define TCL_LIBRARY "."
6471 #ifndef TCL_PLATFORM_OS
6472 #define TCL_PLATFORM_OS "unknown"
6474 #ifndef TCL_PLATFORM_PLATFORM
6475 #define TCL_PLATFORM_PLATFORM "unknown"
6477 #ifndef TCL_PLATFORM_PATH_SEPARATOR
6478 #define TCL_PLATFORM_PATH_SEPARATOR ":"
6481 /*#define DEBUG_SHOW_SCRIPT*/
6482 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
6483 /*#define DEBUG_SHOW_SUBST*/
6484 /*#define DEBUG_SHOW_EXPR*/
6485 /*#define DEBUG_SHOW_EXPR_TOKENS*/
6486 /*#define JIM_DEBUG_GC*/
6487 #ifdef JIM_MAINTAINER
6488 #define JIM_DEBUG_COMMAND
6489 #define JIM_DEBUG_PANIC
6492 const char *jim_tt_name(int type
);
6494 #ifdef JIM_DEBUG_PANIC
6495 static void JimPanicDump(int panic_condition
, Jim_Interp
*interp
, const char *fmt
, ...);
6496 #define JimPanic(X) JimPanicDump X
6501 /* -----------------------------------------------------------------------------
6503 * ---------------------------------------------------------------------------*/
6505 /* A shared empty string for the objects string representation.
6506 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
6507 static char JimEmptyStringRep
[] = "";
6509 /* -----------------------------------------------------------------------------
6510 * Required prototypes of not exported functions
6511 * ---------------------------------------------------------------------------*/
6512 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
);
6513 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
);
6514 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
6516 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6517 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6518 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
6519 const char *prefix
, const char *const *tablePtr
, const char *name
);
6520 static void JimDeleteLocalProcs(Jim_Interp
*interp
);
6521 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
,
6522 int argc
, Jim_Obj
*const *argv
);
6523 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
6524 const char *filename
, int linenr
);
6525 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
6526 static int JimSign(jim_wide w
);
6527 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
6528 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
6529 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
6532 static const Jim_HashTableType JimVariablesHashTableType
;
6534 /* Fast access to the int (wide) value of an object which is known to be of int type */
6535 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
6537 #define JimObjTypeName(O) (objPtr->typePtr ? objPtr->typePtr->name : "none")
6539 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
6541 int l
= utf8_tounicode(s
, uc
);
6543 *uc
= utf8_upper(*uc
);
6548 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
6549 #define JIM_CHARSET_SCAN 2
6550 #define JIM_CHARSET_GLOB 0
6553 * pattern points to a string like "[^a-z\ub5]"
6555 * The pattern may contain trailing chars, which are ignored.
6557 * The pattern is matched against unicode char 'c'.
6559 * If (flags & JIM_NOCASE), case is ignored when matching.
6560 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
6561 * of the charset, per scan, rather than glob/string match.
6563 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
6564 * or the null character if the ']' is missing.
6566 * Returns NULL on no match.
6568 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
6575 if (flags
& JIM_NOCASE
) {
6580 if (flags
& JIM_CHARSET_SCAN
) {
6581 if (*pattern
== '^') {
6586 /* Special case. If the first char is ']', it is part of the set */
6587 if (*pattern
== ']') {
6592 while (*pattern
&& *pattern
!= ']') {
6594 if (pattern
[0] == '\\') {
6596 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
6599 /* Is this a range? a-z */
6603 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
6604 if (pattern
[0] == '-' && pattern
[1]) {
6606 pattern
+= utf8_tounicode(pattern
, &pchar
);
6607 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
6609 /* Handle reversed range too */
6610 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
6626 return match
? pattern
: NULL
;
6629 /* Glob-style pattern matching. */
6631 /* Note: string *must* be valid UTF-8 sequences
6632 * slen is a char length, not byte counts.
6634 static int GlobMatch(const char *pattern
, const char *string
, int nocase
)
6639 switch (pattern
[0]) {
6641 while (pattern
[1] == '*') {
6646 return 1; /* match */
6649 /* Recursive call - Does the remaining pattern match anywhere? */
6650 if (GlobMatch(pattern
, string
, nocase
))
6651 return 1; /* match */
6652 string
+= utf8_tounicode(string
, &c
);
6654 return 0; /* no match */
6657 string
+= utf8_tounicode(string
, &c
);
6661 string
+= utf8_tounicode(string
, &c
);
6662 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
6667 /* Ran out of pattern (no ']') */
6678 string
+= utf8_tounicode_case(string
, &c
, nocase
);
6679 utf8_tounicode_case(pattern
, &pchar
, nocase
);
6685 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
6687 while (*pattern
== '*') {
6693 if (!*pattern
&& !*string
) {
6699 static int JimStringMatch(Jim_Interp
*interp
, Jim_Obj
*patternObj
, const char *string
, int nocase
)
6701 return GlobMatch(Jim_String(patternObj
), string
, nocase
);
6705 * string comparison works on binary data.
6707 * Note that the lengths are byte lengths, not char lengths.
6709 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
)
6712 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
6715 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
6718 return JimSign(memcmp(s1
, s2
, l1
));
6725 * If maxchars is -1, compares to end of string.
6726 * Otherwise compares at most 'maxchars' characters.
6728 static int JimStringCompareNoCase(const char *s1
, const char *s2
, int maxchars
)
6730 while (*s1
&& *s2
&& maxchars
) {
6732 s1
+= utf8_tounicode_case(s1
, &c1
, 1);
6733 s2
+= utf8_tounicode_case(s2
, &c2
, 1);
6735 return JimSign(c1
- c2
);
6742 /* One string or both terminated */
6752 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
6753 * The index of the first occurrence of s1 in s2 is returned.
6754 * If s1 is not found inside s2, -1 is returned. */
6755 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
6760 if (!l1
|| !l2
|| l1
> l2
) {
6765 s2
+= utf8_index(s2
, idx
);
6767 l1bytelen
= utf8_index(s1
, l1
);
6769 for (i
= idx
; i
<= l2
- l1
; i
++) {
6771 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
6774 s2
+= utf8_tounicode(s2
, &c
);
6780 * Note: Lengths and return value are in bytes, not chars.
6782 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
6786 if (!l1
|| !l2
|| l1
> l2
)
6789 /* Now search for the needle */
6790 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
6791 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
6800 * Note: Lengths and return value are in chars.
6802 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
6804 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
6806 n
= utf8_strlen(s2
, n
);
6812 int Jim_WideToString(char *buf
, jim_wide wideValue
)
6814 const char *fmt
= "%" JIM_WIDE_MODIFIER
;
6816 return sprintf(buf
, fmt
, wideValue
);
6820 * After an strtol()/strtod()-like conversion,
6821 * check whether something was converted and that
6822 * the only thing left is white space.
6824 * Returns JIM_OK or JIM_ERR.
6826 static int JimCheckConversion(const char *str
, const char *endptr
)
6828 if (str
[0] == '\0' || str
== endptr
) {
6832 if (endptr
[0] != '\0') {
6834 if (!isspace(UCHAR(*endptr
))) {
6843 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
6847 *widePtr
= strtoull(str
, &endptr
, base
);
6849 return JimCheckConversion(str
, endptr
);
6852 int Jim_DoubleToString(char *buf
, double doubleValue
)
6857 len
= sprintf(buf
, "%.12g", doubleValue
);
6859 /* Add a final ".0" if it's a number. But not
6862 if (*buf
== '.' || isalpha(UCHAR(*buf
))) {
6863 /* inf -> Inf, nan -> Nan */
6864 if (*buf
== 'i' || *buf
== 'n') {
6865 *buf
= toupper(UCHAR(*buf
));
6868 /* Infinity -> Inf */
6870 len
= buf
- buf0
+ 3;
6884 int Jim_StringToDouble(const char *str
, double *doublePtr
)
6888 /* Callers can check for underflow via ERANGE */
6891 *doublePtr
= strtod(str
, &endptr
);
6893 return JimCheckConversion(str
, endptr
);
6896 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
6898 jim_wide i
, res
= 1;
6900 if ((b
== 0 && e
!= 0) || (e
< 0))
6902 for (i
= 0; i
< e
; i
++) {
6908 /* -----------------------------------------------------------------------------
6910 * ---------------------------------------------------------------------------*/
6911 #ifdef JIM_DEBUG_PANIC
6912 /* Note that 'interp' may be NULL if not available in the
6913 * context of the panic. It's only useful to get the error
6914 * file descriptor, it will default to stderr otherwise. */
6915 void JimPanicDump(int condition
, Jim_Interp
*interp
, const char *fmt
, ...)
6925 * Send it here first.. Assuming STDIO still works
6927 fprintf(stderr
, JIM_NL
"JIM INTERPRETER PANIC: ");
6928 vfprintf(stderr
, fmt
, ap
);
6929 fprintf(stderr
, JIM_NL JIM_NL
);
6932 #ifdef HAVE_BACKTRACE
6938 size
= backtrace(array
, 40);
6939 strings
= backtrace_symbols(array
, size
);
6940 for (i
= 0; i
< size
; i
++)
6941 fprintf(stderr
, "[backtrace] %s" JIM_NL
, strings
[i
]);
6942 fprintf(stderr
, "[backtrace] Include the above lines and the output" JIM_NL
);
6943 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL
);
6951 /* -----------------------------------------------------------------------------
6953 * ---------------------------------------------------------------------------*/
6955 void *Jim_Alloc(int size
)
6957 return malloc(size
);
6960 void Jim_Free(void *ptr
)
6965 void *Jim_Realloc(void *ptr
, int size
)
6967 return realloc(ptr
, size
);
6970 char *Jim_StrDup(const char *s
)
6975 char *Jim_StrDupLen(const char *s
, int l
)
6977 char *copy
= Jim_Alloc(l
+ 1);
6979 memcpy(copy
, s
, l
+ 1);
6980 copy
[l
] = 0; /* Just to be sure, original could be substring */
6984 /* -----------------------------------------------------------------------------
6985 * Time related functions
6986 * ---------------------------------------------------------------------------*/
6988 /* Returns microseconds of CPU used since start. */
6989 static jim_wide
JimClock(void)
6993 gettimeofday(&tv
, NULL
);
6994 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
6997 /* -----------------------------------------------------------------------------
6999 * ---------------------------------------------------------------------------*/
7001 /* -------------------------- private prototypes ---------------------------- */
7002 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
7003 static unsigned int JimHashTableNextPower(unsigned int size
);
7004 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
);
7006 /* -------------------------- hash functions -------------------------------- */
7008 /* Thomas Wang's 32 bit Mix Function */
7009 unsigned int Jim_IntHashFunction(unsigned int key
)
7011 key
+= ~(key
<< 15);
7015 key
+= ~(key
<< 11);
7020 /* Generic hash function (we are using to multiply by 9 and add the byte
7022 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
7027 h
+= (h
<< 3) + *buf
++;
7031 /* ----------------------------- API implementation ------------------------- */
7033 /* reset a hashtable already initialized with ht_init().
7034 * NOTE: This function should only called by ht_destroy(). */
7035 static void JimResetHashTable(Jim_HashTable
*ht
)
7044 /* Initialize the hash table */
7045 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
7047 JimResetHashTable(ht
);
7049 ht
->privdata
= privDataPtr
;
7053 /* Resize the table to the minimal size that contains all the elements,
7054 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
7055 int Jim_ResizeHashTable(Jim_HashTable
*ht
)
7057 int minimal
= ht
->used
;
7059 if (minimal
< JIM_HT_INITIAL_SIZE
)
7060 minimal
= JIM_HT_INITIAL_SIZE
;
7061 return Jim_ExpandHashTable(ht
, minimal
);
7064 /* Expand or create the hashtable */
7065 int Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
7067 Jim_HashTable n
; /* the new hashtable */
7068 unsigned int realsize
= JimHashTableNextPower(size
), i
;
7070 /* the size is invalid if it is smaller than the number of
7071 * elements already inside the hashtable */
7072 if (ht
->used
>= size
)
7075 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
7077 n
.sizemask
= realsize
- 1;
7078 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
7080 /* Initialize all the pointers to NULL */
7081 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
7083 /* Copy all the elements from the old to the new table:
7084 * note that if the old hash table is empty ht->size is zero,
7085 * so Jim_ExpandHashTable just creates an hash table. */
7087 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
7088 Jim_HashEntry
*he
, *nextHe
;
7090 if (ht
->table
[i
] == NULL
)
7093 /* For each hash entry on this slot... */
7099 /* Get the new element index */
7100 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
7101 he
->next
= n
.table
[h
];
7104 /* Pass to the next element */
7108 assert(ht
->used
== 0);
7109 Jim_Free(ht
->table
);
7111 /* Remap the new hashtable in the old */
7116 /* Add an element to the target hash table */
7117 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
7120 Jim_HashEntry
*entry
;
7122 /* Get the index of the new element, or -1 if
7123 * the element already exists. */
7124 if ((idx
= JimInsertHashEntry(ht
, key
)) == -1)
7127 /* Allocates the memory and stores key */
7128 entry
= Jim_Alloc(sizeof(*entry
));
7129 entry
->next
= ht
->table
[idx
];
7130 ht
->table
[idx
] = entry
;
7132 /* Set the hash entry fields. */
7133 Jim_SetHashKey(ht
, entry
, key
);
7134 Jim_SetHashVal(ht
, entry
, val
);
7139 /* Add an element, discarding the old if the key already exists */
7140 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
7142 Jim_HashEntry
*entry
;
7144 /* Try to add the element. If the key
7145 * does not exists Jim_AddHashEntry will suceed. */
7146 if (Jim_AddHashEntry(ht
, key
, val
) == JIM_OK
)
7148 /* It already exists, get the entry */
7149 entry
= Jim_FindHashEntry(ht
, key
);
7150 /* Free the old value and set the new one */
7151 Jim_FreeEntryVal(ht
, entry
);
7152 Jim_SetHashVal(ht
, entry
, val
);
7156 /* Search and remove an element */
7157 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
7160 Jim_HashEntry
*he
, *prevHe
;
7164 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7169 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
7170 /* Unlink the element from the list */
7172 prevHe
->next
= he
->next
;
7174 ht
->table
[h
] = he
->next
;
7175 Jim_FreeEntryKey(ht
, he
);
7176 Jim_FreeEntryVal(ht
, he
);
7184 return JIM_ERR
; /* not found */
7187 /* Destroy an entire hash table */
7188 int Jim_FreeHashTable(Jim_HashTable
*ht
)
7192 /* Free all the elements */
7193 for (i
= 0; i
< ht
->size
&& ht
->used
> 0; i
++) {
7194 Jim_HashEntry
*he
, *nextHe
;
7196 if ((he
= ht
->table
[i
]) == NULL
)
7200 Jim_FreeEntryKey(ht
, he
);
7201 Jim_FreeEntryVal(ht
, he
);
7207 /* Free the table and the allocated cache structure */
7208 Jim_Free(ht
->table
);
7209 /* Re-initialize the table */
7210 JimResetHashTable(ht
);
7211 return JIM_OK
; /* never fails */
7214 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
7221 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7224 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
7231 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
7233 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
7238 iter
->nextEntry
= NULL
;
7242 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
7245 if (iter
->entry
== NULL
) {
7247 if (iter
->index
>= (signed)iter
->ht
->size
)
7249 iter
->entry
= iter
->ht
->table
[iter
->index
];
7252 iter
->entry
= iter
->nextEntry
;
7255 /* We need to save the 'next' here, the iterator user
7256 * may delete the entry we are returning. */
7257 iter
->nextEntry
= iter
->entry
->next
;
7264 /* ------------------------- private functions ------------------------------ */
7266 /* Expand the hash table if needed */
7267 static int JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
7269 /* If the hash table is empty expand it to the intial size,
7270 * if the table is "full" dobule its size. */
7272 return Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
7273 if (ht
->size
== ht
->used
)
7274 return Jim_ExpandHashTable(ht
, ht
->size
* 2);
7278 /* Our hash table capability is a power of two */
7279 static unsigned int JimHashTableNextPower(unsigned int size
)
7281 unsigned int i
= JIM_HT_INITIAL_SIZE
;
7283 if (size
>= 2147483648U)
7292 /* Returns the index of a free slot that can be populated with
7293 * an hash entry for the given 'key'.
7294 * If the key already exists, -1 is returned. */
7295 static int JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
)
7300 /* Expand the hashtable if needed */
7301 if (JimExpandHashTableIfNeeded(ht
) == JIM_ERR
)
7303 /* Compute the key hash value */
7304 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
7305 /* Search if this slot does not already contain the given key */
7308 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
7315 /* ----------------------- StringCopy Hash Table Type ------------------------*/
7317 static unsigned int JimStringCopyHTHashFunction(const void *key
)
7319 return Jim_GenHashFunction(key
, strlen(key
));
7322 static const void *JimStringCopyHTKeyDup(void *privdata
, const void *key
)
7324 int len
= strlen(key
);
7325 char *copy
= Jim_Alloc(len
+ 1);
7327 JIM_NOTUSED(privdata
);
7329 memcpy(copy
, key
, len
);
7334 static void *JimStringKeyValCopyHTValDup(void *privdata
, const void *val
)
7336 int len
= strlen(val
);
7337 char *copy
= Jim_Alloc(len
+ 1);
7339 JIM_NOTUSED(privdata
);
7341 memcpy(copy
, val
, len
);
7346 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7348 JIM_NOTUSED(privdata
);
7350 return strcmp(key1
, key2
) == 0;
7353 static void JimStringCopyHTKeyDestructor(void *privdata
, const void *key
)
7355 JIM_NOTUSED(privdata
);
7357 Jim_Free((void *)key
); /* ATTENTION: const cast */
7360 static void JimStringKeyValCopyHTValDestructor(void *privdata
, void *val
)
7362 JIM_NOTUSED(privdata
);
7364 Jim_Free((void *)val
); /* ATTENTION: const cast */
7368 static Jim_HashTableType JimStringCopyHashTableType
= {
7369 JimStringCopyHTHashFunction
, /* hash function */
7370 JimStringCopyHTKeyDup
, /* key dup */
7372 JimStringCopyHTKeyCompare
, /* key compare */
7373 JimStringCopyHTKeyDestructor
, /* key destructor */
7374 NULL
/* val destructor */
7378 /* This is like StringCopy but does not auto-duplicate the key.
7379 * It's used for intepreter's shared strings. */
7380 static const Jim_HashTableType JimSharedStringsHashTableType
= {
7381 JimStringCopyHTHashFunction
, /* hash function */
7384 JimStringCopyHTKeyCompare
, /* key compare */
7385 JimStringCopyHTKeyDestructor
, /* key destructor */
7386 NULL
/* val destructor */
7389 /* This is like StringCopy but also automatically handle dynamic
7390 * allocated C strings as values. */
7391 static const Jim_HashTableType JimStringKeyValCopyHashTableType
= {
7392 JimStringCopyHTHashFunction
, /* hash function */
7393 JimStringCopyHTKeyDup
, /* key dup */
7394 JimStringKeyValCopyHTValDup
, /* val dup */
7395 JimStringCopyHTKeyCompare
, /* key compare */
7396 JimStringCopyHTKeyDestructor
, /* key destructor */
7397 JimStringKeyValCopyHTValDestructor
, /* val destructor */
7400 typedef struct AssocDataValue
7402 Jim_InterpDeleteProc
*delProc
;
7406 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
7408 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
7410 if (assocPtr
->delProc
!= NULL
)
7411 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
7415 static const Jim_HashTableType JimAssocDataHashTableType
= {
7416 JimStringCopyHTHashFunction
, /* hash function */
7417 JimStringCopyHTKeyDup
, /* key dup */
7419 JimStringCopyHTKeyCompare
, /* key compare */
7420 JimStringCopyHTKeyDestructor
, /* key destructor */
7421 JimAssocDataHashTableValueDestructor
/* val destructor */
7424 /* -----------------------------------------------------------------------------
7425 * Stack - This is a simple generic stack implementation. It is used for
7426 * example in the 'expr' expression compiler.
7427 * ---------------------------------------------------------------------------*/
7428 void Jim_InitStack(Jim_Stack
*stack
)
7432 stack
->vector
= NULL
;
7435 void Jim_FreeStack(Jim_Stack
*stack
)
7437 Jim_Free(stack
->vector
);
7440 int Jim_StackLen(Jim_Stack
*stack
)
7445 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
7447 int neededLen
= stack
->len
+ 1;
7449 if (neededLen
> stack
->maxlen
) {
7450 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
7451 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
7453 stack
->vector
[stack
->len
] = element
;
7457 void *Jim_StackPop(Jim_Stack
*stack
)
7459 if (stack
->len
== 0)
7462 return stack
->vector
[stack
->len
];
7465 void *Jim_StackPeek(Jim_Stack
*stack
)
7467 if (stack
->len
== 0)
7469 return stack
->vector
[stack
->len
- 1];
7472 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
7476 for (i
= 0; i
< stack
->len
; i
++)
7477 freeFunc(stack
->vector
[i
]);
7480 /* -----------------------------------------------------------------------------
7482 * ---------------------------------------------------------------------------*/
7485 #define JIM_TT_NONE 0 /* No token returned */
7486 #define JIM_TT_STR 1 /* simple string */
7487 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
7488 #define JIM_TT_VAR 3 /* var substitution */
7489 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
7490 #define JIM_TT_CMD 5 /* command substitution */
7491 /* Note: Keep these three together for TOKEN_IS_SEP() */
7492 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
7493 #define JIM_TT_EOL 7 /* line separator */
7494 #define JIM_TT_EOF 8 /* end of script */
7496 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
7497 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
7499 /* Additional token types needed for expressions */
7500 #define JIM_TT_SUBEXPR_START 11
7501 #define JIM_TT_SUBEXPR_END 12
7502 #define JIM_TT_EXPR_INT 13
7503 #define JIM_TT_EXPR_DOUBLE 14
7505 #define JIM_TT_EXPRSUGAR 15 /* $(expression) */
7507 /* Operator token types start here */
7508 #define JIM_TT_EXPR_OP 20
7510 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
7513 #define JIM_PS_DEF 0 /* Default state */
7514 #define JIM_PS_QUOTE 1 /* Inside "" */
7515 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
7517 /* Parser context structure. The same context is used both to parse
7518 * Tcl scripts and lists. */
7521 const char *p
; /* Pointer to the point of the program we are parsing */
7522 int len
; /* Remaining length */
7523 int linenr
; /* Current line number */
7525 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
7526 int tline
; /* Line number of the returned token */
7527 int tt
; /* Token type */
7528 int eof
; /* Non zero if EOF condition is true. */
7529 int state
; /* Parser state */
7530 int comment
; /* Non zero if the next chars may be a comment. */
7531 char missing
; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
7532 int missingline
; /* Line number starting the missing token */
7536 * Results of missing quotes, braces, etc. from parsing.
7538 struct JimParseResult
{
7539 char missing
; /* From JimParserCtx.missing */
7540 int line
; /* From JimParserCtx.missingline */
7543 static int JimParseScript(struct JimParserCtx
*pc
);
7544 static int JimParseSep(struct JimParserCtx
*pc
);
7545 static int JimParseEol(struct JimParserCtx
*pc
);
7546 static int JimParseCmd(struct JimParserCtx
*pc
);
7547 static int JimParseQuote(struct JimParserCtx
*pc
);
7548 static int JimParseVar(struct JimParserCtx
*pc
);
7549 static int JimParseBrace(struct JimParserCtx
*pc
);
7550 static int JimParseStr(struct JimParserCtx
*pc
);
7551 static int JimParseComment(struct JimParserCtx
*pc
);
7552 static void JimParseSubCmd(struct JimParserCtx
*pc
);
7553 static int JimParseSubQuote(struct JimParserCtx
*pc
);
7554 static void JimParseSubCmd(struct JimParserCtx
*pc
);
7555 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
7557 /* Initialize a parser context.
7558 * 'prg' is a pointer to the program text, linenr is the line
7559 * number of the first line contained in the program. */
7560 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
7567 pc
->tt
= JIM_TT_NONE
;
7569 pc
->state
= JIM_PS_DEF
;
7570 pc
->linenr
= linenr
;
7573 pc
->missingline
= linenr
;
7576 static int JimParseScript(struct JimParserCtx
*pc
)
7578 while (1) { /* the while is used to reiterate with continue if needed */
7581 pc
->tend
= pc
->p
- 1;
7582 pc
->tline
= pc
->linenr
;
7583 pc
->tt
= JIM_TT_EOL
;
7589 if (*(pc
->p
+ 1) == '\n' && pc
->state
== JIM_PS_DEF
) {
7590 return JimParseSep(pc
);
7594 return JimParseStr(pc
);
7600 if (pc
->state
== JIM_PS_DEF
)
7601 return JimParseSep(pc
);
7604 return JimParseStr(pc
);
7610 if (pc
->state
== JIM_PS_DEF
)
7611 return JimParseEol(pc
);
7613 return JimParseStr(pc
);
7617 return JimParseCmd(pc
);
7621 if (JimParseVar(pc
) == JIM_ERR
) {
7622 pc
->tstart
= pc
->tend
= pc
->p
++;
7624 pc
->tline
= pc
->linenr
;
7625 pc
->tt
= JIM_TT_STR
;
7633 JimParseComment(pc
);
7637 return JimParseStr(pc
);
7641 return JimParseStr(pc
);
7648 static int JimParseSep(struct JimParserCtx
*pc
)
7651 pc
->tline
= pc
->linenr
;
7652 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' ||
7653 (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
7654 if (*pc
->p
== '\\') {
7662 pc
->tend
= pc
->p
- 1;
7663 pc
->tt
= JIM_TT_SEP
;
7667 static int JimParseEol(struct JimParserCtx
*pc
)
7670 pc
->tline
= pc
->linenr
;
7671 while (*pc
->p
== ' ' || *pc
->p
== '\n' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== ';') {
7677 pc
->tend
= pc
->p
- 1;
7678 pc
->tt
= JIM_TT_EOL
;
7683 ** Here are the rules for parsing:
7684 ** {braced expression}
7685 ** - Count open and closing braces
7686 ** - Backslash escapes meaning of braces
7688 ** "quoted expression"
7689 ** - First double quote at start of word terminates the expression
7690 ** - Backslash escapes quote and bracket
7691 ** - [commands brackets] are counted/nested
7692 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
7694 ** [command expression]
7695 ** - Count open and closing brackets
7696 ** - Backslash escapes quote, bracket and brace
7697 ** - [commands brackets] are counted/nested
7698 ** - "quoted expressions" are parsed according to quoting rules
7699 ** - {braced expressions} are parsed according to brace rules
7701 ** For everything, backslash escapes the next char, newline increments current line
7705 * Parses a braced expression starting at pc->p.
7707 * Positions the parser at the end of the braced expression,
7708 * sets pc->tend and possibly pc->missing.
7710 static void JimParseSubBrace(struct JimParserCtx
*pc
)
7714 /* Skip the brace */
7721 if (*++pc
->p
== '\n') {
7734 pc
->tend
= pc
->p
- 1;
7749 pc
->missingline
= pc
->tline
;
7750 pc
->tend
= pc
->p
- 1;
7754 * Parses a quoted expression starting at pc->p.
7756 * Positions the parser at the end of the quoted expression,
7757 * sets pc->tend and possibly pc->missing.
7759 * Returns the type of the token of the string,
7760 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
7763 static int JimParseSubQuote(struct JimParserCtx
*pc
)
7765 int tt
= JIM_TT_STR
;
7766 int line
= pc
->tline
;
7768 /* Skip the quote */
7775 if (*++pc
->p
== '\n') {
7784 pc
->tend
= pc
->p
- 1;
7806 pc
->missingline
= line
;
7807 pc
->tend
= pc
->p
- 1;
7812 * Parses a [command] expression starting at pc->p.
7814 * Positions the parser at the end of the command expression,
7815 * sets pc->tend and possibly pc->missing.
7817 static void JimParseSubCmd(struct JimParserCtx
*pc
)
7820 int startofword
= 1;
7821 int line
= pc
->tline
;
7823 /* Skip the bracket */
7830 if (*++pc
->p
== '\n') {
7843 pc
->tend
= pc
->p
- 1;
7852 JimParseSubQuote(pc
);
7858 JimParseSubBrace(pc
);
7866 startofword
= isspace(UCHAR(*pc
->p
));
7871 pc
->missingline
= line
;
7872 pc
->tend
= pc
->p
- 1;
7875 static int JimParseBrace(struct JimParserCtx
*pc
)
7877 pc
->tstart
= pc
->p
+ 1;
7878 pc
->tline
= pc
->linenr
;
7879 pc
->tt
= JIM_TT_STR
;
7880 JimParseSubBrace(pc
);
7884 static int JimParseCmd(struct JimParserCtx
*pc
)
7886 pc
->tstart
= pc
->p
+ 1;
7887 pc
->tline
= pc
->linenr
;
7888 pc
->tt
= JIM_TT_CMD
;
7893 static int JimParseQuote(struct JimParserCtx
*pc
)
7895 pc
->tstart
= pc
->p
+ 1;
7896 pc
->tline
= pc
->linenr
;
7897 pc
->tt
= JimParseSubQuote(pc
);
7901 static int JimParseVar(struct JimParserCtx
*pc
)
7907 #ifdef EXPRSUGAR_BRACKET
7908 if (*pc
->p
== '[') {
7909 /* Parse $[...] expr shorthand syntax */
7911 pc
->tt
= JIM_TT_EXPRSUGAR
;
7917 pc
->tt
= JIM_TT_VAR
;
7918 pc
->tline
= pc
->linenr
;
7920 if (*pc
->p
== '{') {
7921 pc
->tstart
= ++pc
->p
;
7924 while (pc
->len
&& *pc
->p
!= '}') {
7925 if (*pc
->p
== '\n') {
7931 pc
->tend
= pc
->p
- 1;
7939 /* Skip double colon, but not single colon! */
7940 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
7945 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_') {
7952 /* Parse [dict get] syntax sugar. */
7953 if (*pc
->p
== '(') {
7955 const char *paren
= NULL
;
7957 pc
->tt
= JIM_TT_DICTSUGAR
;
7959 while (count
&& pc
->len
) {
7962 if (*pc
->p
== '\\' && pc
->len
>= 1) {
7966 else if (*pc
->p
== '(') {
7969 else if (*pc
->p
== ')') {
7979 /* Did not find a matching paren. Back up */
7981 pc
->len
+= (pc
->p
- paren
);
7984 #ifndef EXPRSUGAR_BRACKET
7985 if (*pc
->tstart
== '(') {
7986 pc
->tt
= JIM_TT_EXPRSUGAR
;
7990 pc
->tend
= pc
->p
- 1;
7992 /* Check if we parsed just the '$' character.
7993 * That's not a variable so an error is returned
7994 * to tell the state machine to consider this '$' just
7996 if (pc
->tstart
== pc
->p
) {
8004 static int JimParseStr(struct JimParserCtx
*pc
)
8006 int newword
= (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
8007 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
);
8008 if (newword
&& *pc
->p
== '{') {
8009 return JimParseBrace(pc
);
8011 else if (newword
&& *pc
->p
== '"') {
8012 pc
->state
= JIM_PS_QUOTE
;
8015 /* In case the end quote is missing */
8016 pc
->missingline
= pc
->tline
;
8019 pc
->tline
= pc
->linenr
;
8022 if (pc
->state
== JIM_PS_QUOTE
) {
8025 pc
->tend
= pc
->p
- 1;
8026 pc
->tt
= JIM_TT_ESC
;
8031 if (pc
->state
== JIM_PS_DEF
&& *(pc
->p
+ 1) == '\n') {
8032 pc
->tend
= pc
->p
- 1;
8033 pc
->tt
= JIM_TT_ESC
;
8037 if (*(pc
->p
+ 1) == '\n') {
8045 /* If the following token is not '$' just keep going */
8046 if (pc
->len
> 1 && pc
->p
[1] != '$') {
8050 /* Only need a separate ')' token if the previous was a var */
8051 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
8052 if (pc
->p
== pc
->tstart
) {
8053 /* At the start of the token, so just return this char */
8057 pc
->tend
= pc
->p
- 1;
8058 pc
->tt
= JIM_TT_ESC
;
8065 pc
->tend
= pc
->p
- 1;
8066 pc
->tt
= JIM_TT_ESC
;
8073 if (pc
->state
== JIM_PS_DEF
) {
8074 pc
->tend
= pc
->p
- 1;
8075 pc
->tt
= JIM_TT_ESC
;
8078 else if (*pc
->p
== '\n') {
8083 if (pc
->state
== JIM_PS_QUOTE
) {
8084 pc
->tend
= pc
->p
- 1;
8085 pc
->tt
= JIM_TT_ESC
;
8088 pc
->state
= JIM_PS_DEF
;
8096 return JIM_OK
; /* unreached */
8099 static int JimParseComment(struct JimParserCtx
*pc
)
8102 if (*pc
->p
== '\n') {
8104 if (*(pc
->p
- 1) != '\\') {
8116 /* xdigitval and odigitval are helper functions for JimEscape() */
8117 static int xdigitval(int c
)
8119 if (c
>= '0' && c
<= '9')
8121 if (c
>= 'a' && c
<= 'f')
8122 return c
- 'a' + 10;
8123 if (c
>= 'A' && c
<= 'F')
8124 return c
- 'A' + 10;
8128 static int odigitval(int c
)
8130 if (c
>= '0' && c
<= '7')
8135 /* Perform Tcl escape substitution of 's', storing the result
8136 * string into 'dest'. The escaped string is guaranteed to
8137 * be the same length or shorted than the source string.
8138 * Slen is the length of the string at 's', if it's -1 the string
8139 * length will be calculated by the function.
8141 * The function returns the length of the resulting string. */
8142 static int JimEscape(char *dest
, const char *s
, int slen
)
8150 for (i
= 0; i
< slen
; i
++) {
8180 /* A unicode or hex sequence.
8181 * \u Expect 1-4 hex chars and convert to utf-8.
8182 * \x Expect 1-2 hex chars and convert to hex.
8183 * An invalid sequence means simply the escaped char.
8191 for (k
= 0; k
< (s
[i
] == 'u' ? 4 : 2); k
++) {
8192 int c
= xdigitval(s
[i
+ k
+ 1]);
8196 val
= (val
<< 4) | c
;
8199 /* Got a valid sequence, so convert */
8201 p
+= utf8_fromunicode(p
, val
);
8209 /* Not a valid codepoint, just an escaped char */
8222 /* Replace all spaces and tabs after backslash newline with a single space*/
8226 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
8239 int c
= odigitval(s
[i
+ 1]);
8242 c
= odigitval(s
[i
+ 2]);
8248 val
= (val
* 8) + c
;
8249 c
= odigitval(s
[i
+ 3]);
8255 val
= (val
* 8) + c
;
8276 /* Returns a dynamically allocated copy of the current token in the
8277 * parser context. The function performs conversion of escapes if
8278 * the token is of type JIM_TT_ESC.
8280 * Note that after the conversion, tokens that are grouped with
8281 * braces in the source code, are always recognizable from the
8282 * identical string obtained in a different way from the type.
8284 * For example the string:
8288 * will return as first token "*", of type JIM_TT_STR
8294 * will return as first token "*", of type JIM_TT_ESC
8296 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
8298 const char *start
, *end
;
8306 token
= Jim_Alloc(1);
8310 len
= (end
- start
) + 1;
8311 token
= Jim_Alloc(len
+ 1);
8312 if (pc
->tt
!= JIM_TT_ESC
) {
8313 /* No escape conversion needed? Just copy it. */
8314 memcpy(token
, start
, len
);
8318 /* Else convert the escape chars. */
8319 len
= JimEscape(token
, start
, len
);
8323 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
8326 /* Parses the given string to determine if it represents a complete script.
8328 * This is useful for interactive shells implementation, for [info complete].
8330 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
8331 * '{' on scripts incomplete missing one or more '}' to be balanced.
8332 * '[' on scripts incomplete missing one or more ']' to be balanced.
8333 * '"' on scripts incomplete missing a '"' char.
8335 * If the script is complete, 1 is returned, otherwise 0.
8337 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
8339 struct JimParserCtx parser
;
8341 JimParserInit(&parser
, s
, len
, 1);
8342 while (!parser
.eof
) {
8343 JimParseScript(&parser
);
8346 *stateCharPtr
= parser
.missing
;
8348 return parser
.missing
== ' ';
8351 /* -----------------------------------------------------------------------------
8353 * ---------------------------------------------------------------------------*/
8354 static int JimParseListSep(struct JimParserCtx
*pc
);
8355 static int JimParseListStr(struct JimParserCtx
*pc
);
8356 static int JimParseListQuote(struct JimParserCtx
*pc
);
8358 static int JimParseList(struct JimParserCtx
*pc
)
8365 return JimParseListSep(pc
);
8368 return JimParseListQuote(pc
);
8371 return JimParseBrace(pc
);
8375 return JimParseListStr(pc
);
8380 pc
->tstart
= pc
->tend
= pc
->p
;
8381 pc
->tline
= pc
->linenr
;
8382 pc
->tt
= JIM_TT_EOL
;
8387 static int JimParseListSep(struct JimParserCtx
*pc
)
8390 pc
->tline
= pc
->linenr
;
8391 while (*pc
->p
== ' ' || *pc
->p
== '\t' || *pc
->p
== '\r' || *pc
->p
== '\n') {
8392 if (*pc
->p
== '\n') {
8398 pc
->tend
= pc
->p
- 1;
8399 pc
->tt
= JIM_TT_SEP
;
8403 static int JimParseListQuote(struct JimParserCtx
*pc
)
8409 pc
->tline
= pc
->linenr
;
8410 pc
->tt
= JIM_TT_STR
;
8415 pc
->tt
= JIM_TT_ESC
;
8416 if (--pc
->len
== 0) {
8417 /* Trailing backslash */
8427 pc
->tend
= pc
->p
- 1;
8436 pc
->tend
= pc
->p
- 1;
8440 static int JimParseListStr(struct JimParserCtx
*pc
)
8443 pc
->tline
= pc
->linenr
;
8444 pc
->tt
= JIM_TT_STR
;
8449 if (--pc
->len
== 0) {
8450 /* Trailing backslash */
8454 pc
->tt
= JIM_TT_ESC
;
8461 pc
->tend
= pc
->p
- 1;
8467 pc
->tend
= pc
->p
- 1;
8471 /* -----------------------------------------------------------------------------
8472 * Jim_Obj related functions
8473 * ---------------------------------------------------------------------------*/
8475 /* Return a new initialized object. */
8476 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
8480 /* -- Check if there are objects in the free list -- */
8481 if (interp
->freeList
!= NULL
) {
8482 /* -- Unlink the object from the free list -- */
8483 objPtr
= interp
->freeList
;
8484 interp
->freeList
= objPtr
->nextObjPtr
;
8487 /* -- No ready to use objects: allocate a new one -- */
8488 objPtr
= Jim_Alloc(sizeof(*objPtr
));
8491 /* Object is returned with refCount of 0. Every
8492 * kind of GC implemented should take care to don't try
8493 * to scan objects with refCount == 0. */
8494 objPtr
->refCount
= 0;
8495 /* All the other fields are left not initialized to save time.
8496 * The caller will probably want to set them to the right
8499 /* -- Put the object into the live list -- */
8500 objPtr
->prevObjPtr
= NULL
;
8501 objPtr
->nextObjPtr
= interp
->liveList
;
8502 if (interp
->liveList
)
8503 interp
->liveList
->prevObjPtr
= objPtr
;
8504 interp
->liveList
= objPtr
;
8509 /* Free an object. Actually objects are never freed, but
8510 * just moved to the free objects list, where they will be
8511 * reused by Jim_NewObj(). */
8512 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8514 /* Check if the object was already freed, panic. */
8515 JimPanic((objPtr
->refCount
!= 0, interp
, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
8516 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
8518 /* Free the internal representation */
8519 Jim_FreeIntRep(interp
, objPtr
);
8520 /* Free the string representation */
8521 if (objPtr
->bytes
!= NULL
) {
8522 if (objPtr
->bytes
!= JimEmptyStringRep
)
8523 Jim_Free(objPtr
->bytes
);
8525 /* Unlink the object from the live objects list */
8526 if (objPtr
->prevObjPtr
)
8527 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
8528 if (objPtr
->nextObjPtr
)
8529 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
8530 if (interp
->liveList
== objPtr
)
8531 interp
->liveList
= objPtr
->nextObjPtr
;
8532 /* Link the object into the free objects list */
8533 objPtr
->prevObjPtr
= NULL
;
8534 objPtr
->nextObjPtr
= interp
->freeList
;
8535 if (interp
->freeList
)
8536 interp
->freeList
->prevObjPtr
= objPtr
;
8537 interp
->freeList
= objPtr
;
8538 objPtr
->refCount
= -1;
8541 /* Invalidate the string representation of an object. */
8542 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
8544 if (objPtr
->bytes
!= NULL
) {
8545 if (objPtr
->bytes
!= JimEmptyStringRep
)
8546 Jim_Free(objPtr
->bytes
);
8548 objPtr
->bytes
= NULL
;
8551 #define Jim_SetStringRep(o, b, l) \
8552 do { (o)->bytes = b; (o)->length = l; } while (0)
8554 /* Set the initial string representation for an object.
8555 * Does not try to free an old one. */
8556 void Jim_InitStringRep(Jim_Obj
*objPtr
, const char *bytes
, int length
)
8559 objPtr
->bytes
= JimEmptyStringRep
;
8563 objPtr
->bytes
= Jim_Alloc(length
+ 1);
8564 objPtr
->length
= length
;
8565 memcpy(objPtr
->bytes
, bytes
, length
);
8566 objPtr
->bytes
[length
] = '\0';
8570 /* Duplicate an object. The returned object has refcount = 0. */
8571 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8575 dupPtr
= Jim_NewObj(interp
);
8576 if (objPtr
->bytes
== NULL
) {
8577 /* Object does not have a valid string representation. */
8578 dupPtr
->bytes
= NULL
;
8581 Jim_InitStringRep(dupPtr
, objPtr
->bytes
, objPtr
->length
);
8584 /* By default, the new object has the same type as the old object */
8585 dupPtr
->typePtr
= objPtr
->typePtr
;
8586 if (objPtr
->typePtr
!= NULL
) {
8587 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
8588 dupPtr
->internalRep
= objPtr
->internalRep
;
8591 /* The dup proc may set a different type, e.g. NULL */
8592 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
8598 /* Return the string representation for objPtr. If the object
8599 * string representation is invalid, calls the method to create
8600 * a new one starting from the internal representation of the object. */
8601 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
8603 if (objPtr
->bytes
== NULL
) {
8604 /* Invalid string repr. Generate it. */
8605 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
8606 objPtr
->typePtr
->updateStringProc(objPtr
);
8609 *lenPtr
= objPtr
->length
;
8610 return objPtr
->bytes
;
8613 /* Just returns the length of the object's string rep */
8614 int Jim_Length(Jim_Obj
*objPtr
)
8618 Jim_GetString(objPtr
, &len
);
8622 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8623 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8625 static const Jim_ObjType dictSubstObjType
= {
8626 "dict-substitution",
8627 FreeDictSubstInternalRep
,
8628 DupDictSubstInternalRep
,
8633 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8635 Jim_DecrRefCount(interp
, (Jim_Obj
*)objPtr
->internalRep
.twoPtrValue
.ptr2
);
8638 static const Jim_ObjType interpolatedObjType
= {
8640 FreeInterpolatedInternalRep
,
8646 /* -----------------------------------------------------------------------------
8648 * ---------------------------------------------------------------------------*/
8649 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8650 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8652 static const Jim_ObjType stringObjType
= {
8655 DupStringInternalRep
,
8657 JIM_TYPE_REFERENCES
,
8660 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8662 JIM_NOTUSED(interp
);
8664 /* This is a bit subtle: the only caller of this function
8665 * should be Jim_DuplicateObj(), that will copy the
8666 * string representaion. After the copy, the duplicated
8667 * object will not have more room in teh buffer than
8668 * srcPtr->length bytes. So we just set it to length. */
8669 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
8671 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
8674 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8676 /* Get a fresh string representation. */
8677 (void)Jim_String(objPtr
);
8678 /* Free any other internal representation. */
8679 Jim_FreeIntRep(interp
, objPtr
);
8680 /* Set it as string, i.e. just set the maxLength field. */
8681 objPtr
->typePtr
= &stringObjType
;
8682 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
8683 /* Don't know the utf-8 length yet */
8684 objPtr
->internalRep
.strValue
.charLength
= -1;
8689 * Returns the length of the object string in chars, not bytes.
8691 * These may be different for a utf-8 string.
8693 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8696 if (objPtr
->typePtr
!= &stringObjType
)
8697 SetStringFromAny(interp
, objPtr
);
8699 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
8700 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
8702 return objPtr
->internalRep
.strValue
.charLength
;
8704 return Jim_Length(objPtr
);
8708 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
8709 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
8711 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
8713 /* Need to find out how many bytes the string requires */
8716 /* Alloc/Set the string rep. */
8718 objPtr
->bytes
= JimEmptyStringRep
;
8722 objPtr
->bytes
= Jim_Alloc(len
+ 1);
8723 objPtr
->length
= len
;
8724 memcpy(objPtr
->bytes
, s
, len
);
8725 objPtr
->bytes
[len
] = '\0';
8728 /* No typePtr field for the vanilla string object. */
8729 objPtr
->typePtr
= NULL
;
8733 /* charlen is in characters -- see also Jim_NewStringObj() */
8734 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
8737 /* Need to find out how many bytes the string requires */
8738 int bytelen
= utf8_index(s
, charlen
);
8740 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
8742 /* Remember the utf8 length, so set the type */
8743 objPtr
->typePtr
= &stringObjType
;
8744 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
8745 objPtr
->internalRep
.strValue
.charLength
= charlen
;
8749 return Jim_NewStringObj(interp
, s
, charlen
);
8753 /* This version does not try to duplicate the 's' pointer, but
8754 * use it directly. */
8755 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
8757 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
8761 Jim_SetStringRep(objPtr
, s
, len
);
8762 objPtr
->typePtr
= NULL
;
8766 /* Low-level string append. Use it only against objects
8767 * of type "string". */
8768 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
8774 needlen
= objPtr
->length
+ len
;
8775 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
8776 objPtr
->internalRep
.strValue
.maxLength
== 0) {
8778 /* Inefficient to malloc() for less than 8 bytes */
8782 if (objPtr
->bytes
== JimEmptyStringRep
) {
8783 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
8786 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
8788 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
8790 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
8791 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
8792 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
8793 /* Update the utf-8 char length */
8794 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
8796 objPtr
->length
+= len
;
8799 /* Higher level API to append strings to objects. */
8800 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
8802 JimPanic((Jim_IsShared(objPtr
), interp
, "Jim_AppendString called with shared object"));
8803 if (objPtr
->typePtr
!= &stringObjType
)
8804 SetStringFromAny(interp
, objPtr
);
8805 StringAppendString(objPtr
, str
, len
);
8808 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
8813 str
= Jim_GetString(appendObjPtr
, &len
);
8814 Jim_AppendString(interp
, objPtr
, str
, len
);
8817 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
8821 if (objPtr
->typePtr
!= &stringObjType
)
8822 SetStringFromAny(interp
, objPtr
);
8823 va_start(ap
, objPtr
);
8825 char *s
= va_arg(ap
, char *);
8829 Jim_AppendString(interp
, objPtr
, s
, -1);
8834 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
8836 const char *aStr
, *bStr
;
8839 if (aObjPtr
== bObjPtr
)
8841 aStr
= Jim_GetString(aObjPtr
, &aLen
);
8842 bStr
= Jim_GetString(bObjPtr
, &bLen
);
8845 return JimStringCompare(aStr
, aLen
, bStr
, bLen
) == 0;
8848 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
8850 return JimStringMatch(interp
, patternObjPtr
, Jim_String(objPtr
), nocase
);
8853 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
8855 const char *s1
, *s2
;
8858 s1
= Jim_GetString(firstObjPtr
, &l1
);
8859 s2
= Jim_GetString(secondObjPtr
, &l2
);
8862 return JimStringCompareNoCase(s1
, s2
, -1);
8864 return JimStringCompare(s1
, l1
, s2
, l2
);
8867 /* Convert a range, as returned by Jim_GetRange(), into
8868 * an absolute index into an object of the specified length.
8869 * This function may return negative values, or values
8870 * bigger or equal to the length of the list if the index
8871 * is out of range. */
8872 static int JimRelToAbsIndex(int len
, int idx
)
8879 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
8880 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
8881 * for implementation of commands like [string range] and [lrange].
8883 * The resulting range is guaranteed to address valid elements of
8885 static void JimRelToAbsRange(int len
, int first
, int last
,
8886 int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
8894 rangeLen
= last
- first
+ 1;
8901 rangeLen
-= (last
- (len
- 1));
8911 *rangeLenPtr
= rangeLen
;
8914 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
8915 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
8922 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
8923 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
8925 str
= Jim_GetString(strObjPtr
, &bytelen
);
8926 first
= JimRelToAbsIndex(bytelen
, first
);
8927 last
= JimRelToAbsIndex(bytelen
, last
);
8928 JimRelToAbsRange(bytelen
, first
, last
, &first
, &last
, &rangeLen
);
8929 if (first
== 0 && rangeLen
== bytelen
) {
8932 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
8935 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
8936 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
8944 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
8945 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
8947 str
= Jim_GetString(strObjPtr
, &bytelen
);
8948 len
= Jim_Utf8Length(interp
, strObjPtr
);
8949 first
= JimRelToAbsIndex(len
, first
);
8950 last
= JimRelToAbsIndex(len
, last
);
8951 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
8952 if (first
== 0 && rangeLen
== len
) {
8955 if (len
== bytelen
) {
8956 /* ASCII optimisation */
8957 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
8959 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
8961 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
8965 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
8971 if (strObjPtr
->typePtr
!= &stringObjType
) {
8972 SetStringFromAny(interp
, strObjPtr
);
8975 str
= Jim_GetString(strObjPtr
, &len
);
8977 buf
= p
= Jim_Alloc(len
+ 1);
8980 str
+= utf8_tounicode(str
, &c
);
8981 p
+= utf8_fromunicode(p
, utf8_lower(c
));
8984 return Jim_NewStringObjNoAlloc(interp
, buf
, len
);
8987 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
8993 if (strObjPtr
->typePtr
!= &stringObjType
) {
8994 SetStringFromAny(interp
, strObjPtr
);
8997 str
= Jim_GetString(strObjPtr
, &len
);
8999 buf
= p
= Jim_Alloc(len
+ 1);
9002 str
+= utf8_tounicode(str
, &c
);
9003 p
+= utf8_fromunicode(p
, utf8_upper(c
));
9006 return Jim_NewStringObjNoAlloc(interp
, buf
, len
);
9009 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
9010 * for unicode character 'c'.
9011 * Returns the position if found or NULL if not
9013 static const char *utf8_memchr(const char *str
, int len
, int c
)
9018 int n
= utf8_tounicode(str
, &sc
);
9027 return memchr(str
, c
, len
);
9032 * Searches for the first non-trim char in string (str, len)
9034 * If none is found, returns just past the last char.
9036 * Lengths are in bytes.
9038 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
9042 int n
= utf8_tounicode(str
, &c
);
9044 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
9045 /* Not a trim char, so stop */
9055 * Searches backwards for a non-trim char in string (str, len).
9057 * Returns a pointer to just after the non-trim char, or NULL if not found.
9059 * Lengths are in bytes.
9061 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
9067 int n
= utf8_prev_len(str
, len
);
9072 n
= utf8_tounicode(str
, &c
);
9074 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
9082 static const char default_trim_chars
[] = " \t\n\r";
9083 /* sizeof() here includes the null byte */
9084 static int default_trim_chars_len
= sizeof(default_trim_chars
);
9086 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9089 const char *str
= Jim_GetString(strObjPtr
, &len
);
9090 const char *trimchars
= default_trim_chars
;
9091 int trimcharslen
= default_trim_chars_len
;
9094 if (trimcharsObjPtr
) {
9095 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
9098 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
9099 if (newstr
== str
) {
9103 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
9106 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9109 const char *trimchars
= default_trim_chars
;
9110 int trimcharslen
= default_trim_chars_len
;
9111 const char *nontrim
;
9113 if (trimcharsObjPtr
) {
9114 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
9117 if (strObjPtr
->typePtr
!= &stringObjType
) {
9118 SetStringFromAny(interp
, strObjPtr
);
9120 Jim_GetString(strObjPtr
, &len
);
9121 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
9123 if (nontrim
== NULL
) {
9124 /* All trim, so return a zero-length string */
9125 return Jim_NewEmptyStringObj(interp
);
9127 if (nontrim
== strObjPtr
->bytes
+ len
) {
9131 if (Jim_IsShared(strObjPtr
)) {
9132 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
9135 /* Can modify this string in place */
9136 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
9137 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
9143 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
9145 /* First trim left. */
9146 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
9148 /* Now trim right */
9149 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
9151 if (objPtr
!= strObjPtr
) {
9152 /* Note that we don't want this object to be leaked */
9153 Jim_IncrRefCount(objPtr
);
9154 Jim_DecrRefCount(interp
, objPtr
);
9161 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
9163 static const char * const strclassnames
[] = {
9164 "integer", "alpha", "alnum", "ascii", "digit",
9165 "double", "lower", "upper", "space", "xdigit",
9166 "control", "print", "graph", "punct",
9170 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
9171 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
9172 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
9178 int (*isclassfunc
)(int c
) = NULL
;
9180 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
9184 str
= Jim_GetString(strObjPtr
, &len
);
9186 Jim_SetResultInt(interp
, !strict
);
9191 case STR_IS_INTEGER
:
9194 Jim_SetResultInt(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
9201 Jim_SetResultInt(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
9205 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
9206 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
9207 case STR_IS_ASCII
: isclassfunc
= isascii
; break;
9208 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
9209 case STR_IS_LOWER
: isclassfunc
= islower
; break;
9210 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
9211 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
9212 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
9213 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
9214 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
9215 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
9216 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
9221 for (i
= 0; i
< len
; i
++) {
9222 if (!isclassfunc(str
[i
])) {
9223 Jim_SetResultInt(interp
, 0);
9227 Jim_SetResultInt(interp
, 1);
9231 /* -----------------------------------------------------------------------------
9232 * Compared String Object
9233 * ---------------------------------------------------------------------------*/
9235 /* This is strange object that allows to compare a C literal string
9236 * with a Jim object in very short time if the same comparison is done
9237 * multiple times. For example every time the [if] command is executed,
9238 * Jim has to check if a given argument is "else". This comparions if
9239 * the code has no errors are true most of the times, so we can cache
9240 * inside the object the pointer of the string of the last matching
9241 * comparison. Because most C compilers perform literal sharing,
9242 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
9243 * this works pretty well even if comparisons are at different places
9244 * inside the C code. */
9246 static const Jim_ObjType comparedStringObjType
= {
9251 JIM_TYPE_REFERENCES
,
9254 /* The only way this object is exposed to the API is via the following
9255 * function. Returns true if the string and the object string repr.
9256 * are the same, otherwise zero is returned.
9258 * Note: this isn't binary safe, but it hardly needs to be.*/
9259 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
9261 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
)
9264 const char *objStr
= Jim_String(objPtr
);
9266 if (strcmp(str
, objStr
) != 0)
9268 if (objPtr
->typePtr
!= &comparedStringObjType
) {
9269 Jim_FreeIntRep(interp
, objPtr
);
9270 objPtr
->typePtr
= &comparedStringObjType
;
9272 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
9277 static int qsortCompareStringPointers(const void *a
, const void *b
)
9279 char *const *sa
= (char *const *)a
;
9280 char *const *sb
= (char *const *)b
;
9282 return strcmp(*sa
, *sb
);
9286 /* -----------------------------------------------------------------------------
9289 * This object is just a string from the language point of view, but
9290 * in the internal representation it contains the filename and line number
9291 * where this given token was read. This information is used by
9292 * Jim_EvalObj() if the object passed happens to be of type "source".
9294 * This allows to propagate the information about line numbers and file
9295 * names and give error messages with absolute line numbers.
9297 * Note that this object uses shared strings for filenames, and the
9298 * pointer to the filename together with the line number is taken into
9299 * the space for the "inline" internal representation of the Jim_Object,
9300 * so there is almost memory zero-overhead.
9302 * Also the object will be converted to something else if the given
9303 * token it represents in the source file is not something to be
9304 * evaluated (not a script), and will be specialized in some other way,
9305 * so the time overhead is also null.
9306 * ---------------------------------------------------------------------------*/
9308 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9309 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9311 static const Jim_ObjType sourceObjType
= {
9313 FreeSourceInternalRep
,
9314 DupSourceInternalRep
,
9316 JIM_TYPE_REFERENCES
,
9319 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9321 Jim_ReleaseSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
9324 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9326 dupPtr
->internalRep
.sourceValue
.fileName
=
9327 Jim_GetSharedString(interp
, srcPtr
->internalRep
.sourceValue
.fileName
);
9328 dupPtr
->internalRep
.sourceValue
.lineNumber
= dupPtr
->internalRep
.sourceValue
.lineNumber
;
9329 dupPtr
->typePtr
= &sourceObjType
;
9332 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
9333 const char *fileName
, int lineNumber
)
9336 JimPanic((Jim_IsShared(objPtr
), interp
, "JimSetSourceInfo called with shared object"));
9337 JimPanic((objPtr
->typePtr
!= NULL
, interp
, "JimSetSourceInfo called with typePtr != NULL"));
9338 objPtr
->internalRep
.sourceValue
.fileName
= Jim_GetSharedString(interp
, fileName
);
9339 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
9340 objPtr
->typePtr
= &sourceObjType
;
9344 /* -----------------------------------------------------------------------------
9346 * ---------------------------------------------------------------------------*/
9348 static const Jim_ObjType scriptLineObjType
= {
9356 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
9360 #ifdef DEBUG_SHOW_SCRIPT
9362 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
9363 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
9365 objPtr
= Jim_NewEmptyStringObj(interp
);
9367 objPtr
->typePtr
= &scriptLineObjType
;
9368 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
9369 objPtr
->internalRep
.scriptLineValue
.line
= line
;
9374 #define JIM_CMDSTRUCT_EXPAND -1
9376 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9377 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9378 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, struct JimParseResult
*result
);
9380 static const Jim_ObjType scriptObjType
= {
9382 FreeScriptInternalRep
,
9383 DupScriptInternalRep
,
9385 JIM_TYPE_REFERENCES
,
9388 /* The ScriptToken structure represents every token into a scriptObj.
9389 * Every token contains an associated Jim_Obj that can be specialized
9390 * by commands operating on it. */
9391 typedef struct ScriptToken
9397 /* This is the script object internal representation. An array of
9398 * ScriptToken structures, including a pre-computed representation of the
9399 * command length and arguments.
9401 * For example the script:
9404 * set $i $x$y [foo]BAR
9406 * will produce a ScriptObj with the following Tokens:
9421 * "puts hello" has two args (LIN 2), composed of single tokens.
9422 * (Note that the WRD token is omitted for the common case of a single token.)
9424 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
9425 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
9427 * The precomputation of the command structure makes Jim_Eval() faster,
9428 * and simpler because there aren't dynamic lengths / allocations.
9430 * -- {expand}/{*} handling --
9432 * Expand is handled in a special way.
9434 * If a "word" begins with {*}, the word token count is -ve.
9436 * For example the command:
9440 * Will produce the following cmdstruct array:
9447 * Note that the 'LIN' token also contains the source information for the
9448 * first word of the line for error reporting purposes
9450 * -- the substFlags field of the structure --
9452 * The scriptObj structure is used to represent both "script" objects
9453 * and "subst" objects. In the second case, the there are no LIN and WRD
9454 * tokens. Instead SEP and EOL tokens are added as-is.
9455 * In addition, the field 'substFlags' is used to represent the flags used to turn
9456 * the string into the internal representation used to perform the
9457 * substitution. If this flags are not what the application requires
9458 * the scriptObj is created again. For example the script:
9460 * subst -nocommands $string
9461 * subst -novariables $string
9463 * Will recreate the internal representation of the $string object
9466 typedef struct ScriptObj
9468 int len
; /* Length as number of tokens. */
9469 ScriptToken
*token
; /* Tokens array. */
9470 int substFlags
; /* flags used for the compilation of "subst" objects */
9471 int inUse
; /* Used to share a ScriptObj. Currently
9472 only used by Jim_EvalObj() as protection against
9473 shimmering of the currently evaluated object. */
9474 const char *fileName
;
9475 int line
; /* Line number of the first line */
9478 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9481 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
9484 if (script
->inUse
!= 0)
9486 for (i
= 0; i
< script
->len
; i
++) {
9487 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
9489 Jim_Free(script
->token
);
9490 if (script
->fileName
) {
9491 Jim_ReleaseSharedString(interp
, script
->fileName
);
9496 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9498 JIM_NOTUSED(interp
);
9499 JIM_NOTUSED(srcPtr
);
9501 /* Just returns an simple string. */
9502 dupPtr
->typePtr
= NULL
;
9505 /* A simple parser token.
9506 * All the simple tokens for the script point into the same script string rep.
9510 const char *token
; /* Pointer to the start of the token */
9511 int len
; /* Length of this token */
9512 int type
; /* Token type */
9513 int line
; /* Line number */
9516 /* A list of parsed tokens representing a script.
9517 * Tokens are added to this list as the script is parsed.
9518 * It grows as needed.
9522 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
9523 ParseToken
*list
; /* Array of tokens */
9524 int size
; /* Current size of the list */
9525 int count
; /* Number of entries used */
9526 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
9529 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
9531 tokenlist
->list
= tokenlist
->static_list
;
9532 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
9533 tokenlist
->count
= 0;
9536 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
9538 if (tokenlist
->list
!= tokenlist
->static_list
) {
9539 Jim_Free(tokenlist
->list
);
9544 * Adds the new token to the tokenlist.
9545 * The token has the given length, type and line number.
9546 * The token list is resized as necessary.
9548 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
9553 if (tokenlist
->count
== tokenlist
->size
) {
9554 /* Resize the list */
9555 tokenlist
->size
*= 2;
9556 if (tokenlist
->list
!= tokenlist
->static_list
) {
9558 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
9561 /* The list needs to become allocated */
9562 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
9563 memcpy(tokenlist
->list
, tokenlist
->static_list
,
9564 tokenlist
->count
* sizeof(*tokenlist
->list
));
9567 t
= &tokenlist
->list
[tokenlist
->count
++];
9574 /* Counts the number of adjoining non-separator.
9576 * Returns -ve if the first token is the expansion
9577 * operator (in which case the count doesn't include
9580 static int JimCountWordTokens(ParseToken
*t
)
9585 /* Is the first word {*} or {expand}? */
9586 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
9587 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
9588 /* Create an expand token */
9594 /* Now count non-separator words */
9595 while (!TOKEN_IS_SEP(t
->type
)) {
9600 return count
* expand
;
9604 * Create a script/subst object from the given token.
9606 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
9610 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
9611 /* Convert the backlash escapes . */
9613 char *str
= Jim_Alloc(len
+ 1);
9614 len
= JimEscape(str
, t
->token
, len
);
9615 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
9618 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
9619 * with a single space. This is currently not done.
9621 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9627 * Takes a tokenlist and creates the allocated list of script tokens
9628 * in script->token, of length script->len.
9630 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
9633 * Also sets script->line to the line number of the first token
9635 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
9636 ParseTokenList
*tokenlist
)
9639 struct ScriptToken
*token
;
9640 /* Number of tokens so far for the current command */
9642 /* This is the first token for the current command */
9643 ScriptToken
*linefirst
;
9647 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
9648 printf("==== Tokens ====\n");
9649 for (i
= 0; i
< tokenlist
->count
; i
++) {
9650 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
9651 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
9655 /* May need up to one extra script token for each EOL in the worst case */
9656 count
= tokenlist
->count
;
9657 for (i
= 0; i
< tokenlist
->count
; i
++) {
9658 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
9662 linenr
= script
->line
= tokenlist
->list
[0].line
;
9664 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9666 /* This is the first token for the current command */
9667 linefirst
= token
++;
9669 for (i
= 0; i
< tokenlist
->count
; ) {
9670 /* Look ahead to find out how many tokens make up the next word */
9673 /* Skip any leading separators */
9674 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
9678 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
9680 if (wordtokens
== 0) {
9681 /* None, so at end of line */
9683 linefirst
->type
= JIM_TT_LINE
;
9684 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
9685 Jim_IncrRefCount(linefirst
->objPtr
);
9687 /* Reset for new line */
9689 linefirst
= token
++;
9694 else if (wordtokens
!= 1) {
9695 /* More than 1, or {expand}, so insert a WORD token */
9696 token
->type
= JIM_TT_WORD
;
9697 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
9698 Jim_IncrRefCount(token
->objPtr
);
9700 if (wordtokens
< 0) {
9701 /* Skip the expand token */
9703 wordtokens
= -wordtokens
- 1;
9708 if (lineargs
== 0) {
9709 /* First real token on the line, so record the line number */
9710 linenr
= tokenlist
->list
[i
].line
;
9714 /* Add each non-separator word token to the line */
9715 while (wordtokens
--) {
9716 const ParseToken
*t
= &tokenlist
->list
[i
++];
9718 token
->type
= t
->type
;
9719 token
->objPtr
= JimMakeScriptObj(interp
, t
);
9720 Jim_IncrRefCount(token
->objPtr
);
9722 /* Every object is initially a string, but the
9723 * internal type may be specialized during execution of the
9725 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileName
, t
->line
);
9730 if (lineargs
== 0) {
9734 script
->len
= token
- script
->token
;
9736 assert(script
->len
< count
);
9738 #ifdef DEBUG_SHOW_SCRIPT
9739 printf("==== Script (%s) ====\n", script
->fileName
);
9740 for (i
= 0; i
< script
->len
; i
++) {
9741 const ScriptToken
*t
= &script
->token
[i
];
9742 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9749 * Similar to ScriptObjAddTokens(), but for subst objects.
9751 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
9752 ParseTokenList
*tokenlist
)
9755 struct ScriptToken
*token
;
9757 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
9759 for (i
= 0; i
< tokenlist
->count
; i
++) {
9760 const ParseToken
*t
= &tokenlist
->list
[i
];
9762 /* Create a token for 't' */
9763 token
->type
= t
->type
;
9764 token
->objPtr
= JimMakeScriptObj(interp
, t
);
9765 Jim_IncrRefCount(token
->objPtr
);
9772 /* This method takes the string representation of an object
9773 * as a Tcl script, and generates the pre-parsed internal representation
9775 static int SetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, struct JimParseResult
*result
)
9778 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
9779 struct JimParserCtx parser
;
9780 struct ScriptObj
*script
;
9781 ParseTokenList tokenlist
;
9784 /* Try to get information about filename / line number */
9785 if (objPtr
->typePtr
== &sourceObjType
) {
9786 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9789 /* Initially parse the script into tokens (in tokenlist) */
9790 ScriptTokenListInit(&tokenlist
);
9792 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
9793 while (!parser
.eof
) {
9794 JimParseScript(&parser
);
9795 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9798 if (result
&& parser
.missing
!= ' ') {
9799 ScriptTokenListFree(&tokenlist
);
9800 result
->missing
= parser
.missing
;
9801 result
->line
= parser
.missingline
;
9805 /* Add a final EOF token */
9806 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
9808 /* Create the "real" script tokens from the initial token list */
9809 script
= Jim_Alloc(sizeof(*script
));
9810 memset(script
, 0, sizeof(*script
));
9812 script
->line
= line
;
9813 if (objPtr
->typePtr
== &sourceObjType
) {
9814 script
->fileName
= Jim_GetSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
9817 ScriptObjAddTokens(interp
, script
, &tokenlist
);
9819 /* No longer need the token list */
9820 ScriptTokenListFree(&tokenlist
);
9822 if (!script
->fileName
) {
9823 script
->fileName
= Jim_GetSharedString(interp
, "");
9826 /* Free the old internal rep and set the new one. */
9827 Jim_FreeIntRep(interp
, objPtr
);
9828 Jim_SetIntRepPtr(objPtr
, script
);
9829 objPtr
->typePtr
= &scriptObjType
;
9834 ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9836 struct ScriptObj
*script
= Jim_GetIntRepPtr(objPtr
);
9838 if (objPtr
->typePtr
!= &scriptObjType
|| script
->substFlags
) {
9839 SetScriptFromAny(interp
, objPtr
, NULL
);
9841 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
9844 /* -----------------------------------------------------------------------------
9846 * ---------------------------------------------------------------------------*/
9847 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
9852 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
9854 if (--cmdPtr
->inUse
== 0) {
9855 if (cmdPtr
->isproc
) {
9856 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
9857 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
9858 if (cmdPtr
->u
.proc
.staticVars
) {
9859 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
9860 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
9862 if (cmdPtr
->u
.proc
.prevCmd
) {
9863 /* Delete any pushed command too */
9864 JimDecrCmdRefCount(interp
, cmdPtr
->u
.proc
.prevCmd
);
9869 if (cmdPtr
->u
.native
.delProc
) {
9870 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
9877 /* Commands HashTable Type.
9879 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
9880 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
9882 JimDecrCmdRefCount(interp
, val
);
9885 static const Jim_HashTableType JimCommandsHashTableType
= {
9886 JimStringCopyHTHashFunction
, /* hash function */
9887 JimStringCopyHTKeyDup
, /* key dup */
9889 JimStringCopyHTKeyCompare
, /* key compare */
9890 JimStringCopyHTKeyDestructor
, /* key destructor */
9891 JimCommandsHT_ValDestructor
/* val destructor */
9894 /* ------------------------- Commands related functions --------------------- */
9896 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdName
,
9897 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
9901 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) != JIM_ERR
) {
9902 /* Command existed so incr proc epoch */
9903 Jim_InterpIncrProcEpoch(interp
);
9906 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
9908 /* Store the new details for this proc */
9909 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
9911 cmdPtr
->u
.native
.delProc
= delProc
;
9912 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
9913 cmdPtr
->u
.native
.privData
= privData
;
9915 Jim_AddHashEntry(&interp
->commands
, cmdName
, cmdPtr
);
9917 /* There is no need to increment the 'proc epoch' because
9918 * creation of a new procedure can never affect existing
9919 * cached commands. We don't do negative caching. */
9923 static int JimCreateProcedure(Jim_Interp
*interp
, Jim_Obj
*cmdName
,
9924 Jim_Obj
*argListObjPtr
, Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
)
9931 if (JimValidName(interp
, "procedure", cmdName
) != JIM_OK
) {
9935 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
9937 /* Allocate space for both the command pointer and the arg list */
9938 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
9939 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
9942 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
9943 cmdPtr
->u
.proc
.argListLen
= argListLen
;
9944 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
9945 cmdPtr
->u
.proc
.argsPos
= -1;
9946 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
9947 Jim_IncrRefCount(argListObjPtr
);
9948 Jim_IncrRefCount(bodyObjPtr
);
9950 /* Create the statics hash table. */
9951 if (staticsListObjPtr
) {
9954 len
= Jim_ListLength(interp
, staticsListObjPtr
);
9956 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
9957 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
9958 for (i
= 0; i
< len
; i
++) {
9959 Jim_Obj
*objPtr
= 0, *initObjPtr
= 0, *nameObjPtr
= 0;
9963 Jim_ListIndex(interp
, staticsListObjPtr
, i
, &objPtr
, JIM_NONE
);
9964 /* Check if it's composed of two elements. */
9965 subLen
= Jim_ListLength(interp
, objPtr
);
9966 if (subLen
== 1 || subLen
== 2) {
9967 /* Try to get the variable value from the current
9969 Jim_ListIndex(interp
, objPtr
, 0, &nameObjPtr
, JIM_NONE
);
9971 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
9972 if (initObjPtr
== NULL
) {
9973 Jim_SetResultFormatted(interp
,
9974 "variable for initialization of static \"%#s\" not found in the local context",
9980 Jim_ListIndex(interp
, objPtr
, 1, &initObjPtr
, JIM_NONE
);
9982 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
9986 varPtr
= Jim_Alloc(sizeof(*varPtr
));
9987 varPtr
->objPtr
= initObjPtr
;
9988 Jim_IncrRefCount(initObjPtr
);
9989 varPtr
->linkFramePtr
= NULL
;
9990 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
9991 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
9992 Jim_SetResultFormatted(interp
,
9993 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
9994 Jim_DecrRefCount(interp
, initObjPtr
);
10000 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
10008 /* Parse the args out into arglist, validating as we go */
10009 /* Examine the argument list for default parameters and 'args' */
10010 for (i
= 0; i
< argListLen
; i
++) {
10012 Jim_Obj
*nameObjPtr
;
10013 Jim_Obj
*defaultObjPtr
;
10017 /* Examine a parameter */
10018 Jim_ListIndex(interp
, argListObjPtr
, i
, &argPtr
, JIM_NONE
);
10019 len
= Jim_ListLength(interp
, argPtr
);
10021 Jim_SetResultString(interp
, "procedure has argument with no name", -1);
10025 Jim_SetResultString(interp
, "procedure has argument with too many fields", -1);
10030 /* Optional parameter */
10031 Jim_ListIndex(interp
, argPtr
, 0, &nameObjPtr
, JIM_NONE
);
10032 Jim_ListIndex(interp
, argPtr
, 1, &defaultObjPtr
, JIM_NONE
);
10035 /* Required parameter */
10036 nameObjPtr
= argPtr
;
10037 defaultObjPtr
= NULL
;
10041 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
10042 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
10043 Jim_SetResultString(interp
, "procedure has 'args' specified more than once", -1);
10046 cmdPtr
->u
.proc
.argsPos
= i
;
10050 cmdPtr
->u
.proc
.optArity
+= n
;
10053 cmdPtr
->u
.proc
.reqArity
+= n
;
10057 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
10058 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
10061 /* Add the new command */
10063 /* It may already exist, so we try to delete the old one.
10064 * Note that reference count means that it won't be deleted yet if
10065 * it exists in the call stack.
10067 * BUT, if 'local' is in force, instead of deleting the existing
10068 * proc, we stash a reference to the old proc here.
10070 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(cmdName
));
10072 /* There was an old procedure with the same name, this requires
10073 * a 'proc epoch' update. */
10075 /* If a procedure with the same name didn't existed there is no need
10076 * to increment the 'proc epoch' because creation of a new procedure
10077 * can never affect existing cached commands. We don't do
10078 * negative caching. */
10079 Jim_InterpIncrProcEpoch(interp
);
10082 if (he
&& interp
->local
) {
10083 /* Just push this proc over the top of the previous one */
10084 cmdPtr
->u
.proc
.prevCmd
= he
->u
.val
;
10085 he
->u
.val
= cmdPtr
;
10089 /* Replace the existing proc */
10090 Jim_DeleteHashEntry(&interp
->commands
, Jim_String(cmdName
));
10093 Jim_AddHashEntry(&interp
->commands
, Jim_String(cmdName
), cmdPtr
);
10096 /* Unlike Tcl, set the name of the proc as the result */
10097 Jim_SetResult(interp
, cmdName
);
10101 if (cmdPtr
->u
.proc
.staticVars
) {
10102 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
10104 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
10105 Jim_DecrRefCount(interp
, argListObjPtr
);
10106 Jim_DecrRefCount(interp
, bodyObjPtr
);
10111 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *cmdName
)
10113 if (Jim_DeleteHashEntry(&interp
->commands
, cmdName
) == JIM_ERR
)
10115 Jim_InterpIncrProcEpoch(interp
);
10119 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
10123 /* Does it exist? */
10124 he
= Jim_FindHashEntry(&interp
->commands
, oldName
);
10126 Jim_SetResultFormatted(interp
, "can't %s \"%s\": command doesn't exist",
10127 newName
[0] ? "rename" : "delete", oldName
);
10131 if (newName
[0] == '\0') /* Delete! */
10132 return Jim_DeleteCommand(interp
, oldName
);
10135 if (Jim_FindHashEntry(&interp
->commands
, newName
)) {
10136 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
10140 /* Add the new name first */
10141 JimIncrCmdRefCount(he
->u
.val
);
10142 Jim_AddHashEntry(&interp
->commands
, newName
, he
->u
.val
);
10144 /* Now remove the old name */
10145 Jim_DeleteHashEntry(&interp
->commands
, oldName
);
10147 /* Increment the epoch */
10148 Jim_InterpIncrProcEpoch(interp
);
10152 /* -----------------------------------------------------------------------------
10154 * ---------------------------------------------------------------------------*/
10156 static int SetCommandFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
10158 static const Jim_ObjType commandObjType
= {
10163 JIM_TYPE_REFERENCES
,
10166 int SetCommandFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10169 const char *cmdName
;
10171 /* Get the string representation */
10172 cmdName
= Jim_String(objPtr
);
10173 /* Lookup this name into the commands hash table */
10174 he
= Jim_FindHashEntry(&interp
->commands
, cmdName
);
10178 /* Free the old internal repr and set the new one. */
10179 Jim_FreeIntRep(interp
, objPtr
);
10180 objPtr
->typePtr
= &commandObjType
;
10181 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
10182 objPtr
->internalRep
.cmdValue
.cmdPtr
= (void *)he
->u
.val
;
10186 /* This function returns the command structure for the command name
10187 * stored in objPtr. It tries to specialize the objPtr to contain
10188 * a cached info instead to perform the lookup into the hash table
10189 * every time. The information cached may not be uptodate, in such
10190 * a case the lookup is performed and the cache updated.
10192 * Respects the 'upcall' setting
10194 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
10198 if ((objPtr
->typePtr
!= &commandObjType
||
10199 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
) &&
10200 SetCommandFromAny(interp
, objPtr
) == JIM_ERR
) {
10201 if (flags
& JIM_ERRMSG
) {
10202 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
10206 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
10207 while (cmd
->isproc
&& cmd
->u
.proc
.upcall
) {
10208 cmd
= cmd
->u
.proc
.prevCmd
;
10213 /* -----------------------------------------------------------------------------
10215 * ---------------------------------------------------------------------------*/
10217 /* Variables HashTable Type.
10219 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
10220 static void JimVariablesHTValDestructor(void *interp
, void *val
)
10222 Jim_Var
*varPtr
= (void *)val
;
10224 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
10228 static const Jim_HashTableType JimVariablesHashTableType
= {
10229 JimStringCopyHTHashFunction
, /* hash function */
10230 JimStringCopyHTKeyDup
, /* key dup */
10231 NULL
, /* val dup */
10232 JimStringCopyHTKeyCompare
, /* key compare */
10233 JimStringCopyHTKeyDestructor
, /* key destructor */
10234 JimVariablesHTValDestructor
/* val destructor */
10237 /* -----------------------------------------------------------------------------
10239 * ---------------------------------------------------------------------------*/
10241 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
10243 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
10245 static const Jim_ObjType variableObjType
= {
10250 JIM_TYPE_REFERENCES
,
10253 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
10254 * is in the form "varname(key)". */
10255 static int JimNameIsDictSugar(const char *str
, int len
)
10257 if (len
&& str
[len
- 1] == ')' && strchr(str
, '(') != NULL
)
10263 * Check that the name does not contain embedded nulls.
10265 * Variable and procedure names are maniplated as null terminated strings, so
10266 * don't allow names with embedded nulls.
10268 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
10270 /* Variable names and proc names can't contain embedded nulls */
10271 if (nameObjPtr
->typePtr
!= &variableObjType
) {
10273 const char *str
= Jim_GetString(nameObjPtr
, &len
);
10274 if (memchr(str
, '\0', len
)) {
10275 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
10282 /* This method should be called only by the variable API.
10283 * It returns JIM_OK on success (variable already exists),
10284 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
10285 * a variable name, but syntax glue for [dict] i.e. the last
10286 * character is ')' */
10287 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
10290 const char *varName
;
10292 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10294 /* Check if the object is already an uptodate variable */
10295 if (objPtr
->typePtr
== &variableObjType
&&
10296 objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
10297 return JIM_OK
; /* nothing to do */
10300 if (objPtr
->typePtr
== &dictSubstObjType
) {
10301 return JIM_DICT_SUGAR
;
10304 if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
10308 /* Get the string representation */
10309 varName
= Jim_GetString(objPtr
, &len
);
10311 /* Make sure it's not syntax glue to get/set dict. */
10312 if (JimNameIsDictSugar(varName
, len
)) {
10313 return JIM_DICT_SUGAR
;
10316 if (varName
[0] == ':' && varName
[1] == ':') {
10317 framePtr
= interp
->topFramePtr
;
10318 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
+ 2);
10324 /* Lookup this name into the variables hash table */
10325 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
10327 /* Try with static vars. */
10328 if (framePtr
->staticVars
== NULL
)
10330 if (!(he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
)))
10334 /* Free the old internal repr and set the new one. */
10335 Jim_FreeIntRep(interp
, objPtr
);
10336 objPtr
->typePtr
= &variableObjType
;
10337 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
10338 objPtr
->internalRep
.varValue
.varPtr
= (void *)he
->u
.val
;
10342 /* -------------------- Variables related functions ------------------------- */
10343 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
10344 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
10346 /* For now that's dummy. Variables lookup should be optimized
10347 * in many ways, with caching of lookups, and possibly with
10348 * a table of pre-allocated vars in every CallFrame for local vars.
10349 * All the caching should also have an 'epoch' mechanism similar
10350 * to the one used by Tcl for procedures lookup caching. */
10352 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
10358 if ((err
= SetVariableFromAny(interp
, nameObjPtr
)) != JIM_OK
) {
10359 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10361 /* Check for [dict] syntax sugar. */
10362 if (err
== JIM_DICT_SUGAR
)
10363 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
10365 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
10369 /* New variable to create */
10370 name
= Jim_String(nameObjPtr
);
10372 var
= Jim_Alloc(sizeof(*var
));
10373 var
->objPtr
= valObjPtr
;
10374 Jim_IncrRefCount(valObjPtr
);
10375 var
->linkFramePtr
= NULL
;
10376 /* Insert the new variable */
10377 if (name
[0] == ':' && name
[1] == ':') {
10378 /* Into the top level frame */
10379 framePtr
= interp
->topFramePtr
;
10380 Jim_AddHashEntry(&framePtr
->vars
, name
+ 2, var
);
10383 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
10385 /* Make the object int rep a variable */
10386 Jim_FreeIntRep(interp
, nameObjPtr
);
10387 nameObjPtr
->typePtr
= &variableObjType
;
10388 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
10389 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
10392 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10393 if (var
->linkFramePtr
== NULL
) {
10394 Jim_IncrRefCount(valObjPtr
);
10395 Jim_DecrRefCount(interp
, var
->objPtr
);
10396 var
->objPtr
= valObjPtr
;
10398 else { /* Else handle the link */
10399 Jim_CallFrame
*savedCallFrame
;
10401 savedCallFrame
= interp
->framePtr
;
10402 interp
->framePtr
= var
->linkFramePtr
;
10403 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
10404 interp
->framePtr
= savedCallFrame
;
10412 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
10414 Jim_Obj
*nameObjPtr
;
10417 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10418 Jim_IncrRefCount(nameObjPtr
);
10419 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
10420 Jim_DecrRefCount(interp
, nameObjPtr
);
10424 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
10426 Jim_CallFrame
*savedFramePtr
;
10429 savedFramePtr
= interp
->framePtr
;
10430 interp
->framePtr
= interp
->topFramePtr
;
10431 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
10432 interp
->framePtr
= savedFramePtr
;
10436 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
10438 Jim_Obj
*nameObjPtr
, *valObjPtr
;
10441 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10442 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
10443 Jim_IncrRefCount(nameObjPtr
);
10444 Jim_IncrRefCount(valObjPtr
);
10445 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
10446 Jim_DecrRefCount(interp
, nameObjPtr
);
10447 Jim_DecrRefCount(interp
, valObjPtr
);
10451 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
10452 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
10454 const char *varName
;
10457 varName
= Jim_GetString(nameObjPtr
, &len
);
10459 if (varName
[0] == ':' && varName
[1] == ':') {
10460 /* Linking a global var does nothing */
10464 if (JimNameIsDictSugar(varName
, len
)) {
10465 Jim_SetResultString(interp
, "Dict key syntax invalid as link source", -1);
10469 /* Check for an existing variable or link */
10470 if (SetVariableFromAny(interp
, nameObjPtr
) == JIM_OK
) {
10471 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10473 if (varPtr
->linkFramePtr
== NULL
) {
10474 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
10478 /* It exists, but is a link, so delete the link */
10479 varPtr
->linkFramePtr
= NULL
;
10482 /* Check for cycles. */
10483 if (interp
->framePtr
== targetCallFrame
) {
10484 Jim_Obj
*objPtr
= targetNameObjPtr
;
10487 /* Cycles are only possible with 'uplevel 0' */
10489 if (Jim_StringEqObj(objPtr
, nameObjPtr
)) {
10490 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
10493 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
10495 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
10496 if (varPtr
->linkFramePtr
!= targetCallFrame
)
10498 objPtr
= varPtr
->objPtr
;
10502 /* Perform the binding */
10503 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
10504 /* We are now sure 'nameObjPtr' type is variableObjType */
10505 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
10509 /* Return the Jim_Obj pointer associated with a variable name,
10510 * or NULL if the variable was not found in the current context.
10511 * The same optimization discussed in the comment to the
10512 * 'SetVariable' function should apply here.
10514 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
10515 * in a dictionary which is shared, the array variable value is duplicated first.
10516 * This allows the array element to be updated (e.g. append, lappend) without
10517 * affecting other references to the dictionary.
10519 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10521 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
10523 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10525 if (varPtr
->linkFramePtr
== NULL
) {
10526 return varPtr
->objPtr
;
10531 /* The variable is a link? Resolve it. */
10532 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10534 interp
->framePtr
= varPtr
->linkFramePtr
;
10535 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
10536 interp
->framePtr
= savedCallFrame
;
10540 /* Error, so fall through to the error message */
10545 case JIM_DICT_SUGAR
:
10546 /* [dict] syntax sugar. */
10547 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
10549 if (flags
& JIM_ERRMSG
) {
10550 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
10555 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10557 Jim_CallFrame
*savedFramePtr
;
10560 savedFramePtr
= interp
->framePtr
;
10561 interp
->framePtr
= interp
->topFramePtr
;
10562 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
10563 interp
->framePtr
= savedFramePtr
;
10568 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
10570 Jim_Obj
*nameObjPtr
, *varObjPtr
;
10572 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
10573 Jim_IncrRefCount(nameObjPtr
);
10574 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
10575 Jim_DecrRefCount(interp
, nameObjPtr
);
10579 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
10581 Jim_CallFrame
*savedFramePtr
;
10584 savedFramePtr
= interp
->framePtr
;
10585 interp
->framePtr
= interp
->topFramePtr
;
10586 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
10587 interp
->framePtr
= savedFramePtr
;
10592 /* Unset a variable.
10593 * Note: On success unset invalidates all the variable objects created
10594 * in the current call frame incrementing. */
10595 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
10601 retval
= SetVariableFromAny(interp
, nameObjPtr
);
10602 if (retval
== JIM_DICT_SUGAR
) {
10603 /* [dict] syntax sugar. */
10604 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
10606 else if (retval
== JIM_OK
) {
10607 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
10609 /* If it's a link call UnsetVariable recursively */
10610 if (varPtr
->linkFramePtr
) {
10611 Jim_CallFrame
*savedCallFrame
;
10613 savedCallFrame
= interp
->framePtr
;
10614 interp
->framePtr
= varPtr
->linkFramePtr
;
10615 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
10616 interp
->framePtr
= savedCallFrame
;
10619 Jim_CallFrame
*framePtr
= interp
->framePtr
;
10621 name
= Jim_String(nameObjPtr
);
10622 if (name
[0] == ':' && name
[1] == ':') {
10623 framePtr
= interp
->topFramePtr
;
10626 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
10627 if (retval
== JIM_OK
) {
10628 /* Change the callframe id, invalidating var lookup caching */
10629 JimChangeCallFrameId(interp
, framePtr
);
10633 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
10634 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
10639 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
10641 /* Given a variable name for [dict] operation syntax sugar,
10642 * this function returns two objects, the first with the name
10643 * of the variable to set, and the second with the rispective key.
10644 * For example "foo(bar)" will return objects with string repr. of
10647 * The returned objects have refcount = 1. The function can't fail. */
10648 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
10649 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
10651 const char *str
, *p
;
10653 Jim_Obj
*varObjPtr
, *keyObjPtr
;
10655 str
= Jim_GetString(objPtr
, &len
);
10657 p
= strchr(str
, '(');
10658 JimPanic((p
== NULL
, interp
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
10660 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
10663 keyLen
= (str
+ len
) - p
;
10664 if (str
[len
- 1] == ')') {
10668 /* Create the objects with the variable name and key. */
10669 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
10671 Jim_IncrRefCount(varObjPtr
);
10672 Jim_IncrRefCount(keyObjPtr
);
10673 *varPtrPtr
= varObjPtr
;
10674 *keyPtrPtr
= keyObjPtr
;
10677 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
10678 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
10679 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
10683 SetDictSubstFromAny(interp
, objPtr
);
10685 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10686 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
);
10688 if (err
== JIM_OK
) {
10689 /* Don't keep an extra ref to the result */
10690 Jim_SetEmptyResult(interp
);
10694 /* Better error message for unset a(2) where a exists but a(2) doesn't */
10695 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
10696 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
10701 /* Make the error more informative and Tcl-compatible */
10702 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
10703 (valObjPtr
? "set" : "unset"), objPtr
);
10709 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
10711 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
10712 * and stored back to the variable before expansion.
10714 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
10715 Jim_Obj
*keyObjPtr
, int flags
)
10717 Jim_Obj
*dictObjPtr
;
10718 Jim_Obj
*resObjPtr
= NULL
;
10721 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
10726 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
10727 if (ret
!= JIM_OK
) {
10730 Jim_SetResultFormatted(interp
,
10731 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr
, keyObjPtr
);
10734 Jim_SetResultFormatted(interp
,
10735 "can't read \"%#s(%#s)\": no such element in array", varObjPtr
, keyObjPtr
);
10738 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
10739 dictObjPtr
= Jim_DuplicateObj(interp
, dictObjPtr
);
10740 if (Jim_SetVariable(interp
, varObjPtr
, dictObjPtr
) != JIM_OK
) {
10741 /* This can probably never happen */
10742 JimPanic((1, interp
, "SetVariable failed for JIM_UNSHARED"));
10744 /* We know that the key exists. Get the result in the now-unshared dictionary */
10745 Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
10751 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
10752 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
10754 SetDictSubstFromAny(interp
, objPtr
);
10756 return JimDictExpandArrayVariable(interp
,
10757 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10758 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
10761 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
10763 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10765 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
10766 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
10769 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
10771 JIM_NOTUSED(interp
);
10773 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
10774 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
10775 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
10776 dupPtr
->typePtr
= &dictSubstObjType
;
10779 /* Note: The object *must* be in dict-sugar format */
10780 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10782 if (objPtr
->typePtr
!= &dictSubstObjType
) {
10783 Jim_Obj
*varObjPtr
, *keyObjPtr
;
10785 if (objPtr
->typePtr
== &interpolatedObjType
) {
10786 /* An interpolated object in dict-sugar form */
10788 const ScriptToken
*token
= objPtr
->internalRep
.twoPtrValue
.ptr1
;
10790 varObjPtr
= token
[0].objPtr
;
10791 keyObjPtr
= objPtr
->internalRep
.twoPtrValue
.ptr2
;
10793 Jim_IncrRefCount(varObjPtr
);
10794 Jim_IncrRefCount(keyObjPtr
);
10797 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
10800 Jim_FreeIntRep(interp
, objPtr
);
10801 objPtr
->typePtr
= &dictSubstObjType
;
10802 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
10803 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
10807 /* This function is used to expand [dict get] sugar in the form
10808 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
10809 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
10810 * object that is *guaranteed* to be in the form VARNAME(INDEX).
10811 * The 'index' part is [subst]ituted, and is used to lookup a key inside
10812 * the [dict]ionary contained in variable VARNAME. */
10813 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10815 Jim_Obj
*resObjPtr
= NULL
;
10816 Jim_Obj
*substKeyObjPtr
= NULL
;
10818 SetDictSubstFromAny(interp
, objPtr
);
10820 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
10821 &substKeyObjPtr
, JIM_NONE
)
10825 Jim_IncrRefCount(substKeyObjPtr
);
10827 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
10828 substKeyObjPtr
, 0);
10829 Jim_DecrRefCount(interp
, substKeyObjPtr
);
10834 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
10836 Jim_Obj
*resultObjPtr
;
10838 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
10839 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
10840 resultObjPtr
->refCount
--;
10841 return resultObjPtr
;
10846 /* -----------------------------------------------------------------------------
10848 * ---------------------------------------------------------------------------*/
10850 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
)
10854 if (interp
->freeFramesList
) {
10855 cf
= interp
->freeFramesList
;
10856 interp
->freeFramesList
= cf
->nextFramePtr
;
10859 cf
= Jim_Alloc(sizeof(*cf
));
10860 cf
->vars
.table
= NULL
;
10863 cf
->id
= interp
->callFrameEpoch
++;
10864 cf
->parentCallFrame
= parent
;
10865 cf
->level
= parent
? parent
->level
+ 1 : 0;
10868 cf
->procArgsObjPtr
= NULL
;
10869 cf
->procBodyObjPtr
= NULL
;
10870 cf
->nextFramePtr
= NULL
;
10871 cf
->staticVars
= NULL
;
10872 if (cf
->vars
.table
== NULL
)
10873 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
10877 /* Used to invalidate every caching related to callframe stability. */
10878 static void JimChangeCallFrameId(Jim_Interp
*interp
, Jim_CallFrame
*cf
)
10880 cf
->id
= interp
->callFrameEpoch
++;
10883 #define JIM_FCF_NONE 0 /* no flags */
10884 #define JIM_FCF_NOHT 1 /* don't free the hash table */
10885 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int flags
)
10887 if (cf
->procArgsObjPtr
)
10888 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
10889 if (cf
->procBodyObjPtr
)
10890 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
10891 if (!(flags
& JIM_FCF_NOHT
))
10892 Jim_FreeHashTable(&cf
->vars
);
10895 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
10897 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
10899 while (he
!= NULL
) {
10900 Jim_HashEntry
*nextEntry
= he
->next
;
10901 Jim_Var
*varPtr
= (void *)he
->u
.val
;
10903 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
10904 Jim_Free(he
->u
.val
);
10905 Jim_Free((void *)he
->key
); /* ATTENTION: const cast */
10913 cf
->nextFramePtr
= interp
->freeFramesList
;
10914 interp
->freeFramesList
= cf
;
10917 /* -----------------------------------------------------------------------------
10919 * ---------------------------------------------------------------------------*/
10920 #ifdef JIM_REFERENCES
10922 /* References HashTable Type.
10924 * Keys are jim_wide integers, dynamically allocated for now but in the
10925 * future it's worth to cache this 8 bytes objects. Values are poitners
10926 * to Jim_References. */
10927 static void JimReferencesHTValDestructor(void *interp
, void *val
)
10929 Jim_Reference
*refPtr
= (void *)val
;
10931 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
10932 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
10933 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
10938 static unsigned int JimReferencesHTHashFunction(const void *key
)
10940 /* Only the least significant bits are used. */
10941 const jim_wide
*widePtr
= key
;
10942 unsigned int intValue
= (unsigned int)*widePtr
;
10944 return Jim_IntHashFunction(intValue
);
10947 static const void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
10949 void *copy
= Jim_Alloc(sizeof(jim_wide
));
10951 JIM_NOTUSED(privdata
);
10953 memcpy(copy
, key
, sizeof(jim_wide
));
10957 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
10959 JIM_NOTUSED(privdata
);
10961 return memcmp(key1
, key2
, sizeof(jim_wide
)) == 0;
10964 static void JimReferencesHTKeyDestructor(void *privdata
, const void *key
)
10966 JIM_NOTUSED(privdata
);
10968 Jim_Free((void *)key
);
10971 static const Jim_HashTableType JimReferencesHashTableType
= {
10972 JimReferencesHTHashFunction
, /* hash function */
10973 JimReferencesHTKeyDup
, /* key dup */
10974 NULL
, /* val dup */
10975 JimReferencesHTKeyCompare
, /* key compare */
10976 JimReferencesHTKeyDestructor
, /* key destructor */
10977 JimReferencesHTValDestructor
/* val destructor */
10980 /* -----------------------------------------------------------------------------
10981 * Reference object type and References API
10982 * ---------------------------------------------------------------------------*/
10984 /* The string representation of references has two features in order
10985 * to make the GC faster. The first is that every reference starts
10986 * with a non common character '<', in order to make the string matching
10987 * faster. The second is that the reference string rep is 42 characters
10988 * in length, this allows to avoid to check every object with a string
10989 * repr < 42, and usually there aren't many of these objects. */
10991 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
10993 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, jim_wide id
)
10995 const char *fmt
= "<reference.<%s>.%020" JIM_WIDE_MODIFIER
">";
10997 sprintf(buf
, fmt
, refPtr
->tag
, id
);
10998 return JIM_REFERENCE_SPACE
;
11001 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
11003 static const Jim_ObjType referenceObjType
= {
11007 UpdateStringOfReference
,
11008 JIM_TYPE_REFERENCES
,
11011 void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
11014 char buf
[JIM_REFERENCE_SPACE
+ 1];
11015 Jim_Reference
*refPtr
;
11017 refPtr
= objPtr
->internalRep
.refValue
.refPtr
;
11018 len
= JimFormatReference(buf
, refPtr
, objPtr
->internalRep
.refValue
.id
);
11019 objPtr
->bytes
= Jim_Alloc(len
+ 1);
11020 memcpy(objPtr
->bytes
, buf
, len
+ 1);
11021 objPtr
->length
= len
;
11024 /* returns true if 'c' is a valid reference tag character.
11025 * i.e. inside the range [_a-zA-Z0-9] */
11026 static int isrefchar(int c
)
11028 return (c
== '_' || isalnum(c
));
11031 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11033 jim_wide wideValue
;
11035 const char *str
, *start
, *end
;
11037 Jim_Reference
*refPtr
;
11040 /* Get the string representation */
11041 str
= Jim_GetString(objPtr
, &len
);
11042 /* Check if it looks like a reference */
11043 if (len
< JIM_REFERENCE_SPACE
)
11047 end
= str
+ len
- 1;
11048 while (*start
== ' ')
11050 while (*end
== ' ' && end
> start
)
11052 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
11054 /* <reference.<1234567>.%020> */
11055 if (memcmp(start
, "<reference.<", 12) != 0)
11057 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
11059 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
11060 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
11061 if (!isrefchar(start
[12 + i
]))
11064 /* Extract info from the reference. */
11065 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
11067 /* Try to convert the ID into a jim_wide */
11068 if (Jim_StringToWide(refId
, &wideValue
, 10) != JIM_OK
)
11070 /* Check if the reference really exists! */
11071 he
= Jim_FindHashEntry(&interp
->references
, &wideValue
);
11073 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
11076 refPtr
= he
->u
.val
;
11077 /* Free the old internal repr and set the new one. */
11078 Jim_FreeIntRep(interp
, objPtr
);
11079 objPtr
->typePtr
= &referenceObjType
;
11080 objPtr
->internalRep
.refValue
.id
= wideValue
;
11081 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
11085 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
11089 /* Returns a new reference pointing to objPtr, having cmdNamePtr
11090 * as finalizer command (or NULL if there is no finalizer).
11091 * The returned reference object has refcount = 0. */
11092 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
11094 struct Jim_Reference
*refPtr
;
11095 jim_wide wideValue
= interp
->referenceNextId
;
11096 Jim_Obj
*refObjPtr
;
11100 /* Perform the Garbage Collection if needed. */
11101 Jim_CollectIfNeeded(interp
);
11103 refPtr
= Jim_Alloc(sizeof(*refPtr
));
11104 refPtr
->objPtr
= objPtr
;
11105 Jim_IncrRefCount(objPtr
);
11106 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
11108 Jim_IncrRefCount(cmdNamePtr
);
11109 Jim_AddHashEntry(&interp
->references
, &wideValue
, refPtr
);
11110 refObjPtr
= Jim_NewObj(interp
);
11111 refObjPtr
->typePtr
= &referenceObjType
;
11112 refObjPtr
->bytes
= NULL
;
11113 refObjPtr
->internalRep
.refValue
.id
= interp
->referenceNextId
;
11114 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
11115 interp
->referenceNextId
++;
11116 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
11117 * that does not pass the 'isrefchar' test is replaced with '_' */
11118 tag
= Jim_GetString(tagPtr
, &tagLen
);
11119 if (tagLen
> JIM_REFERENCE_TAGLEN
)
11120 tagLen
= JIM_REFERENCE_TAGLEN
;
11121 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
11122 if (i
< tagLen
&& isrefchar(tag
[i
]))
11123 refPtr
->tag
[i
] = tag
[i
];
11125 refPtr
->tag
[i
] = '_';
11127 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
11131 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11133 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
11135 return objPtr
->internalRep
.refValue
.refPtr
;
11138 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
11140 Jim_Reference
*refPtr
;
11142 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
11144 Jim_IncrRefCount(cmdNamePtr
);
11145 if (refPtr
->finalizerCmdNamePtr
)
11146 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
11147 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
11151 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
11153 Jim_Reference
*refPtr
;
11155 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
11157 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
11161 /* -----------------------------------------------------------------------------
11162 * References Garbage Collection
11163 * ---------------------------------------------------------------------------*/
11165 /* This the hash table type for the "MARK" phase of the GC */
11166 static const Jim_HashTableType JimRefMarkHashTableType
= {
11167 JimReferencesHTHashFunction
, /* hash function */
11168 JimReferencesHTKeyDup
, /* key dup */
11169 NULL
, /* val dup */
11170 JimReferencesHTKeyCompare
, /* key compare */
11171 JimReferencesHTKeyDestructor
, /* key destructor */
11172 NULL
/* val destructor */
11175 /* Performs the garbage collection. */
11176 int Jim_Collect(Jim_Interp
*interp
)
11178 Jim_HashTable marks
;
11179 Jim_HashTableIterator
*htiter
;
11184 /* Avoid recursive calls */
11185 if (interp
->lastCollectId
== -1) {
11186 /* Jim_Collect() already running. Return just now. */
11189 interp
->lastCollectId
= -1;
11191 /* Mark all the references found into the 'mark' hash table.
11192 * The references are searched in every live object that
11193 * is of a type that can contain references. */
11194 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
11195 objPtr
= interp
->liveList
;
11197 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
11198 const char *str
, *p
;
11201 /* If the object is of type reference, to get the
11202 * Id is simple... */
11203 if (objPtr
->typePtr
== &referenceObjType
) {
11204 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
11205 #ifdef JIM_DEBUG_GC
11206 printf("MARK (reference): %d refcount: %d" JIM_NL
,
11207 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
11209 objPtr
= objPtr
->nextObjPtr
;
11212 /* Get the string repr of the object we want
11213 * to scan for references. */
11214 p
= str
= Jim_GetString(objPtr
, &len
);
11215 /* Skip objects too little to contain references. */
11216 if (len
< JIM_REFERENCE_SPACE
) {
11217 objPtr
= objPtr
->nextObjPtr
;
11220 /* Extract references from the object string repr. */
11226 if ((p
= strstr(p
, "<reference.<")) == NULL
)
11228 /* Check if it's a valid reference. */
11229 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
11231 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
11233 for (i
= 21; i
<= 40; i
++)
11234 if (!isdigit(UCHAR(p
[i
])))
11237 memcpy(buf
, p
+ 21, 20);
11239 Jim_StringToWide(buf
, &id
, 10);
11241 /* Ok, a reference for the given ID
11242 * was found. Mark it. */
11243 Jim_AddHashEntry(&marks
, &id
, NULL
);
11244 #ifdef JIM_DEBUG_GC
11245 printf("MARK: %d" JIM_NL
, (int)id
);
11247 p
+= JIM_REFERENCE_SPACE
;
11250 objPtr
= objPtr
->nextObjPtr
;
11253 /* Run the references hash table to destroy every reference that
11254 * is not referenced outside (not present in the mark HT). */
11255 htiter
= Jim_GetHashTableIterator(&interp
->references
);
11256 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
11257 const jim_wide
*refId
;
11258 Jim_Reference
*refPtr
;
11261 /* Check if in the mark phase we encountered
11262 * this reference. */
11263 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
11264 #ifdef JIM_DEBUG_GC
11265 printf("COLLECTING %d" JIM_NL
, (int)*refId
);
11268 /* Drop the reference, but call the
11269 * finalizer first if registered. */
11270 refPtr
= he
->u
.val
;
11271 if (refPtr
->finalizerCmdNamePtr
) {
11272 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
11273 Jim_Obj
*objv
[3], *oldResult
;
11275 JimFormatReference(refstr
, refPtr
, *refId
);
11277 objv
[0] = refPtr
->finalizerCmdNamePtr
;
11278 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, 32);
11279 objv
[2] = refPtr
->objPtr
;
11280 Jim_IncrRefCount(objv
[0]);
11281 Jim_IncrRefCount(objv
[1]);
11282 Jim_IncrRefCount(objv
[2]);
11284 /* Drop the reference itself */
11285 Jim_DeleteHashEntry(&interp
->references
, refId
);
11287 /* Call the finalizer. Errors ignored. */
11288 oldResult
= interp
->result
;
11289 Jim_IncrRefCount(oldResult
);
11290 Jim_EvalObjVector(interp
, 3, objv
);
11291 Jim_SetResult(interp
, oldResult
);
11292 Jim_DecrRefCount(interp
, oldResult
);
11294 Jim_DecrRefCount(interp
, objv
[0]);
11295 Jim_DecrRefCount(interp
, objv
[1]);
11296 Jim_DecrRefCount(interp
, objv
[2]);
11299 Jim_DeleteHashEntry(&interp
->references
, refId
);
11303 Jim_FreeHashTableIterator(htiter
);
11304 Jim_FreeHashTable(&marks
);
11305 interp
->lastCollectId
= interp
->referenceNextId
;
11306 interp
->lastCollectTime
= time(NULL
);
11310 #define JIM_COLLECT_ID_PERIOD 5000
11311 #define JIM_COLLECT_TIME_PERIOD 300
11313 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
11315 jim_wide elapsedId
;
11318 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
11319 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
11322 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
11323 Jim_Collect(interp
);
11328 static int JimIsBigEndian(void)
11332 unsigned char c
[2];
11335 return uval
.c
[0] == 1;
11338 /* -----------------------------------------------------------------------------
11339 * Interpreter related functions
11340 * ---------------------------------------------------------------------------*/
11342 Jim_Interp
*Jim_CreateInterp(void)
11344 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
11346 memset(i
, 0, sizeof(*i
));
11348 i
->errorFileName
= Jim_StrDup("");
11349 i
->maxNestingDepth
= JIM_MAX_NESTING_DEPTH
;
11350 i
->lastCollectTime
= time(NULL
);
11352 /* Note that we can create objects only after the
11353 * interpreter liveList and freeList pointers are
11354 * initialized to NULL. */
11355 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
11356 #ifdef JIM_REFERENCES
11357 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
11359 Jim_InitHashTable(&i
->sharedStrings
, &JimSharedStringsHashTableType
, NULL
);
11360 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
11361 Jim_InitHashTable(&i
->packages
, &JimStringKeyValCopyHashTableType
, NULL
);
11362 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
);
11363 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
11364 i
->trueObj
= Jim_NewIntObj(i
, 1);
11365 i
->falseObj
= Jim_NewIntObj(i
, 0);
11366 i
->result
= i
->emptyObj
;
11367 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
11368 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
11369 i
->errorProc
= i
->emptyObj
;
11370 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
11371 Jim_IncrRefCount(i
->emptyObj
);
11372 Jim_IncrRefCount(i
->result
);
11373 Jim_IncrRefCount(i
->stackTrace
);
11374 Jim_IncrRefCount(i
->unknown
);
11375 Jim_IncrRefCount(i
->currentScriptObj
);
11376 Jim_IncrRefCount(i
->errorProc
);
11377 Jim_IncrRefCount(i
->trueObj
);
11378 Jim_IncrRefCount(i
->falseObj
);
11380 /* Initialize key variables every interpreter should contain */
11381 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
11382 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
11384 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
11385 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
11386 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
11387 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
11388 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
11389 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
11390 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
11395 void Jim_FreeInterp(Jim_Interp
*i
)
11397 Jim_CallFrame
*cf
= i
->framePtr
, *prevcf
, *nextcf
;
11398 Jim_Obj
*objPtr
, *nextObjPtr
;
11400 Jim_DecrRefCount(i
, i
->emptyObj
);
11401 Jim_DecrRefCount(i
, i
->trueObj
);
11402 Jim_DecrRefCount(i
, i
->falseObj
);
11403 Jim_DecrRefCount(i
, i
->result
);
11404 Jim_DecrRefCount(i
, i
->stackTrace
);
11405 Jim_DecrRefCount(i
, i
->errorProc
);
11406 Jim_DecrRefCount(i
, i
->unknown
);
11407 Jim_Free((void *)i
->errorFileName
);
11408 Jim_DecrRefCount(i
, i
->currentScriptObj
);
11409 Jim_FreeHashTable(&i
->commands
);
11410 #ifdef JIM_REFERENCES
11411 Jim_FreeHashTable(&i
->references
);
11413 Jim_FreeHashTable(&i
->packages
);
11414 Jim_Free(i
->prngState
);
11415 Jim_FreeHashTable(&i
->assocData
);
11416 JimDeleteLocalProcs(i
);
11418 /* Free the call frames list */
11420 prevcf
= cf
->parentCallFrame
;
11421 JimFreeCallFrame(i
, cf
, JIM_FCF_NONE
);
11424 /* Check that the live object list is empty, otherwise
11425 * there is a memory leak. */
11426 if (i
->liveList
!= NULL
) {
11427 objPtr
= i
->liveList
;
11429 printf(JIM_NL
"-------------------------------------" JIM_NL
);
11430 printf("Objects still in the free list:" JIM_NL
);
11432 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
11434 printf("%p (%d) %-10s: '%.20s'" JIM_NL
,
11435 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
11436 if (objPtr
->typePtr
== &sourceObjType
) {
11437 printf("FILE %s LINE %d" JIM_NL
,
11438 objPtr
->internalRep
.sourceValue
.fileName
,
11439 objPtr
->internalRep
.sourceValue
.lineNumber
);
11441 objPtr
= objPtr
->nextObjPtr
;
11443 printf("-------------------------------------" JIM_NL JIM_NL
);
11444 JimPanic((1, i
, "Live list non empty freeing the interpreter! Leak?"));
11446 /* Free all the freed objects. */
11447 objPtr
= i
->freeList
;
11449 nextObjPtr
= objPtr
->nextObjPtr
;
11451 objPtr
= nextObjPtr
;
11453 /* Free cached CallFrame structures */
11454 cf
= i
->freeFramesList
;
11456 nextcf
= cf
->nextFramePtr
;
11457 if (cf
->vars
.table
!= NULL
)
11458 Jim_Free(cf
->vars
.table
);
11462 #ifdef jim_ext_load
11463 Jim_FreeLoadHandles(i
);
11466 /* Free the sharedString hash table. Make sure to free it
11467 * after every other Jim_Object was freed. */
11468 Jim_FreeHashTable(&i
->sharedStrings
);
11469 /* Free the interpreter structure. */
11473 /* Returns the call frame relative to the level represented by
11474 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
11476 * This function accepts the 'level' argument in the form
11477 * of the commands [uplevel] and [upvar].
11479 * For a function accepting a relative integer as level suitable
11480 * for implementation of [info level ?level?] check the
11481 * JimGetCallFrameByInteger() function.
11483 * Returns NULL on error.
11485 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
11489 Jim_CallFrame
*framePtr
;
11492 str
= Jim_String(levelObjPtr
);
11493 if (str
[0] == '#') {
11496 level
= strtol(str
+ 1, &endptr
, 0);
11497 if (str
[1] == '\0' || endptr
[0] != '\0') {
11502 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
11506 /* Convert from a relative to an absolute level */
11507 level
= interp
->framePtr
->level
- level
;
11512 str
= "1"; /* Needed to format the error message. */
11513 level
= interp
->framePtr
->level
- 1;
11517 return interp
->topFramePtr
;
11521 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parentCallFrame
) {
11522 if (framePtr
->level
== level
) {
11528 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
11532 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
11533 * as a relative integer like in the [info level ?level?] command.
11535 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
11538 Jim_CallFrame
*framePtr
;
11540 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
11542 /* Convert from a relative to an absolute level */
11543 level
= interp
->framePtr
->level
+ level
;
11547 return interp
->topFramePtr
;
11551 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parentCallFrame
) {
11552 if (framePtr
->level
== level
) {
11558 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11562 static void JimSetErrorFileName(Jim_Interp
*interp
, const char *filename
)
11564 Jim_Free((void *)interp
->errorFileName
);
11565 interp
->errorFileName
= Jim_StrDup(filename
);
11568 static void JimSetErrorLineNumber(Jim_Interp
*interp
, int linenr
)
11570 interp
->errorLine
= linenr
;
11573 static void JimResetStackTrace(Jim_Interp
*interp
)
11575 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11576 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
11577 Jim_IncrRefCount(interp
->stackTrace
);
11580 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
11584 /* Increment reference first in case these are the same object */
11585 Jim_IncrRefCount(stackTraceObj
);
11586 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11587 interp
->stackTrace
= stackTraceObj
;
11588 interp
->errorFlag
= 1;
11590 /* This is a bit ugly.
11591 * If the filename of the last entry of the stack trace is empty,
11592 * the next stack level should be added.
11594 len
= Jim_ListLength(interp
, interp
->stackTrace
);
11596 Jim_Obj
*filenameObj
;
11598 Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
, JIM_NONE
);
11600 Jim_GetString(filenameObj
, &len
);
11603 interp
->addStackTrace
= 1;
11608 /* Returns 1 if the stack trace information was used or 0 if not */
11609 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
11610 const char *filename
, int linenr
)
11612 if (strcmp(procname
, "unknown") == 0) {
11615 if (!*procname
&& !*filename
) {
11616 /* No useful info here */
11620 if (Jim_IsShared(interp
->stackTrace
)) {
11621 Jim_DecrRefCount(interp
, interp
->stackTrace
);
11622 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
11623 Jim_IncrRefCount(interp
->stackTrace
);
11626 /* If we have no procname but the previous element did, merge with that frame */
11627 if (!*procname
&& *filename
) {
11628 /* Just a filename. Check the previous entry */
11629 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
11632 Jim_Obj
*procnameObj
;
11633 Jim_Obj
*filenameObj
;
11635 if (Jim_ListIndex(interp
, interp
->stackTrace
, len
- 3, &procnameObj
, JIM_NONE
) == JIM_OK
11636 && Jim_ListIndex(interp
, interp
->stackTrace
, len
- 2, &filenameObj
,
11637 JIM_NONE
) == JIM_OK
) {
11639 const char *prev_procname
= Jim_String(procnameObj
);
11640 const char *prev_filename
= Jim_String(filenameObj
);
11642 if (*prev_procname
&& !*prev_filename
) {
11643 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, Jim_NewStringObj(interp
,
11645 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
),
11653 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
11654 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, filename
, -1));
11655 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
11658 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
11661 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
11663 assocEntryPtr
->delProc
= delProc
;
11664 assocEntryPtr
->data
= data
;
11665 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
11668 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
11670 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
11672 if (entryPtr
!= NULL
) {
11673 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) entryPtr
->u
.val
;
11675 return assocEntryPtr
->data
;
11680 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
11682 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
11685 int Jim_GetExitCode(Jim_Interp
*interp
)
11687 return interp
->exitCode
;
11690 /* -----------------------------------------------------------------------------
11692 * Every interpreter has an hash table where to put shared dynamically
11693 * allocate strings that are likely to be used a lot of times.
11694 * For example, in the 'source' object type, there is a pointer to
11695 * the filename associated with that object. Every script has a lot
11696 * of this objects with the identical file name, so it is wise to share
11699 * The API is trivial: Jim_GetSharedString(interp, "foobar")
11700 * returns the pointer to the shared string. Every time a reference
11701 * to the string is no longer used, the user should call
11702 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
11703 * a given string, it is removed from the hash table.
11704 * ---------------------------------------------------------------------------*/
11705 const char *Jim_GetSharedString(Jim_Interp
*interp
, const char *str
)
11707 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
11710 char *strCopy
= Jim_StrDup(str
);
11712 Jim_AddHashEntry(&interp
->sharedStrings
, strCopy
, NULL
);
11713 he
= Jim_FindHashEntry(&interp
->sharedStrings
, strCopy
);
11723 void Jim_ReleaseSharedString(Jim_Interp
*interp
, const char *str
)
11725 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->sharedStrings
, str
);
11727 JimPanic((he
== NULL
, interp
, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str
));
11729 if (--he
->u
.intval
== 0) {
11730 Jim_DeleteHashEntry(&interp
->sharedStrings
, str
);
11734 /* -----------------------------------------------------------------------------
11736 * ---------------------------------------------------------------------------*/
11737 #define JIM_INTEGER_SPACE 24
11739 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
11740 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
11742 static const Jim_ObjType intObjType
= {
11750 /* A coerced double is closer to an int than a double.
11751 * It is an int value temporarily masquerading as a double value.
11752 * i.e. it has the same string value as an int and Jim_GetWide()
11753 * succeeds, but also Jim_GetDouble() returns the value directly.
11755 static const Jim_ObjType coercedDoubleObjType
= {
11764 void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
11767 char buf
[JIM_INTEGER_SPACE
+ 1];
11769 len
= Jim_WideToString(buf
, JimWideValue(objPtr
));
11770 objPtr
->bytes
= Jim_Alloc(len
+ 1);
11771 memcpy(objPtr
->bytes
, buf
, len
+ 1);
11772 objPtr
->length
= len
;
11775 int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11777 jim_wide wideValue
;
11780 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11781 /* Simple switcheroo */
11782 objPtr
->typePtr
= &intObjType
;
11786 /* Get the string representation */
11787 str
= Jim_String(objPtr
);
11788 /* Try to convert into a jim_wide */
11789 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
11790 if (flags
& JIM_ERRMSG
) {
11791 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
11795 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
11796 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
11799 /* Free the old internal repr and set the new one. */
11800 Jim_FreeIntRep(interp
, objPtr
);
11801 objPtr
->typePtr
= &intObjType
;
11802 objPtr
->internalRep
.wideValue
= wideValue
;
11806 #ifdef JIM_OPTIMIZATION
11807 static int JimIsWide(Jim_Obj
*objPtr
)
11809 return objPtr
->typePtr
== &intObjType
;
11813 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
11815 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
11817 *widePtr
= JimWideValue(objPtr
);
11821 /* Get a wide but does not set an error if the format is bad. */
11822 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
11824 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
11826 *widePtr
= JimWideValue(objPtr
);
11830 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
11832 jim_wide wideValue
;
11835 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
11836 if (retval
== JIM_OK
) {
11837 *longPtr
= (long)wideValue
;
11843 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
11847 objPtr
= Jim_NewObj(interp
);
11848 objPtr
->typePtr
= &intObjType
;
11849 objPtr
->bytes
= NULL
;
11850 objPtr
->internalRep
.wideValue
= wideValue
;
11854 /* -----------------------------------------------------------------------------
11856 * ---------------------------------------------------------------------------*/
11857 #define JIM_DOUBLE_SPACE 30
11859 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
11860 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
11862 static const Jim_ObjType doubleObjType
= {
11866 UpdateStringOfDouble
,
11870 void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
11873 char buf
[JIM_DOUBLE_SPACE
+ 1];
11875 len
= Jim_DoubleToString(buf
, objPtr
->internalRep
.doubleValue
);
11876 objPtr
->bytes
= Jim_Alloc(len
+ 1);
11877 memcpy(objPtr
->bytes
, buf
, len
+ 1);
11878 objPtr
->length
= len
;
11881 int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11883 double doubleValue
;
11884 jim_wide wideValue
;
11887 /* Preserve the string representation.
11888 * Needed so we can convert back to int without loss
11890 str
= Jim_String(objPtr
);
11892 #ifdef HAVE_LONG_LONG
11893 /* Assume a 53 bit mantissa */
11894 #define MIN_INT_IN_DOUBLE -(1LL << 53)
11895 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
11897 if (objPtr
->typePtr
== &intObjType
11898 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
11899 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
11901 /* Direct conversion to coerced double */
11902 objPtr
->typePtr
= &coercedDoubleObjType
;
11907 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
11908 /* Managed to convert to an int, so we can use this as a cooerced double */
11909 Jim_FreeIntRep(interp
, objPtr
);
11910 objPtr
->typePtr
= &coercedDoubleObjType
;
11911 objPtr
->internalRep
.wideValue
= wideValue
;
11915 /* Try to convert into a double */
11916 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
11917 Jim_SetResultFormatted(interp
, "expected number but got \"%#s\"", objPtr
);
11920 /* Free the old internal repr and set the new one. */
11921 Jim_FreeIntRep(interp
, objPtr
);
11923 objPtr
->typePtr
= &doubleObjType
;
11924 objPtr
->internalRep
.doubleValue
= doubleValue
;
11928 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
11930 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11931 *doublePtr
= JimWideValue(objPtr
);
11934 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
11937 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
11938 *doublePtr
= JimWideValue(objPtr
);
11941 *doublePtr
= objPtr
->internalRep
.doubleValue
;
11946 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
11950 objPtr
= Jim_NewObj(interp
);
11951 objPtr
->typePtr
= &doubleObjType
;
11952 objPtr
->bytes
= NULL
;
11953 objPtr
->internalRep
.doubleValue
= doubleValue
;
11957 /* -----------------------------------------------------------------------------
11959 * ---------------------------------------------------------------------------*/
11960 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
11961 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
11962 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
11963 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
11964 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
11966 /* Note that while the elements of the list may contain references,
11967 * the list object itself can't. This basically means that the
11968 * list object string representation as a whole can't contain references
11969 * that are not presents in the single elements. */
11970 static const Jim_ObjType listObjType
= {
11972 FreeListInternalRep
,
11973 DupListInternalRep
,
11974 UpdateStringOfList
,
11978 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
11982 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
11983 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
11985 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
11988 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
11992 JIM_NOTUSED(interp
);
11994 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
11995 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
11996 dupPtr
->internalRep
.listValue
.ele
=
11997 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
11998 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
11999 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
12000 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
12001 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
12003 dupPtr
->typePtr
= &listObjType
;
12006 /* The following function checks if a given string can be encoded
12007 * into a list element without any kind of quoting, surrounded by braces,
12008 * or using escapes to quote. */
12009 #define JIM_ELESTR_SIMPLE 0
12010 #define JIM_ELESTR_BRACE 1
12011 #define JIM_ELESTR_QUOTE 2
12012 static int ListElementQuotingType(const char *s
, int len
)
12014 int i
, level
, blevel
, trySimple
= 1;
12016 /* Try with the SIMPLE case */
12018 return JIM_ELESTR_BRACE
;
12020 return JIM_ELESTR_BRACE
;
12021 if (s
[0] == '"' || s
[0] == '{') {
12025 for (i
= 0; i
< len
; i
++) {
12045 return JIM_ELESTR_SIMPLE
;
12048 /* Test if it's possible to do with braces */
12049 if (s
[len
- 1] == '\\')
12050 return JIM_ELESTR_QUOTE
;
12053 for (i
= 0; i
< len
; i
++) {
12061 return JIM_ELESTR_QUOTE
;
12070 if (s
[i
+ 1] == '\n')
12071 return JIM_ELESTR_QUOTE
;
12072 else if (s
[i
+ 1] != '\0')
12078 return JIM_ELESTR_QUOTE
;
12083 return JIM_ELESTR_BRACE
;
12084 for (i
= 0; i
< len
; i
++) {
12098 return JIM_ELESTR_BRACE
;
12102 return JIM_ELESTR_SIMPLE
;
12104 return JIM_ELESTR_QUOTE
;
12107 /* Returns the malloc-ed representation of a string
12108 * using backslash to quote special chars. */
12109 static char *BackslashQuoteString(const char *s
, int len
, int *qlenPtr
)
12111 char *q
= Jim_Alloc(len
* 2 + 1), *p
;
12163 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
12165 int i
, bufLen
, realLength
;
12166 const char *strRep
;
12169 Jim_Obj
**ele
= objPtr
->internalRep
.listValue
.ele
;
12171 /* (Over) Estimate the space needed. */
12172 quotingType
= Jim_Alloc(sizeof(int) * objPtr
->internalRep
.listValue
.len
+ 1);
12174 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
12177 strRep
= Jim_GetString(ele
[i
], &len
);
12178 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
12179 switch (quotingType
[i
]) {
12180 case JIM_ELESTR_SIMPLE
:
12183 case JIM_ELESTR_BRACE
:
12186 case JIM_ELESTR_QUOTE
:
12190 bufLen
++; /* elements separator. */
12194 /* Generate the string rep. */
12195 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
12197 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
12201 strRep
= Jim_GetString(ele
[i
], &len
);
12203 switch (quotingType
[i
]) {
12204 case JIM_ELESTR_SIMPLE
:
12205 memcpy(p
, strRep
, len
);
12209 case JIM_ELESTR_BRACE
:
12211 memcpy(p
, strRep
, len
);
12214 realLength
+= len
+ 2;
12216 case JIM_ELESTR_QUOTE
:
12217 q
= BackslashQuoteString(strRep
, len
, &qlen
);
12218 memcpy(p
, q
, qlen
);
12221 realLength
+= qlen
;
12224 /* Add a separating space */
12225 if (i
+ 1 != objPtr
->internalRep
.listValue
.len
) {
12230 *p
= '\0'; /* nul term. */
12231 objPtr
->length
= realLength
;
12232 Jim_Free(quotingType
);
12235 int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
12237 struct JimParserCtx parser
;
12240 const char *filename
= NULL
;
12243 /* Try to preserve information about filename / line number */
12244 if (objPtr
->typePtr
== &sourceObjType
) {
12245 filename
= Jim_GetSharedString(interp
, objPtr
->internalRep
.sourceValue
.fileName
);
12246 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
12249 /* Get the string representation */
12250 str
= Jim_GetString(objPtr
, &strLen
);
12252 /* Free the old internal repr just now and initialize the
12253 * new one just now. The string->list conversion can't fail. */
12254 Jim_FreeIntRep(interp
, objPtr
);
12255 objPtr
->typePtr
= &listObjType
;
12256 objPtr
->internalRep
.listValue
.len
= 0;
12257 objPtr
->internalRep
.listValue
.maxLen
= 0;
12258 objPtr
->internalRep
.listValue
.ele
= NULL
;
12260 /* Convert into a list */
12261 JimParserInit(&parser
, str
, strLen
, linenr
);
12262 while (!parser
.eof
) {
12263 Jim_Obj
*elementPtr
;
12265 JimParseList(&parser
);
12266 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
12268 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
12269 JimSetSourceInfo(interp
, elementPtr
, filename
, parser
.tline
);
12270 ListAppendElement(objPtr
, elementPtr
);
12273 Jim_ReleaseSharedString(interp
, filename
);
12278 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
12283 objPtr
= Jim_NewObj(interp
);
12284 objPtr
->typePtr
= &listObjType
;
12285 objPtr
->bytes
= NULL
;
12286 objPtr
->internalRep
.listValue
.ele
= NULL
;
12287 objPtr
->internalRep
.listValue
.len
= 0;
12288 objPtr
->internalRep
.listValue
.maxLen
= 0;
12289 for (i
= 0; i
< len
; i
++) {
12290 ListAppendElement(objPtr
, elements
[i
]);
12295 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
12296 * length of the vector. Note that the user of this function should make
12297 * sure that the list object can't shimmer while the vector returned
12298 * is in use, this vector is the one stored inside the internal representation
12299 * of the list object. This function is not exported, extensions should
12300 * always access to the List object elements using Jim_ListIndex(). */
12301 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
12302 Jim_Obj
***listVec
)
12304 *listLen
= Jim_ListLength(interp
, listObj
);
12305 *listVec
= listObj
->internalRep
.listValue
.ele
;
12308 /* Sorting uses ints, but commands may return wide */
12309 static int JimSign(jim_wide w
)
12320 /* ListSortElements type values */
12321 struct lsort_info
{
12324 Jim_Interp
*interp
;
12334 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
12337 static struct lsort_info
*sort_info
;
12339 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12341 Jim_Obj
*lObj
, *rObj
;
12343 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
12344 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
12345 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
12347 return sort_info
->subfn(&lObj
, &rObj
);
12350 /* Sort the internal rep of a list. */
12351 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12353 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
12356 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12358 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
12361 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12363 jim_wide lhs
= 0, rhs
= 0;
12365 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
12366 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
12367 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
12370 return JimSign(lhs
- rhs
) * sort_info
->order
;
12373 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
12375 Jim_Obj
*compare_script
;
12380 /* This must be a valid list */
12381 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
12382 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
12383 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
12385 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
12387 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
12388 longjmp(sort_info
->jmpbuf
, rc
);
12391 return JimSign(ret
) * sort_info
->order
;
12394 /* Sort a list *in place*. MUST be called with non-shared objects. */
12395 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
12397 struct lsort_info
*prev_info
;
12399 typedef int (qsort_comparator
) (const void *, const void *);
12400 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
12405 JimPanic((Jim_IsShared(listObjPtr
), interp
, "Jim_ListSortElements called with shared object"));
12406 if (!Jim_IsList(listObjPtr
))
12407 SetListFromAny(interp
, listObjPtr
);
12409 /* Allow lsort to be called reentrantly */
12410 prev_info
= sort_info
;
12413 vector
= listObjPtr
->internalRep
.listValue
.ele
;
12414 len
= listObjPtr
->internalRep
.listValue
.len
;
12415 switch (info
->type
) {
12416 case JIM_LSORT_ASCII
:
12417 fn
= ListSortString
;
12419 case JIM_LSORT_NOCASE
:
12420 fn
= ListSortStringNoCase
;
12422 case JIM_LSORT_INTEGER
:
12423 fn
= ListSortInteger
;
12425 case JIM_LSORT_COMMAND
:
12426 fn
= ListSortCommand
;
12429 fn
= NULL
; /* avoid warning */
12430 JimPanic((1, interp
, "ListSort called with invalid sort type"));
12433 if (info
->indexed
) {
12434 /* Need to interpose a "list index" function */
12436 fn
= ListSortIndexHelper
;
12439 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
12440 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
12442 Jim_InvalidateStringRep(listObjPtr
);
12443 sort_info
= prev_info
;
12448 /* This is the low-level function to insert elements into a list.
12449 * The higher-level Jim_ListInsertElements() performs shared object
12450 * check and invalidate the string repr. This version is used
12451 * in the internals of the List Object and is not exported.
12453 * NOTE: this function can be called only against objects
12454 * with internal type of List. */
12455 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
12457 int currentLen
= listPtr
->internalRep
.listValue
.len
;
12458 int requiredLen
= currentLen
+ elemc
;
12462 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
12463 int maxLen
= requiredLen
* 2;
12465 listPtr
->internalRep
.listValue
.ele
=
12466 Jim_Realloc(listPtr
->internalRep
.listValue
.ele
, sizeof(Jim_Obj
*) * maxLen
);
12467 listPtr
->internalRep
.listValue
.maxLen
= maxLen
;
12469 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
12470 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
12471 for (i
= 0; i
< elemc
; ++i
) {
12472 point
[i
] = elemVec
[i
];
12473 Jim_IncrRefCount(point
[i
]);
12475 listPtr
->internalRep
.listValue
.len
+= elemc
;
12478 /* Convenience call to ListInsertElements() to append a single element.
12480 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
12482 ListInsertElements(listPtr
, listPtr
->internalRep
.listValue
.len
, 1, &objPtr
);
12486 /* Appends every element of appendListPtr into listPtr.
12487 * Both have to be of the list type.
12488 * Convenience call to ListInsertElements()
12490 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
12492 ListInsertElements(listPtr
, listPtr
->internalRep
.listValue
.len
,
12493 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
12496 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
12498 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListAppendElement called with shared object"));
12499 if (!Jim_IsList(listPtr
))
12500 SetListFromAny(interp
, listPtr
);
12501 Jim_InvalidateStringRep(listPtr
);
12502 ListAppendElement(listPtr
, objPtr
);
12505 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
12507 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListAppendList called with shared object"));
12508 if (!Jim_IsList(listPtr
))
12509 SetListFromAny(interp
, listPtr
);
12510 Jim_InvalidateStringRep(listPtr
);
12511 ListAppendList(listPtr
, appendListPtr
);
12514 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
12516 if (!Jim_IsList(objPtr
))
12517 SetListFromAny(interp
, objPtr
);
12518 return objPtr
->internalRep
.listValue
.len
;
12521 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
12522 int objc
, Jim_Obj
*const *objVec
)
12524 JimPanic((Jim_IsShared(listPtr
), interp
, "Jim_ListInsertElement called with shared object"));
12525 if (!Jim_IsList(listPtr
))
12526 SetListFromAny(interp
, listPtr
);
12527 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
12528 idx
= listPtr
->internalRep
.listValue
.len
;
12531 Jim_InvalidateStringRep(listPtr
);
12532 ListInsertElements(listPtr
, idx
, objc
, objVec
);
12535 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
12537 if (!Jim_IsList(listPtr
))
12538 SetListFromAny(interp
, listPtr
);
12539 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
12540 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
12541 if (flags
& JIM_ERRMSG
) {
12542 Jim_SetResultString(interp
, "list index out of range", -1);
12548 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
12549 *objPtrPtr
= listPtr
->internalRep
.listValue
.ele
[idx
];
12553 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
12554 Jim_Obj
*newObjPtr
, int flags
)
12556 if (!Jim_IsList(listPtr
))
12557 SetListFromAny(interp
, listPtr
);
12558 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
12559 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
12560 if (flags
& JIM_ERRMSG
) {
12561 Jim_SetResultString(interp
, "list index out of range", -1);
12566 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
12567 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
12568 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
12569 Jim_IncrRefCount(newObjPtr
);
12573 /* Modify the list stored into the variable named 'varNamePtr'
12574 * setting the element specified by the 'indexc' indexes objects in 'indexv',
12575 * with the new element 'newObjptr'. */
12576 int Jim_SetListIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
12577 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
12579 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
12580 int shared
, i
, idx
;
12582 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
12583 if (objPtr
== NULL
)
12585 if ((shared
= Jim_IsShared(objPtr
)))
12586 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12587 for (i
= 0; i
< indexc
- 1; i
++) {
12588 listObjPtr
= objPtr
;
12589 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
12591 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
12594 if (Jim_IsShared(objPtr
)) {
12595 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
12596 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
12598 Jim_InvalidateStringRep(listObjPtr
);
12600 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
12602 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
12604 Jim_InvalidateStringRep(objPtr
);
12605 Jim_InvalidateStringRep(varObjPtr
);
12606 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
12608 Jim_SetResult(interp
, varObjPtr
);
12612 Jim_FreeNewObj(interp
, varObjPtr
);
12617 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
12621 /* If all the objects in objv are lists,
12622 * it's possible to return a list as result, that's the
12623 * concatenation of all the lists. */
12624 for (i
= 0; i
< objc
; i
++) {
12625 if (!Jim_IsList(objv
[i
]))
12629 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12631 for (i
= 0; i
< objc
; i
++)
12632 Jim_ListAppendList(interp
, objPtr
, objv
[i
]);
12636 /* Else... we have to glue strings together */
12637 int len
= 0, objLen
;
12640 /* Compute the length */
12641 for (i
= 0; i
< objc
; i
++) {
12642 Jim_GetString(objv
[i
], &objLen
);
12647 /* Create the string rep, and a string object holding it. */
12648 p
= bytes
= Jim_Alloc(len
+ 1);
12649 for (i
= 0; i
< objc
; i
++) {
12650 const char *s
= Jim_GetString(objv
[i
], &objLen
);
12652 /* Remove leading space */
12653 while (objLen
&& (*s
== ' ' || *s
== '\t' || *s
== '\n')) {
12658 /* And trailing space */
12659 while (objLen
&& (s
[objLen
- 1] == ' ' ||
12660 s
[objLen
- 1] == '\n' || s
[objLen
- 1] == '\t')) {
12661 /* Handle trailing backslash-space case */
12662 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
12668 memcpy(p
, s
, objLen
);
12670 if (objLen
&& i
+ 1 != objc
) {
12673 else if (i
+ 1 != objc
) {
12674 /* Drop the space calcuated for this
12675 * element that is instead null. */
12680 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
12684 /* Returns a list composed of the elements in the specified range.
12685 * first and start are directly accepted as Jim_Objects and
12686 * processed for the end?-index? case. */
12687 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
12688 Jim_Obj
*lastObjPtr
)
12693 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
12694 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
12696 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
12697 first
= JimRelToAbsIndex(len
, first
);
12698 last
= JimRelToAbsIndex(len
, last
);
12699 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
12700 if (first
== 0 && last
== len
) {
12703 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
12706 /* -----------------------------------------------------------------------------
12708 * ---------------------------------------------------------------------------*/
12709 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
12710 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
12711 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
12712 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
12714 /* Dict HashTable Type.
12716 * Keys and Values are Jim objects. */
12718 static unsigned int JimObjectHTHashFunction(const void *key
)
12721 Jim_Obj
*objPtr
= (Jim_Obj
*)key
;
12724 str
= Jim_GetString(objPtr
, &len
);
12725 h
= Jim_GenHashFunction((unsigned char *)str
, len
);
12729 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
12731 JIM_NOTUSED(privdata
);
12733 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
12736 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
12738 Jim_Obj
*objPtr
= val
;
12740 Jim_DecrRefCount(interp
, objPtr
);
12743 static const Jim_HashTableType JimDictHashTableType
= {
12744 JimObjectHTHashFunction
, /* hash function */
12745 NULL
, /* key dup */
12746 NULL
, /* val dup */
12747 JimObjectHTKeyCompare
, /* key compare */
12748 (void (*)(void *, const void *)) /* ATTENTION: const cast */
12749 JimObjectHTKeyValDestructor
, /* key destructor */
12750 JimObjectHTKeyValDestructor
/* val destructor */
12753 /* Note that while the elements of the dict may contain references,
12754 * the list object itself can't. This basically means that the
12755 * dict object string representation as a whole can't contain references
12756 * that are not presents in the single elements. */
12757 static const Jim_ObjType dictObjType
= {
12759 FreeDictInternalRep
,
12760 DupDictInternalRep
,
12761 UpdateStringOfDict
,
12765 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
12767 JIM_NOTUSED(interp
);
12769 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
12770 Jim_Free(objPtr
->internalRep
.ptr
);
12773 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
12775 Jim_HashTable
*ht
, *dupHt
;
12776 Jim_HashTableIterator
*htiter
;
12779 /* Create a new hash table */
12780 ht
= srcPtr
->internalRep
.ptr
;
12781 dupHt
= Jim_Alloc(sizeof(*dupHt
));
12782 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
12784 Jim_ExpandHashTable(dupHt
, ht
->size
);
12785 /* Copy every element from the source to the dup hash table */
12786 htiter
= Jim_GetHashTableIterator(ht
);
12787 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
12788 const Jim_Obj
*keyObjPtr
= he
->key
;
12789 Jim_Obj
*valObjPtr
= he
->u
.val
;
12791 Jim_IncrRefCount((Jim_Obj
*)keyObjPtr
); /* ATTENTION: const cast */
12792 Jim_IncrRefCount(valObjPtr
);
12793 Jim_AddHashEntry(dupHt
, keyObjPtr
, valObjPtr
);
12795 Jim_FreeHashTableIterator(htiter
);
12797 dupPtr
->internalRep
.ptr
= dupHt
;
12798 dupPtr
->typePtr
= &dictObjType
;
12801 void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
12803 int i
, bufLen
, realLength
;
12804 const char *strRep
;
12806 int *quotingType
, objc
;
12808 Jim_HashTableIterator
*htiter
;
12812 /* Trun the hash table into a flat vector of Jim_Objects. */
12813 ht
= objPtr
->internalRep
.ptr
;
12814 objc
= ht
->used
* 2;
12815 objv
= Jim_Alloc(objc
* sizeof(Jim_Obj
*));
12816 htiter
= Jim_GetHashTableIterator(ht
);
12818 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
12819 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
12820 objv
[i
++] = he
->u
.val
;
12822 Jim_FreeHashTableIterator(htiter
);
12823 /* (Over) Estimate the space needed. */
12824 quotingType
= Jim_Alloc(sizeof(int) * objc
);
12826 for (i
= 0; i
< objc
; i
++) {
12829 strRep
= Jim_GetString(objv
[i
], &len
);
12830 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
12831 switch (quotingType
[i
]) {
12832 case JIM_ELESTR_SIMPLE
:
12835 case JIM_ELESTR_BRACE
:
12838 case JIM_ELESTR_QUOTE
:
12842 bufLen
++; /* elements separator. */
12846 /* Generate the string rep. */
12847 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
12849 for (i
= 0; i
< objc
; i
++) {
12853 strRep
= Jim_GetString(objv
[i
], &len
);
12855 switch (quotingType
[i
]) {
12856 case JIM_ELESTR_SIMPLE
:
12857 memcpy(p
, strRep
, len
);
12861 case JIM_ELESTR_BRACE
:
12863 memcpy(p
, strRep
, len
);
12866 realLength
+= len
+ 2;
12868 case JIM_ELESTR_QUOTE
:
12869 q
= BackslashQuoteString(strRep
, len
, &qlen
);
12870 memcpy(p
, q
, qlen
);
12873 realLength
+= qlen
;
12876 /* Add a separating space */
12877 if (i
+ 1 != objc
) {
12882 *p
= '\0'; /* nul term. */
12883 objPtr
->length
= realLength
;
12884 Jim_Free(quotingType
);
12888 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
12892 /* Get the string representation. Do this first so we don't
12893 * change order in case of fast conversion to dict.
12895 Jim_String(objPtr
);
12897 /* For simplicity, convert a non-list object to a list and then to a dict */
12898 listlen
= Jim_ListLength(interp
, objPtr
);
12900 Jim_SetResultString(interp
,
12901 "invalid dictionary value: must be a list with an even number of elements", -1);
12905 /* Now it is easy to convert to a dict from a list, and it can't fail */
12909 ht
= Jim_Alloc(sizeof(*ht
));
12910 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
12912 for (i
= 0; i
< listlen
; i
+= 2) {
12913 Jim_Obj
*keyObjPtr
;
12914 Jim_Obj
*valObjPtr
;
12916 Jim_ListIndex(interp
, objPtr
, i
, &keyObjPtr
, JIM_NONE
);
12917 Jim_ListIndex(interp
, objPtr
, i
+ 1, &valObjPtr
, JIM_NONE
);
12919 Jim_IncrRefCount(keyObjPtr
);
12920 Jim_IncrRefCount(valObjPtr
);
12922 if (Jim_AddHashEntry(ht
, keyObjPtr
, valObjPtr
) != JIM_OK
) {
12925 he
= Jim_FindHashEntry(ht
, keyObjPtr
);
12926 Jim_DecrRefCount(interp
, keyObjPtr
);
12927 /* ATTENTION: const cast */
12928 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->u
.val
);
12929 he
->u
.val
= valObjPtr
;
12933 Jim_FreeIntRep(interp
, objPtr
);
12934 objPtr
->typePtr
= &dictObjType
;
12935 objPtr
->internalRep
.ptr
= ht
;
12941 /* Dict object API */
12943 /* Add an element to a dict. objPtr must be of the "dict" type.
12944 * The higer-level exported function is Jim_DictAddElement().
12945 * If an element with the specified key already exists, the value
12946 * associated is replaced with the new one.
12948 * if valueObjPtr == NULL, the key is instead removed if it exists. */
12949 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
12950 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
12952 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
12954 if (valueObjPtr
== NULL
) { /* unset */
12955 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
12957 Jim_IncrRefCount(keyObjPtr
);
12958 Jim_IncrRefCount(valueObjPtr
);
12959 if (Jim_AddHashEntry(ht
, keyObjPtr
, valueObjPtr
) != JIM_OK
) {
12960 Jim_HashEntry
*he
= Jim_FindHashEntry(ht
, keyObjPtr
);
12962 Jim_DecrRefCount(interp
, keyObjPtr
);
12963 /* ATTENTION: const cast */
12964 Jim_DecrRefCount(interp
, (Jim_Obj
*)he
->u
.val
);
12965 he
->u
.val
= valueObjPtr
;
12970 /* Add an element, higher-level interface for DictAddElement().
12971 * If valueObjPtr == NULL, the key is removed if it exists. */
12972 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
12973 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
12977 JimPanic((Jim_IsShared(objPtr
), interp
, "Jim_DictAddElement called with shared object"));
12978 if (objPtr
->typePtr
!= &dictObjType
) {
12979 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
)
12982 retcode
= DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
12983 Jim_InvalidateStringRep(objPtr
);
12987 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
12992 JimPanic((len
% 2, interp
, "Jim_NewDictObj() 'len' argument must be even"));
12994 objPtr
= Jim_NewObj(interp
);
12995 objPtr
->typePtr
= &dictObjType
;
12996 objPtr
->bytes
= NULL
;
12997 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
12998 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
12999 for (i
= 0; i
< len
; i
+= 2)
13000 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
13004 /* Return the value associated to the specified dict key
13005 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
13007 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
13008 Jim_Obj
**objPtrPtr
, int flags
)
13013 if (dictPtr
->typePtr
!= &dictObjType
) {
13014 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
13017 ht
= dictPtr
->internalRep
.ptr
;
13018 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
13019 if (flags
& JIM_ERRMSG
) {
13020 Jim_SetResultFormatted(interp
, "key \"%#s\" not found in dictionary", keyPtr
);
13024 *objPtrPtr
= he
->u
.val
;
13028 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
13029 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
13032 Jim_HashTableIterator
*htiter
;
13037 if (dictPtr
->typePtr
!= &dictObjType
) {
13038 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
)
13041 ht
= dictPtr
->internalRep
.ptr
;
13043 /* Turn the hash table into a flat vector of Jim_Objects. */
13044 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
13045 htiter
= Jim_GetHashTableIterator(ht
);
13047 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
13048 objv
[i
++] = (Jim_Obj
*)he
->key
; /* ATTENTION: const cast */
13049 objv
[i
++] = he
->u
.val
;
13052 Jim_FreeHashTableIterator(htiter
);
13058 /* Return the value associated to the specified dict keys */
13059 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
13060 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
13065 *objPtrPtr
= dictPtr
;
13069 for (i
= 0; i
< keyc
; i
++) {
13072 if (Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
)
13077 *objPtrPtr
= dictPtr
;
13081 /* Modify the dict stored into the variable named 'varNamePtr'
13082 * setting the element specified by the 'keyc' keys objects in 'keyv',
13083 * with the new value of the element 'newObjPtr'.
13085 * If newObjPtr == NULL the operation is to remove the given key
13086 * from the dictionary. */
13087 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
13088 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
)
13090 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
13093 varObjPtr
= objPtr
=
13094 Jim_GetVariable(interp
, varNamePtr
, newObjPtr
== NULL
? JIM_ERRMSG
: JIM_NONE
);
13095 if (objPtr
== NULL
) {
13096 if (newObjPtr
== NULL
) /* Cannot remove a key from non existing var */
13098 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
13099 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
13100 Jim_FreeNewObj(interp
, varObjPtr
);
13104 if ((shared
= Jim_IsShared(objPtr
)))
13105 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
13106 for (i
= 0; i
< keyc
- 1; i
++) {
13107 dictObjPtr
= objPtr
;
13109 /* Check if it's a valid dictionary */
13110 if (dictObjPtr
->typePtr
!= &dictObjType
) {
13111 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
)
13114 /* Check if the given key exists. */
13115 Jim_InvalidateStringRep(dictObjPtr
);
13116 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
13117 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
13118 /* This key exists at the current level.
13119 * Make sure it's not shared!. */
13120 if (Jim_IsShared(objPtr
)) {
13121 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
13122 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
13126 /* Key not found. If it's an [unset] operation
13127 * this is an error. Only the last key may not
13129 if (newObjPtr
== NULL
)
13131 /* Otherwise set an empty dictionary
13132 * as key's value. */
13133 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
13134 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
13137 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
13140 Jim_InvalidateStringRep(objPtr
);
13141 Jim_InvalidateStringRep(varObjPtr
);
13142 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
13144 Jim_SetResult(interp
, varObjPtr
);
13148 Jim_FreeNewObj(interp
, varObjPtr
);
13153 /* -----------------------------------------------------------------------------
13155 * ---------------------------------------------------------------------------*/
13156 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
13157 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
13159 static const Jim_ObjType indexObjType
= {
13163 UpdateStringOfIndex
,
13167 void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
13170 char buf
[JIM_INTEGER_SPACE
+ 1];
13172 if (objPtr
->internalRep
.indexValue
>= 0)
13173 len
= sprintf(buf
, "%d", objPtr
->internalRep
.indexValue
);
13174 else if (objPtr
->internalRep
.indexValue
== -1)
13175 len
= sprintf(buf
, "end");
13177 len
= sprintf(buf
, "end%d", objPtr
->internalRep
.indexValue
+ 1);
13179 objPtr
->bytes
= Jim_Alloc(len
+ 1);
13180 memcpy(objPtr
->bytes
, buf
, len
+ 1);
13181 objPtr
->length
= len
;
13184 int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
13190 /* Get the string representation */
13191 str
= Jim_String(objPtr
);
13193 /* Try to convert into an index */
13194 if (strncmp(str
, "end", 3) == 0) {
13200 idx
= strtol(str
, &endptr
, 10);
13202 if (endptr
== str
) {
13208 /* Now str may include or +<num> or -<num> */
13209 if (*str
== '+' || *str
== '-') {
13210 int sign
= (*str
== '+' ? 1 : -1);
13212 idx
+= sign
* strtol(++str
, &endptr
, 10);
13213 if (str
== endptr
|| *endptr
) {
13218 /* The only thing left should be spaces */
13219 while (isspace(UCHAR(*str
))) {
13230 /* end-1 is repesented as -2 */
13234 else if (idx
< 0) {
13238 /* Free the old internal repr and set the new one. */
13239 Jim_FreeIntRep(interp
, objPtr
);
13240 objPtr
->typePtr
= &indexObjType
;
13241 objPtr
->internalRep
.indexValue
= idx
;
13245 Jim_SetResultFormatted(interp
,
13246 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
13250 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
13252 /* Avoid shimmering if the object is an integer. */
13253 if (objPtr
->typePtr
== &intObjType
) {
13254 jim_wide val
= JimWideValue(objPtr
);
13256 if (!(val
< LONG_MIN
) && !(val
> LONG_MAX
)) {
13257 *indexPtr
= (val
< 0) ? -INT_MAX
: (long)val
;;
13261 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
13263 *indexPtr
= objPtr
->internalRep
.indexValue
;
13267 /* -----------------------------------------------------------------------------
13268 * Return Code Object.
13269 * ---------------------------------------------------------------------------*/
13271 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
13272 static const char * const jimReturnCodes
[] = {
13274 [JIM_ERR
] = "error",
13275 [JIM_RETURN
] = "return",
13276 [JIM_BREAK
] = "break",
13277 [JIM_CONTINUE
] = "continue",
13278 [JIM_SIGNAL
] = "signal",
13279 [JIM_EXIT
] = "exit",
13280 [JIM_EVAL
] = "eval",
13284 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
13286 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
13288 static const Jim_ObjType returnCodeObjType
= {
13296 /* Converts a (standard) return code to a string. Returns "?" for
13297 * non-standard return codes.
13299 const char *Jim_ReturnCode(int code
)
13301 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
13305 return jimReturnCodes
[code
];
13309 int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
13312 jim_wide wideValue
;
13314 /* Try to convert into an integer */
13315 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
13316 returnCode
= (int)wideValue
;
13317 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
13318 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
13321 /* Free the old internal repr and set the new one. */
13322 Jim_FreeIntRep(interp
, objPtr
);
13323 objPtr
->typePtr
= &returnCodeObjType
;
13324 objPtr
->internalRep
.returnCode
= returnCode
;
13328 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
13330 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
13332 *intPtr
= objPtr
->internalRep
.returnCode
;
13336 /* -----------------------------------------------------------------------------
13337 * Expression Parsing
13338 * ---------------------------------------------------------------------------*/
13339 static int JimParseExprOperator(struct JimParserCtx
*pc
);
13340 static int JimParseExprNumber(struct JimParserCtx
*pc
);
13341 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
13343 /* Exrp's Stack machine operators opcodes. */
13345 /* Binary operators (numbers) */
13348 /* Continues on from the JIM_TT_ space */
13350 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 15 */
13365 JIM_EXPROP_BITAND
, /* 30 */
13369 /* Note must keep these together */
13370 JIM_EXPROP_LOGICAND
, /* 33 */
13371 JIM_EXPROP_LOGICAND_LEFT
,
13372 JIM_EXPROP_LOGICAND_RIGHT
,
13375 JIM_EXPROP_LOGICOR
, /* 36 */
13376 JIM_EXPROP_LOGICOR_LEFT
,
13377 JIM_EXPROP_LOGICOR_RIGHT
,
13380 /* Ternary operators */
13381 JIM_EXPROP_TERNARY
, /* 39 */
13382 JIM_EXPROP_TERNARY_LEFT
,
13383 JIM_EXPROP_TERNARY_RIGHT
,
13386 JIM_EXPROP_COLON
, /* 42 */
13387 JIM_EXPROP_COLON_LEFT
,
13388 JIM_EXPROP_COLON_RIGHT
,
13390 JIM_EXPROP_POW
, /* 45 */
13392 /* Binary operators (strings) */
13398 /* Unary operators (numbers) */
13401 JIM_EXPROP_UNARYMINUS
,
13402 JIM_EXPROP_UNARYPLUS
,
13405 JIM_EXPROP_FUNC_FIRST
,
13406 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
13407 JIM_EXPROP_FUNC_ABS
,
13408 JIM_EXPROP_FUNC_DOUBLE
,
13409 JIM_EXPROP_FUNC_ROUND
,
13410 JIM_EXPROP_FUNC_RAND
,
13411 JIM_EXPROP_FUNC_SRAND
,
13413 #ifdef JIM_MATH_FUNCTIONS
13414 /* math functions from libm */
13415 JIM_EXPROP_FUNC_SIN
,
13416 JIM_EXPROP_FUNC_COS
,
13417 JIM_EXPROP_FUNC_TAN
,
13418 JIM_EXPROP_FUNC_ASIN
,
13419 JIM_EXPROP_FUNC_ACOS
,
13420 JIM_EXPROP_FUNC_ATAN
,
13421 JIM_EXPROP_FUNC_SINH
,
13422 JIM_EXPROP_FUNC_COSH
,
13423 JIM_EXPROP_FUNC_TANH
,
13424 JIM_EXPROP_FUNC_CEIL
,
13425 JIM_EXPROP_FUNC_FLOOR
,
13426 JIM_EXPROP_FUNC_EXP
,
13427 JIM_EXPROP_FUNC_LOG
,
13428 JIM_EXPROP_FUNC_LOG10
,
13429 JIM_EXPROP_FUNC_SQRT
,
13433 struct JimExprState
13441 /* Operators table */
13442 typedef struct Jim_ExprOperator
13447 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
13449 } Jim_ExprOperator
;
13451 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
13453 Jim_IncrRefCount(obj
);
13454 e
->stack
[e
->stacklen
++] = obj
;
13457 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
13459 return e
->stack
[--e
->stacklen
];
13462 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13466 Jim_Obj
*A
= ExprPop(e
);
13468 jim_wide wA
, wC
= 0;
13470 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
13473 switch (e
->opcode
) {
13474 case JIM_EXPROP_FUNC_INT
:
13477 case JIM_EXPROP_FUNC_ROUND
:
13480 case JIM_EXPROP_FUNC_DOUBLE
:
13484 case JIM_EXPROP_FUNC_ABS
:
13485 wC
= wA
>= 0 ? wA
: -wA
;
13487 case JIM_EXPROP_UNARYMINUS
:
13490 case JIM_EXPROP_UNARYPLUS
:
13493 case JIM_EXPROP_NOT
:
13500 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
13501 switch (e
->opcode
) {
13502 case JIM_EXPROP_FUNC_INT
:
13506 case JIM_EXPROP_FUNC_ROUND
:
13507 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
13510 case JIM_EXPROP_FUNC_DOUBLE
:
13513 case JIM_EXPROP_FUNC_ABS
:
13514 dC
= dA
>= 0 ? dA
: -dA
;
13516 case JIM_EXPROP_UNARYMINUS
:
13519 case JIM_EXPROP_UNARYPLUS
:
13522 case JIM_EXPROP_NOT
:
13531 if (rc
== JIM_OK
) {
13533 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13536 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13540 Jim_DecrRefCount(interp
, A
);
13545 static double JimRandDouble(Jim_Interp
*interp
)
13548 JimRandomBytes(interp
, &x
, sizeof(x
));
13550 return (double)x
/ (unsigned long)~0;
13553 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13555 Jim_Obj
*A
= ExprPop(e
);
13558 int rc
= Jim_GetWide(interp
, A
, &wA
);
13559 if (rc
== JIM_OK
) {
13560 switch (e
->opcode
) {
13561 case JIM_EXPROP_BITNOT
:
13562 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
13564 case JIM_EXPROP_FUNC_SRAND
:
13565 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
13566 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
13573 Jim_DecrRefCount(interp
, A
);
13578 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
13580 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
));
13582 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
13587 #ifdef JIM_MATH_FUNCTIONS
13588 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
13591 Jim_Obj
*A
= ExprPop(e
);
13594 rc
= Jim_GetDouble(interp
, A
, &dA
);
13595 if (rc
== JIM_OK
) {
13596 switch (e
->opcode
) {
13597 case JIM_EXPROP_FUNC_SIN
:
13600 case JIM_EXPROP_FUNC_COS
:
13603 case JIM_EXPROP_FUNC_TAN
:
13606 case JIM_EXPROP_FUNC_ASIN
:
13609 case JIM_EXPROP_FUNC_ACOS
:
13612 case JIM_EXPROP_FUNC_ATAN
:
13615 case JIM_EXPROP_FUNC_SINH
:
13618 case JIM_EXPROP_FUNC_COSH
:
13621 case JIM_EXPROP_FUNC_TANH
:
13624 case JIM_EXPROP_FUNC_CEIL
:
13627 case JIM_EXPROP_FUNC_FLOOR
:
13630 case JIM_EXPROP_FUNC_EXP
:
13633 case JIM_EXPROP_FUNC_LOG
:
13636 case JIM_EXPROP_FUNC_LOG10
:
13639 case JIM_EXPROP_FUNC_SQRT
:
13645 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13648 Jim_DecrRefCount(interp
, A
);
13654 /* A binary operation on two ints */
13655 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13657 Jim_Obj
*B
= ExprPop(e
);
13658 Jim_Obj
*A
= ExprPop(e
);
13662 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
13667 switch (e
->opcode
) {
13668 case JIM_EXPROP_LSHIFT
:
13671 case JIM_EXPROP_RSHIFT
:
13674 case JIM_EXPROP_BITAND
:
13677 case JIM_EXPROP_BITXOR
:
13680 case JIM_EXPROP_BITOR
:
13683 case JIM_EXPROP_MOD
:
13686 Jim_SetResultString(interp
, "Division by zero", -1);
13693 * This code is tricky: C doesn't guarantee much
13694 * about the quotient or remainder, but Tcl does.
13695 * The remainder always has the same sign as the
13696 * divisor and a smaller absolute value.
13714 case JIM_EXPROP_ROTL
:
13715 case JIM_EXPROP_ROTR
:{
13716 /* uint32_t would be better. But not everyone has inttypes.h? */
13717 unsigned long uA
= (unsigned long)wA
;
13718 unsigned long uB
= (unsigned long)wB
;
13719 const unsigned int S
= sizeof(unsigned long) * 8;
13721 /* Shift left by the word size or more is undefined. */
13724 if (e
->opcode
== JIM_EXPROP_ROTR
) {
13727 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
13733 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13737 Jim_DecrRefCount(interp
, A
);
13738 Jim_DecrRefCount(interp
, B
);
13744 /* A binary operation on two ints or two doubles (or two strings for some ops) */
13745 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13749 double dA
, dB
, dC
= 0;
13750 jim_wide wA
, wB
, wC
= 0;
13752 Jim_Obj
*B
= ExprPop(e
);
13753 Jim_Obj
*A
= ExprPop(e
);
13755 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
13756 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
13757 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
13759 /* Both are ints */
13763 switch (e
->opcode
) {
13764 case JIM_EXPROP_POW
:
13765 wC
= JimPowWide(wA
, wB
);
13767 case JIM_EXPROP_ADD
:
13770 case JIM_EXPROP_SUB
:
13773 case JIM_EXPROP_MUL
:
13776 case JIM_EXPROP_DIV
:
13778 Jim_SetResultString(interp
, "Division by zero", -1);
13785 * This code is tricky: C doesn't guarantee much
13786 * about the quotient or remainder, but Tcl does.
13787 * The remainder always has the same sign as the
13788 * divisor and a smaller absolute value.
13800 case JIM_EXPROP_LT
:
13803 case JIM_EXPROP_GT
:
13806 case JIM_EXPROP_LTE
:
13809 case JIM_EXPROP_GTE
:
13812 case JIM_EXPROP_NUMEQ
:
13815 case JIM_EXPROP_NUMNE
:
13822 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
13823 switch (e
->opcode
) {
13824 case JIM_EXPROP_POW
:
13825 #ifdef JIM_MATH_FUNCTIONS
13828 Jim_SetResultString(interp
, "unsupported", -1);
13832 case JIM_EXPROP_ADD
:
13835 case JIM_EXPROP_SUB
:
13838 case JIM_EXPROP_MUL
:
13841 case JIM_EXPROP_DIV
:
13844 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
13846 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
13853 case JIM_EXPROP_LT
:
13857 case JIM_EXPROP_GT
:
13861 case JIM_EXPROP_LTE
:
13865 case JIM_EXPROP_GTE
:
13869 case JIM_EXPROP_NUMEQ
:
13873 case JIM_EXPROP_NUMNE
:
13882 /* Handle the string case */
13884 /* REVISIT: Could optimise the eq/ne case by checking lengths */
13885 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
13889 switch (e
->opcode
) {
13890 case JIM_EXPROP_LT
:
13893 case JIM_EXPROP_GT
:
13896 case JIM_EXPROP_LTE
:
13899 case JIM_EXPROP_GTE
:
13902 case JIM_EXPROP_NUMEQ
:
13905 case JIM_EXPROP_NUMNE
:
13914 if (rc
== JIM_OK
) {
13916 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13919 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
13923 Jim_DecrRefCount(interp
, A
);
13924 Jim_DecrRefCount(interp
, B
);
13929 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
13934 listlen
= Jim_ListLength(interp
, listObjPtr
);
13935 for (i
= 0; i
< listlen
; i
++) {
13938 Jim_ListIndex(interp
, listObjPtr
, i
, &objPtr
, JIM_NONE
);
13940 if (Jim_StringEqObj(objPtr
, valObj
)) {
13947 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
13949 Jim_Obj
*B
= ExprPop(e
);
13950 Jim_Obj
*A
= ExprPop(e
);
13954 switch (e
->opcode
) {
13955 case JIM_EXPROP_STREQ
:
13956 case JIM_EXPROP_STRNE
: {
13958 const char *sA
= Jim_GetString(A
, &Alen
);
13959 const char *sB
= Jim_GetString(B
, &Blen
);
13961 if (e
->opcode
== JIM_EXPROP_STREQ
) {
13962 wC
= (Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0);
13965 wC
= (Alen
!= Blen
|| memcmp(sA
, sB
, Alen
) != 0);
13969 case JIM_EXPROP_STRIN
:
13970 wC
= JimSearchList(interp
, B
, A
);
13972 case JIM_EXPROP_STRNI
:
13973 wC
= !JimSearchList(interp
, B
, A
);
13978 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
13980 Jim_DecrRefCount(interp
, A
);
13981 Jim_DecrRefCount(interp
, B
);
13986 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
13991 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
13994 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
14000 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
14002 Jim_Obj
*skip
= ExprPop(e
);
14003 Jim_Obj
*A
= ExprPop(e
);
14006 switch (ExprBool(interp
, A
)) {
14008 /* false, so skip RHS opcodes with a 0 result */
14009 e
->skip
= JimWideValue(skip
);
14010 ExprPush(e
, Jim_NewIntObj(interp
, 0));
14014 /* true so continue */
14021 Jim_DecrRefCount(interp
, A
);
14022 Jim_DecrRefCount(interp
, skip
);
14027 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
14029 Jim_Obj
*skip
= ExprPop(e
);
14030 Jim_Obj
*A
= ExprPop(e
);
14033 switch (ExprBool(interp
, A
)) {
14035 /* false, so do nothing */
14039 /* true so skip RHS opcodes with a 1 result */
14040 e
->skip
= JimWideValue(skip
);
14041 ExprPush(e
, Jim_NewIntObj(interp
, 1));
14049 Jim_DecrRefCount(interp
, A
);
14050 Jim_DecrRefCount(interp
, skip
);
14055 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
14057 Jim_Obj
*A
= ExprPop(e
);
14060 switch (ExprBool(interp
, A
)) {
14062 ExprPush(e
, Jim_NewIntObj(interp
, 0));
14066 ExprPush(e
, Jim_NewIntObj(interp
, 1));
14074 Jim_DecrRefCount(interp
, A
);
14079 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
14081 Jim_Obj
*skip
= ExprPop(e
);
14082 Jim_Obj
*A
= ExprPop(e
);
14088 switch (ExprBool(interp
, A
)) {
14090 /* false, skip RHS opcodes */
14091 e
->skip
= JimWideValue(skip
);
14092 /* Push a dummy value */
14093 ExprPush(e
, Jim_NewIntObj(interp
, 0));
14097 /* true so do nothing */
14105 Jim_DecrRefCount(interp
, A
);
14106 Jim_DecrRefCount(interp
, skip
);
14111 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
14113 Jim_Obj
*skip
= ExprPop(e
);
14114 Jim_Obj
*B
= ExprPop(e
);
14115 Jim_Obj
*A
= ExprPop(e
);
14117 /* No need to check for A as non-boolean */
14118 if (ExprBool(interp
, A
)) {
14119 /* true, so skip RHS opcodes */
14120 e
->skip
= JimWideValue(skip
);
14121 /* Repush B as the answer */
14125 Jim_DecrRefCount(interp
, skip
);
14126 Jim_DecrRefCount(interp
, A
);
14127 Jim_DecrRefCount(interp
, B
);
14131 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
14144 /* name - precedence - arity - opcode */
14145 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
14146 [JIM_EXPROP_FUNC_INT
] = {"int", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14147 [JIM_EXPROP_FUNC_DOUBLE
] = {"double", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14148 [JIM_EXPROP_FUNC_ABS
] = {"abs", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14149 [JIM_EXPROP_FUNC_ROUND
] = {"round", 400, 1, JimExprOpNumUnary
, LAZY_NONE
},
14150 [JIM_EXPROP_FUNC_RAND
] = {"rand", 400, 0, JimExprOpNone
, LAZY_NONE
},
14151 [JIM_EXPROP_FUNC_SRAND
] = {"srand", 400, 1, JimExprOpIntUnary
, LAZY_NONE
},
14153 #ifdef JIM_MATH_FUNCTIONS
14154 [JIM_EXPROP_FUNC_SIN
] = {"sin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14155 [JIM_EXPROP_FUNC_COS
] = {"cos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14156 [JIM_EXPROP_FUNC_TAN
] = {"tan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14157 [JIM_EXPROP_FUNC_ASIN
] = {"asin", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14158 [JIM_EXPROP_FUNC_ACOS
] = {"acos", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14159 [JIM_EXPROP_FUNC_ATAN
] = {"atan", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14160 [JIM_EXPROP_FUNC_SINH
] = {"sinh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14161 [JIM_EXPROP_FUNC_COSH
] = {"cosh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14162 [JIM_EXPROP_FUNC_TANH
] = {"tanh", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14163 [JIM_EXPROP_FUNC_CEIL
] = {"ceil", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14164 [JIM_EXPROP_FUNC_FLOOR
] = {"floor", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14165 [JIM_EXPROP_FUNC_EXP
] = {"exp", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14166 [JIM_EXPROP_FUNC_LOG
] = {"log", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14167 [JIM_EXPROP_FUNC_LOG10
] = {"log10", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14168 [JIM_EXPROP_FUNC_SQRT
] = {"sqrt", 400, 1, JimExprOpDoubleUnary
, LAZY_NONE
},
14171 [JIM_EXPROP_NOT
] = {"!", 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14172 [JIM_EXPROP_BITNOT
] = {"~", 300, 1, JimExprOpIntUnary
, LAZY_NONE
},
14173 [JIM_EXPROP_UNARYMINUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14174 [JIM_EXPROP_UNARYPLUS
] = {NULL
, 300, 1, JimExprOpNumUnary
, LAZY_NONE
},
14176 [JIM_EXPROP_POW
] = {"**", 250, 2, JimExprOpBin
, LAZY_NONE
},
14178 [JIM_EXPROP_MUL
] = {"*", 200, 2, JimExprOpBin
, LAZY_NONE
},
14179 [JIM_EXPROP_DIV
] = {"/", 200, 2, JimExprOpBin
, LAZY_NONE
},
14180 [JIM_EXPROP_MOD
] = {"%", 200, 2, JimExprOpIntBin
, LAZY_NONE
},
14182 [JIM_EXPROP_SUB
] = {"-", 100, 2, JimExprOpBin
, LAZY_NONE
},
14183 [JIM_EXPROP_ADD
] = {"+", 100, 2, JimExprOpBin
, LAZY_NONE
},
14185 [JIM_EXPROP_ROTL
] = {"<<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14186 [JIM_EXPROP_ROTR
] = {">>>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14187 [JIM_EXPROP_LSHIFT
] = {"<<", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14188 [JIM_EXPROP_RSHIFT
] = {">>", 90, 2, JimExprOpIntBin
, LAZY_NONE
},
14190 [JIM_EXPROP_LT
] = {"<", 80, 2, JimExprOpBin
, LAZY_NONE
},
14191 [JIM_EXPROP_GT
] = {">", 80, 2, JimExprOpBin
, LAZY_NONE
},
14192 [JIM_EXPROP_LTE
] = {"<=", 80, 2, JimExprOpBin
, LAZY_NONE
},
14193 [JIM_EXPROP_GTE
] = {">=", 80, 2, JimExprOpBin
, LAZY_NONE
},
14195 [JIM_EXPROP_NUMEQ
] = {"==", 70, 2, JimExprOpBin
, LAZY_NONE
},
14196 [JIM_EXPROP_NUMNE
] = {"!=", 70, 2, JimExprOpBin
, LAZY_NONE
},
14198 [JIM_EXPROP_STREQ
] = {"eq", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
14199 [JIM_EXPROP_STRNE
] = {"ne", 60, 2, JimExprOpStrBin
, LAZY_NONE
},
14201 [JIM_EXPROP_STRIN
] = {"in", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
14202 [JIM_EXPROP_STRNI
] = {"ni", 55, 2, JimExprOpStrBin
, LAZY_NONE
},
14204 [JIM_EXPROP_BITAND
] = {"&", 50, 2, JimExprOpIntBin
, LAZY_NONE
},
14205 [JIM_EXPROP_BITXOR
] = {"^", 49, 2, JimExprOpIntBin
, LAZY_NONE
},
14206 [JIM_EXPROP_BITOR
] = {"|", 48, 2, JimExprOpIntBin
, LAZY_NONE
},
14208 [JIM_EXPROP_LOGICAND
] = {"&&", 10, 2, NULL
, LAZY_OP
},
14209 [JIM_EXPROP_LOGICOR
] = {"||", 9, 2, NULL
, LAZY_OP
},
14211 [JIM_EXPROP_TERNARY
] = {"?", 5, 2, JimExprOpNull
, LAZY_OP
},
14212 [JIM_EXPROP_COLON
] = {":", 5, 2, JimExprOpNull
, LAZY_OP
},
14214 /* private operators */
14215 [JIM_EXPROP_TERNARY_LEFT
] = {NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
},
14216 [JIM_EXPROP_TERNARY_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
14217 [JIM_EXPROP_COLON_LEFT
] = {NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
},
14218 [JIM_EXPROP_COLON_RIGHT
] = {NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
},
14219 [JIM_EXPROP_LOGICAND_LEFT
] = {NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
},
14220 [JIM_EXPROP_LOGICAND_RIGHT
] = {NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
14221 [JIM_EXPROP_LOGICOR_LEFT
] = {NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
},
14222 [JIM_EXPROP_LOGICOR_RIGHT
] = {NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
},
14225 #define JIM_EXPR_OPERATORS_NUM \
14226 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
14228 static int JimParseExpression(struct JimParserCtx
*pc
)
14230 /* Discard spaces and quoted newline */
14231 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
14236 if (pc
->len
== 0) {
14237 pc
->tstart
= pc
->tend
= pc
->p
;
14238 pc
->tline
= pc
->linenr
;
14239 pc
->tt
= JIM_TT_EOL
;
14243 switch (*(pc
->p
)) {
14245 pc
->tstart
= pc
->tend
= pc
->p
;
14246 pc
->tline
= pc
->linenr
;
14247 pc
->tt
= JIM_TT_SUBEXPR_START
;
14252 pc
->tstart
= pc
->tend
= pc
->p
;
14253 pc
->tline
= pc
->linenr
;
14254 pc
->tt
= JIM_TT_SUBEXPR_END
;
14259 return JimParseCmd(pc
);
14261 if (JimParseVar(pc
) == JIM_ERR
)
14262 return JimParseExprOperator(pc
);
14264 /* Don't allow expr sugar in expressions */
14265 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
14282 return JimParseExprNumber(pc
);
14284 return JimParseQuote(pc
);
14286 return JimParseBrace(pc
);
14292 if (JimParseExprIrrational(pc
) == JIM_ERR
)
14293 return JimParseExprOperator(pc
);
14296 return JimParseExprOperator(pc
);
14302 static int JimParseExprNumber(struct JimParserCtx
*pc
)
14307 /* Assume an integer for now */
14308 pc
->tt
= JIM_TT_EXPR_INT
;
14309 pc
->tstart
= pc
->p
;
14310 pc
->tline
= pc
->linenr
;
14311 while (isdigit(UCHAR(*pc
->p
))
14312 || (allowhex
&& isxdigit(UCHAR(*pc
->p
)))
14313 || (allowdot
&& *pc
->p
== '.')
14314 || (pc
->p
- pc
->tstart
== 1 && *pc
->tstart
== '0' && (*pc
->p
== 'x' || *pc
->p
== 'X'))
14316 if ((*pc
->p
== 'x') || (*pc
->p
== 'X')) {
14320 if (*pc
->p
== '.') {
14322 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14326 if (!allowhex
&& (*pc
->p
== 'e' || *pc
->p
== 'E') && (pc
->p
[1] == '-' || pc
->p
[1] == '+'
14327 || isdigit(UCHAR(pc
->p
[1])))) {
14330 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14333 pc
->tend
= pc
->p
- 1;
14337 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
14339 const char *Tokens
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
14340 const char **token
;
14342 for (token
= Tokens
; *token
!= NULL
; token
++) {
14343 int len
= strlen(*token
);
14345 if (strncmp(*token
, pc
->p
, len
) == 0) {
14346 pc
->tstart
= pc
->p
;
14347 pc
->tend
= pc
->p
+ len
- 1;
14350 pc
->tline
= pc
->linenr
;
14351 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
14358 static int JimParseExprOperator(struct JimParserCtx
*pc
)
14361 int bestIdx
= -1, bestLen
= 0;
14363 /* Try to get the longest match. */
14364 for (i
= JIM_TT_EXPR_OP
; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
14365 const char *opname
;
14368 opname
= Jim_ExprOperators
[i
].name
;
14369 if (opname
== NULL
) {
14372 oplen
= strlen(opname
);
14374 if (strncmp(opname
, pc
->p
, oplen
) == 0 && oplen
> bestLen
) {
14379 if (bestIdx
== -1) {
14383 /* Validate paretheses around function arguments */
14384 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
14385 const char *p
= pc
->p
+ bestLen
;
14386 int len
= pc
->len
- bestLen
;
14388 while (len
&& isspace(UCHAR(*p
))) {
14396 pc
->tstart
= pc
->p
;
14397 pc
->tend
= pc
->p
+ bestLen
- 1;
14399 pc
->len
-= bestLen
;
14400 pc
->tline
= pc
->linenr
;
14406 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
14408 return &Jim_ExprOperators
[opcode
];
14411 const char *jim_tt_name(int type
)
14413 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
14414 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", "INT",
14416 if (type
< JIM_TT_EXPR_OP
) {
14417 return tt_names
[type
];
14420 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
14421 static char buf
[20];
14423 if (op
&& op
->name
) {
14426 sprintf(buf
, "(%d)", type
);
14431 /* -----------------------------------------------------------------------------
14432 * Expression Object
14433 * ---------------------------------------------------------------------------*/
14434 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
14435 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
14436 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
14438 static const Jim_ObjType exprObjType
= {
14440 FreeExprInternalRep
,
14441 DupExprInternalRep
,
14443 JIM_TYPE_REFERENCES
,
14446 /* Expr bytecode structure */
14447 typedef struct ExprByteCode
14449 int len
; /* Length as number of tokens. */
14450 ScriptToken
*token
; /* Tokens array. */
14451 int inUse
; /* Used for sharing. */
14454 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
14458 for (i
= 0; i
< expr
->len
; i
++) {
14459 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
14461 Jim_Free(expr
->token
);
14465 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14467 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
14470 if (--expr
->inUse
!= 0) {
14474 ExprFreeByteCode(interp
, expr
);
14478 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
14480 JIM_NOTUSED(interp
);
14481 JIM_NOTUSED(srcPtr
);
14483 /* Just returns an simple string. */
14484 dupPtr
->typePtr
= NULL
;
14487 /* Check if an expr program looks correct. */
14488 static int ExprCheckCorrectness(ExprByteCode
* expr
)
14494 /* Try to check if there are stack underflows,
14495 * and make sure at the end of the program there is
14496 * a single result on the stack. */
14497 for (i
= 0; i
< expr
->len
; i
++) {
14498 ScriptToken
*t
= &expr
->token
[i
];
14499 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
14502 stacklen
-= op
->arity
;
14503 if (stacklen
< 0) {
14506 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
14509 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
14514 /* All operations and operands add one to the stack */
14517 if (stacklen
!= 1 || ternary
!= 0) {
14523 /* This procedure converts every occurrence of || and && opereators
14524 * in lazy unary versions.
14526 * a b || is converted into:
14528 * a <offset> |L b |R
14530 * a b && is converted into:
14532 * a <offset> &L b &R
14534 * "|L" checks if 'a' is true:
14535 * 1) if it is true pushes 1 and skips <offset> instructions to reach
14536 * the opcode just after |R.
14537 * 2) if it is false does nothing.
14538 * "|R" checks if 'b' is true:
14539 * 1) if it is true pushes 1, otherwise pushes 0.
14541 * "&L" checks if 'a' is true:
14542 * 1) if it is true does nothing.
14543 * 2) If it is false pushes 0 and skips <offset> instructions to reach
14544 * the opcode just after &R
14545 * "&R" checks if 'a' is true:
14546 * if it is true pushes 1, otherwise pushes 0.
14548 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
14552 int leftindex
, arity
, offset
;
14554 /* Search for the end of the first operator */
14555 leftindex
= expr
->len
- 1;
14559 ScriptToken
*tt
= &expr
->token
[leftindex
];
14561 if (tt
->type
>= JIM_TT_EXPR_OP
) {
14562 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
14565 if (--leftindex
< 0) {
14572 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
14573 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
14575 offset
= (expr
->len
- leftindex
) - 1;
14577 /* Now we rely on the fact the the left and right version have opcodes
14578 * 1 and 2 after the main opcode respectively
14580 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
14581 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
14583 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
14584 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
14586 /* Now add the 'R' operator */
14587 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
14588 expr
->token
[expr
->len
].type
= t
->type
+ 2;
14591 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
14592 for (i
= leftindex
- 1; i
> 0; i
--) {
14593 if (JimExprOperatorInfoByOpcode(expr
->token
[i
].type
)->lazy
== LAZY_LEFT
) {
14594 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
14595 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
14602 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
14604 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
14605 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
14607 if (op
->lazy
== LAZY_OP
) {
14608 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
14609 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
14614 token
->objPtr
= interp
->emptyObj
;
14615 token
->type
= t
->type
;
14622 * Returns the index of the COLON_LEFT to the left of 'right_index'
14623 * taking into account nesting.
14625 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
14627 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
14629 int ternary_count
= 1;
14633 while (right_index
> 1) {
14634 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
14637 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
14640 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
14641 return right_index
;
14651 * Find the left/right indices for the ternary expression to the left of 'right_index'.
14653 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
14654 * Otherwise returns 0.
14656 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
14658 int i
= right_index
- 1;
14659 int ternary_count
= 1;
14662 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
14663 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
14664 *prev_right_index
= i
- 2;
14665 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
14669 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
14670 if (ternary_count
== 0) {
14681 * ExprTernaryReorderExpression description
14682 * ========================================
14684 * ?: is right-to-left associative which doesn't work with the stack-based
14685 * expression engine. The fix is to reorder the bytecode.
14691 * Has initial bytecode:
14693 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
14694 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
14696 * The fix involves simulating this expression instead:
14700 * With the following bytecode:
14702 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
14703 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
14705 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
14706 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
14707 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
14708 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
14710 * ExprTernaryReorderExpression works thus as follows :
14711 * - start from the end of the stack
14712 * - while walking towards the beginning of the stack
14713 * if token=JIM_EXPROP_COLON_RIGHT then
14714 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
14715 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
14716 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
14717 * if all found then
14718 * perform the rotation
14719 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
14723 * Note: care has to be taken for nested ternary constructs!!!
14725 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
14729 for (i
= expr
->len
- 1; i
> 1; i
--) {
14730 int prev_right_index
;
14731 int prev_left_index
;
14735 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
14739 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
14740 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
14745 ** rotate tokens down
14747 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
14756 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
14758 tmp
= expr
->token
[prev_right_index
];
14759 for (j
= prev_right_index
; j
< i
; j
++) {
14760 expr
->token
[j
] = expr
->token
[j
+ 1];
14762 expr
->token
[i
] = tmp
;
14764 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
14766 * This is 'colon left increment' = i - prev_right_index
14768 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
14769 * [prev_left_index-1] : skip_count
14772 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
14774 /* Adjust for i-- in the loop */
14779 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
)
14782 ExprByteCode
*expr
;
14785 int prevtt
= JIM_TT_NONE
;
14786 int have_ternary
= 0;
14789 int count
= tokenlist
->count
- 1;
14791 expr
= Jim_Alloc(sizeof(*expr
));
14795 Jim_InitStack(&stack
);
14797 /* Need extra bytecodes for lazy operators.
14798 * Also check for the ternary operator
14800 for (i
= 0; i
< tokenlist
->count
; i
++) {
14801 ParseToken
*t
= &tokenlist
->list
[i
];
14803 if (JimExprOperatorInfoByOpcode(t
->type
)->lazy
== LAZY_OP
) {
14805 /* Ternary is a lazy op but also needs reordering */
14806 if (t
->type
== JIM_EXPROP_TERNARY
) {
14812 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
14814 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
14815 ParseToken
*t
= &tokenlist
->list
[i
];
14817 /* Next token will be stored here */
14818 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
14820 if (t
->type
== JIM_TT_EOL
) {
14828 case JIM_TT_DICTSUGAR
:
14829 case JIM_TT_EXPRSUGAR
:
14831 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
14832 token
->type
= t
->type
;
14836 case JIM_TT_EXPR_INT
:
14837 token
->objPtr
= Jim_NewIntObj(interp
, strtoull(t
->token
, NULL
, 0));
14838 token
->type
= t
->type
;
14842 case JIM_TT_EXPR_DOUBLE
:
14843 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, NULL
));
14844 token
->type
= t
->type
;
14848 case JIM_TT_SUBEXPR_START
:
14849 Jim_StackPush(&stack
, t
);
14850 prevtt
= JIM_TT_NONE
;
14853 case JIM_TT_SUBEXPR_END
:
14855 while (Jim_StackLen(&stack
)) {
14856 ParseToken
*tt
= Jim_StackPop(&stack
);
14858 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
14863 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14868 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
14875 /* Must be an operator */
14876 const struct Jim_ExprOperator
*op
;
14879 /* Convert -/+ to unary minus or unary plus if necessary */
14880 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
14881 if (t
->type
== JIM_EXPROP_SUB
) {
14882 t
->type
= JIM_EXPROP_UNARYMINUS
;
14884 else if (t
->type
== JIM_EXPROP_ADD
) {
14885 t
->type
= JIM_EXPROP_UNARYPLUS
;
14889 op
= JimExprOperatorInfoByOpcode(t
->type
);
14891 /* Now handle precedence */
14892 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
14893 const struct Jim_ExprOperator
*tt_op
=
14894 JimExprOperatorInfoByOpcode(tt
->type
);
14896 /* Note that right-to-left associativity of ?: operator is handled later */
14898 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
14899 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14903 Jim_StackPop(&stack
);
14909 Jim_StackPush(&stack
, t
);
14916 /* Reduce any remaining subexpr */
14917 while (Jim_StackLen(&stack
)) {
14918 ParseToken
*tt
= Jim_StackPop(&stack
);
14920 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
14922 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
14925 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
14931 if (have_ternary
) {
14932 ExprTernaryReorderExpression(interp
, expr
);
14936 /* Free the stack used for the compilation. */
14937 Jim_FreeStack(&stack
);
14939 for (i
= 0; i
< expr
->len
; i
++) {
14940 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
14944 ExprFreeByteCode(interp
, expr
);
14952 /* This method takes the string representation of an expression
14953 * and generates a program for the Expr's stack-based VM. */
14954 int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
14957 const char *exprText
;
14958 struct JimParserCtx parser
;
14959 struct ExprByteCode
*expr
;
14960 ParseTokenList tokenlist
;
14964 /* Try to get information about filename / line number */
14965 if (objPtr
->typePtr
== &sourceObjType
) {
14966 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
14969 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
14971 /* Initially tokenise the expression into tokenlist */
14972 ScriptTokenListInit(&tokenlist
);
14974 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
14975 while (!parser
.eof
) {
14976 if (JimParseExpression(&parser
) != JIM_OK
) {
14977 ScriptTokenListFree(&tokenlist
);
14979 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
14984 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
14988 #ifdef DEBUG_SHOW_EXPR_TOKENS
14991 printf("==== Expr Tokens ====\n");
14992 for (i
= 0; i
< tokenlist
.count
; i
++) {
14993 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
14994 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
14999 /* Now create the expression bytecode from the tokenlist */
15000 expr
= ExprCreateByteCode(interp
, &tokenlist
);
15002 /* No longer need the token list */
15003 ScriptTokenListFree(&tokenlist
);
15009 #ifdef DEBUG_SHOW_EXPR
15013 printf("==== Expr ====\n");
15014 for (i
= 0; i
< expr
->len
; i
++) {
15015 ScriptToken
*t
= &expr
->token
[i
];
15017 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
15022 /* Check program correctness. */
15023 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
15024 ExprFreeByteCode(interp
, expr
);
15031 /* Free the old internal rep and set the new one. */
15032 Jim_FreeIntRep(interp
, objPtr
);
15033 Jim_SetIntRepPtr(objPtr
, expr
);
15034 objPtr
->typePtr
= &exprObjType
;
15038 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
15040 if (objPtr
->typePtr
!= &exprObjType
) {
15041 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
15045 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
15048 /* -----------------------------------------------------------------------------
15049 * Expressions evaluation.
15050 * Jim uses a specialized stack-based virtual machine for expressions,
15051 * that takes advantage of the fact that expr's operators
15052 * can't be redefined.
15054 * Jim_EvalExpression() uses the bytecode compiled by
15055 * SetExprFromAny() method of the "expression" object.
15057 * On success a Tcl Object containing the result of the evaluation
15058 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
15060 * On error the function returns a retcode != to JIM_OK and set a suitable
15061 * error on the interp.
15062 * ---------------------------------------------------------------------------*/
15063 #define JIM_EE_STATICSTACK_LEN 10
15065 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
15067 ExprByteCode
*expr
;
15068 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
15070 int retcode
= JIM_OK
;
15071 struct JimExprState e
;
15073 expr
= JimGetExpression(interp
, exprObjPtr
);
15075 return JIM_ERR
; /* error in expression. */
15078 #ifdef JIM_OPTIMIZATION
15079 /* Check for one of the following common expressions used by while/for
15084 * $a < CONST, $a < $b
15085 * $a <= CONST, $a <= $b
15086 * $a > CONST, $a > $b
15087 * $a >= CONST, $a >= $b
15088 * $a != CONST, $a != $b
15089 * $a == CONST, $a == $b
15094 /* STEP 1 -- Check if there are the conditions to run the specialized
15095 * version of while */
15097 switch (expr
->len
) {
15099 if (expr
->token
[0].type
== JIM_TT_EXPR_INT
) {
15100 *exprResultPtrPtr
= expr
->token
[0].objPtr
;
15101 Jim_IncrRefCount(*exprResultPtrPtr
);
15104 if (expr
->token
[0].type
== JIM_TT_VAR
) {
15105 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_ERRMSG
);
15107 *exprResultPtrPtr
= objPtr
;
15108 Jim_IncrRefCount(*exprResultPtrPtr
);
15115 if (expr
->token
[1].type
== JIM_EXPROP_NOT
&& expr
->token
[0].type
== JIM_TT_VAR
) {
15116 jim_wide wideValue
;
15118 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
15119 if (objPtr
&& JimIsWide(objPtr
)
15120 && Jim_GetWide(interp
, objPtr
, &wideValue
) == JIM_OK
) {
15121 *exprResultPtrPtr
= wideValue
? interp
->falseObj
: interp
->trueObj
;
15122 Jim_IncrRefCount(*exprResultPtrPtr
);
15129 if (expr
->token
[0].type
== JIM_TT_VAR
&& (expr
->token
[1].type
== JIM_TT_EXPR_INT
15130 || expr
->token
[1].type
== JIM_TT_VAR
)) {
15131 switch (expr
->token
[2].type
) {
15132 case JIM_EXPROP_LT
:
15133 case JIM_EXPROP_LTE
:
15134 case JIM_EXPROP_GT
:
15135 case JIM_EXPROP_GTE
:
15136 case JIM_EXPROP_NUMEQ
:
15137 case JIM_EXPROP_NUMNE
:{
15139 jim_wide wideValueA
;
15140 jim_wide wideValueB
;
15142 objPtr
= Jim_GetVariable(interp
, expr
->token
[0].objPtr
, JIM_NONE
);
15143 if (objPtr
&& JimIsWide(objPtr
)
15144 && Jim_GetWide(interp
, objPtr
, &wideValueA
) == JIM_OK
) {
15145 if (expr
->token
[1].type
== JIM_TT_VAR
) {
15147 Jim_GetVariable(interp
, expr
->token
[1].objPtr
,
15151 objPtr
= expr
->token
[1].objPtr
;
15153 if (objPtr
&& JimIsWide(objPtr
)
15154 && Jim_GetWide(interp
, objPtr
, &wideValueB
) == JIM_OK
) {
15157 switch (expr
->token
[2].type
) {
15158 case JIM_EXPROP_LT
:
15159 cmpRes
= wideValueA
< wideValueB
;
15161 case JIM_EXPROP_LTE
:
15162 cmpRes
= wideValueA
<= wideValueB
;
15164 case JIM_EXPROP_GT
:
15165 cmpRes
= wideValueA
> wideValueB
;
15167 case JIM_EXPROP_GTE
:
15168 cmpRes
= wideValueA
>= wideValueB
;
15170 case JIM_EXPROP_NUMEQ
:
15171 cmpRes
= wideValueA
== wideValueB
;
15173 case JIM_EXPROP_NUMNE
:
15174 cmpRes
= wideValueA
!= wideValueB
;
15176 default: /*notreached */
15179 *exprResultPtrPtr
=
15180 cmpRes
? interp
->trueObj
: interp
->falseObj
;
15181 Jim_IncrRefCount(*exprResultPtrPtr
);
15193 /* In order to avoid that the internal repr gets freed due to
15194 * shimmering of the exprObjPtr's object, we make the internal rep
15198 /* The stack-based expr VM itself */
15200 /* Stack allocation. Expr programs have the feature that
15201 * a program of length N can't require a stack longer than
15203 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
15204 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
15206 e
.stack
= staticStack
;
15210 /* Execute every instruction */
15211 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
15214 switch (expr
->token
[i
].type
) {
15215 case JIM_TT_EXPR_INT
:
15216 case JIM_TT_EXPR_DOUBLE
:
15218 ExprPush(&e
, expr
->token
[i
].objPtr
);
15222 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
15224 ExprPush(&e
, objPtr
);
15231 case JIM_TT_DICTSUGAR
:
15232 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
15234 ExprPush(&e
, objPtr
);
15242 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
15243 if (retcode
== JIM_OK
) {
15244 ExprPush(&e
, objPtr
);
15249 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
15250 if (retcode
== JIM_OK
) {
15251 ExprPush(&e
, Jim_GetResult(interp
));
15256 /* Find and execute the operation */
15258 e
.opcode
= expr
->token
[i
].type
;
15260 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
15261 /* Skip some opcodes if necessary */
15270 if (retcode
== JIM_OK
) {
15271 *exprResultPtrPtr
= ExprPop(&e
);
15274 for (i
= 0; i
< e
.stacklen
; i
++) {
15275 Jim_DecrRefCount(interp
, e
.stack
[i
]);
15278 if (e
.stack
!= staticStack
) {
15284 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
15287 jim_wide wideValue
;
15288 double doubleValue
;
15289 Jim_Obj
*exprResultPtr
;
15291 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
15292 if (retcode
!= JIM_OK
)
15295 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
15296 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
15297 Jim_DecrRefCount(interp
, exprResultPtr
);
15301 Jim_DecrRefCount(interp
, exprResultPtr
);
15302 *boolPtr
= doubleValue
!= 0;
15306 *boolPtr
= wideValue
!= 0;
15308 Jim_DecrRefCount(interp
, exprResultPtr
);
15312 /* -----------------------------------------------------------------------------
15313 * ScanFormat String Object
15314 * ---------------------------------------------------------------------------*/
15316 /* This Jim_Obj will held a parsed representation of a format string passed to
15317 * the Jim_ScanString command. For error diagnostics, the scanformat string has
15318 * to be parsed in its entirely first and then, if correct, can be used for
15319 * scanning. To avoid endless re-parsing, the parsed representation will be
15320 * stored in an internal representation and re-used for performance reason. */
15322 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
15323 * scanformat string. This part will later be used to extract information
15324 * out from the string to be parsed by Jim_ScanString */
15326 typedef struct ScanFmtPartDescr
15328 char type
; /* Type of conversion (e.g. c, d, f) */
15329 char modifier
; /* Modify type (e.g. l - long, h - short */
15330 size_t width
; /* Maximal width of input to be converted */
15331 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
15332 char *arg
; /* Specification of a CHARSET conversion */
15333 char *prefix
; /* Prefix to be scanned literally before conversion */
15334 } ScanFmtPartDescr
;
15336 /* The ScanFmtStringObj will hold the internal representation of a scanformat
15337 * string parsed and separated in part descriptions. Furthermore it contains
15338 * the original string representation of the scanformat string to allow for
15339 * fast update of the Jim_Obj's string representation part.
15341 * As an add-on the internal object representation adds some scratch pad area
15342 * for usage by Jim_ScanString to avoid endless allocating and freeing of
15343 * memory for purpose of string scanning.
15345 * The error member points to a static allocated string in case of a mal-
15346 * formed scanformat string or it contains '0' (NULL) in case of a valid
15347 * parse representation.
15349 * The whole memory of the internal representation is allocated as a single
15350 * area of memory that will be internally separated. So freeing and duplicating
15351 * of such an object is cheap */
15353 typedef struct ScanFmtStringObj
15355 jim_wide size
; /* Size of internal repr in bytes */
15356 char *stringRep
; /* Original string representation */
15357 size_t count
; /* Number of ScanFmtPartDescr contained */
15358 size_t convCount
; /* Number of conversions that will assign */
15359 size_t maxPos
; /* Max position index if XPG3 is used */
15360 const char *error
; /* Ptr to error text (NULL if no error */
15361 char *scratch
; /* Some scratch pad used by Jim_ScanString */
15362 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
15363 } ScanFmtStringObj
;
15366 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
15367 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
15368 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
15370 static const Jim_ObjType scanFmtStringObjType
= {
15371 "scanformatstring",
15372 FreeScanFmtInternalRep
,
15373 DupScanFmtInternalRep
,
15374 UpdateStringOfScanFmt
,
15378 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
15380 JIM_NOTUSED(interp
);
15381 Jim_Free((char *)objPtr
->internalRep
.ptr
);
15382 objPtr
->internalRep
.ptr
= 0;
15385 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
15387 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
15388 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
15390 JIM_NOTUSED(interp
);
15391 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
15392 dupPtr
->internalRep
.ptr
= newVec
;
15393 dupPtr
->typePtr
= &scanFmtStringObjType
;
15396 void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
15398 char *bytes
= ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
;
15400 objPtr
->bytes
= Jim_StrDup(bytes
);
15401 objPtr
->length
= strlen(bytes
);
15404 /* SetScanFmtFromAny will parse a given string and create the internal
15405 * representation of the format specification. In case of an error
15406 * the error data member of the internal representation will be set
15407 * to an descriptive error text and the function will be left with
15408 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
15411 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
15413 ScanFmtStringObj
*fmtObj
;
15415 int maxCount
, i
, approxSize
, lastPos
= -1;
15416 const char *fmt
= objPtr
->bytes
;
15417 int maxFmtLen
= objPtr
->length
;
15418 const char *fmtEnd
= fmt
+ maxFmtLen
;
15421 Jim_FreeIntRep(interp
, objPtr
);
15422 /* Count how many conversions could take place maximally */
15423 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
15426 /* Calculate an approximation of the memory necessary */
15427 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
15428 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
15429 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
15430 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
15431 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
15432 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
15433 +1; /* safety byte */
15434 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
15435 memset(fmtObj
, 0, approxSize
);
15436 fmtObj
->size
= approxSize
;
15437 fmtObj
->maxPos
= 0;
15438 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
15439 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
15440 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
15441 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
15442 objPtr
->internalRep
.ptr
= fmtObj
;
15443 objPtr
->typePtr
= &scanFmtStringObjType
;
15444 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
15445 int width
= 0, skip
;
15446 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
15449 descr
->width
= 0; /* Assume width unspecified */
15450 /* Overread and store any "literal" prefix */
15451 if (*fmt
!= '%' || fmt
[1] == '%') {
15453 descr
->prefix
= &buffer
[i
];
15454 for (; fmt
< fmtEnd
; ++fmt
) {
15460 buffer
[i
++] = *fmt
;
15464 /* Skip the conversion introducing '%' sign */
15466 /* End reached due to non-conversion literal only? */
15469 descr
->pos
= 0; /* Assume "natural" positioning */
15471 descr
->pos
= -1; /* Okay, conversion will not be assigned */
15475 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
15476 /* Check if next token is a number (could be width or pos */
15477 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
15479 /* Was the number a XPG3 position specifier? */
15480 if (descr
->pos
!= -1 && *fmt
== '$') {
15484 descr
->pos
= width
;
15486 /* Look if "natural" postioning and XPG3 one was mixed */
15487 if ((lastPos
== 0 && descr
->pos
> 0)
15488 || (lastPos
> 0 && descr
->pos
== 0)) {
15489 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
15492 /* Look if this position was already used */
15493 for (prev
= 0; prev
< curr
; ++prev
) {
15494 if (fmtObj
->descr
[prev
].pos
== -1)
15496 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
15498 "variable is assigned by multiple \"%n$\" conversion specifiers";
15502 /* Try to find a width after the XPG3 specifier */
15503 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
15504 descr
->width
= width
;
15507 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
15508 fmtObj
->maxPos
= descr
->pos
;
15511 /* Number was not a XPG3, so it has to be a width */
15512 descr
->width
= width
;
15515 /* If positioning mode was undetermined yet, fix this */
15517 lastPos
= descr
->pos
;
15518 /* Handle CHARSET conversion type ... */
15520 int swapped
= 1, beg
= i
, end
, j
;
15523 descr
->arg
= &buffer
[i
];
15526 buffer
[i
++] = *fmt
++;
15528 buffer
[i
++] = *fmt
++;
15529 while (*fmt
&& *fmt
!= ']')
15530 buffer
[i
++] = *fmt
++;
15532 fmtObj
->error
= "unmatched [ in format string";
15537 /* In case a range fence was given "backwards", swap it */
15540 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
15541 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
15542 char tmp
= buffer
[j
- 1];
15544 buffer
[j
- 1] = buffer
[j
+ 1];
15545 buffer
[j
+ 1] = tmp
;
15552 /* Remember any valid modifier if given */
15553 if (strchr("hlL", *fmt
) != 0)
15554 descr
->modifier
= tolower((int)*fmt
++);
15556 descr
->type
= *fmt
;
15557 if (strchr("efgcsndoxui", *fmt
) == 0) {
15558 fmtObj
->error
= "bad scan conversion character";
15561 else if (*fmt
== 'c' && descr
->width
!= 0) {
15562 fmtObj
->error
= "field width may not be specified in %c " "conversion";
15565 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
15566 fmtObj
->error
= "unsigned wide not supported";
15576 /* Some accessor macros to allow lowlevel access to fields of internal repr */
15578 #define FormatGetCnvCount(_fo_) \
15579 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
15580 #define FormatGetMaxPos(_fo_) \
15581 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
15582 #define FormatGetError(_fo_) \
15583 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
15585 /* JimScanAString is used to scan an unspecified string that ends with
15586 * next WS, or a string that is specified via a charset.
15589 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
15591 char *buffer
= Jim_StrDup(str
);
15598 if (!sdescr
&& isspace(UCHAR(*str
)))
15599 break; /* EOS via WS if unspecified */
15601 n
= utf8_tounicode(str
, &c
);
15602 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
15608 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
15611 /* ScanOneEntry will scan one entry out of the string passed as argument.
15612 * It use the sscanf() function for this task. After extracting and
15613 * converting of the value, the count of scanned characters will be
15614 * returned of -1 in case of no conversion tool place and string was
15615 * already scanned thru */
15617 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
15618 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
15621 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
15622 size_t scanned
= 0;
15623 size_t anchor
= pos
;
15625 Jim_Obj
*tmpObj
= NULL
;
15627 /* First pessimistically assume, we will not scan anything :-) */
15629 if (descr
->prefix
) {
15630 /* There was a prefix given before the conversion, skip it and adjust
15631 * the string-to-be-parsed accordingly */
15632 /* XXX: Should be checking strLen, not str[pos] */
15633 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
15634 /* If prefix require, skip WS */
15635 if (isspace(UCHAR(descr
->prefix
[i
])))
15636 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
15638 else if (descr
->prefix
[i
] != str
[pos
])
15639 break; /* Prefix do not match here, leave the loop */
15641 ++pos
; /* Prefix matched so far, next round */
15643 if (pos
>= strLen
) {
15644 return -1; /* All of str consumed: EOF condition */
15646 else if (descr
->prefix
[i
] != 0)
15647 return 0; /* Not whole prefix consumed, no conversion possible */
15649 /* For all but following conversion, skip leading WS */
15650 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
15651 while (isspace(UCHAR(str
[pos
])))
15653 /* Determine how much skipped/scanned so far */
15654 scanned
= pos
- anchor
;
15656 /* %c is a special, simple case. no width */
15657 if (descr
->type
== 'n') {
15658 /* Return pseudo conversion means: how much scanned so far? */
15659 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
15661 else if (pos
>= strLen
) {
15662 /* Cannot scan anything, as str is totally consumed */
15665 else if (descr
->type
== 'c') {
15667 scanned
+= utf8_tounicode(&str
[pos
], &c
);
15668 *valObjPtr
= Jim_NewIntObj(interp
, c
);
15672 /* Processing of conversions follows ... */
15673 if (descr
->width
> 0) {
15674 /* Do not try to scan as fas as possible but only the given width.
15675 * To ensure this, we copy the part that should be scanned. */
15676 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
15677 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
15679 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
15680 tok
= tmpObj
->bytes
;
15683 /* As no width was given, simply refer to the original string */
15686 switch (descr
->type
) {
15692 char *endp
; /* Position where the number finished */
15695 int base
= descr
->type
== 'o' ? 8
15696 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
15698 /* Try to scan a number with the given base */
15699 w
= strtoull(tok
, &endp
, base
);
15700 if (endp
== tok
&& base
== 0) {
15701 /* If scanning failed, and base was undetermined, simply
15702 * put it to 10 and try once more. This should catch the
15703 * case where %i begin to parse a number prefix (e.g.
15704 * '0x' but no further digits follows. This will be
15705 * handled as a ZERO followed by a char 'x' by Tcl */
15706 w
= strtoull(tok
, &endp
, 10);
15710 /* There was some number sucessfully scanned! */
15711 *valObjPtr
= Jim_NewIntObj(interp
, w
);
15713 /* Adjust the number-of-chars scanned so far */
15714 scanned
+= endp
- tok
;
15717 /* Nothing was scanned. We have to determine if this
15718 * happened due to e.g. prefix mismatch or input str
15720 scanned
= *tok
? 0 : -1;
15726 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
15727 scanned
+= Jim_Length(*valObjPtr
);
15734 double value
= strtod(tok
, &endp
);
15737 /* There was some number sucessfully scanned! */
15738 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
15739 /* Adjust the number-of-chars scanned so far */
15740 scanned
+= endp
- tok
;
15743 /* Nothing was scanned. We have to determine if this
15744 * happened due to e.g. prefix mismatch or input str
15746 scanned
= *tok
? 0 : -1;
15751 /* If a substring was allocated (due to pre-defined width) do not
15752 * forget to free it */
15754 Jim_FreeNewObj(interp
, tmpObj
);
15760 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
15761 * string and returns all converted (and not ignored) values in a list back
15762 * to the caller. If an error occured, a NULL pointer will be returned */
15764 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
15768 const char *str
= Jim_String(strObjPtr
);
15769 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
15770 Jim_Obj
*resultList
= 0;
15771 Jim_Obj
**resultVec
= 0;
15773 Jim_Obj
*emptyStr
= 0;
15774 ScanFmtStringObj
*fmtObj
;
15776 /* This should never happen. The format object should already be of the correct type */
15777 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, interp
, "Jim_ScanString() for non-scan format"));
15779 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
15780 /* Check if format specification was valid */
15781 if (fmtObj
->error
!= 0) {
15782 if (flags
& JIM_ERRMSG
)
15783 Jim_SetResultString(interp
, fmtObj
->error
, -1);
15786 /* Allocate a new "shared" empty string for all unassigned conversions */
15787 emptyStr
= Jim_NewEmptyStringObj(interp
);
15788 Jim_IncrRefCount(emptyStr
);
15789 /* Create a list and fill it with empty strings up to max specified XPG3 */
15790 resultList
= Jim_NewListObj(interp
, 0, 0);
15791 if (fmtObj
->maxPos
> 0) {
15792 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
15793 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
15794 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
15796 /* Now handle every partial format description */
15797 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
15798 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
15799 Jim_Obj
*value
= 0;
15801 /* Only last type may be "literal" w/o conversion - skip it! */
15802 if (descr
->type
== 0)
15804 /* As long as any conversion could be done, we will proceed */
15806 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
15807 /* In case our first try results in EOF, we will leave */
15808 if (scanned
== -1 && i
== 0)
15810 /* Advance next pos-to-be-scanned for the amount scanned already */
15813 /* value == 0 means no conversion took place so take empty string */
15815 value
= Jim_NewEmptyStringObj(interp
);
15816 /* If value is a non-assignable one, skip it */
15817 if (descr
->pos
== -1) {
15818 Jim_FreeNewObj(interp
, value
);
15820 else if (descr
->pos
== 0)
15821 /* Otherwise append it to the result list if no XPG3 was given */
15822 Jim_ListAppendElement(interp
, resultList
, value
);
15823 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
15824 /* But due to given XPG3, put the value into the corr. slot */
15825 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
15826 Jim_IncrRefCount(value
);
15827 resultVec
[descr
->pos
- 1] = value
;
15830 /* Otherwise, the slot was already used - free obj and ERROR */
15831 Jim_FreeNewObj(interp
, value
);
15835 Jim_DecrRefCount(interp
, emptyStr
);
15838 Jim_DecrRefCount(interp
, emptyStr
);
15839 Jim_FreeNewObj(interp
, resultList
);
15840 return (Jim_Obj
*)EOF
;
15842 Jim_DecrRefCount(interp
, emptyStr
);
15843 Jim_FreeNewObj(interp
, resultList
);
15847 /* -----------------------------------------------------------------------------
15848 * Pseudo Random Number Generation
15849 * ---------------------------------------------------------------------------*/
15850 /* Initialize the sbox with the numbers from 0 to 255 */
15851 static void JimPrngInit(Jim_Interp
*interp
)
15853 #define PRNG_SEED_SIZE 256
15855 unsigned int *seed
;
15856 time_t t
= time(NULL
);
15858 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
15860 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
15861 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
15862 seed
[i
] = (rand() ^ t
^ clock());
15864 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
15868 /* Generates N bytes of random data */
15869 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
15871 Jim_PrngState
*prng
;
15872 unsigned char *destByte
= (unsigned char *)dest
;
15873 unsigned int si
, sj
, x
;
15875 /* initialization, only needed the first time */
15876 if (interp
->prngState
== NULL
)
15877 JimPrngInit(interp
);
15878 prng
= interp
->prngState
;
15879 /* generates 'len' bytes of pseudo-random numbers */
15880 for (x
= 0; x
< len
; x
++) {
15881 prng
->i
= (prng
->i
+ 1) & 0xff;
15882 si
= prng
->sbox
[prng
->i
];
15883 prng
->j
= (prng
->j
+ si
) & 0xff;
15884 sj
= prng
->sbox
[prng
->j
];
15885 prng
->sbox
[prng
->i
] = sj
;
15886 prng
->sbox
[prng
->j
] = si
;
15887 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
15891 /* Re-seed the generator with user-provided bytes */
15892 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
15895 Jim_PrngState
*prng
;
15897 /* initialization, only needed the first time */
15898 if (interp
->prngState
== NULL
)
15899 JimPrngInit(interp
);
15900 prng
= interp
->prngState
;
15902 /* Set the sbox[i] with i */
15903 for (i
= 0; i
< 256; i
++)
15905 /* Now use the seed to perform a random permutation of the sbox */
15906 for (i
= 0; i
< seedLen
; i
++) {
15909 t
= prng
->sbox
[i
& 0xFF];
15910 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
15911 prng
->sbox
[seed
[i
]] = t
;
15913 prng
->i
= prng
->j
= 0;
15915 /* discard at least the first 256 bytes of stream.
15916 * borrow the seed buffer for this
15918 for (i
= 0; i
< 256; i
+= seedLen
) {
15919 JimRandomBytes(interp
, seed
, seedLen
);
15924 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15926 jim_wide wideValue
, increment
= 1;
15927 Jim_Obj
*intObjPtr
;
15929 if (argc
!= 2 && argc
!= 3) {
15930 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
15934 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
15937 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
15939 /* Set missing variable to 0 */
15942 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
15945 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
15946 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
15947 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
15948 Jim_FreeNewObj(interp
, intObjPtr
);
15953 /* Can do it the quick way */
15954 Jim_InvalidateStringRep(intObjPtr
);
15955 JimWideValue(intObjPtr
) = wideValue
+ increment
;
15957 /* The following step is required in order to invalidate the
15958 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
15959 if (argv
[1]->typePtr
!= &variableObjType
) {
15960 /* Note that this can't fail since GetVariable already succeeded */
15961 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
15964 Jim_SetResult(interp
, intObjPtr
);
15969 /* -----------------------------------------------------------------------------
15971 * ---------------------------------------------------------------------------*/
15972 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
15973 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
15975 /* Handle calls to the [unknown] command */
15976 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *filename
,
15979 Jim_Obj
**v
, *sv
[JIM_EVAL_SARGV_LEN
];
15982 /* If JimUnknown() is recursively called too many times...
15985 if (interp
->unknown_called
> 50) {
15989 /* If the [unknown] command does not exists returns
15991 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
15994 /* The object interp->unknown just contains
15995 * the "unknown" string, it is used in order to
15996 * avoid to lookup the unknown command every time
15997 * but instread to cache the result. */
15998 if (argc
+ 1 <= JIM_EVAL_SARGV_LEN
)
16001 v
= Jim_Alloc(sizeof(Jim_Obj
*) * (argc
+ 1));
16002 /* Make a copy of the arguments vector, but shifted on
16003 * the right of one position. The command name of the
16004 * command will be instead the first argument of the
16005 * [unknown] call. */
16006 memcpy(v
+ 1, argv
, sizeof(Jim_Obj
*) * argc
);
16007 v
[0] = interp
->unknown
;
16009 interp
->unknown_called
++;
16010 retCode
= JimEvalObjVector(interp
, argc
+ 1, v
, filename
, linenr
);
16011 interp
->unknown_called
--;
16019 /* Eval the object vector 'objv' composed of 'objc' elements.
16020 * Every element is used as single argument.
16021 * Jim_EvalObj() will call this function every time its object
16022 * argument is of "list" type, with no string representation.
16024 * This is possible because the string representation of a
16025 * list object generated by the UpdateStringOfList is made
16026 * in a way that ensures that every list element is a different
16027 * command argument. */
16028 static int JimEvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
,
16029 const char *filename
, int linenr
)
16034 /* Incr refcount of arguments. */
16035 for (i
= 0; i
< objc
; i
++)
16036 Jim_IncrRefCount(objv
[i
]);
16037 /* Command lookup */
16038 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
16039 if (cmdPtr
== NULL
) {
16040 retcode
= JimUnknown(interp
, objc
, objv
, filename
, linenr
);
16043 /* Call it -- Make sure result is an empty object. */
16044 JimIncrCmdRefCount(cmdPtr
);
16045 Jim_SetEmptyResult(interp
);
16046 if (cmdPtr
->isproc
) {
16047 retcode
= JimCallProcedure(interp
, cmdPtr
, filename
, linenr
, objc
, objv
);
16050 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
16051 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
16053 JimDecrCmdRefCount(interp
, cmdPtr
);
16055 /* Decr refcount of arguments and return the retcode */
16056 for (i
= 0; i
< objc
; i
++)
16057 Jim_DecrRefCount(interp
, objv
[i
]);
16062 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
16064 return JimEvalObjVector(interp
, objc
, objv
, NULL
, 0);
16068 * Invokes 'prefix' as a command with the objv array as arguments.
16070 int Jim_EvalObjPrefix(Jim_Interp
*interp
, const char *prefix
, int objc
, Jim_Obj
*const *objv
)
16074 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
16076 nargv
[0] = Jim_NewStringObj(interp
, prefix
, -1);
16077 for (i
= 0; i
< objc
; i
++) {
16078 nargv
[i
+ 1] = objv
[i
];
16080 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
16085 static void JimAddErrorToStack(Jim_Interp
*interp
, int retcode
, const char *filename
, int line
)
16089 if (rc
== JIM_ERR
&& !interp
->errorFlag
) {
16090 /* This is the first error, so save the file/line information and reset the stack */
16091 interp
->errorFlag
= 1;
16092 JimSetErrorFileName(interp
, filename
);
16093 JimSetErrorLineNumber(interp
, line
);
16095 JimResetStackTrace(interp
);
16096 /* Always add a level where the error first occurs */
16097 interp
->addStackTrace
++;
16100 /* Now if this is an "interesting" level, add it to the stack trace */
16101 if (rc
== JIM_ERR
&& interp
->addStackTrace
> 0) {
16102 /* Add the stack info for the current level */
16104 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), filename
, line
);
16106 /* Note: if we didn't have a filename for this level,
16107 * don't clear the addStackTrace flag
16108 * so we can pick it up at the next level
16111 interp
->addStackTrace
= 0;
16114 Jim_DecrRefCount(interp
, interp
->errorProc
);
16115 interp
->errorProc
= interp
->emptyObj
;
16116 Jim_IncrRefCount(interp
->errorProc
);
16118 else if (rc
== JIM_RETURN
&& interp
->returnCode
== JIM_ERR
) {
16119 /* Propagate the addStackTrace value through 'return -code error' */
16122 interp
->addStackTrace
= 0;
16126 /* And delete any local procs */
16127 static void JimDeleteLocalProcs(Jim_Interp
*interp
)
16129 if (interp
->localProcs
) {
16132 while ((procname
= Jim_StackPop(interp
->localProcs
)) != NULL
) {
16133 /* If there is a pushed command, find it */
16134 Jim_Cmd
*prevCmd
= NULL
;
16135 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, procname
);
16137 Jim_Cmd
*cmd
= (Jim_Cmd
*)he
->u
.val
;
16138 if (cmd
->isproc
&& cmd
->u
.proc
.prevCmd
) {
16139 prevCmd
= cmd
->u
.proc
.prevCmd
;
16140 cmd
->u
.proc
.prevCmd
= NULL
;
16144 /* Delete the local proc */
16145 Jim_DeleteCommand(interp
, procname
);
16148 /* And restore the pushed command */
16149 Jim_AddHashEntry(&interp
->commands
, procname
, prevCmd
);
16151 Jim_Free(procname
);
16153 Jim_FreeStack(interp
->localProcs
);
16154 Jim_Free(interp
->localProcs
);
16155 interp
->localProcs
= NULL
;
16159 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
16163 switch (token
->type
) {
16166 objPtr
= token
->objPtr
;
16169 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
16171 case JIM_TT_DICTSUGAR
:
16172 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
16174 case JIM_TT_EXPRSUGAR
:
16175 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
16178 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
16181 objPtr
= interp
->result
;
16184 /* Stop substituting */
16187 /* just skip this one */
16188 return JIM_CONTINUE
;
16194 JimPanic((1, interp
,
16195 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
16200 *objPtrPtr
= objPtr
;
16206 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
16207 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
16208 * The returned object has refcount = 0.
16210 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
16214 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
16218 if (tokens
<= JIM_EVAL_SINTV_LEN
)
16221 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
16223 /* Compute every token forming the argument
16224 * in the intv objects vector. */
16225 for (i
= 0; i
< tokens
; i
++) {
16226 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
16231 if (flags
& JIM_SUBST_FLAG
) {
16236 /* XXX: Should probably set an error about break outside loop */
16237 /* fall through to error */
16239 if (flags
& JIM_SUBST_FLAG
) {
16243 /* XXX: Ditto continue outside loop */
16244 /* fall through to error */
16247 Jim_DecrRefCount(interp
, intv
[i
]);
16249 if (intv
!= sintv
) {
16254 Jim_IncrRefCount(intv
[i
]);
16255 Jim_String(intv
[i
]);
16256 totlen
+= intv
[i
]->length
;
16259 /* Fast path return for a single token */
16260 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
16261 Jim_DecrRefCount(interp
, intv
[0]);
16265 /* Concatenate every token in an unique
16267 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
16269 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
16270 && token
[2].type
== JIM_TT_VAR
) {
16271 /* May be able to do fast interpolated object -> dictSubst */
16272 objPtr
->typePtr
= &interpolatedObjType
;
16273 objPtr
->internalRep
.twoPtrValue
.ptr1
= (void *)token
;
16274 objPtr
->internalRep
.twoPtrValue
.ptr2
= intv
[2];
16275 Jim_IncrRefCount(intv
[2]);
16278 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
16279 objPtr
->length
= totlen
;
16280 for (i
= 0; i
< tokens
; i
++) {
16282 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
16283 s
+= intv
[i
]->length
;
16284 Jim_DecrRefCount(interp
, intv
[i
]);
16287 objPtr
->bytes
[totlen
] = '\0';
16288 /* Free the intv vector if not static. */
16289 if (intv
!= sintv
) {
16297 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
16298 * Otherwise eval with Jim_EvalObj()
16300 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, const char *filename
, int linenr
)
16302 if (!Jim_IsList(listPtr
)) {
16303 return Jim_EvalObj(interp
, listPtr
);
16306 int retcode
= JIM_OK
;
16308 if (listPtr
->internalRep
.listValue
.len
) {
16309 Jim_IncrRefCount(listPtr
);
16310 retcode
= JimEvalObjVector(interp
,
16311 listPtr
->internalRep
.listValue
.len
,
16312 listPtr
->internalRep
.listValue
.ele
, filename
, linenr
);
16313 Jim_DecrRefCount(interp
, listPtr
);
16319 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
16323 ScriptToken
*token
;
16324 int retcode
= JIM_OK
;
16325 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
16328 interp
->errorFlag
= 0;
16330 /* If the object is of type "list", we can call
16331 * a specialized version of Jim_EvalObj() */
16332 if (Jim_IsList(scriptObjPtr
)) {
16333 return Jim_EvalObjList(interp
, scriptObjPtr
, NULL
, 0);
16336 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
16337 script
= Jim_GetScript(interp
, scriptObjPtr
);
16339 /* Reset the interpreter result. This is useful to
16340 * return the empty result in the case of empty program. */
16341 Jim_SetEmptyResult(interp
);
16343 #ifdef JIM_OPTIMIZATION
16344 /* Check for one of the following common scripts used by for, while
16349 if (script
->len
== 0) {
16350 Jim_DecrRefCount(interp
, scriptObjPtr
);
16353 if (script
->len
== 3
16354 && script
->token
[1].objPtr
->typePtr
== &commandObjType
16355 && script
->token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
16356 && script
->token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
16357 && script
->token
[2].objPtr
->typePtr
== &variableObjType
) {
16359 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, script
->token
[2].objPtr
, JIM_NONE
);
16361 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
16362 JimWideValue(objPtr
)++;
16363 Jim_InvalidateStringRep(objPtr
);
16364 Jim_DecrRefCount(interp
, scriptObjPtr
);
16365 Jim_SetResult(interp
, objPtr
);
16371 /* Now we have to make sure the internal repr will not be
16372 * freed on shimmering.
16374 * Think for example to this:
16376 * set x {llength $x; ... some more code ...}; eval $x
16378 * In order to preserve the internal rep, we increment the
16379 * inUse field of the script internal rep structure. */
16382 token
= script
->token
;
16385 /* Execute every command sequentially until the end of the script
16386 * or an error occurs.
16388 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
16393 /* First token of the line is always JIM_TT_LINE */
16394 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
16395 linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
16397 /* Allocate the arguments vector if required */
16398 if (argc
> JIM_EVAL_SARGV_LEN
)
16399 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
16401 /* Skip the JIM_TT_LINE token */
16404 /* Populate the arguments objects.
16405 * If an error occurs, retcode will be set and
16406 * 'j' will be set to the number of args expanded
16408 for (j
= 0; j
< argc
; j
++) {
16409 long wordtokens
= 1;
16411 Jim_Obj
*wordObjPtr
= NULL
;
16413 if (token
[i
].type
== JIM_TT_WORD
) {
16414 wordtokens
= JimWideValue(token
[i
++].objPtr
);
16415 if (wordtokens
< 0) {
16417 wordtokens
= -wordtokens
;
16421 if (wordtokens
== 1) {
16422 /* Fast path if the token does not
16423 * need interpolation */
16425 switch (token
[i
].type
) {
16428 wordObjPtr
= token
[i
].objPtr
;
16431 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
16433 case JIM_TT_EXPRSUGAR
:
16434 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
16436 case JIM_TT_DICTSUGAR
:
16437 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
16440 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
16441 if (retcode
== JIM_OK
) {
16442 wordObjPtr
= Jim_GetResult(interp
);
16446 JimPanic((1, interp
, "default token type reached " "in Jim_EvalObj()."));
16450 /* For interpolation we call a helper
16451 * function to do the work for us. */
16452 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
16456 if (retcode
== JIM_OK
) {
16462 Jim_IncrRefCount(wordObjPtr
);
16466 argv
[j
] = wordObjPtr
;
16469 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
16470 int len
= Jim_ListLength(interp
, wordObjPtr
);
16471 int newargc
= argc
+ len
- 1;
16475 if (argv
== sargv
) {
16476 if (newargc
> JIM_EVAL_SARGV_LEN
) {
16477 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
16478 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
16482 /* Need to realloc to make room for (len - 1) more entries */
16483 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
16487 /* Now copy in the expanded version */
16488 for (k
= 0; k
< len
; k
++) {
16489 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
16490 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
16493 /* The original object reference is no longer needed,
16494 * after the expansion it is no longer present on
16495 * the argument vector, but the single elements are
16497 Jim_DecrRefCount(interp
, wordObjPtr
);
16499 /* And update the indexes */
16505 if (retcode
== JIM_OK
&& argc
) {
16506 /* Lookup the command to call */
16507 cmd
= Jim_GetCommand(interp
, argv
[0], JIM_ERRMSG
);
16509 /* Call it -- Make sure result is an empty object. */
16510 JimIncrCmdRefCount(cmd
);
16511 Jim_SetEmptyResult(interp
);
16514 JimCallProcedure(interp
, cmd
, script
->fileName
, linenr
, argc
, argv
);
16516 interp
->cmdPrivData
= cmd
->u
.native
.privData
;
16517 retcode
= cmd
->u
.native
.cmdProc(interp
, argc
, argv
);
16519 JimDecrCmdRefCount(interp
, cmd
);
16522 /* Call [unknown] */
16523 retcode
= JimUnknown(interp
, argc
, argv
, script
->fileName
, linenr
);
16525 if (interp
->signal_level
&& interp
->sigmask
) {
16526 /* Check for a signal after each command */
16527 retcode
= JIM_SIGNAL
;
16531 /* Finished with the command, so decrement ref counts of each argument */
16533 Jim_DecrRefCount(interp
, argv
[j
]);
16536 if (argv
!= sargv
) {
16542 /* Possibly add to the error stack trace */
16543 JimAddErrorToStack(interp
, retcode
, script
->fileName
, linenr
);
16545 /* Note that we don't have to decrement inUse, because the
16546 * following code transfers our use of the reference again to
16547 * the script object. */
16548 Jim_FreeIntRep(interp
, scriptObjPtr
);
16549 scriptObjPtr
->typePtr
= &scriptObjType
;
16550 Jim_SetIntRepPtr(scriptObjPtr
, script
);
16551 Jim_DecrRefCount(interp
, scriptObjPtr
);
16556 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
16559 /* If argObjPtr begins with '&', do an automatic upvar */
16560 const char *varname
= Jim_String(argNameObj
);
16561 if (*varname
== '&') {
16562 /* First check that the target variable exists */
16564 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
16566 interp
->framePtr
= interp
->framePtr
->parentCallFrame
;
16567 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
16568 interp
->framePtr
= savedCallFrame
;
16573 /* It exists, so perform the binding. */
16574 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
16575 Jim_IncrRefCount(objPtr
);
16576 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parentCallFrame
);
16577 Jim_DecrRefCount(interp
, objPtr
);
16580 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
16586 * Sets the interp result to be an error message indicating the required proc args.
16588 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
16590 /* Create a nice error message, consistent with Tcl 8.5 */
16591 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
16594 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
16595 Jim_AppendString(interp
, argmsg
, " ", 1);
16597 if (i
== cmd
->u
.proc
.argsPos
) {
16598 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
16600 Jim_AppendString(interp
, argmsg
, "?", 1);
16601 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
16602 Jim_AppendString(interp
, argmsg
, " ...?", -1);
16605 /* We have plain args */
16606 Jim_AppendString(interp
, argmsg
, "?argument ...?", -1);
16610 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
16611 Jim_AppendString(interp
, argmsg
, "?", 1);
16612 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
16613 Jim_AppendString(interp
, argmsg
, "?", 1);
16616 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
16620 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
16621 Jim_FreeNewObj(interp
, argmsg
);
16624 /* Call a procedure implemented in Tcl.
16625 * It's possible to speed-up a lot this function, currently
16626 * the callframes are not cached, but allocated and
16627 * destroied every time. What is expecially costly is
16628 * to create/destroy the local vars hash table every time.
16630 * This can be fixed just implementing callframes caching
16631 * in JimCreateCallFrame() and JimFreeCallFrame(). */
16632 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, const char *filename
, int linenr
, int argc
,
16633 Jim_Obj
*const *argv
)
16635 Jim_CallFrame
*callFramePtr
;
16636 Jim_Stack
*prevLocalProcs
;
16637 int i
, d
, retcode
, optargs
;
16640 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
16641 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
16642 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
16646 /* Check if there are too nested calls */
16647 if (interp
->framePtr
->level
== interp
->maxNestingDepth
) {
16648 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
16652 /* Create a new callframe */
16653 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
);
16654 callFramePtr
->argv
= argv
;
16655 callFramePtr
->argc
= argc
;
16656 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
16657 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
16658 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
16659 callFramePtr
->filename
= filename
;
16660 callFramePtr
->line
= linenr
;
16661 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
16662 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
16663 interp
->framePtr
= callFramePtr
;
16665 /* How many optional args are available */
16666 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
16668 /* Step 'i' along the actual args, and step 'd' along the formal args */
16670 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
16671 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
16672 if (d
== cmd
->u
.proc
.argsPos
) {
16674 Jim_Obj
*listObjPtr
;
16676 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
16677 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
16679 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
16681 /* It is possible to rename args. */
16682 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
16683 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
16685 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
16686 if (retcode
!= JIM_OK
) {
16694 /* Optional or required? */
16695 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
16696 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
16699 /* Ran out, so use the default */
16700 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
16702 if (retcode
!= JIM_OK
) {
16707 /* Install a new stack for local procs */
16708 prevLocalProcs
= interp
->localProcs
;
16709 interp
->localProcs
= NULL
;
16711 /* Eval the body */
16712 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
16714 /* Delete any local procs */
16715 JimDeleteLocalProcs(interp
);
16716 interp
->localProcs
= prevLocalProcs
;
16719 /* Destroy the callframe */
16720 interp
->framePtr
= interp
->framePtr
->parentCallFrame
;
16721 if (callFramePtr
->vars
.size
!= JIM_HT_INITIAL_SIZE
) {
16722 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NONE
);
16725 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_NOHT
);
16727 /* Handle the JIM_EVAL return code */
16728 while (retcode
== JIM_EVAL
) {
16729 Jim_Obj
*resultScriptObjPtr
= Jim_GetResult(interp
);
16731 Jim_IncrRefCount(resultScriptObjPtr
);
16732 /* Should be a list! */
16733 retcode
= Jim_EvalObjList(interp
, resultScriptObjPtr
, filename
, linenr
);
16734 Jim_DecrRefCount(interp
, resultScriptObjPtr
);
16736 /* Handle the JIM_RETURN return code */
16737 if (retcode
== JIM_RETURN
) {
16738 if (--interp
->returnLevel
<= 0) {
16739 retcode
= interp
->returnCode
;
16740 interp
->returnCode
= JIM_OK
;
16741 interp
->returnLevel
= 0;
16744 else if (retcode
== JIM_ERR
) {
16745 interp
->addStackTrace
++;
16746 Jim_DecrRefCount(interp
, interp
->errorProc
);
16747 interp
->errorProc
= argv
[0];
16748 Jim_IncrRefCount(interp
->errorProc
);
16753 int Jim_Eval_Named(Jim_Interp
*interp
, const char *script
, const char *filename
, int lineno
)
16756 Jim_Obj
*scriptObjPtr
;
16758 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
16759 Jim_IncrRefCount(scriptObjPtr
);
16763 Jim_Obj
*prevScriptObj
;
16765 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, lineno
);
16767 prevScriptObj
= interp
->currentScriptObj
;
16768 interp
->currentScriptObj
= scriptObjPtr
;
16770 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
16772 interp
->currentScriptObj
= prevScriptObj
;
16775 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
16777 Jim_DecrRefCount(interp
, scriptObjPtr
);
16781 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
16783 return Jim_Eval_Named(interp
, script
, NULL
, 0);
16786 /* Execute script in the scope of the global level */
16787 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
16790 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
16792 interp
->framePtr
= interp
->topFramePtr
;
16793 retval
= Jim_Eval(interp
, script
);
16794 interp
->framePtr
= savedFramePtr
;
16799 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
16802 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
16804 interp
->framePtr
= interp
->topFramePtr
;
16805 retval
= Jim_EvalFile(interp
, filename
);
16806 interp
->framePtr
= savedFramePtr
;
16811 #include <sys/stat.h>
16813 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
16817 Jim_Obj
*scriptObjPtr
;
16818 Jim_Obj
*prevScriptObj
;
16822 struct JimParseResult result
;
16824 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
16825 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
16828 if (sb
.st_size
== 0) {
16833 buf
= Jim_Alloc(sb
.st_size
+ 1);
16834 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
16838 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
16844 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
16845 JimSetSourceInfo(interp
, scriptObjPtr
, filename
, 1);
16846 Jim_IncrRefCount(scriptObjPtr
);
16848 /* Now check the script for unmatched braces, etc. */
16849 if (SetScriptFromAny(interp
, scriptObjPtr
, &result
) == JIM_ERR
) {
16853 switch (result
.missing
) {
16855 msg
= "unmatched \"[\"";
16858 msg
= "missing close-brace";
16862 msg
= "missing quote";
16866 snprintf(linebuf
, sizeof(linebuf
), "%d", result
.line
);
16868 Jim_SetResultFormatted(interp
, "%s in \"%s\" at line %s",
16869 msg
, filename
, linebuf
);
16870 Jim_DecrRefCount(interp
, scriptObjPtr
);
16874 prevScriptObj
= interp
->currentScriptObj
;
16875 interp
->currentScriptObj
= scriptObjPtr
;
16877 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
16879 /* Handle the JIM_RETURN return code */
16880 if (retcode
== JIM_RETURN
) {
16881 if (--interp
->returnLevel
<= 0) {
16882 retcode
= interp
->returnCode
;
16883 interp
->returnCode
= JIM_OK
;
16884 interp
->returnLevel
= 0;
16887 if (retcode
== JIM_ERR
) {
16888 /* EvalFile changes context, so add a stack frame here */
16889 interp
->addStackTrace
++;
16892 interp
->currentScriptObj
= prevScriptObj
;
16894 Jim_DecrRefCount(interp
, scriptObjPtr
);
16899 /* -----------------------------------------------------------------------------
16901 * ---------------------------------------------------------------------------*/
16902 static int JimParseSubstStr(struct JimParserCtx
*pc
)
16904 pc
->tstart
= pc
->p
;
16905 pc
->tline
= pc
->linenr
;
16906 while (pc
->len
&& *pc
->p
!= '$' && *pc
->p
!= '[') {
16907 if (*pc
->p
== '\\' && pc
->len
> 1) {
16914 pc
->tend
= pc
->p
- 1;
16915 pc
->tt
= JIM_TT_ESC
;
16919 static int JimParseSubst(struct JimParserCtx
*pc
, int flags
)
16923 if (pc
->len
== 0) {
16924 pc
->tstart
= pc
->tend
= pc
->p
;
16925 pc
->tline
= pc
->linenr
;
16926 pc
->tt
= JIM_TT_EOL
;
16932 retval
= JimParseCmd(pc
);
16933 if (flags
& JIM_SUBST_NOCMD
) {
16936 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
16941 if (JimParseVar(pc
) == JIM_ERR
) {
16942 pc
->tstart
= pc
->tend
= pc
->p
++;
16944 pc
->tline
= pc
->linenr
;
16945 pc
->tt
= JIM_TT_STR
;
16948 if (flags
& JIM_SUBST_NOVAR
) {
16950 if (flags
& JIM_SUBST_NOESC
)
16951 pc
->tt
= JIM_TT_STR
;
16953 pc
->tt
= JIM_TT_ESC
;
16954 if (*pc
->tstart
== '{') {
16956 if (*(pc
->tend
+ 1))
16963 retval
= JimParseSubstStr(pc
);
16964 if (flags
& JIM_SUBST_NOESC
)
16965 pc
->tt
= JIM_TT_STR
;
16972 /* The subst object type reuses most of the data structures and functions
16973 * of the script object. Script's data structures are a bit more complex
16974 * for what is needed for [subst]itution tasks, but the reuse helps to
16975 * deal with a single data structure at the cost of some more memory
16976 * usage for substitutions. */
16978 /* This method takes the string representation of an object
16979 * as a Tcl string where to perform [subst]itution, and generates
16980 * the pre-parsed internal representation. */
16981 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
16984 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
16985 struct JimParserCtx parser
;
16986 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
16987 ParseTokenList tokenlist
;
16989 /* Initially parse the subst into tokens (in tokenlist) */
16990 ScriptTokenListInit(&tokenlist
);
16992 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
16994 JimParseSubst(&parser
, flags
);
16996 /* Note that subst doesn't need the EOL token */
16999 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
17003 /* Create the "real" subst/script tokens from the initial token list */
17005 script
->substFlags
= flags
;
17006 script
->fileName
= NULL
;
17007 SubstObjAddTokens(interp
, script
, &tokenlist
);
17009 /* No longer need the token list */
17010 ScriptTokenListFree(&tokenlist
);
17012 #ifdef DEBUG_SHOW_SUBST
17016 printf("==== Subst ====\n");
17017 for (i
= 0; i
< script
->len
; i
++) {
17018 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
17019 Jim_String(script
->token
[i
].objPtr
));
17024 /* Free the old internal rep and set the new one. */
17025 Jim_FreeIntRep(interp
, objPtr
);
17026 Jim_SetIntRepPtr(objPtr
, script
);
17027 objPtr
->typePtr
= &scriptObjType
;
17031 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
17033 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
17034 SetSubstFromAny(interp
, objPtr
, flags
);
17035 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
17038 /* Performs commands,variables,blackslashes substitution,
17039 * storing the result object (with refcount 0) into
17041 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
17043 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
17045 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
17046 /* In order to preserve the internal rep, we increment the
17047 * inUse field of the script internal rep structure. */
17050 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
17053 Jim_DecrRefCount(interp
, substObjPtr
);
17054 if (*resObjPtrPtr
== NULL
) {
17060 /* -----------------------------------------------------------------------------
17061 * Core commands utility functions
17062 * ---------------------------------------------------------------------------*/
17063 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
17066 Jim_Obj
*objPtr
= Jim_NewEmptyStringObj(interp
);
17068 Jim_AppendString(interp
, objPtr
, "wrong # args: should be \"", -1);
17069 for (i
= 0; i
< argc
; i
++) {
17070 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
17071 if (!(i
+ 1 == argc
&& msg
[0] == '\0'))
17072 Jim_AppendString(interp
, objPtr
, " ", 1);
17074 Jim_AppendString(interp
, objPtr
, msg
, -1);
17075 Jim_AppendString(interp
, objPtr
, "\"", 1);
17076 Jim_SetResult(interp
, objPtr
);
17079 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
17081 /* type is: 0=commands, 1=procs, 2=channels */
17082 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
17084 Jim_HashTableIterator
*htiter
;
17086 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
17088 /* Check for the non-pattern case. We can do this much more efficiently. */
17089 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
17090 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, patternObjPtr
, JIM_NONE
);
17092 if (type
== 1 && !cmdPtr
->isproc
) {
17095 else if (type
== 2 && !Jim_AioFilehandle(interp
, patternObjPtr
)) {
17096 /* not a channel */
17099 Jim_ListAppendElement(interp
, listObjPtr
, patternObjPtr
);
17105 htiter
= Jim_GetHashTableIterator(&interp
->commands
);
17106 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
17107 Jim_Cmd
*cmdPtr
= he
->u
.val
;
17108 Jim_Obj
*cmdNameObj
;
17110 if (type
== 1 && !cmdPtr
->isproc
) {
17114 if (patternObjPtr
&& !JimStringMatch(interp
, patternObjPtr
, he
->key
, 0))
17117 cmdNameObj
= Jim_NewStringObj(interp
, he
->key
, -1);
17119 /* Is it a channel? */
17120 if (type
== 2 && !Jim_AioFilehandle(interp
, cmdNameObj
)) {
17121 Jim_FreeNewObj(interp
, cmdNameObj
);
17125 Jim_ListAppendElement(interp
, listObjPtr
, cmdNameObj
);
17127 Jim_FreeHashTableIterator(htiter
);
17131 /* Keep this in order */
17132 #define JIM_VARLIST_GLOBALS 0
17133 #define JIM_VARLIST_LOCALS 1
17134 #define JIM_VARLIST_VARS 2
17136 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
17138 Jim_HashTableIterator
*htiter
;
17140 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
17142 if (mode
== JIM_VARLIST_GLOBALS
) {
17143 htiter
= Jim_GetHashTableIterator(&interp
->topFramePtr
->vars
);
17146 /* For [info locals], if we are at top level an emtpy list
17147 * is returned. I don't agree, but we aim at compatibility (SS) */
17148 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
)
17150 htiter
= Jim_GetHashTableIterator(&interp
->framePtr
->vars
);
17152 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
17153 Jim_Var
*varPtr
= (Jim_Var
*)he
->u
.val
;
17155 if (mode
== JIM_VARLIST_LOCALS
) {
17156 if (varPtr
->linkFramePtr
!= NULL
)
17159 if (patternObjPtr
&& !JimStringMatch(interp
, patternObjPtr
, he
->key
, 0))
17161 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
17163 Jim_FreeHashTableIterator(htiter
);
17167 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
17168 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
17170 Jim_CallFrame
*targetCallFrame
;
17172 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
17173 if (targetCallFrame
== NULL
) {
17176 /* No proc call at toplevel callframe */
17177 if (targetCallFrame
== interp
->topFramePtr
) {
17178 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
17181 if (info_level_cmd
) {
17182 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
17185 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
17187 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
17188 Jim_ListAppendElement(interp
, listObj
, Jim_NewStringObj(interp
,
17189 targetCallFrame
->filename
? targetCallFrame
->filename
: "", -1));
17190 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
17191 *objPtrPtr
= listObj
;
17196 /* -----------------------------------------------------------------------------
17198 * ---------------------------------------------------------------------------*/
17200 /* fake [puts] -- not the real puts, just for debugging. */
17201 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17203 if (argc
!= 2 && argc
!= 3) {
17204 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
17208 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
17209 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
17213 fputs(Jim_String(argv
[2]), stdout
);
17217 puts(Jim_String(argv
[1]));
17222 /* Helper for [+] and [*] */
17223 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
17225 jim_wide wideValue
, res
;
17226 double doubleValue
, doubleRes
;
17229 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
17231 for (i
= 1; i
< argc
; i
++) {
17232 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
17234 if (op
== JIM_EXPROP_ADD
)
17239 Jim_SetResultInt(interp
, res
);
17242 doubleRes
= (double)res
;
17243 for (; i
< argc
; i
++) {
17244 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
17246 if (op
== JIM_EXPROP_ADD
)
17247 doubleRes
+= doubleValue
;
17249 doubleRes
*= doubleValue
;
17251 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17255 /* Helper for [-] and [/] */
17256 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
17258 jim_wide wideValue
, res
= 0;
17259 double doubleValue
, doubleRes
= 0;
17263 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
17266 else if (argc
== 2) {
17267 /* The arity = 2 case is different. For [- x] returns -x,
17268 * while [/ x] returns 1/x. */
17269 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
17270 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
17274 if (op
== JIM_EXPROP_SUB
)
17275 doubleRes
= -doubleValue
;
17277 doubleRes
= 1.0 / doubleValue
;
17278 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17282 if (op
== JIM_EXPROP_SUB
) {
17284 Jim_SetResultInt(interp
, res
);
17287 doubleRes
= 1.0 / wideValue
;
17288 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17293 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
17294 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
17303 for (i
= 2; i
< argc
; i
++) {
17304 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
17305 doubleRes
= (double)res
;
17308 if (op
== JIM_EXPROP_SUB
)
17313 Jim_SetResultInt(interp
, res
);
17316 for (; i
< argc
; i
++) {
17317 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
17319 if (op
== JIM_EXPROP_SUB
)
17320 doubleRes
-= doubleValue
;
17322 doubleRes
/= doubleValue
;
17324 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
17330 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17332 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
17336 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17338 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
17342 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17344 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
17348 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17350 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
17354 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17356 if (argc
!= 2 && argc
!= 3) {
17357 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
17363 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
17366 Jim_SetResult(interp
, objPtr
);
17369 /* argc == 3 case. */
17370 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
17372 Jim_SetResult(interp
, argv
[2]);
17378 * unset ?-nocomplain? ?--? ?varName ...?
17380 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17386 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
17390 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
17399 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
17409 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17412 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
17416 /* The general purpose implementation of while starts here */
17418 int boolean
, retval
;
17420 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
17425 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
17439 Jim_SetEmptyResult(interp
);
17444 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17448 Jim_Obj
*varNamePtr
= NULL
;
17449 Jim_Obj
*stopVarNamePtr
= NULL
;
17452 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
17456 /* Do the initialisation */
17457 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
17461 /* And do the first test now. Better for optimisation
17462 * if we can do next/test at the bottom of the loop
17464 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
17466 /* Ready to do the body as follows:
17468 * body // check retcode
17469 * next // check retcode
17470 * test // check retcode/test bool
17474 #ifdef JIM_OPTIMIZATION
17475 /* Check if the for is on the form:
17476 * for ... {$i < CONST} {incr i}
17477 * for ... {$i < $j} {incr i}
17479 if (retval
== JIM_OK
&& boolean
) {
17480 ScriptObj
*incrScript
;
17481 ExprByteCode
*expr
;
17482 jim_wide stop
, currentVal
;
17483 unsigned jim_wide procEpoch
;
17487 /* Do it only if there aren't shared arguments */
17488 expr
= JimGetExpression(interp
, argv
[2]);
17489 incrScript
= Jim_GetScript(interp
, argv
[3]);
17491 /* Ensure proper lengths to start */
17492 if (incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
17495 /* Ensure proper token types. */
17496 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
17497 expr
->token
[0].type
!= JIM_TT_VAR
||
17498 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
17502 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
17505 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
17512 /* Update command must be incr */
17513 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
17517 /* incr, expression must be about the same variable */
17518 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
17522 /* Get the stop condition (must be a variable or integer) */
17523 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
17524 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
17529 stopVarNamePtr
= expr
->token
[1].objPtr
;
17530 Jim_IncrRefCount(stopVarNamePtr
);
17531 /* Keep the compiler happy */
17535 /* Initialization */
17536 procEpoch
= interp
->procEpoch
;
17537 varNamePtr
= expr
->token
[0].objPtr
;
17538 Jim_IncrRefCount(varNamePtr
);
17540 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
17541 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
17545 /* --- OPTIMIZED FOR --- */
17546 while (retval
== JIM_OK
) {
17547 /* === Check condition === */
17548 /* Note that currentVal is already set here */
17550 /* Immediate or Variable? get the 'stop' value if the latter. */
17551 if (stopVarNamePtr
) {
17552 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
17553 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
17558 if (currentVal
>= stop
+ cmpOffset
) {
17563 retval
= Jim_EvalObj(interp
, argv
[4]);
17564 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17566 /* If there was a change in procedures/command continue
17567 * with the usual [for] command implementation */
17568 if (procEpoch
!= interp
->procEpoch
) {
17572 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
17575 if (objPtr
== NULL
) {
17579 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
17580 currentVal
= ++JimWideValue(objPtr
);
17581 Jim_InvalidateStringRep(objPtr
);
17584 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
17585 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
17586 ++currentVal
)) != JIM_OK
) {
17597 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
17599 retval
= Jim_EvalObj(interp
, argv
[4]);
17601 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17604 retval
= Jim_EvalObj(interp
, argv
[3]);
17605 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17608 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
17613 if (stopVarNamePtr
) {
17614 Jim_DecrRefCount(interp
, stopVarNamePtr
);
17617 Jim_DecrRefCount(interp
, varNamePtr
);
17620 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
17621 Jim_SetEmptyResult(interp
);
17629 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17635 Jim_Obj
*bodyObjPtr
;
17637 if (argc
!= 5 && argc
!= 6) {
17638 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
17642 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
17643 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
17644 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
17647 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
17649 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
17651 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
17652 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
17653 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
17654 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
17661 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
17662 if (argv
[1]->typePtr
!= &variableObjType
) {
17663 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
17667 JimWideValue(objPtr
) = i
;
17668 Jim_InvalidateStringRep(objPtr
);
17670 /* The following step is required in order to invalidate the
17671 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
17672 if (argv
[1]->typePtr
!= &variableObjType
) {
17673 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
17680 objPtr
= Jim_NewIntObj(interp
, i
);
17681 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
17682 if (retval
!= JIM_OK
) {
17683 Jim_FreeNewObj(interp
, objPtr
);
17689 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
17690 Jim_SetEmptyResult(interp
);
17696 /* foreach + lmap implementation. */
17697 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
17699 int result
= JIM_ERR
, i
, nbrOfLists
, *listsIdx
, *listsEnd
;
17700 int nbrOfLoops
= 0;
17701 Jim_Obj
*emptyStr
, *script
, *mapRes
= NULL
;
17703 if (argc
< 4 || argc
% 2 != 0) {
17704 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
17708 mapRes
= Jim_NewListObj(interp
, NULL
, 0);
17709 Jim_IncrRefCount(mapRes
);
17711 emptyStr
= Jim_NewEmptyStringObj(interp
);
17712 Jim_IncrRefCount(emptyStr
);
17713 script
= argv
[argc
- 1]; /* Last argument is a script */
17714 nbrOfLists
= (argc
- 1 - 1) / 2; /* argc - 'foreach' - script */
17715 listsIdx
= (int *)Jim_Alloc(nbrOfLists
* sizeof(int));
17716 listsEnd
= (int *)Jim_Alloc(nbrOfLists
* 2 * sizeof(int));
17717 /* Initialize iterators and remember max nbr elements each list */
17718 memset(listsIdx
, 0, nbrOfLists
* sizeof(int));
17719 /* Remember lengths of all lists and calculate how much rounds to loop */
17720 for (i
= 0; i
< nbrOfLists
* 2; i
+= 2) {
17724 listsEnd
[i
] = Jim_ListLength(interp
, argv
[i
+ 1]);
17725 listsEnd
[i
+ 1] = Jim_ListLength(interp
, argv
[i
+ 2]);
17726 if (listsEnd
[i
] == 0) {
17727 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
17730 cnt
= div(listsEnd
[i
+ 1], listsEnd
[i
]);
17731 count
= cnt
.quot
+ (cnt
.rem
? 1 : 0);
17732 if (count
> nbrOfLoops
)
17733 nbrOfLoops
= count
;
17735 for (; nbrOfLoops
-- > 0;) {
17736 for (i
= 0; i
< nbrOfLists
; ++i
) {
17737 int varIdx
= 0, var
= i
* 2;
17739 while (varIdx
< listsEnd
[var
]) {
17740 Jim_Obj
*varName
, *ele
;
17741 int lst
= i
* 2 + 1;
17743 /* List index operations below can't fail */
17744 Jim_ListIndex(interp
, argv
[var
+ 1], varIdx
, &varName
, JIM_NONE
);
17745 if (listsIdx
[i
] < listsEnd
[lst
]) {
17746 Jim_ListIndex(interp
, argv
[lst
+ 1], listsIdx
[i
], &ele
, JIM_NONE
);
17747 /* Avoid shimmering */
17748 Jim_IncrRefCount(ele
);
17749 result
= Jim_SetVariable(interp
, varName
, ele
);
17750 Jim_DecrRefCount(interp
, ele
);
17751 if (result
== JIM_OK
) {
17752 ++listsIdx
[i
]; /* Remember next iterator of current list */
17753 ++varIdx
; /* Next variable */
17757 else if (Jim_SetVariable(interp
, varName
, emptyStr
) == JIM_OK
) {
17758 ++varIdx
; /* Next variable */
17764 switch (result
= Jim_EvalObj(interp
, script
)) {
17767 Jim_ListAppendElement(interp
, mapRes
, interp
->result
);
17781 Jim_SetResult(interp
, mapRes
);
17783 Jim_SetEmptyResult(interp
);
17786 Jim_DecrRefCount(interp
, mapRes
);
17787 Jim_DecrRefCount(interp
, emptyStr
);
17788 Jim_Free(listsIdx
);
17789 Jim_Free(listsEnd
);
17794 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17796 return JimForeachMapHelper(interp
, argc
, argv
, 0);
17800 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17802 return JimForeachMapHelper(interp
, argc
, argv
, 1);
17806 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17808 int boolean
, retval
, current
= 1, falsebody
= 0;
17812 /* Far not enough arguments given! */
17813 if (current
>= argc
)
17815 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
17818 /* There lacks something, isn't it? */
17819 if (current
>= argc
)
17821 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
17823 /* Tsk tsk, no then-clause? */
17824 if (current
>= argc
)
17827 return Jim_EvalObj(interp
, argv
[current
]);
17828 /* Ok: no else-clause follows */
17829 if (++current
>= argc
) {
17830 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
17833 falsebody
= current
++;
17834 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
17835 /* IIICKS - else-clause isn't last cmd? */
17836 if (current
!= argc
- 1)
17838 return Jim_EvalObj(interp
, argv
[current
]);
17840 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
17841 /* Ok: elseif follows meaning all the stuff
17842 * again (how boring...) */
17844 /* OOPS - else-clause is not last cmd? */
17845 else if (falsebody
!= argc
- 1)
17847 return Jim_EvalObj(interp
, argv
[falsebody
]);
17852 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
17857 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
17858 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
17859 Jim_Obj
*stringObj
, int nocase
)
17866 parms
[argc
++] = commandObj
;
17868 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
17870 parms
[argc
++] = patternObj
;
17871 parms
[argc
++] = stringObj
;
17873 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
17875 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
17883 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
17886 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17888 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
17889 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
17890 Jim_Obj
*script
= 0;
17894 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
17895 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
17898 for (opt
= 1; opt
< argc
; ++opt
) {
17899 const char *option
= Jim_GetString(argv
[opt
], 0);
17901 if (*option
!= '-')
17903 else if (strncmp(option
, "--", 2) == 0) {
17907 else if (strncmp(option
, "-exact", 2) == 0)
17908 matchOpt
= SWITCH_EXACT
;
17909 else if (strncmp(option
, "-glob", 2) == 0)
17910 matchOpt
= SWITCH_GLOB
;
17911 else if (strncmp(option
, "-regexp", 2) == 0)
17912 matchOpt
= SWITCH_RE
;
17913 else if (strncmp(option
, "-command", 2) == 0) {
17914 matchOpt
= SWITCH_CMD
;
17915 if ((argc
- opt
) < 2)
17917 command
= argv
[++opt
];
17920 Jim_SetResultFormatted(interp
,
17921 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
17925 if ((argc
- opt
) < 2)
17928 strObj
= argv
[opt
++];
17929 patCount
= argc
- opt
;
17930 if (patCount
== 1) {
17933 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
17937 caseList
= &argv
[opt
];
17938 if (patCount
== 0 || patCount
% 2 != 0)
17940 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
17941 Jim_Obj
*patObj
= caseList
[i
];
17943 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
17944 || i
< (patCount
- 2)) {
17945 switch (matchOpt
) {
17947 if (Jim_StringEqObj(strObj
, patObj
))
17948 script
= caseList
[i
+ 1];
17951 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
17952 script
= caseList
[i
+ 1];
17955 command
= Jim_NewStringObj(interp
, "regexp", -1);
17956 /* Fall thru intentionally */
17958 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
17960 /* After the execution of a command we need to
17961 * make sure to reconvert the object into a list
17962 * again. Only for the single-list style [switch]. */
17963 if (argc
- opt
== 1) {
17966 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
17969 /* command is here already decref'd */
17974 script
= caseList
[i
+ 1];
17980 script
= caseList
[i
+ 1];
17983 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
17984 script
= caseList
[i
+ 1];
17985 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
17986 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
17989 Jim_SetEmptyResult(interp
);
17991 return Jim_EvalObj(interp
, script
);
17997 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
17999 Jim_Obj
*listObjPtr
;
18001 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
18002 Jim_SetResult(interp
, listObjPtr
);
18007 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18009 Jim_Obj
*objPtr
, *listObjPtr
;
18014 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?...?");
18018 Jim_IncrRefCount(objPtr
);
18019 for (i
= 2; i
< argc
; i
++) {
18020 listObjPtr
= objPtr
;
18021 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
18022 Jim_DecrRefCount(interp
, listObjPtr
);
18025 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
18026 /* Returns an empty object if the index
18027 * is out of range. */
18028 Jim_DecrRefCount(interp
, listObjPtr
);
18029 Jim_SetEmptyResult(interp
);
18032 Jim_IncrRefCount(objPtr
);
18033 Jim_DecrRefCount(interp
, listObjPtr
);
18035 Jim_SetResult(interp
, objPtr
);
18036 Jim_DecrRefCount(interp
, objPtr
);
18041 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18044 Jim_WrongNumArgs(interp
, 1, argv
, "list");
18047 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
18052 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18054 static const char * const options
[] = {
18055 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
18059 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
18064 int opt_nocase
= 0;
18066 int opt_inline
= 0;
18067 int opt_match
= OPT_EXACT
;
18070 Jim_Obj
*listObjPtr
= NULL
;
18071 Jim_Obj
*commandObj
= NULL
;
18075 Jim_WrongNumArgs(interp
, 1, argv
,
18076 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
18080 for (i
= 1; i
< argc
- 2; i
++) {
18083 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
18105 if (i
>= argc
- 2) {
18108 commandObj
= argv
[++i
];
18113 opt_match
= option
;
18121 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18123 if (opt_match
== OPT_REGEXP
) {
18124 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
18127 Jim_IncrRefCount(commandObj
);
18130 listlen
= Jim_ListLength(interp
, argv
[0]);
18131 for (i
= 0; i
< listlen
; i
++) {
18135 Jim_ListIndex(interp
, argv
[0], i
, &objPtr
, JIM_NONE
);
18136 switch (opt_match
) {
18138 eq
= Jim_StringCompareObj(interp
, objPtr
, argv
[1], opt_nocase
) == 0;
18142 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
18147 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
18150 Jim_FreeNewObj(interp
, listObjPtr
);
18158 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
18159 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
18163 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
18164 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
18165 Jim_Obj
*resultObj
;
18168 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
18170 else if (!opt_inline
) {
18171 resultObj
= Jim_NewIntObj(interp
, i
);
18174 resultObj
= objPtr
;
18178 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
18181 Jim_SetResult(interp
, resultObj
);
18188 Jim_SetResult(interp
, listObjPtr
);
18193 Jim_SetResultBool(interp
, opt_not
);
18195 else if (!opt_inline
) {
18196 Jim_SetResultInt(interp
, -1);
18202 Jim_DecrRefCount(interp
, commandObj
);
18208 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18210 Jim_Obj
*listObjPtr
;
18214 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
18217 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
18219 /* Create the list if it does not exists */
18220 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18221 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
18222 Jim_FreeNewObj(interp
, listObjPtr
);
18226 shared
= Jim_IsShared(listObjPtr
);
18228 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
18229 for (i
= 2; i
< argc
; i
++)
18230 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
18231 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
18233 Jim_FreeNewObj(interp
, listObjPtr
);
18236 Jim_SetResult(interp
, listObjPtr
);
18241 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18247 Jim_WrongNumArgs(interp
, 1, argv
, "list index element " "?element ...?");
18251 if (Jim_IsShared(listPtr
))
18252 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
18253 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
18255 len
= Jim_ListLength(interp
, listPtr
);
18259 idx
= len
+ idx
+ 1;
18260 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
18261 Jim_SetResult(interp
, listPtr
);
18264 if (listPtr
!= argv
[1]) {
18265 Jim_FreeNewObj(interp
, listPtr
);
18271 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18273 int first
, last
, len
, rangeLen
;
18275 Jim_Obj
*newListObj
;
18280 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element element ...?");
18283 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
18284 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
18289 len
= Jim_ListLength(interp
, listObj
);
18291 first
= JimRelToAbsIndex(len
, first
);
18292 last
= JimRelToAbsIndex(len
, last
);
18293 JimRelToAbsRange(len
, first
, last
, &first
, &last
, &rangeLen
);
18295 /* Now construct a new list which consists of:
18296 * <elements before first> <supplied elements> <elements after last>
18299 /* Check to see if trying to replace past the end of the list */
18301 /* OK. Not past the end */
18303 else if (len
== 0) {
18304 /* Special for empty list, adjust first to 0 */
18308 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
18309 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
18313 newListObj
= Jim_NewListObj(interp
, NULL
, 0);
18315 shared
= Jim_IsShared(listObj
);
18317 listObj
= Jim_DuplicateObj(interp
, listObj
);
18320 /* Add the first set of elements */
18321 for (i
= 0; i
< first
; i
++) {
18322 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
18325 /* Add supplied elements */
18326 for (i
= 4; i
< argc
; i
++) {
18327 Jim_ListAppendElement(interp
, newListObj
, argv
[i
]);
18330 /* Add the remaining elements */
18331 for (i
= first
+ rangeLen
; i
< len
; i
++) {
18332 Jim_ListAppendElement(interp
, newListObj
, listObj
->internalRep
.listValue
.ele
[i
]);
18334 Jim_SetResult(interp
, newListObj
);
18336 Jim_FreeNewObj(interp
, listObj
);
18342 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18345 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
18348 else if (argc
== 3) {
18349 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
18351 Jim_SetResult(interp
, argv
[2]);
18354 if (Jim_SetListIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1])
18361 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
18363 static const char * const options
[] = {
18364 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
18367 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_INDEX
};
18372 struct lsort_info info
;
18375 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
18379 info
.type
= JIM_LSORT_ASCII
;
18382 info
.command
= NULL
;
18383 info
.interp
= interp
;
18385 for (i
= 1; i
< (argc
- 1); i
++) {
18388 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
)
18393 info
.type
= JIM_LSORT_ASCII
;
18396 info
.type
= JIM_LSORT_NOCASE
;
18399 info
.type
= JIM_LSORT_INTEGER
;
18401 case OPT_INCREASING
:
18404 case OPT_DECREASING
:
18408 if (i
>= (argc
- 2)) {
18409 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
18412 info
.type
= JIM_LSORT_COMMAND
;
18413 info
.command
= argv
[i
+ 1];
18417 if (i
>= (argc
- 2)) {
18418 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
18421 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
18429 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
18430 retCode
= ListSortElements(interp
, resObj
, &info
);
18431 if (retCode
== JIM_OK
) {
18432 Jim_SetResult(interp
, resObj
);
18435 Jim_FreeNewObj(interp
, resObj
);
18441 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18443 Jim_Obj
*stringObjPtr
;
18447 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
18451 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
18457 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
18458 if (!stringObjPtr
) {
18459 /* Create the string if it doesn't exist */
18460 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
18463 else if (Jim_IsShared(stringObjPtr
)) {
18465 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
18467 for (i
= 2; i
< argc
; i
++) {
18468 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
18470 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
18472 Jim_FreeNewObj(interp
, stringObjPtr
);
18477 Jim_SetResult(interp
, stringObjPtr
);
18482 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18484 #ifdef JIM_DEBUG_COMMAND
18485 static const char * const options
[] = {
18486 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
18492 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
18493 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
18498 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
18501 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
18503 if (option
== OPT_REFCOUNT
) {
18505 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18508 Jim_SetResultInt(interp
, argv
[2]->refCount
);
18511 else if (option
== OPT_OBJCOUNT
) {
18512 int freeobj
= 0, liveobj
= 0;
18517 Jim_WrongNumArgs(interp
, 2, argv
, "");
18520 /* Count the number of free objects. */
18521 objPtr
= interp
->freeList
;
18524 objPtr
= objPtr
->nextObjPtr
;
18526 /* Count the number of live objects. */
18527 objPtr
= interp
->liveList
;
18530 objPtr
= objPtr
->nextObjPtr
;
18532 /* Set the result string and return. */
18533 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
18534 Jim_SetResultString(interp
, buf
, -1);
18537 else if (option
== OPT_OBJECTS
) {
18538 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
18540 /* Count the number of live objects. */
18541 objPtr
= interp
->liveList
;
18542 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18545 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
18547 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
18548 sprintf(buf
, "%p", objPtr
);
18549 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
18550 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
18551 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
18552 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
18553 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
18554 objPtr
= objPtr
->nextObjPtr
;
18556 Jim_SetResult(interp
, listObjPtr
);
18559 else if (option
== OPT_INVSTR
) {
18563 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18567 if (objPtr
->typePtr
!= NULL
)
18568 Jim_InvalidateStringRep(objPtr
);
18569 Jim_SetEmptyResult(interp
);
18572 else if (option
== OPT_SHOW
) {
18577 Jim_WrongNumArgs(interp
, 2, argv
, "object");
18580 s
= Jim_GetString(argv
[2], &len
);
18581 charlen
= Jim_Utf8Length(interp
, argv
[2]);
18582 printf("chars (%d): <<%s>>\n", charlen
, s
);
18583 printf("bytes (%d):", len
);
18585 printf(" %02x", (unsigned char)*s
++);
18590 else if (option
== OPT_SCRIPTLEN
) {
18594 Jim_WrongNumArgs(interp
, 2, argv
, "script");
18597 script
= Jim_GetScript(interp
, argv
[2]);
18598 Jim_SetResultInt(interp
, script
->len
);
18601 else if (option
== OPT_EXPRLEN
) {
18602 ExprByteCode
*expr
;
18605 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
18608 expr
= JimGetExpression(interp
, argv
[2]);
18611 Jim_SetResultInt(interp
, expr
->len
);
18614 else if (option
== OPT_EXPRBC
) {
18616 ExprByteCode
*expr
;
18620 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
18623 expr
= JimGetExpression(interp
, argv
[2]);
18626 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
18627 for (i
= 0; i
< expr
->len
; i
++) {
18629 const Jim_ExprOperator
*op
;
18630 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
18632 switch (expr
->token
[i
].type
) {
18633 case JIM_TT_EXPR_INT
:
18636 case JIM_TT_EXPR_DOUBLE
:
18645 case JIM_TT_DICTSUGAR
:
18646 type
= "dictsugar";
18648 case JIM_TT_EXPRSUGAR
:
18649 type
= "exprsugar";
18658 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
18665 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
18668 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
18669 Jim_ListAppendElement(interp
, objPtr
, obj
);
18671 Jim_SetResult(interp
, objPtr
);
18675 Jim_SetResultString(interp
,
18676 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
18681 Jim_SetResultString(interp
, "unsupported", -1);
18687 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18692 Jim_WrongNumArgs(interp
, 1, argv
, "script ?...?");
18697 rc
= Jim_EvalObj(interp
, argv
[1]);
18700 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
18703 if (rc
== JIM_ERR
) {
18704 /* eval is "interesting", so add a stack frame here */
18705 interp
->addStackTrace
++;
18711 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18715 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
18719 /* Save the old callframe pointer */
18720 savedCallFrame
= interp
->framePtr
;
18722 /* Lookup the target frame pointer */
18723 str
= Jim_String(argv
[1]);
18724 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
18725 targetCallFrame
=Jim_GetCallFrameByLevel(interp
, argv
[1]);
18730 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
18732 if (targetCallFrame
== NULL
) {
18737 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
18740 /* Eval the code in the target callframe. */
18741 interp
->framePtr
= targetCallFrame
;
18743 retcode
= Jim_EvalObj(interp
, argv
[1]);
18746 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
18747 Jim_IncrRefCount(objPtr
);
18748 retcode
= Jim_EvalObj(interp
, objPtr
);
18749 Jim_DecrRefCount(interp
, objPtr
);
18751 interp
->framePtr
= savedCallFrame
;
18755 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
18761 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18763 Jim_Obj
*exprResultPtr
;
18767 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
18769 else if (argc
> 2) {
18772 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
18773 Jim_IncrRefCount(objPtr
);
18774 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
18775 Jim_DecrRefCount(interp
, objPtr
);
18778 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
18781 if (retcode
!= JIM_OK
)
18783 Jim_SetResult(interp
, exprResultPtr
);
18784 Jim_DecrRefCount(interp
, exprResultPtr
);
18789 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18792 Jim_WrongNumArgs(interp
, 1, argv
, "");
18799 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18802 Jim_WrongNumArgs(interp
, 1, argv
, "");
18805 return JIM_CONTINUE
;
18809 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18812 Jim_Obj
*stackTraceObj
= NULL
;
18813 Jim_Obj
*errorCodeObj
= NULL
;
18814 int returnCode
= JIM_OK
;
18817 for (i
= 1; i
< argc
- 1; i
+= 2) {
18818 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
18819 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
18823 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
18824 stackTraceObj
= argv
[i
+ 1];
18826 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
18827 errorCodeObj
= argv
[i
+ 1];
18829 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
18830 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
18831 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
18840 if (i
!= argc
- 1 && i
!= argc
) {
18841 Jim_WrongNumArgs(interp
, 1, argv
,
18842 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
18845 /* If a stack trace is supplied and code is error, set the stack trace */
18846 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
18847 JimSetStackTrace(interp
, stackTraceObj
);
18849 /* If an error code list is supplied, set the global $errorCode */
18850 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
18851 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
18853 interp
->returnCode
= returnCode
;
18854 interp
->returnLevel
= level
;
18856 if (i
== argc
- 1) {
18857 Jim_SetResult(interp
, argv
[i
]);
18863 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18867 objPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
18868 Jim_SetResult(interp
, objPtr
);
18873 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18875 if (argc
!= 4 && argc
!= 5) {
18876 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
18881 return JimCreateProcedure(interp
, argv
[1], argv
[2], NULL
, argv
[3]);
18884 return JimCreateProcedure(interp
, argv
[1], argv
[2], argv
[3], argv
[4]);
18889 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18893 /* Evaluate the arguments with 'local' in force */
18895 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
18899 /* If OK, and the result is a proc, add it to the list of local procs */
18900 if (retcode
== 0) {
18901 const char *procname
= Jim_String(Jim_GetResult(interp
));
18903 if (Jim_FindHashEntry(&interp
->commands
, procname
) == NULL
) {
18904 Jim_SetResultFormatted(interp
, "not a proc: \"%s\"", procname
);
18907 if (interp
->localProcs
== NULL
) {
18908 interp
->localProcs
= Jim_Alloc(sizeof(*interp
->localProcs
));
18909 Jim_InitStack(interp
->localProcs
);
18911 Jim_StackPush(interp
->localProcs
, Jim_StrDup(procname
));
18918 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18921 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
18927 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
18928 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->u
.proc
.prevCmd
) {
18929 Jim_SetResultFormatted(interp
, "no previous proc: \"%#s\"", argv
[1]);
18932 /* OK. Mark this command as being in an upcall */
18933 cmdPtr
->u
.proc
.upcall
++;
18934 JimIncrCmdRefCount(cmdPtr
);
18936 /* Invoke the command as normal */
18937 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
18939 /* No longer in an upcall */
18940 cmdPtr
->u
.proc
.upcall
--;
18941 JimDecrCmdRefCount(interp
, cmdPtr
);
18948 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18950 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
18955 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18958 Jim_CallFrame
*targetCallFrame
;
18960 /* Lookup the target frame pointer */
18961 if (argc
> 3 && (argc
% 2 == 0)) {
18962 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
18967 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
18969 if (targetCallFrame
== NULL
) {
18973 /* Check for arity */
18975 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
18979 /* Now... for every other/local couple: */
18980 for (i
= 1; i
< argc
; i
+= 2) {
18981 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
18988 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
18993 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
18996 /* Link every var to the toplevel having the same name */
18997 if (interp
->framePtr
->level
== 0)
18998 return JIM_OK
; /* global at toplevel... */
18999 for (i
= 1; i
< argc
; i
++) {
19000 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
19006 /* does the [string map] operation. On error NULL is returned,
19007 * otherwise a new string object with the result, having refcount = 0,
19009 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
19010 Jim_Obj
*objPtr
, int nocase
)
19013 const char *str
, *noMatchStart
= NULL
;
19015 Jim_Obj
*resultObjPtr
;
19017 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
19019 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
19023 str
= Jim_String(objPtr
);
19024 strLen
= Jim_Utf8Length(interp
, objPtr
);
19027 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
19029 for (i
= 0; i
< numMaps
; i
+= 2) {
19034 Jim_ListIndex(interp
, mapListObjPtr
, i
, &objPtr
, JIM_NONE
);
19035 k
= Jim_String(objPtr
);
19036 kl
= Jim_Utf8Length(interp
, objPtr
);
19038 if (strLen
>= kl
&& kl
) {
19041 rc
= JimStringCompareNoCase(str
, k
, kl
);
19044 rc
= JimStringCompare(str
, kl
, k
, kl
);
19047 if (noMatchStart
) {
19048 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
19049 noMatchStart
= NULL
;
19051 Jim_ListIndex(interp
, mapListObjPtr
, i
+ 1, &objPtr
, JIM_NONE
);
19052 Jim_AppendObj(interp
, resultObjPtr
, objPtr
);
19053 str
+= utf8_index(str
, kl
);
19059 if (i
== numMaps
) { /* no match */
19061 if (noMatchStart
== NULL
)
19062 noMatchStart
= str
;
19063 str
+= utf8_tounicode(str
, &c
);
19067 if (noMatchStart
) {
19068 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
19070 return resultObjPtr
;
19074 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19079 static const char * const options
[] = {
19080 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "map",
19081 "repeat", "reverse", "index", "first", "last",
19082 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
19086 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_MAP
,
19087 OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
,
19088 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
19090 static const char * const nocase_options
[] = {
19095 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
19098 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
19099 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
19104 case OPT_BYTELENGTH
:
19106 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19109 if (option
== OPT_LENGTH
) {
19110 len
= Jim_Utf8Length(interp
, argv
[2]);
19113 len
= Jim_Length(argv
[2]);
19115 Jim_SetResultInt(interp
, len
);
19122 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19123 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19124 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? string1 string2");
19127 if (opt_case
== 0) {
19130 if (option
== OPT_COMPARE
|| !opt_case
) {
19131 Jim_SetResultInt(interp
, Jim_StringCompareObj(interp
, argv
[2], argv
[3], !opt_case
));
19134 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[2], argv
[3]));
19141 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19142 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19143 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
19146 if (opt_case
== 0) {
19149 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
19157 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
19158 JIM_ENUM_ABBREV
) != JIM_OK
)) {
19159 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
19163 if (opt_case
== 0) {
19166 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
19167 if (objPtr
== NULL
) {
19170 Jim_SetResult(interp
, objPtr
);
19175 case OPT_BYTERANGE
:{
19179 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
19182 if (option
== OPT_RANGE
) {
19183 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
19187 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
19190 if (objPtr
== NULL
) {
19193 Jim_SetResult(interp
, objPtr
);
19202 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
19205 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
19208 objPtr
= Jim_NewStringObj(interp
, "", 0);
19211 Jim_AppendObj(interp
, objPtr
, argv
[2]);
19214 Jim_SetResult(interp
, objPtr
);
19225 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19229 str
= Jim_GetString(argv
[2], &len
);
19234 buf
= Jim_Alloc(len
+ 1);
19237 for (i
= 0; i
< len
; ) {
19239 int l
= utf8_tounicode(str
, &c
);
19240 memcpy(p
- l
, str
, l
);
19245 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
19254 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
19257 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
19260 str
= Jim_String(argv
[2]);
19261 len
= Jim_Utf8Length(interp
, argv
[2]);
19262 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
19263 idx
= JimRelToAbsIndex(len
, idx
);
19265 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
19266 Jim_SetResultString(interp
, "", 0);
19268 else if (len
== Jim_Length(argv
[2])) {
19269 /* ASCII optimisation */
19270 Jim_SetResultString(interp
, str
+ idx
, 1);
19274 int i
= utf8_index(str
, idx
);
19275 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
19282 int idx
= 0, l1
, l2
;
19283 const char *s1
, *s2
;
19285 if (argc
!= 4 && argc
!= 5) {
19286 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
19289 s1
= Jim_String(argv
[2]);
19290 s2
= Jim_String(argv
[3]);
19291 l1
= Jim_Utf8Length(interp
, argv
[2]);
19292 l2
= Jim_Utf8Length(interp
, argv
[3]);
19294 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
19297 idx
= JimRelToAbsIndex(l2
, idx
);
19299 else if (option
== OPT_LAST
) {
19302 if (option
== OPT_FIRST
) {
19303 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
19307 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
19309 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
19317 case OPT_TRIMRIGHT
:{
19318 Jim_Obj
*trimchars
;
19320 if (argc
!= 3 && argc
!= 4) {
19321 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
19324 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
19325 if (option
== OPT_TRIM
) {
19326 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
19328 else if (option
== OPT_TRIMLEFT
) {
19329 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
19331 else if (option
== OPT_TRIMRIGHT
) {
19332 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
19340 Jim_WrongNumArgs(interp
, 2, argv
, "string");
19343 if (option
== OPT_TOLOWER
) {
19344 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
19347 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
19352 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
19353 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
19355 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
19362 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19365 jim_wide start
, elapsed
;
19367 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
19370 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
19374 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
19380 start
= JimClock();
19384 retval
= Jim_EvalObj(interp
, argv
[1]);
19385 if (retval
!= JIM_OK
) {
19389 elapsed
= JimClock() - start
;
19390 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
19391 Jim_SetResultString(interp
, buf
, -1);
19396 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19401 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
19405 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
19408 interp
->exitCode
= exitCode
;
19413 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19419 /* Which return codes are caught? These are the defaults */
19421 (1 << JIM_OK
| 1 << JIM_ERR
| 1 << JIM_BREAK
| 1 << JIM_CONTINUE
| 1 << JIM_RETURN
);
19423 /* Reset the error code before catch.
19424 * Note that this is not strictly correct.
19426 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
19428 for (i
= 1; i
< argc
- 1; i
++) {
19429 const char *arg
= Jim_String(argv
[i
]);
19433 /* It's a pity we can't use Jim_GetEnum here :-( */
19434 if (strcmp(arg
, "--") == 0) {
19442 if (strncmp(arg
, "-no", 3) == 0) {
19451 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
19455 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
19462 mask
|= (1 << option
);
19465 mask
&= ~(1 << option
);
19470 if (argc
< 1 || argc
> 3) {
19472 Jim_WrongNumArgs(interp
, 1, argv
,
19473 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
19478 if (mask
& (1 << JIM_SIGNAL
)) {
19482 interp
->signal_level
+= sig
;
19483 if (interp
->signal_level
&& interp
->sigmask
) {
19484 /* If a signal is set, don't even try to execute the body */
19485 exitCode
= JIM_SIGNAL
;
19488 exitCode
= Jim_EvalObj(interp
, argv
[0]);
19490 interp
->signal_level
-= sig
;
19492 /* Catch or pass through? Only the first 32/64 codes can be passed through */
19493 if (exitCode
>= 0 && exitCode
< (int)sizeof(mask
) * 8 && ((1 << exitCode
) & mask
) == 0) {
19494 /* Not caught, pass it up */
19498 if (sig
&& exitCode
== JIM_SIGNAL
) {
19499 /* Catch the signal at this level */
19500 if (interp
->signal_set_result
) {
19501 interp
->signal_set_result(interp
, interp
->sigmask
);
19504 Jim_SetResultInt(interp
, interp
->sigmask
);
19506 interp
->sigmask
= 0;
19510 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
19514 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
19516 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
19517 Jim_ListAppendElement(interp
, optListObj
,
19518 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
19519 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
19520 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
19521 if (exitCode
== JIM_ERR
) {
19522 Jim_Obj
*errorCode
;
19523 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
19525 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
19527 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
19529 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
19530 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
19533 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
19538 Jim_SetResultInt(interp
, exitCode
);
19542 #ifdef JIM_REFERENCES
19545 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19547 if (argc
!= 3 && argc
!= 4) {
19548 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
19552 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
19555 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
19561 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19563 Jim_Reference
*refPtr
;
19566 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
19569 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
19571 Jim_SetResult(interp
, refPtr
->objPtr
);
19576 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19578 Jim_Reference
*refPtr
;
19581 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
19584 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
19586 Jim_IncrRefCount(argv
[2]);
19587 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
19588 refPtr
->objPtr
= argv
[2];
19589 Jim_SetResult(interp
, argv
[2]);
19594 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19597 Jim_WrongNumArgs(interp
, 1, argv
, "");
19600 Jim_SetResultInt(interp
, Jim_Collect(interp
));
19602 /* Free all the freed objects. */
19603 while (interp
->freeList
) {
19604 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
19605 Jim_Free(interp
->freeList
);
19606 interp
->freeList
= nextObjPtr
;
19612 /* [finalize] reference ?newValue? */
19613 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19615 if (argc
!= 2 && argc
!= 3) {
19616 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
19620 Jim_Obj
*cmdNamePtr
;
19622 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
19624 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
19625 Jim_SetResult(interp
, cmdNamePtr
);
19628 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
19630 Jim_SetResult(interp
, argv
[2]);
19635 /* [info references] */
19636 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19638 Jim_Obj
*listObjPtr
;
19639 Jim_HashTableIterator
*htiter
;
19642 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
19644 htiter
= Jim_GetHashTableIterator(&interp
->references
);
19645 while ((he
= Jim_NextHashEntry(htiter
)) != NULL
) {
19646 char buf
[JIM_REFERENCE_SPACE
];
19647 Jim_Reference
*refPtr
= he
->u
.val
;
19648 const jim_wide
*refId
= he
->key
;
19650 JimFormatReference(buf
, refPtr
, *refId
);
19651 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
19653 Jim_FreeHashTableIterator(htiter
);
19654 Jim_SetResult(interp
, listObjPtr
);
19660 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19662 const char *oldName
, *newName
;
19665 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
19669 if (JimValidName(interp
, "new procedure", argv
[2])) {
19673 oldName
= Jim_String(argv
[1]);
19674 newName
= Jim_String(argv
[2]);
19675 return Jim_RenameCommand(interp
, oldName
, newName
);
19678 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObj
)
19682 Jim_Obj
*resultObj
;
19684 Jim_Obj
**dictValuesObj
;
19686 if (Jim_DictKeysVector(interp
, objPtr
, NULL
, 0, &dictObj
, JIM_ERRMSG
) != JIM_OK
) {
19690 /* XXX: Could make the exact-match case much more efficient here.
19691 * See JimCommandsList()
19693 if (Jim_DictPairs(interp
, dictObj
, &dictValuesObj
, &len
) != JIM_OK
) {
19697 /* Only return the matching values */
19698 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
19700 for (i
= 0; i
< len
; i
+= 2) {
19701 if (patternObj
== NULL
|| Jim_StringMatchObj(interp
, patternObj
, dictValuesObj
[i
], 0)) {
19702 Jim_ListAppendElement(interp
, resultObj
, dictValuesObj
[i
]);
19705 Jim_Free(dictValuesObj
);
19707 Jim_SetResult(interp
, resultObj
);
19711 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
19713 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
19716 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
19720 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19724 static const char * const options
[] = {
19725 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
19729 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXIST
, OPT_KEYS
, OPT_MERGE
, OPT_SIZE
, OPT_WITH
,
19733 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
19737 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
19744 Jim_WrongNumArgs(interp
, 2, argv
, "varName ?key ...?");
19747 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
19748 JIM_ERRMSG
) != JIM_OK
) {
19751 Jim_SetResult(interp
, objPtr
);
19756 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
19759 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1]);
19763 Jim_WrongNumArgs(interp
, 2, argv
, "varName ?key ...?");
19766 Jim_SetResultBool(interp
, Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3,
19767 &objPtr
, JIM_ERRMSG
) == JIM_OK
);
19772 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
19775 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
);
19778 if (argc
!= 3 && argc
!= 4) {
19779 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?pattern?");
19782 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
19788 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar");
19792 size
= Jim_DictSize(interp
, argv
[2]);
19796 Jim_SetResultInt(interp
, size
);
19804 else if (argv
[2]->typePtr
!= &dictObjType
&& SetDictFromAny(interp
, argv
[2]) != JIM_OK
) {
19808 return Jim_EvalObjPrefix(interp
, "dict merge", argc
- 2, argv
+ 2);
19813 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?key ...? script");
19816 else if (Jim_GetVariable(interp
, argv
[2], JIM_ERRMSG
) == NULL
) {
19820 return Jim_EvalObjPrefix(interp
, "dict with", argc
- 2, argv
+ 2);
19825 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
19828 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
19829 Jim_SetResult(interp
, objPtr
);
19838 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19840 static const char * const options
[] = {
19841 "-nobackslashes", "-nocommands", "-novariables", NULL
19844 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
19846 int flags
= JIM_SUBST_FLAG
;
19850 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
19853 for (i
= 1; i
< (argc
- 1); i
++) {
19856 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
19857 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
19861 case OPT_NOBACKSLASHES
:
19862 flags
|= JIM_SUBST_NOESC
;
19864 case OPT_NOCOMMANDS
:
19865 flags
|= JIM_SUBST_NOCMD
;
19867 case OPT_NOVARIABLES
:
19868 flags
|= JIM_SUBST_NOVAR
;
19872 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
19875 Jim_SetResult(interp
, objPtr
);
19880 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
19886 static const char * const commands
[] = {
19887 "body", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
19888 "vars", "version", "patchlevel", "complete", "args", "hostname",
19889 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
19893 { INFO_BODY
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
19894 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
19895 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
19896 INFO_RETURNCODES
, INFO_REFERENCES
,
19900 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
19903 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
19908 /* Test for the the most common commands first, just in case it makes a difference */
19912 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
19915 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
19919 case INFO_CHANNELS
:
19920 #ifndef jim_ext_aio
19921 Jim_SetResultString(interp
, "aio not enabled", -1);
19924 case INFO_COMMANDS
:
19926 if (argc
!= 2 && argc
!= 3) {
19927 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
19930 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
,
19931 (cmd
- INFO_COMMANDS
)));
19935 mode
++; /* JIM_VARLIST_VARS */
19937 mode
++; /* JIM_VARLIST_LOCALS */
19939 /* mode 0 => JIM_VARLIST_GLOBALS */
19940 if (argc
!= 2 && argc
!= 3) {
19941 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
19944 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
19949 Jim_WrongNumArgs(interp
, 2, argv
, "");
19952 Jim_SetResultString(interp
, Jim_GetScript(interp
, interp
->currentScriptObj
)->fileName
,
19957 const char *filename
= "";
19959 Jim_Obj
*resObjPtr
;
19962 Jim_WrongNumArgs(interp
, 2, argv
, "source");
19965 if (argv
[2]->typePtr
== &sourceObjType
) {
19966 filename
= argv
[2]->internalRep
.sourceValue
.fileName
;
19967 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
19969 else if (argv
[2]->typePtr
== &scriptObjType
) {
19970 ScriptObj
*script
= Jim_GetScript(interp
, argv
[2]);
19971 filename
= script
->fileName
;
19972 line
= script
->line
;
19974 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
19975 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObj(interp
, filename
, -1));
19976 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
19977 Jim_SetResult(interp
, resObjPtr
);
19981 case INFO_STACKTRACE
:
19982 Jim_SetResult(interp
, interp
->stackTrace
);
19989 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
19993 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
19996 Jim_SetResult(interp
, objPtr
);
20000 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
20010 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
20013 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
20016 if (!cmdPtr
->isproc
) {
20017 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
20020 Jim_SetResult(interp
,
20021 cmd
== INFO_BODY
? cmdPtr
->u
.proc
.bodyObjPtr
: cmdPtr
->u
.proc
.argListObjPtr
);
20026 case INFO_PATCHLEVEL
:{
20027 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
20029 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
20030 Jim_SetResultString(interp
, buf
, -1);
20034 case INFO_COMPLETE
:
20035 if (argc
!= 3 && argc
!= 4) {
20036 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
20041 const char *s
= Jim_GetString(argv
[2], &len
);
20044 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
20045 if (missing
!= ' ' && argc
== 4) {
20046 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
20051 case INFO_HOSTNAME
:
20052 /* Redirect to os.gethostname if it exists */
20053 return Jim_Eval(interp
, "os.gethostname");
20055 case INFO_NAMEOFEXECUTABLE
:
20056 /* Redirect to Tcl proc */
20057 return Jim_Eval(interp
, "{info nameofexecutable}");
20059 case INFO_RETURNCODES
:
20062 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20064 for (i
= 0; jimReturnCodes
[i
]; i
++) {
20065 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
20066 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
20067 jimReturnCodes
[i
], -1));
20070 Jim_SetResult(interp
, listObjPtr
);
20072 else if (argc
== 3) {
20076 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
20079 name
= Jim_ReturnCode(code
);
20080 if (*name
== '?') {
20081 Jim_SetResultInt(interp
, code
);
20084 Jim_SetResultString(interp
, name
, -1);
20088 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
20092 case INFO_REFERENCES
:
20093 #ifdef JIM_REFERENCES
20094 return JimInfoReferences(interp
, argc
, argv
);
20096 Jim_SetResultString(interp
, "not supported", -1);
20104 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20108 static const char * const options
[] = {
20109 "-command", "-proc", "-var", NULL
20113 OPT_COMMAND
, OPT_PROC
, OPT_VAR
20121 else if (argc
== 3) {
20122 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
20128 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
20132 /* Test for the the most common commands first, just in case it makes a difference */
20135 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, objPtr
, 0) != NULL
);
20140 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
20141 Jim_SetResultBool(interp
, cmd
!= NULL
&& (option
== OPT_COMMAND
|| cmd
->isproc
));
20149 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20151 const char *str
, *splitChars
, *noMatchStart
;
20152 int splitLen
, strLen
;
20153 Jim_Obj
*resObjPtr
;
20157 if (argc
!= 2 && argc
!= 3) {
20158 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
20162 str
= Jim_GetString(argv
[1], &len
);
20166 strLen
= Jim_Utf8Length(interp
, argv
[1]);
20170 splitChars
= " \n\t\r";
20174 splitChars
= Jim_String(argv
[2]);
20175 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
20178 noMatchStart
= str
;
20179 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20185 const char *sc
= splitChars
;
20186 int scLen
= splitLen
;
20187 int sl
= utf8_tounicode(str
, &c
);
20190 sc
+= utf8_tounicode(sc
, &pc
);
20192 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
20193 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
20194 noMatchStart
= str
+ sl
;
20200 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
20201 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
20204 /* This handles the special case of splitchars eq {}
20205 * Optimise by sharing common (ASCII) characters
20207 Jim_Obj
**commonObj
= NULL
;
20208 #define NUM_COMMON (128 - 9)
20210 int n
= utf8_tounicode(str
, &c
);
20211 #ifdef JIM_OPTIMIZATION
20212 if (c
>= 9 && c
< 128) {
20213 /* Common ASCII char. Note that 9 is the tab character */
20216 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
20217 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
20219 if (!commonObj
[c
]) {
20220 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
20222 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
20227 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
20230 Jim_Free(commonObj
);
20233 Jim_SetResult(interp
, resObjPtr
);
20238 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20240 const char *joinStr
;
20241 int joinStrLen
, i
, listLen
;
20242 Jim_Obj
*resObjPtr
;
20244 if (argc
!= 2 && argc
!= 3) {
20245 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
20254 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
20256 listLen
= Jim_ListLength(interp
, argv
[1]);
20257 resObjPtr
= Jim_NewStringObj(interp
, NULL
, 0);
20259 for (i
= 0; i
< listLen
; i
++) {
20260 Jim_Obj
*objPtr
= 0;
20262 Jim_ListIndex(interp
, argv
[1], i
, &objPtr
, JIM_NONE
);
20263 Jim_AppendObj(interp
, resObjPtr
, objPtr
);
20264 if (i
+ 1 != listLen
) {
20265 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
20268 Jim_SetResult(interp
, resObjPtr
);
20273 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20278 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
20281 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
20282 if (objPtr
== NULL
)
20284 Jim_SetResult(interp
, objPtr
);
20289 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20291 Jim_Obj
*listPtr
, **outVec
;
20295 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
20298 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
20299 SetScanFmtFromAny(interp
, argv
[2]);
20300 if (FormatGetError(argv
[2]) != 0) {
20301 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
20305 int maxPos
= FormatGetMaxPos(argv
[2]);
20306 int count
= FormatGetCnvCount(argv
[2]);
20308 if (maxPos
> argc
- 3) {
20309 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
20312 else if (count
> argc
- 3) {
20313 Jim_SetResultString(interp
, "different numbers of variable names and "
20314 "field specifiers", -1);
20317 else if (count
< argc
- 3) {
20318 Jim_SetResultString(interp
, "variable is not assigned by any "
20319 "conversion specifiers", -1);
20323 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
20330 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
20331 int len
= Jim_ListLength(interp
, listPtr
);
20334 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
20335 for (i
= 0; i
< outc
; ++i
) {
20336 if (Jim_Length(outVec
[i
]) > 0) {
20338 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
20344 Jim_FreeNewObj(interp
, listPtr
);
20349 if (rc
== JIM_OK
) {
20350 Jim_SetResultInt(interp
, count
);
20355 if (listPtr
== (Jim_Obj
*)EOF
) {
20356 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
20359 Jim_SetResult(interp
, listPtr
);
20365 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20367 if (argc
!= 2 && argc
!= 3) {
20368 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
20371 Jim_SetResult(interp
, argv
[1]);
20373 JimSetStackTrace(interp
, argv
[2]);
20376 interp
->addStackTrace
++;
20381 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20386 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
20389 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
20391 Jim_SetResult(interp
, objPtr
);
20396 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20401 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
20402 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
20406 if (count
== 0 || argc
== 2) {
20413 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
20417 for (i
= 0; i
< argc
; i
++) {
20418 ListAppendElement(objPtr
, argv
[i
]);
20422 Jim_SetResult(interp
, objPtr
);
20426 char **Jim_GetEnviron(void)
20428 #if defined(HAVE__NSGETENVIRON)
20429 return *_NSGetEnviron();
20431 #if !defined(NO_ENVIRON_EXTERN)
20432 extern char **environ
;
20439 void Jim_SetEnviron(char **env
)
20441 #if defined(HAVE__NSGETENVIRON)
20442 *_NSGetEnviron() = env
;
20444 #if !defined(NO_ENVIRON_EXTERN)
20445 extern char **environ
;
20453 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20459 char **e
= Jim_GetEnviron();
20462 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20464 for (i
= 0; e
[i
]; i
++) {
20465 const char *equals
= strchr(e
[i
], '=');
20468 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
20470 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
20474 Jim_SetResult(interp
, listObjPtr
);
20479 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
20482 key
= Jim_String(argv
[1]);
20486 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
20489 val
= Jim_String(argv
[2]);
20491 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
20496 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20501 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
20504 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
20505 if (retval
== JIM_RETURN
)
20511 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20513 Jim_Obj
*revObjPtr
, **ele
;
20517 Jim_WrongNumArgs(interp
, 1, argv
, "list");
20520 JimListGetElements(interp
, argv
[1], &len
, &ele
);
20522 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
20524 ListAppendElement(revObjPtr
, ele
[len
--]);
20525 Jim_SetResult(interp
, revObjPtr
);
20529 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
20537 else if (step
> 0 && start
> end
)
20539 else if (step
< 0 && end
> start
)
20543 len
= -len
; /* abs(len) */
20545 step
= -step
; /* abs(step) */
20546 len
= 1 + ((len
- 1) / step
);
20547 /* We can truncate safely to INT_MAX, the range command
20548 * will always return an error for a such long range
20549 * because Tcl lists can't be so long. */
20552 return (int)((len
< 0) ? -1 : len
);
20556 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20558 jim_wide start
= 0, end
, step
= 1;
20562 if (argc
< 2 || argc
> 4) {
20563 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
20567 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
20571 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
20572 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
20574 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
20577 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
20578 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
20581 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
20582 for (i
= 0; i
< len
; i
++)
20583 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
20584 Jim_SetResult(interp
, objPtr
);
20589 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20591 jim_wide min
= 0, max
= 0, len
, maxMul
;
20593 if (argc
< 1 || argc
> 3) {
20594 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
20598 max
= JIM_WIDE_MAX
;
20599 } else if (argc
== 2) {
20600 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
20602 } else if (argc
== 3) {
20603 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
20604 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
20609 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
20612 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
20616 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
20617 if (r
< 0 || r
>= maxMul
) continue;
20618 r
= (len
== 0) ? 0 : r
%len
;
20619 Jim_SetResultInt(interp
, min
+r
);
20624 static const struct {
20626 Jim_CmdProc cmdProc
;
20627 } Jim_CoreCommandsTable
[] = {
20628 {"set", Jim_SetCoreCommand
},
20629 {"unset", Jim_UnsetCoreCommand
},
20630 {"puts", Jim_PutsCoreCommand
},
20631 {"+", Jim_AddCoreCommand
},
20632 {"*", Jim_MulCoreCommand
},
20633 {"-", Jim_SubCoreCommand
},
20634 {"/", Jim_DivCoreCommand
},
20635 {"incr", Jim_IncrCoreCommand
},
20636 {"while", Jim_WhileCoreCommand
},
20637 {"loop", Jim_LoopCoreCommand
},
20638 {"for", Jim_ForCoreCommand
},
20639 {"foreach", Jim_ForeachCoreCommand
},
20640 {"lmap", Jim_LmapCoreCommand
},
20641 {"if", Jim_IfCoreCommand
},
20642 {"switch", Jim_SwitchCoreCommand
},
20643 {"list", Jim_ListCoreCommand
},
20644 {"lindex", Jim_LindexCoreCommand
},
20645 {"lset", Jim_LsetCoreCommand
},
20646 {"lsearch", Jim_LsearchCoreCommand
},
20647 {"llength", Jim_LlengthCoreCommand
},
20648 {"lappend", Jim_LappendCoreCommand
},
20649 {"linsert", Jim_LinsertCoreCommand
},
20650 {"lreplace", Jim_LreplaceCoreCommand
},
20651 {"lsort", Jim_LsortCoreCommand
},
20652 {"append", Jim_AppendCoreCommand
},
20653 {"debug", Jim_DebugCoreCommand
},
20654 {"eval", Jim_EvalCoreCommand
},
20655 {"uplevel", Jim_UplevelCoreCommand
},
20656 {"expr", Jim_ExprCoreCommand
},
20657 {"break", Jim_BreakCoreCommand
},
20658 {"continue", Jim_ContinueCoreCommand
},
20659 {"proc", Jim_ProcCoreCommand
},
20660 {"concat", Jim_ConcatCoreCommand
},
20661 {"return", Jim_ReturnCoreCommand
},
20662 {"upvar", Jim_UpvarCoreCommand
},
20663 {"global", Jim_GlobalCoreCommand
},
20664 {"string", Jim_StringCoreCommand
},
20665 {"time", Jim_TimeCoreCommand
},
20666 {"exit", Jim_ExitCoreCommand
},
20667 {"catch", Jim_CatchCoreCommand
},
20668 #ifdef JIM_REFERENCES
20669 {"ref", Jim_RefCoreCommand
},
20670 {"getref", Jim_GetrefCoreCommand
},
20671 {"setref", Jim_SetrefCoreCommand
},
20672 {"finalize", Jim_FinalizeCoreCommand
},
20673 {"collect", Jim_CollectCoreCommand
},
20675 {"rename", Jim_RenameCoreCommand
},
20676 {"dict", Jim_DictCoreCommand
},
20677 {"subst", Jim_SubstCoreCommand
},
20678 {"info", Jim_InfoCoreCommand
},
20679 {"exists", Jim_ExistsCoreCommand
},
20680 {"split", Jim_SplitCoreCommand
},
20681 {"join", Jim_JoinCoreCommand
},
20682 {"format", Jim_FormatCoreCommand
},
20683 {"scan", Jim_ScanCoreCommand
},
20684 {"error", Jim_ErrorCoreCommand
},
20685 {"lrange", Jim_LrangeCoreCommand
},
20686 {"lrepeat", Jim_LrepeatCoreCommand
},
20687 {"env", Jim_EnvCoreCommand
},
20688 {"source", Jim_SourceCoreCommand
},
20689 {"lreverse", Jim_LreverseCoreCommand
},
20690 {"range", Jim_RangeCoreCommand
},
20691 {"rand", Jim_RandCoreCommand
},
20692 {"tailcall", Jim_TailcallCoreCommand
},
20693 {"local", Jim_LocalCoreCommand
},
20694 {"upcall", Jim_UpcallCoreCommand
},
20698 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
20702 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
20703 Jim_CreateCommand(interp
,
20704 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
20709 /* -----------------------------------------------------------------------------
20710 * Interactive prompt
20711 * ---------------------------------------------------------------------------*/
20712 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
20716 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
20717 argv
[1] = interp
->result
;
20719 Jim_EvalObjVector(interp
, 2, argv
);
20722 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
20723 const char *prefix
, const char *const *tablePtr
, const char *name
)
20726 char **tablePtrSorted
;
20729 for (count
= 0; tablePtr
[count
]; count
++) {
20732 if (name
== NULL
) {
20736 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
20737 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
20738 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
20739 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
20740 for (i
= 0; i
< count
; i
++) {
20741 if (i
+ 1 == count
&& count
> 1) {
20742 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
20744 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
20745 if (i
+ 1 != count
) {
20746 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
20749 Jim_Free(tablePtrSorted
);
20752 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
20753 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
20755 const char *bad
= "bad ";
20756 const char *const *entryPtr
= NULL
;
20760 const char *arg
= Jim_GetString(objPtr
, &arglen
);
20764 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
20765 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
20766 /* Found an exact match */
20770 if (flags
& JIM_ENUM_ABBREV
) {
20771 /* Accept an unambiguous abbreviation.
20772 * Note that '-' doesnt' consitute a valid abbreviation
20774 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
20775 if (*arg
== '-' && arglen
== 1) {
20779 bad
= "ambiguous ";
20787 /* If we had an unambiguous partial match */
20794 if (flags
& JIM_ERRMSG
) {
20795 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
20800 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
20804 for (i
= 0; i
< (int)len
; i
++) {
20805 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
20812 int Jim_IsDict(Jim_Obj
*objPtr
)
20814 return objPtr
->typePtr
== &dictObjType
;
20817 int Jim_IsList(Jim_Obj
*objPtr
)
20819 return objPtr
->typePtr
== &listObjType
;
20823 * Very simple printf-like formatting, designed for error messages.
20825 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
20826 * The resulting string is created and set as the result.
20828 * Each '%s' should correspond to a regular string parameter.
20829 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
20830 * Any other printf specifier is not allowed (but %% is allowed for the % character).
20832 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
20834 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
20836 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
20838 /* Initial space needed */
20839 int len
= strlen(format
);
20842 const char *params
[5];
20847 va_start(args
, format
);
20849 for (i
= 0; i
< len
&& n
< 5; i
++) {
20852 if (strncmp(format
+ i
, "%s", 2) == 0) {
20853 params
[n
] = va_arg(args
, char *);
20855 l
= strlen(params
[n
]);
20857 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
20858 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
20860 params
[n
] = Jim_GetString(objPtr
, &l
);
20863 if (format
[i
] == '%') {
20873 buf
= Jim_Alloc(len
+ 1);
20874 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
20876 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
20880 #ifndef jim_ext_package
20881 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
20886 #ifndef jim_ext_aio
20887 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
20889 Jim_SetResultString(interp
, "aio not enabled", -1);
20896 * Local Variables: ***
20897 * c-basic-offset: 4 ***
20902 #include <string.h>
20906 * Implements the common 'commands' subcommand
20908 static int subcmd_null(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
20910 /* Nothing to do, since the result has already been created */
20915 * Do-nothing command to support -commands and -usage
20917 static const jim_subcmd_type dummy_subcmd
= {
20919 .function
= subcmd_null
,
20920 .flags
= JIM_MODFLAG_HIDDEN
,
20923 static void add_commands(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, const char *sep
)
20925 const char *s
= "";
20927 for (; ct
->cmd
; ct
++) {
20928 if (!(ct
->flags
& JIM_MODFLAG_HIDDEN
)) {
20929 Jim_AppendStrings(interp
, Jim_GetResult(interp
), s
, ct
->cmd
, NULL
);
20935 static void bad_subcmd(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, const char *type
,
20936 Jim_Obj
*cmd
, Jim_Obj
*subcmd
)
20938 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20939 Jim_AppendStrings(interp
, Jim_GetResult(interp
), Jim_String(cmd
), ", ", type
,
20940 " command \"", Jim_String(subcmd
), "\": should be ", NULL
);
20941 add_commands(interp
, command_table
, ", ");
20944 static void show_cmd_usage(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, int argc
,
20945 Jim_Obj
*const *argv
)
20947 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20948 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "Usage: \"", Jim_String(argv
[0]),
20949 " command ... \", where command is one of: ", NULL
);
20950 add_commands(interp
, command_table
, ", ");
20953 static void add_cmd_usage(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, Jim_Obj
*cmd
)
20956 Jim_AppendStrings(interp
, Jim_GetResult(interp
), Jim_String(cmd
), " ", NULL
);
20958 Jim_AppendStrings(interp
, Jim_GetResult(interp
), ct
->cmd
, NULL
);
20959 if (ct
->args
&& *ct
->args
) {
20960 Jim_AppendStrings(interp
, Jim_GetResult(interp
), " ", ct
->args
, NULL
);
20964 static void show_full_usage(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, int argc
,
20965 Jim_Obj
*const *argv
)
20967 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
20968 for (; ct
->cmd
; ct
++) {
20969 if (!(ct
->flags
& JIM_MODFLAG_HIDDEN
)) {
20971 add_cmd_usage(interp
, ct
, argv
[0]);
20972 if (ct
->description
) {
20973 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n ", ct
->description
, NULL
);
20975 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", NULL
);
20980 static void set_wrong_args(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, Jim_Obj
*subcmd
)
20982 Jim_SetResultString(interp
, "wrong # args: must be \"", -1);
20983 add_cmd_usage(interp
, command_table
, subcmd
);
20984 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\"", NULL
);
20987 const jim_subcmd_type
*Jim_ParseSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
,
20988 int argc
, Jim_Obj
*const *argv
)
20990 const jim_subcmd_type
*ct
;
20991 const jim_subcmd_type
*partial
= 0;
20994 const char *cmdstr
;
20995 const char *cmdname
;
20998 cmdname
= Jim_String(argv
[0]);
21001 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
21002 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "wrong # args: should be \"", cmdname
,
21003 " command ...\"\n", NULL
);
21004 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "Use \"", cmdname
, " -help\" or \"",
21005 cmdname
, " -help command\" for help", NULL
);
21011 if (argc
== 2 && Jim_CompareStringImmediate(interp
, cmd
, "-usage")) {
21012 /* Show full usage */
21013 show_full_usage(interp
, command_table
, argc
, argv
);
21014 return &dummy_subcmd
;
21017 /* Check for the help command */
21018 if (Jim_CompareStringImmediate(interp
, cmd
, "-help")) {
21020 /* Usage for the command, not the subcommand */
21021 show_cmd_usage(interp
, command_table
, argc
, argv
);
21022 return &dummy_subcmd
;
21026 /* Skip the 'help' command */
21030 /* Check for special builtin '-commands' command first */
21031 if (Jim_CompareStringImmediate(interp
, cmd
, "-commands")) {
21032 /* Build the result here */
21033 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
21034 add_commands(interp
, command_table
, " ");
21035 return &dummy_subcmd
;
21038 cmdstr
= Jim_GetString(cmd
, &cmdlen
);
21040 for (ct
= command_table
; ct
->cmd
; ct
++) {
21041 if (Jim_CompareStringImmediate(interp
, cmd
, ct
->cmd
)) {
21042 /* Found an exact match */
21045 if (strncmp(cmdstr
, ct
->cmd
, cmdlen
) == 0) {
21049 /* Just show the top level help here */
21050 show_cmd_usage(interp
, command_table
, argc
, argv
);
21051 return &dummy_subcmd
;
21053 bad_subcmd(interp
, command_table
, "ambiguous", argv
[0], argv
[1 + help
]);
21061 /* If we had an unambiguous partial match */
21062 if (partial
&& !ct
->cmd
) {
21067 /* No matching command */
21069 /* Just show the top level help here */
21070 show_cmd_usage(interp
, command_table
, argc
, argv
);
21071 return &dummy_subcmd
;
21073 bad_subcmd(interp
, command_table
, "unknown", argv
[0], argv
[1 + help
]);
21078 Jim_SetResultString(interp
, "Usage: ", -1);
21080 add_cmd_usage(interp
, ct
, argv
[0]);
21081 if (ct
->description
) {
21082 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", ct
->description
, NULL
);
21084 return &dummy_subcmd
;
21087 /* Check the number of args */
21088 if (argc
- 2 < ct
->minargs
|| (ct
->maxargs
>= 0 && argc
- 2 > ct
->maxargs
)) {
21089 Jim_SetResultString(interp
, "wrong # args: must be \"", -1);
21091 add_cmd_usage(interp
, ct
, argv
[0]);
21092 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\"", NULL
);
21101 int Jim_CallSubCmd(Jim_Interp
*interp
, const jim_subcmd_type
* ct
, int argc
, Jim_Obj
*const *argv
)
21106 if (ct
->flags
& JIM_MODFLAG_FULLARGV
) {
21107 ret
= ct
->function(interp
, argc
, argv
);
21110 ret
= ct
->function(interp
, argc
- 2, argv
+ 2);
21113 set_wrong_args(interp
, ct
, argv
[0]);
21120 int Jim_SubCmdProc(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
21122 const jim_subcmd_type
*ct
=
21123 Jim_ParseSubCmd(interp
, (const jim_subcmd_type
*)Jim_CmdPrivData(interp
), argc
, argv
);
21125 return Jim_CallSubCmd(interp
, ct
, argc
, argv
);
21128 /* The following two functions are for normal commands */
21130 Jim_CheckCmdUsage(Jim_Interp
*interp
, const jim_subcmd_type
* command_table
, int argc
,
21131 Jim_Obj
*const *argv
)
21133 /* -usage or -help */
21135 if (Jim_CompareStringImmediate(interp
, argv
[1], "-usage")
21136 || Jim_CompareStringImmediate(interp
, argv
[1], "-help")) {
21137 Jim_SetResultString(interp
, "Usage: ", -1);
21138 add_cmd_usage(interp
, command_table
, NULL
);
21139 if (command_table
->description
) {
21140 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\n\n", command_table
->description
,
21146 if (argc
>= 2 && command_table
->function
) {
21147 /* This is actually a sub command table */
21151 const char *subcmd
= NULL
;
21153 if (Jim_CompareStringImmediate(interp
, argv
[1], "-subcommands")) {
21154 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
21155 add_commands(interp
, (jim_subcmd_type
*) command_table
->function
, " ");
21159 if (Jim_CompareStringImmediate(interp
, argv
[1], "-subhelp")
21160 || Jim_CompareStringImmediate(interp
, argv
[1], "-help")) {
21163 else if (Jim_CompareStringImmediate(interp
, argv
[1], "-subusage")) {
21168 nargv
[nargc
++] = Jim_NewStringObj(interp
, "$handle", -1);
21169 nargv
[nargc
++] = Jim_NewStringObj(interp
, subcmd
, -1);
21171 nargv
[nargc
++] = argv
[2];
21173 Jim_ParseSubCmd(interp
, (jim_subcmd_type
*) command_table
->function
, nargc
, nargv
);
21174 Jim_FreeNewObj(interp
, nargv
[0]);
21175 Jim_FreeNewObj(interp
, nargv
[1]);
21180 /* Check the number of args */
21181 if (argc
- 1 < command_table
->minargs
|| (command_table
->maxargs
>= 0
21182 && argc
- 1 > command_table
->maxargs
)) {
21183 set_wrong_args(interp
, command_table
, NULL
);
21184 Jim_AppendStrings(interp
, Jim_GetResult(interp
), "\nUse \"", Jim_String(argv
[0]),
21185 " -help\" for help", NULL
);
21189 /* Not usage, but passed arg checking */
21193 * UTF-8 utility functions
21195 * (c) 2010 Steve Bennett <steveb@workware.net.au>
21197 * See LICENCE for licence details.
21201 #include <stdlib.h>
21202 #include <string.h>
21204 #include <assert.h>
21206 /* This one is always implemented */
21207 int utf8_fromunicode(char *p
, unsigned short uc
)
21213 else if (uc
<= 0x7ff) {
21214 *p
++ = 0xc0 | ((uc
& 0x7c0) >> 6);
21215 *p
= 0x80 | (uc
& 0x3f);
21219 *p
++ = 0xe0 | ((uc
& 0xf000) >> 12);
21220 *p
++ = 0x80 | ((uc
& 0xfc0) >> 6);
21221 *p
= 0x80 | (uc
& 0x3f);
21227 int utf8_charlen(int c
)
21229 if ((c
& 0x80) == 0) {
21232 if ((c
& 0xe0) == 0xc0) {
21235 if ((c
& 0xf0) == 0xe0) {
21238 if ((c
& 0xf8) == 0xf0) {
21241 /* Invalid sequence */
21245 int utf8_strlen(const char *str
, int bytelen
)
21249 bytelen
= strlen(str
);
21253 int l
= utf8_tounicode(str
, &c
);
21261 int utf8_index(const char *str
, int index
)
21263 const char *s
= str
;
21266 s
+= utf8_tounicode(s
, &c
);
21271 int utf8_charequal(const char *s1
, const char *s2
)
21275 utf8_tounicode(s1
, &c1
);
21276 utf8_tounicode(s2
, &c2
);
21281 int utf8_prev_len(const char *str
, int len
)
21287 /* Look up to len chars backward for a start-of-char byte */
21289 if ((str
[-n
] & 0x80) == 0) {
21290 /* Start of a 1-byte char */
21293 if ((str
[-n
] & 0xc0) == 0xc0) {
21294 /* Start of a multi-byte char */
21302 int utf8_tounicode(const char *str
, int *uc
)
21304 unsigned const char *s
= (unsigned const char *)str
;
21311 if ((s
[1] & 0xc0) == 0x80) {
21312 *uc
= ((s
[0] & ~0xc0) << 6) | (s
[1] & ~0x80);
21316 else if (s
[0] < 0xf0) {
21317 if (((str
[1] & 0xc0) == 0x80) && ((str
[2] & 0xc0) == 0x80)) {
21318 *uc
= ((s
[0] & ~0xe0) << 12) | ((s
[1] & ~0x80) << 6) | (s
[2] & ~0x80);
21323 /* Invalid sequence, so just return the byte */
21329 unsigned short code
; /* code point */
21330 signed char lowerdelta
; /* add for lowercase, or if -128 use the ext table */
21331 signed char upperdelta
; /* add for uppercase, or offset into the ext table */
21334 /* Extended table for codepoints where |delta| > 127 */
21335 struct caseextmap
{
21336 unsigned short lower
;
21337 unsigned short upper
;
21340 /* Generated mapping tables */
21341 #include "_unicode_mapping.c"
21343 #define NUMCASEMAP sizeof(unicode_case_mapping) / sizeof(*unicode_case_mapping)
21345 static int cmp_casemap(const void *key
, const void *cm
)
21347 return *(int *)key
- (int)((const struct casemap
*)cm
)->code
;
21350 static int utf8_map_case(int uc
, int upper
)
21352 const struct casemap
*cm
= bsearch(&uc
, unicode_case_mapping
, NUMCASEMAP
, sizeof(*unicode_case_mapping
), cmp_casemap
);
21355 if (cm
->lowerdelta
== -128) {
21356 uc
= upper
? unicode_extmap
[cm
->upperdelta
].upper
: unicode_extmap
[cm
->upperdelta
].lower
;
21359 uc
+= upper
? cm
->upperdelta
: cm
->lowerdelta
;
21365 int utf8_upper(int uc
)
21368 return toupper(uc
);
21370 return utf8_map_case(uc
, 1);
21373 int utf8_lower(int uc
)
21376 return tolower(uc
);
21379 return utf8_map_case(uc
, 0);
21384 #include <string.h>
21386 #ifdef USE_LINENOISE
21387 #include <unistd.h>
21388 #include "linenoise.h"
21391 #define MAX_LINE_LEN 512
21393 static char *linenoise(const char *prompt
)
21395 char *line
= malloc(MAX_LINE_LEN
);
21397 fputs(prompt
, stdout
);
21400 if (fgets(line
, MAX_LINE_LEN
, stdin
) == NULL
) {
21408 int Jim_InteractivePrompt(Jim_Interp
*interp
)
21410 int retcode
= JIM_OK
;
21411 char *history_file
= NULL
;
21412 #ifdef USE_LINENOISE
21415 home
= getenv("HOME");
21416 if (home
&& isatty(STDIN_FILENO
)) {
21417 int history_len
= strlen(home
) + sizeof("/.jim_history");
21418 history_file
= Jim_Alloc(history_len
);
21419 snprintf(history_file
, history_len
, "%s/.jim_history", home
);
21420 linenoiseHistoryLoad(history_file
);
21424 printf("Welcome to Jim version %d.%d" JIM_NL
,
21425 JIM_VERSION
/ 100, JIM_VERSION
% 100);
21426 Jim_SetVariableStrWithStr(interp
, JIM_INTERACTIVE
, "1");
21429 Jim_Obj
*scriptObjPtr
;
21430 const char *result
;
21435 if (retcode
!= 0) {
21436 const char *retcodestr
= Jim_ReturnCode(retcode
);
21438 if (*retcodestr
== '?') {
21439 snprintf(prompt
, sizeof(prompt
) - 3, "[%d] ", retcode
);
21442 snprintf(prompt
, sizeof(prompt
) - 3, "[%s] ", retcodestr
);
21448 strcat(prompt
, ". ");
21450 scriptObjPtr
= Jim_NewStringObj(interp
, "", 0);
21451 Jim_IncrRefCount(scriptObjPtr
);
21457 line
= linenoise(prompt
);
21458 if (line
== NULL
) {
21459 if (errno
== EINTR
) {
21462 Jim_DecrRefCount(interp
, scriptObjPtr
);
21465 if (Jim_Length(scriptObjPtr
) != 0) {
21466 Jim_AppendString(interp
, scriptObjPtr
, "\n", 1);
21468 Jim_AppendString(interp
, scriptObjPtr
, line
, -1);
21470 str
= Jim_GetString(scriptObjPtr
, &len
);
21474 if (Jim_ScriptIsComplete(str
, len
, &state
))
21477 snprintf(prompt
, sizeof(prompt
), "%c> ", state
);
21479 #ifdef USE_LINENOISE
21480 if (strcmp(str
, "h") == 0) {
21481 /* built-in history command */
21484 char **history
= linenoiseHistory(&len
);
21485 for (i
= 0; i
< len
; i
++) {
21486 printf("%4d %s\n", i
+ 1, history
[i
]);
21488 Jim_DecrRefCount(interp
, scriptObjPtr
);
21492 linenoiseHistoryAdd(Jim_String(scriptObjPtr
));
21493 if (history_file
) {
21494 linenoiseHistorySave(history_file
);
21497 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
21498 Jim_DecrRefCount(interp
, scriptObjPtr
);
21502 if (retcode
== JIM_EXIT
) {
21503 Jim_Free(history_file
);
21506 if (retcode
== JIM_ERR
) {
21507 Jim_MakeErrorMessage(interp
);
21509 result
= Jim_GetString(Jim_GetResult(interp
), &reslen
);
21511 printf("%s\n", result
);
21515 Jim_Free(history_file
);
21519 * Implements the internals of the format command for jim
21521 * The FreeBSD license
21523 * Redistribution and use in source and binary forms, with or without
21524 * modification, are permitted provided that the following conditions
21527 * 1. Redistributions of source code must retain the above copyright
21528 * notice, this list of conditions and the following disclaimer.
21529 * 2. Redistributions in binary form must reproduce the above
21530 * copyright notice, this list of conditions and the following
21531 * disclaimer in the documentation and/or other materials
21532 * provided with the distribution.
21534 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
21535 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
21536 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
21537 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
21538 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
21539 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
21540 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
21541 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21542 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
21543 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
21544 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
21545 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
21547 * The views and conclusions contained in the software and documentation
21548 * are those of the authors and should not be interpreted as representing
21549 * official policies, either expressed or implied, of the Jim Tcl Project.
21551 * Based on code originally from Tcl 8.5:
21553 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
21554 * Copyright (c) 1999 by Scriptics Corporation.
21556 * See the file "tcl.license.terms" for information on usage and redistribution of
21557 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
21560 #include <string.h>
21563 #define JIM_UTF_MAX 3
21564 #define JIM_INTEGER_SPACE 24
21565 #define MAX_FLOAT_WIDTH 320
21568 * Apply the printf-like format in fmtObjPtr with the given arguments.
21570 * Returns a new object with zero reference count if OK, or NULL on error.
21572 Jim_Obj
*Jim_FormatString(Jim_Interp
*interp
, Jim_Obj
*fmtObjPtr
, int objc
, Jim_Obj
*const *objv
)
21574 const char *span
, *format
, *formatEnd
, *msg
;
21575 int numBytes
= 0, objIndex
= 0, gotXpg
= 0, gotSequential
= 0;
21576 static const char *mixedXPG
=
21577 "cannot mix \"%\" and \"%n$\" conversion specifiers";
21578 static const char *badIndex
[2] = {
21579 "not enough arguments for all format specifiers",
21580 "\"%n$\" argument index out of range"
21583 Jim_Obj
*resultPtr
;
21585 /* A single buffer is used to store numeric fields (with sprintf())
21586 * This buffer is allocated/reallocated as necessary
21588 char *num_buffer
= NULL
;
21589 int num_buffer_size
= 0;
21591 span
= format
= Jim_GetString(fmtObjPtr
, &formatLen
);
21592 formatEnd
= format
+ formatLen
;
21593 resultPtr
= Jim_NewStringObj(interp
, "", 0);
21595 while (format
!= formatEnd
) {
21597 int gotMinus
, sawFlag
;
21598 int gotPrecision
, useShort
;
21599 long width
, precision
;
21605 char spec
[2*JIM_INTEGER_SPACE
+ 12];
21608 int formatted_chars
;
21609 int formatted_bytes
;
21610 const char *formatted_buf
;
21612 step
= utf8_tounicode(format
, &ch
);
21619 Jim_AppendString(interp
, resultPtr
, span
, numBytes
);
21624 * Saw a % : process the format specifier.
21626 * Step 0. Handle special case of escaped format marker (i.e., %%).
21629 step
= utf8_tounicode(format
, &ch
);
21638 * Step 1. XPG3 position specifier
21643 int position
= strtoul(format
, &end
, 10);
21646 objIndex
= position
- 1;
21648 step
= utf8_tounicode(format
, &ch
);
21652 if (gotSequential
) {
21664 if ((objIndex
< 0) || (objIndex
>= objc
)) {
21665 msg
= badIndex
[gotXpg
];
21670 * Step 2. Set of flags. Also build up the sprintf spec.
21695 step
= utf8_tounicode(format
, &ch
);
21699 * Step 3. Minimum field width.
21704 width
= strtoul(format
, &end
, 10);
21706 step
= utf8_tounicode(format
, &ch
);
21707 } else if (ch
== '*') {
21708 if (objIndex
>= objc
- 1) {
21709 msg
= badIndex
[gotXpg
];
21712 if (Jim_GetLong(interp
, objv
[objIndex
], &width
) != JIM_OK
) {
21724 step
= utf8_tounicode(format
, &ch
);
21728 * Step 4. Precision.
21731 gotPrecision
= precision
= 0;
21735 step
= utf8_tounicode(format
, &ch
);
21738 precision
= strtoul(format
, &end
, 10);
21740 step
= utf8_tounicode(format
, &ch
);
21741 } else if (ch
== '*') {
21742 if (objIndex
>= objc
- 1) {
21743 msg
= badIndex
[gotXpg
];
21746 if (Jim_GetLong(interp
, objv
[objIndex
], &precision
) != JIM_OK
) {
21751 * TODO: Check this truncation logic.
21754 if (precision
< 0) {
21759 step
= utf8_tounicode(format
, &ch
);
21763 * Step 5. Length modifier.
21770 step
= utf8_tounicode(format
, &ch
);
21771 } else if (ch
== 'l') {
21772 /* Just for compatibility. All non-short integers are wide. */
21774 step
= utf8_tounicode(format
, &ch
);
21777 step
= utf8_tounicode(format
, &ch
);
21785 * Step 6. The actual conversion character.
21794 /* Each valid conversion will set:
21795 * formatted_buf - the result to be added
21796 * formatted_chars - the length of formatted_buf in characters
21797 * formatted_bytes - the length of formatted_buf in bytes
21801 msg
= "format string ended in middle of field specifier";
21804 formatted_buf
= Jim_GetString(objv
[objIndex
], &formatted_bytes
);
21805 formatted_chars
= Jim_Utf8Length(interp
, objv
[objIndex
]);
21806 if (gotPrecision
&& (precision
< formatted_chars
)) {
21807 /* Need to build a (null terminated) truncated string */
21808 formatted_chars
= precision
;
21809 formatted_bytes
= utf8_index(formatted_buf
, precision
);
21816 if (Jim_GetWide(interp
, objv
[objIndex
], &code
) != JIM_OK
) {
21819 /* Just store the value in the 'spec' buffer */
21820 formatted_bytes
= utf8_fromunicode(spec
, code
);
21821 formatted_buf
= spec
;
21822 formatted_chars
= 1;
21842 /* Fill in the width and precision */
21844 p
+= sprintf(p
, "%ld", width
);
21846 if (gotPrecision
) {
21847 p
+= sprintf(p
, ".%ld", precision
);
21850 /* Now the modifier, and get the actual value here */
21852 if (Jim_GetDouble(interp
, objv
[objIndex
], &d
) != JIM_OK
) {
21855 length
= MAX_FLOAT_WIDTH
;
21858 if (Jim_GetWide(interp
, objv
[objIndex
], &w
) != JIM_OK
) {
21861 length
= JIM_INTEGER_SPACE
;
21868 w
= (unsigned short)w
;
21873 #ifdef HAVE_LONG_LONG
21874 if (sizeof(long long) == sizeof(jim_wide
)) {
21884 /* Adjust length for width and precision */
21885 if (width
> length
) {
21888 if (gotPrecision
) {
21889 length
+= precision
;
21892 /* Increase the size of the buffer if needed */
21893 if (num_buffer_size
< length
+ 1) {
21894 num_buffer_size
= length
+ 1;
21895 num_buffer
= Jim_Realloc(num_buffer
, num_buffer_size
);
21899 snprintf(num_buffer
, length
+ 1, spec
, d
);
21902 formatted_bytes
= snprintf(num_buffer
, length
+ 1, spec
, w
);
21904 formatted_chars
= formatted_bytes
= strlen(num_buffer
);
21905 formatted_buf
= num_buffer
;
21910 /* Just reuse the 'spec' buffer */
21913 Jim_SetResultFormatted(interp
, "bad field specifier \"%s\"", spec
);
21919 while (formatted_chars
< width
) {
21920 Jim_AppendString(interp
, resultPtr
, &pad
, 1);
21925 Jim_AppendString(interp
, resultPtr
, formatted_buf
, formatted_bytes
);
21927 while (formatted_chars
< width
) {
21928 Jim_AppendString(interp
, resultPtr
, &pad
, 1);
21932 objIndex
+= gotSequential
;
21935 Jim_AppendString(interp
, resultPtr
, span
, numBytes
);
21938 Jim_Free(num_buffer
);
21942 Jim_SetResultString(interp
, msg
, -1);
21944 Jim_FreeNewObj(interp
, resultPtr
);
21945 Jim_Free(num_buffer
);
21949 * regcomp and regexec -- regsub and regerror are elsewhere
21951 * Copyright (c) 1986 by University of Toronto.
21952 * Written by Henry Spencer. Not derived from licensed software.
21954 * Permission is granted to anyone to use this software for any
21955 * purpose on any computer system, and to redistribute it freely,
21956 * subject to the following restrictions:
21958 * 1. The author is not responsible for the consequences of use of
21959 * this software, no matter how awful, even if they arise
21960 * from defects in it.
21962 * 2. The origin of this software must not be misrepresented, either
21963 * by explicit claim or by omission.
21965 * 3. Altered versions must be plainly marked as such, and must not
21966 * be misrepresented as being the original software.
21967 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21968 *** hoptoad!gnu, on 27 Dec 1986, to add \n as an alternative to |
21969 *** to assist in implementing egrep.
21970 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21971 *** hoptoad!gnu, on 27 Dec 1986, to add \< and \> for word-matching
21972 *** as in BSD grep and ex.
21973 *** THIS IS AN ALTERED VERSION. It was altered by John Gilmore,
21974 *** hoptoad!gnu, on 28 Dec 1986, to optimize characters quoted with \.
21975 *** THIS IS AN ALTERED VERSION. It was altered by James A. Woods,
21976 *** ames!jaw, on 19 June 1987, to quash a regcomp() redundancy.
21977 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21978 *** seiwald@vix.com, on 28 August 1993, for use in jam. Regmagic.h
21979 *** was moved into regexp.h, and the include of regexp.h now uses "'s
21980 *** to avoid conflicting with the system regexp.h. Const, bless its
21981 *** soul, was removed so it can compile everywhere. The declaration
21982 *** of strchr() was in conflict on AIX, so it was removed (as it is
21983 *** happily defined in string.h).
21984 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21985 *** seiwald@perforce.com, on 20 January 2000, to use function prototypes.
21986 *** THIS IS AN ALTERED VERSION. It was altered by Christopher Seiwald
21987 *** seiwald@perforce.com, on 05 November 2002, to const string literals.
21989 * THIS IS AN ALTERED VERSION. It was altered by Steve Bennett <steveb@workware.net.au>
21990 * on 16 October 2010, to remove static state and add better Tcl ARE compatibility.
21991 * This includes counted repetitions, UTF-8 support, character classes,
21992 * shorthand character classes, increased number of parentheses to 100,
21993 * backslash escape sequences. It also removes \n as an alternative to |.
21995 * Beware that some of this code is subtly aware of the way operator
21996 * precedence is structured in regular expressions. Serious changes in
21997 * regular-expression syntax might require a total rethink.
22001 #include <stdlib.h>
22002 #include <string.h>
22005 #if !defined(HAVE_REGCOMP) || defined(JIM_REGEXP)
22008 * Structure for regexp "program". This is essentially a linear encoding
22009 * of a nondeterministic finite-state machine (aka syntax charts or
22010 * "railroad normal form" in parsing technology). Each node is an opcode
22011 * plus a "next" pointer, possibly plus an operand. "Next" pointers of
22012 * all nodes except BRANCH implement concatenation; a "next" pointer with
22013 * a BRANCH on both ends of it is connecting two alternatives. (Here we
22014 * have one of the subtle syntax dependencies: an individual BRANCH (as
22015 * opposed to a collection of them) is never concatenated with anything
22016 * because of operator precedence.) The operand of some types of node is
22017 * a literal string; for others, it is a node leading into a sub-FSM. In
22018 * particular, the operand of a BRANCH node is the first node of the branch.
22019 * (NB this is *not* a tree structure: the tail of the branch connects
22020 * to the thing following the set of BRANCHes.) The opcodes are:
22023 /* This *MUST* be less than (255-20)/2=117 */
22024 #define REG_MAX_PAREN 100
22026 /* definition number opnd? meaning */
22027 #define END 0 /* no End of program. */
22028 #define BOL 1 /* no Match "" at beginning of line. */
22029 #define EOL 2 /* no Match "" at end of line. */
22030 #define ANY 3 /* no Match any one character. */
22031 #define ANYOF 4 /* str Match any character in this string. */
22032 #define ANYBUT 5 /* str Match any character not in this string. */
22033 #define BRANCH 6 /* node Match this alternative, or the next... */
22034 #define BACK 7 /* no Match "", "next" ptr points backward. */
22035 #define EXACTLY 8 /* str Match this string. */
22036 #define NOTHING 9 /* no Match empty string. */
22037 #define REP 10 /* max,min Match this (simple) thing [min,max] times. */
22038 #define REPMIN 11 /* max,min Match this (simple) thing [min,max] times, mininal match. */
22039 #define REPX 12 /* max,min Match this (complex) thing [min,max] times. */
22040 #define REPXMIN 13 /* max,min Match this (complex) thing [min,max] times, minimal match. */
22042 #define WORDA 15 /* no Match "" at wordchar, where prev is nonword */
22043 #define WORDZ 16 /* no Match "" at nonwordchar, where prev is word */
22044 #define OPEN 20 /* no Mark this point in input as start of #n. */
22045 /* OPEN+1 is number 1, etc. */
22046 #define CLOSE (OPEN+REG_MAX_PAREN) /* no Analogous to OPEN. */
22047 #define CLOSE_END (CLOSE+REG_MAX_PAREN)
22050 * The first byte of the regexp internal "program" is actually this magic
22051 * number; the start node begins in the second byte.
22053 #define REG_MAGIC 0xFADED00D
22058 * BRANCH The set of branches constituting a single choice are hooked
22059 * together with their "next" pointers, since precedence prevents
22060 * anything being concatenated to any individual branch. The
22061 * "next" pointer of the last BRANCH in a choice points to the
22062 * thing following the whole choice. This is also where the
22063 * final "next" pointer of each individual branch points; each
22064 * branch starts with the operand node of a BRANCH node.
22066 * BACK Normal "next" pointers all implicitly point forward; BACK
22067 * exists to make loop structures possible.
22069 * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
22070 * BRANCH structures using BACK. Simple cases (one character
22071 * per match) are implemented with STAR and PLUS for speed
22072 * and to minimize recursive plunges.
22074 * OPEN,CLOSE ...are numbered at compile time.
22078 * A node is one char of opcode followed by two chars of "next" pointer.
22079 * "Next" pointers are stored as two 8-bit pieces, high order first. The
22080 * value is a positive offset from the opcode of the node containing it.
22081 * An operand, if any, simply follows the node. (Note that much of the
22082 * code generation knows about this implicit relationship.)
22084 * Using two bytes for the "next" pointer is vast overkill for most things,
22085 * but allows patterns to get big without disasters.
22087 #define OP(preg, p) (preg->program[p])
22088 #define NEXT(preg, p) (preg->program[p + 1])
22089 #define OPERAND(p) ((p) + 2)
22092 * See regmagic.h for one further detail of program structure.
22097 * Utility definitions.
22100 #define FAIL(R,M) { (R)->err = (M); return (M); }
22101 #define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?' || (c) == '{')
22102 #define META "^$.[()|?{+*"
22105 * Flags to be passed up and down.
22107 #define HASWIDTH 01 /* Known never to match null string. */
22108 #define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */
22109 #define SPSTART 04 /* Starts with * or +. */
22110 #define WORST 0 /* Worst case. */
22112 #define MAX_REP_COUNT 1000000
22115 * Forward declarations for regcomp()'s friends.
22117 static int reg(regex_t
*preg
, int paren
/* Parenthesized? */, int *flagp
);
22118 static int regpiece(regex_t
*preg
, int *flagp
);
22119 static int regbranch(regex_t
*preg
, int *flagp
);
22120 static int regatom(regex_t
*preg
, int *flagp
);
22121 static int regnode(regex_t
*preg
, int op
);
22122 static int regnext(regex_t
*preg
, int p
);
22123 static void regc(regex_t
*preg
, int b
);
22124 static int reginsert(regex_t
*preg
, int op
, int size
, int opnd
);
22125 static void regtail_(regex_t
*preg
, int p
, int val
, int line
);
22126 static void regoptail(regex_t
*preg
, int p
, int val
);
22127 #define regtail(PREG, P, VAL) regtail_(PREG, P, VAL, __LINE__)
22129 static int reg_range_find(const int *string
, int c
);
22130 static const char *str_find(const char *string
, int c
, int nocase
);
22131 static int prefix_cmp(const int *prog
, int proglen
, const char *string
, int nocase
);
22135 int regnarrate
= 0;
22136 static void regdump(regex_t
*preg
);
22137 static const char *regprop( int op
);
22142 * Returns the length of the null-terminated integer sequence.
22144 static int str_int_len(const int *seq
)
22154 - regcomp - compile a regular expression into internal code
22156 * We can't allocate space until we know how big the compiled form will be,
22157 * but we can't compile it (and thus know how big it is) until we've got a
22158 * place to put the code. So we cheat: we compile it twice, once with code
22159 * generation turned off and size counting turned on, and once "for real".
22160 * This also means that we don't allocate space until we are sure that the
22161 * thing really will compile successfully, and we never have to move the
22162 * code and thus invalidate pointers into it. (Note that it has to be in
22163 * one piece because free() must be able to free it all.)
22165 * Beware that the optimization-preparation code in here knows about some
22166 * of the structure of the compiled regexp.
22168 int regcomp(regex_t
*preg
, const char *exp
, int cflags
)
22176 fprintf(stderr
, "Compiling: '%s'\n", exp
);
22178 memset(preg
, 0, sizeof(*preg
));
22181 FAIL(preg
, REG_ERR_NULL_ARGUMENT
);
22183 /* First pass: determine size, legality. */
22184 preg
->cflags
= cflags
;
22185 preg
->regparse
= exp
;
22186 /* XXX: For now, start unallocated */
22187 preg
->program
= NULL
;
22191 /* Allocate space. */
22192 preg
->proglen
= (strlen(exp
) + 1) * 5;
22193 preg
->program
= malloc(preg
->proglen
* sizeof(int));
22194 if (preg
->program
== NULL
)
22195 FAIL(preg
, REG_ERR_NOMEM
);
22198 /* Note that since we store a magic value as the first item in the program,
22199 * program offsets will never be 0
22201 regc(preg
, REG_MAGIC
);
22202 if (reg(preg
, 0, &flags
) == 0) {
22206 /* Small enough for pointer-storage convention? */
22207 if (preg
->re_nsub
>= REG_MAX_PAREN
) /* Probably could be 65535L. */
22208 FAIL(preg
,REG_ERR_TOO_BIG
);
22210 /* Dig out information for optimizations. */
22211 preg
->regstart
= 0; /* Worst-case defaults. */
22215 scan
= 1; /* First BRANCH. */
22216 if (OP(preg
, regnext(preg
, scan
)) == END
) { /* Only one top-level choice. */
22217 scan
= OPERAND(scan
);
22219 /* Starting-point info. */
22220 if (OP(preg
, scan
) == EXACTLY
) {
22221 preg
->regstart
= preg
->program
[OPERAND(scan
)];
22223 else if (OP(preg
, scan
) == BOL
)
22227 * If there's something expensive in the r.e., find the
22228 * longest literal string that must appear and make it the
22229 * regmust. Resolve ties in favor of later strings, since
22230 * the regstart check works with the beginning of the r.e.
22231 * and avoiding duplication strengthens checking. Not a
22232 * strong reason, but sufficient in the absence of others.
22234 if (flags
&SPSTART
) {
22237 for (; scan
!= 0; scan
= regnext(preg
, scan
)) {
22238 if (OP(preg
, scan
) == EXACTLY
) {
22239 int plen
= str_int_len(preg
->program
+ OPERAND(scan
));
22241 longest
= OPERAND(scan
);
22246 preg
->regmust
= longest
;
22247 preg
->regmlen
= len
;
22259 - reg - regular expression, i.e. main body or parenthesized thing
22261 * Caller must absorb opening parenthesis.
22263 * Combining parenthesis handling with the base level of regular expression
22264 * is a trifle forced, but the need to tie the tails of the branches to what
22265 * follows makes it hard to avoid.
22267 static int reg(regex_t
*preg
, int paren
/* Parenthesized? */, int *flagp
)
22275 *flagp
= HASWIDTH
; /* Tentatively. */
22277 /* Make an OPEN node, if parenthesized. */
22279 parno
= ++preg
->re_nsub
;
22280 ret
= regnode(preg
, OPEN
+parno
);
22284 /* Pick up the branches, linking them together. */
22285 br
= regbranch(preg
, &flags
);
22289 regtail(preg
, ret
, br
); /* OPEN -> first. */
22292 if (!(flags
&HASWIDTH
))
22293 *flagp
&= ~HASWIDTH
;
22294 *flagp
|= flags
&SPSTART
;
22295 while (*preg
->regparse
== '|') {
22297 br
= regbranch(preg
, &flags
);
22300 regtail(preg
, ret
, br
); /* BRANCH -> BRANCH. */
22301 if (!(flags
&HASWIDTH
))
22302 *flagp
&= ~HASWIDTH
;
22303 *flagp
|= flags
&SPSTART
;
22306 /* Make a closing node, and hook it on the end. */
22307 ender
= regnode(preg
, (paren
) ? CLOSE
+parno
: END
);
22308 regtail(preg
, ret
, ender
);
22310 /* Hook the tails of the branches to the closing node. */
22311 for (br
= ret
; br
!= 0; br
= regnext(preg
, br
))
22312 regoptail(preg
, br
, ender
);
22314 /* Check for proper termination. */
22315 if (paren
&& *preg
->regparse
++ != ')') {
22316 preg
->err
= REG_ERR_UNMATCHED_PAREN
;
22318 } else if (!paren
&& *preg
->regparse
!= '\0') {
22319 if (*preg
->regparse
== ')') {
22320 preg
->err
= REG_ERR_UNMATCHED_PAREN
;
22323 preg
->err
= REG_ERR_JUNK_ON_END
;
22332 - regbranch - one alternative of an | operator
22334 * Implements the concatenation operator.
22336 static int regbranch(regex_t
*preg
, int *flagp
)
22343 *flagp
= WORST
; /* Tentatively. */
22345 ret
= regnode(preg
, BRANCH
);
22347 while (*preg
->regparse
!= '\0' && *preg
->regparse
!= ')' &&
22348 *preg
->regparse
!= '|') {
22349 latest
= regpiece(preg
, &flags
);
22352 *flagp
|= flags
&HASWIDTH
;
22353 if (chain
== 0) {/* First piece. */
22354 *flagp
|= flags
&SPSTART
;
22357 regtail(preg
, chain
, latest
);
22361 if (chain
== 0) /* Loop ran zero times. */
22362 (void) regnode(preg
, NOTHING
);
22368 - regpiece - something followed by possible [*+?]
22370 * Note that the branching code sequences used for ? and the general cases
22371 * of * and + are somewhat optimized: they use the same NOTHING node as
22372 * both the endmarker for their branch list and the body of the last branch.
22373 * It might seem that this node could be dispensed with entirely, but the
22374 * endmarker role is not redundant.
22376 static int regpiece(regex_t
*preg
, int *flagp
)
22386 ret
= regatom(preg
, &flags
);
22390 op
= *preg
->regparse
;
22396 if (!(flags
&HASWIDTH
) && op
!= '?') {
22397 preg
->err
= REG_ERR_OPERAND_COULD_BE_EMPTY
;
22401 /* Handle braces (counted repetition) by expansion */
22405 min
= strtoul(preg
->regparse
+ 1, &end
, 10);
22406 if (end
== preg
->regparse
+ 1) {
22407 preg
->err
= REG_ERR_BAD_COUNT
;
22414 preg
->regparse
= end
;
22415 max
= strtoul(preg
->regparse
+ 1, &end
, 10);
22417 preg
->err
= REG_ERR_UNMATCHED_BRACES
;
22421 if (end
== preg
->regparse
+ 1) {
22422 max
= MAX_REP_COUNT
;
22424 else if (max
< min
|| max
>= 100) {
22425 preg
->err
= REG_ERR_BAD_COUNT
;
22429 preg
->err
= REG_ERR_BAD_COUNT
;
22433 preg
->regparse
= strchr(preg
->regparse
, '}');
22437 max
= (op
== '?' ? 1 : MAX_REP_COUNT
);
22440 if (preg
->regparse
[1] == '?') {
22442 next
= reginsert(preg
, flags
& SIMPLE
? REPMIN
: REPXMIN
, 5, ret
);
22445 next
= reginsert(preg
, flags
& SIMPLE
? REP
: REPX
, 5, ret
);
22447 preg
->program
[ret
+ 2] = max
;
22448 preg
->program
[ret
+ 3] = min
;
22449 preg
->program
[ret
+ 4] = 0;
22451 *flagp
= (min
) ? (WORST
|HASWIDTH
) : (WORST
|SPSTART
);
22453 if (!(flags
& SIMPLE
)) {
22454 int back
= regnode(preg
, BACK
);
22455 regtail(preg
, back
, ret
);
22456 regtail(preg
, next
, back
);
22460 if (ISMULT(*preg
->regparse
)) {
22461 preg
->err
= REG_ERR_NESTED_COUNT
;
22465 return chain
? chain
: ret
;
22469 * Add all characters in the inclusive range between lower and upper.
22471 * Handles a swapped range (upper < lower).
22473 static void reg_addrange(regex_t
*preg
, int lower
, int upper
)
22475 if (lower
> upper
) {
22476 reg_addrange(preg
, upper
, lower
);
22478 /* Add a range as length, start */
22479 regc(preg
, upper
- lower
+ 1);
22484 * Add a null-terminated literal string as a set of ranges.
22486 static void reg_addrange_str(regex_t
*preg
, const char *str
)
22489 reg_addrange(preg
, *str
, *str
);
22495 * Extracts the next unicode char from utf8.
22497 * If 'upper' is set, converts the char to uppercase.
22499 static int reg_utf8_tounicode_case(const char *s
, int *uc
, int upper
)
22501 int l
= utf8_tounicode(s
, uc
);
22503 *uc
= utf8_upper(*uc
);
22509 * Converts a hex digit to decimal.
22511 * Returns -1 for an invalid hex digit.
22513 static int hexdigitval(int c
)
22515 if (c
>= '0' && c
<= '9')
22517 if (c
>= 'a' && c
<= 'f')
22518 return c
- 'a' + 10;
22519 if (c
>= 'A' && c
<= 'F')
22520 return c
- 'A' + 10;
22525 * Parses up to 'n' hex digits at 's' and stores the result in *uc.
22527 * Returns the number of hex digits parsed.
22528 * If there are no hex digits, returns 0 and stores nothing.
22530 static int parse_hex(const char *s
, int n
, int *uc
)
22535 for (k
= 0; k
< n
; k
++) {
22536 int c
= hexdigitval(*s
++);
22540 val
= (val
<< 4) | c
;
22549 * Call for chars after a backlash to decode the escape sequence.
22551 * Stores the result in *ch.
22553 * Returns the number of bytes consumed.
22555 static int reg_decode_escape(const char *s
, int *ch
)
22558 const char *s0
= s
;
22563 case 'b': *ch
= '\b'; break;
22564 case 'e': *ch
= 27; break;
22565 case 'f': *ch
= '\f'; break;
22566 case 'n': *ch
= '\n'; break;
22567 case 'r': *ch
= '\r'; break;
22568 case 't': *ch
= '\t'; break;
22569 case 'v': *ch
= '\v'; break;
22571 if ((n
= parse_hex(s
, 4, ch
)) > 0) {
22576 if ((n
= parse_hex(s
, 2, ch
)) > 0) {
22589 - regatom - the lowest level
22591 * Optimization: gobbles an entire sequence of ordinary characters so that
22592 * it can turn them into a single node, which is smaller to store and
22593 * faster to run. Backslashed characters are exceptions, each becoming a
22594 * separate node; the code is simpler that way and it's not worth fixing.
22596 static int regatom(regex_t
*preg
, int *flagp
)
22600 int nocase
= (preg
->cflags
& REG_ICASE
);
22603 int n
= reg_utf8_tounicode_case(preg
->regparse
, &ch
, nocase
);
22605 *flagp
= WORST
; /* Tentatively. */
22607 preg
->regparse
+= n
;
22609 /* FIXME: these chars only have meaning at beg/end of pat? */
22611 ret
= regnode(preg
, BOL
);
22614 ret
= regnode(preg
, EOL
);
22617 ret
= regnode(preg
, ANY
);
22618 *flagp
|= HASWIDTH
|SIMPLE
;
22621 const char *pattern
= preg
->regparse
;
22623 if (*pattern
== '^') { /* Complement of range. */
22624 ret
= regnode(preg
, ANYBUT
);
22627 ret
= regnode(preg
, ANYOF
);
22629 /* Special case. If the first char is ']' or '-', it is part of the set */
22630 if (*pattern
== ']' || *pattern
== '-') {
22631 reg_addrange(preg
, *pattern
, *pattern
);
22635 while (*pattern
&& *pattern
!= ']') {
22636 /* Is this a range? a-z */
22640 pattern
+= reg_utf8_tounicode_case(pattern
, &start
, nocase
);
22641 if (start
== '\\') {
22642 pattern
+= reg_decode_escape(pattern
, &start
);
22644 preg
->err
= REG_ERR_NULL_CHAR
;
22648 if (pattern
[0] == '-' && pattern
[1]) {
22650 pattern
+= utf8_tounicode(pattern
, &end
);
22651 pattern
+= reg_utf8_tounicode_case(pattern
, &end
, nocase
);
22653 pattern
+= reg_decode_escape(pattern
, &end
);
22655 preg
->err
= REG_ERR_NULL_CHAR
;
22660 reg_addrange(preg
, start
, end
);
22663 if (start
== '[') {
22664 if (strncmp(pattern
, ":alpha:]", 8) == 0) {
22665 if ((preg
->cflags
& REG_ICASE
) == 0) {
22666 reg_addrange(preg
, 'a', 'z');
22668 reg_addrange(preg
, 'A', 'Z');
22672 if (strncmp(pattern
, ":alnum:]", 8) == 0) {
22673 if ((preg
->cflags
& REG_ICASE
) == 0) {
22674 reg_addrange(preg
, 'a', 'z');
22676 reg_addrange(preg
, 'A', 'Z');
22677 reg_addrange(preg
, '0', '9');
22681 if (strncmp(pattern
, ":space:]", 8) == 0) {
22682 reg_addrange_str(preg
, " \t\r\n\f\v");
22687 /* Not a range, so just add the char */
22688 reg_addrange(preg
, start
, start
);
22695 preg
->regparse
= pattern
;
22697 *flagp
|= HASWIDTH
|SIMPLE
;
22701 ret
= reg(preg
, 1, &flags
);
22704 *flagp
|= flags
&(HASWIDTH
|SPSTART
);
22709 preg
->err
= REG_ERR_INTERNAL
;
22710 return 0; /* Supposed to be caught earlier. */
22715 preg
->err
= REG_ERR_COUNT_FOLLOWS_NOTHING
;
22718 switch (*preg
->regparse
++) {
22720 preg
->err
= REG_ERR_TRAILING_BACKSLASH
;
22724 ret
= regnode(preg
, WORDA
);
22728 ret
= regnode(preg
, WORDZ
);
22731 ret
= regnode(preg
, ANYOF
);
22732 reg_addrange(preg
, '0', '9');
22734 *flagp
|= HASWIDTH
|SIMPLE
;
22737 ret
= regnode(preg
, ANYOF
);
22738 if ((preg
->cflags
& REG_ICASE
) == 0) {
22739 reg_addrange(preg
, 'a', 'z');
22741 reg_addrange(preg
, 'A', 'Z');
22742 reg_addrange(preg
, '0', '9');
22743 reg_addrange(preg
, '_', '_');
22745 *flagp
|= HASWIDTH
|SIMPLE
;
22748 ret
= regnode(preg
, ANYOF
);
22749 reg_addrange_str(preg
," \t\r\n\f\v");
22751 *flagp
|= HASWIDTH
|SIMPLE
;
22753 /* FIXME: Someday handle \1, \2, ... */
22755 /* Handle general quoted chars in exact-match routine */
22756 /* Back up to include the backslash */
22764 * Encode a string of characters to be matched exactly.
22768 /* Back up to pick up the first char of interest */
22769 preg
->regparse
-= n
;
22771 ret
= regnode(preg
, EXACTLY
);
22773 /* Note that a META operator such as ? or * consumes the
22775 * Thus we must be careful to look ahead by 2 and add the
22776 * last char as it's own EXACTLY if necessary
22779 /* Until end of string or a META char is reached */
22780 while (*preg
->regparse
&& strchr(META
, *preg
->regparse
) == NULL
) {
22781 n
= reg_utf8_tounicode_case(preg
->regparse
, &ch
, (preg
->cflags
& REG_ICASE
));
22782 if (ch
== '\\' && preg
->regparse
[n
]) {
22783 /* Non-trailing backslash.
22784 * Is this a special escape, or a regular escape?
22786 if (strchr("<>mMwds", preg
->regparse
[n
])) {
22787 /* A special escape. All done with EXACTLY */
22790 /* Decode it. Note that we add the length for the escape
22791 * sequence to the length for the backlash so we can skip
22792 * the entire sequence, or not as required.
22794 n
+= reg_decode_escape(preg
->regparse
+ n
, &ch
);
22796 preg
->err
= REG_ERR_NULL_CHAR
;
22801 /* Now we have one char 'ch' of length 'n'.
22802 * Check to see if the following char is a MULT
22805 if (ISMULT(preg
->regparse
[n
])) {
22806 /* Yes. But do we already have some EXACTLY chars? */
22808 /* Yes, so return what we have and pick up the current char next time around */
22811 /* No, so add this single char and finish */
22814 preg
->regparse
+= n
;
22818 /* No, so just add this char normally */
22821 preg
->regparse
+= n
;
22825 *flagp
|= HASWIDTH
;
22836 static void reg_grow(regex_t
*preg
, int n
)
22838 if (preg
->p
+ n
>= preg
->proglen
) {
22839 preg
->proglen
= (preg
->p
+ n
) * 2;
22840 preg
->program
= realloc(preg
->program
, preg
->proglen
* sizeof(int));
22845 - regnode - emit a node
22848 static int regnode(regex_t
*preg
, int op
)
22852 preg
->program
[preg
->p
++] = op
;
22853 preg
->program
[preg
->p
++] = 0;
22855 /* Return the start of the node */
22856 return preg
->p
- 2;
22860 - regc - emit (if appropriate) a byte of code
22862 static void regc(regex_t
*preg
, int b
)
22865 preg
->program
[preg
->p
++] = b
;
22869 - reginsert - insert an operator in front of already-emitted operand
22871 * Means relocating the operand.
22872 * Returns the new location of the original operand.
22874 static int reginsert(regex_t
*preg
, int op
, int size
, int opnd
)
22876 reg_grow(preg
, size
);
22878 /* Move everything from opnd up */
22879 memmove(preg
->program
+ opnd
+ size
, preg
->program
+ opnd
, sizeof(int) * (preg
->p
- opnd
));
22880 /* Zero out the new space */
22881 memset(preg
->program
+ opnd
, 0, sizeof(int) * size
);
22883 preg
->program
[opnd
] = op
;
22887 return opnd
+ size
;
22891 - regtail - set the next-pointer at the end of a node chain
22893 static void regtail_(regex_t
*preg
, int p
, int val
, int line
)
22899 /* Find last node. */
22902 temp
= regnext(preg
, scan
);
22908 if (OP(preg
, scan
) == BACK
)
22909 offset
= scan
- val
;
22911 offset
= val
- scan
;
22913 preg
->program
[scan
+ 1] = offset
;
22917 - regoptail - regtail on operand of first argument; nop if operandless
22920 static void regoptail(regex_t
*preg
, int p
, int val
)
22922 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
22923 if (p
!= 0 && OP(preg
, p
) == BRANCH
) {
22924 regtail(preg
, OPERAND(p
), val
);
22929 * regexec and friends
22935 static int regtry(regex_t
*preg
, const char *string
);
22936 static int regmatch(regex_t
*preg
, int prog
);
22937 static int regrepeat(regex_t
*preg
, int p
, int max
);
22940 - regexec - match a regexp against a string
22942 int regexec(regex_t
*preg
, const char *string
, size_t nmatch
, regmatch_t pmatch
[], int eflags
)
22947 /* Be paranoid... */
22948 if (preg
== NULL
|| preg
->program
== NULL
|| string
== NULL
) {
22949 return REG_ERR_NULL_ARGUMENT
;
22952 /* Check validity of program. */
22953 if (*preg
->program
!= REG_MAGIC
) {
22954 return REG_ERR_CORRUPTED
;
22958 fprintf(stderr
, "regexec: %s\n", string
);
22962 preg
->eflags
= eflags
;
22963 preg
->pmatch
= pmatch
;
22964 preg
->nmatch
= nmatch
;
22965 preg
->start
= string
; /* All offsets are computed from here */
22967 /* Must clear out the embedded repeat counts */
22968 for (scan
= OPERAND(1); scan
!= 0; scan
= regnext(preg
, scan
)) {
22969 switch (OP(preg
, scan
)) {
22974 preg
->program
[scan
+ 4] = 0;
22979 /* If there is a "must appear" string, look for it. */
22980 if (preg
->regmust
!= 0) {
22982 while ((s
= str_find(s
, preg
->program
[preg
->regmust
], preg
->cflags
& REG_ICASE
)) != NULL
) {
22983 if (prefix_cmp(preg
->program
+ preg
->regmust
, preg
->regmlen
, s
, preg
->cflags
& REG_ICASE
) >= 0) {
22988 if (s
== NULL
) /* Not present. */
22989 return REG_NOMATCH
;
22992 /* Mark beginning of line for ^ . */
22993 preg
->regbol
= string
;
22995 /* Simplest case: anchored match need be tried only once (maybe per line). */
22996 if (preg
->reganch
) {
22997 if (eflags
& REG_NOTBOL
) {
22998 /* This is an anchored search, but not an BOL, so possibly skip to the next line */
23002 int ret
= regtry(preg
, string
);
23004 return REG_NOERROR
;
23008 if (preg
->cflags
& REG_NEWLINE
) {
23009 /* Try the next anchor? */
23010 string
= strchr(string
, '\n');
23012 preg
->regbol
= ++string
;
23017 return REG_NOMATCH
;
23021 /* Messy cases: unanchored match. */
23023 if (preg
->regstart
!= '\0') {
23024 /* We know what char it must start with. */
23025 while ((s
= str_find(s
, preg
->regstart
, preg
->cflags
& REG_ICASE
)) != NULL
) {
23026 if (regtry(preg
, s
))
23027 return REG_NOERROR
;
23032 /* We don't -- general case. */
23034 if (regtry(preg
, s
))
23035 return REG_NOERROR
;
23039 s
+= utf8_charlen(*s
);
23043 return REG_NOMATCH
;
23047 - regtry - try match at specific point
23049 /* 0 failure, 1 success */
23050 static int regtry( regex_t
*preg
, const char *string
)
23054 preg
->reginput
= string
;
23056 for (i
= 0; i
< preg
->nmatch
; i
++) {
23057 preg
->pmatch
[i
].rm_so
= -1;
23058 preg
->pmatch
[i
].rm_eo
= -1;
23060 if (regmatch(preg
, 1)) {
23061 preg
->pmatch
[0].rm_so
= string
- preg
->start
;
23062 preg
->pmatch
[0].rm_eo
= preg
->reginput
- preg
->start
;
23069 * Returns bytes matched if 'pattern' is a prefix of 'string'.
23071 * If 'nocase' is non-zero, does a case-insensitive match.
23073 * Returns -1 on not found.
23075 static int prefix_cmp(const int *prog
, int proglen
, const char *string
, int nocase
)
23077 const char *s
= string
;
23078 while (proglen
&& *s
) {
23080 int n
= reg_utf8_tounicode_case(s
, &ch
, nocase
);
23088 if (proglen
== 0) {
23095 * Searchs for 'c' in the range 'range'.
23097 * Returns 1 if found, or 0 if not.
23099 static int reg_range_find(const int *range
, int c
)
23102 /*printf("Checking %d in range [%d,%d]\n", c, range[1], (range[0] + range[1] - 1));*/
23103 if (c
>= range
[1] && c
<= (range
[0] + range
[1] - 1)) {
23112 * Search for the character 'c' in the utf-8 string 'string'.
23114 * If 'nocase' is set, the 'string' is assumed to be uppercase
23115 * and 'c' is converted to uppercase before matching.
23117 * Returns the byte position in the string where the 'c' was found, or
23118 * NULL if not found.
23120 static const char *str_find(const char *string
, int c
, int nocase
)
23123 /* The "string" should already be converted to uppercase */
23128 int n
= reg_utf8_tounicode_case(string
, &ch
, nocase
);
23138 * Returns true if 'ch' is an end-of-line char.
23140 * In REG_NEWLINE mode, \n is considered EOL in
23143 static int reg_iseol(regex_t
*preg
, int ch
)
23145 if (preg
->cflags
& REG_NEWLINE
) {
23146 return ch
== '\0' || ch
== '\n';
23153 static int regmatchsimplerepeat(regex_t
*preg
, int scan
, int matchmin
)
23160 int max
= preg
->program
[scan
+ 2];
23161 int min
= preg
->program
[scan
+ 3];
23162 int next
= regnext(preg
, scan
);
23165 * Lookahead to avoid useless match attempts
23166 * when we know what character comes next.
23168 if (OP(preg
, next
) == EXACTLY
) {
23169 nextch
= preg
->program
[OPERAND(next
)];
23171 save
= preg
->reginput
;
23172 no
= regrepeat(preg
, scan
+ 5, max
);
23177 /* from min up to no */
23181 /* else from no down to min */
23193 preg
->reginput
= save
+ utf8_index(save
, no
);
23194 reg_utf8_tounicode_case(preg
->reginput
, &c
, (preg
->cflags
& REG_ICASE
));
23195 /* If it could work, try it. */
23196 if (reg_iseol(preg
, nextch
) || c
== nextch
) {
23197 if (regmatch(preg
, next
)) {
23202 /* Couldn't or didn't, add one more */
23206 /* Couldn't or didn't -- back up. */
23213 static int regmatchrepeat(regex_t
*preg
, int scan
, int matchmin
)
23215 int *scanpt
= preg
->program
+ scan
;
23217 int max
= scanpt
[2];
23218 int min
= scanpt
[3];
23220 /* Have we reached min? */
23221 if (scanpt
[4] < min
) {
23222 /* No, so get another one */
23224 if (regmatch(preg
, scan
+ 5)) {
23230 if (scanpt
[4] > max
) {
23235 /* minimal, so try other branch first */
23236 if (regmatch(preg
, regnext(preg
, scan
))) {
23239 /* No, so try one more */
23241 if (regmatch(preg
, scan
+ 5)) {
23247 /* maximal, so try this branch again */
23248 if (scanpt
[4] < max
) {
23250 if (regmatch(preg
, scan
+ 5)) {
23255 /* At this point we are at max with no match. Try the other branch */
23256 return regmatch(preg
, regnext(preg
, scan
));
23260 - regmatch - main matching routine
23262 * Conceptually the strategy is simple: check to see whether the current
23263 * node matches, call self recursively to see whether the rest matches,
23264 * and then act accordingly. In practice we make some effort to avoid
23265 * recursion, in particular by going through "ordinary" nodes (that don't
23266 * need to know whether the rest of the match failed) by a loop instead of
23269 /* 0 failure, 1 success */
23270 static int regmatch(regex_t
*preg
, int prog
)
23272 int scan
; /* Current node. */
23273 int next
; /* Next node. */
23278 if (scan
!= 0 && regnarrate
)
23279 fprintf(stderr
, "%s(\n", regprop(scan
));
23281 while (scan
!= 0) {
23286 //fprintf(stderr, "%s...\n", regprop(scan));
23287 fprintf(stderr
, "%3d: %s...\n", scan
, regprop(OP(preg
, scan
))); /* Where, what. */
23290 next
= regnext(preg
, scan
);
23291 n
= reg_utf8_tounicode_case(preg
->reginput
, &c
, (preg
->cflags
& REG_ICASE
));
23293 switch (OP(preg
, scan
)) {
23295 if (preg
->reginput
!= preg
->regbol
)
23299 if (!reg_iseol(preg
, c
)) {
23304 /* Must be looking at a letter, digit, or _ */
23305 if ((!isalnum(UCHAR(c
))) && c
!= '_')
23307 /* Prev must be BOL or nonword */
23308 if (preg
->reginput
> preg
->regbol
&&
23309 (isalnum(UCHAR(preg
->reginput
[-1])) || preg
->reginput
[-1] == '_'))
23313 /* Can't match at BOL */
23314 if (preg
->reginput
> preg
->regbol
) {
23315 /* Current must be EOL or nonword */
23316 if (reg_iseol(preg
, c
) || !isalnum(UCHAR(c
)) || c
!= '_') {
23317 c
= preg
->reginput
[-1];
23318 /* Previous must be word */
23319 if (isalnum(UCHAR(c
)) || c
== '_') {
23328 if (reg_iseol(preg
, c
))
23330 preg
->reginput
+= n
;
23337 opnd
= OPERAND(scan
);
23338 len
= str_int_len(preg
->program
+ opnd
);
23340 slen
= prefix_cmp(preg
->program
+ opnd
, len
, preg
->reginput
, preg
->cflags
& REG_ICASE
);
23344 preg
->reginput
+= slen
;
23348 if (reg_iseol(preg
, c
) || reg_range_find(preg
->program
+ OPERAND(scan
), c
) == 0) {
23351 preg
->reginput
+= n
;
23354 if (reg_iseol(preg
, c
) || reg_range_find(preg
->program
+ OPERAND(scan
), c
) != 0) {
23357 preg
->reginput
+= n
;
23366 if (OP(preg
, next
) != BRANCH
) /* No choice. */
23367 next
= OPERAND(scan
); /* Avoid recursion. */
23370 save
= preg
->reginput
;
23371 if (regmatch(preg
, OPERAND(scan
))) {
23374 preg
->reginput
= save
;
23375 scan
= regnext(preg
, scan
);
23376 } while (scan
!= 0 && OP(preg
, scan
) == BRANCH
);
23384 return regmatchsimplerepeat(preg
, scan
, OP(preg
, scan
) == REPMIN
);
23388 return regmatchrepeat(preg
, scan
, OP(preg
, scan
) == REPXMIN
);
23391 return(1); /* Success! */
23394 if (OP(preg
, scan
) >= OPEN
+1 && OP(preg
, scan
) < CLOSE_END
) {
23397 save
= preg
->reginput
;
23399 if (regmatch(preg
, next
)) {
23402 * Don't set startp if some later
23403 * invocation of the same parentheses
23406 if (OP(preg
, scan
) < CLOSE
) {
23407 no
= OP(preg
, scan
) - OPEN
;
23408 if (no
< preg
->nmatch
&& preg
->pmatch
[no
].rm_so
== -1) {
23409 preg
->pmatch
[no
].rm_so
= save
- preg
->start
;
23413 no
= OP(preg
, scan
) - CLOSE
;
23414 if (no
< preg
->nmatch
&& preg
->pmatch
[no
].rm_eo
== -1) {
23415 preg
->pmatch
[no
].rm_eo
= save
- preg
->start
;
23422 return REG_ERR_INTERNAL
;
23429 * We get here only if there's trouble -- normally "case END" is
23430 * the terminating point.
23432 return REG_ERR_INTERNAL
;
23436 - regrepeat - repeatedly match something simple, report how many
23438 static int regrepeat(regex_t
*preg
, int p
, int max
)
23446 scan
= preg
->reginput
;
23448 switch (OP(preg
, p
)) {
23450 /* No need to handle utf8 specially here */
23451 while (!reg_iseol(preg
, *scan
) && count
< max
) {
23457 while (count
< max
) {
23458 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23459 if (preg
->program
[opnd
] != ch
) {
23467 while (count
< max
) {
23468 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23469 if (reg_iseol(preg
, ch
) || reg_range_find(preg
->program
+ opnd
, ch
) == 0) {
23477 while (count
< max
) {
23478 n
= reg_utf8_tounicode_case(scan
, &ch
, preg
->cflags
& REG_ICASE
);
23479 if (reg_iseol(preg
, ch
) || reg_range_find(preg
->program
+ opnd
, ch
) != 0) {
23486 default: /* Oh dear. Called inappropriately. */
23487 preg
->err
= REG_ERR_INTERNAL
;
23488 count
= 0; /* Best compromise. */
23491 preg
->reginput
= scan
;
23497 - regnext - dig the "next" pointer out of a node
23499 static int regnext(regex_t
*preg
, int p
)
23503 offset
= NEXT(preg
, p
);
23508 if (OP(preg
, p
) == BACK
)
23517 - regdump - dump a regexp onto stdout in vaguely comprehensible form
23519 static void regdump(regex_t
*preg
)
23522 int op
= EXACTLY
; /* Arbitrary non-END op. */
23527 for (i
= 1; i
< preg
->p
; i
++) {
23528 printf("%02x ", preg
->program
[i
]);
23529 if (i
% 16 == 15) {
23536 while (op
!= END
&& s
< preg
->p
) { /* While that wasn't END last time... */
23538 printf("%3d: %s", s
, regprop(op
)); /* Where, what. */
23539 next
= regnext(preg
, s
);
23540 if (next
== 0) /* Next ptr. */
23543 printf("(%d)", next
);
23545 if (op
== REP
|| op
== REPMIN
|| op
== REPX
|| op
== REPXMIN
) {
23546 int max
= preg
->program
[s
];
23547 int min
= preg
->program
[s
+ 1];
23548 if (max
== 65535) {
23549 printf("{%d,*}", min
);
23552 printf("{%d,%d}", min
, max
);
23554 printf(" %d", preg
->program
[s
+ 2]);
23557 else if (op
== ANYOF
|| op
== ANYBUT
) {
23558 /* set of ranges */
23560 while (preg
->program
[s
]) {
23561 int len
= preg
->program
[s
++];
23562 int first
= preg
->program
[s
++];
23563 buf
[utf8_fromunicode(buf
, first
)] = 0;
23566 buf
[utf8_fromunicode(buf
, first
+ len
- 1)] = 0;
23567 printf("-%s", buf
);
23572 else if (op
== EXACTLY
) {
23573 /* Literal string, where present. */
23575 while (preg
->program
[s
]) {
23576 buf
[utf8_fromunicode(buf
, preg
->program
[s
])] = 0;
23586 /* Header fields of interest. */
23587 if (preg
->regstart
) {
23588 buf
[utf8_fromunicode(buf
, preg
->regstart
)] = 0;
23589 printf("start '%s' ", buf
);
23592 printf("anchored ");
23593 if (preg
->regmust
!= 0) {
23595 printf("must have:");
23596 for (i
= 0; i
< preg
->regmlen
; i
++) {
23597 putchar(preg
->program
[preg
->regmust
+ i
]);
23606 - regprop - printable representation of opcode
23608 static const char *regprop( int op
)
23610 static char buf
[50];
23646 if (op
>= OPEN
&& op
< CLOSE
) {
23647 snprintf(buf
, sizeof(buf
), "OPEN%d", op
-OPEN
);
23649 else if (op
>= CLOSE
&& op
< CLOSE_END
) {
23650 snprintf(buf
, sizeof(buf
), "CLOSE%d", op
-CLOSE
);
23653 snprintf(buf
, sizeof(buf
), "?%d?\n", op
);
23660 size_t regerror(int errcode
, const regex_t
*preg
, char *errbuf
, size_t errbuf_size
)
23662 static const char *error_strings
[] = {
23671 "parentheses () not balanced",
23672 "braces {} not balanced",
23673 "invalid repetition count(s)",
23674 "extra characters",
23675 "*+ of empty atom",
23678 "count follows nothing",
23679 "trailing backslash",
23680 "corrupted program",
23681 "contains null char",
23685 if (errcode
< 0 || errcode
>= REG_ERR_NUM
) {
23686 err
= "Bad error code";
23689 err
= error_strings
[errcode
];
23692 return snprintf(errbuf
, errbuf_size
, "%s", err
);
23695 void regfree(regex_t
*preg
)
23697 free(preg
->program
);
23702 /* Jimsh - An interactive shell for Jim
23703 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
23704 * Copyright 2009 Steve Bennett <steveb@workware.net.au>
23706 * Licensed under the Apache License, Version 2.0 (the "License");
23707 * you may not use this file except in compliance with the License.
23708 * You may obtain a copy of the License at
23710 * http://www.apache.org/licenses/LICENSE-2.0
23712 * A copy of the license is also included in the source distribution
23713 * of Jim, as a TXT file name called LICENSE.
23715 * Unless required by applicable law or agreed to in writing, software
23716 * distributed under the License is distributed on an "AS IS" BASIS,
23717 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
23718 * See the License for the specific language governing permissions and
23719 * limitations under the License.
23723 #include <stdlib.h>
23724 #include <string.h>
23727 /* From initjimsh.tcl */
23728 extern int Jim_initjimshInit(Jim_Interp
*interp
);
23730 static void JimSetArgv(Jim_Interp
*interp
, int argc
, char *const argv
[])
23733 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
23735 /* Populate argv global var */
23736 for (n
= 0; n
< argc
; n
++) {
23737 Jim_Obj
*obj
= Jim_NewStringObj(interp
, argv
[n
], -1);
23739 Jim_ListAppendElement(interp
, listObj
, obj
);
23742 Jim_SetVariableStr(interp
, "argv", listObj
);
23743 Jim_SetVariableStr(interp
, "argc", Jim_NewIntObj(interp
, argc
));
23746 int main(int argc
, char *const argv
[])
23749 Jim_Interp
*interp
;
23751 if (argc
> 1 && strcmp(argv
[1], "--version") == 0) {
23752 printf("%d.%d\n", JIM_VERSION
/ 100, JIM_VERSION
% 100);
23756 /* Create and initialize the interpreter */
23757 interp
= Jim_CreateInterp();
23758 Jim_RegisterCoreCommands(interp
);
23760 /* Register static extensions */
23761 if (Jim_InitStaticExtensions(interp
) != JIM_OK
) {
23762 Jim_MakeErrorMessage(interp
);
23763 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23766 Jim_SetVariableStrWithStr(interp
, "jim_argv0", argv
[0]);
23767 Jim_SetVariableStrWithStr(interp
, JIM_INTERACTIVE
, argc
== 1 ? "1" : "0");
23768 retcode
= Jim_initjimshInit(interp
);
23771 if (retcode
== JIM_ERR
) {
23772 Jim_MakeErrorMessage(interp
);
23773 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23775 if (retcode
!= JIM_EXIT
) {
23776 JimSetArgv(interp
, 0, NULL
);
23777 retcode
= Jim_InteractivePrompt(interp
);
23781 if (argc
> 2 && strcmp(argv
[1], "-e") == 0) {
23782 JimSetArgv(interp
, argc
- 3, argv
+ 3);
23783 retcode
= Jim_Eval(interp
, argv
[2]);
23784 if (retcode
!= JIM_ERR
) {
23785 printf("%s\n", Jim_String(Jim_GetResult(interp
)));
23789 Jim_SetVariableStr(interp
, "argv0", Jim_NewStringObj(interp
, argv
[1], -1));
23790 JimSetArgv(interp
, argc
- 2, argv
+ 2);
23791 retcode
= Jim_EvalFile(interp
, argv
[1]);
23793 if (retcode
== JIM_ERR
) {
23794 Jim_MakeErrorMessage(interp
);
23795 fprintf(stderr
, "%s\n", Jim_String(Jim_GetResult(interp
)));
23798 if (retcode
== JIM_EXIT
) {
23799 retcode
= Jim_GetExitCode(interp
);
23801 else if (retcode
== JIM_ERR
) {
23807 Jim_FreeInterp(interp
);