diff options
| -rw-r--r-- | ChangeLog | 38 | ||||
| -rw-r--r-- | generic/tcl.decls | 4 | ||||
| -rw-r--r-- | generic/tclAlloc.c | 6 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 4 | ||||
| -rw-r--r-- | generic/tclDecls.h | 6 | ||||
| -rw-r--r-- | generic/tclIO.c | 36 | ||||
| -rw-r--r-- | generic/tclListObj.c | 4 | ||||
| -rw-r--r-- | generic/tclThread.c | 4 | ||||
| -rw-r--r-- | win/tclWinThrd.c | 71 |
9 files changed, 91 insertions, 82 deletions
@@ -1,3 +1,41 @@ +1999-08-10 Scott Redman <redman@scriptics.com> + + * generic/tclListObj.c: + * generic/tcl.decls: + * generic/tclDecls.h: Applied patch from Jim Ingham to change the + prototype of Tcl_ListObjGetElements to have the last argument have + a CONST so that you can feed it the objv that you get from the + standard TclObj command proc. + + * generic/tclAlloc.c: + * generic/tclCmdIL.c: + * generic/tclIO.c: + * generic/tclThread.c: + * win/tclWinThrd.c: + * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on + Windows (and he fixed the bug in the Unix thread implementation). + +1999-08-09 Brent Welch <welch@scriptics.com> + + * generic/tcl.decls: + * generic/tclAlloc.c: + * generic/tclCkalloc.c: + * generic/tclCmdIL.c: + * generic/tclDecls.h: + * generic/tclIO.c: + * generic/tclInt.decls: + * generic/tclIntDecls.h: + * generic/tclStubInit.c: + * generic/tclVar.c: + * mac/tclMacThrd.c: + * unix/tclUnixThrd.c: + * win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c + and tclCkalloc.c so they can be linked against alternate thread + packages. Added Tcl_GetChannelNames to tclIO.c. Added + TclVarTraceExists hook so "info exists" triggers read traces + exactly like it did in Tcl 7.6. Stubs table changes to reflect new + internal and external APIs. + 1999-08-09 Jeff Hobbs <hobbs@scriptics.com> * tests/string.test: added largest_int proc to adapt for >32 bit diff --git a/generic/tcl.decls b/generic/tcl.decls index 890c80d..0ba69a9 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.25 1999/08/10 02:42:12 welch Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.26 1999/08/10 17:35:17 redman Exp $ library tcl @@ -181,7 +181,7 @@ declare 44 generic { } declare 45 generic { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \ - int *objcPtr, Tcl_Obj ***objvPtr) + int *objcPtr, Tcl_Obj * CONST **objvPtr) } declare 46 generic { int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \ diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index f66dc57..0b9bace 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclAlloc.c,v 1.7 1999/08/10 02:42:12 welch Exp $ + * RCS: @(#) $Id: tclAlloc.c,v 1.8 1999/08/10 17:35:18 redman Exp $ */ #include "tclInt.h" @@ -162,7 +162,9 @@ TclInitAlloc() { if (!allocInit) { allocInit = 1; +#ifdef TCL_THREADS allocMutexPtr = Tcl_GetAllocMutex(); +#endif } } @@ -254,7 +256,7 @@ TclpAlloc(nbytes) * may be used before any other part of Tcl. E.g., see * main() for tclsh! */ - TclAllocInit(); + TclInitAlloc(); } Tcl_MutexLock(allocMutexPtr); /* diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 0724cec..aff66e2 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.14 1999/08/10 02:42:13 welch Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.15 1999/08/10 17:35:18 redman Exp $ */ #include "tclInt.h" @@ -907,7 +907,7 @@ InfoExistsCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { char *varName; - Var *varPtr, *arrayPtr; + Var *varPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varName"); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 04fd365..ad44e96 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.26 1999/08/10 02:42:13 welch Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.27 1999/08/10 17:35:18 redman Exp $ */ #ifndef _TCLDECLS @@ -164,7 +164,7 @@ EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_(( /* 45 */ EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * listPtr, - int * objcPtr, Tcl_Obj *** objvPtr)); + int * objcPtr, Tcl_Obj * CONST ** objvPtr)); /* 46 */ EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, @@ -1284,7 +1284,7 @@ typedef struct TclStubs { void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */ int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */ int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */ - int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */ + int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj * CONST ** objvPtr)); /* 45 */ int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */ int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */ int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 245c7f7..c35147d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.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: tclIO.c,v 1.13 1999/08/10 02:42:13 welch Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.14 1999/08/10 17:35:18 redman Exp $ */ #include "tclInt.h" @@ -597,40 +597,6 @@ TclFinalizeIOSubsystem() /* *---------------------------------------------------------------------- * - * Tcl_CloseChannels -- - * - * Close all open channels in this interp, except for the - * standard input/output channels. This is useful for cleanup. - * - * Results: - * None - * - * Side effects: - * May closes one or more channels. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_CloseChannels(Tcl_Interp *interp) -{ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Channel *chanPtr, *nextChanPtr; - - for (chanPtr = tsdPtr->firstChanPtr; chanPtr != NULL; chanPtr = nextChanPtr) { - nextChanPtr = chanPtr->nextChanPtr; - if (chanPtr != (Channel *) tsdPtr->stdinChannel - && chanPtr != (Channel *) tsdPtr->stdoutChannel - && chanPtr != (Channel *) tsdPtr->stderrChannel) { - (void) Tcl_UnregisterChannel(interp, (Tcl_Channel) chanPtr); - } - } -} - - -/* - *---------------------------------------------------------------------- - * * Tcl_SetStdChannel -- * * This function is used to change the channels that are used diff --git a/generic/tclListObj.c b/generic/tclListObj.c index d4b3aba..7b00f6c 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.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: tclListObj.c,v 1.5 1999/04/28 17:06:06 stanton Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.6 1999/08/10 17:35:19 redman Exp $ */ #include "tclInt.h" @@ -305,7 +305,7 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) * is to be returned. */ int *objcPtr; /* Where to store the count of objects * referenced by objv. */ - Tcl_Obj ***objvPtr; /* Where to store the pointer to an array + Tcl_Obj * CONST **objvPtr; /* Where to store the pointer to an array * of pointers to the list's objects. */ { register List *listRepPtr; diff --git a/generic/tclThread.c b/generic/tclThread.c index 2dcd832..a192f43 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.2 1999/04/16 00:46:54 stanton Exp $ + * RCS: @(#) $Id: tclThread.c,v 1.3 1999/08/10 17:35:19 redman Exp $ */ #include "tclInt.h" @@ -403,7 +403,9 @@ TclFinalizeThreadData() } #endif } +#ifdef TCL_THREADS TclpMasterUnlock(); +#endif } /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index eaf0dc9..e12be89 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -42,6 +42,7 @@ static CRITICAL_SECTION initLock; */ static CRITICAL_SECTION allocLock; +static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
/* * Condition variables are implemented with a combination of a @@ -199,18 +200,17 @@ Tcl_GetCurrentThread() void TclpInitLock() { - if (!init) { - /* - * There is a fundamental race here that is solved by creating - * the first Tcl interpreter in a single threaded environment. - * Once the interpreter has been created, it is safe to create - * more threads that create interpreters in parallel. - */ - init = 1; - InitializeCriticalSection(&initLock); - InitializeCriticalSection(&masterLock); - InitializeCriticalSection(&allocLock); - } + if (!init) {
+ /*
+ * There is a fundamental race here that is solved by creating
+ * the first Tcl interpreter in a single threaded environment.
+ * Once the interpreter has been created, it is safe to create
+ * more threads that create interpreters in parallel.
+ */
+ init = 1;
+ InitializeCriticalSection(&initLock);
+ InitializeCriticalSection(&masterLock);
+ }
EnterCriticalSection(&initLock); } @@ -272,7 +272,6 @@ TclpMasterLock() init = 1; InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); - InitializeCriticalSection(&allocLock); } EnterCriticalSection(&masterLock); } @@ -281,54 +280,56 @@ TclpMasterLock() /* *---------------------------------------------------------------------- * - * TclpMasterUnlock + * Tcl_GetAllocMutex * - * This procedure is used to release a lock that serializes creation - * and deletion of synchronization objects. + * This procedure returns a pointer to a statically initialized + * mutex for use by the memory allocator. The alloctor must + * use this lock, because all other locks are allocated... * * Results: - * None. + * A pointer to a mutex that is suitable for passing to + * Tcl_MutexLock and Tcl_MutexUnlock. * * Side effects: - * Release the master mutex. + * None. * *---------------------------------------------------------------------- */ -void -TclpMasterUnlock() +Tcl_Mutex * +Tcl_GetAllocMutex() { - LeaveCriticalSection(&masterLock); +#ifdef TCL_THREADS
+ InitializeCriticalSection(&allocLock);
+ return &allocLockPtr; +#else + return NULL; +#endif } +#ifdef TCL_THREADS /* *---------------------------------------------------------------------- * - * Tcl_GetAllocMutex + * TclpMasterUnlock * - * This procedure returns a pointer to a statically initialized - * mutex for use by the memory allocator. The alloctor must - * use this lock, because all other locks are allocated... + * This procedure is used to release a lock that serializes creation + * and deletion of synchronization objects. * * Results: - * A pointer to a mutex that is suitable for passing to - * Tcl_MutexLock and Tcl_MutexUnlock. + * None. * * Side effects: - * None. + * Release the master mutex. * *---------------------------------------------------------------------- */ -Tcl_Mutex * -Tcl_GetAllocMutex() +void +TclpMasterUnlock() { -#ifdef TCL_THREADS - return &allocLock; -#else - return NULL; -#endif + LeaveCriticalSection(&masterLock); } |