diff options
-rw-r--r-- | generic/tclCkalloc.c | 4 | ||||
-rw-r--r-- | generic/tclTestObj.c | 4 | ||||
-rw-r--r-- | generic/tclThread.c | 14 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 30 | ||||
-rw-r--r-- | unix/Makefile.in | 4 | ||||
-rw-r--r-- | unix/configure.in | 11 | ||||
-rw-r--r-- | unix/tclUnixFCmd.c | 4 | ||||
-rw-r--r-- | unix/tclUnixNotfy.c | 31 |
8 files changed, 60 insertions, 42 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index e498b6a..a51b52e 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -12,7 +12,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.1.2.2 1998/09/24 23:58:41 stanton Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.1.2.3 1998/12/01 05:01:01 stanton Exp $ */ #include "tclInt.h" @@ -468,12 +468,12 @@ Tcl_DbCkfree(ptr, file, line) if (validate_memory) Tcl_ValidateAllMemory(file, line); + TclpMutexLock(&ckallocMutex); ValidateMemory(memp, file, line, TRUE); if (init_malloced_bodies) { memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length); } - TclpMutexLock(&ckallocMutex); total_frees++; current_malloc_packets--; current_bytes_malloced -= memp->length; diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 471fe63..9be2520 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.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: tclTestObj.c,v 1.1.2.2 1998/09/24 23:59:03 stanton Exp $ + * RCS: @(#) $Id: tclTestObj.c,v 1.1.2.3 1998/12/01 05:01:01 stanton Exp $ */ #include "tclInt.h" @@ -851,7 +851,7 @@ TeststringobjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { int varIndex, option, i, length; -#define MAX_STRINGS 10 +#define MAX_STRINGS 11 char *index, *string, *strings[MAX_STRINGS+1]; static char *options[] = { "append", "appendstrings", "get", "get2", "length", "length2", diff --git a/generic/tclThread.c b/generic/tclThread.c index 14bb1ba..cfadfb9 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.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: tclThread.c,v 1.1.2.3 1998/11/11 04:54:20 stanton Exp $ + * RCS: @(#) $Id: tclThread.c,v 1.1.2.4 1998/12/01 05:01:02 stanton Exp $ */ #include "tclInt.h" @@ -225,23 +225,27 @@ TclRememberSyncObject(objPtr, recPtr) SyncObjRecord *recPtr; /* Record of sync objects */ { char **newList; - int i; + int i, j; /* * Save the pointer to the allocated object so it can be finalized. - * Grow the list of pointers if necessary. + * Grow the list of pointers if necessary, copying only non-NULL + * pointers to the new list. */ if (recPtr->num >= recPtr->max) { recPtr->max += 8; newList = (char **)ckalloc(recPtr->max * sizeof(char *)); - for (i=0 ; i<recPtr->num ; i++) { - newList[i] = recPtr->list[i]; + for (i=0,j=0 ; i<recPtr->num ; i++) { + if (recPtr->list[i] != NULL) { + newList[j++] = recPtr->list[i]; + } } if (recPtr->list != NULL) { ckfree((char *)recPtr->list); } recPtr->list = newList; + recPtr->num = j; } recPtr->list[recPtr->num] = objPtr; recPtr->num++; diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index e2aa6d3..5b891a4 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.1.2.2 1998/10/03 01:56:42 stanton Exp $ + * RCS: @(#) $Id: tclThreadTest.c,v 1.1.2.3 1998/12/01 05:01:02 stanton Exp $ */ #include "tclInt.h" @@ -62,11 +62,11 @@ typedef struct ThreadCtrl { * ThreadSpecificData structure for the new thread. * Might contain TP_Detached or TP_TclThread. */ Tcl_Condition condWait; - /* This condition variable is used to synchronize - * the parent and child threads. The child won't run - * until it acquires threadMutex, and the parent function - * won't complete until signaled on this condition - * variable. */ + /* This condition variable is used to synchronize + * the parent and child threads. The child won't run + * until it acquires threadMutex, and the parent function + * won't complete until signaled on this condition + * variable. */ } ThreadCtrl; /* @@ -113,12 +113,12 @@ static Tcl_Mutex threadMutex; EXTERN int TclThread_Init(Tcl_Interp *interp); EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp, - CONST char *script)); + CONST char *script)); EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id, - char *script, int wait)); + char *script, int wait)); #ifdef MAC_TCL static pascal void *NewThread _ANSI_ARGS_((ClientData clientData)); #else @@ -149,7 +149,7 @@ static void ThreadExitProc _ANSI_ARGS_((ClientData clientData)); int TclThread_Init(interp) - Tcl_Interp *interp; /* The current Tcl interpreter */ + Tcl_Interp *interp; /* The current Tcl interpreter */ { Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, @@ -197,9 +197,9 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; static char *threadOptions[] = {"create", "exit", "id", "names", - "send", "wait", "errorproc", (char *) NULL}; + "send", "wait", "errorproc", (char *) NULL}; enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES, - THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; + THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); @@ -719,7 +719,9 @@ TclThreadSend(interp, id, script, wait) Tcl_ResetResult(interp); Tcl_MutexLock(&threadMutex); - TclpConditionWait(&resultPtr->done, &threadMutex, NULL); + if (resultPtr->result == NULL) { + TclpConditionWait(&resultPtr->done, &threadMutex, NULL); + } Tcl_MutexUnlock(&threadMutex); if (resultPtr->code != TCL_OK) { if (resultPtr->errorCode) { @@ -731,7 +733,7 @@ TclThreadSend(interp, id, script, wait) ckfree(resultPtr->errorInfo); } } - Tcl_SetResult(interp, resultPtr->result, TCL_VOLATILE); + Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC); TclFinalizeCondition(&resultPtr->done); code = resultPtr->code; diff --git a/unix/Makefile.in b/unix/Makefile.in index f19d0f2..b10c995 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.1.2.7 1998/11/18 03:15:33 stanton Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.1.2.8 1998/12/01 05:01:02 stanton Exp $ # Current Tcl version; used in various names. @@ -86,7 +86,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = $(@CFLAGS_DEFAULT@) +CFLAGS = @CFLAGS@ # To disable ANSI-C procedure prototypes reverse the comment characters diff --git a/unix/configure.in b/unix/configure.in index 78f3c2c..c4ab60b 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -2,7 +2,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. AC_INIT(../generic/tcl.h) -# RCS: @(#) $Id: configure.in,v 1.1.2.3 1998/11/11 04:08:37 stanton Exp $ +# RCS: @(#) $Id: configure.in,v 1.1.2.4 1998/12/01 05:01:02 stanton Exp $ TCL_VERSION=8.1 TCL_MAJOR_VERSION=8 @@ -34,6 +34,7 @@ AC_ARG_ENABLE(threads,[ --enable-threads enable Threads support],,enable if test "$enableval" = "yes"; then AC_MSG_RESULT(Will compile with Threads support) AC_DEFINE(TCL_THREADS) + AC_DEFINE(_REENTRANT) AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) if test "$tcl_ok" = "yes"; then @@ -1145,15 +1146,15 @@ if test "$DL_OBJS" != "tclLoadNone.o" ; then fi fi -# Set the default compiler switches based on the --enable-symbols option +# Set the default compiler switches based on the --enable-symbols option AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols], [tcl_ok=$enableval], [tcl_ok=no]) if test "$tcl_ok" = "yes"; then - CFLAGS_DEFAULT=CFLAGS_DEBUG + CFLAGS='$(CFLAGS_DEBUG)' TCL_DBGX=g else - CFLAGS_DEFAULT=CFLAGS_OPTIMIZE + CFLAGS='$(CFLAGS_OPTIMIZE)' TCL_DBGX="" fi @@ -1291,8 +1292,8 @@ else fi AC_SUBST(BUILD_DLTEST) +AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) -AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX) diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 3538328..1ece331 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.1.2.3 1998/09/28 20:24:20 stanton Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.1.2.4 1998/12/01 05:01:03 stanton Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -1166,7 +1166,7 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ { struct stat statBuf; - char returnString[6]; + char returnString[7]; int result; result = TclStat(fileName, &statBuf); diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 1a09d29..398af41 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.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: tclUnixNotfy.c,v 1.1.2.3 1998/11/11 04:54:22 stanton Exp $ + * RCS: @(#) $Id: tclUnixNotfy.c,v 1.1.2.4 1998/12/01 05:01:03 stanton Exp $ */ #include "tclInt.h" @@ -84,9 +84,12 @@ typedef struct ThreadSpecificData { * from these pointers. You must hold the * notifierMutex lock before accessing these * fields. */ - Tcl_Condition waitCV; /* The notifier thread alerts a notifier + Tcl_Condition waitCV; /* Any other thread alerts a notifier * that an event is ready to be processed * by signaling this condition variable. */ + int eventReady; /* True if an event is ready to be processed. + * Used as condition flag together with + * waitCV above. */ #endif } ThreadSpecificData; @@ -194,6 +197,8 @@ Tcl_InitNotifier() ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef TCL_THREADS + tsdPtr->eventReady = 0; + /* * Start the Notifier thread if necessary. */ @@ -298,6 +303,7 @@ Tcl_AlertNotifier(clientData) #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; Tcl_MutexLock(¬ifierMutex); + tsdPtr->eventReady = 1; TclpConditionNotify(&tsdPtr->waitCV); Tcl_MutexUnlock(¬ifierMutex); #endif @@ -365,7 +371,7 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData) int index, bit; for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } @@ -438,7 +444,7 @@ Tcl_DeleteFileHandler(fd) */ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { + prevPtr = filePtr, filePtr = filePtr->nextPtr) { if (filePtr == NULL) { return; } @@ -543,7 +549,7 @@ FileHandlerEventProc(evPtr, flags) tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } @@ -675,14 +681,17 @@ Tcl_WaitForEvent(timePtr) memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); - TclpConditionWait(&tsdPtr->waitCV, ¬ifierMutex, timePtr); + if (!tsdPtr->eventReady) { + TclpConditionWait(&tsdPtr->waitCV, ¬ifierMutex, timePtr); + } + tsdPtr->eventReady = 0; if (waitForFiles && tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this thread from the - * waiting list. Don't bother to alert the notifier thread since - * we haven't added anything and it will notice the next time it - * wakes up. + * waiting list. Alert the notifier thread to recompute its select + * masks - skipping this caused a hang when trying to close a pipe + * which the notifier thread was still doing a select on. */ if (tsdPtr->prevPtr) { @@ -695,6 +704,7 @@ Tcl_WaitForEvent(timePtr) } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; + write(triggerPipe, "", 1); } @@ -721,7 +731,7 @@ Tcl_WaitForEvent(timePtr) */ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { index = filePtr->fd / (NBBY*sizeof(fd_mask)); bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask))); mask = 0; @@ -897,6 +907,7 @@ NotifierThreadProc(clientData) (((long*)(tsdPtr->readyMasks))[i]) = word; } if (found || (tsdPtr->pollState & POLL_DONE)) { + tsdPtr->eventReady = 1; TclpConditionNotify(&tsdPtr->waitCV); if (tsdPtr->onList) { /* |