summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorredman <redman@noemail.net>1999-08-10 17:35:14 (GMT)
committerredman <redman@noemail.net>1999-08-10 17:35:14 (GMT)
commit0bfc9b13430b2852bd39b852de8c15f730db9595 (patch)
tree17312f8cada055139e9649674bdf4d701fdf2f13
parentc498ce424205023240debef2488295b5916e61d3 (diff)
downloadtcl-0bfc9b13430b2852bd39b852de8c15f730db9595.zip
tcl-0bfc9b13430b2852bd39b852de8c15f730db9595.tar.gz
tcl-0bfc9b13430b2852bd39b852de8c15f730db9595.tar.bz2
* generic/tclListObj.c:core-8-2-b3-base
* 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). FossilOrigin-Name: cfb9ace67b1a6f28603349a246c29834927fcf0c
-rw-r--r--ChangeLog38
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclAlloc.c6
-rw-r--r--generic/tclCmdIL.c4
-rw-r--r--generic/tclDecls.h6
-rw-r--r--generic/tclIO.c36
-rw-r--r--generic/tclListObj.c4
-rw-r--r--generic/tclThread.c4
-rw-r--r--win/tclWinThrd.c71
9 files changed, 91 insertions, 82 deletions
diff --git a/ChangeLog b/ChangeLog
index dd9eb7f..dc5d259 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);
}