fix for [Bugs 733221, 733156]

1 files changed, 449 insertions, 400 deletions

diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 864f59a..38fd50d 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -1,400 +1,449 @@
-/* 
- * tclAppInit.c --
- *
- *	Provides a default version of the main program and Tcl_AppInit
- *	procedure for Tcl applications (without Tk).  Note that this
- *	program must be built in Win32 console mode to work properly.
- *
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAppInit.c,v 1.11 2002/12/04 03:59:17 davygrvy Exp $
- */
-
-#include "tcl.h"
-#include <windows.h>
-#include <locale.h>
-
-#ifdef TCL_TEST
-extern int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-extern int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-#ifdef TCL_THREADS
-extern int		TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
-#endif
-#endif /* TCL_TEST */
-
-static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
-static BOOL __stdcall	sigHandler (DWORD fdwCtrlType);
-static Tcl_AsyncProc	asyncExit;
-
-Tcl_AsyncHandler	exitToken;
-DWORD			exitErrorCode;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * main --
- *
- *	This is the main program for the application.
- *
- * Results:
- *	None: Tcl_Main never returns here, so this procedure never
- *	returns either.
- *
- * Side effects:
- *	Whatever the application does.
- *
- *----------------------------------------------------------------------
- */
-
-int
-main(argc, argv)
-    int argc;			/* Number of command-line arguments. */
-    char **argv;		/* Values of command-line arguments. */
-{
-    /*
-     * The following #if block allows you to change the AppInit
-     * function by using a #define of TCL_LOCAL_APPINIT instead
-     * of rewriting this entire file.  The #if checks for that
-     * #define and uses Tcl_AppInit if it doesn't exist.
-     */
-    
-#ifndef TCL_LOCAL_APPINIT
-#define TCL_LOCAL_APPINIT Tcl_AppInit    
-#endif
-    extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
-    
-    /*
-     * The following #if block allows you to change how Tcl finds the startup
-     * script, prime the library or encoding paths, fiddle with the argv,
-     * etc., without needing to rewrite Tcl_Main()
-     */
-    
-#ifdef TCL_LOCAL_MAIN_HOOK
-    extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
-#endif
-
-    char buffer[MAX_PATH +1];
-    char *p;
-    /*
-     * Set up the default locale to be standard "C" locale so parsing
-     * is performed correctly.
-     */
-
-    setlocale(LC_ALL, "C");
-    setargv(&argc, &argv);
-
-    /*
-     * Replace argv[0] with full pathname of executable, and forward
-     * slashes substituted for backslashes.
-     */
-
-    GetModuleFileName(NULL, buffer, sizeof(buffer));
-    argv[0] = buffer;
-    for (p = buffer; *p != '\0'; p++) {
-	if (*p == '\\') {
-	    *p = '/';
-	}
-    }
-
-#ifdef TCL_LOCAL_MAIN_HOOK
-    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
-#endif
-
-    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
-
-    return 0;			/* Needed only to prevent compiler warning. */
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppInit --
- *
- *	This procedure performs application-specific initialization.
- *	Most applications, especially those that incorporate additional
- *	packages, will have their own version of this procedure.
- *
- * Results:
- *	Returns a standard Tcl completion code, and leaves an error
- *	message in the interp's result if an error occurs.
- *
- * Side effects:
- *	Depends on the startup script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_AppInit(interp)
-    Tcl_Interp *interp;		/* Interpreter for application. */
-{
-    if (Tcl_Init(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Install a signal handler to the win32 console tclsh is running in.
-     */
-    SetConsoleCtrlHandler(sigHandler, TRUE); 
-    exitToken = Tcl_AsyncCreate(asyncExit, NULL); 
-
-#ifdef TCL_TEST
-    if (Tcltest_Init(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
-            (Tcl_PackageInitProc *) NULL);
-    if (TclObjTest_Init(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-#ifdef TCL_THREADS
-    if (TclThread_Init(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-#endif
-    if (Procbodytest_Init(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
-            Procbodytest_SafeInit);
-#endif /* TCL_TEST */
-
-#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)
-    {
-	extern Tcl_PackageInitProc Registry_Init;
-	extern Tcl_PackageInitProc Dde_Init;
-
-	if (Registry_Init(interp) == TCL_ERROR) {
-	    return TCL_ERROR;
-	}
-	Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
-
-	if (Dde_Init(interp) == TCL_ERROR) {
-	    return TCL_ERROR;
-	}
-	Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
-   }
-#endif
-
-    /*
-     * Call the init procedures for included packages.  Each call should
-     * look like this:
-     *
-     * if (Mod_Init(interp) == TCL_ERROR) {
-     *     return TCL_ERROR;
-     * }
-     *
-     * where "Mod" is the name of the module.
-     */
-
-    /*
-     * Call Tcl_CreateCommand for application-specific commands, if
-     * they weren't already created by the init procedures called above.
-     */
-
-    /*
-     * Specify a user-specific startup file to invoke if the application
-     * is run interactively.  Typically the startup file is "~/.apprc"
-     * where "app" is the name of the application.  If this line is deleted
-     * then no user-specific startup file will be run under any conditions.
-     */
-
-    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * setargv --
- *
- *	Parse the Windows command line string into argc/argv.  Done here
- *	because we don't trust the builtin argument parser in crt0.  
- *	Windows applications are responsible for breaking their command
- *	line into arguments.
- *
- *	2N backslashes + quote -> N backslashes + begin quoted string
- *	2N + 1 backslashes + quote -> literal
- *	N backslashes + non-quote -> literal
- *	quote + quote in a quoted string -> single quote
- *	quote + quote not in quoted string -> empty string
- *	quote -> begin quoted string
- *
- * Results:
- *	Fills argcPtr with the number of arguments and argvPtr with the
- *	array of arguments.
- *
- * Side effects:
- *	Memory allocated.
- *
- *--------------------------------------------------------------------------
- */
-
-static void
-setargv(argcPtr, argvPtr)
-    int *argcPtr;		/* Filled with number of argument strings. */
-    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
-{
-    char *cmdLine, *p, *arg, *argSpace;
-    char **argv;
-    int argc, size, inquote, copy, slashes;
-    
-    cmdLine = GetCommandLine();	/* INTL: BUG */
-
-    /*
-     * Precompute an overly pessimistic guess at the number of arguments
-     * in the command line by counting non-space spans.
-     */
-
-    size = 2;
-    for (p = cmdLine; *p != '\0'; p++) {
-	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
-	    size++;
-	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
-		p++;
-	    }
-	    if (*p == '\0') {
-		break;
-	    }
-	}
-    }
-    argSpace = (char *) Tcl_Alloc(
-	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
-    argv = (char **) argSpace;
-    argSpace += size * sizeof(char *);
-    size--;
-
-    p = cmdLine;
-    for (argc = 0; argc < size; argc++) {
-	argv[argc] = arg = argSpace;
-	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
-	    p++;
-	}
-	if (*p == '\0') {
-	    break;
-	}
-
-	inquote = 0;
-	slashes = 0;
-	while (1) {
-	    copy = 1;
-	    while (*p == '\\') {
-		slashes++;
-		p++;
-	    }
-	    if (*p == '"') {
-		if ((slashes & 1) == 0) {
-		    copy = 0;
-		    if ((inquote) && (p[1] == '"')) {
-			p++;
-			copy = 1;
-		    } else {
-			inquote = !inquote;
-		    }
-                }
-                slashes >>= 1;
-            }
-
-            while (slashes) {
-		*arg = '\\';
-		arg++;
-		slashes--;
-	    }
-
-	    if ((*p == '\0')
-		    || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
-		break;
-	    }
-	    if (copy != 0) {
-		*arg = *p;
-		arg++;
-	    }
-	    p++;
-        }
-	*arg = '\0';
-	argSpace = arg + 1;
-    }
-    argv[argc] = NULL;
-
-    *argcPtr = argc;
-    *argvPtr = argv;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * asyncExit --
- *
- * 	The AsyncProc for the exitToken.
- *
- * Results:
- * 	doesn't actually return.
- *
- * Side effects:
- * 	tclsh cleanly exits.
- *
- *----------------------------------------------------------------------
- */
-
-int
-asyncExit (ClientData clientData, Tcl_Interp *interp, int code)
-{
-    Tcl_Exit((int)exitErrorCode);
-
-    /* NOTREACHED */
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * sigHandler --
- *
- *	Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and
- *	other exits. This is needed so tclsh can do it's real clean-up
- *	and not an unclean crash terminate.
- *
- * Results:
- *	TRUE.
- *
- * Side effects:
- *	Effects the way the app exits from a signal. This is an
- *	operating system supplied thread and unsafe to call ANY
- *	Tcl commands except for Tcl_AsyncMark.
- *
- *----------------------------------------------------------------------
- */
-
-BOOL __stdcall
-sigHandler(DWORD fdwCtrlType)
-{
-    HANDLE hStdIn;
-    /*
-     * If Tcl is currently executing some bytecode or in the eventloop,
-     * this will cause Tcl to enter asyncExit at the next command
-     * boundry.
-     */
-    exitErrorCode = fdwCtrlType;
-    Tcl_AsyncMark(exitToken);
-
-    /* 
-     * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF> 
-     * should it be blocked on input and our Tcl_AsyncMark didn't grab 
-     * the attention of the interpreter. 
-     */
-    hStdIn = GetStdHandle(STD_INPUT_HANDLE);
-    if (hStdIn) {
-	CloseHandle(hStdIn);
-    }
-
-    /* indicate to the OS not to call the default terminator */ 
-    return TRUE; 
-} 
+/*

+ * tclAppInit.c --

+ *

+ *	Provides a default version of the main program and Tcl_AppInit

+ *	procedure for Tcl applications (without Tk).  Note that this

+ *	program must be built in Win32 console mode to work properly.

+ *

+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.

+ * Copyright (c) 1998-1999 by Scriptics Corporation.

+ *

+ * See the file "license.terms" for information on usage and redistribution

+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

+ *

+ * RCS: @(#) $Id: tclAppInit.c,v 1.12 2003/05/10 02:52:54 mistachkin Exp $

+ */

+

+#include "tcl.h"

+#include <windows.h>

+#include <locale.h>

+

+#ifdef TCL_TEST

+extern int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));

+extern int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));

+extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));

+extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));

+#ifdef TCL_THREADS

+extern int		TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));

+#endif

+#endif /* TCL_TEST */

+

+static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));

+static BOOL __stdcall	sigHandler (DWORD fdwCtrlType);

+static Tcl_AsyncProc	asyncExit;

+static void		AppInitExitHandler(ClientData clientData);

+

+static char **          argvSave = NULL;

+static Tcl_AsyncHandler exitToken = NULL;

+static DWORD            exitErrorCode = 0;

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * main --

+ *

+ *	This is the main program for the application.

+ *

+ * Results:

+ *	None: Tcl_Main never returns here, so this procedure never

+ *	returns either.

+ *

+ * Side effects:

+ *	Whatever the application does.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+main(argc, argv)

+    int argc;			/* Number of command-line arguments. */

+    char **argv;		/* Values of command-line arguments. */

+{

+    /*

+     * The following #if block allows you to change the AppInit

+     * function by using a #define of TCL_LOCAL_APPINIT instead

+     * of rewriting this entire file.  The #if checks for that

+     * #define and uses Tcl_AppInit if it doesn't exist.

+     */

+

+#ifndef TCL_LOCAL_APPINIT

+#define TCL_LOCAL_APPINIT Tcl_AppInit

+#endif

+    extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));

+

+    /*

+     * The following #if block allows you to change how Tcl finds the startup

+     * script, prime the library or encoding paths, fiddle with the argv,

+     * etc., without needing to rewrite Tcl_Main()

+     */

+

+#ifdef TCL_LOCAL_MAIN_HOOK

+    extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));

+#endif

+

+    char buffer[MAX_PATH +1];

+    char *p;

+    /*

+     * Set up the default locale to be standard "C" locale so parsing

+     * is performed correctly.

+     */

+

+    setlocale(LC_ALL, "C");

+    setargv(&argc, &argv);

+

+    /*

+     * Save this for later, so we can free it.

+     */

+    argvSave = argv;

+

+    /*

+     * Replace argv[0] with full pathname of executable, and forward

+     * slashes substituted for backslashes.

+     */

+

+    GetModuleFileName(NULL, buffer, sizeof(buffer));

+    argv[0] = buffer;

+    for (p = buffer; *p != '\0'; p++) {

+	if (*p == '\\') {

+	    *p = '/';

+	}

+    }

+

+#ifdef TCL_LOCAL_MAIN_HOOK

+    TCL_LOCAL_MAIN_HOOK(&argc, &argv);

+#endif

+

+    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);

+

+    return 0;			/* Needed only to prevent compiler warning. */

+}

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_AppInit --

+ *

+ *	This procedure performs application-specific initialization.

+ *	Most applications, especially those that incorporate additional

+ *	packages, will have their own version of this procedure.

+ *

+ * Results:

+ *	Returns a standard Tcl completion code, and leaves an error

+ *	message in the interp's result if an error occurs.

+ *

+ * Side effects:

+ *	Depends on the startup script.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_AppInit(interp)

+    Tcl_Interp *interp;		/* Interpreter for application. */

+{

+    if (Tcl_Init(interp) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+

+    /*

+     * Install a signal handler to the win32 console tclsh is running in.

+     */

+    SetConsoleCtrlHandler(sigHandler, TRUE);

+    exitToken = Tcl_AsyncCreate(asyncExit, NULL);

+

+    /*

+     * This exit handler will be used to free the

+     * resources allocated in this file.

+     */

+    Tcl_CreateExitHandler(AppInitExitHandler, NULL);

+

+#ifdef TCL_TEST

+    if (Tcltest_Init(interp) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,

+            (Tcl_PackageInitProc *) NULL);

+    if (TclObjTest_Init(interp) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+#ifdef TCL_THREADS

+    if (TclThread_Init(interp) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+#endif

+    if (Procbodytest_Init(interp) == TCL_ERROR) {

+	return TCL_ERROR;

+    }

+    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,

+            Procbodytest_SafeInit);

+#endif /* TCL_TEST */

+

+#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)

+    {

+	extern Tcl_PackageInitProc Registry_Init;

+	extern Tcl_PackageInitProc Dde_Init;

+

+	if (Registry_Init(interp) == TCL_ERROR) {

+	    return TCL_ERROR;

+	}

+	Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);

+

+	if (Dde_Init(interp) == TCL_ERROR) {

+	    return TCL_ERROR;

+	}

+	Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);

+   }

+#endif

+

+    /*

+     * Call the init procedures for included packages.  Each call should

+     * look like this:

+     *

+     * if (Mod_Init(interp) == TCL_ERROR) {

+     *     return TCL_ERROR;

+     * }

+     *

+     * where "Mod" is the name of the module.

+     */

+

+    /*

+     * Call Tcl_CreateCommand for application-specific commands, if

+     * they weren't already created by the init procedures called above.

+     */

+

+    /*

+     * Specify a user-specific startup file to invoke if the application

+     * is run interactively.  Typically the startup file is "~/.apprc"

+     * where "app" is the name of the application.  If this line is deleted

+     * then no user-specific startup file will be run under any conditions.

+     */

+

+    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * AppInitExitHandler --

+ *

+ *	This function is called to cleanup the app init resources before

+ *	Tcl is unloaded.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Frees the saved argv and deletes the async exit handler.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+AppInitExitHandler(

+    ClientData clientData)

+{

+    if (argvSave != NULL) {

+        ckfree((char *)argvSave);

+        argvSave = NULL;

+    }

+

+    if (exitToken != NULL) {

+        /*

+         * This should be safe to do even if we

+         * are in an async exit right now.

+         */

+        Tcl_AsyncDelete(exitToken);

+        exitToken = NULL;

+    }

+}

+

+/*

+ *-------------------------------------------------------------------------

+ *

+ * setargv --

+ *

+ *	Parse the Windows command line string into argc/argv.  Done here

+ *	because we don't trust the builtin argument parser in crt0.

+ *	Windows applications are responsible for breaking their command

+ *	line into arguments.

+ *

+ *	2N backslashes + quote -> N backslashes + begin quoted string

+ *	2N + 1 backslashes + quote -> literal

+ *	N backslashes + non-quote -> literal

+ *	quote + quote in a quoted string -> single quote

+ *	quote + quote not in quoted string -> empty string

+ *	quote -> begin quoted string

+ *

+ * Results:

+ *	Fills argcPtr with the number of arguments and argvPtr with the

+ *	array of arguments.

+ *

+ * Side effects:

+ *	Memory allocated.

+ *

+ *--------------------------------------------------------------------------

+ */

+

+static void

+setargv(argcPtr, argvPtr)

+    int *argcPtr;		/* Filled with number of argument strings. */

+    char ***argvPtr;		/* Filled with argument strings (malloc'd). */

+{

+    char *cmdLine, *p, *arg, *argSpace;

+    char **argv;

+    int argc, size, inquote, copy, slashes;

+

+    cmdLine = GetCommandLine();	/* INTL: BUG */

+

+    /*

+     * Precompute an overly pessimistic guess at the number of arguments

+     * in the command line by counting non-space spans.

+     */

+

+    size = 2;

+    for (p = cmdLine; *p != '\0'; p++) {

+	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */

+	    size++;

+	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */

+		p++;

+	    }

+	    if (*p == '\0') {

+		break;

+	    }

+	}

+    }

+    argSpace = (char *) Tcl_Alloc(

+	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));

+    argv = (char **) argSpace;

+    argSpace += size * sizeof(char *);

+    size--;

+

+    p = cmdLine;

+    for (argc = 0; argc < size; argc++) {

+	argv[argc] = arg = argSpace;

+	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */

+	    p++;

+	}

+	if (*p == '\0') {

+	    break;

+	}

+

+	inquote = 0;

+	slashes = 0;

+	while (1) {

+	    copy = 1;

+	    while (*p == '\\') {

+		slashes++;

+		p++;

+	    }

+	    if (*p == '"') {

+		if ((slashes & 1) == 0) {

+		    copy = 0;

+		    if ((inquote) && (p[1] == '"')) {

+			p++;

+			copy = 1;

+		    } else {

+			inquote = !inquote;

+		    }

+                }

+                slashes >>= 1;

+            }

+

+            while (slashes) {

+		*arg = '\\';

+		arg++;

+		slashes--;

+	    }

+

+	    if ((*p == '\0')

+		    || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */

+		break;

+	    }

+	    if (copy != 0) {

+		*arg = *p;

+		arg++;

+	    }

+	    p++;

+        }

+	*arg = '\0';

+	argSpace = arg + 1;

+    }

+    argv[argc] = NULL;

+

+    *argcPtr = argc;

+    *argvPtr = argv;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * asyncExit --

+ *

+ * 	The AsyncProc for the exitToken.

+ *

+ * Results:

+ * 	doesn't actually return.

+ *

+ * Side effects:

+ * 	tclsh cleanly exits.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+asyncExit (ClientData clientData, Tcl_Interp *interp, int code)

+{

+    Tcl_Exit((int)exitErrorCode);

+

+    /* NOTREACHED */

+    return code;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * sigHandler --

+ *

+ *	Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and

+ *	other exits. This is needed so tclsh can do it's real clean-up

+ *	and not an unclean crash terminate.

+ *

+ * Results:

+ *	TRUE.

+ *

+ * Side effects:

+ *	Effects the way the app exits from a signal. This is an

+ *	operating system supplied thread and unsafe to call ANY

+ *	Tcl commands except for Tcl_AsyncMark.

+ *

+ *----------------------------------------------------------------------

+ */

+

+BOOL __stdcall

+sigHandler(DWORD fdwCtrlType)

+{

+    HANDLE hStdIn;

+    /*

+     * If Tcl is currently executing some bytecode or in the eventloop,

+     * this will cause Tcl to enter asyncExit at the next command

+     * boundry.

+     */

+    exitErrorCode = fdwCtrlType;

+    Tcl_AsyncMark(exitToken);

+

+    /*

+     * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF>

+     * should it be blocked on input and our Tcl_AsyncMark didn't grab

+     * the attention of the interpreter.

+     */

+    hStdIn = GetStdHandle(STD_INPUT_HANDLE);

+    if (hStdIn) {

+	CloseHandle(hStdIn);

+    }

+

+    /* indicate to the OS not to call the default terminator */

+    return TRUE;

+}