initsubsystems

4 files changed, 71 insertions, 29 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 4de18f0..5d93e8d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2409,6 +2409,15 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  * TODO - tommath stubs export goes here!
  */
 
+/* Tcl_InitSubsystems, see TIP #414 */
+
+#ifdef USE_TCL_STUBS
+EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
+#define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0)
+#else
+EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
+#endif
+
 /*
  * Public functions that are not accessible via the stubs table.
  * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2cc55d6..e57272f 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1411,21 +1411,47 @@ Tcl_UtfToExternal(
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_FindExecutable --
+ * Tcl_InitSubsystems/Tcl_FindExecutable --
  *
- *	This function computes the absolute path name of the current
- *	application, given its argv[0] value.
+ *	This function initializes everything needed for the Tcl library
+ *	to be able to operate.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	The absolute pathname for the application is computed and stored to be
- *	returned later be [info nameofexecutable].
+ *	returned later by [info nameofexecutable]. The system encoding is
+ *	determined and stored to be returned later by [encoding system]
  *
  *---------------------------------------------------------------------------
  */
+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 {
+    /* A real interpreter has interp->result/freeProc here: */
+    const char version[sizeof(struct {char *r; void (*f)(void);})];
+    int errorLine;
+    const struct TclStubs *stubTable;
+} dummyInterp = {
+    TCL_PATCH_LEVEL, TCL_STUB_MAGIC, &tclStubs
+};
+
 #undef Tcl_FindExecutable
+const char *
+Tcl_InitSubsystems(Tcl_PanicProc *panicProc)
+{
+    if (panicProc) {
+	Tcl_SetPanicProc(panicProc);
+    }
+    TclInitSubsystems();
+    return dummyInterp.version;
+}
+
 void
 Tcl_FindExecutable(
     const char *argv0)		/* The value of the application's argv[0]
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f445383..38c4450 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -313,6 +313,8 @@ Tcl_MainEx(
     Tcl_Channel chan;
     InteractiveState is;
 
+    TclpSetInitialEncodings();
+    TclpFindExecutable(argv[0]);
     Tcl_InitMemory(interp);
 
     is.interp = interp;
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 859cbf9..3656f9a 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 = (const char *)interp;
+	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;