Single stub library can now handle Tcl8 and Tcl9 with different MAGIC values

3 files changed, 72 insertions, 14 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index c18b251..b69160d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2277,7 +2277,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
  * stubs tables.
  */
 
-#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + sizeof(size_t))
+#define TCL_STUB_MAGIC		((int) (0xFCA3BACB + sizeof(size_t)))
 
 /*
  * The following function is required to be defined in all stubs aware
@@ -2286,8 +2286,8 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
  * main library in case an extension is statically linked into an application.
  */
 
-const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
-			    int exact);
+const char *		TclInitStubs(Tcl_Interp *interp, const char *version,
+			    int exact, int magic);
 const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 			    const char *version, int epoch, int revision);
 
@@ -2295,16 +2295,15 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  * When not using stubs, make it a macro.
  */
 
-#ifndef USE_TCL_STUBS
+#ifdef USE_TCL_STUBS
+#define Tcl_InitStubs(interp, version, exact) \
+    TclInitStubs(interp, version, exact, TCL_STUB_MAGIC)
+#else
 #define Tcl_InitStubs(interp, version, exact) \
     Tcl_PkgInitStubsCheck(interp, version, exact)
 #endif
 
 /*
- * TODO - tommath stubs export goes here!
- */
-
-/*
  * Public functions that are not accessible via the stubs table.
  * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
  */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index be2c966..bd80ec1 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -34,7 +34,8 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
 
 static const TclStubs *
 HasStubSupport(
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+    int magic)
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -42,7 +43,7 @@ HasStubSupport(
 	/* No stub table at all? Nothing we can do. */
 	return NULL;
     }
-    if (iPtr->stubTable->magic != TCL_STUB_MAGIC) {
+    if (iPtr->stubTable->magic != magic) {
 	/*
 	 * The iPtr->stubTable entry from Tcl_Interp and the
 	 * Tcl_NewStringObj() and Tcl_SetObjResult() entries
@@ -70,7 +71,7 @@ static int isDigit(const int c)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_InitStubs --
+ * TclInitStubs --
  *
  *	Tries to initialise the stub table pointers and ensures that the
  *	correct version of Tcl is loaded.
@@ -86,10 +87,11 @@ static int isDigit(const int c)
  */
 
 MODULE_SCOPE const char *
-Tcl_InitStubs(
+TclInitStubs(
     Tcl_Interp *interp,
     const char *version,
-    int exact)
+    int exact,
+    int magic)
 {
     const char *actualVersion = NULL;
     ClientData pkgData = NULL;
@@ -100,7 +102,7 @@ Tcl_InitStubs(
      * times. [Bug 615304]
      */
 
-    tclStubsPtr = HasStubSupport(interp);
+    tclStubsPtr = HasStubSupport(interp, magic);
     if (!tclStubsPtr) {
 	return NULL;
     }
diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c
new file mode 100644
index 0000000..7d8c5c3
--- /dev/null
+++ b/generic/tclStubLibCompat.c
@@ -0,0 +1,57 @@
+/*
+ * tclStubLibCompat.c --
+ *
+ *	Stub object that will be statically linked into extensions that want
+ *	to access Tcl.
+ *
+ * Copyright (c) 2012 Jan Nijtmans
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * Small wrapper, which allows Tcl8 extensions to use the same stub
+ * library as Tcl 9.
+ */
+
+#include "tclInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitStubs --
+ *
+ *	Tries to initialise the stub table pointers and ensures that the
+ *	correct version of Tcl is loaded.
+ *
+ * Results:
+ *	The actual version of Tcl that satisfies the request, or NULL to
+ *	indicate that an error occurred.
+ *
+ * Side effects:
+ *	Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+#undef Tcl_InitStubs
+
+MODULE_SCOPE const char *
+Tcl_InitStubs(
+    Tcl_Interp *interp,
+    const char *version,
+    int exact)
+{
+    /* Use the hardcoded Tcl8 magic value here. */
+    return TclInitStubs(interp, version, exact, (int) 0xFCA3BACF);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+