summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog29
-rw-r--r--generic/tclBasic.c14
-rw-r--r--generic/tclCmdAH.c8
-rw-r--r--generic/tclCmdIL.c4
-rw-r--r--generic/tclCmdMZ.c14
-rw-r--r--generic/tclCompCmds.c24
-rw-r--r--generic/tclCompExpr.c34
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclExecute.c39
-rw-r--r--generic/tclFCmd.c4
-rw-r--r--generic/tclFileName.c4
-rw-r--r--generic/tclIOCmd.c4
-rw-r--r--generic/tclIndexObj.c6
-rw-r--r--generic/tclInt.decls6
-rw-r--r--generic/tclIntDecls.h10
-rw-r--r--generic/tclInterp.c6
-rw-r--r--generic/tclNamesp.c10
-rw-r--r--generic/tclProc.c15
-rw-r--r--generic/tclTrace.c6
-rw-r--r--unix/tclUnixPipe.c6
20 files changed, 154 insertions, 93 deletions
diff --git a/ChangeLog b/ChangeLog
index 10bb42d..b6b691e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,32 @@
+2007-06-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decls: Revised the interfaces of the routines
+ * generic/tclExecute.c: TclStackAlloc and TclStackFree to make them
+ easier for callers to use (or more precisely, harder to misuse).
+ TclStackFree now takes a (void *) argument which is the pointer
+ intended to be freed. TclStackFree will panic if that's not actually
+ the memory the call will free. TSA/TSF also now tolerate receiving
+ (interp == NULL), in which case they simply fall back to be calls to
+ Tcl_Alloc/Tcl_Free.
+
+ * generic/tclIntDecls.h: make genstubs
+
+ * generic/tclBasic.c: Updated callers
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclFCmd.c:
+ * generic/tclFileName.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * generic/tclProc.c:
+ * generic/tclTrace.c:
+ * unix/tclUnixPipe.c:
+
2007-06-20 Jeff Hobbs <jeffh@ActiveState.com>
* tools/tcltk-man2html.tcl: revamp of html doc output to use CSS,
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7d82ed9..8b20630 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.253 2007/06/18 21:27:24 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.254 2007/06/20 18:46:07 dgp Exp $
*/
#include "tclInt.h"
@@ -2021,7 +2021,7 @@ TclInvokeStringCommand(
result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
- TclStackFree(interp); /* argv */
+ TclStackFree(interp, argv);
return result;
}
@@ -2088,7 +2088,7 @@ TclInvokeObjectCommand(
objPtr = objv[i];
Tcl_DecrRefCount(objPtr);
}
- TclStackFree(interp); /* objv */
+ TclStackFree(interp, objv);
return result;
}
@@ -3556,7 +3556,7 @@ TclEvalObjvInternal(
for (i = 0; i < handlerObjc; ++i) {
Tcl_DecrRefCount(newObjv[i]);
}
- TclStackFree(interp);
+ TclStackFree(interp, newObjv);
if (savedNsPtr) {
varFramePtr->nsPtr = savedNsPtr;
}
@@ -4269,7 +4269,7 @@ TclEvalEx(
if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(eeFramePtr->data.eval.path);
}
- TclStackFree(interp); /* eeFramePtr */
+ TclStackFree(interp, eeFramePtr);
return code;
}
@@ -4511,7 +4511,7 @@ TclEvalObjEx(
ckfree((char *) eoFramePtr->line);
eoFramePtr->line = NULL;
eoFramePtr->nline = 0;
- TclStackFree(interp); /* eoFramePtr */
+ TclStackFree(interp, eoFramePtr);
goto done;
}
@@ -4606,7 +4606,7 @@ TclEvalObjEx(
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
}
- TclStackFree(interp); /* ctxPtr */
+ TclStackFree(interp, ctxPtr);
}
}
} else {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 452bdce..d8748b1 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.88 2007/04/10 14:47:09 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.89 2007/06/20 18:46:07 dgp Exp $
*/
#include "tclInt.h"
@@ -1838,9 +1838,9 @@ Tcl_ForeachObjCmd(
Tcl_DecrRefCount(aCopyList[i]);
}
}
- TclStackFree(interp); /* Tcl_Obj * arrays */
- TclStackFree(interp); /* Tcl_Obj ** arrays */
- TclStackFree(interp); /* int arrays */
+ TclStackFree(interp, vCopyList); /* Tcl_Obj * arrays */
+ TclStackFree(interp, varvList); /* Tcl_Obj ** arrays */
+ TclStackFree(interp, index); /* int arrays */
return result;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 49ca22c..2112d6f 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.117 2007/06/18 22:51:11 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.118 2007/06/20 18:46:07 dgp Exp $
*/
#include "tclInt.h"
@@ -1260,7 +1260,7 @@ InfoFrameCmd(
}
}
}
- TclStackFree(interp); /* fPtr */
+ TclStackFree(interp, fPtr);
break;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2d06d46..205dd7d 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.152 2007/06/18 22:51:11 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.153 2007/06/20 18:46:08 dgp Exp $
*/
#include "tclInt.h"
@@ -1930,7 +1930,7 @@ Tcl_StringObjCmd(
*/
if (mapWithDict) {
- TclStackFree(interp);
+ TclStackFree(interp, mapElemv);
}
if (copySource) {
Tcl_DecrRefCount(sourceObj);
@@ -2054,10 +2054,10 @@ Tcl_StringObjCmd(
}
}
if (nocase) {
- TclStackFree(interp); /* u2lc */
+ TclStackFree(interp, u2lc);
}
- TclStackFree(interp); /* mapLens */
- TclStackFree(interp); /* mapStrings */
+ TclStackFree(interp, mapLens);
+ TclStackFree(interp, mapStrings);
}
if (p != ustring1) {
/*
@@ -2067,7 +2067,7 @@ Tcl_StringObjCmd(
Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
}
if (mapWithDict) {
- TclStackFree(interp);
+ TclStackFree(interp, mapElemv);
}
if (copySource) {
Tcl_DecrRefCount(sourceObj);
@@ -3025,7 +3025,7 @@ Tcl_SwitchObjCmd(
(overflow ? limit : patternLength), pattern,
(overflow ? "..." : ""), interp->errorLine));
}
- TclStackFree(interp); /* ctxPtr */
+ TclStackFree(interp, ctxPtr);
return result;
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 952f4bd..3801886 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.110 2007/06/15 22:58:48 msofer Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.111 2007/06/20 18:46:11 dgp Exp $
*/
#include "tclInt.h"
@@ -948,14 +948,14 @@ TclCompileDictCmd(
tokenPtr = TokenAfter(tokenPtr);
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
ckfree((char *) duiPtr);
- TclStackFree(interp); /* keyTokenPtrs */
+ TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
}
name = tokenPtr[1].start;
nameChars = tokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
ckfree((char *) duiPtr);
- TclStackFree(interp); /* keyTokenPtrs */
+ TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
}
duiPtr->varIndices[i] = TclFindCompiledLocal(name, nameChars, 1,
@@ -964,7 +964,7 @@ TclCompileDictCmd(
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
ckfree((char *) duiPtr);
- TclStackFree(interp); /* keyTokenPtrs */
+ TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
}
bodyTokenPtr = tokenPtr;
@@ -1015,7 +1015,7 @@ TclCompileDictCmd(
TclEmitInt4( infoIndex, envPtr);
TclEmitOpcode( INST_RETURN_STK, envPtr);
- TclStackFree(interp); /* keyTokenPtrs */
+ TclStackFree(interp, keyTokenPtrs);
return TCL_OK;
} else if (size==6 && strncmp(cmd, "append", 6) == 0) {
Tcl_Token *varTokenPtr;
@@ -1665,8 +1665,8 @@ TclCompileForeachCmd(
ckfree((char *) varvList[loopIndex]);
}
}
- TclStackFree(interp); /* varvList */
- TclStackFree(interp); /* varcList */
+ TclStackFree(interp, varvList);
+ TclStackFree(interp, varcList);
return code;
}
@@ -2995,7 +2995,7 @@ TclCompileRegexpCmd(
if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL)
|| (Tcl_RegExpCompile(NULL, str) == NULL)) {
- TclStackFree(interp); /* str */
+ TclStackFree(interp, str);
return TCL_ERROR;
}
@@ -3021,9 +3021,9 @@ TclCompileRegexpCmd(
}
newStr[len] = '\0';
PushLiteral(envPtr, newStr, len);
- TclStackFree(interp); /* newStr */
+ TclStackFree(interp, newStr);
}
- TclStackFree(interp); /* str */
+ TclStackFree(interp, str);
/*
* Push the string arg.
@@ -3128,7 +3128,7 @@ TclCompileReturnCmd(
while (--objc >= 0) {
TclDecrRefCount(objv[objc]);
}
- TclStackFree(interp); /* objv */
+ TclStackFree(interp, objv);
if (TCL_ERROR == status) {
/*
* Something was bogus in the return options. Clear the error message,
@@ -4696,7 +4696,7 @@ PushVarName(
++varTokenPtr[removedParen].size;
}
if (allocedTokens) {
- TclStackFree(interp); /* elemTokenPtr */
+ TclStackFree(interp, elemTokenPtr);
}
*localIndexPtr = localIndex;
*simpleVarNamePtr = simpleVarName;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index f24c505..7465135 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.53 2007/04/25 19:07:07 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.54 2007/06/20 18:46:11 dgp Exp $
*/
#include "tclInt.h"
@@ -2460,7 +2460,7 @@ CompileExprTree(
{
OpNode *nodePtr = nodes;
int nextFunc = 0;
- JumpList *jumpPtr = NULL;
+ JumpList *freePtr, *jumpPtr = NULL;
static const int instruction[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -2642,9 +2642,12 @@ CompileExprTree(
jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
*convertPtr |= jumpPtr->convert;
envPtr->currStackDepth = jumpPtr->depth + 1;
- jumpPtr = jumpPtr->next->next;
- TclStackFree(interp);
- TclStackFree(interp);
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
} else if (nodePtr->lexeme == AND) {
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
&(jumpPtr->next->jump));
@@ -2672,10 +2675,15 @@ CompileExprTree(
&(jumpPtr->next->next->jump), 127);
*convertPtr = 0;
envPtr->currStackDepth = jumpPtr->depth + 1;
- jumpPtr = jumpPtr->next->next->next;
- TclStackFree(interp);
- TclStackFree(interp);
- TclStackFree(interp);
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
}
nodePtr = nodes + nodePtr->parent;
}
@@ -2708,7 +2716,7 @@ OpCmd(
Tcl_IncrRefCount(byteCodeObj);
TclInitByteCodeObj(byteCodeObj, compEnvPtr);
TclFreeCompileEnv(compEnvPtr);
- TclStackFree(interp); /* compEnvPtr */
+ TclStackFree(interp, compEnvPtr);
byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
code = TclExecuteByteCode(interp, byteCodePtr);
Tcl_DecrRefCount(byteCodeObj);
@@ -2794,8 +2802,8 @@ TclSortingOpCmd(
code = OpCmd(interp, nodes, litObjv);
- TclStackFree(interp); /* nodes */
- TclStackFree(interp); /* litObjv */
+ TclStackFree(interp, nodes);
+ TclStackFree(interp, litObjv);
}
return code;
}
@@ -2887,7 +2895,7 @@ TclVariadicOpCmd(
code = OpCmd(interp, nodes, objv+1);
- TclStackFree(interp); /* nodes */
+ TclStackFree(interp, nodes);
return code;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d00ee09..30520ed 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.120 2007/06/18 22:51:11 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.121 2007/06/20 18:46:11 dgp Exp $
*/
#include "tclInt.h"
@@ -948,7 +948,7 @@ TclInitCompileEnv(
Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
}
}
- TclStackFree(interp);
+ TclStackFree(interp, ctxPtr);
}
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 20e61ea..9e74fd3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.300 2007/06/19 20:21:43 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.301 2007/06/20 18:46:12 dgp Exp $
*/
#include "tclInt.h"
@@ -814,18 +814,33 @@ StackReallocWords(
void
TclStackFree(
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ void *freePtr)
{
+ Interp *iPtr;
+ ExecEnv *eePtr;
+ ExecStack *esPtr;
+ Tcl_Obj **markerPtr;
+
+ if (interp == NULL) {
+ Tcl_Free((char *) freePtr);
+ return;
+ }
+
/*
* Rewind the stack to the previous marker position. The current marker,
* as set in the last call to GrowEvaluationStack, contains a pointer to
* the previous marker.
*/
-
- Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr = iPtr->execEnvPtr;
- ExecStack *esPtr = eePtr->execStackPtr;
- Tcl_Obj **markerPtr = esPtr->markerPtr;
+
+ iPtr = (Interp *) interp;
+ eePtr = iPtr->execEnvPtr;
+ esPtr = eePtr->execStackPtr;
+ markerPtr = esPtr->markerPtr;
+
+ if ((markerPtr+1) != (Tcl_Obj **)freePtr) {
+ Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?");
+ }
esPtr->tosPtr = markerPtr-1;
esPtr->markerPtr = (Tcl_Obj **) *markerPtr;
@@ -849,14 +864,18 @@ TclStackFree(
}
}
-char *
+void *
TclStackAlloc(
Tcl_Interp *interp,
int numBytes)
{
int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
- return (char *) StackAllocWords(interp, numWords);
+ if (interp == NULL) {
+ return (void *) Tcl_Alloc(numBytes);
+ }
+
+ return (void *) StackAllocWords(interp, numWords);
}
char *
@@ -6842,7 +6861,7 @@ TclExecuteByteCode(
* Restore the stack to the state it had previous to this bytecode.
*/
- TclStackFree(interp);
+ TclStackFree(interp, initCatchTop+1);
return result;
#undef iPtr
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 198f9af..1cb3d3f 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFCmd.c,v 1.39 2007/04/20 05:51:10 kennykb Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.40 2007/06/20 18:46:12 dgp Exp $
*/
#include "tclInt.h"
@@ -1112,7 +1112,7 @@ TclFileAttrsCmd(
* Free up the array we allocated.
*/
- TclStackFree(interp); /* attributeStrings */
+ TclStackFree(interp, attributeStrings);
/*
* We don't need this object that was passed to us any more.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index fad9f72..6705866 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileName.c,v 1.83 2007/04/20 05:51:10 kennykb Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.84 2007/06/20 18:46:12 dgp Exp $
*/
#include "tclInt.h"
@@ -1629,7 +1629,7 @@ Tcl_GlobObjCmd(
if (globTypes->macCreator != NULL) {
Tcl_DecrRefCount(globTypes->macCreator);
}
- TclStackFree(interp); /* globTypes */
+ TclStackFree(interp, globTypes);
}
return result;
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 97d11ff..8507eb2 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 2007/04/24 02:42:18 kennykb Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.41 2007/06/20 18:46:13 dgp Exp $
*/
#include "tclInt.h"
@@ -872,7 +872,7 @@ Tcl_ExecObjCmd(
* Free the argv array.
*/
- TclStackFree(interp); /* argv */
+ TclStackFree(interp, argv);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index e45a902..ef2f3ed 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIndexObj.c,v 1.34 2007/06/12 12:36:54 dkf Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.35 2007/06/20 18:46:13 dgp Exp $
*/
#include "tclInt.h"
@@ -543,7 +543,7 @@ Tcl_WrongNumArgs(
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
- TclStackFree(interp); /* quotedElementStr */
+ TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
@@ -597,7 +597,7 @@ Tcl_WrongNumArgs(
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
- TclStackFree(interp); /* quotedElementStr */
+ TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 4437b7d..72cb162 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.109 2007/06/14 21:02:19 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.110 2007/06/20 18:46:13 dgp Exp $
library tcl
@@ -868,10 +868,10 @@ declare 214 generic {
void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 generic {
- char * TclStackAlloc(Tcl_Interp *interp, int numBytes)
+ void * TclStackAlloc(Tcl_Interp *interp, int numBytes)
}
declare 216 generic {
- void TclStackFree(Tcl_Interp *interp)
+ void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 generic {
int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 15f7dcf..7d827db 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIntDecls.h,v 1.100 2007/06/14 21:02:20 msofer Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.101 2007/06/20 18:46:13 dgp Exp $
*/
#ifndef _TCLINTDECLS
@@ -950,12 +950,12 @@ EXTERN void TclSetObjNameOfExecutable (Tcl_Obj * name,
#ifndef TclStackAlloc_TCL_DECLARED
#define TclStackAlloc_TCL_DECLARED
/* 215 */
-EXTERN char * TclStackAlloc (Tcl_Interp * interp, int numBytes);
+EXTERN void * TclStackAlloc (Tcl_Interp * interp, int numBytes);
#endif
#ifndef TclStackFree_TCL_DECLARED
#define TclStackFree_TCL_DECLARED
/* 216 */
-EXTERN void TclStackFree (Tcl_Interp * interp);
+EXTERN void TclStackFree (Tcl_Interp * interp, void * freePtr);
#endif
#ifndef TclPushStackFrame_TCL_DECLARED
#define TclPushStackFrame_TCL_DECLARED
@@ -1274,8 +1274,8 @@ typedef struct TclIntStubs {
void (*tclpFindExecutable) (CONST char * argv0); /* 212 */
Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
void (*tclSetObjNameOfExecutable) (Tcl_Obj * name, Tcl_Encoding encoding); /* 214 */
- char * (*tclStackAlloc) (Tcl_Interp * interp, int numBytes); /* 215 */
- void (*tclStackFree) (Tcl_Interp * interp); /* 216 */
+ void * (*tclStackAlloc) (Tcl_Interp * interp, int numBytes); /* 215 */
+ void (*tclStackFree) (Tcl_Interp * interp, void * freePtr); /* 216 */
int (*tclPushStackFrame) (Tcl_Interp * interp, Tcl_CallFrame ** framePtrPtr, Tcl_Namespace * namespacePtr, int isProcCallFrame); /* 217 */
void (*tclPopStackFrame) (Tcl_Interp * interp); /* 218 */
void *reserved219;
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index cfbdb6b..1d28a95 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.75 2007/06/09 20:12:55 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.76 2007/06/20 18:46:13 dgp Exp $
*/
#include "tclInt.h"
@@ -1104,7 +1104,7 @@ Tcl_CreateAlias(
for (i = 0; i < argc; i++) {
Tcl_DecrRefCount(objv[i]);
}
- TclStackFree(slaveInterp); /* objv */
+ TclStackFree(slaveInterp, objv);
Tcl_DecrRefCount(targetObjPtr);
Tcl_DecrRefCount(slaveObjPtr);
@@ -1778,7 +1778,7 @@ AliasObjCmd(
Tcl_DecrRefCount(cmdv[i]);
}
if (cmdv != cmdArr) {
- TclStackFree(interp);
+ TclStackFree(interp, cmdv);
}
return result;
#undef ALIAS_CMDV_PREALLOC
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index ba64680..1fa1967 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,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.139 2007/06/12 12:29:06 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.140 2007/06/20 18:46:13 dgp Exp $
*/
#include "tclInt.h"
@@ -533,8 +533,10 @@ void
TclPopStackFrame(
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
+ Tcl_CallFrame *freePtr = ((Interp *)interp)->framePtr;
+
Tcl_PopCallFrame(interp);
- TclStackFree(interp);
+ TclStackFree(interp, freePtr);
}
/*
@@ -4119,7 +4121,7 @@ NamespacePathCmd(
result = TCL_OK;
badNamespace:
if (namespaceList != NULL) {
- TclStackFree(interp); /* namespaceList */
+ TclStackFree(interp, namespaceList);
}
return result;
}
@@ -6196,7 +6198,7 @@ NsEnsembleImplementationCmd(
TCL_EVAL_INVOKE);
Tcl_DecrRefCount(copyObj);
Tcl_DecrRefCount(prefixObj);
- TclStackFree(interp);
+ TclStackFree(interp, tempObjv);
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = NULL;
iPtr->ensembleRewrite.numRemovedObjs = 0;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 5253e21..8cd8aa1 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.124 2007/06/18 22:51:12 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.125 2007/06/20 18:46:14 dgp Exp $
*/
#include "tclInt.h"
@@ -270,7 +270,7 @@ Tcl_ProcObjCmd(
Tcl_DecrRefCount(contextPtr->data.eval.path);
contextPtr->data.eval.path = NULL;
}
- TclStackFree(interp); /* contextPtr */
+ TclStackFree(interp, contextPtr);
}
/*
@@ -1222,7 +1222,7 @@ InitArgsAndLocals(
for (i=0 ; i<=numArgs ; i++) {
Tcl_DecrRefCount(desiredObjs[i]);
}
- TclStackFree(interp);
+ TclStackFree(interp, desiredObjs);
return TCL_ERROR;
}
@@ -1565,6 +1565,7 @@ TclObjInterpProcCore(
{
register Proc *procPtr = ((Interp *)interp)->varFramePtr->procPtr;
int result;
+ CallFrame *freePtr;
result = InitArgsAndLocals(interp, procNameObj, skip);
if (result != TCL_OK) {
@@ -1680,9 +1681,11 @@ TclObjInterpProcCore(
* allocated later on the stack.
*/
+ freePtr = ((Interp *)interp)->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
- TclStackFree(interp); /* Free compiledLocals. */
- TclStackFree(interp); /* Free CallFrame. */
+ TclStackFree(interp, freePtr->compiledLocals);
+ /* Free compiledLocals. */
+ TclStackFree(interp, freePtr); /* Free CallFrame. */
return result;
}
@@ -2401,7 +2404,7 @@ SetLambdaFromAny(
Tcl_DecrRefCount(contextPtr->data.eval.path);
}
- TclStackFree(interp); /* contextPtr */
+ TclStackFree(interp, contextPtr);
}
/*
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 7d6b667..799a764 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTrace.c,v 1.38 2007/06/09 20:12:55 msofer Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.39 2007/06/20 18:46:14 dgp Exp $
*/
#include "tclInt.h"
@@ -1704,7 +1704,7 @@ CallTraceFunction(
traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*) iPtr,
iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
- TclStackFree(interp); /* commandCopy */
+ TclStackFree(interp, commandCopy);
return traceCode;
}
@@ -2281,7 +2281,7 @@ StringTraceProc(
(data->proc)(data->clientData, interp, level, (char *) command,
cmdPtr->proc, cmdPtr->clientData, objc, argv);
- TclStackFree(interp); /* argv */
+ TclStackFree(interp, argv);
return TCL_OK;
}
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index a6ec0e4..cf061ed 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPipe.c,v 1.38 2007/04/02 18:48:04 dgp Exp $
+ * RCS: @(#) $Id: tclUnixPipe.c,v 1.39 2007/06/20 18:46:14 dgp Exp $
*/
#include "tclInt.h"
@@ -485,8 +485,8 @@ TclpCreateProcess(
for (i = 0; i < argc; i++) {
Tcl_DStringFree(&dsArray[i]);
}
- TclStackFree(interp); /* newArgv */
- TclStackFree(interp); /* dsArray */
+ TclStackFree(interp, newArgv);
+ TclStackFree(interp, dsArray);
if (pid == -1) {
Tcl_AppendResult(interp, "couldn't fork child process: ",
generated by cgit v0.12 at 2024-11-04 20:40:52 (GMT)