diff options
| -rw-r--r-- | ChangeLog | 13 | ||||
| -rw-r--r-- | generic/tclBasic.c | 68 | ||||
| -rw-r--r-- | generic/tclExecute.c | 3 | ||||
| -rw-r--r-- | generic/tclFCmd.c | 8 | ||||
| -rw-r--r-- | generic/tclFileName.c | 7 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 16 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 10 | ||||
| -rw-r--r-- | generic/tclInterp.c | 7 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 16 | ||||
| -rw-r--r-- | generic/tclTrace.c | 14 | ||||
| -rw-r--r-- | unix/tclUnixPipe.c | 11 |
11 files changed, 66 insertions, 107 deletions
@@ -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: ", |