From 0481e3ca74a06381151d36ed72e32d8c12c7c29d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 9 Jan 2013 10:30:00 +0000
Subject: New function Tcl_InitSubsystems, still to be TIP'ed

---
 doc/FindExec.3        | 54 ++++++++++++++++++++++++++++++++++++++++++++--
 doc/InitStubs.3       |  4 ++++
 generic/tcl.h         | 10 ++++++++-
 generic/tclEncoding.c | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 generic/tclStubLib.c  | 55 +++++++++++++++++++++++++---------------------
 5 files changed, 154 insertions(+), 29 deletions(-)

diff --git a/doc/FindExec.3 b/doc/FindExec.3
index e4b4ed0..216588c 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -8,7 +8,7 @@
 .TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
+Tcl_FindExecutable, Tcl_GetNameOfExecutable, Tcl_InitSubsystems \- identify or return the name of the binary file containing the application
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -18,11 +18,18 @@ void
 .sp
 const char *
 \fBTcl_GetNameOfExecutable\fR()
+.sp
+Tcl_Interp *
+\fBTcl_InitSubsystems\fR(\fIflags\fR, \fI...\fR)
 .SH ARGUMENTS
 .AS char *argv0
 .AP char *argv0 in
 The first command-line argument to the program, which gives the
 application's name.
+.AP int flags in
+Any combination of TCL_INIT_PANIC or TCL_INIT_CREATE, which indicate
+whether a custom panicProc is registered and/or a real interpreter is created.
+The value 0 can be used if Tcl is used as utility library only.
 .BE
 
 .SH DESCRIPTION
@@ -58,6 +65,49 @@ internal full path name of the executable file as computed by
 equivalent to the \fBinfo nameofexecutable\fR command.  NULL
 is returned if the internal full path name has not been
 computed or unknown.
-
+.PP
+The \fBTcl_InitSubsystems\fR can be used as alternative to
+\fBTcl_FindExecutable\fR, when more flexibility is required.
+Its flags control exactly what is initialized.
+.PP
+The call \fBTcl_InitSubsystems(0)\fR does the same as
+\fBTcl_FindExecutable(NULL)\fR, except that a Tcl_Interp *
+is returned which can be used only by \fBTcl_InitStubs\fR
+to initialize the stub table. This opens up the Tcl Stub
+technology for Tcl embedders, which now can dynamically
+load the Tcl shared library and use functions in it
+without ever creating an interpreter. E.g. the
+following code can be compiled with -DUSE_TCL_STUBS:
+.CS
+    handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
+    initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
+    interp = initSubSystems(0); /* not a real interpreter */
+    Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */
+    interp = Tcl_CreateInterp(); /* now we have a real interpreter */
+.CE
+The function \fBTcl_CreateInterp\fR, or any other Tcl function you
+would like to call, no longer needs to be searched for in the
+shared library. It can be called directly though the stub table. 
+.PP
+If you supply the flag TCL_INIT_PANIC to \fBTcl_InitSubsystems\fR,
+the function expects an additional argument, a custom panicProc.
+This is equivalent to calling \fBTcl_SetPanicProc\fR immediately
+before \fBTcl_InitSubsystems\fR.
+.PP
+If you supply the flag TCL_INIT_CREATE to \fBTcl_InitSubsystems\fR,
+the function gets two additional parameters, argc and argv. A real
+Tcl interpreter will be created and if argc > 0 then the variables
+"argc" and "argv" will be set in this interpreter. So, the above
+example code could be simplified to:
+.CS
+    handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
+    initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
+    interp = initSubSystems(TCL_INIT_CREATE, 0, NULL); /* real interpreter */
+    Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */
+.CE
+.PP
+The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to
+any other function than Tcl_InitStubs(). Tcl functions with an "interp"
+argument can only be called if this function supports passing NULL.
 .SH KEYWORDS
 binary, executable file
diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 4dc62c6..8188b0b 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -83,6 +83,10 @@ non-zero means that only the specified \fIversion\fR is acceptable.
 \fBTcl_InitStubs\fR returns a string containing the actual version
 of Tcl satisfying the request, or NULL if the Tcl version is not
 acceptable, does not support stubs, or any other error condition occurred.
+.PP
+If \fBTcl_InitStubs\fR is called with as first argument the
+pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then
+the \fIversion\fR and \fIexact\fR parameters have no effect. 
 .SH "SEE ALSO"
 Tk_InitStubs
 .SH KEYWORDS
diff --git a/generic/tcl.h b/generic/tcl.h
index 3003abf..8a7911b 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2409,13 +2409,21 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  * TODO - tommath stubs export goes here!
  */
 
+/* Tcl_InitSubsystems, see TIP ??? */
+
+#define TCL_INIT_PANIC (1) /* Set Panic proc */
+#define TCL_INIT_CREATE (4) /* Call Tcl_CreateInterp(), and set argc/argv */
+
+EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
+
 /*
  * Public functions that are not accessible via the stubs table.
  * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    Tcl_InitSubsystems(TCL_INIT_CREATE, argc, argv))
+//	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 7a55724..9a64f10 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1411,7 +1411,7 @@ Tcl_UtfToExternal(
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_FindExecutable --
+ * Tcl_InitSubsystems/Tcl_FindExecutable --
  *
  *	This function computes the absolute path name of the current
  *	application, given its argv[0] value.
@@ -1425,6 +1425,64 @@ Tcl_UtfToExternal(
  *
  *---------------------------------------------------------------------------
  */
+MODULE_SCOPE const TclStubs tclStubs;
+
+/* Dummy const structure returned by Tcl_InitSubsystems,
+ * which looks like an Tcl_Interp, but in reality is not.
+ * It contains just enough for Tcl_InitStubs to be able
+ * to initialize the stub table. */
+static const struct {
+    const char *version; /* a real interpreter has interp->result here. */
+    void (*unused2) (void); /* a real interpreter has interp->freeProc here. */
+    int magic; /* a real interpreter has interp->errorLine here. */
+    const struct TclStubs *stubTable;
+} dummyInterp = {
+    TCL_PATCH_LEVEL, 0, TCL_STUB_MAGIC, &tclStubs
+};
+
+Tcl_Interp *
+Tcl_InitSubsystems(int flags, ...)
+{
+    va_list argList;
+
+    int argc = 0;
+    char **argv = NULL;
+
+    va_start(argList, flags);
+    if (flags & TCL_INIT_PANIC) {
+	Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
+    }
+    if (flags & TCL_INIT_CREATE) {
+	argc = va_arg(argList, int);
+	argv = va_arg(argList, char **);
+    }
+    va_end (argList);
+
+    TclInitSubsystems();
+    TclpSetInitialEncodings();
+    TclpFindExecutable(argv ? argv[0] : NULL);
+    if (flags & TCL_INIT_CREATE) {
+	Tcl_Interp *interp = Tcl_CreateInterp();
+	if (argc > 0) {
+	    Tcl_Obj *argvPtr;
+	    argc--;
+	    argv++;
+
+	    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
+	    argvPtr = Tcl_NewListObj(argc, NULL);
+	    while (argc--) {
+		Tcl_DString ds;
+
+		Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
+		Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds));
+	    }
+	    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
+	}
+	return interp;
+    }
+    return (Tcl_Interp *) &dummyInterp;
+}
+
 #undef Tcl_FindExecutable
 void
 Tcl_FindExecutable(
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 859cbf9..c5c0d92 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -73,37 +73,42 @@ Tcl_InitStubs(
 	return NULL;
     }
 
-    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
-    if (actualVersion == NULL) {
-	return NULL;
-    }
-    if (exact) {
-	const char *p = version;
-	int count = 0;
-
-	while (*p) {
-	    count += !isDigit(*p++);
+    if(iPtr->errorLine == TCL_STUB_MAGIC) {
+	actualVersion = iPtr->result;
+	tclStubsPtr = stubsPtr;
+    } else {
+	actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
+	if (actualVersion == NULL) {
+	    return NULL;
 	}
-	if (count == 1) {
-	    const char *q = actualVersion;
+	if (exact) {
+	    const char *p = version;
+	    int count = 0;
 
-	    p = version;
-	    while (*p && (*p == *q)) {
-		p++; q++;
-	    }
-	    if (*p || isDigit(*q)) {
-		/* Construct error message */
-		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
-		return NULL;
+	    while (*p) {
+		count += !isDigit(*p++);
 	    }
-	} else {
-	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
-	    if (actualVersion == NULL) {
-		return NULL;
+	    if (count == 1) {
+		const char *q = actualVersion;
+
+		p = version;
+		while (*p && (*p == *q)) {
+		    p++; q++;
+		}
+		if (*p || isDigit(*q)) {
+		    /* Construct error message */
+		    stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+		    return NULL;
+		}
+	    } else {
+		actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+		if (actualVersion == NULL) {
+		    return NULL;
+		}
 	    }
 	}
+	tclStubsPtr = (const TclStubs *)pkgData;
     }
-    tclStubsPtr = (TclStubs *)pkgData;
 
     if (tclStubsPtr->hooks) {
 	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
-- 
cgit v0.12


From 2c02c2ae5d892599247538f12315b137dbdeba59 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 25 Jan 2013 11:45:17 +0000
Subject: Eliminate some unneeded usages of Tcl_SetResult, Tcl_AddObjErrorInfo
 Fix "make test-packages" on cygwin

---
 generic/tclAssembly.c   |  9 ++++-----
 generic/tclEnsemble.c   |  2 +-
 generic/tclExecute.c    |  4 ++--
 generic/tclOO.c         |  2 +-
 generic/tclResult.c     |  2 +-
 generic/tclThreadTest.c |  2 +-
 generic/tclTrace.c      |  2 +-
 generic/tclVar.c        |  4 ++--
 unix/Makefile.in        |  2 +-
 unix/tclUnixTest.c      | 10 +++++-----
 win/tclWinTest.c        |  2 +-
 11 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7833105..99bdf43 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -798,12 +798,11 @@ TclNRAssembleObjCmd(
 
     if (codePtr == NULL) {
 	Tcl_AddErrorInfo(interp, "\n    (\"");
-	Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+	Tcl_AppendObjToErrorInfo(interp, objv[0]);
 	Tcl_AddErrorInfo(interp, "\" body, line ");
 	backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
 	Tcl_IncrRefCount(backtrace);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
-	Tcl_DecrRefCount(backtrace);
+	Tcl_AppendObjToErrorInfo(interp, backtrace);
 	Tcl_AddErrorInfo(interp, ")");
 	return TCL_ERROR;
     }
@@ -4270,11 +4269,11 @@ AddBasicBlockRangeToErrorInfo(
     Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
     lineNo = Tcl_NewIntObj(bbPtr->startLine);
     Tcl_IncrRefCount(lineNo);
-    Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+    Tcl_AppendObjToErrorInfo(interp, lineNo);
     Tcl_AddErrorInfo(interp, " and ");
     if (bbPtr->successor1 != NULL) {
 	Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+	Tcl_AppendObjToErrorInfo(interp, lineNo);
     } else {
 	Tcl_AddErrorInfo(interp, "end of assembly code");
     }
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 88de9f3..f392cad 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2196,7 +2196,7 @@ EnsembleUnknownCallback(
 	    }
 	    Tcl_AddErrorInfo(interp, "\n    result of "
 		    "ensemble unknown subcommand handler: ");
-	    Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+	    Tcl_AppendObjToErrorInfo(interp, unknownCmd);
 	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
 		    NULL);
 	} else {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8a68e9b..479ab86 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3464,8 +3464,8 @@ TEBCresume(
 	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
 	if (!varPtr) {
-	    Tcl_AddObjErrorInfo(interp,
-		    "\n    (reading value of variable to increment)", -1);
+	    Tcl_AddErrorInfo(interp,
+		    "\n    (reading value of variable to increment)");
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    Tcl_DecrRefCount(incrPtr);
 	    goto gotError;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d6d2d6a..cb22de6 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -843,7 +843,7 @@ ObjectRenamedTrace(
 	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
 		    contextPtr, 0, NULL);
 	    if (result != TCL_OK) {
-		Tcl_BackgroundError(interp);
+		Tcl_BackgroundException(interp, result);
 	    }
 	    Tcl_RestoreInterpState(interp, state);
 	    TclOODeleteContext(contextPtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9707f20..07f6819 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1587,7 +1587,7 @@ Tcl_GetReturnOptions(
     }
 
     if (result == TCL_ERROR) {
-	Tcl_AddObjErrorInfo(interp, "", -1);
+	Tcl_AddErrorInfo(interp, "");
         Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
     }
     if (iPtr->errorCode) {
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index b90e33d..1115ff0 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -926,7 +926,7 @@ ThreadSend(
 	    ckfree(resultPtr->errorInfo);
 	}
     }
-    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+    Tcl_AppendResult(interp, resultPtr->result, NULL);
     Tcl_ConditionFinalize(&resultPtr->done);
     code = resultPtr->code;
 
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 519f201..0f297a4 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1322,7 +1322,7 @@ TraceCommandProc(
 		Tcl_DStringLength(&cmd), 0);
 	if (code != TCL_OK) {
 	    /* We ignore errors in these traced commands */
-	    /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+	    /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
 	}
 	Tcl_DStringFree(&cmd);
     }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 9b8527c..2d1479d 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2036,8 +2036,8 @@ TclIncrObjVar2(
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
-	Tcl_AddObjErrorInfo(interp,
-		"\n    (reading value of variable to increment)", -1);
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
 	return NULL;
     }
     return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
diff --git a/unix/Makefile.in b/unix/Makefile.in
index ee31282..f8dd67c 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1718,7 +1718,7 @@ install-packages: packages
 	  fi; \
 	done
 
-test-packages: tcltest packages
+test-packages: ${TCLTEST_EXE} packages
 	@for i in $(PKGS_DIR)/*; do \
 	  if [ -d $$i ]; then \
 	    pkg=`basename $$i`; \
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 46fc972..c10225d 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -200,7 +200,7 @@ TestfilehandlerCmd(
 	    return TCL_ERROR;
 	}
 	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "create") == 0) {
 	if (argc != 5) {
 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -217,8 +217,8 @@ TestfilehandlerCmd(
 	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
 	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
 #else
-	    Tcl_SetResult(interp, "can't make pipes non-blocking",
-		    TCL_STATIC);
+	    Tcl_AppendResult(interp, "can't make pipes non-blocking",
+		    NULL);
 	    return TCL_ERROR;
 #endif
 	}
@@ -281,7 +281,7 @@ TestfilehandlerCmd(
 
 	memset(buffer, 'b', 10);
 	TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "oneevent") == 0) {
 	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
     } else if (strcmp(argv[1], "wait") == 0) {
@@ -390,7 +390,7 @@ TestfilewaitCmd(
     if (Tcl_GetChannelHandle(channel,
 	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
 	    (ClientData*) &data) != TCL_OK) {
-	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+	Tcl_AppendResult(interp, "couldn't get channel file", NULL);
 	return TCL_ERROR;
     }
     fd = PTR2INT(data);
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 136c4db..b83c0ba 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -211,7 +211,7 @@ TestvolumetypeCmd(
 	TclWinConvertError(GetLastError());
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, volType, TCL_VOLATILE);
+    Tcl_AppendResult(interp, volType, NULL);
     return TCL_OK;
 #undef VOL_BUF_SIZE
 }
-- 
cgit v0.12


From 4796adf5cb7dda39555411ea4941ab630f2eabec Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 25 Jan 2013 13:07:06 +0000
Subject: Another memory leak, and one Tcl_Free -> ckfree

---
 generic/tclThreadTest.c | 1 +
 unix/tclUnixTime.c      | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 1115ff0..8708f9a 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -930,6 +930,7 @@ ThreadSend(
     Tcl_ConditionFinalize(&resultPtr->done);
     code = resultPtr->code;
 
+    ckfree(resultPtr->result);
     ckfree(resultPtr);
 
     return code;
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index c7921fe..926e8f4 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -503,7 +503,7 @@ SetTZIfNecessary(void)
 	if (lastTZ == NULL) {
 	    Tcl_CreateExitHandler(CleanupMemory, NULL);
 	} else {
-	    Tcl_Free(lastTZ);
+	    ckfree(lastTZ);
 	}
 	lastTZ = ckalloc(strlen(newTZ) + 1);
 	strcpy(lastTZ, newTZ);
-- 
cgit v0.12


From eecece2afea26aec8b61ab04a7887c203257e82a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 25 Mar 2013 15:00:55 +0000
Subject: TCL_INIT_ENCODINGPATH

---
 generic/tcl.h         | 1 +
 generic/tclEncoding.c | 7 +++++++
 2 files changed, 8 insertions(+)

diff --git a/generic/tcl.h b/generic/tcl.h
index e89dff8..eda9eb9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2412,6 +2412,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 /* Tcl_InitSubsystems, see TIP 414 */
 
 #define TCL_INIT_PANIC (1) /* Set Panic proc */
+#define TCL_INIT_ENCODINGPATH (2) /* Set encoding path */
 #define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */
 #define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */
 #define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index dbe747b..dfcca14 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1448,11 +1448,15 @@ Tcl_InitSubsystems(int flags, ...)
     va_list argList;
     int argc = 0;
     void **argv = NULL;
+    const char *encodingpath = NULL;
 
     va_start(argList, flags);
     if (flags & TCL_INIT_PANIC) {
 	Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
     }
+    if (flags & TCL_INIT_ENCODINGPATH) {
+	encodingpath = va_arg(argList, const char *);
+    }
     if (flags & TCL_INIT_CREATE) {
 	argc = va_arg(argList, int);
 	argv = va_arg(argList, void **);
@@ -1460,6 +1464,9 @@ Tcl_InitSubsystems(int flags, ...)
     va_end(argList);
 
     TclInitSubsystems();
+    if(encodingpath) {
+	Tcl_SetEncodingSearchPath(Tcl_NewStringObj(encodingpath, -1));
+    }
     TclpSetInitialEncodings();
     TclpFindExecutable(argv ? argv[0] : NULL);
     if (flags & TCL_INIT_CREATE) {
-- 
cgit v0.12


From d048128004c027a3ee8e8d4fab19039a3bb358e2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 26 Mar 2013 10:20:03 +0000
Subject: Version having TCL_INIT_PANIC as only Tcl_InitSubsystems() flag

---
 doc/InitSubSyst.3     | 31 ++-----------------------------
 generic/tcl.h         |  6 +-----
 generic/tclEncoding.c | 44 +-------------------------------------------
 3 files changed, 4 insertions(+), 77 deletions(-)

diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index c23f2a3..0125912 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -18,8 +18,8 @@ Tcl_Interp *
 .SH ARGUMENTS
 .AS int flags
 .AP int flags in
-Any combination of flags which indicate whether a custom panicProc
-is registered and/or a real interpreter is created.
+Any combination of flags which might modify the initialization sequence.
+At this moment, only 0 and \fBTCL_INIT_PANIC\fR are supported.
 The value 0 can be used if Tcl is used as utility library only.
 .BE
 
@@ -74,33 +74,6 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
 but then panics which could be produced by the initialization
 itself still use the default panic procedure. 
 .PP
-If you supply one of the flags \fBTCL_INIT_CREATE\fR, \fBTCL_INIT_CREATE_UTF8\fR or
-\fBTCL_INIT_CREATE_UNICODE\fR to \fBTcl_InitSubsystems\fR, the function
-gets two additional parameters, argc and argv. Then a real
-Tcl interpreter will be created. If argc > 0 then the variables
-\fBargc\fR and \fBargv\fR will be set in this interpreter. The 3
-variants assume a different encoding for the arguments, except for
-\fIargv[0]\fR which is always assumed to be in the system encoding.
-So, the above example code could be simplified to:
-.CS
-Tcl_Interp *interp = Tcl_InitSubSystems(TCL_INIT_CREATE, 0, NULL);
-Tcl_InitStubs(interp, TCL_VERSION, 0); /* initialize the stub table */
-.CE
-.PP
-If the \fBTCL_INIT_PANIC\fR and one of the \fBTCL_INIT_CREATE\fR
-flags are used in combination, the \fBpanicProc\fR argument comes
-before the argc/argv arguments.
-.PP
-The reason for \fBargv[0]\fR always using the system encoding is that this way,
-argv[0] can be derived directly from the main() (or mainw, on Windows)
-arguments without any processing. \fBTCL_INIT_CREATE_UNICODE\fR is really only
-useful on Windows. But on Windows, the argv[0] parameter is not used for
-determining the value of [info executable] anyway. Modern UNIX system already
-have UTF-8 as system encoding, so \fBTCL_INIT_CREATE_UTF8\fR would have the same
-effect as \fBTCL_INIT_CREATE\fR, only slightly faster. Other parameters can be
-preprocessed at will by the application, and if the application uses unicode
-or UTF-8 internally there is no need to convert it back to the system encoding.
-.PP
 The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to
 any other function than Tcl_InitStubs(). Tcl functions with an "interp"
 argument can only be called if the function supports passing NULL.
diff --git a/generic/tcl.h b/generic/tcl.h
index eda9eb9..4049c8a 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2409,13 +2409,9 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  * TODO - tommath stubs export goes here!
  */
 
-/* Tcl_InitSubsystems, see TIP 414 */
+/* Tcl_InitSubsystems, see TIP #414 */
 
 #define TCL_INIT_PANIC (1) /* Set Panic proc */
-#define TCL_INIT_ENCODINGPATH (2) /* Set encoding path */
-#define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */
-#define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */
-#define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */
 
 EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
 
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index dfcca14..0ffc481 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1446,58 +1446,16 @@ Tcl_Interp *
 Tcl_InitSubsystems(int flags, ...)
 {
     va_list argList;
-    int argc = 0;
-    void **argv = NULL;
-    const char *encodingpath = NULL;
 
     va_start(argList, flags);
     if (flags & TCL_INIT_PANIC) {
 	Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
     }
-    if (flags & TCL_INIT_ENCODINGPATH) {
-	encodingpath = va_arg(argList, const char *);
-    }
-    if (flags & TCL_INIT_CREATE) {
-	argc = va_arg(argList, int);
-	argv = va_arg(argList, void **);
-    }
     va_end(argList);
 
     TclInitSubsystems();
-    if(encodingpath) {
-	Tcl_SetEncodingSearchPath(Tcl_NewStringObj(encodingpath, -1));
-    }
     TclpSetInitialEncodings();
-    TclpFindExecutable(argv ? argv[0] : NULL);
-    if (flags & TCL_INIT_CREATE) {
-	Tcl_Interp *interp = Tcl_CreateInterp();
-	if (--argc >= 0) {
-	    Tcl_Obj *argvPtr;
-
-	    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
-	    argvPtr = Tcl_NewListObj(argc, NULL);
-	    if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UTF8) {
-		while (argc--) {
-		    Tcl_ListObjAppendElement(NULL, argvPtr,
-			    Tcl_NewStringObj(*++argv, -1));
-		}
-	    } else if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UNICODE) {
-		while (argc--) {
-		    Tcl_ListObjAppendElement(NULL, argvPtr,
-			    Tcl_NewUnicodeObj(*++argv, -1));
-		}
-	    } else {
-		Tcl_DString ds;
-
-		while (argc--) {
-		    Tcl_ExternalToUtfDString(NULL, *++argv, -1, &ds);
-		    Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds));
-		}
-	    }
-	    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
-	}
-	return interp;
-    }
+    TclpFindExecutable(NULL);
     return (Tcl_Interp *) &dummyInterp;
 }
 
-- 
cgit v0.12


From bb770e33f8e270fc105aa9807a61bec5ac171771 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 26 Mar 2013 13:58:53 +0000
Subject: Add TCL_INIT_STUFF

---
 doc/InitSubSyst.3     | 8 +++++++-
 generic/tcl.h         | 1 +
 generic/tclEncoding.c | 7 ++++++-
 3 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index 0125912..4a3dc64 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -19,7 +19,8 @@ Tcl_Interp *
 .AS int flags
 .AP int flags in
 Any combination of flags which might modify the initialization sequence.
-At this moment, only 0 and \fBTCL_INIT_PANIC\fR are supported.
+At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_STUFF\fR
+(or a combination) are supported.
 The value 0 can be used if Tcl is used as utility library only.
 .BE
 
@@ -74,6 +75,11 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
 but then panics which could be produced by the initialization
 itself still use the default panic procedure. 
 .PP
+If you supply the flag \fBTCL_INIT_STUFF\fR to \fBTcl_InitSubsystems\fR,
+the function expects two additional arguments: ClientData and a
+custom proc with has ClientData as its only argument. The given
+function will be executed just before the encodings are initialized.
+.PP
 The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to
 any other function than Tcl_InitStubs(). Tcl functions with an "interp"
 argument can only be called if the function supports passing NULL.
diff --git a/generic/tcl.h b/generic/tcl.h
index 4049c8a..9325bf2 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2412,6 +2412,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 /* Tcl_InitSubsystems, see TIP #414 */
 
 #define TCL_INIT_PANIC (1) /* Set Panic proc */
+#define TCL_INIT_STUFF (2) /* Do any stuff before initializing the encoding */
 
 EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
 
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 0ffc481..753222f 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1451,9 +1451,14 @@ Tcl_InitSubsystems(int flags, ...)
     if (flags & TCL_INIT_PANIC) {
 	Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
     }
+    TclInitSubsystems();
+    if (flags & TCL_INIT_STUFF) {
+	ClientData clientData = va_arg(argList, ClientData);
+	void (*fn)() = va_arg(argList, void (*)(ClientData));
+	fn(clientData);
+    }
     va_end(argList);
 
-    TclInitSubsystems();
     TclpSetInitialEncodings();
     TclpFindExecutable(NULL);
     return (Tcl_Interp *) &dummyInterp;
-- 
cgit v0.12


From e4a0b9dbfd9e5e1261ed40444a27f64feac2833b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 26 Mar 2013 15:57:45 +0000
Subject: Looks like TCL_INIT_CUSTOM (previously known as TCL_INIT_STUFF) is
 not a bad idea at all, provided it has a Tcl_Interp* argument as well, so it
 can initialize the stub table. A typedef for the function is not necessary,
 as a variable-argument function doesn't do any type checking. It's for the
 experienced developer anyway.

---
 doc/InitSubSyst.3     | 16 +++++++++-------
 generic/tcl.h         |  2 +-
 generic/tclEncoding.c | 10 ++++++----
 3 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index 4a3dc64..db3951e 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -19,7 +19,7 @@ Tcl_Interp *
 .AS int flags
 .AP int flags in
 Any combination of flags which might modify the initialization sequence.
-At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_STUFF\fR
+At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_CUSTOM\fR
 (or a combination) are supported.
 The value 0 can be used if Tcl is used as utility library only.
 .BE
@@ -75,13 +75,15 @@ could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
 but then panics which could be produced by the initialization
 itself still use the default panic procedure. 
 .PP
-If you supply the flag \fBTCL_INIT_STUFF\fR to \fBTcl_InitSubsystems\fR,
+If you supply the flag \fBTCL_INIT_CUSTOM\fR to \fBTcl_InitSubsystems\fR,
 the function expects two additional arguments: ClientData and a
-custom proc with has ClientData as its only argument. The given
-function will be executed just before the encodings are initialized.
+custom proc. The proc will be supplied two arguments, the (pseudo)
+Tcl interpreter and ClientData. The given function will be executed
+just before the encodings are initialized.
 .PP
-The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to
-any other function than Tcl_InitStubs(). Tcl functions with an "interp"
-argument can only be called if the function supports passing NULL.
+The interpreter returned by Tcl_InitSubsystems(0) or passed to the
+TCL_INIT_CUSTOM function cannot be passed to any other function than
+Tcl_InitStubs(). Tcl functions with an "interp" argument can only
+be called if the function supports passing NULL.
 .SH KEYWORDS
 binary, executable file
diff --git a/generic/tcl.h b/generic/tcl.h
index 9325bf2..522171e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2412,7 +2412,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 /* Tcl_InitSubsystems, see TIP #414 */
 
 #define TCL_INIT_PANIC (1) /* Set Panic proc */
-#define TCL_INIT_STUFF (2) /* Do any stuff before initializing the encoding */
+#define TCL_INIT_CUSTOM (2) /* Do any stuff before initializing the encoding */
 
 EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
 
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 753222f..9905eaa 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1446,22 +1446,24 @@ Tcl_Interp *
 Tcl_InitSubsystems(int flags, ...)
 {
     va_list argList;
+    Tcl_Interp *interp = (Tcl_Interp *) &dummyInterp;
 
     va_start(argList, flags);
     if (flags & TCL_INIT_PANIC) {
 	Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
     }
     TclInitSubsystems();
-    if (flags & TCL_INIT_STUFF) {
+    if (flags & TCL_INIT_CUSTOM) {
 	ClientData clientData = va_arg(argList, ClientData);
-	void (*fn)() = va_arg(argList, void (*)(ClientData));
-	fn(clientData);
+	void (*fn)(Tcl_Interp *, ClientData) = va_arg(argList,
+		void (*)(Tcl_Interp *, ClientData));
+	fn(interp, clientData);
     }
     va_end(argList);
 
     TclpSetInitialEncodings();
     TclpFindExecutable(NULL);
-    return (Tcl_Interp *) &dummyInterp;
+    return interp;
 }
 
 void
-- 
cgit v0.12


From 6d0db57c023c72893e0a7221030126a4ec637b3c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 30 Mar 2013 21:44:39 +0000
Subject: Better Windows console panic proc, still to be TIPped.

---
 generic/tcl.h      |  8 +++++-
 generic/tclPanic.c | 16 +++--------
 win/Makefile.in    |  6 +++-
 win/makefile.bc    |  6 +++-
 win/makefile.vc    |  6 +++-
 win/tcl.dsp        |  4 +++
 win/tclWinPanic.c  | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 114 insertions(+), 16 deletions(-)
 create mode 100644 win/tclWinPanic.c

diff --git a/generic/tcl.h b/generic/tcl.h
index 4de18f0..73229b1 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2395,6 +2395,11 @@ const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
 			    int exact);
 const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 			    const char *version, int epoch, int revision);
+#ifdef _WIN32
+void Tcl_ConsolePanic(const char *format, ...);
+#else
+#define Tcl_ConsolePanic NULL
+#endif
 
 /*
  * When not using stubs, make it a macro.
@@ -2415,7 +2420,8 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    (Tcl_SetPanicProc(Tcl_ConsolePanic), \
+			Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b87a8df..a95b9c9 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -23,11 +23,7 @@
  * procedure.
  */
 
-#if defined(__CYGWIN__)
-static Tcl_PanicProc *panicProc = tclWinDebugPanic;
-#else
 static Tcl_PanicProc *panicProc = NULL;
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -49,10 +45,6 @@ void
 Tcl_SetPanicProc(
     Tcl_PanicProc *proc)
 {
-#if defined(_WIN32)
-    /* tclWinDebugPanic only installs if there is no panicProc yet. */
-    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
-#endif
     panicProc = proc;
 }
 
@@ -93,15 +85,15 @@ Tcl_PanicVA(
 
     if (panicProc != NULL) {
 	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-#ifdef _WIN32
-    } else if (IsDebuggerPresent()) {
-	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-#endif
     } else {
+#if defined(_WIN32) || defined(__CYGWIN__)
+	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+#else
 	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 		arg8);
 	fprintf(stderr, "\n");
 	fflush(stderr);
+#endif
 #if defined(_WIN32) || defined(__CYGWIN__)
 #   if defined(__GNUC__)
 	__builtin_trap();
diff --git a/win/Makefile.in b/win/Makefile.in
index 99009b9..2942da4 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -384,7 +384,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
 STUB_OBJS = \
 	tclStubLib.$(OBJEXT) \
 	tclTomMathStubLib.$(OBJEXT) \
-	tclOOStubLib.$(OBJEXT)
+	tclOOStubLib.$(OBJEXT) \
+	tclWinPanic.$(OBJEXT)
 
 TCLSH_OBJS = tclAppInit.$(OBJEXT)
 
@@ -519,6 +520,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
 tclOOStubLib.${OBJEXT}: tclOOStubLib.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
+tclWinPanic.${OBJEXT}: tclWinPanic.c
+	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
 # Implicit rule for all object files that will end up in the Tcl library
 
 %.${OBJEXT}: %.c
diff --git a/win/makefile.bc b/win/makefile.bc
index 18bfa28..b5f388c 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -278,7 +278,8 @@ TCLOBJS	= \
 TCLSTUBOBJS	= \
 	$(TMPDIR)\tclStubLib.obj \
 	$(TMPDIR)\tclTomMathStubLib.obj \
-	$(TMPDIR)\tclOOStubLib.obj
+	$(TMPDIR)\tclOOStubLib.obj \
+	$(TMPDIR)\tclWinPanic.obj
 
 WINDIR		= $(ROOT)\win
 GENERICDIR	= $(ROOT)\generic
@@ -532,6 +533,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
 $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
 
+$(TMPDIR)\tclWinPanic.obj : $(GENERICDIR)\tclWinPanic.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
 
 # Dedependency rules
 
diff --git a/win/makefile.vc b/win/makefile.vc
index 2784140..e4f064e 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -449,7 +449,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
 TCLSTUBOBJS = \
 	$(TMP_DIR)\tclStubLib.obj \
 	$(TMP_DIR)\tclTomMathStubLib.obj \
-	$(TMP_DIR)\tclOOStubLib.obj
+	$(TMP_DIR)\tclOOStubLib.obj \
+	$(TMP_DIR)\tclWinPanic.obj
 
 ### The following paths CANNOT have spaces in them.
 COMPATDIR	= $(ROOT)\compat
@@ -983,6 +984,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
 $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
+$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c
+	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
 #---------------------------------------------------------------------
 # Generate the source dependencies.  Having dependency rules will
 # improve incremental build accuracy without having to resort to a
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 57ec6bf..5880d09 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclOOStubLib.c
 # End Source File
 # Begin Source File
 
+SOURCE=..\generic\tclWinPanic.c
+# End Source File
+# Begin Source File
+
 SOURCE=..\generic\tclTomMathStubLib.c
 # End Source File
 # Begin Source File
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
new file mode 100644
index 0000000..266625c
--- /dev/null
+++ b/win/tclWinPanic.c
@@ -0,0 +1,84 @@
+/*
+ * tclWinPanic.c --
+ *
+ *	Contains the Windows-specific command-line panic proc.
+ *
+ * Copyright (c) 2013 by Jan Nijtmans.
+ * All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConsolePanic --
+ *
+ *	Display a message. If a debugger is present, present it directly to
+ *	the debugger, otherwise send it to stderr.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConsolePanic(
+    const char *format, ...)
+{
+#define TCL_MAX_WARN_LEN 1024
+    DWORD dummy;
+    va_list argList;
+    WCHAR msgString[TCL_MAX_WARN_LEN];
+    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
+
+    va_start(argList, format);
+    _vsnprintf(buf+3, sizeof(buf)-3, format, argList);
+    buf[sizeof(buf)-1] = 0;
+    msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+    MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN);
+
+    /*
+     * Truncate MessageBox string if it is too long to not overflow the buffer.
+     */
+
+    if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
+	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+    }
+
+    if (IsDebuggerPresent()) {
+	OutputDebugStringW(msgString);
+    } else if (_isatty(2)) {
+	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+    } else {
+	buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+	WriteFile(handle, buf, strlen(buf), &dummy, 0);
+	FlushFileBuffers(handle);
+    }
+#if defined(__GNUC__)
+    __builtin_trap();
+#elif defined(_WIN64)
+    __debugbreak();
+#elif defined(_MSC_VER)
+    _asm {int 3}
+#else
+    DebugBreak();
+#endif
+    ExitProcess(1);
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
-- 
cgit v0.12


From 260c2634b9c296b79c7c6adc8326214233e38d87 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 31 Mar 2013 19:32:57 +0000
Subject: better leave tclPanic.c as it was

---
 generic/tcl.h      |  7 ++++++-
 generic/tclPanic.c | 16 ++++++++++++----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 73229b1..70fee83 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2419,9 +2419,14 @@ void Tcl_ConsolePanic(const char *format, ...);
  * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
  */
 
+#ifdef _WIN32
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
 	    (Tcl_SetPanicProc(Tcl_ConsolePanic), \
-			Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+#else
+#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
+	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+#endif
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index a95b9c9..b87a8df 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -23,7 +23,11 @@
  * procedure.
  */
 
+#if defined(__CYGWIN__)
+static Tcl_PanicProc *panicProc = tclWinDebugPanic;
+#else
 static Tcl_PanicProc *panicProc = NULL;
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -45,6 +49,10 @@ void
 Tcl_SetPanicProc(
     Tcl_PanicProc *proc)
 {
+#if defined(_WIN32)
+    /* tclWinDebugPanic only installs if there is no panicProc yet. */
+    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#endif
     panicProc = proc;
 }
 
@@ -85,15 +93,15 @@ Tcl_PanicVA(
 
     if (panicProc != NULL) {
 	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-    } else {
-#if defined(_WIN32) || defined(__CYGWIN__)
+#ifdef _WIN32
+    } else if (IsDebuggerPresent()) {
 	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-#else
+#endif
+    } else {
 	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
 		arg8);
 	fprintf(stderr, "\n");
 	fflush(stderr);
-#endif
 #if defined(_WIN32) || defined(__CYGWIN__)
 #   if defined(__GNUC__)
 	__builtin_trap();
-- 
cgit v0.12


From a58db736cfe4a984cd83ab93d38da09d21fb418f Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 31 Mar 2013 20:27:33 +0000
Subject: Fix Tcl_Main macro

---
 doc/InitStubs.3 | 4 ----
 generic/tcl.h   | 2 +-
 2 files changed, 1 insertion(+), 5 deletions(-)

diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 8188b0b..4dc62c6 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -83,10 +83,6 @@ non-zero means that only the specified \fIversion\fR is acceptable.
 \fBTcl_InitStubs\fR returns a string containing the actual version
 of Tcl satisfying the request, or NULL if the Tcl version is not
 acceptable, does not support stubs, or any other error condition occurred.
-.PP
-If \fBTcl_InitStubs\fR is called with as first argument the
-pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then
-the \fIversion\fR and \fIexact\fR parameters have no effect. 
 .SH "SEE ALSO"
 Tk_InitStubs
 .SH KEYWORDS
diff --git a/generic/tcl.h b/generic/tcl.h
index 451c6cc..4acc39d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2432,7 +2432,7 @@ EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_InitSubsystems(Tcl_ConsolePanic), Tcl_CreateInterp)())
+	    (Tcl_InitSubsystems(Tcl_ConsolePanic), Tcl_CreateInterp()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
-- 
cgit v0.12


From 1c6a242b2e520aacca113e4189ebb0b95caf9844 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 31 Mar 2013 22:09:40 +0000
Subject: 2 lines not used any more

---
 generic/tcl.h | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 4acc39d..67cd181 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2416,9 +2416,6 @@ void Tcl_ConsolePanic(const char *format, ...);
 
 /* Tcl_InitSubsystems, see TIP #414 */
 
-#define TCL_INIT_PANIC (1) /* Set Panic proc */
-#define TCL_INIT_CUSTOM (2) /* Do any stuff before initializing the encoding */
-
 #ifdef USE_TCL_STUBS
 EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
 #define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0)
-- 
cgit v0.12


From 696a9ba3f9a7c0ed882dc6a3b878970f8a94d27c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 1 Apr 2013 21:48:51 +0000
Subject: Use Tcl_InitSubsystems in Tcl_Main macro

---
 generic/tcl.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 5d93e8d..051e2a1 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2424,7 +2424,7 @@ EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    (Tcl_InitSubsystems(NULL), Tcl_CreateInterp()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
-- 
cgit v0.12


From 07af7d5337d813d6bd0ce15b62b1b04de5db9e06 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 3 Apr 2013 12:38:46 +0000
Subject: better comments

---
 doc/InitSubSyst.3     | 22 ++++++++++------------
 generic/tcl.h         |  3 ++-
 generic/tclEncoding.c | 10 ++++++----
 3 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index 4fd99c7..2d5c2bc 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -5,7 +5,7 @@
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
 .so man.macros
-.TH Tcl_InitSubsystems 3 8.7 Tcl "Tcl Library Procedures"
+.TH Tcl_InitSubsystems 3 8.6.1 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
 Tcl_InitSubsystems \- initialize the Tcl library.
@@ -19,9 +19,8 @@ const char *
 .SH ARGUMENTS
 .AS Tcl_PanicProc *panicProc
 .AP Tcl_PanicProc *panicProc in
-Desired panic function, for error reporting. The value NULL is used
-when the default panicProc is desired, which normally writes the
-message to stderr.
+Desired panic function, for error reporting. If NULL, the default
+panicProc is used, which normally writes the message to stderr.
 .BE
 
 .SH DESCRIPTION
@@ -35,11 +34,12 @@ called once by Tcl embedders. Tcl_SetPanicProc is in the stub
 table, meant for Tcl extenders, and can be called at any time
 later to change the panic proc.
 .PP
-\fBTcl_InitSubsystems\fR can be used in stead of
-\fBTcl_FindExecutable\fR when Tcl is used as utility library
-only, and no other encodings than utf8, iso8859-1 or unicode
-are used. The system encoding will not be determined
-correctly but being set to iso8859-1.
+\fBTcl_InitSubsystems\fR is very similar to
+\fBTcl_FindExecutable\fR as well. It can be used when Tcl is
+used as utility library, no other encodings than utf8,
+iso8859-1 or unicode are used, and no interest exists in the
+value of \fBinfo nameofexecutable\fR. The system encoding will not
+be extracted from the environment, but falls back to iso8859-1.
 .PP
 The return value is the Tcl version.
 .PP
@@ -53,8 +53,6 @@ const char *version = Tcl_InitSubSystems(NULL);
 int major, minor, patch;
 Tcl_GetVersion(&major, &minor, &patch);
 .CE
-This will work as expected, both with and without stubs. When
-using stubs, this code must be linked with both the normal
-Tcl library (static or shared) and the stub library.
+This will work as expected, both with and without stubs.
 .SH KEYWORDS
 binary, executable file
diff --git a/generic/tcl.h b/generic/tcl.h
index 051e2a1..543b2a6 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2413,7 +2413,8 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 
 #ifdef USE_TCL_STUBS
 EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
-#define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0)
+#define Tcl_InitSubsystems(panicProc) \
+    Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0)
 #else
 EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
 #endif
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index e57272f..a83a6b0 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1428,10 +1428,12 @@ Tcl_UtfToExternal(
  */
 MODULE_SCOPE const TclStubs tclStubs;
 
-/* Dummy const structure returned by Tcl_InitSubsystems,
- * which looks like an Tcl_Interp, but in reality is not.
- * It contains just enough for Tcl_InitStubs to be able
- * to initialize the stub table. */
+/* Dummy const structure returned by Tcl_InitSubsystems when
+ * using stubs, which looks like an Tcl_Interp, but in reality
+ * is not. It contains just enough for Tcl_InitStubs to be able
+ * to initialize the stub table. The first bytes of this structure
+ * are filled with the Tcl version string, so it can be cast to a
+ * "const char *" holding the Tcl version as well. */
 static const struct {
     /* A real interpreter has interp->result/freeProc here: */
     const char version[sizeof(struct {char *r; void (*f)(void);})];
-- 
cgit v0.12