summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclBasic.c68
-rw-r--r--generic/tclExecute.c3
-rw-r--r--generic/tclFCmd.c8
-rw-r--r--generic/tclFileName.c7
-rw-r--r--generic/tclIOCmd.c16
-rw-r--r--generic/tclIndexObj.c10
-rw-r--r--generic/tclInterp.c7
-rw-r--r--generic/tclNamesp.c16
-rw-r--r--generic/tclTrace.c14
-rw-r--r--unix/tclUnixPipe.c11
11 files changed, 66 insertions, 107 deletions
diff --git a/ChangeLog b/ChangeLog
index f31c7ee..0107295 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2007-04-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Replace arrays on the C stack and ckalloc
+ * generic/tclExecute.c: calls with TclStackAlloc calls to use memory
+ * generic/tclFCmd.c: on Tcl's evaluation stack.
+ * generic/tclFileName.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * generic/tclTrace.c:
+ * unix/tclUnixPipe.c:
+
2007-04-01 Donal K. Fellows <dkf@users.sf.net>
* generic/tclCompile.c (TclCompileScript, TclPrintInstruction):
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 43e570e..d35dd6c 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.239 2007/03/23 19:59:34 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.240 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -2003,28 +2003,10 @@ TclInvokeStringCommand(
register int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- register Command *cmdPtr = (Command *) clientData;
- register int i;
- int result;
-
- /*
- * This function generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
-#define NUM_ARGS 20
- const char *(argStorage[NUM_ARGS]);
- const char **argv = argStorage;
-
- /*
- * Create the string argument array "argv". Make sure argv is large enough
- * to hold the objc arguments plus 1 extra for the zero end-of-argv word.
- */
-
- if ((objc + 1) > NUM_ARGS) {
- argv = (const char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
- }
+ Command *cmdPtr = (Command *) clientData;
+ int i, result;
+ const char **argv = (const char **)
+ TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
@@ -2037,15 +2019,8 @@ TclInvokeStringCommand(
result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
- /*
- * Free the argv array if malloc'ed storage was used.
- */
-
- if (argv != argStorage) {
- ckfree((char *) argv);
- }
+ TclStackFree(interp); /* argv */
return result;
-#undef NUM_ARGS
}
/*
@@ -2077,28 +2052,10 @@ TclInvokeObjectCommand(
register const char **argv) /* Argument strings. */
{
Command *cmdPtr = (Command *) clientData;
- register Tcl_Obj *objPtr;
- register int i;
- int length, result;
-
- /*
- * This function generates an objv array for object arguments that hold
- * the argv strings. It starts out with stack-allocated space but uses
- * dynamically-allocated storage if needed.
- */
-
-#define NUM_ARGS 20
- Tcl_Obj *(argStorage[NUM_ARGS]);
- register Tcl_Obj **objv = argStorage;
-
- /*
- * Create the object argument array "objv". Make sure objv is large enough
- * to hold the objc arguments plus 1 extra for the zero end-of-objv word.
- */
-
- if (argc > NUM_ARGS) {
- objv = (Tcl_Obj **) ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
- }
+ Tcl_Obj *objPtr;
+ int i, length, result;
+ Tcl_Obj **objv = (Tcl_Obj **)
+ TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
for (i = 0; i < argc; i++) {
length = strlen(argv[i]);
@@ -2129,11 +2086,8 @@ TclInvokeObjectCommand(
objPtr = objv[i];
Tcl_DecrRefCount(objPtr);
}
- if (objv != argStorage) {
- ckfree((char *) objv);
- }
+ TclStackFree(interp); /* objv */
return result;
-#undef NUM_ARGS
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fd3fb34..7e4148e 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.266 2007/04/01 00:32:27 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.267 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -115,7 +115,6 @@ static char *resultStrings[] = {
#ifdef TCL_COMPILE_STATS
long tclObjsAlloced = 0;
long tclObjsFreed = 0;
-#define TCL_MAX_SHARED_OBJ_STATS 5
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 516ffcf..a7f5478 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.36 2005/11/01 15:30:52 dkf Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.37 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -999,8 +999,8 @@ TclFileAttrsCmd(
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
- attributeStrings = (CONST char **)
- ckalloc((1+numObjStrings) * sizeof(char*));
+ attributeStrings = (CONST char **) TclStackAlloc(interp,
+ (1+numObjStrings) * sizeof(char*));
for (index = 0; index < numObjStrings; index++) {
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
attributeStrings[index] = TclGetString(objPtr);
@@ -1110,7 +1110,7 @@ TclFileAttrsCmd(
* Free up the array we allocated.
*/
- ckfree((char*)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 adb94d0..131a8d5 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.78 2007/02/20 23:24:03 nijtmans Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.79 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -1410,7 +1410,8 @@ Tcl_GlobObjCmd(
*/
Tcl_ListObjLength(interp, typePtr, &length);
- globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
+ globTypes = (Tcl_GlobTypeData*)
+ TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1626,7 +1627,7 @@ Tcl_GlobObjCmd(
if (globTypes->macCreator != NULL) {
Tcl_DecrRefCount(globTypes->macCreator);
}
- ckfree((char *) globTypes);
+ TclStackFree(interp); /* globTypes */
}
return result;
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 108af57..542aeb6 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.38 2007/02/20 23:24:04 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.39 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -794,12 +794,10 @@ Tcl_ExecObjCmd(
* storage if needed.
*/
-#define NUM_ARGS 20
Tcl_Obj *resultPtr;
const char **argv;
char *string;
Tcl_Channel chan;
- const char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
int ignoreStderr;
static const char *options[] = {
@@ -854,11 +852,9 @@ Tcl_ExecObjCmd(
* to hold the argc arguments plus 1 extra for the zero end-of-argv word.
*/
- argv = argStorage;
argc = objc - skip;
- if ((size_t)(argc + 1) > sizeof(argv) / sizeof(argv[0])) {
- argv = (const char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
- }
+ argv = (const char **)
+ TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
/*
* Copy the string conversions of each (post option) object into the
@@ -873,12 +869,10 @@ Tcl_ExecObjCmd(
(ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
/*
- * Free the argv array if malloc'ed storage was used.
+ * Free the argv array.
*/
- if (argv != argStorage) {
- ckfree((char *)argv);
- }
+ TclStackFree(interp); /* argv */
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index df658dd..af0b444 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.31 2006/04/06 18:57:58 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.32 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -525,12 +525,12 @@ Tcl_WrongNumArgs(
len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = ckalloc((unsigned) len);
+ char *quotedElementStr = TclStackAlloc(interp, (unsigned) len);
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
- ckfree(quotedElementStr);
+ TclStackFree(interp); /* quotedElementStr */
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
@@ -573,12 +573,12 @@ Tcl_WrongNumArgs(
len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = ckalloc((unsigned) len);
+ char *quotedElementStr = TclStackAlloc(interp,(unsigned) len);
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
- ckfree(quotedElementStr);
+ TclStackFree(interp); /* quotedElementStr */
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0bd79c4..6e9c041 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.70 2006/11/28 22:20:29 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.71 2007/04/02 18:48:03 dgp Exp $
*/
#include "tclInt.h"
@@ -1085,7 +1085,8 @@ Tcl_CreateAlias(
int i;
int result;
- objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
+ objv = (Tcl_Obj **)
+ TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
@@ -1103,7 +1104,7 @@ Tcl_CreateAlias(
for (i = 0; i < argc; i++) {
Tcl_DecrRefCount(objv[i]);
}
- ckfree((char *) objv);
+ TclStackFree(slaveInterp); /* objv */
Tcl_DecrRefCount(targetObjPtr);
Tcl_DecrRefCount(slaveObjPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 605a7d8..e5587fb 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.127 2007/03/21 18:02:51 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.128 2007/04/02 18:48:04 dgp Exp $
*/
#include "tclInt.h"
@@ -4094,7 +4094,6 @@ NamespacePathCmd(
int i, nsObjc, result = TCL_ERROR;
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
- Tcl_Namespace *staticNs[4];
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
@@ -4127,12 +4126,9 @@ NamespacePathCmd(
goto badNamespace;
}
if (nsObjc != 0) {
- if (nsObjc > 4) {
- namespaceList = (Tcl_Namespace **)
- ckalloc(sizeof(Tcl_Namespace *) * nsObjc);
- } else {
- namespaceList = staticNs;
- }
+
+ namespaceList = (Tcl_Namespace **)
+ TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc);
for (i=0 ; i<nsObjc ; i++) {
if (TclGetNamespaceFromObj(interp, nsObjv[i],
@@ -4155,8 +4151,8 @@ NamespacePathCmd(
result = TCL_OK;
badNamespace:
- if (namespaceList != NULL && namespaceList != staticNs) {
- ckfree((char *) namespaceList);
+ if (namespaceList != NULL) {
+ TclStackFree(interp); /* namespaceList */
}
return result;
}
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 3d0244c..4301c8b 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.34 2006/10/23 21:36:55 msofer Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.35 2007/04/02 18:48:04 dgp Exp $
*/
#include "tclInt.h"
@@ -1657,7 +1657,7 @@ CallTraceFunction(
* Copy the command characters into a new string.
*/
- commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
+ commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
memcpy((void *) commandCopy, (void *) command, (size_t) numChars);
commandCopy[numChars] = '\0';
@@ -1668,8 +1668,8 @@ CallTraceFunction(
traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*) iPtr,
iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
- ckfree((char *) commandCopy);
- return(traceCode);
+ TclStackFree(interp); /* commandCopy */
+ return traceCode;
}
/*
@@ -2230,8 +2230,8 @@ StringTraceProc(
* which uses strings for everything.
*/
- argv = (CONST char **)
- ckalloc((unsigned) ((objc + 1) * sizeof(CONST char *)));
+ argv = (CONST char **) TclStackAlloc(interp,
+ (unsigned) ((objc + 1) * sizeof(CONST char *)));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
}
@@ -2245,7 +2245,7 @@ StringTraceProc(
(data->proc)(data->clientData, interp, level, (char *) command,
cmdPtr->proc, cmdPtr->clientData, objc, argv);
- ckfree((char *) argv);
+ TclStackFree(interp); /* argv */
return TCL_OK;
}
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 3cc4759..a6ec0e4 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.37 2007/02/20 23:24:07 nijtmans Exp $
+ * RCS: @(#) $Id: tclUnixPipe.c,v 1.38 2007/04/02 18:48:04 dgp Exp $
*/
#include "tclInt.h"
@@ -421,8 +421,9 @@ TclpCreateProcess(
* deallocated later
*/
- dsArray = (Tcl_DString *) ckalloc(argc * sizeof(Tcl_DString));
- newArgv = (char **) ckalloc((argc+1) * sizeof(char *));
+ dsArray = (Tcl_DString *)
+ TclStackAlloc(interp, argc * sizeof(Tcl_DString));
+ newArgv = (char **) TclStackAlloc(interp, (argc+1) * sizeof(char *));
newArgv[argc] = NULL;
for (i = 0; i < argc; i++) {
newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
@@ -484,8 +485,8 @@ TclpCreateProcess(
for (i = 0; i < argc; i++) {
Tcl_DStringFree(&dsArray[i]);
}
- ckfree((char *) dsArray);
- ckfree((char *) newArgv);
+ TclStackFree(interp); /* newArgv */
+ TclStackFree(interp); /* dsArray */
if (pid == -1) {
Tcl_AppendResult(interp, "couldn't fork child process: ",