From 255b6f78419e20a2954baaab97b26182a4b27c76 Mon Sep 17 00:00:00 2001 From: hobbs Date: Thu, 21 Oct 1999 02:16:21 +0000 Subject: * unix/tclUnixNotfy.c: fixed event/io threading problems by making triggerPipe non-blocking * library/tcltest1.0/tcltest.tcl: * generic/tclThreadTest.c: fixed mem leaks in threads * generic/tclResult.c: fixed Tcl_AppendResultVA so it only iterates once over the va_list (avoiding a memcpy of it, which is not portable). * generic/regc_color.c: fixed mem leak and assertion, from HS * generic/tclCompile.c: removed savedChar trick that appeared to be causing a segv when the literal table was released * tests/string.test: * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when indexing into one (test case string-5.16) [Bug: 2871] --- generic/regc_color.c | 4 +- generic/tclCmdMZ.c | 4 +- generic/tclCompile.c | 6 +-- generic/tclResult.c | 57 ++++++++++++++++++++------- generic/tclThreadTest.c | 101 ++++++++++++++++++++++++++++++++++++++++++------ 5 files changed, 136 insertions(+), 36 deletions(-) diff --git a/generic/regc_color.c b/generic/regc_color.c index 000d0ea..5aed21c 100644 --- a/generic/regc_color.c +++ b/generic/regc_color.c @@ -97,7 +97,7 @@ struct colormap *cm; cm->magic = 0; if (NBYTS > 1) cmtreefree(cm, cm->tree, 0); - for (i = 1; i < cm->max; i++) /* skip WHITE */ + for (i = 1; i <= cm->max; i++) /* skip WHITE */ if (!UNUSEDCOLOR(&cm->cd[i])) { cb = cm->cd[i].block; if (cb != NULL) @@ -456,7 +456,7 @@ struct state *rp; color co; color sco; - assert((uc & BYTMASK) == 0); + assert((uc % BYTTAB) == 0); /* find its color block, making new pointer blocks as needed */ t = cm->tree; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 8758660..bd00b56 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.20 1999/09/21 04:20:40 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.21 1999/10/21 02:16:21 hobbs Exp $ */ #include "tclInt.h" @@ -1109,7 +1109,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) &index) != TCL_OK) { return TCL_ERROR; } - Tcl_SetStringObj(resultPtr, &string1[index], 1); + Tcl_SetByteArrayObj(resultPtr, &string1[index], 1); } else { string1 = Tcl_GetStringFromObj(objv[2], &length1); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index d83a9c1..7df3815 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.16 1999/08/19 02:59:09 hobbs Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.17 1999/10/21 02:16:22 hobbs Exp $ */ #include "tclInt.h" @@ -1348,7 +1348,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr) JumpFixup jumpFixup; int maxDepth, doExprInline, range, numBytes, i, j, code; char *script; - char savedChar; int saveExprIsJustVarRef = envPtr->exprIsJustVarRef; int saveExprIsComparison = envPtr->exprIsComparison; @@ -1370,10 +1369,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr) script = tokenPtr[1].start; numBytes = tokenPtr[1].size; - savedChar = script[numBytes]; - script[numBytes] = 0; code = TclCompileExpr(interp, script, numBytes, envPtr); - script[numBytes] = savedChar; return code; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 2f18b51..663f47f 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.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: tclResult.c,v 1.3 1999/05/07 20:07:35 stanton Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.4 1999/10/21 02:16:22 hobbs Exp $ */ #include "tclInt.h" @@ -455,10 +455,12 @@ Tcl_AppendResultVA (interp, argList) * return value. */ va_list argList; /* Variable argument list. */ { +#define STATIC_LIST_SIZE 16 Interp *iPtr = (Interp *) interp; - va_list tmpArgList; - char *string; - int newSpace; + char *string, *static_list[STATIC_LIST_SIZE]; + char **args = static_list; + int nargs_space = STATIC_LIST_SIZE; + int nargs, newSpace, i; /* * If the string result is empty, move the object result to the @@ -472,17 +474,35 @@ Tcl_AppendResultVA (interp, argList) } /* - * Scan through all the arguments to see how much space is needed. + * Scan through all the arguments to see how much space is needed + * and save pointers to the arguments in the args array, + * reallocating as necessary. */ - memcpy ((VOID *) &tmpArgList, (VOID *) &argList, sizeof (tmpArgList)); + nargs = 0; newSpace = 0; while (1) { - string = va_arg(tmpArgList, char *); + string = va_arg(argList, char *); if (string == NULL) { break; } - newSpace += strlen(string); + if (nargs >= nargs_space) { + /* + * Expand the args buffer + */ + nargs_space += STATIC_LIST_SIZE; + if (args == static_list) { + args = (void *)ckalloc(nargs_space * sizeof(char *)); + for (i = 0; i < nargs; ++i) { + args[i] = static_list[i]; + } + } else { + args = (void *)ckrealloc((void *)args, + nargs_space * sizeof(char *)); + } + } + newSpace += strlen(string); + args[nargs++] = string; } /* @@ -501,14 +521,21 @@ Tcl_AppendResultVA (interp, argList) * buffer. */ - while (1) { - string = va_arg(argList, char *); - if (string == NULL) { - break; - } - strcpy(iPtr->appendResult + iPtr->appendUsed, string); - iPtr->appendUsed += strlen(string); + for (i = 0; i < nargs; ++i) { + string = args[i]; + strcpy(iPtr->appendResult + iPtr->appendUsed, string); + iPtr->appendUsed += strlen(string); + } + + /* + * If we had to allocate a buffer from the heap, + * free it now. + */ + + if (args != static_list) { + ckfree((void *)args); } +#undef STATIC_LIST_SIZE } /* diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index c24b059..113f327 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.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: tclThreadTest.c,v 1.3 1999/05/26 20:24:43 redman Exp $ + * RCS: @(#) $Id: tclThreadTest.c,v 1.4 1999/10/21 02:16:22 hobbs Exp $ */ #include "tclInt.h" @@ -135,6 +135,9 @@ static void ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); static void ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); static int ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask)); static void ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp)); +static void ThreadFreeProc _ANSI_ARGS_((ClientData clientData)); +static int ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr, + ClientData clientData)); static void ThreadExitProc _ANSI_ARGS_((ClientData clientData)); @@ -351,8 +354,7 @@ TclCreateThread(interp, script) ThreadCtrl ctrl; Tcl_ThreadId id; - ctrl.script = (char*)ckalloc( strlen(script) + 1 ); - strcpy(ctrl.script, script); + ctrl.script = (char *) script; ctrl.condWait = NULL; ctrl.flags = 0; @@ -413,10 +415,8 @@ NewThread(clientData) { ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ThreadCtrl ctrl; int result; - - ctrl = *ctrlPtr; + char *threadEvalScript; /* * Initialize the interpreter. This should be more general. @@ -432,7 +432,14 @@ NewThread(clientData) Tcl_MutexLock(&threadMutex); ListUpdateInner(tsdPtr); - Tcl_CreateThreadExitHandler(ThreadExitProc, NULL); + /* + * We need to keep a pointer to the alloc'ed mem of the script + * we are eval'ing, for the case that we exit during evaluation + */ + threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1); + strcpy(threadEvalScript, ctrlPtr->script); + + Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript); /* * Notify the parent we are alive. @@ -446,7 +453,7 @@ NewThread(clientData) */ Tcl_Preserve((ClientData) tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, ctrl.script); + result = Tcl_Eval(tsdPtr->interp, threadEvalScript); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -456,7 +463,6 @@ NewThread(clientData) */ ListRemove(tsdPtr); - ckfree((char*)ctrl.script); Tcl_Release((ClientData) tsdPtr->interp); Tcl_DeleteInterp(tsdPtr->interp); Tcl_ExitThread(result); @@ -676,7 +682,7 @@ TclThreadSend(interp, id, script, wait) threadEventPtr->script = ckalloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { - threadEventPtr->resultPtr = NULL; + resultPtr = threadEventPtr->resultPtr = NULL; } else { resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; @@ -802,7 +808,11 @@ ThreadEventProc(evPtr, mask) } else { Tcl_Preserve((ClientData) interp); Tcl_ResetResult(interp); + Tcl_CreateThreadExitHandler(ThreadFreeProc, + (ClientData) threadEventPtr->script); code = Tcl_GlobalEval(interp, threadEventPtr->script); + Tcl_DeleteThreadExitHandler(ThreadFreeProc, + (ClientData) threadEventPtr->script); result = Tcl_GetStringResult(interp); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); @@ -837,6 +847,65 @@ ThreadEventProc(evPtr, mask) /* *------------------------------------------------------------------------ * + * ThreadFreeProc -- + * + * This is called from when we are exiting and memory needs + * to be freed. + * + * Results: + * None. + * + * Side effects: + * Clears up mem specified in ClientData + * + *------------------------------------------------------------------------ + */ + /* ARGSUSED */ +void +ThreadFreeProc(clientData) + ClientData clientData; +{ + if (clientData) { + ckfree((char *) clientData); + } +} + +/* + *------------------------------------------------------------------------ + * + * ThreadDeleteEvent -- + * + * This is called from the ThreadExitProc to delete memory related + * to events that we put on the queue. + * + * Results: + * 1 it was our event and we want it removed, 0 otherwise. + * + * Side effects: + * It cleans up our events in the event queue for this thread. + * + *------------------------------------------------------------------------ + */ + /* ARGSUSED */ +int +ThreadDeleteEvent(eventPtr, clientData) + Tcl_Event *eventPtr; /* Really ThreadEvent */ + ClientData clientData; /* dummy */ +{ + if (eventPtr->proc == ThreadEventProc) { + ckfree((char *) ((ThreadEvent *) eventPtr)->script); + return 1; + } + /* + * If it was NULL, we were in the middle of servicing the event + * and it should be removed + */ + return (eventPtr->proc == NULL); +} + +/* + *------------------------------------------------------------------------ + * * ThreadExitProc -- * * This is called when the thread exits. @@ -852,13 +921,21 @@ ThreadEventProc(evPtr, mask) */ /* ARGSUSED */ void -ThreadExitProc(dummy) - ClientData dummy; +ThreadExitProc(clientData) + ClientData clientData; { + char *threadEvalScript = (char *) clientData; ThreadEventResult *resultPtr, *nextPtr; Tcl_ThreadId self = Tcl_GetCurrentThread(); Tcl_MutexLock(&threadMutex); + + if (threadEvalScript) { + ckfree((char *) threadEvalScript); + threadEvalScript = NULL; + } + Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL); + for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) { nextPtr = resultPtr->nextPtr; if (resultPtr->srcThreadId == self) { -- cgit v0.12