diff options
Diffstat (limited to 'generic/tclInt.h')
| -rw-r--r-- | generic/tclInt.h | 3201 |
1 files changed, 2496 insertions, 705 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index 895eafd..7b1f5bf 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -6,23 +6,23 @@ * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1994-1998 Sun Microsystems, Inc. - * Copyright (c) 1998-19/99 by Scriptics Corporation. + * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. + * Copyright (c) 2008 by Miguel Sofer. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclInt.h,v 1.264 2005/12/27 20:14:09 kennykb Exp $ */ #ifndef _TCLINT #define _TCLINT /* - * Some numerics configuration options + * Some numerics configuration options. */ -#undef NO_WIDE_TYPE #undef ACCEPT_NAN /* @@ -30,25 +30,14 @@ * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but * greater modularity. The order of the three groups of #includes is - * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_ - * declaration in tcl.h is needed by stdlib.h in some configurations. + * important. For example, stdio.h is needed by tcl.h. */ -#ifdef HAVE_TCL_CONFIG_H -#include "tclConfig.h" -#endif -#ifndef _TCL -#include "tcl.h" -#endif +#include "tclPort.h" #include <stdio.h> #include <ctype.h> -#ifdef NO_LIMITS_H -# include "../compat/limits.h" -#else -# include <limits.h> -#endif #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else @@ -66,7 +55,7 @@ typedef int ptrdiff_t; #endif /* - * Ensure WORDS_BIGENDIAN is defined correcly: + * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). */ @@ -81,7 +70,7 @@ typedef int ptrdiff_t; # ifdef BIG_ENDIAN # if BYTE_ORDER == BIG_ENDIAN # undef WORDS_BIGENDIAN -# define WORDS_BIGENDIAN +# define WORDS_BIGENDIAN 1 # endif # endif # ifdef LITTLE_ENDIAN @@ -105,11 +94,32 @@ typedef int ptrdiff_t; #endif /* - * When Tcl_WideInt and long are the same type, there's no value in - * having a tclWideIntType separate from the tclIntType. + * Macros used to cast between pointers and integers (e.g. when storing an int + * in ClientData), on 64-bit architectures they avoid gcc warning about "cast + * to/from pointer from/to integer of different size". */ -#ifdef TCL_WIDE_INT_IS_LONG -#define NO_WIDE_TYPE + +#if !defined(INT2PTR) && !defined(PTR2INT) +# if defined(HAVE_INTPTR_T) || defined(intptr_t) +# define INT2PTR(p) ((void *)(intptr_t)(p)) +# define PTR2INT(p) ((int)(intptr_t)(p)) +# else +# define INT2PTR(p) ((void *)(p)) +# define PTR2INT(p) ((int)(p)) +# endif +#endif +#if !defined(UINT2PTR) && !defined(PTR2UINT) +# if defined(HAVE_UINTPTR_T) || defined(uintptr_t) +# define UINT2PTR(p) ((void *)(uintptr_t)(p)) +# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p)) +# else +# define UINT2PTR(p) ((void *)(p)) +# define PTR2UINT(p) ((unsigned int)(p)) +# endif +#endif + +#if defined(_WIN32) && defined(_MSC_VER) +# define vsnprintf _vsnprintf #endif /* @@ -119,7 +129,7 @@ typedef int ptrdiff_t; struct Tcl_ResolvedVarInfo; -typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) (Tcl_Interp* interp, +typedef Tcl_Var (Tcl_ResolveRuntimeVarProc)(Tcl_Interp *interp, struct Tcl_ResolvedVarInfo *vinfoPtr); typedef void (Tcl_ResolveVarDeleteProc)(struct Tcl_ResolvedVarInfo *vinfoPtr); @@ -135,25 +145,27 @@ typedef struct Tcl_ResolvedVarInfo { Tcl_ResolveVarDeleteProc *deleteProc; } Tcl_ResolvedVarInfo; -typedef int (Tcl_ResolveCompiledVarProc) (Tcl_Interp* interp, - CONST84 char* name, int length, Tcl_Namespace *context, +typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, + CONST84 char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr); -typedef int (Tcl_ResolveVarProc) (Tcl_Interp* interp, CONST84 char* name, +typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr); -typedef int (Tcl_ResolveCmdProc) (Tcl_Interp* interp, CONST84 char* name, +typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { - Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name - * resolution. */ - Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name - * resolution for variables that - * can only be handled at runtime. */ + Tcl_ResolveCmdProc *cmdResProc; + /* Procedure handling command name + * resolution. */ + Tcl_ResolveVarProc *varResProc; + /* Procedure handling variable name resolution + * for variables that can only be handled at + * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarResProc; - /* Procedure handling variable name - * resolution at compile time. */ + /* Procedure handling variable name resolution + * at compile time. */ } Tcl_ResolverInfo; /* @@ -166,6 +178,34 @@ typedef struct Tcl_Ensemble Tcl_Ensemble; typedef struct NamespacePathEntry NamespacePathEntry; /* + * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr + * field added at the end: in this way variables can find their namespace + * without having to copy a pointer in their struct: they can access it via + * their hPtr->tablePtr. + */ + +typedef struct TclVarHashTable { + Tcl_HashTable table; + struct Namespace *nsPtr; +} TclVarHashTable; + +/* + * This is for itcl - it likes to search our varTables directly :( + */ + +#define TclVarHashFindVar(tablePtr, key) \ + TclVarHashCreateVar((tablePtr), (key), NULL) + +/* + * Define this to reduce the amount of space that the average namespace + * consumes by only allocating the table of child namespaces when necessary. + * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which + * reach directly into the Namespace structure. + */ + +#undef BREAK_NAMESPACE_COMPAT + +/* * The structure below defines a namespace. * Note: the first five fields must match exactly the fields in a * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change @@ -187,8 +227,15 @@ typedef struct Namespace { struct Namespace *parentPtr;/* Points to the namespace that contains this * one. NULL if this is the global * namespace. */ +#ifndef BREAK_NAMESPACE_COMPAT Tcl_HashTable childTable; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). */ +#else + Tcl_HashTable *childTablePtr; + /* Contains any child namespaces. Indexed by + * strings; values have type (Namespace *). If + * NULL, there are no children. */ +#endif long nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ @@ -209,7 +256,7 @@ typedef struct Namespace { * ImportedCmdRef structure) to the Command * structure in the source namespace's command * table. */ - Tcl_HashTable varTable; /* Contains all the (global) variables + TclVarHashTable varTable; /* Contains all the (global) variables * currently in this namespace. Indexed by * strings; values have type (Var *). */ char **exportArrayPtr; /* Points to an array of string patterns @@ -225,9 +272,9 @@ typedef struct Namespace { * is currently allocated. */ int cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace - * has already cached a Command * pointer; - * this causes all its cached Command* - * pointers to be invalidated. */ + * has already cached a Command* pointer; this + * causes all its cached Command* pointers to + * be invalidated. */ int resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a @@ -263,6 +310,9 @@ typedef struct Namespace { Tcl_Ensemble *ensembles; /* List of structures that contain the details * of the ensembles that are implemented on * top of this namespace. */ + Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command + * resolution in this namespace fails. TIP + * 181. */ int commandPathLength; /* The length of the explicit path. */ NamespacePathEntry *commandPathArray; /* The explicit path of the namespace as an @@ -270,6 +320,12 @@ typedef struct Namespace { NamespacePathEntry *commandPathSourceList; /* Linked list of path entries that point to * this namespace. */ + Tcl_NamespaceDeleteProc *earlyDeleteProc; + /* Just like the deleteProc field (and called + * with the same clientData) but called at the + * start of the deletion process, so there is + * a chance for code to do stuff inside the + * namespace before deletion completes. */ } Namespace; /* @@ -308,18 +364,22 @@ struct NamespacePathEntry { * unit that refers to the namespace has been freed (i.e., when * the namespace's refCount is 0), the namespace's storage will * be freed. - * NS_KILLED 1 means that TclTeardownNamespace has already been called on - * this namespace and it should not be called again [Bug 1355942] + * NS_KILLED - 1 means that TclTeardownNamespace has already been called on + * this namespace and it should not be called again [Bug 1355942] + * NS_SUPPRESS_COMPILATION - + * Marks the commands in this namespace for not being compiled, + * forcing them to be looked up every time. */ #define NS_DYING 0x01 #define NS_DEAD 0x02 -#define NS_KILLED 0x04 +#define NS_KILLED 0x04 +#define NS_SUPPRESS_COMPILATION 0x08 /* * Flags passed to TclGetNamespaceForQualName: * - * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. + * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. @@ -329,6 +389,114 @@ struct NamespacePathEntry { #define TCL_FIND_ONLY_NS 0x1000 /* + * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in + * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs + * referring to the same subcommand, even where one is a duplicate of another. + */ + +typedef struct { + Namespace *nsPtr; /* The namespace backing the ensemble which + * this is a subcommand of. */ + int epoch; /* Used to confirm when the data in this + * really structure matches up with the + * ensemble. */ + Tcl_Command token; /* Reference to the comamnd for which this + * structure is a cache of the resolution. */ + char *fullSubcmdName; /* The full (local) name of the subcommand, + * allocated with ckalloc(). */ + Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the + * command that implements this ensemble + * subcommand. */ +} EnsembleCmdRep; + +/* + * The client data for an ensemble command. This consists of the table of + * commands that are actually exported by the namespace, and an epoch counter + * that, combined with the exportLookupEpoch field of the namespace structure, + * defines whether the table contains valid data or will need to be recomputed + * next time the ensemble command is called. + */ + +typedef struct EnsembleConfig { + Namespace *nsPtr; /* The namspace backing this ensemble up. */ + Tcl_Command token; /* The token for the command that provides + * ensemble support for the namespace, or NULL + * if the command has been deleted (or never + * existed; the global namespace never has an + * ensemble command.) */ + int epoch; /* The epoch at which this ensemble's table of + * exported commands is valid. */ + char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all + * consistent points, this will have the same + * number of entries as there are entries in + * the subcommandTable hash. */ + Tcl_HashTable subcommandTable; + /* Hash table of ensemble subcommand names, + * which are its keys so this also provides + * the storage management for those subcommand + * names. The contents of the entry values are + * object version the prefix lists to use when + * substituting for the command/subcommand to + * build the ensemble implementation command. + * Has to be stored here as well as in + * subcommandDict because that field is NULL + * when we are deriving the ensemble from the + * namespace exports list. FUTURE WORK: use + * object hash table here. */ + struct EnsembleConfig *next;/* The next ensemble in the linked list of + * ensembles associated with a namespace. If + * this field points to this ensemble, the + * structure has already been unlinked from + * all lists, and cannot be found by scanning + * the list from the namespace's ensemble + * field. */ + int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX, + * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */ + + /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */ + + Tcl_Obj *subcommandDict; /* Dictionary providing mapping from + * subcommands to their implementing command + * prefixes, or NULL if we are to build the + * map automatically from the namespace + * exports. */ + Tcl_Obj *subcmdList; /* List of commands that this ensemble + * actually provides, and whose implementation + * will be built using the subcommandDict (if + * present and defined) and by simple mapping + * to the namespace otherwise. If NULL, + * indicates that we are using the (dynamic) + * list of currently exported commands. */ + Tcl_Obj *unknownHandler; /* Script prefix used to handle the case when + * no match is found (according to the rule + * defined by flag bit TCL_ENSEMBLE_PREFIX) or + * NULL to use the default error-generating + * behaviour. The script execution gets all + * the arguments to the ensemble command + * (including objv[0]) and will have the + * results passed directly back to the caller + * (including the error code) unless the code + * is TCL_CONTINUE in which case the + * subcommand will be reparsed by the ensemble + * core, presumably because the ensemble + * itself has been updated. */ + Tcl_Obj *parameterList; /* List of ensemble parameter names. */ + int numParameters; /* Cached number of parameters. This is either + * 0 (if the parameterList field is NULL) or + * the length of the list in the parameterList + * field. */ +} EnsembleConfig; + +/* + * Various bits for the EnsembleConfig.flags field. + */ + +#define ENSEMBLE_DEAD 0x1 /* Flag value to say that the ensemble is dead + * and on its way out. */ +#define ENSEMBLE_COMPILE 0x4 /* Flag to enable bytecode compilation of an + * ensemble. */ + +/* *---------------------------------------------------------------- * Data structures related to variables. These are used primarily in tclVar.c *---------------------------------------------------------------- @@ -415,30 +583,6 @@ typedef struct ActiveVarTrace { } ActiveVarTrace; /* - * The following structure describes an enumerative search in progress on an - * array variable; this are invoked with options to the "array" command. - */ - -typedef struct ArraySearch { - int id; /* Integer id used to distinguish among - * multiple concurrent searches for the same - * array. */ - struct Var *varPtr; /* Pointer to array variable that's being - * searched. */ - Tcl_HashSearch search; /* Info kept by the hash module about progress - * through the array. */ - Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to - * be enumerated (it's leftover from the - * Tcl_FirstHashEntry call or from an "array - * anymore" command). NULL means must call - * Tcl_NextHashEntry to get value to - * return. */ - struct ArraySearch *nextPtr;/* Next in list of all active searches for - * this variable, or NULL if this is the last - * one. */ -} ArraySearch; - -/* * The structure below defines a variable, which associates a string name with * a Tcl_Obj value. These structures are kept in procedure call frames (for * local variables recognized by the compiler) or in the heap (for global @@ -448,10 +592,12 @@ typedef struct ArraySearch { */ typedef struct Var { + int flags; /* Miscellaneous bits of information about + * variable. See below for definitions. */ union { Tcl_Obj *objPtr; /* The variable's object value. Used for * scalar variables and array elements. */ - Tcl_HashTable *tablePtr;/* For array variables, this points to + TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to * ckalloc-ed data. */ @@ -460,48 +606,30 @@ typedef struct Var { * "upvar", this field points to the * referenced variable's Var struct. */ } value; - char *name; /* NULL if the variable is in a hashtable, - * otherwise points to the variable's name. It - * is used, e.g., by TclLookupVar and "info - * locals". The storage for the characters of - * the name is not owned by the Var and must - * not be freed when freeing the Var. */ - Namespace *nsPtr; /* Points to the namespace that contains this - * variable or NULL if the variable is a local - * variable in a Tcl procedure. */ - Tcl_HashEntry *hPtr; /* If variable is in a hashtable, either the - * hash table entry that refers to this - * variable or NULL if the variable has been - * detached from its hash table (e.g. an array - * is deleted, but some of its elements are - * still referred to in upvars). NULL if the - * variable is not in a hashtable. This is - * used to delete an variable from its - * hashtable if it is no longer needed. */ - int refCount; /* Counts number of active uses of this - * variable, not including its entry in the - * call frame or the hash table: 1 for each - * additional variable whose linkPtr points - * here, 1 for each nested trace active on - * variable, and 1 if the variable is a - * namespace variable. This record can't be - * deleted until refCount becomes 0. */ - VarTrace *tracePtr; /* First in list of all traces set for this - * variable. */ - ArraySearch *searchPtr; /* First in list of all searches active for - * this variable, or NULL if none. */ - int flags; /* Miscellaneous bits of information about - * variable. See below for definitions. */ } Var; +typedef struct VarInHash { + Var var; + int refCount; /* Counts number of active uses of this + * variable: 1 for the entry in the hash + * table, 1 for each additional variable whose + * linkPtr points here, 1 for each nested + * trace active on variable, and 1 if the + * variable is a namespace variable. This + * record can't be deleted until refCount + * becomes 0. */ + Tcl_HashEntry entry; /* The hash table entry that refers to this + * variable. This is used to find the name of + * the variable and to delete it from its + * hashtable if it is no longer needed. It + * also holds the variable's name. */ +} VarInHash; + /* - * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and - * VAR_LINK) are mutually exclusive and give the "type" of the variable. - * VAR_UNDEFINED is independent of the variable's type. + * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are + * mutually exclusive and give the "type" of the variable. If none is set, + * this is a scalar variable. * - * VAR_SCALAR - 1 means this is a scalar variable and not an - * array or link. The "objPtr" field points to - * the variable's value, a Tcl object. * VAR_ARRAY - 1 means this is an array variable rather than * a scalar variable or link. The "tablePtr" * field points to the array's hashtable for its @@ -513,21 +641,17 @@ typedef struct Var { * through "upvar" and "global" commands, or * through references to variables in enclosing * namespaces. - * VAR_UNDEFINED - 1 means that the variable is in the process of - * being deleted. An undefined variable logically - * does not exist and survives only while it has - * a trace, or if it is a global variable - * currently being used by some procedure. + * + * Flags that indicate the type and status of storage; none is set for + * compiled local variables (Var structs). + * * VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and * the Var structure is malloced. 0 if it is a * local variable that was assigned a slot in a * procedure frame by the compiler so the Var * storage is part of the call frame. - * VAR_TRACE_ACTIVE - 1 means that trace processing is currently - * underway for a read or write access, so new - * read or write accesses should not cause trace - * procedures to be called and the variable can't - * be deleted. + * VAR_DEAD_HASH 1 means that this var's entry in the hashtable + * has already been deleted. * VAR_ARRAY_ELEMENT - 1 means that this variable is an array * element, so it is not legal for it to be an * array itself (the VAR_ARRAY flag had better @@ -541,6 +665,19 @@ typedef struct Var { * incremented to reflect the "reference" from * its namespace. * + * Flag values relating to the variable's trace and search status. + * + * VAR_TRACED_READ + * VAR_TRACED_WRITE + * VAR_TRACED_UNSET + * VAR_TRACED_ARRAY + * VAR_TRACE_ACTIVE - 1 means that trace processing is currently + * underway for a read or write access, so new + * read or write accesses should not cause trace + * procedures to be called and the variable can't + * be deleted. + * VAR_SEARCH_ACTIVE + * * The following additional flags are used with the CompiledLocal type defined * below: * @@ -551,21 +688,49 @@ typedef struct Var { * name. * VAR_RESOLVED - 1 if name resolution has been done for this * variable. + * VAR_IS_ARGS 1 if this variable is the last argument and is + * named "args". + */ + +/* + * FLAGS RENUMBERED: everything breaks already, make things simpler. + * + * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to + * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c + * + * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values + * in precompiled scripts keep working. */ -#define VAR_SCALAR 0x1 -#define VAR_ARRAY 0x2 -#define VAR_LINK 0x4 -#define VAR_UNDEFINED 0x8 -#define VAR_IN_HASHTABLE 0x10 -#define VAR_TRACE_ACTIVE 0x20 -#define VAR_ARRAY_ELEMENT 0x40 -#define VAR_NAMESPACE_VAR 0x80 +/* Type of value (0 is scalar) */ +#define VAR_ARRAY 0x1 +#define VAR_LINK 0x2 -#define VAR_ARGUMENT 0x100 -#define VAR_TEMPORARY 0x200 -#define VAR_RESOLVED 0x400 -#define VAR_IS_ARGS 0x800 +/* Type of storage (0 is compiled local) */ +#define VAR_IN_HASHTABLE 0x4 +#define VAR_DEAD_HASH 0x8 +#define VAR_ARRAY_ELEMENT 0x1000 +#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */ + +#define VAR_ALL_HASH \ + (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT) + +/* Trace and search state. */ + +#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */ +#define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */ +#define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */ +#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */ +#define VAR_TRACE_ACTIVE 0x2000 +#define VAR_SEARCH_ACTIVE 0x4000 +#define VAR_ALL_TRACES \ + (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET) + +/* Special handling on initialisation (only CompiledLocal). */ +#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ +#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ +#define VAR_IS_ARGS 0x400 +#define VAR_RESOLVED 0x8000 /* * Macros to ensure that various flag bits are set properly for variables. @@ -580,22 +745,22 @@ typedef struct Var { */ #define TclSetVarScalar(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK) #define TclSetVarArray(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY + (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY #define TclSetVarLink(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK + (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK #define TclSetVarArrayElement(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ - (varPtr)->flags |= VAR_UNDEFINED + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\ + (varPtr)->value.objPtr = NULL -#define TclClearVarUndefined(varPtr) \ - (varPtr)->flags &= ~VAR_UNDEFINED +#define TclClearVarUndefined(varPtr) #define TclSetVarTraceActive(varPtr) \ (varPtr)->flags |= VAR_TRACE_ACTIVE @@ -604,10 +769,20 @@ typedef struct Var { (varPtr)->flags &= ~VAR_TRACE_ACTIVE #define TclSetVarNamespaceVar(varPtr) \ - (varPtr)->flags |= VAR_NAMESPACE_VAR + if (!TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags |= VAR_NAMESPACE_VAR;\ + if (TclIsVarInHash(varPtr)) {\ + ((VarInHash *)(varPtr))->refCount++;\ + }\ + } #define TclClearVarNamespaceVar(varPtr) \ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR + if (TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ + if (TclIsVarInHash(varPtr)) {\ + ((VarInHash *)(varPtr))->refCount--;\ + }\ + } /* * Macros to read various flag bits of variables. @@ -624,7 +799,7 @@ typedef struct Var { */ #define TclIsVarScalar(varPtr) \ - ((varPtr)->flags & VAR_SCALAR) + !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) #define TclIsVarLink(varPtr) \ ((varPtr)->flags & VAR_LINK) @@ -633,7 +808,7 @@ typedef struct Var { ((varPtr)->flags & VAR_ARRAY) #define TclIsVarUndefined(varPtr) \ - ((varPtr)->flags & VAR_UNDEFINED) + ((varPtr)->value.objPtr == NULL) #define TclIsVarArrayElement(varPtr) \ ((varPtr)->flags & VAR_ARRAY_ELEMENT) @@ -653,24 +828,52 @@ typedef struct Var { #define TclIsVarTraceActive(varPtr) \ ((varPtr)->flags & VAR_TRACE_ACTIVE) -#define TclIsVarUntraced(varPtr) \ - ((varPtr)->tracePtr == NULL) +#define TclIsVarTraced(varPtr) \ + ((varPtr)->flags & VAR_ALL_TRACES) + +#define TclIsVarInHash(varPtr) \ + ((varPtr)->flags & VAR_IN_HASHTABLE) + +#define TclIsVarDeadHash(varPtr) \ + ((varPtr)->flags & VAR_DEAD_HASH) + +#define TclGetVarNsPtr(varPtr) \ + (TclIsVarInHash(varPtr) \ + ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ + : NULL) + +#define VarHashRefCount(varPtr) \ + ((VarInHash *) (varPtr))->refCount /* - * Macros for direct variable access by TEBC + * Macros for direct variable access by TEBC. */ #define TclIsVarDirectReadable(varPtr) \ - (TclIsVarScalar(varPtr) \ - && !TclIsVarUndefined(varPtr) \ - && TclIsVarUntraced(varPtr)) + ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \ + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - ( !(((varPtr)->flags & VAR_IN_HASHTABLE) \ - && ((varPtr)->hPtr == NULL)) \ - && TclIsVarUntraced(varPtr) \ - && (TclIsVarScalar(varPtr) \ - || TclIsVarUndefined(varPtr))) + !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH)) + +#define TclIsVarDirectUnsettable(varPtr) \ + !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) + +#define TclIsVarDirectModifyable(varPtr) \ + ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \ + && (varPtr)->value.objPtr) + +#define TclIsVarDirectReadable2(varPtr, arrayPtr) \ + (TclIsVarDirectReadable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) + +#define TclIsVarDirectWritable2(varPtr, arrayPtr) \ + (TclIsVarDirectWritable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE))) + +#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \ + (TclIsVarDirectModifyable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) /* *---------------------------------------------------------------- @@ -711,9 +914,8 @@ typedef struct CompiledLocal { * variables in the procedure call frame. */ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, - * although only VAR_SCALAR, VAR_ARRAY, - * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and - * VAR_RESOLVED make sense. */ + * although only VAR_ARGUMENT, VAR_TEMPORARY, + * and VAR_RESOLVED make sense. */ Tcl_Obj *defValuePtr; /* Pointer to the default value of an * argument, if any. NULL if not an argument * or, if an argument, no default value. */ @@ -724,7 +926,7 @@ typedef struct CompiledLocal { * is marked by a unique ClientData tag during * compilation, and that same tag is used to * find the variable at runtime. */ - char name[4]; /* Name of the local variable starts here. If + char name[1]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST @@ -767,6 +969,13 @@ typedef struct Proc { } Proc; /* + * The type of functions called to process errors found during the execution + * of a procedure (or lambda term or ...). + */ + +typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj); + +/* * The structure below defines a command trace. This is used to allow Tcl * clients to find out whenever a command is about to be executed. */ @@ -778,9 +987,9 @@ typedef struct Trace { ClientData clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see - * Tcl_CreateObjTrace for details */ - Tcl_CmdObjTraceDeleteProc* delProc; - /* Procedure to call when trace is deleted */ + * Tcl_CreateObjTrace for details. */ + Tcl_CmdObjTraceDeleteProc *delProc; + /* Procedure to call when trace is deleted. */ } Trace; /* @@ -813,8 +1022,8 @@ typedef struct ActiveInterpTrace { * TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces. * - passed to Tcl_CreateObjTrace to set up * "leavestep" traces. - * */ + #define TCL_TRACE_ENTER_EXEC 1 #define TCL_TRACE_LEAVE_EXEC 2 @@ -844,6 +1053,23 @@ typedef struct AssocData { * Tcl_CallFrame structure in tcl.h. If you change one, change the other. */ +/* + * Will be grown to contain: pointers to the varnames (allocated at the end), + * plus the init values for each variable (suitable to be memcopied on init) + */ + +typedef struct LocalCache { + int refCount; + int numVars; + Tcl_Obj *varName0; +} LocalCache; + +#define localName(framePtr, i) \ + ((&((framePtr)->localCachePtr->varName0))[(i)]) + +MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, + LocalCache *localCachePtr); + typedef struct CallFrame { Namespace *nsPtr; /* Points to the namespace used to resolve * commands and global variables. */ @@ -856,7 +1082,7 @@ typedef struct CallFrame { * have local vars. */ int objc; /* This and objv below describe the arguments * for this procedure call. */ - Tcl_Obj *CONST *objv; /* Array of argument objects. */ + Tcl_Obj *const *objv; /* Array of argument objects. */ struct CallFrame *callerPtr; /* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in @@ -877,19 +1103,216 @@ typedef struct CallFrame { * the number of compiled local variables * (local variables assigned entries ["slots"] * in the compiledLocals array below). */ - Tcl_HashTable *varTablePtr; /* Hash table containing local variables not + TclVarHashTable *varTablePtr; + /* Hash table containing local variables not * recognized by the compiler, or created at * execution time through, e.g., upvar. * Initially NULL and created if needed. */ int numCompiledLocals; /* Count of local variables recognized by the * compiler including arguments. */ - Var* compiledLocals; /* Points to the array of local variables + Var *compiledLocals; /* Points to the array of local variables * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ + ClientData clientData; /* Pointer to some context that is used by + * object systems. The meaning of the contents + * of this field is defined by the code that + * sets it, and it should only ever be set by + * the code that is pushing the frame. In that + * case, the code that sets it should also + * have some means of discovering what the + * meaning of the value is, which we do not + * specify. */ + LocalCache *localCachePtr; + Tcl_Obj *tailcallPtr; + /* NULL if no tailcall is scheduled */ } CallFrame; -#define FRAME_IS_PROC 0x1 +#define FRAME_IS_PROC 0x1 +#define FRAME_IS_LAMBDA 0x2 +#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's + * clientData field contains a CallContext + * reference. Part of TIP#257. */ +#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of + * the [oo::define] command; the clientData + * field contains an Object reference that has + * been confirmed to refer to a class. Part of + * TIP#257. */ + +/* + * TIP #280 + * The structure below defines a command frame. A command frame provides + * location information for all commands executing a tcl script (source, eval, + * uplevel, procedure bodies, ...). The runtime structure essentially contains + * the stack trace as it would be if the currently executing command were to + * throw an error. + * + * For commands where it makes sense it refers to the associated CallFrame as + * well. + * + * The structures are chained in a single list, with the top of the stack + * anchored in the Interp structure. + * + * Instances can be allocated on the C stack, or the heap, the former making + * cleanup a bit simpler. + */ + +typedef struct CmdFrame { + /* + * General data. Always available. + */ + + int type; /* Values see below. */ + int level; /* Number of frames in stack, prevent O(n) + * scan of list. */ + int *line; /* Lines the words of the command start on. */ + int nline; + CallFrame *framePtr; /* Procedure activation record, may be + * NULL. */ + struct CmdFrame *nextPtr; /* Link to calling frame. */ + /* + * Data needed for Eval vs TEBC + * + * EXECUTION CONTEXTS and usage of CmdFrame + * + * Field TEBC EvalEx + * ======= ==== ====== + * level yes yes + * type BC/PREBC SRC/EVAL + * line0 yes yes + * framePtr yes yes + * ======= ==== ====== + * + * ======= ==== ========= union data + * line1 - yes + * line3 - yes + * path - yes + * ------- ---- ------ + * codePtr yes - + * pc yes - + * ======= ==== ====== + * + * ======= ==== ========= union cmd + * str.cmd yes yes + * str.len yes yes + * ------- ---- ------ + */ + + union { + struct { + Tcl_Obj *path; /* Path of the sourced file the command is + * in. */ + } eval; + struct { + const void *codePtr;/* Byte code currently executed... */ + const char *pc; /* ... and instruction pointer. */ + } tebc; + } data; + Tcl_Obj *cmdObj; + const char *cmd; /* The executed command, if possible... */ + int len; /* ... and its length. */ + const struct CFWordBC *litarg; + /* Link to set of literal arguments which have + * ben pushed on the lineLABCPtr stack by + * TclArgumentBCEnter(). These will be removed + * by TclArgumentBCRelease. */ +} CmdFrame; + +typedef struct CFWord { + CmdFrame *framePtr; /* CmdFrame to access. */ + int word; /* Index of the word in the command. */ + int refCount; /* Number of times the word is on the + * stack. */ +} CFWord; + +typedef struct CFWordBC { + CmdFrame *framePtr; /* CmdFrame to access. */ + int pc; /* Instruction pointer of a command in + * ExtCmdLoc.loc[.] */ + int word; /* Index of word in + * ExtCmdLoc.loc[cmd]->line[.] */ + struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ + struct CFWordBC *nextPtr; /* Next entry for same command call. See + * CmdFrame litarg field for the list start. */ + Tcl_Obj *obj; /* Back reference to hashtable key */ +} CFWordBC; + +/* + * Structure to record the locations of invisible continuation lines in + * literal scripts, as character offset from the beginning of the script. Both + * compiler and direct evaluator use this information to adjust their line + * counters when tracking through the script, because when it is invoked the + * continuation line marker as a whole has been removed already, meaning that + * the \n which was part of it is gone as well, breaking regular line + * tracking. + * + * These structures are allocated and filled by both the function + * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the + * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in + * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and + * TclCompileScript(), both found in the file "tclCompile.c". Their memory is + * released by the function TclFreeObj(), in the file "tclObj.c", and also by + * the function TclThreadFinalizeObjects(), in the same file. + */ + +#define CLL_END (-1) + +typedef struct ContLineLoc { + int num; /* Number of entries in loc, not counting the + * final -1 marker entry. */ + int loc[1]; /* Table of locations, as character offsets. + * The table is allocated as part of the + * structure, extending behind the nominal end + * of the structure. An entry containing the + * value -1 is put after the last location, as + * end-marker/sentinel. */ +} ContLineLoc; + +/* + * The following macros define the allowed values for the type field of the + * CmdFrame structure above. Some of the values occur only in the extended + * location data referenced via the 'baseLocPtr'. + * + * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. + * TCL_LOCATION_BC : Frame is for bytecode. + * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. + * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a + * sourced file. + * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. + * + * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC + * types, per the context of the byte code in execution. + */ + +#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ +#define TCL_LOCATION_BC (2) /* Location in byte code. */ +#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no + * location. */ +#define TCL_LOCATION_SOURCE (4) /* Location in a file. */ +#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */ +#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */ + +/* + * Structure passed to describe procedure-like "procedures" that are not + * procedures (e.g. a lambda) so that their details can be reported correctly + * by [info frame]. Contains a sub-structure for each extra field. + */ + +typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData); +typedef struct { + const char *name; /* Name of this field. */ + GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the + * clientData, or just use the clientData + * directly (after casting) if NULL. */ + ClientData clientData; /* Context for above function, or Tcl_Obj* if + * proc field is NULL. */ +} ExtraFrameInfoField; +typedef struct { + int length; /* Length of array. */ + ExtraFrameInfoField fields[2]; + /* Really as long as necessary, but this is + * long enough for nearly anything. */ +} ExtraFrameInfo; /* *---------------------------------------------------------------- @@ -903,33 +1326,13 @@ typedef void **TclHandle; /* *---------------------------------------------------------------- - * Data structures related to expressions. These are used only in tclExpr.c. + * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use + * only by Expect. It will probably go away in a later release. *---------------------------------------------------------------- */ -/* - * The data structure below defines a math function (e.g. sin or hypot) for - * use in Tcl expressions. - */ - -#define MAX_MATH_ARGS 5 -typedef struct MathFunc { - int builtinFuncIndex; /* If this is a builtin math function, its - * index in the array of builtin functions. - * (tclCompilation.h lists these indices.) - * The value is -1 if this is a new function - * defined by Tcl_CreateMathFunc. The value is - * also -1 if a builtin function is replaced - * by a Tcl_CreateMathFunc call. */ - int numArgs; /* Number of arguments for function. */ - Tcl_ValueType argTypes[MAX_MATH_ARGS]; - /* Acceptable types for each argument. */ - Tcl_MathProc *proc; /* Procedure that implements this function. - * NULL if isBuiltinFunc is 1. */ - ClientData clientData; /* Additional argument to pass to the function - * when invoking it. NULL if isBuiltinFunc is - * 1. */ -} MathFunc; +#define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at + * the beginning of the string. */ /* * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet @@ -948,7 +1351,6 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr, #define TCL_TSD_INIT(keyPtr) \ (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) - /* *---------------------------------------------------------------- * Data structures related to bytecode compilation and execution. These are @@ -986,35 +1388,80 @@ struct CompileEnv; #define TCL_OUT_LINE_COMPILE TCL_ERROR -typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr, - struct CompileEnv *compEnvPtr); +typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, + struct Command *cmdPtr, struct CompileEnv *compEnvPtr); /* * The type of procedure called from the compilation hook point in * SetByteCodeFromAny. */ -typedef int (CompileHookProc) (Tcl_Interp *interp, +typedef int (CompileHookProc)(Tcl_Interp *interp, struct CompileEnv *compEnvPtr, ClientData clientData); /* + * The data structure for a (linked list of) execution stacks. + */ + +typedef struct ExecStack { + struct ExecStack *prevPtr; + struct ExecStack *nextPtr; + Tcl_Obj **markerPtr; + Tcl_Obj **endPtr; + Tcl_Obj **tosPtr; + Tcl_Obj *stackWords[1]; +} ExecStack; + +/* * The data structure defining the execution environment for ByteCode's. * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation * stack that holds command operands and results. The stack grows towards - * increasing addresses. The "stackTop" member is cached by TclExecuteByteCode - * in a local variable: it must be set before calling TclExecuteByteCode and - * will be restored by TclExecuteByteCode before it returns. + * increasing addresses. The member stackPtr points to the stackItems of the + * currently active execution stack. */ +typedef struct CorContext { + struct CallFrame *framePtr; + struct CallFrame *varFramePtr; + struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ +} CorContext; + +typedef struct CoroutineData { + struct Command *cmdPtr; /* The command handle for the coroutine. */ + struct ExecEnv *eePtr; /* The special execution environment (stacks, + * etc.) for the coroutine. */ + struct ExecEnv *callerEEPtr;/* The execution environment for the caller of + * the coroutine, which might be the + * interpreter global environment or another + * coroutine. */ + CorContext caller; + CorContext running; + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + void *stackLevel; + int auxNumLevels; /* While the coroutine is running the + * numLevels of the create/resume command is + * stored here; for suspended coroutines it + * holds the nesting numLevels at yield. */ + int nargs; /* Number of args required for resuming this + * coroutine; -2 means "0 or 1" (default), -1 + * means "any" */ +} CoroutineData; + typedef struct ExecEnv { - Tcl_Obj **stackPtr; /* Points to the first item in the evaluation + ExecStack *execStackPtr; /* Points to the first item in the evaluation * stack on the heap. */ - Tcl_Obj **tosPtr; /* Points to current top of stack; - * (stackPtr-1) when the stack is empty. */ - Tcl_Obj **endPtr; /* Points to last usable item in stack. */ Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */ + struct Tcl_Interp *interp; + struct NRE_callback *callbackPtr; + /* Top callback in NRE's stack. */ + struct CoroutineData *corPtr; + int rewind; } ExecEnv; +#define COR_IS_SUSPENDED(corPtr) \ + ((corPtr)->stackLevel == NULL) + /* * The definitions for the LiteralTable and LiteralEntry structures. Each * interpreter contains a LiteralTable. It is used to reduce the storage @@ -1103,6 +1550,22 @@ typedef struct ByteCodeStats { #endif /* TCL_COMPILE_STATS */ /* + * Structure used in implementation of those core ensembles which are + * partially compiled. Used as an array of these, with a terminating field + * whose 'name' is NULL. + */ + +typedef struct { + const char *name; /* The name of the subcommand. */ + Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ + CompileProc *compileProc; /* The compiler for the subcommand. */ + Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ + ClientData clientData; /* Any clientData to give the command. */ + int unsafe; /* Whether this command is to be hidden by + * default in a safe interpreter. */ +} EnsembleImplMap; + +/* *---------------------------------------------------------------- * Data structures related to commands. *---------------------------------------------------------------- @@ -1192,6 +1655,7 @@ typedef struct Command { * command. */ CommandTrace *tracePtr; /* First in list of all traces set for this * command. */ + Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ } Command; /* @@ -1208,6 +1672,9 @@ typedef struct Command { * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one * execution trace (as opposed to simple * delete/rename traces) in its tracePtr list. + * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that + * can handle expansion (provided it is not the + * first word). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further @@ -1215,9 +1682,11 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_IS_DELETED 0x1 -#define CMD_TRACE_ACTIVE 0x2 -#define CMD_HAS_EXEC_TRACES 0x4 +#define CMD_IS_DELETED 0x1 +#define CMD_TRACE_ACTIVE 0x2 +#define CMD_HAS_EXEC_TRACES 0x4 +#define CMD_COMPILES_EXPANDED 0x8 +#define CMD_REDEF_IN_PROGRESS 0x10 /* *---------------------------------------------------------------- @@ -1257,6 +1726,33 @@ typedef struct ResolverScheme { typedef struct LimitHandler LimitHandler; /* + * TIP #268. + * Values for the selection mode, i.e the package require preferences. + */ + +enum PkgPreferOptions { + PKG_PREFER_LATEST, PKG_PREFER_STABLE +}; + +/* + *---------------------------------------------------------------- + * This structure shadows the first few fields of the memory cache for the + * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the + * definition there. + * Some macros require knowledge of some fields in the struct in order to + * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer + * to the relevant fields is kept in the objCache field in struct Interp. + *---------------------------------------------------------------- + */ + +typedef struct AllocCache { + struct Cache *nextPtr; /* Linked list of cache entries. */ + Tcl_ThreadId owner; /* Which thread's cache is this? */ + Tcl_Obj *firstObjPtr; /* List of free objects for thread. */ + int numObjects; /* Number of objects for thread. */ +} AllocCache; + +/* *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of commands * plus other state information related to interpreting commands, such as @@ -1295,7 +1791,8 @@ typedef struct Interp { int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ - struct TclStubs *stubTable; /* Pointer to the exported Tcl stub table. On + const struct TclStubs *stubTable; + /* Pointer to the exported Tcl stub table. On * previous versions of Tcl this is a pointer * to the objResultPtr or a pointer to a * buckets array in a hash table. We therefore @@ -1313,10 +1810,14 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - Tcl_HashTable mathFuncTable;/* Contains all the math functions currently - * defined for the interpreter. Indexed by - * strings (function names); values have type - * (MathFunc *). */ + union { + void (*optimizer)(void *envPtr); + Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The + * unused space in interp was repurposed for + * pluggable bytecode optimizers. The core + * contains one optimizer, which can be + * selectively overriden by extensions. */ + } extra; /* * Information related to procedures and variables. See tclProc.c and @@ -1332,19 +1833,19 @@ typedef struct Interp { * assumes that infinite recursion has * occurred and it generates an error. */ CallFrame *framePtr; /* Points to top-most in stack of all nested - * procedure invocations. NULL means there are - * no active procedures. */ + * procedure invocations. */ CallFrame *varFramePtr; /* Points to the call frame whose variables * are currently in use (same as framePtr - * unless an "uplevel" command is executing). - * NULL means no procedure is active or - * "uplevel 0" is executing. */ + * unless an "uplevel" command is + * executing). */ ActiveVarTrace *activeVarTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - int returnCode; /* [return -code] parameter */ - char *unused3; /* No longer used (was errorInfo) */ - char *unused4; /* No longer used (was errorCode) */ + int returnCode; /* [return -code] parameter. */ + CallFrame *rootFramePtr; /* Global frame pointer for this + * interpreter. */ + Namespace *lookupNsPtr; /* Namespace to use ONLY on the next + * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* * Information used by Tcl_AppendResult to keep track of partial results. @@ -1371,7 +1872,6 @@ typedef struct Interp { * commands for packages that aren't described * in packageTable. Ckalloc'ed, may be * NULL. */ - /* * Miscellaneous information: */ @@ -1425,7 +1925,7 @@ typedef struct Interp { Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ - Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */ + Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */ ActiveCommandTrace *activeCmdTracePtr; /* First in list of active command traces for @@ -1434,19 +1934,22 @@ typedef struct Interp { /* First in list of active traces for interp, * or NULL if no active traces. */ - int tracesForbiddingInline; /* Count of traces (in the list headed by + int tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode - * compilation */ + * compilation. */ + + /* + * Fields used to manage extensible return options (TIP 90). + */ - /* Fields used to manage extensible return options (TIP 90) */ Tcl_Obj *returnOpts; /* A dictionary holding the options to the - * last [return] command */ + * last [return] command. */ - Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj) */ - Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable */ - Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj) */ - Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable */ - int returnLevel; /* [return -level] parameter */ + Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj). */ + Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable. */ + Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj). */ + Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable. */ + int returnLevel; /* [return -level] parameter. */ /* * Resource limiting framework support (TIP#143). @@ -1492,7 +1995,7 @@ typedef struct Interp { */ struct { - Tcl_Obj * CONST *sourceObjs; + Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not @@ -1504,36 +2007,169 @@ typedef struct Interp { } ensembleRewrite; /* - * TIP #219 ... Global info for the I/O system ... + * TIP #219: Global info for the I/O system. */ - Tcl_Obj* chanMsg; /* Error message set by channel drivers, for + Tcl_Obj *chanMsg; /* Error message set by channel drivers, for * the propagation of arbitrary Tcl errors. * This information, if present (chanMsg not - * NULL), takes precedence over a posix error + * NULL), takes precedence over a POSIX error * code returned by a channel operation. */ /* - * Statistical information about the bytecode compiler and interpreter's - * operation. + * Source code origin information (TIP #280). + */ + + CmdFrame *cmdFramePtr; /* Points to the command frame containing the + * location information for the current + * command. */ + const CmdFrame *invokeCmdFramePtr; + /* Points to the command frame which is the + * invoking context of the bytecode compiler. + * NULL when the byte code compiler is not + * active. */ + int invokeWord; /* Index of the word in the command which + * is getting compiled. */ + Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically + * defined procedure the location information + * for its body. It is keyed by the address of + * the Proc structure for a procedure. The + * values are "struct CmdFrame*". */ + Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode + * object the location information for its + * body. It is keyed by the address of the + * Proc structure for a procedure. The values + * are "struct ExtCmdLoc*". (See + * tclCompile.h) */ + Tcl_HashTable *lineLABCPtr; + Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a + * command on the execution stack the index of + * the argument in the command, and the + * location data of the command. It is keyed + * by the address of the Tcl_Obj containing + * the argument. The values are "struct + * CFWord*" (See tclBasic.c). This allows + * commands like uplevel, eval, etc. to find + * location information for their arguments, + * if they are a proper literal argument to an + * invoking command. Alt view: An index to the + * CmdFrame stack keyed by command argument + * holders. */ + ContLineLoc *scriptCLLocPtr;/* This table points to the location data for + * invisible continuation lines in the script, + * if any. This pointer is set by the function + * TclEvalObjEx() in file "tclBasic.c", and + * used by function ...() in the same file. + * It does for the eval/direct path of script + * execution what CompileEnv.clLoc does for + * the bytecode compiler. + */ + /* + * TIP #268. The currently active selection mode, i.e. the package require + * preferences. + */ + + int packagePrefer; /* Current package selection mode. */ + + /* + * Hashtables for variable traces and searches. + */ + + Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's + * active trace list; varPtr is the key. */ + Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's + * active searches list; varPtr is the key. */ + /* + * The thread-specific data ekeko: cache pointers or values that + * (a) do not change during the thread's lifetime + * (b) require access to TSD to determine at runtime + * (c) are accessed very often (e.g., at each command call) + * + * Note that these are the same for all interps in the same thread. They + * just have to be initialised for the thread's master interp, slaves + * inherit the value. + * + * They are used by the macros defined below. */ + AllocCache *allocCache; + void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData + * structs for this interp's thread; see + * tclObj.c and tclThreadAlloc.c */ + int *asyncReadyPtr; /* Pointer to the asyncReady indicator for + * this interp's thread; see tclAsync.c */ + /* + * The pointer to the object system root ekeko. c.f. TIP #257. + */ + void *objectFoundation; /* Pointer to the Foundation structure of the + * object system, which contains things like + * references to key namespaces. See + * tclOOInt.h and tclOO.c for real definition + * and setup. */ + + struct NRE_callback *deferredCallbacks; + /* Callbacks that are set previous to a call + * to some Eval function but that actually + * belong to the command that is about to be + * called - i.e., they should be run *before* + * any tailcall is invoked. */ + + /* + * TIP #285, Script cancellation support. + */ + + Tcl_AsyncHandler asyncCancel; + /* Async handler token for Tcl_CancelEval. */ + Tcl_Obj *asyncCancelMsg; /* Error message set by async cancel handler + * for the propagation of arbitrary Tcl + * errors. This information, if present + * (asyncCancelMsg not NULL), takes precedence + * over the default error messages returned by + * a script cancellation operation. */ + + /* + * TIP #348 IMPLEMENTATION - Substituted error stack + */ + Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */ + Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */ + Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ + Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ + Tcl_Obj *innerContext; /* cached list for fast reallocation */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ + #ifdef TCL_COMPILE_STATS + /* + * Statistical information about the bytecode compiler and interpreter's + * operation. This should be the last field of Interp. + */ + ByteCodeStats stats; /* Holds compilation and execution statistics * for this interpreter. */ #endif /* TCL_COMPILE_STATS */ } Interp; /* - * General list of interpreters. Doubly linked for easier removal of items - * deep in the list. + * Macros that use the TSD-ekeko. + */ + +#define TclAsyncReady(iPtr) \ + *((iPtr)->asyncReadyPtr) + +/* + * Macros for script cancellation support (TIP #285). */ -typedef struct InterpList { - Interp* interpPtr; - struct InterpList* prevPtr; - struct InterpList* nextPtr; -} InterpList; +#define TclCanceled(iPtr) \ + (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) + +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ + } + +#define TclUnsetCancelFlags(iPtr) \ + (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND)) /* * Macros for splicing into and out of doubly linked lists. They assume @@ -1570,7 +2206,10 @@ typedef struct InterpList { * other than these should be turned into errors. */ -#define TCL_ALLOW_EXCEPTIONS 4 +#define TCL_ALLOW_EXCEPTIONS 0x04 +#define TCL_EVAL_FILE 0x02 +#define TCL_EVAL_SOURCE_IN_FRAME 0x10 +#define TCL_EVAL_NORESOLVE 0x20 /* * Flag bits for Interp structures: @@ -1593,6 +2232,9 @@ typedef struct InterpList { * SAFE_INTERP: Non zero means that the current interp is a safe * interp (i.e. it has only the safe commands installed, * less priviledge than a regular interp). + * INTERP_DEBUG_FRAME: Used for switching on various extra interpreter + * debug/info mechanisms (e.g. info frame eval/uplevel + * tracing) which are performance intensive. * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently * active; so no further trace callbacks should be * invoked. @@ -1600,19 +2242,32 @@ typedef struct InterpList { * of the wrong-num-args string in Tcl_WrongNumArgs. * Makes it append instead of replacing and uses * different intermediate text. + * CANCELED: Non-zero means that the script in progress should be + * canceled as soon as possible. This can be checked by + * extensions (and the core itself) by calling + * Tcl_Canceled and checking if TCL_ERROR is returned. + * This is a one-shot flag that is reset immediately upon + * being detected; however, if the TCL_CANCEL_UNWIND flag + * is set Tcl_Canceled will continue to report that the + * script in progress has been canceled thereby allowing + * the evaluation stack for the interp to be fully + * unwound. * * WARNING: For the sake of some extensions that have made use of former * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS) * or 8 (formerly ERROR_CODE_SET). */ -#define DELETED 1 -#define ERR_ALREADY_LOGGED 4 -#define DONT_COMPILE_CMDS_INLINE 0x20 -#define RAND_SEED_INITIALIZED 0x40 -#define SAFE_INTERP 0x80 -#define INTERP_TRACE_IN_PROGRESS 0x200 -#define INTERP_ALTERNATE_WRONG_ARGS 0x400 +#define DELETED 1 +#define ERR_ALREADY_LOGGED 4 +#define INTERP_DEBUG_FRAME 0x10 +#define DONT_COMPILE_CMDS_INLINE 0x20 +#define RAND_SEED_INITIALIZED 0x40 +#define SAFE_INTERP 0x80 +#define INTERP_TRACE_IN_PROGRESS 0x200 +#define INTERP_ALTERNATE_WRONG_ARGS 0x400 +#define ERR_LEGACY_COPY 0x800 +#define CANCELED 0x1000 /* * Maximum number of levels of nesting permitted in Tcl commands (used to @@ -1622,34 +2277,6 @@ typedef struct InterpList { #define MAX_NESTING_DEPTH 1000 /* - * TIP#143 limit handler internal representation. - */ - -struct LimitHandler { - int flags; /* The state of this particular handler. */ - Tcl_LimitHandlerProc *handlerProc; - /* The handler callback. */ - ClientData clientData; /* Opaque argument to the handler callback. */ - Tcl_LimitHandlerDeleteProc *deleteProc; - /* How to delete the clientData */ - LimitHandler *prevPtr; /* Previous item in linked list of handlers */ - LimitHandler *nextPtr; /* Next item in linked list of handlers */ -}; - -/* - * Values for the LimitHandler flags field. - * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be entered reentrantly. - * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This - * should not normally be observed because when a handler is - * deleted it is also spliced out of the list of handlers, but - * even so we will be careful. - */ - -#define LIMIT_HANDLER_ACTIVE 0x01 -#define LIMIT_HANDLER_DELETED 0x02 - -/* * The macro below is used to modify a "char" value (e.g. by casting it to an * unsigned character) so that it can be used safely with macros such as * isspace. @@ -1658,6 +2285,17 @@ struct LimitHandler { #define UCHAR(c) ((unsigned char) (c)) /* + * This macro is used to properly align the memory allocated by Tcl, giving + * the same alignment as the native malloc. + */ + +#if defined(__APPLE__) +#define TCL_ALLOCALIGN 16 +#else +#define TCL_ALLOCALIGN (2*sizeof(void *)) +#endif + +/* * This macro is used to determine the offset needed to safely allocate any * data structure in memory. Given a starting offset or size, it "rounds up" * or "aligns" the offset to the next 8-byte boundary so that any data @@ -1675,7 +2313,6 @@ struct LimitHandler { #define TCL_ALIGN(x) (((int)(x) + 7) & ~7) - /* * The following enum values are used to specify the runtime platform setting * of the tclPlatform variable. @@ -1689,7 +2326,7 @@ typedef enum { /* * The following enum values are used to indicate the translation of a Tcl * channel. Declared here so that each platform can define - * TCL_PLATFORM_TRANSLATION to the native translation on that platform + * TCL_PLATFORM_TRANSLATION to the native translation on that platform. */ typedef enum TclEolTranslation { @@ -1738,18 +2375,82 @@ typedef struct List { * accomodate all elements. */ } List; +#define LIST_MAX \ + (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *))) +#define LIST_SIZE(numElems) \ + (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) + /* - * Macro used to get the elements of a list object - do NOT forget to verify - * that it is of list type before using! + * Macro used to get the elements of a list object. */ -#define TclListObjGetElements(listPtr, objc, objv) \ - { \ - List *listRepPtr = \ - (List *) (listPtr)->internalRep.twoPtrValue.ptr1;\ - (objc) = listRepPtr->elemCount;\ - (objv) = &listRepPtr->elements;\ - } +#define ListRepPtr(listPtr) \ + ((List *) (listPtr)->internalRep.twoPtrValue.ptr1) + +#define ListSetIntRep(objPtr, listRepPtr) \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \ + (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \ + (listRepPtr)->refCount++, \ + (objPtr)->typePtr = &tclListType + +#define ListObjGetElements(listPtr, objc, objv) \ + ((objv) = &(ListRepPtr(listPtr)->elements), \ + (objc) = ListRepPtr(listPtr)->elemCount) + +#define ListObjLength(listPtr, len) \ + ((len) = ListRepPtr(listPtr)->elemCount) + +#define ListObjIsCanonical(listPtr) \ + (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag) + +#define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \ + (((listPtr)->typePtr == &tclListType) \ + ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\ + : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))) + +#define TclListObjLength(interp, listPtr, lenPtr) \ + (((listPtr)->typePtr == &tclListType) \ + ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\ + : Tcl_ListObjLength((interp), (listPtr), (lenPtr))) + +#define TclListObjIsCanonical(listPtr) \ + (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0) + +/* + * Modes for collecting (or not) in the implementations of TclNRForeachCmd, + * TclNRLmapCmd and their compilations. + */ + +#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ +#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ + +/* + * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere, + * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints. + * + * WARNING: these macros eval their args more than once. + */ + +#define TclGetLongFromObj(interp, objPtr, longPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + +#if (LONG_MAX == INT_MAX) +#define TclGetIntFromObj(interp, objPtr, intPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) +#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) +#else +#define TclGetIntFromObj(interp, objPtr, intPtr) \ + Tcl_GetIntFromObj((interp), (objPtr), (intPtr)) +#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \ + TclGetIntForIndex(interp, objPtr, ignore, idxPtr) +#endif /* * Flag values for TclTraceDictPath(). @@ -1792,7 +2493,9 @@ typedef struct List { */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) -typedef ClientData (TclFSGetCwdProc2) (ClientData clientData); +typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); +typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); /* * The following types are used for getting and storing platform-specific file @@ -1802,9 +2505,9 @@ typedef ClientData (TclFSGetCwdProc2) (ClientData clientData); * tclFCmd.c. */ -typedef int (TclGetFileAttrProc) (Tcl_Interp *interp, int objIndex, +typedef int (TclGetFileAttrProc)(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr); -typedef int (TclSetFileAttrProc) (Tcl_Interp *interp, int objIndex, +typedef int (TclSetFileAttrProc)(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr); typedef struct TclFileAttrProcs { @@ -1842,10 +2545,10 @@ typedef enum Tcl_PathPart { *---------------------------------------------------------------- */ -typedef int (TclStatProc_) (CONST char *path, struct stat *buf); -typedef int (TclAccessProc_) (CONST char *path, int mode); -typedef Tcl_Channel (TclOpenFileChannelProc_) (Tcl_Interp *interp, - CONST char *fileName, CONST char *modeString, int permissions); +typedef int (TclStatProc_)(const char *path, struct stat *buf); +typedef int (TclAccessProc_)(const char *path, int mode); +typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, + const char *fileName, const char *modeString, int permissions); /* *---------------------------------------------------------------- @@ -1862,7 +2565,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc) (char **valuePtr, int *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -1897,17 +2600,21 @@ typedef struct ProcessGlobalValue { */ #define TCL_PARSE_DECIMAL_ONLY 1 - /* Leading zero doesn't denote octal or hex */ + /* Leading zero doesn't denote octal or + * hex. */ #define TCL_PARSE_OCTAL_ONLY 2 - /* Parse octal even without prefix */ + /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 - /* Parse hexadecimal even without prefix */ + /* Parse hexadecimal even without prefix. */ #define TCL_PARSE_INTEGER_ONLY 8 - /* Disable floating point parsing */ + /* Disable floating point parsing. */ #define TCL_PARSE_SCAN_PREFIXES 16 - /* Use [scan] rules dealing with 0? prefixes */ + /* Use [scan] rules dealing with 0? + * prefixes. */ #define TCL_PARSE_NO_WHITESPACE 32 - /* Reject leading/trailing whitespace */ + /* Reject leading/trailing whitespace. */ +#define TCL_PARSE_BINARY_ONLY 64 + /* Parse binary even without prefix. */ /* *---------------------------------------------------------------------- @@ -1927,51 +2634,54 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------- */ -MODULE_SCOPE char * tclNativeExecutableName; -MODULE_SCOPE int tclFindExecutableSearchDone; -MODULE_SCOPE char * tclMemDumpFileName; +MODULE_SCOPE char *tclNativeExecutableName; +MODULE_SCOPE int tclFindExecutableSearchDone; +MODULE_SCOPE char *tclMemDumpFileName; MODULE_SCOPE TclPlatformType tclPlatform; -MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier; +MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks; + +MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. */ -MODULE_SCOPE Tcl_GetTimeProc* tclGetTimeProcPtr; -MODULE_SCOPE Tcl_ScaleTimeProc* tclScaleTimeProcPtr; -MODULE_SCOPE ClientData tclTimeClientData; +MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; +MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; +MODULE_SCOPE ClientData tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. */ -MODULE_SCOPE Tcl_ObjType tclBignumType; -MODULE_SCOPE Tcl_ObjType tclBooleanType; -MODULE_SCOPE Tcl_ObjType tclByteArrayType; -MODULE_SCOPE Tcl_ObjType tclByteCodeType; -MODULE_SCOPE Tcl_ObjType tclDoubleType; -MODULE_SCOPE Tcl_ObjType tclEndOffsetType; -MODULE_SCOPE Tcl_ObjType tclIntType; -MODULE_SCOPE Tcl_ObjType tclListType; -MODULE_SCOPE Tcl_ObjType tclDictType; -MODULE_SCOPE Tcl_ObjType tclProcBodyType; -MODULE_SCOPE Tcl_ObjType tclStringType; -MODULE_SCOPE Tcl_ObjType tclArraySearchType; -MODULE_SCOPE Tcl_ObjType tclNsNameType; -#ifndef NO_WIDE_TYPE -MODULE_SCOPE Tcl_ObjType tclWideIntType; +MODULE_SCOPE const Tcl_ObjType tclBignumType; +MODULE_SCOPE const Tcl_ObjType tclBooleanType; +MODULE_SCOPE const Tcl_ObjType tclByteArrayType; +MODULE_SCOPE const Tcl_ObjType tclByteCodeType; +MODULE_SCOPE const Tcl_ObjType tclDoubleType; +MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; +MODULE_SCOPE const Tcl_ObjType tclIntType; +MODULE_SCOPE const Tcl_ObjType tclListType; +MODULE_SCOPE const Tcl_ObjType tclDictType; +MODULE_SCOPE const Tcl_ObjType tclProcBodyType; +MODULE_SCOPE const Tcl_ObjType tclStringType; +MODULE_SCOPE const Tcl_ObjType tclArraySearchType; +MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; +#ifndef TCL_WIDE_INT_IS_LONG +MODULE_SCOPE const Tcl_ObjType tclWideIntType; #endif -MODULE_SCOPE Tcl_ObjType tclRegexpType; +MODULE_SCOPE const Tcl_ObjType tclRegexpType; +MODULE_SCOPE Tcl_ObjType tclCmdNameType; /* * Variables denoting the hash key types defined in the core. */ -MODULE_SCOPE Tcl_HashKeyType tclArrayHashKeyType; -MODULE_SCOPE Tcl_HashKeyType tclOneWordHashKeyType; -MODULE_SCOPE Tcl_HashKeyType tclStringHashKeyType; -MODULE_SCOPE Tcl_HashKeyType tclObjHashKeyType; +MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType; +MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType; +MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType; +MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType; /* * The head of the list of free Tcl objects, and the total number of Tcl @@ -1998,50 +2708,182 @@ MODULE_SCOPE char tclEmptyString; /* *---------------------------------------------------------------- + * Procedures shared among Tcl modules but not used by the outside world, + * introduced by/for NRE. + *---------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; + +MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; +MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback; +MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; +MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval; +MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; + +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); + +/* These two can be considered for the public api */ +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); + +/* + * This structure holds the data for the various iteration callbacks used to + * NRE the 'for' and 'while' commands. We need a separate structure because we + * have more than the 4 client data entries we can provide directly thorugh + * the callback API. It is the 'word' information which puts us over the + * limit. It is needed because the loop body is argument 4 of 'for' and + * argument 2 of 'while'. Not providing the correct index confuses the #280 + * code. We TclSmallAlloc/Free this. + */ + +typedef struct ForIterData { + Tcl_Obj *cond; /* Loop condition expression. */ + Tcl_Obj *body; /* Loop body. */ + Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ + const char *msg; /* Error message part. */ + int word; /* Index of the body script in the command */ +} ForIterData; + +/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile + * and Tcl_FindSymbol. This structure corresponds to an opaque + * typedef in tcl.h */ + +typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, + const char* symbol); +struct Tcl_LoadHandle_ { + ClientData clientData; /* Client data is the load handle in the + * native filesystem if a module was loaded + * there, or an opaque pointer to a structure + * for further bookkeeping on load-from-VFS + * and load-from-memory */ + TclFindSymbolProc* findSymbolProcPtr; + /* Procedure that resolves symbols in a + * loaded module */ + Tcl_FSUnloadFileProc* unloadFileProcPtr; + /* Procedure that unloads a loaded module */ +}; + +/* Flags for conversion of doubles to digit strings */ + +#define TCL_DD_SHORTEST 0x4 + /* Use the shortest possible string */ +#define TCL_DD_STEELE 0x5 + /* Use the original Steele&White algorithm */ +#define TCL_DD_E_FORMAT 0x2 + /* Use a fixed-length string of digits, + * suitable for E format*/ +#define TCL_DD_F_FORMAT 0x3 + /* Use a fixed number of digits after the + * decimal point, suitable for F format */ + +#define TCL_DD_SHORTEN_FLAG 0x4 + /* Allow return of a shorter digit string + * if it converts losslessly */ +#define TCL_DD_NO_QUICK 0x8 + /* Debug flag: forbid quick FP conversion */ + +#define TCL_DD_CONVERSION_TYPE_MASK 0x3 + /* Mask to isolate the conversion type */ +#define TCL_DD_STEELE0 0x1 + /* 'Steele&White' after masking */ +#define TCL_DD_SHORTEST0 0x0 + /* 'Shortest possible' after masking */ + +/* + *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ -MODULE_SCOPE int TclAppendFormattedObjs(Tcl_Interp *interp, - Tcl_Obj *appendObj, CONST char *format, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE void TclAppendLimitedToObj(Tcl_Obj *objPtr, - CONST char *bytes, int length, int limit, - CONST char *ellipsis); -MODULE_SCOPE void TclAppendObjToErrorInfo(Tcl_Interp *interp, - Tcl_Obj *objPtr); +MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, + const unsigned char *bytes, int len); +MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, + int flags); +MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, + int loc); +MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, + const char *end); +MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, + Tcl_Obj *objv[], int objc, CmdFrame *cf); +MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, + Tcl_Obj *objv[], int objc); +MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, + Tcl_Obj *objv[], int objc, + void *codePtr, CmdFrame *cfPtr, int cmd, int pc); +MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, + CmdFrame *cfPtr); +MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, + CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); -MODULE_SCOPE double TclBignumToDouble(mp_int* bignum); -MODULE_SCOPE double TclCeil(mp_int* a); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,CONST char *value); -MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); +MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, + int strLen, const unsigned char *pattern, + int ptnLen, int flags); +MODULE_SCOPE double TclCeil(const mp_int *a); +MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, + const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); -MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp* interp, - LiteralTable* tablePtr); -MODULE_SCOPE int TclDoubleDigits(char* buf, double value, int* signum); -MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); -MODULE_SCOPE void TclExpandTokenArray(Tcl_Parse *parsePtr); -MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclFileDeleteCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclFileMakeDirsCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclFileRenameCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); +MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; +MODULE_SCOPE int TclClearRootEnsemble(ClientData data[], + Tcl_Interp *interp, int result); +MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, + int *loc); +MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, + int start, int *clNext); +MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); +MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, + Tcl_Obj *originObjPtr); +MODULE_SCOPE int TclConvertElement(const char *src, int length, + char *dst, int flags); +MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); +/* TIP #280 - Modified token based evulation, with line information. */ +MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, + int numBytes, int flags, int line, + int *clNextOuter, const char *outerScript); +MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; +MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, + ClientData clientData); +MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, + ClientData clientData); +MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, + Tcl_Obj *objPtr); +MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr); +MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); -MODULE_SCOPE void TclFinalizeCompilation(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); +MODULE_SCOPE void TclFinalizeEvaluation(void); MODULE_SCOPE void TclFinalizeExecution(void); MODULE_SCOPE void TclFinalizeIOSubsystem(void); MODULE_SCOPE void TclFinalizeFilesystem(void); @@ -2053,34 +2895,51 @@ MODULE_SCOPE void TclFinalizeNotifier(void); MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); +MODULE_SCOPE void TclFinalizeThreadAlloc(void); +MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(void); -MODULE_SCOPE double TclFloor(mp_int* a); -MODULE_SCOPE void TclFormatNaN(double value, char* buffer); -MODULE_SCOPE int TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST char *format, ...); -MODULE_SCOPE int TclFormatToErrorInfo(Tcl_Interp *interp, - CONST char *format, ...); +MODULE_SCOPE void TclFinalizeThreadObjects(void); +MODULE_SCOPE double TclFloor(const mp_int *a); +MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, - CONST char *attributeName, int *indexPtr); + const char *attributeName, int *indexPtr); +MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, + const char *encodingName); +MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle); +MODULE_SCOPE int * TclGetAsyncReadyPtr(void); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp); -MODULE_SCOPE int TclGetEncodingFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); -MODULE_SCOPE int TclGetNamespaceFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); +MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_Channel *chanPtr, + int *modePtr, int flags); +MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, + Tcl_Obj *value, int *code); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, - CONST char *modeString, int *seekFlagPtr, + const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); +MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, - Tcl_GlobTypeData* types); + Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); +MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); +MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); @@ -2092,74 +2951,79 @@ MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); -MODULE_SCOPE void TclInitSubsystems (); +MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); -MODULE_SCOPE int TclIsLocalScalar(CONST char *src, int len); -MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int* result); +MODULE_SCOPE int TclIsLocalScalar(const char *src, int len); +MODULE_SCOPE int TclIsSpaceProc(char byte); +MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]); +MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); -MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp* interp, - Tcl_Obj* listPtr, Tcl_Obj* argPtr); -MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp* interp, Tcl_Obj* listPtr, - int indexCount, Tcl_Obj *CONST indexArray[]); -MODULE_SCOPE int TclLoadFile(Tcl_Interp* interp, Tcl_Obj *pathPtr, - int symc, CONST char *symbols[], - Tcl_PackageInitProc **procPtrs[], - Tcl_LoadHandle *handlePtr, - ClientData *clientDataPtr, - Tcl_FSUnloadFileProc **unloadProcPtr); -MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp* interp, Tcl_Obj* listPtr, - Tcl_Obj* indexPtr, Tcl_Obj* valuePtr); -MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp* interp, Tcl_Obj* listPtr, - int indexCount, Tcl_Obj *CONST indexArray[], - Tcl_Obj* valuePtr); +MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, + Tcl_Obj *listPtr, Tcl_Obj *argPtr); +MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, + int indexCount, Tcl_Obj *const indexArray[]); +/* TIP #280 */ +MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, + int *lines, Tcl_Obj *const *elems); +MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); +MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, + Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); +MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, + int indexCount, Tcl_Obj *const indexArray[], + Tcl_Obj *valuePtr); +MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, + const EnsembleImplMap map[]); +MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes, + const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr, + Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); +MODULE_SCOPE int TclNokia770Doubles(void); +MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); +MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, const char *operation, + const char *reason, int index); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[], + int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); -MODULE_SCOPE int TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST char *format, ...); -MODULE_SCOPE int TclParseBackslash(CONST char *src, +MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, + Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); +MODULE_SCOPE int TclParseBackslash(const char *src, int numBytes, int *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes, - Tcl_UniChar *resultPtr); -MODULE_SCOPE int TclParseNumber(Tcl_Interp* interp, Tcl_Obj* objPtr, - CONST char *expected, CONST char* bytes, - int numBytes, CONST char** endPtrPtr, int flags); -MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, CONST char *string, +MODULE_SCOPE int TclParseHex(const char *src, int numBytes, + int *resultPtr); +MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, + const char *expected, const char *bytes, + int numBytes, const char **endPtrPtr, int flags); +MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, int numBytes, Tcl_Parse *parsePtr); -#if 0 -MODULE_SCOPE int TclParseInteger(CONST char *string, int numBytes); -#endif -MODULE_SCOPE int TclParseWhiteSpace(CONST char *src, - int numBytes, Tcl_Parse *parsePtr, char *typePtr); +MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); -MODULE_SCOPE int TclpCheckStackSpace(void); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); +MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, int len); -MODULE_SCOPE int TclpDeleteFile(CONST char *path); +MODULE_SCOPE int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); +MODULE_SCOPE void TclpFinalizeSockets(void); +MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, + struct addrinfo **addrlist, + const char *host, int port, int willBind, + const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc proc, ClientData clientData, + Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); -MODULE_SCOPE int TclpFindVariable(CONST char *name, int *lengthPtr); +MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); -MODULE_SCOPE int TclpLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, - CONST char *sym1, CONST char *sym2, - Tcl_PackageInitProc **proc1Ptr, - Tcl_PackageInitProc **proc2Ptr, - ClientData *clientDataPtr, - Tcl_FSUnloadFileProc **unloadProcPtr); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); MODULE_SCOPE void TclpMasterLock(void); MODULE_SCOPE void TclpMasterUnlock(void); @@ -2167,66 +3031,102 @@ MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators, Tcl_DString *dirPtr, char *pattern, char *tail); MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); -MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, char *joining); +MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining); MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr); MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef); -MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, +MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, - CONST char *pattern, Tcl_GlobTypeData *types); + const char *pattern, Tcl_GlobTypeData *types); MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; -MODULE_SCOPE Tcl_Obj* TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, +MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr); +MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); -MODULE_SCOPE void TclpPanic(CONST char *format, ...); -MODULE_SCOPE char * TclpReadlink(CONST char *fileName, +MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); -MODULE_SCOPE void TclpReleaseFile(TclFile file); MODULE_SCOPE void TclpSetInterfaces(void); MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp); -MODULE_SCOPE void TclpUnloadFile(Tcl_LoadHandle loadHandle); -MODULE_SCOPE void * TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr); -MODULE_SCOPE void TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr, +MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr); +MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr, void *data); MODULE_SCOPE void TclpThreadExit(int status); -MODULE_SCOPE int TclpThreadGetStackSize(void); MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex); MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); +MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, + int reStrLen, Tcl_DString *dsPtr, int *flagsPtr); +MODULE_SCOPE int TclScanElement(const char *string, int length, + int *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); -MODULE_SCOPE void TclSetBignumIntRep (Tcl_Obj *objPtr, +MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); +MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Command *cmdPtr); +MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); +MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, + int numBytes); +MODULE_SCOPE int TclStringMatch(const char *str, int strLen, + const char *pattern, int ptnLen, int flags); +MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, + Tcl_Obj *patternObj, int flags); +MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr); +MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, + int numBytes, int flags, int line, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, + Tcl_Obj *const opts[], int *flagPtr); +MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, + int numBytes, int flags, Tcl_Parse *parsePtr, + Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count, int *tokensLeftPtr); -MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result, - Tcl_Interp *targetInterp); + int count, int *tokensLeftPtr, int line, + int *clNextOuter, const char *outerScript); +MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, + const char *trim, int numTrim); +MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, + const char *trim, int numTrim); +MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); -MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj* pathPtr); -MODULE_SCOPE Tcl_PackageInitProc* TclpFindSymbol(Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, CONST char *symbol); +MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, - Tcl_FSUnloadFileProc **unloadProcPtr); + Tcl_FSUnloadFileProc **unloadProcPtr, int flags); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); #ifdef TCL_LOAD_FROM_MEMORY -MODULE_SCOPE void* TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size); +MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size); MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, - Tcl_FSUnloadFileProc **unloadProcPtr); + Tcl_FSUnloadFileProc **unloadProcPtr, int flags); #endif MODULE_SCOPE void TclInitThreadStorage(void); -MODULE_SCOPE void TclpFinalizeThreadDataThread(void); +MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +#ifdef TCL_WIDE_CLICKS +MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); +MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); +#endif +MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); +MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); +MODULE_SCOPE void * TclpThreadCreateKey(void); +MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); +MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); +MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); + +MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); /* *---------------------------------------------------------------- @@ -2236,260 +3136,291 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void); MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_ArrayObjCmd(ClientData clientData, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_BinaryObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); +MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclChanTruncateObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE void TclClockInit(Tcl_Interp*); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_DictObjCmd(ClientData clientData, + int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, + Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, int index, int pathc, + Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); +MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, + int pathc, Tcl_Obj *const pathv[]); +MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); + +/* Assemble command function */ +MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); + MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int TclEncodingDirsObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_FileObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp); MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_InfoObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, - Tcl_Interp* interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_NamespaceObjCmd(ClientData clientData, + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -MODULE_SCOPE int Tcl_StringObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); /* *---------------------------------------------------------------- @@ -2498,49 +3429,454 @@ MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, */ MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileArrayExistsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileArraySetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileArrayUnsetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileDictCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictAppendCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictCreateCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictExistsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictForCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictGetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictIncrCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictLappendCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictMapCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictMergeCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictSetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictUnsetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictWithCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileErrorCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileExprCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileFormatCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoCommandsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoCoroutineCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoLevelCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoObjectClassCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoObjectIsACmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoObjectNamespaceCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp* interp, - Tcl_Parse* parsePtr, struct CompileEnv* envPtr); -MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp* interp, - Tcl_Parse* parsePtr, struct CompileEnv* envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLmapCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLrangeCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLreplaceCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceTailCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceUpvarCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileObjectNextToCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileRegsubCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileStringCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringEqualCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringMapCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringReplaceCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimRCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileTailcallCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileThrowCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileTryCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileUnsetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileYieldToCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0To2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1To3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin0ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); + +MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclNotOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclAddOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclMulOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclAndOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclOrOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclXorOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclPowOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclModOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclInOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclNiOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclDivOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclLessOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclEqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); + +MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); /* * Functions defined in generic/tclVar.c and currenttly exported only for use @@ -2548,36 +3884,53 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, * the public interface. */ +MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp, + Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, + const char *msg, const int createPart1, + const int createPart2, Var **arrayPtrPtr); MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp, - CONST char *arrayName, CONST char *elName, - CONST int flags, CONST char *msg, - CONST int createPart1, CONST int createPart2, - Var *arrayPtr); -MODULE_SCOPE Var * TclObjLookupVar(Tcl_Interp *interp, - Tcl_Obj *part1Ptr, CONST char *part2, int flags, - CONST char *msg, CONST int createPart1, - CONST int createPart2, Var **arrayPtrPtr); + Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr, + const int flags, const char *msg, + const int createPart1, const int createPart2, + Var *arrayPtr, int index); MODULE_SCOPE Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, CONST int flags); + Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, const int flags, int index); MODULE_SCOPE Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, Tcl_Obj *newValuePtr, - CONST int flags); -MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar (Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, Tcl_Obj *incrPtr, - CONST int flags); -#if 0 -MODULE_SCOPE Tcl_Obj * TclPtrIncrVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, CONST long i, CONST int flags); -MODULE_SCOPE Tcl_Obj * TclPtrIncrWideVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, CONST Tcl_WideInt i, - CONST int flags); -#endif + Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, + const int flags, int index); +MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, + Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, + const int flags, int index); +MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr, + Tcl_Obj *myNamePtr, int myFlags, int index); +MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr, + Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, const int flags, + int index); MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); +MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr, + Tcl_HashTable *tablePtr); + +/* + * The new extended interface to the variable traces. + */ + +MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, + Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, + int flags, int leaveErrMsg, int index); + +/* + * So tclObj.c and tclDictObj.c can share these implementations. + */ + +MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); +MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); +MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); + +MODULE_SCOPE int TclFullFinalizationRequested(void); /* *---------------------------------------------------------------- @@ -2600,6 +3953,22 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); *---------------------------------------------------------------- */ +/* + * DTrace object allocation probe macros. + */ + +#ifdef USE_DTRACE +#ifndef _TCLDTRACE_H +typedef const char *TclDTraceStr; +#include "tclDTrace.h" +#endif +#define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr) +#define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr) +#else /* USE_DTRACE */ +#define TCL_DTRACE_OBJ_CREATE(objPtr) {} +#define TCL_DTRACE_OBJ_FREE(objPtr) {} +#endif /* USE_DTRACE */ + #ifdef TCL_COMPILE_STATS # define TclIncrObjsAllocated() \ tclObjsAlloced++ @@ -2610,6 +3979,12 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ +# define TclAllocObjStorage(objPtr) \ + TclAllocObjStorageEx(NULL, (objPtr)) + +# define TclFreeObjStorage(objPtr) \ + TclFreeObjStorageEx(NULL, (objPtr)) + #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ TclIncrObjsAllocated(); \ @@ -2617,19 +3992,29 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); (objPtr)->refCount = 0; \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr) + +/* + * Invalidate the string rep first so we can use the bytes value for our + * pointer chain, and signal an obj deletion (as opposed to shimmering) with + * 'length == -1'. + * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. + */ # define TclDecrRefCount(objPtr) \ - if (--(objPtr)->refCount <= 0) { \ - if ((objPtr)->typePtr && (objPtr)->typePtr->freeIntRepProc) { \ - TclFreeObj(objPtr); \ - } else { \ + if (--(objPtr)->refCount > 0) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ && ((objPtr)->bytes != tclEmptyStringRep)) { \ ckfree((char *) (objPtr)->bytes); \ } \ + (objPtr)->length = -1; \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ } \ } @@ -2639,15 +4024,17 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); * The PURIFY mode is like the regular mode, but instead of doing block * Tcl_Obj allocation and keeping a freed list for efficiency, it always * allocates and frees a single Tcl_Obj so that tools like Purify can better - * track memory leaks + * track memory leaks. */ -# define TclAllocObjStorage(objPtr) \ - (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj)) +# define TclAllocObjStorageEx(interp, objPtr) \ + (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorageEx(interp, objPtr) \ ckfree((char *) (objPtr)) +#undef USE_THREAD_ALLOC +#undef USE_TCLALLOC #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) /* @@ -2661,47 +4048,94 @@ MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); MODULE_SCOPE void TclFreeAllocCache(void *); MODULE_SCOPE void * TclpGetAllocCache(void); MODULE_SCOPE void TclpSetAllocCache(void *); -MODULE_SCOPE void TclFinalizeThreadAlloc(void); -MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex* mutex); +MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclpFreeAllocCache(void *); -# define TclAllocObjStorage(objPtr) \ - (objPtr) = TclThreadAllocObj() +/* + * These macros need to be kept in sync with the code of TclThreadAllocObj() + * and TclThreadFreeObj(). + * + * Note that the optimiser should resolve the case (interp==NULL) at compile + * time. + */ -# define TclFreeObjStorage(objPtr) \ - TclThreadFreeObj((objPtr)) +# define ALLOC_NOBJHIGH 1200 + +# define TclAllocObjStorageEx(interp, objPtr) \ + do { \ + AllocCache *cachePtr; \ + if (((interp) == NULL) || \ + ((cachePtr = ((Interp *)(interp))->allocCache), \ + (cachePtr->numObjects == 0))) { \ + (objPtr) = TclThreadAllocObj(); \ + } else { \ + (objPtr) = cachePtr->firstObjPtr; \ + cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \ + --cachePtr->numObjects; \ + } \ + } while (0) + +# define TclFreeObjStorageEx(interp, objPtr) \ + do { \ + AllocCache *cachePtr; \ + if (((interp) == NULL) || \ + ((cachePtr = ((Interp *)(interp))->allocCache), \ + (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \ + TclThreadFreeObj(objPtr); \ + } else { \ + (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \ + cachePtr->firstObjPtr = objPtr; \ + ++cachePtr->numObjects; \ + } \ + } while (0) #else /* not PURIFY or USE_THREAD_ALLOC */ +#if defined(USE_TCLALLOC) && USE_TCLALLOC + MODULE_SCOPE void TclFinalizeAllocSubsystem(); + MODULE_SCOPE void TclInitAlloc(); +#else +# define USE_TCLALLOC 0 +#endif + #ifdef TCL_THREADS /* declared in tclObj.c */ MODULE_SCOPE Tcl_Mutex tclObjMutex; #endif -# define TclAllocObjStorage(objPtr) \ - Tcl_MutexLock(&tclObjMutex); \ - if (tclFreeObjList == NULL) { \ - TclAllocateFreeObjects(); \ - } \ - (objPtr) = tclFreeObjList; \ - tclFreeObjList = (Tcl_Obj *) \ - tclFreeObjList->internalRep.otherValuePtr; \ - Tcl_MutexUnlock(&tclObjMutex) - -# define TclFreeObjStorage(objPtr) \ - Tcl_MutexLock(&tclObjMutex); \ - (objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex) +# define TclAllocObjStorageEx(interp, objPtr) \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ + if (tclFreeObjList == NULL) { \ + TclAllocateFreeObjects(); \ + } \ + (objPtr) = tclFreeObjList; \ + tclFreeObjList = (Tcl_Obj *) \ + tclFreeObjList->internalRep.twoPtrValue.ptr1; \ + Tcl_MutexUnlock(&tclObjMutex); \ + } while (0) + +# define TclFreeObjStorageEx(interp, objPtr) \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ + } while (0) #endif #else /* TCL_MEM_DEBUG */ -MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); +MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, + int line); # define TclDbNewObj(objPtr, file, line) \ - TclIncrObjsAllocated(); \ - (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ - TclDbInitNewObj(objPtr); + do { \ + TclIncrObjsAllocated(); \ + (objPtr) = (Tcl_Obj *) \ + Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ + TclDbInitNewObj((objPtr), (file), (line)); \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) # define TclNewObj(objPtr) \ TclDbNewObj(objPtr, __FILE__, __LINE__); @@ -2736,8 +4170,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); (objPtr)->length = 0; \ } else { \ (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ - memcpy((void *) (objPtr)->bytes, (void *) (bytePtr), \ - (unsigned) (len)); \ + memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } @@ -2757,6 +4190,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr))) +#define TclGetStringFromObj(objPtr, lenPtr) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + : Tcl_GetStringFromObj((objPtr), (lenPtr))) + /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal @@ -2768,9 +4206,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); */ #define TclFreeIntRep(objPtr) \ - if ((objPtr)->typePtr != NULL && \ - (objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* @@ -2784,55 +4224,151 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); #define TclInvalidateStringRep(objPtr) \ if (objPtr->bytes != NULL) { \ - if (objPtr->bytes != tclEmptyStringRep) {\ - ckfree((char *) objPtr->bytes);\ - }\ - objPtr->bytes = NULL;\ - }\ - + if (objPtr->bytes != tclEmptyStringRep) { \ + ckfree((char *) objPtr->bytes); \ + } \ + objPtr->bytes = NULL; \ + } -#if 0 /* *---------------------------------------------------------------- - * Macro used by the Tcl core to get a Tcl_WideInt value out of a Tcl_Obj of - * the "wideInt" type. + * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same + * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C + * "prototype" for this macro is: + * + * MODULE_SCOPE void TclGrowTokenArray(Tcl_Token *tokenPtr, int used, + * int available, int append, + * Tcl_Token *staticPtr); + * MODULE_SCOPE void TclGrowParseTokenArray(Tcl_Parse *parsePtr, + * int append); *---------------------------------------------------------------- */ -#ifndef NO_WIDE_TYPE -# define TclGetWide(resultVar, objPtr) \ - (resultVar) = (objPtr)->internalRep.wideValue -# define TclGetLongFromWide(resultVar, objPtr) \ - (resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue) +/* General tuning for minimum growth in Tcl growth algorithms */ +#ifndef TCL_MIN_GROWTH +# ifdef TCL_GROWTH_MIN_ALLOC + /* Support for any legacy tuners */ +# define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC +# else +# define TCL_MIN_GROWTH 1024 +# endif #endif + +/* Token growth tuning, default to the general value. */ +#ifndef TCL_MIN_TOKEN_GROWTH +#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token) #endif +#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token)) +#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ + do { \ + int needed = (used) + (append); \ + if (needed > TCL_MAX_TOKENS) { \ + Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \ + TCL_MAX_TOKENS); \ + } \ + if (needed > (available)) { \ + int allocated = 2 * needed; \ + Tcl_Token *oldPtr = (tokenPtr); \ + Tcl_Token *newPtr; \ + if (oldPtr == (staticPtr)) { \ + oldPtr = NULL; \ + } \ + if (allocated > TCL_MAX_TOKENS) { \ + allocated = TCL_MAX_TOKENS; \ + } \ + newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ + (unsigned int) (allocated * sizeof(Tcl_Token))); \ + if (newPtr == NULL) { \ + allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH; \ + if (allocated > TCL_MAX_TOKENS) { \ + allocated = TCL_MAX_TOKENS; \ + } \ + newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \ + (unsigned int) (allocated * sizeof(Tcl_Token))); \ + } \ + (available) = allocated; \ + if (oldPtr == NULL) { \ + memcpy(newPtr, staticPtr, \ + (size_t) ((used) * sizeof(Tcl_Token))); \ + } \ + (tokenPtr) = newPtr; \ + } \ + } while (0) + +#define TclGrowParseTokenArray(parsePtr, append) \ + TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \ + (parsePtr)->tokensAvailable, (append), \ + (parsePtr)->staticTokens) + /* *---------------------------------------------------------------- * Macro used by the Tcl core get a unicode char from a utf string. It checks * to see if we have a one-byte utf char before calling the real - * Tcl_UtfToUniChar, as this will save a lot of time for primarily ascii + * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE int TclUtfToUniChar(CONST char *string, Tcl_UniChar *ch); + * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ - ((((unsigned char) *(str)) < 0xC0) ? \ - ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \ + ((((unsigned char) *(str)) < 0xC0) ? \ + ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* *---------------------------------------------------------------- + * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- + * -sensitive points where it pays to avoid a function call in the common case + * of counting along a string of all one-byte characters. The ANSI C + * "prototype" for this macro is: + * + * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes, + * int numBytes); + *---------------------------------------------------------------- + */ + +#define TclNumUtfChars(numChars, bytes, numBytes) \ + do { \ + int count, i = (numBytes); \ + unsigned char *str = (unsigned char *) (bytes); \ + while (i && (*str < 0xC0)) { i--; str++; } \ + count = (numBytes) - i; \ + if (i) { \ + count += Tcl_NumUtfChars((bytes) + count, i); \ + } \ + (numChars) = count; \ + } while (0); + +/* + *---------------------------------------------------------------- + * Macro that encapsulates the logic that determines when it is safe to + * interpret a string as a byte array directly. In summary, the object must be + * a byte array and must not have a string representation (as the operations + * that it is used in are defined on strings, not byte arrays). Theoretically + * it is possible to also be efficient in the case where the object's bytes + * field is filled by generation from the byte array (c.f. list canonicality) + * but we don't do that at the moment since this is purely about efficiency. + * The ANSI C "prototype" for this macro is: + * + * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); + *---------------------------------------------------------------- + */ + +#define TclIsPureByteArray(objPtr) \ + (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL)) + +/* + *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: * - * MODULE_SCOPE int TclUniCharNcmp(CONST Tcl_UniChar *cs, - * CONST Tcl_UniChar *ct, unsigned long n); + * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, + * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ @@ -2852,8 +4388,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); */ #define TclInvalidateNsCmdLookup(nsPtr) \ - if ((nsPtr)->numExportPatterns) { \ - (nsPtr)->exportLookupEpoch++; \ + if ((nsPtr)->numExportPatterns) { \ + (nsPtr)->exportLookupEpoch++; \ + } \ + if ((nsPtr)->commandPathLength) { \ + (nsPtr)->cmdRefEpoch++; \ } /* @@ -2864,34 +4403,40 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); *---------------------------------------------------------------------- */ -MODULE_SCOPE int TclTommath_Init(Tcl_Interp*); +MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init; MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal); -MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int* bignum, +MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal); -MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, +MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal); /* - *---------------------------------------------------------------- - * Macro used by the Tcl core to check whether a pattern has any characters - * special to [string match]. The ANSI C "prototype" for this macro is: + *---------------------------------------------------------------------- * - * MODULE_SCOPE int TclMatchIsTrivial(CONST char *pattern); - *---------------------------------------------------------------- + * External (platform specific) initialization routine, these declarations + * explicitly don't use EXTERN since this code does not get compiled into the + * library: + * + *---------------------------------------------------------------------- */ -#define TclMatchIsTrivial(pattern) strpbrk((pattern), "*[]]?\\") == NULL +MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit; +MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init; +MODULE_SCOPE Tcl_PackageInitProc TclThread_Init; +MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init; +MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- - * Macro used by the Tcl core to write the string rep of a long integer to a - * character buffer. The ANSI C "prototype" for this macro is: + * Macro used by the Tcl core to check whether a pattern has any characters + * special to [string match]. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE int TclFormatInt(char *buf, long n); + * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern); *---------------------------------------------------------------- */ -#define TclFormatInt(buf, n) sprintf((buf), "%ld", (long)(n)) +#define TclMatchIsTrivial(pattern) \ + (strpbrk((pattern), "*[?\\") == NULL) /* *---------------------------------------------------------------- @@ -2908,14 +4453,16 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, *---------------------------------------------------------------- */ -#define TclSetIntObj(objPtr, i) \ - TclInvalidateStringRep(objPtr);\ - TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.longValue = (long)(i); \ - (objPtr)->typePtr = &tclIntType +#define TclSetLongObj(objPtr, i) \ + do { \ + TclInvalidateStringRep(objPtr); \ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->typePtr = &tclIntType; \ + } while (0) -#define TclSetLongObj(objPtr, l) \ - TclSetIntObj((objPtr), (l)) +#define TclSetIntObj(objPtr, l) \ + TclSetLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set @@ -2925,21 +4472,25 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, */ #define TclSetBooleanObj(objPtr, b) \ - TclSetIntObj((objPtr), ((b)? 1 : 0)); + TclSetLongObj(objPtr, (b)!=0); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG #define TclSetWideIntObj(objPtr, w) \ - TclInvalidateStringRep(objPtr);\ - TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclWideIntType + do { \ + TclInvalidateStringRep(objPtr); \ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclWideIntType; \ + } while (0) #endif #define TclSetDoubleObj(objPtr, d) \ - TclInvalidateStringRep(objPtr);\ - TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType + do { \ + TclInvalidateStringRep(objPtr); \ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + } while (0) /* *---------------------------------------------------------------- @@ -2953,43 +4504,56 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len); + * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral); * *---------------------------------------------------------------- */ #ifndef TCL_MEM_DEBUG -#define TclNewIntObj(objPtr, i) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.longValue = (long)(i); \ - (objPtr)->typePtr = &tclIntType - -#define TclNewLongObj(objPtr, l) \ - TclNewIntObj((objPtr), (l)) +#define TclNewLongObj(objPtr, i) \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) + +#define TclNewIntObj(objPtr, l) \ + TclNewLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. * See comment above TclSetBooleanObj macro above. */ #define TclNewBooleanObj(objPtr, b) \ - TclNewIntObj((objPtr), ((b)? 1 : 0)) + TclNewLongObj((objPtr), (b)!=0) #define TclNewDoubleObj(objPtr, d) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) #define TclNewStringObj(objPtr, s, len) \ - TclNewObj(objPtr); \ - TclInitStringRep((objPtr), (s), (len)) + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) #else /* TCL_MEM_DEBUG */ -#define TclNewIntObj(objPtr, i) \ +#define TclNewIntObj(objPtr, i) \ (objPtr) = Tcl_NewIntObj(i) #define TclNewLongObj(objPtr, l) \ @@ -3006,6 +4570,28 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, #endif /* TCL_MEM_DEBUG */ /* + * The sLiteral argument *must* be a string literal; the incantation with + * sizeof(sLiteral "") will fail to compile otherwise. + */ +#define TclNewLiteralStringObj(objPtr, sLiteral) \ + TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) + +/* + *---------------------------------------------------------------- + * Convenience macros for DStrings. + * The ANSI C "prototypes" for these macros are: + * + * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, + * const char *sLiteral); + * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); + */ + +#define TclDStringAppendLiteral(dsPtr, sLiteral) \ + Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) +#define TclDStringClear(dsPtr) \ + Tcl_DStringSetLength((dsPtr), 0) + +/* *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: @@ -3015,18 +4601,223 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int* bignum, */ #ifdef _MSC_VER -#define TclIsInfinite(d) ( ! (_finite((d))) ) -#define TclIsNaN(d) (_isnan((d))) +# define TclIsInfinite(d) (!(_finite((d)))) +# define TclIsNaN(d) (_isnan((d))) #else -#define TclIsInfinite(d) ( (d) > DBL_MAX || (d) < -DBL_MAX ) -#define TclIsNaN(d) ((d) != (d)) +# define TclIsInfinite(d) ((d) > DBL_MAX || (d) < -DBL_MAX) +# ifdef NO_ISNAN +# define TclIsNaN(d) ((d) != (d)) +# else +# define TclIsNaN(d) (isnan(d)) +# endif +#endif + +/* + * ---------------------------------------------------------------------- + * Macro to use to find the offset of a field in a structure. Computes number + * of bytes from beginning of structure to a given field. + */ + +#ifdef offsetof +#define TclOffset(type, field) ((int) offsetof(type, field)) +#else +#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) +#endif + +/* + *---------------------------------------------------------------- + * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. + */ + +#define TclGetCurrentNamespace(interp) \ + (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr + +#define TclGetGlobalNamespace(interp) \ + (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr + +/* + *---------------------------------------------------------------- + * Inline version of TclCleanupCommand; still need the function as it is in + * the internal stubs, but the core can use the macro instead. + */ + +#define TclCleanupCommandMacro(cmdPtr) \ + if (--(cmdPtr)->refCount <= 0) { \ + ckfree((char *) (cmdPtr));\ + } + +/* + *---------------------------------------------------------------- + * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number + * of calls out of the critical path. Note that this code isn't particularly + * readable; the non-inline version (in tclInterp.c) is much easier to + * understand. Note also that these macros takes different args (iPtr->limit) + * to the non-inline version. + */ + +#define TclLimitExceeded(limit) ((limit).exceeded != 0) + +#define TclLimitReady(limit) \ + (((limit).active == 0) ? 0 : \ + (++(limit).granularityTicker, \ + ((((limit).active & TCL_LIMIT_COMMANDS) && \ + (((limit).cmdGranularity == 1) || \ + ((limit).granularityTicker % (limit).cmdGranularity == 0))) \ + ? 1 : \ + (((limit).active & TCL_LIMIT_TIME) && \ + (((limit).timeGranularity == 1) || \ + ((limit).granularityTicker % (limit).timeGranularity == 0)))\ + ? 1 : 0))) + +/* + * Compile-time assertions: these produce a compile time error if the + * expression is not known to be true at compile time. If the assertion is + * known to be false, the compiler (or optimizer?) will error out with + * "division by zero". If the assertion cannot be evaluated at compile time, + * the compiler will error out with "non-static initializer". + * + * Adapted with permission from + * http://www.pixelbeat.org/programming/gcc/static_assert.html + */ + +#define TCL_CT_ASSERT(e) \ + {enum { ct_assert_value = 1/(!!(e)) };} + +/* + *---------------------------------------------------------------- + * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool. + * Only checked at compile time. + * + * ONLY USE FOR CONSTANT nBytes. + * + * DO NOT LET THEM CROSS THREAD BOUNDARIES + *---------------------------------------------------------------- + */ + +#define TclSmallAlloc(nbytes, memPtr) \ + TclSmallAllocEx(NULL, (nbytes), (memPtr)) + +#define TclSmallFree(memPtr) \ + TclSmallFreeEx(NULL, (memPtr)) + +#ifndef TCL_MEM_DEBUG +#define TclSmallAllocEx(interp, nbytes, memPtr) \ + do { \ + Tcl_Obj *objPtr; \ + TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ + TclIncrObjsAllocated(); \ + TclAllocObjStorageEx((interp), (objPtr)); \ + memPtr = (ClientData) (objPtr); \ + } while (0) + +#define TclSmallFreeEx(interp, memPtr) \ + do { \ + TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ + TclIncrObjsFreed(); \ + } while (0) + +#else /* TCL_MEM_DEBUG */ +#define TclSmallAllocEx(interp, nbytes, memPtr) \ + do { \ + Tcl_Obj *objPtr; \ + TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ + TclNewObj(objPtr); \ + memPtr = (ClientData) objPtr; \ + } while (0) + +#define TclSmallFreeEx(interp, memPtr) \ + do { \ + Tcl_Obj *objPtr = (Tcl_Obj *) memPtr; \ + objPtr->bytes = NULL; \ + objPtr->typePtr = NULL; \ + objPtr->refCount = 1; \ + TclDecrRefCount(objPtr); \ + } while (0) +#endif /* TCL_MEM_DEBUG */ + +/* + * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> + */ + +#if defined(PURIFY) && defined(__clang__) +#if __has_feature(attribute_analyzer_noreturn) && \ + !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED) +void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); +#endif +#if !defined(CLANG_ASSERT) +#include <assert.h> +#define CLANG_ASSERT(x) assert(x) +#endif +#elif !defined(CLANG_ASSERT) +#define CLANG_ASSERT(x) +#endif /* PURIFY && __clang__ */ + +/* + *---------------------------------------------------------------- + * Parameters, structs and macros for the non-recursive engine (NRE) + *---------------------------------------------------------------- + */ + +#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */ +#define NRE_ENABLE_ASSERTS 1 + +/* + * This is the main data struct for representing NR commands. It is designed + * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator + * available. + */ + +typedef struct NRE_callback { + Tcl_NRPostProc *procPtr; + ClientData data[4]; + struct NRE_callback *nextPtr; +} NRE_callback; + +#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) + +/* + * Inline version of Tcl_NRAddCallback. + */ + +#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ + do { \ + NRE_callback *callbackPtr; \ + TCLNR_ALLOC((interp), (callbackPtr)); \ + callbackPtr->procPtr = (postProcPtr); \ + callbackPtr->data[0] = (ClientData)(data0); \ + callbackPtr->data[1] = (ClientData)(data1); \ + callbackPtr->data[2] = (ClientData)(data2); \ + callbackPtr->data[3] = (ClientData)(data3); \ + callbackPtr->nextPtr = TOP_CB(interp); \ + TOP_CB(interp) = callbackPtr; \ + } while (0) + +#if NRE_USE_SMALL_ALLOC +#define TCLNR_ALLOC(interp, ptr) \ + TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr)) +#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) +#else +#define TCLNR_ALLOC(interp, ptr) \ + (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr)) +#endif + +#if NRE_ENABLE_ASSERTS +#define NRE_ASSERT(expr) assert((expr)) +#else +#define NRE_ASSERT(expr) #endif -#include "tclPort.h" #include "tclIntDecls.h" #include "tclIntPlatDecls.h" #include "tclTomMathDecls.h" +#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) +#define Tcl_AttemptAlloc(size) TclpAlloc(size) +#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) +#define Tcl_Free(ptr) TclpFree(ptr) +#endif + #endif /* _TCLINT */ /* |