diff options
Diffstat (limited to 'generic/tclInt.h')
| -rw-r--r-- | generic/tclInt.h | 1102 |
1 files changed, 895 insertions, 207 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h index 854404f..ebc8bef 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -9,6 +9,8 @@ * 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. @@ -200,6 +202,14 @@ typedef struct TclVarHashTable { #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. @@ -223,8 +233,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. */ @@ -309,6 +326,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; /* @@ -347,13 +370,17 @@ 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_SUPPRESS_COMPILATION 0x08 /* * Flags passed to TclGetNamespaceForQualName: @@ -389,10 +416,91 @@ typedef struct { } EnsembleCmdRep; /* - * Flag to enable bytecode compilation of an ensemble. + * 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_COMPILE 0x4 +#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. */ /* *---------------------------------------------------------------- @@ -774,6 +882,9 @@ typedef struct VarInHash { #define TclIsVarDirectWritable(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) @@ -841,7 +952,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 @@ -888,7 +999,7 @@ typedef struct Proc { * of a procedure (or lambda term or ...). */ -typedef void (*ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj); +typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj); /* * The structure below defines a command trace. This is used to allow Tcl @@ -1039,10 +1150,20 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; + struct NRE_callback *tailcallPtr; + /* NULL if no tailcall is scheduled */ } CallFrame; #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 @@ -1122,6 +1243,13 @@ typedef struct CmdFrame { } str; Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list. */ } cmd; + int numLevels; /* Value of interp's numLevels when the frame + * was pushed. */ + 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 { @@ -1138,6 +1266,9 @@ typedef struct CFWordBC { 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; /* @@ -1205,10 +1336,10 @@ typedef struct ContLineLoc { * by [info frame]. Contains a sub-structure for each extra field. */ -typedef Tcl_Obj *(*GetFrameInfoValueProc)(ClientData clientData); +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 + 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 @@ -1327,12 +1458,48 @@ typedef struct ExecStack { * 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 { ExecStack *execStackPtr; /* Points to the first item in the evaluation * stack on the heap. */ 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 @@ -1430,6 +1597,10 @@ 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; /* @@ -1522,6 +1693,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; /* @@ -1597,6 +1769,24 @@ enum PkgPreferOptions { /* *---------------------------------------------------------------- + * 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 * variable storage. Primary responsibility for this data structure is in @@ -1634,7 +1824,7 @@ 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; + 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 @@ -1928,23 +2118,55 @@ typedef struct Interp { * They are used by the macros defined below. */ - void *allocCache; + 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 */ - int *stackBound; /* Pointer to the limit stack address - * allowable for invoking a new command - * without "risking" a C-stack overflow; see - * TclpCheckStackSpace in the platform's - * directory. */ + /* + * 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. + * operation. This should be the last field of Interp. */ ByteCodeStats stats; /* Holds compilation and execution statistics @@ -1960,6 +2182,22 @@ typedef struct Interp { *((iPtr)->asyncReadyPtr) /* + * Macros for script cancellation support (TIP #285). + */ + +#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)) + +/* * General list of interpreters. Doubly linked for easier removal of items * deep in the list. */ @@ -2008,6 +2246,7 @@ typedef struct InterpList { #define TCL_ALLOW_EXCEPTIONS 4 #define TCL_EVAL_FILE 2 #define TCL_EVAL_CTX 8 +#define TCL_EVAL_REDIRECT 16 /* * Flag bits for Interp structures: @@ -2040,6 +2279,16 @@ 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) @@ -2055,6 +2304,7 @@ typedef struct InterpList { #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 @@ -2193,6 +2443,8 @@ typedef struct 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. @@ -2349,10 +2601,10 @@ typedef enum Tcl_PathPart { *---------------------------------------------------------------- */ -typedef int (TclStatProc_)(CONST char *path, struct stat *buf); -typedef int (TclAccessProc_)(CONST char *path, int mode); +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); + const char *fileName, const char *modeString, int permissions); /* *---------------------------------------------------------------- @@ -2417,6 +2669,8 @@ typedef struct ProcessGlobalValue { * prefixes. */ #define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ +#define TCL_PARSE_BINARY_ONLY 64 + /* Parse binary even without prefix. */ /* *---------------------------------------------------------------------- @@ -2440,7 +2694,7 @@ 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; /* * TIP #233 (Virtualized Time) @@ -2455,32 +2709,33 @@ 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 tclEnsembleCmdType; +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 NO_WIDE_TYPE -MODULE_SCOPE Tcl_ObjType tclWideIntType; +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 @@ -2505,6 +2760,73 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; MODULE_SCOPE char * tclEmptyStringRep; 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 TclNRUplevelObjCmd; +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 TclNRSourceObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; + +MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; +MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; + +MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, + struct NRE_callback *tailcallPtr); + +/* + * 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 @@ -2537,55 +2859,62 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ -MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc); -MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, +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 TclPushTailcallPoint(Tcl_Interp *interp); +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 TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj, - CmdFrame **cfPtrPtr, int *wordPtr); -MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, - Tcl_Obj* objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int pc); -MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, +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, int pc); + void *codePtr, CmdFrame *cfPtr, 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 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(mp_int *a); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); +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 ContLineLoc* TclContinuationsEnter(Tcl_Obj *objPtr, int num, +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 ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); -MODULE_SCOPE int TclConvertElement(CONST char *src, int length, +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 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[]); + 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, @@ -2595,6 +2924,7 @@ MODULE_SCOPE void TclFinalizeAsync(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); @@ -2609,16 +2939,20 @@ MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadData(void); MODULE_SCOPE void TclFinalizeThreadObjects(void); -MODULE_SCOPE double TclFloor(mp_int *a); +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); +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 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); @@ -2636,6 +2970,8 @@ 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[]); @@ -2668,12 +3004,6 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, 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 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, @@ -2681,12 +3011,13 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, 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 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, int *codePtr, int *levelPtr); -MODULE_SCOPE int TclNokia770Doubles(); +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); @@ -2707,20 +3038,22 @@ MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); -#ifndef TCL_NO_STACK_CHECK -MODULE_SCOPE int TclpGetCStackParams(int **stackBoundPtr); -#endif MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); +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 void TclpInitLibraryPath(char **valuePtr, @@ -2741,7 +3074,7 @@ 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); @@ -2755,31 +3088,26 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; 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); -#ifndef TclpPanic -MODULE_SCOPE void TclpPanic(const char *format, ...); -#endif MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); -#ifndef TclpReleaseFile -MODULE_SCOPE void TclpReleaseFile(TclFile file); -#endif 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 size_t 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, +MODULE_SCOPE int TclScanElement(const char *string, int length, int *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -2787,6 +3115,7 @@ MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); 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); @@ -2797,19 +3126,23 @@ MODULE_SCOPE int TclStringMatch(const char *str, int strLen, 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, int line, - int *clNextOuter, CONST char *outerScript); -MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result, - Tcl_Interp *targetInterp); + 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 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 int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); @@ -2821,13 +3154,20 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, Tcl_FSUnloadFileProc **unloadProcPtr); #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); /* *---------------------------------------------------------------- @@ -2844,12 +3184,8 @@ MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ArrayObjCmd(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[]); +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[]); @@ -2869,6 +3205,10 @@ MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, 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, @@ -2892,6 +3232,15 @@ MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); 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[]); + MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -2922,9 +3271,8 @@ MODULE_SCOPE int Tcl_FconfigureObjCmd( 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[]); +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[]); @@ -3004,7 +3352,8 @@ MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_NamespaceObjCmd(ClientData clientData, +MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); +MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, @@ -3016,6 +3365,7 @@ MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, 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[]); @@ -3034,6 +3384,9 @@ MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, 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[]); @@ -3065,12 +3418,17 @@ MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, 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[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, 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[]); @@ -3138,6 +3496,9 @@ MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp, 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, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3177,7 +3538,7 @@ MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileNamespaceCmd(Tcl_Interp *interp, +MODULE_SCOPE int TclCompileNamespaceUpvarCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, @@ -3207,9 +3568,21 @@ MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileStringMatchCmd(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, 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); @@ -3358,6 +3731,10 @@ MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, 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 @@ -3387,6 +3764,10 @@ MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, 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); /* @@ -3431,7 +3812,10 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); */ #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 */ @@ -3449,6 +3833,12 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); # 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(); \ @@ -3491,10 +3881,10 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); * track memory leaks. */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorageEx(interp, objPtr) \ (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorageEx(interp, objPtr) \ ckfree((char *) (objPtr)) #undef USE_THREAD_ALLOC @@ -3514,11 +3904,43 @@ MODULE_SCOPE void TclpSetAllocCache(void *); MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclpFreeAllocCache(void *); -# define TclAllocObjStorage(objPtr) \ - (objPtr) = TclThreadAllocObj() - -# define TclFreeObjStorage(objPtr) \ - TclThreadFreeObj((objPtr)) +/* + * 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 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.otherValuePtr; \ + --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.otherValuePtr = cachePtr->firstObjPtr; \ + cachePtr->firstObjPtr = objPtr; \ + ++cachePtr->numObjects; \ + } \ + } while (0) #else /* not PURIFY or USE_THREAD_ALLOC */ @@ -3534,32 +3956,39 @@ MODULE_SCOPE void TclpFreeAllocCache(void *); 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); \ +# define TclAllocObjStorageEx(interp, objPtr) \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ + if (tclFreeObjList == NULL) { \ + TclAllocateFreeObjects(); \ + } \ + (objPtr) = tclFreeObjList; \ + tclFreeObjList = (Tcl_Obj *) \ + tclFreeObjList->internalRep.otherValuePtr; \ + Tcl_MutexUnlock(&tclObjMutex); \ + } while (0) + +# define TclFreeObjStorageEx(interp, objPtr) \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex) + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ + } while (0) #endif #else /* TCL_MEM_DEBUG */ -MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, +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), (file), (line)); \ - TCL_DTRACE_OBJ_CREATE(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__); @@ -3594,8 +4023,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, (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); \ } @@ -3631,9 +4059,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, */ #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; \ } /* @@ -3667,43 +4097,57 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, *---------------------------------------------------------------- */ +/* 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 TCL_MIN_TOKEN_GROWTH 50 #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ -{ \ - 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; \ + do { \ + int needed = (used) + (append); \ + if (needed > TCL_MAX_TOKENS) { \ + Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \ + 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 (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 *) ckrealloc((char *) oldPtr, \ + 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; \ } \ - (available) = allocated; \ - if (oldPtr == NULL) { \ - memcpy((VOID *) newPtr, (VOID *) staticPtr, \ - (size_t) ((used) * sizeof(Tcl_Token))); \ - } \ - (tokenPtr) = newPtr; \ - } \ -} + } while (0) #define TclGrowParseTokenArray(parsePtr, append) \ TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \ @@ -3729,6 +4173,48 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, /* *---------------------------------------------------------------- + * 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 @@ -3770,7 +4256,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file, *---------------------------------------------------------------------- */ -MODULE_SCOPE int TclTommath_Init(Tcl_Interp *interp); +MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init; MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal); MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal); @@ -3778,6 +4264,22 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal); /* + *---------------------------------------------------------------------- + * + * External (platform specific) initialization routine, these declarations + * explicitly don't use EXTERN since this code does not get compiled into the + * library: + * + *---------------------------------------------------------------------- + */ + +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 check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: @@ -3786,7 +4288,8 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, *---------------------------------------------------------------- */ -#define TclMatchIsTrivial(pattern) strpbrk((pattern), "*[?\\") == NULL +#define TclMatchIsTrivial(pattern) \ + (strpbrk((pattern), "*[?\\") == NULL) /* *---------------------------------------------------------------- @@ -3804,10 +4307,12 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, */ #define TclSetIntObj(objPtr, i) \ - TclInvalidateStringRep(objPtr);\ - TclFreeIntRep(objPtr); \ - (objPtr)->internalRep.longValue = (long)(i); \ - (objPtr)->typePtr = &tclIntType + do { \ + TclInvalidateStringRep(objPtr); \ + TclFreeIntRep(objPtr); \ + (objPtr)->internalRep.longValue = (long)(i); \ + (objPtr)->typePtr = &tclIntType; \ + } while (0) #define TclSetLongObj(objPtr, l) \ TclSetIntObj((objPtr), (l)) @@ -3824,17 +4329,21 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #ifndef NO_WIDE_TYPE #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) /* *---------------------------------------------------------------- @@ -3855,13 +4364,15 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #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; \ - TCL_DTRACE_OBJ_CREATE(objPtr) + 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 TclNewLongObj(objPtr, l) \ TclNewIntObj((objPtr), (l)) @@ -3874,21 +4385,25 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, TclNewIntObj((objPtr), ((b)? 1 : 0)) #define TclNewDoubleObj(objPtr, d) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr) + 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) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len));\ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr) + 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) \ @@ -3992,11 +4507,184 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, ((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) + +#define TclNRDeferCallback(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 = ((Interp *)interp)->deferredCallbacks; \ + ((Interp *)interp)->deferredCallbacks = callbackPtr; \ + } while (0) + +#define TclNRSpliceCallbacks(interp, topPtr) \ + do { \ + NRE_callback *bottomPtr = topPtr; \ + while (bottomPtr->nextPtr) { \ + bottomPtr = bottomPtr->nextPtr; \ + } \ + bottomPtr->nextPtr = TOP_CB(interp); \ + TOP_CB(interp) = topPtr; \ + } while (0) + +#define TclNRSpliceDeferred(interp) \ + if (((Interp *)interp)->deferredCallbacks) { \ + TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \ + ((Interp *)interp)->deferredCallbacks = NULL; \ + } + +#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 "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 */ /* |