1 Added use of Tcl_GetAllocMutex to tclAlloc.c and tclCkalloc.c so they

    can be linked against alternate thread packages.
2   Added Tcl_GetChannelNames to tclIO.c
3   Added TclVarTraceExists hook so "info exists" triggers read traces
    exactly like it did in Tcl 7.6
4   Stubs table changes to reflect new internal and external APIs

10 files changed, 225 insertions, 56 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 0d186f9..890c80d 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.24 1999/08/02 18:33:43 redman Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.25 1999/08/10 02:42:12 welch Exp $
 
 library tcl
 
@@ -1334,6 +1334,14 @@ declare 385 generic {
 declare 386 generic {
     void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
 }
+declare 387 generic {
+    Tcl_Mutex * Tcl_GetAllocMutex(void)
+}
+declare 388 generic {
+    int Tcl_GetChannelNames(Tcl_Interp *interp)
+}
+
+
 
 ##############################################################################
 
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index c44cf9f..f66dc57 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.6 1999/04/16 00:46:42 stanton Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.7 1999/08/10 02:42:12 welch Exp $
  */
 
 #include "tclInt.h"
@@ -110,7 +110,7 @@ static struct block bigBlocks = {	/* Big blocks aren't suballocated. */
  */
 
 #ifdef TCL_THREADS
-static TclpMutex allocMutex;
+static Tcl_Mutex *allocMutexPtr;
 #endif
 static int allocInit = 0;
 
@@ -162,7 +162,7 @@ TclInitAlloc()
 {
     if (!allocInit) {
 	allocInit = 1;
-	TclpMutexInit(&allocMutex);
+	allocMutexPtr = Tcl_GetAllocMutex();
     }
 }
 
@@ -196,7 +196,7 @@ TclFinalizeAllocSubsystem()
     int i;
     struct block *blockPtr, *nextPtr;
 
-    TclpMutexLock(&allocMutex);
+    Tcl_MutexLock(allocMutexPtr);
     for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
 	nextPtr = blockPtr->nextPtr;
 	TclpSysFree(blockPtr);
@@ -220,7 +220,7 @@ TclFinalizeAllocSubsystem()
 #ifdef MSTATS
     nmalloc[i] = 0;
 #endif
-    TclpMutexUnlock(&allocMutex);
+    Tcl_MutexUnlock(allocMutexPtr);
 }
 
 /*
@@ -254,11 +254,9 @@ TclpAlloc(nbytes)
 	 * may be used before any other part of Tcl.  E.g., see
 	 * main() for tclsh!
 	 */
-
-	allocInit = 1;
-	TclpMutexInit(&allocMutex);
+	TclAllocInit();
     }
-    TclpMutexLock(&allocMutex);
+    Tcl_MutexLock(allocMutexPtr);
     /*
      * First the simple case: we simple allocate big blocks directly
      */
@@ -266,7 +264,7 @@ TclpAlloc(nbytes)
 	bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 
 		(sizeof(struct block) + OVERHEAD + nbytes), 0);
 	if (bigBlockPtr == NULL) {
-	    TclpMutexUnlock(&allocMutex);
+	    Tcl_MutexUnlock(allocMutexPtr);
 	    return NULL;
 	}
 	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
@@ -289,7 +287,7 @@ TclpAlloc(nbytes)
 	op->ov_rmagic = RMAGIC;
 	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 	return (void *)(op+1);
     }
     /*
@@ -307,7 +305,7 @@ TclpAlloc(nbytes)
     while (nbytes + OVERHEAD > amt) {
 	amt <<= 1;
 	if (amt == 0) {
-	    TclpMutexUnlock(&allocMutex);
+	    Tcl_MutexUnlock(allocMutexPtr);
 	    return (NULL);
 	}
 	bucket++;
@@ -321,7 +319,7 @@ TclpAlloc(nbytes)
     if ((op = nextf[bucket]) == NULL) {
 	MoreCore(bucket);
 	if ((op = nextf[bucket]) == NULL) {
-	    TclpMutexUnlock(&allocMutex);
+	    Tcl_MutexUnlock(allocMutexPtr);
 	    return (NULL);
 	}
     }
@@ -343,7 +341,7 @@ TclpAlloc(nbytes)
     op->ov_rmagic = RMAGIC;
     *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-    TclpMutexUnlock(&allocMutex);
+    Tcl_MutexUnlock(allocMutexPtr);
     return ((char *)(op + 1));
 }
 
@@ -437,13 +435,13 @@ TclpFree(cp)
 	return;
     }
 
-    TclpMutexLock(&allocMutex);
+    Tcl_MutexLock(allocMutexPtr);
     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
     ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
     ASSERT(op->ov_magic1 == MAGIC);
     if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
 
@@ -458,7 +456,7 @@ TclpFree(cp)
 	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
 	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
 	TclpSysFree(bigBlockPtr);
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
     ASSERT(size < NBUCKETS);
@@ -467,7 +465,7 @@ TclpFree(cp)
 #ifdef MSTATS
     nmalloc[size]--;
 #endif
-    TclpMutexUnlock(&allocMutex);
+    Tcl_MutexUnlock(allocMutexPtr);
 }
 
 /*
@@ -501,14 +499,14 @@ TclpRealloc(cp, nbytes)
 	return (TclpAlloc(nbytes));
     }
 
-    TclpMutexLock(&allocMutex);
+    Tcl_MutexLock(allocMutexPtr);
 
     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
     ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
     ASSERT(op->ov_magic1 == MAGIC);
     if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 	return NULL;
     }
 
@@ -528,7 +526,7 @@ TclpRealloc(cp, nbytes)
 	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, 
 		sizeof(struct block) + OVERHEAD + nbytes);
 	if (bigBlockPtr == NULL) {
-	    TclpMutexUnlock(&allocMutex);
+	    Tcl_MutexUnlock(allocMutexPtr);
 	    return NULL;
 	}
 
@@ -554,7 +552,7 @@ TclpRealloc(cp, nbytes)
 	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
 	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 	return (char *)(op+1);
     }
     maxsize = 1 << (i+3);
@@ -568,7 +566,7 @@ TclpRealloc(cp, nbytes)
     if (expensive) {
 	void *newp;
 
-	TclpMutexUnlock(&allocMutex);
+	Tcl_MutexUnlock(allocMutexPtr);
 
 	newp = TclpAlloc(nbytes);
 	if ( newp == NULL ) {
@@ -589,7 +587,7 @@ TclpRealloc(cp, nbytes)
     op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
     *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-    TclpMutexUnlock(&allocMutex);
+    Tcl_MutexUnlock(allocMutexPtr);
     return(cp);
 }
 
@@ -621,7 +619,7 @@ mstats(s)
     int totfree = 0,
 	totused = 0;
 
-    TclpMutexLock(&allocMutex);
+    Tcl_MutexLock(allocMutexPtr);
     fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
     for (i = 0; i < NBUCKETS; i++) {
 	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
@@ -637,7 +635,7 @@ mstats(s)
 	    totused, totfree);
     fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
 	    MAXMALLOC, nmalloc[NBUCKETS]);
-    TclpMutexUnlock(&allocMutex);
+    Tcl_MutexUnlock(allocMutexPtr);
 }
 #endif
 
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index f19d597..61e744c 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -13,7 +13,7 @@
  *
  * This code contributed by Karl Lehenbauer and Mark Diekhans
  *
- * RCS: @(#) $Id: tclCkalloc.c,v 1.4 1999/04/16 00:46:42 stanton Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.5 1999/08/10 02:42:12 welch Exp $
  */
 
 #include "tclInt.h"
@@ -119,7 +119,7 @@ static char dumpFile[100];	/* Records where to dump memory allocation
  * be explicitly initialized.  This is necessary because the self
  * initializing mutexes use ckalloc...
  */
-static TclpMutex ckallocMutex;
+static Tcl_Mutex *ckallocMutexPtr;
 static int ckallocInit = 0;
 
 /*
@@ -138,8 +138,8 @@ static void		ValidateMemory _ANSI_ARGS_((
  *----------------------------------------------------------------------
  *
  * TclInitDbCkalloc --
- *     Initialize the locks used by the allocator.
- *	This is only appropriate to call in a single threaded environtment,
+ *	Initialize the locks used by the allocator.
+ *	This is only appropriate to call in a single threaded environment,
  *	such as during TclInitSubsystems.
  *
  *----------------------------------------------------------------------
@@ -149,7 +149,7 @@ TclInitDbCkalloc()
 {
     if (!ckallocInit) {
 	ckallocInit = 1;
-	TclpMutexInit(&ckallocMutex);
+	ckallocMutexPtr = Tcl_GetAllocMutex();
     }
 }
 
@@ -265,14 +265,13 @@ Tcl_ValidateAllMemory (file, line)
     struct mem_header *memScanP;
 
     if (!ckallocInit) {
-	ckallocInit = 1;
-	TclpMutexInit(&ckallocMutex);
+	TclInitDbCkalloc();
     }
-    TclpMutexLock(&ckallocMutex);
+    Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
         ValidateMemory(memScanP, file, line, FALSE);
     }
-    TclpMutexUnlock(&ckallocMutex);
+    Tcl_MutexUnlock(ckallocMutexPtr);
 }
 
 /*
@@ -303,7 +302,7 @@ Tcl_DumpActiveMemory (fileName)
 	}
     }
 
-    TclpMutexLock(&ckallocMutex);
+    Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
         address = &memScanP->body [0];
         fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
@@ -313,7 +312,7 @@ Tcl_DumpActiveMemory (fileName)
 		 (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
 	(void) fputc('\n', fileP);
     }
-    TclpMutexUnlock(&ckallocMutex);
+    Tcl_MutexUnlock(ckallocMutexPtr);
 
     if (fileP != stderr) {
 	fclose (fileP);
@@ -372,10 +371,9 @@ Tcl_DbCkalloc(size, file, line)
 	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
     }
     if (!ckallocInit) {
-	ckallocInit = 1;
-	TclpMutexInit(&ckallocMutex);
+	TclInitDbCkalloc();
     }
-    TclpMutexLock(&ckallocMutex);
+    Tcl_MutexLock(ckallocMutexPtr);
     result->length = size;
     result->tagPtr = curTagPtr;
     if (curTagPtr != NULL) {
@@ -421,7 +419,7 @@ Tcl_DbCkalloc(size, file, line)
     if (current_bytes_malloced > maximum_bytes_malloced)
         maximum_bytes_malloced = current_bytes_malloced;
 
-    TclpMutexUnlock(&ckallocMutex);
+    Tcl_MutexUnlock(ckallocMutexPtr);
 
     return result->body;
 }
@@ -469,7 +467,7 @@ Tcl_DbCkfree(ptr, file, line)
     if (validate_memory)
         Tcl_ValidateAllMemory(file, line);
 
-    TclpMutexLock(&ckallocMutex);
+    Tcl_MutexLock(ckallocMutexPtr);
     ValidateMemory(memp, file, line, TRUE);
     if (init_malloced_bodies) {
 	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
@@ -496,7 +494,7 @@ Tcl_DbCkfree(ptr, file, line)
     if (allocHead == memp)
         allocHead = memp->flink;
     TclpFree((char *) memp);
-    TclpMutexUnlock(&ckallocMutex);
+    Tcl_MutexUnlock(ckallocMutexPtr);
 
     return 0;
 }
@@ -957,7 +955,7 @@ void
 TclFinalizeMemorySubsystem()
 {
 #ifdef TCL_MEM_DEBUG
-    TclpMutexLock(&ckallocMutex);
+    Tcl_MutexLock(ckallocMutexPtr);
     if (tclMemDumpFileName != NULL) {
 	Tcl_DumpActiveMemory(tclMemDumpFileName);
     }
@@ -965,7 +963,7 @@ TclFinalizeMemorySubsystem()
 	TclpFree((char *) curTagPtr);
     }
     allocHead = NULL;
-    TclpMutexUnlock(&ckallocMutex);
+    Tcl_MutexUnlock(ckallocMutexPtr);
 #endif
 
 #if USE_TCLALLOC
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b121c67..0724cec 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.13 1999/06/17 19:31:50 stanton Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.14 1999/08/10 02:42:13 welch Exp $
  */
 
 #include "tclInt.h"
@@ -915,9 +915,7 @@ InfoExistsCmd(dummy, interp, objc, objv)
     }
 
     varName = Tcl_GetString(objv[2]);
-    varPtr = TclLookupVar(interp, varName, (char *) NULL,
-            0, "access",
-            /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    varPtr = TclVarTraceExists(interp, varName);
     if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
         Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
     } else {
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 0eda09f..04fd365 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.25 1999/08/02 18:33:43 redman Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.26 1999/08/10 02:42:13 welch Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1208,6 +1208,10 @@ EXTERN int		Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp,
 /* 386 */
 EXTERN void		Tcl_SetNotifier _ANSI_ARGS_((
 				Tcl_NotifierProcs * notifierProcPtr));
+/* 387 */
+EXTERN Tcl_Mutex *	Tcl_GetAllocMutex _ANSI_ARGS_((void));
+/* 388 */
+EXTERN int		Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1662,6 +1666,8 @@ typedef struct TclStubs {
     void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((register Tcl_Obj * objPtr, Tcl_UniChar * unicode, int length)); /* 384 */
     int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 385 */
     void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */
+    Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */
+    int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3255,6 +3261,14 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_SetNotifier \
 	(tclStubsPtr->tcl_SetNotifier) /* 386 */
 #endif
+#ifndef Tcl_GetAllocMutex
+#define Tcl_GetAllocMutex \
+	(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
+#endif
+#ifndef Tcl_GetChannelNames
+#define Tcl_GetChannelNames \
+	(tclStubsPtr->tcl_GetChannelNames) /* 388 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c0a33b0..245c7f7 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.12 1999/07/30 21:46:47 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.13 1999/08/10 02:42:13 welch Exp $
  */
 
 #include "tclInt.h"
@@ -593,6 +593,39 @@ 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);
+	}
+    }
+}
 
 
 /*
@@ -8159,4 +8192,44 @@ SetBlockMode(interp, chanPtr, mode)
     return TCL_OK;
 }
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelNames --
+ *
+ *	Return the names of all open channels in the interp.
+ *
+ * Results:
+ *	TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ *	Interp result modified with list of channel names.
+ *
+ *----------------------------------------------------------------------
+ */
 
+int
+Tcl_GetChannelNames(Tcl_Interp *interp)
+{
+    Channel *chanPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    char *name;
+
+    Tcl_ResetResult(interp);
+    chanPtr = tsdPtr->firstChanPtr;
+    while (chanPtr != NULL) {
+        if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
+	    name = "stdin";
+	} else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
+	    name = "stdout";
+	} else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
+	    name = "stderr";
+	} else {
+	    name = chanPtr->channelName;
+	}
+	Tcl_AppendElement(interp, name);
+	chanPtr = chanPtr->nextChanPtr;
+    }
+    return TCL_OK;
+}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index b4cab7c..52604a6 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.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: tclInt.decls,v 1.16 1999/08/02 17:45:37 redman Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.17 1999/08/10 02:42:14 welch Exp $
 
 library tcl
 
@@ -560,6 +560,8 @@ declare 149 generic {
     void TclHandleRelease(TclHandle handle)
 }
 
+# Added for Tcl 8.2
+
 declare 150 generic {
     int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
 }
@@ -587,6 +589,9 @@ declare 156 generic {
     void TclRegError (Tcl_Interp *interp, char *msg, \
 	    int status)
 }
+declare 157 generic {
+    Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
+}
 
 ##############################################################################
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index b6f3c8f..fea3857 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.16 1999/08/02 17:45:37 redman Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.17 1999/08/10 02:42:14 welch Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -516,6 +516,9 @@ EXTERN int		TclTestChannelEventCmd _ANSI_ARGS_((
 /* 156 */
 EXTERN void		TclRegError _ANSI_ARGS_((Tcl_Interp * interp, 
 				char * msg, int status));
+/* 157 */
+EXTERN Var *		TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp, 
+				char * varName));
 
 typedef struct TclIntStubs {
     int magic;
@@ -710,6 +713,7 @@ typedef struct TclIntStubs {
     int (*tclTestChannelCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 154 */
     int (*tclTestChannelEventCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 155 */
     void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
+    Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -1347,6 +1351,10 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclRegError \
 	(tclIntStubsPtr->tclRegError) /* 156 */
 #endif
+#ifndef TclVarTraceExists
+#define TclVarTraceExists \
+	(tclIntStubsPtr->tclVarTraceExists) /* 157 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index f79dbd4..c433c97 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.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: tclStubInit.c,v 1.26 1999/08/02 18:33:44 redman Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.27 1999/08/10 02:42:14 welch Exp $
  */
 
 #include "tclInt.h"
@@ -232,6 +232,7 @@ TclIntStubs tclIntStubs = {
     TclTestChannelCmd, /* 154 */
     TclTestChannelEventCmd, /* 155 */
     TclRegError, /* 156 */
+    TclVarTraceExists, /* 157 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
@@ -780,6 +781,8 @@ TclStubs tclStubs = {
     Tcl_AppendUnicodeToObj, /* 384 */
     Tcl_RegExpMatchObj, /* 385 */
     Tcl_SetNotifier, /* 386 */
+    Tcl_GetAllocMutex, /* 387 */
+    Tcl_GetChannelNames, /* 388 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 2dc867d..67a5cab 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.11 1999/07/22 21:50:54 redman Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.12 1999/08/10 02:42:14 welch Exp $
  */
 
 #include "tclInt.h"
@@ -4668,3 +4668,67 @@ VarErrMsg(interp, part1, part2, operation, reason)
     }
     Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceVarExists --
+ *
+ *	This is called from info exists.  We need to trigger read
+ *	and/or array traces because they may end up creating a
+ *	variable that doesn't currently exist.
+ *
+ * Results:
+ *	A pointer to the Var structure, or NULL.
+ *
+ * Side effects:
+ *	May fill in error messages in the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Var *
+TclVarTraceExists(interp, varName)
+    Tcl_Interp *interp;		/* The interpreter */
+    char *varName;		/* The variable name */
+{
+    Var *varPtr;
+    Var *arrayPtr;
+    char *msg;
+
+    /*
+     * The choice of "create" flag values is delicate here, and
+     * matches the semantics of GetVar.  Things are still not perfect,
+     * however, because if you do "info exists x" you get a varPtr
+     * and therefore trigger traces.  However, if you do 
+     * "info exists x(i)", then you only get a varPtr if x is already
+     * known to be an array.  Otherwise you get NULL, and no trace
+     * is triggered.  This matches Tcl 7.6 semantics.
+     */
+
+    varPtr = TclLookupVar(interp, varName, (char *) NULL,
+            0, "access",
+            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return NULL;
+    }
+    if ((varPtr != NULL) &&
+	    ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
+	msg = CallTraces((Interp *)interp, arrayPtr, varPtr, varName,
+		(char *) NULL, TCL_TRACE_READS);
+	if (msg != NULL) {
+	    /*
+	     * If the variable doesn't exist anymore and no-one's using
+	     * it, then free up the relevant structures and hash table entries.
+	     */
+
+	    if (TclIsVarUndefined(varPtr)) {
+		CleanupVar(varPtr, arrayPtr);
+	    }
+	    return NULL;
+	}
+    }
+    return varPtr;
+}