Index: generic/tclBasic.c
===================================================================
--- generic/tclBasic.c
+++ generic/tclBasic.c
@@ -1353,14 +1353,15 @@
     Tcl_HashTable *hTablePtr;
     ResolverScheme *resPtr, *nextResPtr;
     int i;
 
     /*
-     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
+	 * unless we are exiting.
      */
 
-    if (iPtr->numLevels > 0) {
+    if ((iPtr->numLevels > 0) && !TclInExit()) {
 	Tcl_Panic("DeleteInterpProc called with active evals");
     }
 
     /*
      * The interpreter should already be marked deleted; otherwise how did we
@@ -1479,11 +1480,11 @@
     /*
      * Pop the root frame pointer and finish deleting the global
      * namespace. The order is important [Bug 1658572].
      */
 
-    if (iPtr->framePtr != iPtr->rootFramePtr) {
+    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
 	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
     }
     Tcl_PopCallFrame(interp);
     ckfree(iPtr->rootFramePtr);
     iPtr->rootFramePtr = NULL;
@@ -1600,24 +1601,24 @@
      * Location stack for uplevel/eval/... scripts which were passed through
      * proc arguments. Actually we track all arguments as we do not and cannot
      * know which arguments will be used as scripts and which will not.
      */
 
-    if (iPtr->lineLAPtr->numEntries) {
+    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
 	/*
 	 * When the interp goes away we have nothing on the stack, so there
 	 * are no arguments, so this table has to be empty.
 	 */
 
 	Tcl_Panic("Argument location tracking table not empty");
     }
 
     Tcl_DeleteHashTable(iPtr->lineLAPtr);
-    ckfree(iPtr->lineLAPtr);
+    ckfree((char *) iPtr->lineLAPtr);
     iPtr->lineLAPtr = NULL;
 
-    if (iPtr->lineLABCPtr->numEntries) {
+    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
 	/*
 	 * When the interp goes away we have nothing on the stack, so there
 	 * are no arguments, so this table has to be empty.
 	 */
 

Index: generic/tclEvent.c
===================================================================
--- generic/tclEvent.c
+++ generic/tclEvent.c
@@ -951,31 +951,42 @@
 	 */
 
 	currentAppExitPtr(INT2PTR(status));
 	Tcl_Panic("AppExitProc returned unexpectedly");
     } else {
-	/*
-	 * Use default handling.
-	 */
-
-	InvokeExitHandlers();
-
-	/*
-	 * Ensure the thread-specific data is initialised as it is used in
-	 * Tcl_FinalizeThread()
-	 */
-	
-	(void) TCL_TSD_INIT(&dataKey);
-	
-	/*
-	 * Now finalize the calling thread only (others are not safely
-	 * reachable).  Among other things, this triggers a flush of the
-	 * Tcl_Channels that may have data enqueued.
-	 */
-	
-	Tcl_FinalizeThread();
-	
+
+	if (TclFullFinalizationRequested()) {
+
+	    /*
+	     * Thorough finalization for Valgrind et al.
+	     */
+
+	    Tcl_Finalize();
+
+	} else {
+
+	    /*
+	     * Fast and deterministic exit (default behavior)
+	     */
+	    
+	    InvokeExitHandlers();
+	    
+	    /*
+	     * Ensure the thread-specific data is initialised as it is used in
+	     * Tcl_FinalizeThread()
+	     */
+	    
+	    (void) TCL_TSD_INIT(&dataKey);
+	    
+	    /*
+	     * Now finalize the calling thread only (others are not safely
+	     * reachable).  Among other things, this triggers a flush of the
+	     * Tcl_Channels that may have data enqueued.
+	     */
+	    
+	    Tcl_FinalizeThread();
+	}
 	TclpExit(status);
 	Tcl_Panic("OS exit failed!");
     }
 }
 

Index: generic/tclExecute.c
===================================================================
--- generic/tclExecute.c
+++ generic/tclExecute.c
@@ -51,10 +51,12 @@
  */
 
 static int execInitialized = 0;
 TCL_DECLARE_MUTEX(execMutex)
 
+static int cachedInExit = 0;
+
 #ifdef TCL_COMPILE_DEBUG
 /*
  * Variable that controls whether execution tracing is enabled and, if so,
  * what level of tracing is desired:
  *    0: no execution tracing
@@ -894,11 +896,11 @@
 
 static void
 DeleteExecStack(
     ExecStack *esPtr)
 {
-    if (esPtr->markerPtr) {
+    if (esPtr->markerPtr && !cachedInExit) {
 	Tcl_Panic("freeing an execStack which is still in use");
     }
 
     if (esPtr->prevPtr) {
 	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
@@ -913,10 +915,12 @@
 TclDeleteExecEnv(
     ExecEnv *eePtr)		/* Execution environment to free. */
 {
     ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
 
+	cachedInExit = TclInExit();
+
     /*
      * Delete all stacks in this exec env.
      */
 
     while (esPtr->nextPtr) {
@@ -928,14 +932,14 @@
 	DeleteExecStack(tmpPtr);
     }
 
     TclDecrRefCount(eePtr->constants[0]);
     TclDecrRefCount(eePtr->constants[1]);
-    if (eePtr->callbackPtr) {
-	Tcl_Panic("Deleting execEnv with pending NRE callbacks!");
+    if (eePtr->callbackPtr && !cachedInExit) {
+	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
     }
-    if (eePtr->corPtr) {
+    if (eePtr->corPtr && !cachedInExit) {
 	Tcl_Panic("Deleting execEnv with existing coroutine");
     }
     ckfree(eePtr);
 }
 

Index: generic/tclInt.h
===================================================================
--- generic/tclInt.h
+++ generic/tclInt.h
@@ -3783,10 +3783,12 @@
  */
 
 MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
 MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
 MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
+
+MODULE_SCOPE int	TclFullFinalizationRequested(void);
 
 /*
  *----------------------------------------------------------------
  * Macros used by the Tcl core to create and release Tcl objects.
  * TclNewObj(objPtr) creates a new object denoting an empty string.

Index: generic/tclMain.c
===================================================================
--- generic/tclMain.c
+++ generic/tclMain.c
@@ -123,10 +123,11 @@
  */
 
 MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
 static void		Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
 static void		StdinProc(ClientData clientData, int mask);
+static void     FreeMainInterp(ClientData clientData);
 
 #ifndef TCL_ASCII_MAIN
 static Tcl_ThreadDataKey dataKey;
 /*
  *----------------------------------------------------------------------
@@ -385,10 +386,17 @@
 	goto done;
     }
     if (Tcl_LimitExceeded(interp)) {
 	goto done;
     }
+    if (TclFullFinalizationRequested()) {
+	/*
+	 * Arrange for final deletion of the main interp
+	 */
+	// ARGH Munchhausen effect 
+	Tcl_CreateExitHandler(FreeMainInterp, (ClientData)interp);
+    }
 
     /*
      * Invoke the script specified on the command line, if any. Must fetch it
      * again, as the appInitProc might have reset it.
      */
@@ -595,35 +603,22 @@
      */
 
     if (!Tcl_InterpDeleted(interp)) {
 	if (!Tcl_LimitExceeded(interp)) {
 	    Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
-
+	    
 	    Tcl_IncrRefCount(cmd);
 	    Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
 	    Tcl_DecrRefCount(cmd);
 	}
-
+    }
 	/*
 	 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
 	 * is happening. Maybe interp has been deleted; maybe [exit] was
 	 * redefined, maybe we've blown up because of an exceeded limit. We
 	 * still want to cleanup and exit.
 	 */
-
-	if (!Tcl_InterpDeleted(interp)) {
-	    Tcl_DeleteInterp(interp);
-	}
-    }
-    Tcl_SetStartupScript(NULL, NULL);
-
-    /*
-     * If we get here, the master interp has been deleted. Allow its
-     * destruction with the last matching Tcl_Release.
-     */
-
-    Tcl_Release(interp);
     Tcl_Exit(exitCode);
 }
 
 #ifndef UNICODE
 void
@@ -693,10 +688,46 @@
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     return tsdPtr->mainLoopProc;
 }
 #endif /* !TCL_ASCII_MAIN */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFullFinalizationRequested --
+ *
+ *	This function returns true when either -DPURIFY is specified, or the
+ *	environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This
+ *	predicate is called at places affecting the exit sequence, so that the
+ *	default behavior is a fast and deadlock-free exit, and the modified
+ *	behavior is a more thorough finalization for debugging purposes (leak
+ *	hunting etc).
+ *
+ * Results:
+ *	A boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE int
+TclFullFinalizationRequested(void)
+{
+#ifdef PURIFY
+    return 1;
+#else
+    const char *fin;
+    Tcl_DString ds;
+    int finalize = 0;
+    
+    fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
+    finalize = ((fin != NULL) && strcmp(fin, "0"));
+    if (fin != NULL) {
+	Tcl_DStringFree(&ds);
+    }
+    return finalize;
+#endif
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * StdinProc --
@@ -876,14 +907,40 @@
     chan = Tcl_GetStdChannel(TCL_STDOUT);
     if (chan != NULL) {
 	Tcl_Flush(chan);
     }
     isPtr->prompt = PROMPT_NONE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMainInterp --
+ *
+ *	Exit handler used to cleanup the main interpreter and ancillary startup
+ *	script storage at exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMainInterp(
+    ClientData clientData)
+{
+	Tcl_Interp *interp = (Tcl_Interp *) clientData;
+
+	//if (TclInExit()) return;
+
+	if (!Tcl_InterpDeleted(interp)) {
+	    Tcl_DeleteInterp(interp);
+	}
+    Tcl_SetStartupScript(NULL, NULL);
+    Tcl_Release(interp);
 }
 
 /*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
  * End:
  */

