* doc/Tcl_Main.3:

        * generic/tclMain.c:  Substantial rewrite and expanded documentation
        of Tcl_Main to correct a number of bugs and flaws:

                * Interactive Tcl_Main can now enter a main loop, exit
                  that loop and continue interactive operations.  The loop
                  may even exit in the midst of interactive command typing
                  without loss of the partial command.  [Bugs 486453, 474131]
                * Tcl_Main now gracefully handles deletion of its master
                  interpreter.
                * Interactive Tcl_Main can now operate with non-blocking stdin
                * Interactive Tcl_Main can now detect EOF on stdin even in
                  mid-command.  [Bug 491341]
                * Added VFS-aware internal routines for managing the
                  startup script selection.
                * Tcl variable 'tcl_interactive' is now linked to C variable
                  'tty' so that one can disable/enable interactive prompts
                  at the script level when there is no startup script.  This
                  is meant for use by the test suite.
                * Consistent use of the Tcl libraries standard channels as
                  returned by Tcl_GetStdChannel(); as opposed to the channels
                  named 'stdin', 'stdout', and 'stderr' in the master interp,
                  which can be different or unavailable.
                * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
                  master interpreter returns, assuring Tcl_Main does not return.                * Documented Tcl_Main's absence from public stub table
                * Documented that Tcl_Main does not return.
                * Documented Tcl variables set by Tcl_Main.
                * All prompts are done from a single procedure, Prompt.
                * Use of Tcl_Obj-enabled interfaces everywhere.

        * generic/tclInt.decls (TclGetStartupScriptPath,
          TclSetStartupScriptPath): New internal VFS-aware routines for
        managing the startup script of Tcl_Main.
        * generic/tclIntDecls.h:
        * generic/tclStubInit.c: make genstubs

        * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
          Tcltest_Init,TestinterpdeleteCmd):
        * tests/main.test (new):  Added new file to test suite that
        thoroughly tests generic/tclMain.c; added some new test commands
        for testing Tcl_SetMainLoop().

5 files changed, 462 insertions, 185 deletions

diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 23dfdd0..1b7915b 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,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.38 2001/11/23 01:26:47 das Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.39 2002/01/05 22:55:51 dgp Exp $
 
 library tcl
 
@@ -611,10 +611,10 @@ declare 157 generic {
     Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
 }
 declare 158 generic {
-    void TclSetStartupScriptFileName(char *filename)
+    void TclSetStartupScriptFileName(CONST char *filename)
 }
 declare 159 generic {
-    char *TclGetStartupScriptFileName(void)
+    CONST char *TclGetStartupScriptFileName(void)
 }
 #declare 160 generic {
 #    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
@@ -660,6 +660,15 @@ declare 166 generic {
                                Tcl_Obj* valuePtr   )
 }
 
+# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
+declare 167 generic {
+    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
+}
+declare 168 generic {
+    Tcl_Obj *TclGetStartupScriptPath(void)
+}
+
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 5e36ba9..9e4574e 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.31 2001/11/14 23:17:03 hobbs Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.32 2002/01/05 22:55:51 dgp Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -477,9 +477,9 @@ EXTERN Var *		TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
 				char * varName));
 /* 158 */
 EXTERN void		TclSetStartupScriptFileName _ANSI_ARGS_((
-				char * filename));
+				CONST char * filename));
 /* 159 */
-EXTERN char *		TclGetStartupScriptFileName _ANSI_ARGS_((void));
+EXTERN CONST char *	TclGetStartupScriptFileName _ANSI_ARGS_((void));
 /* Slot 160 is reserved */
 /* 161 */
 EXTERN int		TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, 
@@ -497,6 +497,11 @@ EXTERN void		TclpSetInitialEncodings _ANSI_ARGS_((void));
 EXTERN int		TclListObjSetElement _ANSI_ARGS_((Tcl_Interp* interp, 
 				Tcl_Obj* listPtr, int index, 
 				Tcl_Obj* valuePtr));
+/* 167 */
+EXTERN void		TclSetStartupScriptPath _ANSI_ARGS_((
+				Tcl_Obj * pathPtr));
+/* 168 */
+EXTERN Tcl_Obj *	TclGetStartupScriptPath _ANSI_ARGS_((void));
 
 typedef struct TclIntStubs {
     int magic;
@@ -692,8 +697,8 @@ typedef struct TclIntStubs {
     void *reserved155;
     void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
     Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
-    void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
-    char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+    void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */
+    CONST char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
     void *reserved160;
     int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
     void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
@@ -701,6 +706,8 @@ typedef struct TclIntStubs {
     void (*tclExpandCodeArray) _ANSI_ARGS_((void * envPtr)); /* 164 */
     void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 165 */
     int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* listPtr, int index, Tcl_Obj* valuePtr)); /* 166 */
+    void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */
+    Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -1309,6 +1316,14 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclListObjSetElement \
 	(tclIntStubsPtr->tclListObjSetElement) /* 166 */
 #endif
+#ifndef TclSetStartupScriptPath
+#define TclSetStartupScriptPath \
+	(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
+#endif
+#ifndef TclGetStartupScriptPath
+#define TclGetStartupScriptPath \
+	(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 8b4ef51..0678e3f 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.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: tclMain.c,v 1.14 2001/11/23 01:28:53 das Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.15 2002/01/05 22:55:52 dgp Exp $
  */
 
 #include "tcl.h"
@@ -33,9 +33,6 @@ int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
  * Declarations for various library procedures and variables (don't want
  * to include tclPort.h here, because people might copy this file out of
  * the Tcl source directory to make their own modified versions).
- * Note:  "exit" should really be declared here, but there's no way to
- * declare it without causing conflicts with other definitions elsewher
- * on some systems, so it's better just to leave it out.
  */
 
 #if !defined(MAC_TCL)
@@ -43,29 +40,42 @@ extern int		isatty _ANSI_ARGS_((int fd));
 #else
 #include <unistd.h>
 #endif
-extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
 
-static char *tclStartupScriptFileName = NULL;
+static Tcl_Obj *tclStartupScriptPath = NULL;
 
 static Tcl_MainLoopProc *mainLoopProc = NULL;
 
-typedef struct ThreadSpecificData {
-    Tcl_Interp *interp;         /* Interpreter for this thread. */
-    Tcl_DString command;        /* Used to assemble lines of terminal input
-				 * into Tcl commands. */
-    Tcl_DString line;           /* Used to read the next line from the
-				 * terminal input. */
+/* 
+ * Structure defintiion for information used to keep the state of
+ * an interactive command processor that reads lines from standard
+ * input and writes prompts and results to standard output.
+ */
+
+typedef enum {
+    PROMPT_NONE,	/* Print no prompt */
+    PROMPT_START,	/* Print prompt for command start */
+    PROMPT_CONTINUE	/* Print prompt for command continuation */
+} PromptType;
+
+typedef struct InteractiveState {
+    Tcl_Channel input;		/* The standard input channel from which
+				 * lines are read. */
     int tty;                    /* Non-zero means standard input is a 
 				 * terminal-like device.  Zero means it's
 				 * a file. */
-} ThreadSpecificData;
-Tcl_ThreadDataKey dataKey;
+    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into
+				 * Tcl commands. */
+    PromptType prompt;		/* Next prompt to print */
+    Tcl_Interp *interp;		/* Interpreter that evaluates interactive
+				 * commands. */
+} InteractiveState;
 
 /*
  * Forward declarations for procedures defined later in this file.
  */
 
-static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
+static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,
+			    PromptType *promptPtr));
 static void		StdinProc _ANSI_ARGS_((ClientData clientData,
 			    int mask));
 
@@ -73,6 +83,58 @@ static void		StdinProc _ANSI_ARGS_((ClientData clientData,
 /*
  *----------------------------------------------------------------------
  *
+ * TclSetStartupScriptPath --
+ *
+ *	Primes the startup script VFS path, used to override the
+ *      command line processing.
+ *
+ * Results:
+ *	None. 
+ *
+ * Side effects:
+ *	This procedure initializes the VFS path of the Tcl script to
+ *      run at startup.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclSetStartupScriptPath(pathPtr)
+    Tcl_Obj *pathPtr;
+{
+    if (tclStartupScriptPath != NULL) {
+	Tcl_DecrRefCount(tclStartupScriptPath);
+    }
+    tclStartupScriptPath = pathPtr;
+    if (tclStartupScriptPath != NULL) {
+	Tcl_IncrRefCount(tclStartupScriptPath);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetStartupScriptPath --
+ *
+ *	Gets the startup script VFS path, used to override the
+ *      command line processing.
+ *
+ * Results:
+ *	The startup script VFS path, NULL if none has been set.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *TclGetStartupScriptPath()
+{
+    return tclStartupScriptPath;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclSetStartupScriptFileName --
  *
  *	Primes the startup script file name, used to override the
@@ -88,9 +150,10 @@ static void		StdinProc _ANSI_ARGS_((ClientData clientData,
  *----------------------------------------------------------------------
  */
 void TclSetStartupScriptFileName(fileName)
-    char *fileName;
+    CONST char *fileName;
 {
-    tclStartupScriptFileName = fileName;
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+    TclSetStartupScriptPath(pathPtr);
 }
 
 
@@ -110,9 +173,9 @@ void TclSetStartupScriptFileName(fileName)
  *
  *----------------------------------------------------------------------
  */
-char *TclGetStartupScriptFileName()
+CONST char *TclGetStartupScriptFileName()
 {
-    return tclStartupScriptFileName;
+    return Tcl_GetString(TclGetStartupScriptPath());
 }
 
 
@@ -148,22 +211,18 @@ Tcl_Main(argc, argv, appInitProc)
 {
     Tcl_Obj *resultPtr;
     Tcl_Obj *commandPtr = NULL;
-    char buffer[1000], *args;
-    int code, gotPartial, length;
+    char buffer[TCL_INTEGER_SPACE + 5], *args;
+    PromptType prompt = PROMPT_START;
+    int code, length, tty;
     int exitCode = 0;
     Tcl_Channel inChannel, outChannel, errChannel;
     Tcl_Interp *interp;
     Tcl_DString argString;
-    ThreadSpecificData *tsdPtr;
 
     Tcl_FindExecutable(argv[0]);
 
-    tsdPtr = (ThreadSpecificData *) 
-	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    tsdPtr->interp = interp = Tcl_CreateInterp();
-#ifdef TCL_MEM_DEBUG
+    interp = Tcl_CreateInterp();
     Tcl_InitMemory(interp);
-#endif
 
     /*
      * Make command-line arguments available in the Tcl variables "argc"
@@ -171,9 +230,9 @@ Tcl_Main(argc, argv, appInitProc)
      * strip it off and use it as the name of a script file to process.
      */
 
-    if (tclStartupScriptFileName == NULL) {
+    if (TclGetStartupScriptPath() == NULL) {
 	if ((argc > 1) && (argv[1][0] != '-')) {
-	    tclStartupScriptFileName = argv[1];
+	    TclSetStartupScriptFileName(argv[1]);
 	    argc--;
 	    argv++;
 	}
@@ -184,14 +243,14 @@ Tcl_Main(argc, argv, appInitProc)
     Tcl_DStringFree(&argString);
     ckfree(args);
 
-    if (tclStartupScriptFileName == NULL) {
+    if (TclGetStartupScriptPath() == NULL) {
 	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
     } else {
-	tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
-		tclStartupScriptFileName, -1, &argString);
+	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
+		TclGetStartupScriptFileName(), -1, &argString));
     }
 
-    TclFormatInt(buffer, argc-1);
+    TclFormatInt(buffer, (long) argc-1);
     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
 
@@ -199,15 +258,16 @@ Tcl_Main(argc, argv, appInitProc)
      * Set the "tcl_interactive" variable.
      */
 
-    tsdPtr->tty = isatty(0);
+    tty = isatty(0);
     Tcl_SetVar(interp, "tcl_interactive",
-	    ((tclStartupScriptFileName == NULL) && tsdPtr->tty) ? "1" : "0",
+	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
 	    TCL_GLOBAL_ONLY);
     
     /*
      * Invoke application-specific initialization.
      */
 
+    Tcl_Preserve((ClientData) interp);
     if ((*appInitProc)(interp) != TCL_OK) {
 	errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	if (errChannel) {
@@ -217,17 +277,21 @@ Tcl_Main(argc, argv, appInitProc)
 	    Tcl_WriteChars(errChannel, "\n", 1);
 	}
     }
+    if (Tcl_InterpDeleted(interp)) {
+	goto done;
+    }
 
     /*
      * If a script file was specified then just source that file
      * and quit.
      */
 
-    if (tclStartupScriptFileName != NULL) {
-	code = Tcl_EvalFile(interp, tclStartupScriptFileName);
+    if (TclGetStartupScriptPath() != NULL) {
+	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
 	if (code != TCL_OK) {
 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	    if (errChannel) {
+
 		/*
 		 * The following statement guarantees that the errorInfo
 		 * variable is set properly.
@@ -260,49 +324,44 @@ Tcl_Main(argc, argv, appInitProc)
     commandPtr = Tcl_NewObj();
     Tcl_IncrRefCount(commandPtr);
 
+    /*
+     * Get a new value for tty if anyone writes to ::tcl_interactive
+     */
+    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
     inChannel = Tcl_GetStdChannel(TCL_STDIN);
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-    gotPartial = 0;
-    while (1) {
-	if (tsdPtr->tty) {
-	    Tcl_Obj *promptCmdPtr;
-
-	    promptCmdPtr = Tcl_GetVar2Ex(interp,
-		    (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
-		    NULL, TCL_GLOBAL_ONLY);
-	    if (promptCmdPtr == NULL) {
-                defaultPrompt:
-		if (!gotPartial && outChannel) {
-		    Tcl_WriteChars(outChannel, "% ", 2);
-		}
-	    } else {
-		code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
-		inChannel = Tcl_GetStdChannel(TCL_STDIN);
-		outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-		errChannel = Tcl_GetStdChannel(TCL_STDERR);
-		if (code != TCL_OK) {
-		    if (errChannel) {
-			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-			Tcl_WriteChars(errChannel, "\n", 1);
-		    }
-		    Tcl_AddErrorInfo(interp,
-			    "\n    (script that generates prompt)");
-		    goto defaultPrompt;
-		}
+    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
+	if (tty) {
+	    Prompt(interp, &prompt);
+	    if (Tcl_InterpDeleted(interp)) {
+		break;
 	    }
-	    if (outChannel) {
-		Tcl_Flush(outChannel);
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    if (inChannel == (Tcl_Channel) NULL) {
+	        break;
 	    }
 	}
-	if (!inChannel) {
-	    goto done;
-	}
         length = Tcl_GetsObj(inChannel, commandPtr);
 	if (length < 0) {
-	    goto done;
-	}
-	if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
-	    goto done;
+	    if (Tcl_InputBlocked(inChannel)) {
+
+		/*
+		 * This can only happen if stdin has been set to
+		 * non-blocking.  In that case cycle back and try
+		 * again.  This sets up a tight polling loop (since
+		 * we have no event loop running).  If this causes
+		 * bad CPU hogging, we might try toggling the blocking
+		 * on stdin instead.
+		 */
+
+		continue;
+	    }
+
+	    /* 
+	     * Either EOF, or an error on stdin; we're done
+	     */
+
+	    break;
 	}
 
         /*
@@ -311,12 +370,12 @@ Tcl_Main(argc, argv, appInitProc)
 
 	Tcl_AppendToObj(commandPtr, "\n", 1);
 	if (!TclObjCommandComplete(commandPtr)) {
-	    gotPartial = 1;
+	    prompt = PROMPT_CONTINUE;
 	    continue;
 	}
 
-	gotPartial = 0;
-	code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
+	prompt = PROMPT_START;
+	code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
 	inChannel = Tcl_GetStdChannel(TCL_STDIN);
 	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 	errChannel = Tcl_GetStdChannel(TCL_STDERR);
@@ -328,7 +387,7 @@ Tcl_Main(argc, argv, appInitProc)
 		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
 		Tcl_WriteChars(errChannel, "\n", 1);
 	    }
-	} else if (tsdPtr->tty) {
+	} else if (tty) {
 	    resultPtr = Tcl_GetObjResult(interp);
 	    Tcl_GetStringFromObj(resultPtr, &length);
 	    if ((length > 0) && outChannel) {
@@ -337,43 +396,71 @@ Tcl_Main(argc, argv, appInitProc)
 	    }
 	}
 	if (mainLoopProc != NULL) {
+
 	    /*
 	     * If a main loop has been defined while running interactively,
 	     * we want to start a fileevent based prompt by establishing a
 	     * channel handler for stdin.
 	     */
 
+	    InteractiveState *isPtr = NULL;
+
 	    if (inChannel) {
+	        if (tty) {
+		    Prompt(interp, &prompt);
+	        }
+		isPtr = (InteractiveState *) 
+			ckalloc((int) sizeof(InteractiveState));
+		isPtr->input = inChannel;
+		isPtr->tty = tty;
+		isPtr->commandPtr = commandPtr;
+		isPtr->prompt = prompt;
+		isPtr->interp = interp;
+
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
+			TCL_LINK_BOOLEAN);
+
 		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
-			(ClientData) inChannel);
+			(ClientData) isPtr);
 	    }
-	    if (tsdPtr->tty) {
-		Prompt(interp, 0);
-	    }
-	    Tcl_DStringInit(&tsdPtr->command);
-	    Tcl_DStringInit(&tsdPtr->line);
 
 	    (*mainLoopProc)();
 	    mainLoopProc = NULL;
-	    break;
+
+	    if (inChannel) {
+		tty = isPtr->tty;
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
+			TCL_LINK_BOOLEAN);
+		prompt = isPtr->prompt;
+		if (isPtr->input != (Tcl_Channel) NULL) {
+		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
+			    (ClientData) isPtr);
+		}
+		ckfree((char *)isPtr);
+	    }
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	}
 #ifdef TCL_MEM_DEBUG
+
+	/*
+	 * This code here only for the (unsupported and deprecated)
+	 * [checkmem] command.
+	 */
+
 	if (tclMemDumpFileName != NULL) {
-	    Tcl_DecrRefCount(commandPtr);
+	    mainLoopProc = NULL;
 	    Tcl_DeleteInterp(interp);
-	    Tcl_Exit(0);
 	}
 #endif
     }
 
-    /*
-     * Rather than calling exit, invoke the "exit" command so that
-     * users can replace "exit" with some other command to do additional
-     * cleanup on exit.  The Tcl_Eval call should never return.
-     */
-
     done:
     if ((exitCode == 0) && (mainLoopProc != NULL)) {
+
 	/*
 	 * If everything has gone OK so far, call the main loop proc,
 	 * if it exists.  Packages (like Tk) can set it to start processing
@@ -386,8 +473,36 @@ Tcl_Main(argc, argv, appInitProc)
     if (commandPtr != NULL) {
 	Tcl_DecrRefCount(commandPtr);
     }
-    sprintf(buffer, "exit %d", exitCode);
-    Tcl_Eval(interp, buffer);
+
+    /*
+     * Rather than calling exit, invoke the "exit" command so that
+     * users can replace "exit" with some other command to do additional
+     * cleanup on exit.  The Tcl_Eval call should never return.
+     */
+
+    if (!Tcl_InterpDeleted(interp)) {
+        sprintf(buffer, "exit %d", exitCode);
+        Tcl_Eval(interp, buffer);
+
+        /*
+         * If Tcl_Eval returns, trying to eval [exit], something
+         * unusual is happening.  Maybe interp has been deleted;
+         * maybe [exit] was redefined.  We still want to cleanup
+         * and exit.
+         */
+
+        if (!Tcl_InterpDeleted(interp)) {
+            Tcl_DeleteInterp(interp);
+        }
+    }
+
+    /*
+     * If we get here, the master interp has been deleted.  Allow
+     * its destruction with the last matching Tcl_Release.
+     */
+
+    Tcl_Release((ClientData) interp);
+    Tcl_Exit(exitCode);
 }
 
 /*
@@ -437,40 +552,38 @@ Tcl_SetMainLoop(proc)
     /* ARGSUSED */
 static void
 StdinProc(clientData, mask)
-    ClientData clientData;		/* Not used. */
+    ClientData clientData;		/* The state of interactive cmd line */
     int mask;				/* Not used. */
 {
-    static int gotPartial = 0;
-    char *cmd;
-    int code, count;
-    Tcl_Channel chan = (Tcl_Channel) clientData;
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    Tcl_Interp *interp = tsdPtr->interp;
-
-    count = Tcl_Gets(chan, &tsdPtr->line);
-
-    if (count < 0) {
-	if (!gotPartial) {
-	    if (tsdPtr->tty) {
-		Tcl_Exit(0);
-	    } else {
-		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
-	    }
+    InteractiveState *isPtr = (InteractiveState *) clientData;
+    Tcl_Channel chan = isPtr->input;
+    Tcl_Obj *commandPtr = isPtr->commandPtr;
+    Tcl_Interp *interp = isPtr->interp;
+    int code, length;
+
+    length = Tcl_GetsObj(chan, commandPtr);
+    if (length < 0) {
+	if (Tcl_InputBlocked(chan)) {
 	    return;
-	} 
+	}
+	if (isPtr->tty) {
+	    /*
+	     * Would be better to find a way to exit the mainLoop?
+	     * Or perhaps evaluate [exit]?  Leaving as is for now due
+	     * to compatibility concerns.
+	     */
+	    Tcl_Exit(0);
+	}
+	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
+	return;
     }
 
-    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
-            &tsdPtr->line), -1);
-    Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
-    cmd = Tcl_DStringValue(&tsdPtr->command);
-    Tcl_DStringFree(&tsdPtr->line);
-    if (!Tcl_CommandComplete(cmd)) {
-        gotPartial = 1;
+    Tcl_AppendToObj(commandPtr, "\n", 1);
+    if (!TclObjCommandComplete(commandPtr)) {
+        isPtr->prompt = PROMPT_CONTINUE;
         goto prompt;
     }
-    gotPartial = 0;
+    isPtr->prompt = PROMPT_START;
 
     /*
      * Disable the stdin channel handler while evaluating the command;
@@ -480,34 +593,41 @@ StdinProc(clientData, mask)
      * command being evaluated.
      */
 
-    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
-    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
-    
-    chan = Tcl_GetStdChannel(TCL_STDIN);
-    if (chan) {
+    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
+    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
+    isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
+    Tcl_DecrRefCount(commandPtr);
+    isPtr->commandPtr = commandPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(commandPtr);
+    if (chan != (Tcl_Channel) NULL) {
 	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
-		(ClientData) chan);
+		(ClientData) isPtr);
     }
-    Tcl_DStringFree(&tsdPtr->command);
-    if (Tcl_GetStringResult(interp)[0] != '\0') {
-	if ((code != TCL_OK) || (tsdPtr->tty)) {
-	    chan = Tcl_GetStdChannel(TCL_STDOUT);
-	    if (chan) {
-		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-		Tcl_WriteChars(chan, "\n", 1);
-	    }
+    if (code != TCL_OK) {
+	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	if (errChannel != (Tcl_Channel) NULL) {
+	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(errChannel, "\n", 1);
+	}
+    } else if (isPtr->tty) {
+	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	Tcl_GetStringFromObj(resultPtr, &length);
+	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteObj(outChannel, resultPtr);
+	    Tcl_WriteChars(outChannel, "\n", 1);
 	}
     }
 
     /*
-     * Output a prompt.
+     * If a tty stdin is still around, output a prompt.
      */
 
     prompt:
-    if (tsdPtr->tty) {
-	Prompt(interp, gotPartial);
+    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
+	Prompt(interp, &(isPtr->prompt));
+	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
     }
-    Tcl_ResetResult(interp);
 }
 
 /*
@@ -529,45 +649,39 @@ StdinProc(clientData, mask)
  */
 
 static void
-Prompt(interp, partial)
+Prompt(interp, promptPtr)
     Tcl_Interp *interp;			/* Interpreter to use for prompting. */
-    int partial;			/* Non-zero means there already
-					 * exists a partial command, so use
-					 * the secondary prompt. */
+    PromptType *promptPtr;		/* Points to type of prompt to print.
+					 * Filled with PROMPT_NONE after a
+					 * prompt is printed. */
 {
-    char *promptCmd;
+    Tcl_Obj *promptCmdPtr;
     int code;
     Tcl_Channel outChannel, errChannel;
 
-    promptCmd = Tcl_GetVar(interp,
-	partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
-    if (promptCmd == NULL) {
-defaultPrompt:
-	if (!partial) {
-
-            /*
-             * We must check that outChannel is a real channel - it
-             * is possible that someone has transferred stdout out of
-             * this interpreter with "interp transfer".
-             */
-
-	    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
-            if (outChannel != (Tcl_Channel) NULL) {
-                Tcl_WriteChars(outChannel, "% ", 2);
-            }
+    if (*promptPtr == PROMPT_NONE) {
+	return;
+    }
+
+    promptCmdPtr = Tcl_GetVar2Ex(interp,
+	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+	    NULL, TCL_GLOBAL_ONLY);
+    if (Tcl_InterpDeleted(interp)) {
+	return;
+    }
+    if (promptCmdPtr == NULL) {
+	defaultPrompt:
+	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	if ((*promptPtr == PROMPT_START)
+		&& (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteChars(outChannel, "% ", 2);
 	}
     } else {
-	code = Tcl_Eval(interp, promptCmd);
+	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (script that generates prompt)");
-            /*
-             * We must check that errChannel is a real channel - it
-             * is possible that someone has transferred stderr out of
-             * this interpreter with "interp transfer".
-             */
-            
-	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
             if (errChannel != (Tcl_Channel) NULL) {
                 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                 Tcl_WriteChars(errChannel, "\n", 1);
@@ -575,8 +689,9 @@ defaultPrompt:
 	    goto defaultPrompt;
 	}
     }
-    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
     if (outChannel != (Tcl_Channel) NULL) {
 	Tcl_Flush(outChannel);
     }
+    *promptPtr = PROMPT_NONE;
 }
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 0a03bc9..9f739bd 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.65 2001/11/23 01:29:01 das Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.66 2002/01/05 22:55:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -246,6 +246,8 @@ TclIntStubs tclIntStubs = {
     TclExpandCodeArray, /* 164 */
     TclpSetInitialEncodings, /* 165 */
     TclListObjSetElement, /* 166 */
+    TclSetStartupScriptPath, /* 167 */
+    TclGetStartupScriptPath, /* 168 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 029d0b9..2b977f2 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.34 2001/11/23 01:29:07 das Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.35 2002/01/05 22:55:52 dgp Exp $
  */
 
 #define TCL_TEST
@@ -107,6 +107,12 @@ typedef struct TclEncoding {
 static int freeCount;
 
 /*
+ * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
+ * commands.
+ */
+static int exitMainLoop = 0;
+
+/*
  * Forward declarations for procedures defined later in this file:
  */
 
@@ -239,6 +245,10 @@ static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Value *resultPtr));
 static int		TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
+static int		TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int argc, char **argv));
 static Tcl_Channel	PretendTclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *filename, char *modeString, int permissions));
 static Tcl_Channel	TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp,
@@ -408,7 +418,15 @@ Tcltest_Init(interp)
     Tcl_Interp *interp;		/* Interpreter for application. */
 {
     Tcl_ValueType t3ArgTypes[2];
-	
+
+    Tcl_Obj *listPtr;
+    Tcl_Obj **objv;
+    int objc, index;
+    static char *specialOptions[] = {
+	"-appinitprocerror", "-appinitprocdeleteinterp",
+	"-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
+    };
+
     if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
         return TCL_ERROR;
     }
@@ -532,6 +550,10 @@ Tcltest_Init(interp)
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -544,6 +566,42 @@ Tcltest_Init(interp)
 #endif
 
     /*
+     * Check for special options used in ../tests/main.test
+     */
+
+    listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
+    if (listPtr != NULL) {
+        if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	    return TCL_ERROR;
+        }
+        if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
+		TCL_EXACT, &index) == TCL_OK)) {
+	    switch (index) {
+	        case 0: {
+		    return TCL_ERROR;
+	        }
+	        case 1: {
+		    Tcl_DeleteInterp(interp);
+		    return TCL_ERROR;
+	        }
+	        case 2: {
+		    int mode;
+		    Tcl_UnregisterChannel(interp, 
+			    Tcl_GetChannel(interp, "stderr", &mode));
+		    return TCL_ERROR;
+	        }
+	        case 3: {
+		    if (objc-1) {
+		        Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL,
+			       objv[1], TCL_GLOBAL_ONLY);
+		    }
+		    return TCL_ERROR;
+	        }
+	    }
+        }
+    }
+	
+    /*
      * And finally add any platform specific test commands.
      */
     
@@ -1934,11 +1992,6 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
                 " path\"", (char *) NULL);
         return TCL_ERROR;
     }
-    if (argv[1][0] == '\0') {
-        Tcl_AppendResult(interp, "cannot delete current interpreter",
-                (char *) NULL);
-        return TCL_ERROR;
-    }
     slaveToDelete = Tcl_GetSlave(interp, argv[1]);
     if (slaveToDelete == (Tcl_Interp *) NULL) {
         return TCL_ERROR;
@@ -4164,6 +4217,89 @@ TestmainthreadCmd (dummy, interp, argc, argv)
       return TCL_ERROR;
   }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MainLoop --
+ *
+ *	A main loop set by TestsetmainloopCmd below.
+ *
+ * Results:
+ * 	None.
+ *
+ * Side effects:
+ *	Event handlers could do anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MainLoop()
+{
+    while (!exitMainLoop) {
+	Tcl_DoOneEvent(0);
+    }
+    fprintf(stdout,"Exit MainLoop\n");
+    fflush(stdout);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetmainloopCmd  --
+ *
+ *	Implements the "testsetmainloop" cmd that is used to test the
+ *	'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetmainloopCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+  exitMainLoop = 0;
+  Tcl_SetMainLoop(MainLoop);
+  return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexitmainloopCmd  --
+ *
+ *	Implements the "testexitmainloop" cmd that is used to test the
+ *	'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexitmainloopCmd (dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    register Tcl_Interp *interp;	/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+  exitMainLoop = 1;
+  return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------