summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/regc_color.c4
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclResult.c57
-rw-r--r--generic/tclThreadTest.c101
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) {
generated by cgit v0.12 at 2024-08-20 02:51:32 (GMT)