summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclBasic.c646
-rw-r--r--generic/tclCompCmds.c19
-rw-r--r--generic/tclIOCmd.c90
-rw-r--r--generic/tclInt.h19
-rw-r--r--generic/tclNamesp.c3
-rw-r--r--library/init.tcl27
7 files changed, 431 insertions, 387 deletions
diff --git a/ChangeLog b/ChangeLog
index c1982b0..68f6187 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2007-12-06 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Simplify the setting up of
+ * generic/tclIOCmd.c (TclInitChanCmd): the [chan] ensemble. This
+ * library/init.tcl: gets rid of quite a bit of
+ code and makes it possible to understand the whole with less effort.
+
+ * generic/tclCompCmds.c (TclCompileEnsemble): Ensure that the right
+ number of tokens are copied. [Bug 1845320]
+
+ * generic/tclNamesp.c (TclMakeEnsemble): Added missing release of a
+ DString. [Bug 1845397]
+
2007-12-05 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclIO.h: Create Tcl_Obj for Tcl channels to reduce
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a866f66..57be158 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.244.2.18 2007/11/28 20:30:23 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.244.2.19 2007/12/06 16:27:44 dgp Exp $
*/
#include "tclInt.h"
@@ -51,7 +51,7 @@ typedef struct OldMathFuncData {
*/
static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
- const char *oldName, const char* newName, int flags);
+ const char *oldName, const char *newName, int flags);
static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void DeleteInterpProc(Tcl_Interp *interp);
static void DeleteOpCmdClientData(ClientData clientData);
@@ -91,9 +91,8 @@ static int ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *const *objv);
static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *const *objv);
-static void MathFuncWrongNumArgs(Tcl_Interp* interp, int expected,
+static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
-
#ifdef USE_DTRACE
static int DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -102,7 +101,7 @@ static int DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
extern TclStubs tclStubs;
/*
- * The following structures define the commands in the Tcl core.
+ * The following structure define the commands in the Tcl core.
*/
typedef struct {
@@ -113,14 +112,6 @@ typedef struct {
* safe interpreter. Otherwise it will be
* hidden. */
} CmdInfo;
-typedef struct {
- const char *name; /* Name of object-based command. */
- const char *name2; /* Name of secondary object-based command. */
- Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
- int isSafe; /* If non-zero, command will be present in
- * safe interpreter. Otherwise it will be
- * hidden. */
-} CmdInfo2;
/*
* The built-in commands, and the functions that implement them:
@@ -136,14 +127,14 @@ static const CmdInfo builtInCmds[] = {
{"array", Tcl_ArrayObjCmd, NULL, 1},
{"binary", Tcl_BinaryObjCmd, NULL, 1},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, 1},
+#ifndef EXCLUDE_OBSOLETE_COMMANDS
{"case", Tcl_CaseObjCmd, NULL, 1},
+#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, 1},
{"concat", Tcl_ConcatObjCmd, NULL, 1},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, 1},
- {"encoding", Tcl_EncodingObjCmd, NULL, 0},
{"error", Tcl_ErrorObjCmd, NULL, 1},
{"eval", Tcl_EvalObjCmd, NULL, 1},
- {"exit", Tcl_ExitObjCmd, NULL, 0},
{"expr", Tcl_ExprObjCmd, TclCompileExprCmd, 1},
{"for", Tcl_ForObjCmd, TclCompileForCmd, 1},
{"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, 1},
@@ -158,7 +149,6 @@ static const CmdInfo builtInCmds[] = {
{"linsert", Tcl_LinsertObjCmd, NULL, 1},
{"list", Tcl_ListObjCmd, TclCompileListCmd, 1},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, 1},
- {"load", Tcl_LoadObjCmd, NULL, 0},
{"lrange", Tcl_LrangeObjCmd, NULL, 1},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, 1},
{"lreplace", Tcl_LreplaceObjCmd, NULL, 1},
@@ -179,7 +169,6 @@ static const CmdInfo builtInCmds[] = {
{"subst", Tcl_SubstObjCmd, NULL, 1},
{"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, 1},
{"trace", Tcl_TraceObjCmd, NULL, 1},
- {"unload", Tcl_UnloadObjCmd, NULL, 1},
{"unset", Tcl_UnsetObjCmd, NULL, 1},
{"uplevel", Tcl_UplevelObjCmd, NULL, 1},
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, 1},
@@ -187,43 +176,43 @@ static const CmdInfo builtInCmds[] = {
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, 1},
/*
- * Commands in the UNIX core:
+ * Commands in the OS-interface. Note that many of these are unsafe.
*/
{"after", Tcl_AfterObjCmd, NULL, 1},
{"cd", Tcl_CdObjCmd, NULL, 0},
+ {"close", Tcl_CloseObjCmd, NULL, 1},
+ {"eof", Tcl_EofObjCmd, NULL, 1},
+ {"encoding", Tcl_EncodingObjCmd, NULL, 0},
+ {"exec", Tcl_ExecObjCmd, NULL, 0},
+ {"exit", Tcl_ExitObjCmd, NULL, 0},
+ {"fblocked", Tcl_FblockedObjCmd, NULL, 1},
+ {"fconfigure", Tcl_FconfigureObjCmd, NULL, 0},
+ {"fcopy", Tcl_FcopyObjCmd, NULL, 1},
{"file", Tcl_FileObjCmd, NULL, 0},
+ {"fileevent", Tcl_FileEventObjCmd, NULL, 1},
+ {"flush", Tcl_FlushObjCmd, NULL, 1},
+ {"gets", Tcl_GetsObjCmd, NULL, 1},
{"glob", Tcl_GlobObjCmd, NULL, 0},
+ {"load", Tcl_LoadObjCmd, NULL, 0},
{"open", Tcl_OpenObjCmd, NULL, 0},
{"pid", Tcl_PidObjCmd, NULL, 1},
+ {"puts", Tcl_PutsObjCmd, NULL, 1},
{"pwd", Tcl_PwdObjCmd, NULL, 0},
+ {"read", Tcl_ReadObjCmd, NULL, 1},
+ {"seek", Tcl_SeekObjCmd, NULL, 1},
{"socket", Tcl_SocketObjCmd, NULL, 0},
+ {"source", Tcl_SourceObjCmd, NULL, 0},
+ {"tell", Tcl_TellObjCmd, NULL, 1},
{"time", Tcl_TimeObjCmd, NULL, 1},
+ {"unload", Tcl_UnloadObjCmd, NULL, 1},
{"update", Tcl_UpdateObjCmd, NULL, 1},
{"vwait", Tcl_VwaitObjCmd, NULL, 1},
- {"exec", Tcl_ExecObjCmd, NULL, 0},
- {"source", Tcl_SourceObjCmd, NULL, 0},
{NULL, NULL, NULL, 0}
};
-static const CmdInfo2 builtInCmds2[] = {
- {"fileevent", "::tcl::chan::event", Tcl_FileEventObjCmd, 1},
- {"fcopy", "::tcl::chan::copy", Tcl_FcopyObjCmd, 1},
- {"close", "::tcl::chan::close", Tcl_CloseObjCmd, 1},
- {"eof", "::tcl::chan::eof", Tcl_EofObjCmd, 1},
- {"fblocked", "::tcl::chan::blocked", Tcl_FblockedObjCmd, 1},
- {"fconfigure", "::tcl::chan::configure", Tcl_FconfigureObjCmd, 0},
- {"flush", "::tcl::chan::flush", Tcl_FlushObjCmd, 1},
- {"gets", "::tcl::chan::gets", Tcl_GetsObjCmd, 1},
- {"puts", "::tcl::chan::puts", Tcl_PutsObjCmd, 1},
- {"read", "::tcl::chan::read", Tcl_ReadObjCmd, 1},
- {"seek", "::tcl::chan::seek", Tcl_SeekObjCmd, 1},
- {"tell", "::tcl::chan::tell", Tcl_TellObjCmd, 1},
- {NULL, NULL, 0}
-};
-
/*
- * Math functions
+ * Math functions. All are safe.
*/
typedef struct {
@@ -266,7 +255,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
};
/*
- * TIP#174's math operators.
+ * TIP#174's math operators. All are safe.
*/
typedef struct {
@@ -280,85 +269,97 @@ typedef struct {
const char *expected; /* For error message, what argument(s)
* were expected. */
} OpCmdInfo;
-
static const OpCmdInfo mathOpCmds[] = {
{ "~", TclSingleOpCmd, TclCompileInvertOpCmd,
- /* numArgs */ {1}, "integer" },
+ /* numArgs */ {1}, "integer"},
{ "!", TclSingleOpCmd, TclCompileNotOpCmd,
- /* numArgs */ {1}, "boolean" },
+ /* numArgs */ {1}, "boolean"},
{ "+", TclVariadicOpCmd, TclCompileAddOpCmd,
- /* identity */ {0}, NULL },
+ /* identity */ {0}, NULL},
{ "*", TclVariadicOpCmd, TclCompileMulOpCmd,
- /* identity */ {1}, NULL },
+ /* identity */ {1}, NULL},
{ "&", TclVariadicOpCmd, TclCompileAndOpCmd,
- /* identity */ {-1}, NULL },
+ /* identity */ {-1}, NULL},
{ "|", TclVariadicOpCmd, TclCompileOrOpCmd,
- /* identity */ {0}, NULL },
+ /* identity */ {0}, NULL},
{ "^", TclVariadicOpCmd, TclCompileXorOpCmd,
- /* identity */ {0}, NULL },
+ /* identity */ {0}, NULL},
{ "**", TclVariadicOpCmd, TclCompilePowOpCmd,
- /* identity */ {1}, NULL },
+ /* identity */ {1}, NULL},
{ "<<", TclSingleOpCmd, TclCompileLshiftOpCmd,
- /* numArgs */ {2}, "integer shift" },
+ /* numArgs */ {2}, "integer shift"},
{ ">>", TclSingleOpCmd, TclCompileRshiftOpCmd,
- /* numArgs */ {2}, "integer shift" },
+ /* numArgs */ {2}, "integer shift"},
{ "%", TclSingleOpCmd, TclCompileModOpCmd,
- /* numArgs */ {2}, "integer integer" },
+ /* numArgs */ {2}, "integer integer"},
{ "!=", TclSingleOpCmd, TclCompileNeqOpCmd,
/* numArgs */ {2}, "value value"},
{ "ne", TclSingleOpCmd, TclCompileStrneqOpCmd,
- /* numArgs */ {2}, "value value" },
+ /* numArgs */ {2}, "value value"},
{ "in", TclSingleOpCmd, TclCompileInOpCmd,
/* numArgs */ {2}, "value list"},
{ "ni", TclSingleOpCmd, TclCompileNiOpCmd,
/* numArgs */ {2}, "value list"},
{ "-", TclNoIdentOpCmd, TclCompileMinusOpCmd,
- /* unused */ {0}, "value ?value ...?"},
+ /* unused */ {0}, "value ?value ...?"},
{ "/", TclNoIdentOpCmd, TclCompileDivOpCmd,
- /* unused */ {0}, "value ?value ...?"},
+ /* unused */ {0}, "value ?value ...?"},
{ "<", TclSortingOpCmd, TclCompileLessOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ "<=", TclSortingOpCmd, TclCompileLeqOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ ">", TclSortingOpCmd, TclCompileGreaterOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ ">=", TclSortingOpCmd, TclCompileGeqOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ "==", TclSortingOpCmd, TclCompileEqOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ "eq", TclSortingOpCmd, TclCompileStreqOpCmd,
- /* unused */ {0}, NULL },
+ /* unused */ {0}, NULL},
{ NULL, NULL, NULL,
- {0}, NULL }
+ {0}, NULL}
};
-#ifdef TCL_NO_STACK_CHECK
-/* stack check disabled: make them noops */
-#define CheckCStack(interp, localIntPtr) 1
-#define GetCStackParams(iPtr)
-#else /* TCL_NO_STACK_CHECK */
-#ifdef TCL_CROSS_COMPILE
+/*
+ * Macros for stack checks. The goal of these macros is to allow the size of
+ * the stack to be checked (so preventing overflow) in a *cheap* way. Note
+ * that the check needs to be (amortized) cheap since it is on the critical
+ * path for recursion.
+ */
+
+#if defined(TCL_NO_STACK_CHECK)
+/*
+ * Stack check disabled: make them noops.
+ */
+
+# define CheckCStack(interp, localIntPtr) 1
+# define GetCStackParams(iPtr) /* do nothing */
+#elif defined(TCL_CROSS_COMPILE)
+
+/*
+ * This variable is static and only set *once*, during library initialization.
+ * It therefore needs no thread guards.
+ */
+
static int stackGrowsDown = 1;
-#define GetCStackParams(iPtr) \
+# define GetCStackParams(iPtr) \
stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
-#define CheckCStack(iPtr, localIntPtr) \
+# define CheckCStack(iPtr, localIntPtr) \
(stackGrowsDown \
? ((localIntPtr) > (iPtr)->stackBound) \
: ((localIntPtr) < (iPtr)->stackBound) \
)
-#else /* TCL_CROSS_COMPILE */
-#define GetCStackParams(iPtr) \
+#else /* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
+# define GetCStackParams(iPtr) \
TclpGetCStackParams(&((iPtr)->stackBound))
-#ifdef TCL_STACK_GROWS_UP
-#define CheckCStack(iPtr, localIntPtr) \
+# ifdef TCL_STACK_GROWS_UP
+# define CheckCStack(iPtr, localIntPtr) \
(!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
-#else /* TCL_STACK_GROWS_UP */
-#define CheckCStack(iPtr, localIntPtr) \
+# else /* TCL_STACK_GROWS_UP */
+# define CheckCStack(iPtr, localIntPtr) \
((localIntPtr) > (iPtr)->stackBound)
-#endif /* TCL_STACK_GROWS_UP */
-#endif /* TCL_CROSS_COMPILE */
-#endif /* TCL_NO_STACK_CHECK */
-
+# endif /* TCL_STACK_GROWS_UP */
+#endif /* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */
/*
*----------------------------------------------------------------------
@@ -387,7 +388,6 @@ Tcl_CreateInterp(void)
const BuiltinFuncDef *builtinFuncPtr;
const OpCmdInfo *opcmdInfoPtr;
const CmdInfo *cmdInfoPtr;
- const CmdInfo2 *cmdInfo2Ptr;
Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
union {
char c[sizeof(short)];
@@ -489,8 +489,9 @@ Tcl_CreateInterp(void)
iPtr->activeCmdTracePtr = NULL;
iPtr->activeInterpTracePtr = NULL;
iPtr->assocData = NULL;
- iPtr->execEnvPtr = NULL; /* Set after namespaces initialized */
- iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object */
+ iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */
+ iPtr->emptyObjPtr = Tcl_NewObj();
+ /* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
iPtr->resultSpace[0] = 0;
iPtr->threadId = Tcl_GetCurrentThread();
@@ -504,9 +505,9 @@ Tcl_CreateInterp(void)
Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);
- iPtr->globalNsPtr = NULL; /* Force creation of global ns below */
+ iPtr->globalNsPtr = NULL; /* Force creation of global ns below. */
iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
- (ClientData) NULL, NULL);
+ NULL, NULL);
if (iPtr->globalNsPtr == NULL) {
Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
}
@@ -611,9 +612,9 @@ Tcl_CreateInterp(void)
/*
* Insure that the stack checking mechanism for this interp is
- * initialized.
+ * initialized.
*/
-
+
GetCStackParams(iPtr);
/*
@@ -646,11 +647,11 @@ Tcl_CreateInterp(void)
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = cmdInfoPtr->compileProc;
cmdPtr->proc = TclInvokeObjectCommand;
- cmdPtr->clientData = (ClientData) cmdPtr;
+ cmdPtr->clientData = cmdPtr;
cmdPtr->objProc = cmdInfoPtr->objProc;
- cmdPtr->objClientData = (ClientData) NULL;
+ cmdPtr->objClientData = NULL;
cmdPtr->deleteProc = NULL;
- cmdPtr->deleteData = (ClientData) NULL;
+ cmdPtr->deleteData = NULL;
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
@@ -659,42 +660,24 @@ Tcl_CreateInterp(void)
}
/*
- * Create the "dict", "info" and "string" ensembles.
+ * Create the "chan", "dict", "info" and "string" ensembles. Note that all
+ * these commands (and their subcommands that are not present in the
+ * global namespace) are wholly safe.
*/
+ TclInitChanCmd(interp);
TclInitDictCmd(interp);
TclInitInfoCmd(interp);
TclInitStringCmd(interp);
/*
- * Register "clock" and "chan" subcommands. These *do* go through
+ * Register "clock" subcommands. These *do* go through
* Tcl_CreateObjCommand, since they aren't in the global namespace and
* involve ensembles.
*/
TclClockInit(interp);
- for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
- Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->objProc,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->objProc,
- NULL, NULL);
- }
-
- /* TIP #208 */
- Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
- TclChanTruncateObjCmd, NULL, NULL);
-
- /* TIP #219 */
- Tcl_CreateObjCommand(interp, "::tcl::chan::rCreate",
- TclChanCreateObjCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
- TclChanPostEventObjCmd, NULL, NULL);
-
- /* TIP #287 */
- Tcl_CreateObjCommand(interp, "::tcl::chan::Pending",
- TclChanPendingObjCmd, NULL, NULL);
-
/*
* Register the built-in functions. This is empty now that they are
* implemented as commands in the ::tcl::mathfunc namespace.
@@ -726,7 +709,7 @@ Tcl_CreateInterp(void)
* Register the builtin math functions.
*/
- mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL);
+ mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
if (mathfuncNSPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
@@ -751,18 +734,19 @@ Tcl_CreateInterp(void)
}
(void) Tcl_Export(interp, mathopNSPtr, "*", 1);
strcpy(mathFuncName, "::tcl::mathop::");
- for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++) {
+ for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
ckalloc(sizeof(TclOpCmdClientData));
+
occdPtr->operator = opcmdInfoPtr->name;
occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
occdPtr->expected = opcmdInfoPtr->expected;
strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
- opcmdInfoPtr->objProc, (ClientData) occdPtr,
- DeleteOpCmdClientData);
+ opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
if (cmdPtr == NULL) {
- Tcl_Panic("failed to create math operator %s", opcmdInfoPtr->name);
+ Tcl_Panic("failed to create math operator %s",
+ opcmdInfoPtr->name);
} else if (opcmdInfoPtr->compileProc != NULL) {
cmdPtr->compileProc = opcmdInfoPtr->compileProc;
}
@@ -776,8 +760,7 @@ Tcl_CreateInterp(void)
TclSetupEnv(interp);
/*
- * TIP #59: Make embedded configuration information
- * available.
+ * TIP #59: Make embedded configuration information available.
*/
TclInitEmbeddedConfigurationInformation(interp);
@@ -796,7 +779,7 @@ Tcl_CreateInterp(void)
/* TIP #291 */
Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
- Tcl_NewLongObj((long) sizeof(void*)), TCL_GLOBAL_ONLY);
+ Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
/*
* Set up other variables such as tcl_version and tcl_library
@@ -825,7 +808,7 @@ Tcl_CreateInterp(void)
* TIP #268: Full patchlevel instead of just major.minor
*/
- Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, (ClientData) &tclStubs);
+ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
#ifdef Tcl_InitStubs
#undef Tcl_InitStubs
@@ -843,8 +826,9 @@ static void
DeleteOpCmdClientData(
ClientData clientData)
{
- TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) clientData;
- ckfree((char *)occdPtr);
+ TclOpCmdClientData *occdPtr = clientData;
+
+ ckfree((char *) occdPtr);
}
/*
@@ -868,7 +852,6 @@ TclHideUnsafeCommands(
Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
- register const CmdInfo2 *cmdInfo2Ptr;
if (interp == NULL) {
return TCL_ERROR;
@@ -878,12 +861,6 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
- for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
- if (!cmdInfo2Ptr->isSafe) {
- Tcl_HideCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->name);
- Tcl_HideCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->name2);
- }
- }
return TCL_OK;
}
@@ -1022,7 +999,7 @@ Tcl_SetAssocData(
}
hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
if (isNew == 0) {
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
} else {
dPtr = (AssocData *) ckalloc(sizeof(AssocData));
}
@@ -1065,9 +1042,9 @@ Tcl_DeleteAssocData(
if (hPtr == NULL) {
return;
}
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
if (dPtr->proc != NULL) {
- (dPtr->proc)(dPtr->clientData, interp);
+ dPtr->proc(dPtr->clientData, interp);
}
ckfree((char *) dPtr);
Tcl_DeleteHashEntry(hPtr);
@@ -1104,13 +1081,13 @@ Tcl_GetAssocData(
Tcl_HashEntry *hPtr;
if (iPtr->assocData == NULL) {
- return (ClientData) NULL;
+ return NULL;
}
hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
if (hPtr == NULL) {
- return (ClientData) NULL;
+ return NULL;
}
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
if (procPtr != NULL) {
*procPtr = dPtr->proc;
}
@@ -1191,7 +1168,7 @@ Tcl_DeleteInterp(
* Ensure that the interpreter is eventually deleted.
*/
- Tcl_EventuallyFree((ClientData) interp, (Tcl_FreeProc *) DeleteInterpProc);
+ Tcl_EventuallyFree(interp, (Tcl_FreeProc *) DeleteInterpProc);
}
/*
@@ -1307,10 +1284,10 @@ DeleteInterpProc(
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (dPtr->proc != NULL) {
- (*dPtr->proc)(dPtr->clientData, interp);
+ dPtr->proc(dPtr->clientData, interp);
}
ckfree((char *) dPtr);
}
@@ -1327,7 +1304,7 @@ DeleteInterpProc(
Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
}
Tcl_PopCallFrame(interp);
- ckfree((char *)iPtr->rootFramePtr);
+ ckfree((char *) iPtr->rootFramePtr);
iPtr->rootFramePtr = NULL;
Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
@@ -1359,7 +1336,7 @@ DeleteInterpProc(
}
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
- Tcl_DeleteTrace((Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr);
+ Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
}
if (iPtr->execEnvPtr != NULL) {
TclDeleteExecEnv(iPtr->execEnvPtr);
@@ -1395,7 +1372,7 @@ DeleteInterpProc(
for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
- CmdFrame *cfPtr = (CmdFrame*) Tcl_GetHashValue(hPtr);
+ CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
if (cfPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(cfPtr->data.eval.path);
@@ -1437,8 +1414,8 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(&iPtr->varTraces);
- Tcl_DeleteHashTable(&iPtr->varSearches);
-
+ Tcl_DeleteHashTable(&iPtr->varSearches);
+
ckfree((char *) iPtr);
}
@@ -1591,7 +1568,7 @@ Tcl_HideCommand(
*/
cmdPtr->hPtr = hPtr;
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ Tcl_SetHashValue(hPtr, cmdPtr);
/*
* If the command being hidden has a compile function, increment the
@@ -1675,7 +1652,7 @@ Tcl_ExposeCommand(
"\"", NULL);
return TCL_ERROR;
}
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
/*
* Check that we have a true global namespace command (enforced by
@@ -1739,7 +1716,7 @@ Tcl_ExposeCommand(
cmdPtr->hPtr = hPtr;
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ Tcl_SetHashValue(hPtr, cmdPtr);
/*
* Not needed as we are only in the global namespace (but would be needed
@@ -1844,7 +1821,7 @@ Tcl_CreateCommand(
* intact.
*/
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
oldRefPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = NULL;
@@ -1857,7 +1834,7 @@ Tcl_CreateCommand(
* stuck in an infinite loop).
*/
- ckfree((char*) Tcl_GetHashValue(hPtr));
+ ckfree((char *) Tcl_GetHashValue(hPtr));
}
} else {
/*
@@ -1877,7 +1854,7 @@ Tcl_CreateCommand(
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
cmdPtr->objProc = TclInvokeStringCommand;
- cmdPtr->objClientData = (ClientData) cmdPtr;
+ cmdPtr->objClientData = cmdPtr;
cmdPtr->proc = proc;
cmdPtr->clientData = clientData;
cmdPtr->deleteProc = deleteProc;
@@ -1895,7 +1872,7 @@ Tcl_CreateCommand(
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
- dataPtr = (ImportedCmdData *) refCmdPtr->objClientData;
+ dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -1994,7 +1971,7 @@ Tcl_CreateObjCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
/*
* Command already exists. If its object-based Tcl_ObjCmdProc is
@@ -2029,7 +2006,7 @@ Tcl_CreateObjCommand(
* stuck in an infinite loop).
*/
- ckfree((char *) Tcl_GetHashValue(hPtr));
+ ckfree(Tcl_GetHashValue(hPtr));
}
} else {
/*
@@ -2050,7 +2027,7 @@ Tcl_CreateObjCommand(
cmdPtr->objProc = proc;
cmdPtr->objClientData = clientData;
cmdPtr->proc = TclInvokeObjectCommand;
- cmdPtr->clientData = (ClientData) cmdPtr;
+ cmdPtr->clientData = cmdPtr;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
cmdPtr->flags = 0;
@@ -2066,7 +2043,7 @@ Tcl_CreateObjCommand(
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
- dataPtr = (ImportedCmdData *) refCmdPtr->objClientData;
+ dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -2111,7 +2088,7 @@ TclInvokeStringCommand(
register int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Command *cmdPtr = (Command *) clientData;
+ Command *cmdPtr = clientData;
int i, result;
const char **argv = (const char **)
TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
@@ -2127,7 +2104,7 @@ TclInvokeStringCommand(
result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
- TclStackFree(interp, (void *)argv);
+ TclStackFree(interp, (void *) argv);
return result;
}
@@ -2235,7 +2212,7 @@ TclRenameCommand(
Command *cmdPtr;
Tcl_HashEntry *hPtr, *oldHPtr;
int isNew, result;
- Tcl_Obj* oldFullName;
+ Tcl_Obj *oldFullName;
Tcl_DString newFullName;
/*
@@ -2303,7 +2280,7 @@ TclRenameCommand(
oldHPtr = cmdPtr->hPtr;
hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &isNew);
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = newNsPtr;
TclResetShadowedCmdRefs(interp, cmdPtr);
@@ -2463,7 +2440,7 @@ Tcl_SetCommandInfoFromToken(
cmdPtr->clientData = infoPtr->clientData;
if (infoPtr->objProc == NULL) {
cmdPtr->objProc = TclInvokeStringCommand;
- cmdPtr->objClientData = (ClientData) cmdPtr;
+ cmdPtr->objClientData = cmdPtr;
} else {
cmdPtr->objProc = infoPtr->objProc;
cmdPtr->objClientData = infoPtr->objClientData;
@@ -2771,7 +2748,7 @@ Tcl_DeleteCommandFromToken(
while (tracePtr != NULL) {
CommandTrace *nextPtr = tracePtr->nextPtr;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree((char *) tracePtr);
}
tracePtr = nextPtr;
}
@@ -2918,7 +2895,7 @@ CallCommandTraces(
}
active.cmdPtr = cmdPtr;
- Tcl_Preserve((ClientData) iPtr);
+ Tcl_Preserve(iPtr);
for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
tracePtr = active.nextTracePtr) {
@@ -2936,18 +2913,18 @@ CallCommandTraces(
}
tracePtr->refCount++;
if (state == NULL) {
- state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, TCL_OK);
+ state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
}
(*tracePtr->traceProc)(tracePtr->clientData,
(Tcl_Interp *) iPtr, oldName, newName, flags);
cmdPtr->flags &= ~tracePtr->flags;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree((char *) tracePtr);
}
}
if (state) {
- Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+ Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
}
/*
@@ -2966,7 +2943,7 @@ CallCommandTraces(
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
cmdPtr->refCount--;
iPtr->activeCmdTracePtr = active.nextPtr;
- Tcl_Release((ClientData) iPtr);
+ Tcl_Release(iPtr);
return result;
}
@@ -2976,8 +2953,8 @@ CallCommandTraces(
* GetCommandSource --
*
* This function returns a Tcl_Obj with the full source string for the
- * command. This insures that traces get a correct nul-terminated command
- * string.
+ * command. This insures that traces get a correct NUL-terminated command
+ * string.
*
*----------------------------------------------------------------------
*/
@@ -2986,24 +2963,18 @@ static Tcl_Obj *
GetCommandSource(
Interp *iPtr,
const char *command,
- int numChars,
+ int numChars,
int objc,
Tcl_Obj *const objv[])
{
- Tcl_Obj *commandPtr;
-
if (!command) {
- commandPtr = Tcl_NewListObj(objc, objv);
- } else {
- if (command == (char *) -1) {
- command = TclGetSrcInfoForCmd(iPtr, &numChars);
- }
- commandPtr = Tcl_NewStringObj(command, numChars);
+ return Tcl_NewListObj(objc, objv);
}
-
- return commandPtr;
+ if (command == (char *) -1) {
+ command = TclGetSrcInfoForCmd(iPtr, &numChars);
+ }
+ return Tcl_NewStringObj(command, numChars);
}
-
/*
*----------------------------------------------------------------------
@@ -3079,7 +3050,8 @@ Tcl_CreateMathFunc(
data->proc = proc;
data->numArgs = numArgs;
- data->argTypes = (Tcl_ValueType*) ckalloc(numArgs * sizeof(Tcl_ValueType));
+ data->argTypes = (Tcl_ValueType *)
+ ckalloc(numArgs * sizeof(Tcl_ValueType));
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
data->clientData = clientData;
@@ -3088,7 +3060,7 @@ Tcl_CreateMathFunc(
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
- OldMathFuncProc, (ClientData) data, OldMathFuncDeleteProc);
+ OldMathFuncProc, data, OldMathFuncDeleteProc);
Tcl_DStringFree(&bigName);
}
@@ -3256,6 +3228,7 @@ OldMathFuncDeleteProc(
ClientData clientData)
{
OldMathFuncData *dataPtr = clientData;
+
ckfree((void *) dataPtr->argTypes);
ckfree((void *) dataPtr);
}
@@ -3330,7 +3303,7 @@ Tcl_GetMathFuncInfo(
*/
if (cmdPtr->objProc == &OldMathFuncProc) {
- OldMathFuncData *dataPtr = (OldMathFuncData*) cmdPtr->clientData;
+ OldMathFuncData *dataPtr = cmdPtr->clientData;
*procPtr = dataPtr->proc;
*numArgsPtr = dataPtr->numArgs;
@@ -3376,29 +3349,32 @@ Tcl_ListMathFuncs(
Namespace *dummy2NsPtr;
const char *dummyNamePtr;
Tcl_Obj *result = Tcl_NewObj();
- Tcl_HashEntry *cmdHashEntry;
- Tcl_HashSearch cmdHashSearch;
- const char *cmdNamePtr;
TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
+ if (nsPtr == NULL) {
+ return result;
+ }
+
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(pattern, -1));
+ }
+ } else {
+ Tcl_HashSearch cmdHashSearch;
+ Tcl_HashEntry *cmdHashEntry =
+ Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
- if (nsPtr != NULL) {
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
+ for (; cmdHashEntry != NULL;
+ cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
+ const char *cmdNamePtr =
+ Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
+
+ if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(pattern, -1));
- }
- } else {
- cmdHashEntry = Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
- for (; cmdHashEntry != NULL;
- cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
- cmdNamePtr = Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
- if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(cmdNamePtr, -1));
- }
+ Tcl_NewStringObj(cmdNamePtr, -1));
}
}
}
@@ -3557,8 +3533,8 @@ TclEvalObjvInternal(
} else {
varFramePtr->nsPtr = iPtr->globalNsPtr;
}
- } else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)
- && !savedVarFramePtr) {
+ } else if ((flags & TCL_EVAL_GLOBAL)
+ && (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
varFramePtr = iPtr->rootFramePtr;
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = varFramePtr;
@@ -3584,7 +3560,7 @@ TclEvalObjvInternal(
/*
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
-
+
iPtr->ensembleRewrite.sourceObjs = NULL;
}
@@ -3604,7 +3580,7 @@ TclEvalObjvInternal(
commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
command = TclGetStringFromObj(commandPtr, &length);
-
+
/*
* Execute any command or execution traces. Note that we bump up the
* command's reference count for the duration of the calling of the
@@ -3650,7 +3626,7 @@ TclEvalObjvInternal(
if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
char *a[4]; int i[2];
-
+
TclDTraceInfo(info, a, i);
TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
TclDecrRefCount(info);
@@ -3662,7 +3638,8 @@ TclEvalObjvInternal(
cmdPtr->refCount++;
iPtr->cmdCount++;
- if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) {
+ if (code == TCL_OK && traceCode == TCL_OK
+ && !TclLimitExceeded(iPtr->limit)) {
if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
@@ -3686,7 +3663,7 @@ TclEvalObjvInternal(
if (traced) {
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
- if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+ if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
@@ -3697,11 +3674,11 @@ TclEvalObjvInternal(
}
/*
- * If one of the trace invocation resulted in error, then change the
+ * If one of the trace invocation resulted in error, then change the
* result code accordingly. Note, that the interp->result should
* already be set correctly by the call to TraceExecutionProc.
*/
-
+
if (traceCode != TCL_OK) {
code = traceCode;
}
@@ -3709,7 +3686,7 @@ TclEvalObjvInternal(
Tcl_DecrRefCount(commandPtr);
}
}
-
+
/*
* Decrement the reference count of cmdPtr and deallocate it if it has
* dropped to zero.
@@ -3732,7 +3709,7 @@ TclEvalObjvInternal(
Tcl_Obj *r;
r = Tcl_GetObjResult(interp);
- TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r), r);
+ TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
}
done:
@@ -3745,11 +3722,11 @@ TclEvalObjvInternal(
{
Namespace *currNsPtr = NULL; /* Used to check for and invoke any
* registered unknown command handler
- * for the current namespace
- * (TIP 181). */
+ * for the current namespace (TIP
+ * 181). */
int newObjc, handlerObjc;
Tcl_Obj **handlerObjv;
-
+
currNsPtr = varFramePtr->nsPtr;
if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
currNsPtr = iPtr->globalNsPtr;
@@ -3757,17 +3734,17 @@ TclEvalObjvInternal(
Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
}
}
-
+
/*
* Check to see if the resolution namespace has lost its unknown
* handler. If so, reset it to "::unknown".
*/
-
+
if (currNsPtr->unknownHandlerPtr == NULL) {
TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
}
-
+
/*
* Get the list of words for the unknown handler and allocate enough
* space to hold both the handler prefix and all words of the command
@@ -3869,12 +3846,12 @@ Tcl_EvalObjv(
return code;
} else {
int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-
+
/*
* If we are again at the top level, process any unusual return code
* returned by the evaluated code.
*/
-
+
if (iPtr->numLevels == 0) {
if (code == TCL_RETURN) {
code = TclUpdateReturnInfo(iPtr);
@@ -3884,24 +3861,24 @@ Tcl_EvalObjv(
code = TCL_ERROR;
}
}
-
+
if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
/*
* If there was an error, a command string will be needed for the
* error log: generate it now. Do not worry too much about doing
* it expensively.
*/
-
+
Tcl_Obj *listPtr;
char *cmdString;
int cmdLen;
-
+
listPtr = Tcl_NewListObj(objc, objv);
cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(listPtr);
}
-
+
return code;
}
}
@@ -4052,21 +4029,17 @@ TclEvalEx(
* state has been allocated while evaluating
* the script, so that it can be freed
* properly if an error occurs. */
-
- Tcl_Parse *parsePtr =
- (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
- CmdFrame *eeFramePtr =
- (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
- Tcl_Obj **stackObjArray =
- (Tcl_Obj **) TclStackAlloc(interp, minObjs*sizeof(Tcl_Obj *));
- int *expandStack =
- (int *) TclStackAlloc(interp, minObjs*sizeof(int));
- int *linesStack =
- (int *) TclStackAlloc(interp, minObjs*sizeof(int));
-
-
+ Tcl_Parse *parsePtr = (Tcl_Parse *)
+ TclStackAlloc(interp, sizeof(Tcl_Parse));
+ CmdFrame *eeFramePtr = (CmdFrame *)
+ TclStackAlloc(interp, sizeof(CmdFrame));
+ Tcl_Obj **stackObjArray = (Tcl_Obj **)
+ TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
+ int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
+ int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
/* TIP #280 Structures for tracking of command
* locations. */
+
if (numBytes < 0) {
numBytes = strlen(script);
}
@@ -4145,7 +4118,8 @@ TclEvalEx(
eeFramePtr->data.eval.path = NULL;
}
- eeFramePtr->level = (iPtr->cmdFramePtr==NULL? 1 : iPtr->cmdFramePtr->level+1);
+ eeFramePtr->level =
+ (iPtr->cmdFramePtr==NULL ? 1 : iPtr->cmdFramePtr->level+1);
eeFramePtr->framePtr = iPtr->framePtr;
eeFramePtr->nextPtr = iPtr->cmdFramePtr;
eeFramePtr->nline = 0;
@@ -4169,8 +4143,7 @@ TclEvalEx(
gotParse = 1;
if (parsePtr->numWords > 0) {
/*
- * TIP #280. Track lines within the words of the current
- * command.
+ * TIP #280. Track lines within the words of the current command.
*/
int wordLine = line;
@@ -4185,7 +4158,8 @@ TclEvalEx(
if (numWords > minObjs) {
expand = (int *) ckalloc(numWords * sizeof(int));
- objvSpace = (Tcl_Obj **) ckalloc(numWords * sizeof(Tcl_Obj *));
+ objvSpace = (Tcl_Obj **)
+ ckalloc(numWords * sizeof(Tcl_Obj *));
lineSpace = (int *) ckalloc(numWords * sizeof(int));
}
expandRequested = 0;
@@ -4194,7 +4168,7 @@ TclEvalEx(
for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
objectsUsed < numWords;
- objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
/*
* TIP #280. Track lines to current word. Save the information
* on a per-word basis, signaling dynamic words as needed.
@@ -4259,8 +4233,8 @@ TclEvalEx(
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
objv = objvSpace = (Tcl_Obj **)
- ckalloc(objectsNeeded * sizeof(Tcl_Obj*));
- lines = lineSpace = (int*)
+ ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
+ lines = lineSpace = (int *)
ckalloc(objectsNeeded * sizeof(int));
}
@@ -4308,7 +4282,8 @@ TclEvalEx(
eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
eeFramePtr->cmd.str.len = parsePtr->commandSize;
- if (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1) {
+ if (parsePtr->term ==
+ parsePtr->commandStart + parsePtr->commandSize - 1) {
eeFramePtr->cmd.str.len--;
}
@@ -4335,7 +4310,7 @@ TclEvalEx(
if (objvSpace != stackObjArray) {
ckfree((char *) objvSpace);
objvSpace = stackObjArray;
- ckfree ((char*) lineSpace);
+ ckfree((char *) lineSpace);
lineSpace = linesStack;
}
@@ -4372,6 +4347,7 @@ TclEvalEx(
/*
* Generate and log various pieces of error information.
*/
+
if (iPtr->numLevels == 0) {
if (code == TCL_RETURN) {
code = TclUpdateReturnInfo(iPtr);
@@ -4393,7 +4369,8 @@ TclEvalEx(
commandLength -= 1;
}
- Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, commandLength);
+ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+ commandLength);
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -4429,7 +4406,7 @@ TclEvalEx(
TclStackFree(interp, stackObjArray);
TclStackFree(interp, eeFramePtr);
TclStackFree(interp, parsePtr);
-
+
return code;
}
@@ -4457,7 +4434,7 @@ TclAdvanceLines(
const char *start,
const char *end)
{
- const char *p;
+ register const char *p;
for (p = start; p < end; p++) {
if (*p == '\n') {
@@ -4618,8 +4595,7 @@ TclEvalObjEx(
*/
if (objPtr->typePtr == &tclListType) { /* is a list... */
- List *listRepPtr =
- (List *) objPtr->internalRep.twoPtrValue.ptr1;
+ List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
if (objPtr->bytes == NULL || /* ...without a string rep */
listRepPtr->canonicalFlag) {/* ...or that is canonical */
@@ -4632,8 +4608,8 @@ TclEvalObjEx(
int line, i;
char *w;
Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
- CmdFrame *eoFramePtr =
- (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+ CmdFrame *eoFramePtr = (CmdFrame *)
+ TclStackAlloc(interp, sizeof(CmdFrame));
eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
@@ -4643,7 +4619,8 @@ TclEvalObjEx(
Tcl_ListObjGetElements(NULL, copyPtr,
&(eoFramePtr->nline), &elements);
- eoFramePtr->line = (int *) ckalloc(eoFramePtr->nline * sizeof(int));
+ eoFramePtr->line = (int *)
+ ckalloc(eoFramePtr->nline * sizeof(int));
eoFramePtr->cmd.listPtr = objPtr;
Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
@@ -4662,7 +4639,8 @@ TclEvalObjEx(
}
iPtr->cmdFramePtr = eoFramePtr;
- result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements, flags);
+ result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements,
+ flags);
Tcl_DecrRefCount(copyPtr);
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
@@ -4722,8 +4700,8 @@ TclEvalObjEx(
*/
int pc = 0;
- CmdFrame *ctxPtr =
- (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+ CmdFrame *ctxPtr = (CmdFrame *)
+ TclStackAlloc(interp, sizeof(CmdFrame));
*ctxPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
@@ -4916,7 +4894,8 @@ Tcl_ExprDouble(
exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
- Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */
+ Tcl_DecrRefCount(exprPtr);
+ /* Discard the expression object. */
if (result != TCL_OK) {
(void) Tcl_GetStringResult(interp);
}
@@ -5003,7 +4982,7 @@ Tcl_ExprLongObj(
case TCL_NUMBER_DOUBLE: {
mp_int big;
- d = *((const double *)internalPtr);
+ d = *((const double *) internalPtr);
Tcl_DecrRefCount(resultPtr);
if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
return TCL_ERROR;
@@ -5051,7 +5030,7 @@ Tcl_ExprDoubleObj(
break;
#endif
case TCL_NUMBER_DOUBLE:
- *ptr = *((const double *)internalPtr);
+ *ptr = *((const double *) internalPtr);
result = TCL_OK;
break;
default:
@@ -5075,7 +5054,8 @@ Tcl_ExprBooleanObj(
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result == TCL_OK) {
result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
- Tcl_DecrRefCount(resultPtr); /* Discard the result object. */
+ Tcl_DecrRefCount(resultPtr);
+ /* Discard the result object. */
}
return result;
}
@@ -5120,7 +5100,7 @@ TclObjInvokeNamespace(
* command.
*/
- result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcCallFrame*/0);
+ result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -5193,14 +5173,14 @@ TclObjInvoke(
cmdName, "\"", NULL);
return TCL_ERROR;
}
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
/*
* Invoke the command function.
*/
iPtr->cmdCount++;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
/*
* If an error occurred, record information about what was being executed
@@ -5212,7 +5192,7 @@ TclObjInvoke(
&& ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
int length;
Tcl_Obj *command = Tcl_NewListObj(objc, objv);
- const char* cmdString;
+ const char *cmdString;
Tcl_IncrRefCount(command);
cmdString = Tcl_GetStringFromObj(command, &length);
@@ -5647,8 +5627,8 @@ ExprCeilFunc(
ClientData clientData, /* Ignored */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter list */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
@@ -5682,8 +5662,8 @@ ExprFloorFunc(
ClientData clientData, /* Ignored */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter list */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
@@ -5715,9 +5695,9 @@ ExprFloorFunc(
static int
ExprIsqrtFunc(
ClientData clientData, /* Ignored */
- Tcl_Interp* interp, /* The interpreter in which to execute */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter list */
+ Tcl_Interp *interp, /* The interpreter in which to execute. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
ClientData ptr;
int type;
@@ -5726,7 +5706,7 @@ ExprIsqrtFunc(
mp_int big;
int exact = 0; /* Flag == 1 if the argument can be
* represented in a double as an exact
- * integer */
+ * integer. */
/*
* Check syntax.
@@ -5750,7 +5730,7 @@ ExprIsqrtFunc(
Tcl_GetDoubleFromObj(interp, objv[1], &d);
return TCL_ERROR;
case TCL_NUMBER_DOUBLE:
- d = *((const double *)ptr);
+ d = *((const double *) ptr);
if (d < 0) {
goto negarg;
}
@@ -5817,8 +5797,8 @@ ExprSqrtFunc(
ClientData clientData, /* Ignored */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter list */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
@@ -5920,8 +5900,8 @@ ExprBinaryFunc(
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
int code;
double d1, d2;
@@ -5962,8 +5942,8 @@ ExprAbsFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
ClientData ptr;
int type;
@@ -5979,7 +5959,7 @@ ExprAbsFunc(
}
if (type == TCL_NUMBER_LONG) {
- long l = *((const long int *)ptr);
+ long l = *((const long *) ptr);
if (l < (long)0) {
if (l == LONG_MIN) {
TclBNInitBignumFromLong(&big, l);
@@ -5993,7 +5973,7 @@ ExprAbsFunc(
}
if (type == TCL_NUMBER_DOUBLE) {
- double d = *((const double *)ptr);
+ double d = *((const double *) ptr);
if (d < 0.0) {
Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
} else {
@@ -6004,7 +5984,7 @@ ExprAbsFunc(
#ifndef NO_WIDE_TYPE
if (type == TCL_NUMBER_WIDE) {
- Tcl_WideInt w = *((const Tcl_WideInt *)ptr);
+ Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
if (w < (Tcl_WideInt)0) {
if (w == LLONG_MIN) {
TclBNInitBignumFromWideInt(&big, w);
@@ -6020,7 +6000,7 @@ ExprAbsFunc(
if (type == TCL_NUMBER_BIG) {
/* TODO: const correctness ? */
- if (mp_cmp_d((mp_int *)ptr, 0) == MP_LT) {
+ if (mp_cmp_d((mp_int *) ptr, 0) == MP_LT) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
mp_neg(&big, &big);
@@ -6049,8 +6029,8 @@ ExprBoolFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
int value;
@@ -6070,8 +6050,8 @@ ExprDoubleFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
double dResult;
if (objc != 2) {
@@ -6096,8 +6076,8 @@ ExprEntierFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
double d;
int type;
@@ -6112,7 +6092,7 @@ ExprEntierFunc(
}
if (type == TCL_NUMBER_DOUBLE) {
- d = *((const double *)ptr);
+ d = *((const double *) ptr);
if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
mp_int big;
@@ -6152,8 +6132,8 @@ ExprIntFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
long iResult;
Tcl_Obj *objPtr;
@@ -6184,8 +6164,8 @@ ExprWideFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Tcl_WideInt wResult;
Tcl_Obj *objPtr;
@@ -6216,14 +6196,14 @@ ExprRandFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Interp *iPtr = (Interp *) interp;
double dResult;
long tmp; /* Algorithm assumes at least 32 bits. Only
* long guarantees that. See below. */
- Tcl_Obj* oResult;
+ Tcl_Obj *oResult;
if (objc != 1) {
MathFuncWrongNumArgs(interp, 1, objc, objv);
@@ -6309,8 +6289,8 @@ ExprRoundFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
double d;
ClientData ptr;
@@ -6329,7 +6309,7 @@ ExprRoundFunc(
double fractPart, intPart;
long max = LONG_MAX, min = LONG_MIN;
- fractPart = modf(*((const double *)ptr), &intPart);
+ fractPart = modf(*((const double *) ptr), &intPart);
if (fractPart <= -0.5) {
min++;
} else if (fractPart >= 0.5) {
@@ -6384,8 +6364,8 @@ ExprSrandFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
Interp *iPtr = (Interp *) interp;
long i = 0; /* Initialized to avoid compiler warning. */
@@ -6456,9 +6436,9 @@ ExprSrandFunc(
static void
MathFuncWrongNumArgs(
Tcl_Interp *interp, /* Tcl interpreter */
- int expected, /* Formal parameter count */
- int found, /* Actual parameter count */
- Tcl_Obj *const *objv) /* Actual parameter vector */
+ int expected, /* Formal parameter count. */
+ int found, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
const char *name = Tcl_GetString(objv[0]);
const char *tail = name + strlen(name);
@@ -6534,36 +6514,36 @@ TclDTraceInfo(
char **args,
int *argsi)
{
- static Tcl_Obj *keys[7] = { NULL };
- Tcl_Obj **k = keys, *val;
- int i;
-
- if (!*k) {
- TclNewLiteralStringObj(keys[0], "cmd");
- TclNewLiteralStringObj(keys[1], "type");
- TclNewLiteralStringObj(keys[2], "proc");
- TclNewLiteralStringObj(keys[3], "file");
- TclNewLiteralStringObj(keys[4], "lambda");
- TclNewLiteralStringObj(keys[5], "line");
- TclNewLiteralStringObj(keys[6], "level");
- }
- for (i = 0; i < 4; i++) {
- Tcl_DictObjGet(NULL, info, *k++, &val);
- args[i] = val ? TclGetString(val) : NULL;
- }
- if (!args[2]) {
- Tcl_DictObjGet(NULL, info, *k, &val);
- args[2] = val ? TclGetString(val) : NULL;
- }
- k++;
- for (i = 0; i < 2; i++) {
- Tcl_DictObjGet(NULL, info, *k++, &val);
- if (val) {
- TclGetIntFromObj(NULL, val, &(argsi[i]));
- } else {
- argsi[i] = 0;
- }
+ static Tcl_Obj *keys[7] = { NULL };
+ Tcl_Obj **k = keys, *val;
+ int i;
+
+ if (!*k) {
+ TclNewLiteralStringObj(keys[0], "cmd");
+ TclNewLiteralStringObj(keys[1], "type");
+ TclNewLiteralStringObj(keys[2], "proc");
+ TclNewLiteralStringObj(keys[3], "file");
+ TclNewLiteralStringObj(keys[4], "lambda");
+ TclNewLiteralStringObj(keys[5], "line");
+ TclNewLiteralStringObj(keys[6], "level");
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ args[i] = val ? TclGetString(val) : NULL;
+ }
+ if (!args[2]) {
+ Tcl_DictObjGet(NULL, info, *k, &val);
+ args[2] = val ? TclGetString(val) : NULL;
+ }
+ k++;
+ for (i = 0; i < 2; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ if (val) {
+ TclGetIntFromObj(NULL, val, &(argsi[i]));
+ } else {
+ argsi[i] = 0;
}
+ }
}
#endif /* USE_DTRACE */
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index dec56d2..839c54c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.14 2007/12/04 16:55:53 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.15 2007/12/06 16:27:45 dgp Exp $
*/
#include "tclInt.h"
@@ -6098,7 +6098,10 @@ TclCompileVariableCmd(
*
* TclCompileEnsemble --
*
- * Procedure called to compile an ensemble command.
+ * Procedure called to compile an ensemble command. Note that most
+ * ensembles are not compiled, since modifying a compiled ensemble causes
+ * a invalidation of all existing bytecode (expensive!) which is not
+ * normally warranted.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
@@ -6145,8 +6148,8 @@ TclCompileEnsemble(
/*
* There's a sporting chance we'll be able to compile this. But now we
- * must check properly. To do that, check that we're compiling an
- * ensemble that has [info exists] as its appropriate subcommand.
+ * must check properly. To do that, check that we're compiling an ensemble
+ * that has a compilable command as its appropriate subcommand.
*/
if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
@@ -6326,8 +6329,8 @@ TclCompileEnsemble(
synthetic.tokenPtr = synthetic.staticTokens;
synthetic.tokensAvailable = NUM_STATIC_TOKENS;
} else {
- synthetic.tokenPtr = (Tcl_Token *)
- ckalloc(sizeof(Tcl_Token) * synthetic.numTokens);
+ synthetic.tokenPtr =
+ TclStackAlloc(interp, sizeof(Tcl_Token) * synthetic.numTokens);
synthetic.tokensAvailable = synthetic.numTokens;
}
@@ -6358,7 +6361,7 @@ TclCompileEnsemble(
*/
memcpy(synthetic.tokenPtr + 2, argTokensPtr,
- sizeof(Tcl_Token) * (synthetic.numTokens - 2));
+ sizeof(Tcl_Token) * (synthetic.numTokens - 2*len));
/*
* Hand off compilation to the subcommand compiler. At last!
@@ -6371,7 +6374,7 @@ TclCompileEnsemble(
*/
if (synthetic.tokenPtr != synthetic.staticTokens) {
- ckfree((char *) synthetic.tokenPtr);
+ TclStackFree(interp, synthetic.tokenPtr);
}
return result;
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index af1a44c..fe16aea 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.7 2007/12/06 07:08:37 dgp Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.8 2007/12/06 16:27:45 dgp Exp $
*/
#include "tclInt.h"
@@ -28,6 +28,12 @@ typedef struct AcceptCallback {
static void AcceptCallbackProc(ClientData callbackData,
Tcl_Channel chan, char *address, int port);
+static int ChanPendingObjCmd(ClientData unused,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ChanTruncateObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static void RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
AcceptCallback *acceptCallbackPtr);
static void TcpAcceptCallbacksDeleteProc(ClientData clientData,
@@ -1609,7 +1615,7 @@ Tcl_FcopyObjCmd(
/*
*---------------------------------------------------------------------------
*
- * TclChanPendingObjCmd --
+ * ChanPendingObjCmd --
*
* This function is invoked to process the Tcl "chan pending" command
* (TIP #287). See the user documentation for details on what it does.
@@ -1626,8 +1632,8 @@ Tcl_FcopyObjCmd(
*/
/* ARGSUSED */
-int
-TclChanPendingObjCmd(
+static int
+ChanPendingObjCmd(
ClientData unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -1674,7 +1680,7 @@ TclChanPendingObjCmd(
/*
*----------------------------------------------------------------------
*
- * Tcl_ChanTruncateObjCmd --
+ * ChanTruncateObjCmd --
*
* This function is invoked to process the "chan truncate" Tcl command.
* See the user documentation for details on what it does.
@@ -1688,8 +1694,8 @@ TclChanPendingObjCmd(
*----------------------------------------------------------------------
*/
-int
-TclChanTruncateObjCmd(
+static int
+ChanTruncateObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -1745,10 +1751,78 @@ TclChanTruncateObjCmd(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitChanCmd --
+ *
+ * This function is invoked to create the "chan" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A Tcl command handle.
+ *
+ * Side effects:
+ * None (since nothing is byte-compiled).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitChanCmd(
+ Tcl_Interp *interp)
+{
+ /*
+ * Most commands are plugged directly together, but some are done via
+ * alias-like rewriting; [chan configure] is this way for security reasons
+ * (want overwriting of [fconfigure] to control that nicely), and [chan
+ * names] because the functionality isn't available as a separate command
+ * function at the moment.
+ */
+ static const EnsembleImplMap initMap[] = {
+ {"blocked", Tcl_FblockedObjCmd},
+ {"close", Tcl_CloseObjCmd},
+ {"copy", Tcl_FcopyObjCmd},
+ {"create", TclChanCreateObjCmd}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd},
+ {"event", Tcl_FileEventObjCmd},
+ {"flush", Tcl_FlushObjCmd},
+ {"gets", Tcl_GetsObjCmd},
+ {"pending", ChanPendingObjCmd}, /* TIP #287 */
+ {"postevent", TclChanPostEventObjCmd}, /* TIP #219 */
+ {"puts", Tcl_PutsObjCmd},
+ {"read", Tcl_ReadObjCmd},
+ {"seek", Tcl_SeekObjCmd},
+ {"tell", Tcl_TellObjCmd},
+ {"truncate", ChanTruncateObjCmd}, /* TIP #208 */
+ {NULL}
+ };
+ static const char *extras[] = {
+ "configure", "::fconfigure",
+ "names", "::file channels",
+ NULL
+ };
+ Tcl_Command ensemble;
+ Tcl_Obj *mapObj;
+ int i;
+
+ ensemble = TclMakeEnsemble(interp, "chan", initMap);
+ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
+ for (i=0 ; extras[i] ; i+=2) {
+ /*
+ * Can assume that reference counts are all incremented.
+ */
+
+ Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1),
+ Tcl_NewStringObj(extras[i+1], -1));
+ }
+ Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
+ return ensemble;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
-
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 146014d..7eb5e59 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* 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.310.2.20 2007/11/26 19:43:16 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.310.2.21 2007/12/06 16:27:46 dgp Exp $
*/
#ifndef _TCLINT
@@ -2424,10 +2424,6 @@ MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
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 int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp,
@@ -2698,12 +2694,13 @@ MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int TclChanPendingObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]); /* TIP 287 */
-MODULE_SCOPE int TclChanTruncateObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, 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 void TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int TclClockOldscanObjCmd(
ClientData clientData, Tcl_Interp *interp,
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 2c53562..7156ff3 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.14 2007/11/28 20:30:32 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.15 2007/12/06 16:27:46 dgp Exp $
*/
#include "tclInt.h"
@@ -5964,6 +5964,7 @@ TclMakeEnsemble(
TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
}
}
+ Tcl_DStringFree(&buf);
return ensemble;
}
diff --git a/library/init.tcl b/library/init.tcl
index e19af00..e6b848c 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.91.2.6 2007/11/21 06:30:55 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.91.2.7 2007/12/06 16:27:46 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -75,31 +75,6 @@ namespace eval tcl {
}
}
- # Set up the 'chan' ensemble (TIP #208).
- namespace eval chan {
- # TIP #219. Added methods: create, postevent.
- # TIP 287. Added method: pending.
- namespace ensemble create -command ::chan -map {
- blocked ::tcl::chan::blocked
- close ::tcl::chan::close
- configure ::tcl::chan::configure
- copy ::tcl::chan::copy
- create ::tcl::chan::rCreate
- eof ::tcl::chan::eof
- event ::tcl::chan::event
- flush ::tcl::chan::flush
- gets ::tcl::chan::gets
- names {::file channels}
- pending ::tcl::chan::Pending
- postevent ::tcl::chan::rPostevent
- puts ::tcl::chan::puts
- read ::tcl::chan::read
- seek ::tcl::chan::seek
- tell ::tcl::chan::tell
- truncate ::tcl::chan::Truncate
- }
- }
-
# TIP #255 min and max functions
namespace eval mathfunc {
proc min {args} {
generated by cgit v0.12 at 2024-11-23 20:15:40 (GMT)