* 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

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);
 }