First experimental implementation of RFE [854941], built on top of [http://tip.tcl.tk/414|TIP #414].

6 files changed, 112 insertions, 1 deletions

diff --git a/generic/tclStubLibDl.c b/generic/tclStubLibDl.c
new file mode 100644
index 0000000..1b12698
--- /dev/null
+++ b/generic/tclStubLibDl.c
@@ -0,0 +1,91 @@
+/*
+ * tclStubLibDl.c --
+ *
+ *	Stub object that will be statically linked into extensions that want
+ *	to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#ifndef _WIN32
+#   include <dlfcn.h>
+#else
+#   define dlopen(a,b) (void *)LoadLibraryA(a)
+#   define dlsym(a,b) (void *)GetProcAddress((HANDLE)(a),b)
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitSubsystems --
+ *
+ *	Initialize the stub table, using the structure pointed at
+ *	by the "version" argument.
+ *
+ * Results:
+ *	Outputs the value of the "version" argument.
+ *
+ * Side effects:
+ *	Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclStubInfoType info;
+
+MODULE_SCOPE const char *
+Tcl_InitSubsystems(
+	Tcl_PanicProc *panicProc)
+{
+    void *handle = dlopen(TCL_LIB_FILE, RTLD_NOW|RTLD_LOCAL);
+    const char *(*initSubsystems)(Tcl_PanicProc *);
+    const char *(*setPanicProc)(Tcl_PanicProc *);
+    Tcl_Interp *interp, *(*createInterp)(void);
+    int a,b,c,d;
+
+    if (!handle) {
+	if (panicProc) {
+	    panicProc("Cannot find Tcl core");
+	} else {
+	    fprintf(stderr, "Cannot find Tcl core");
+	    abort();
+	}
+	return NULL;
+    }
+    initSubsystems = dlsym(handle, "Tcl_InitSubsystems");
+    if (!initSubsystems) {
+	initSubsystems = dlsym(handle, "_Tcl_InitSubsystems");
+    }
+    if (initSubsystems) {
+	return initSubsystems(panicProc);
+    }
+    setPanicProc = dlsym(handle, "Tcl_SetPanicProc");
+    if (!setPanicProc) {
+	setPanicProc = dlsym(handle, "_Tcl_SetPanicProc");
+    }
+    createInterp = dlsym(handle, "Tcl_CreateInterp");
+    if (!createInterp) {
+	createInterp = dlsym(handle, "_Tcl_CreateInterp");
+    }
+
+    setPanicProc(panicProc);
+    interp = createInterp();
+    info.stubs = ((Interp *) interp)->stubTable;
+    info.stubs->tcl_DeleteInterp(interp);
+    info.stubs->tcl_GetVersion(&a, &b, &c, &d);
+    sprintf(info.version, "%d.%d.%d", a, b, c);
+    return info.version;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 5295a45..3f44748 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -335,7 +335,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
 	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
         bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
 
-STUB_LIB_OBJS = tclStubLib.o tclStubLibTbl.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
+STUB_LIB_OBJS = tclStubLib.o tclStubLibTbl.o tclStubLibDl.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
 
 UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
 	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
@@ -471,6 +471,7 @@ OO_SRCS = \
 STUB_SRCS = \
 	$(GENERIC_DIR)/tclStubLib.c \
 	$(GENERIC_DIR)/tclStubLibTbl.c \
+	$(GENERIC_DIR)/tclStubLibDl.c \
 	$(GENERIC_DIR)/tclTomMathStubLib.c \
 	$(GENERIC_DIR)/tclOOStubLib.c
 
@@ -1689,6 +1690,9 @@ tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
 tclStubLibTbl.o: $(GENERIC_DIR)/tclStubLibTbl.c
 	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibTbl.c
 
+tclStubLibDl.o: $(GENERIC_DIR)/tclStubLibDl.c
+	$(CC) -c $(STUB_CC_SWITCHES) -DTCL_LIB_FILE="\"$(TCL_LIB_FILE)\"" $(GENERIC_DIR)/tclStubLibDl.c
+
 tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
 	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index d7b25b7..986b517 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -386,6 +386,7 @@ REG_OBJS = tclWinReg.$(OBJEXT)
 STUB_OBJS = \
 	tclStubLib.$(OBJEXT) \
 	tclStubLibTbl.$(OBJEXT) \
+	tclStubLibDl.$(OBJEXT) \
 	tclTomMathStubLib.$(OBJEXT) \
 	tclOOStubLib.$(OBJEXT)
 
@@ -519,6 +520,9 @@ tclStubLib.${OBJEXT}: tclStubLib.c
 tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
+tclStubLibDl.${OBJEXT}: tclStubLibDl.c
+	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD -DTCL_LIB_FILE="\"$(TCL_LIB_FILE)\"" @DEPARG@ $(CC_OBJNAME)
+
 tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
diff --git a/win/makefile.bc b/win/makefile.bc
index 2726dad..0315c98 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -280,6 +280,7 @@ TCLOBJS	= \
 TCLSTUBOBJS	= \
 	$(TMPDIR)\tclStubLib.obj \
 	$(TMPDIR)\tclStubLibTbl.obj \
+	$(TMPDIR)\tclStubLibDl.obj \
 	$(TMPDIR)\tclTomMathStubLib.obj \
 	$(TMPDIR)\tclOOStubLib.obj
 
@@ -532,6 +533,9 @@ $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
 $(TMPDIR)\tclStubLibTbl.obj : $(GENERICDIR)\tclStubLibTbl.c
 	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
 
+$(TMPDIR)\tclStubLibDl.obj : $(GENERICDIR)\tclStubLibDl.c
+	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
 $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c
 	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
 
diff --git a/win/makefile.vc b/win/makefile.vc
index c24534a..cf61bbf 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -451,6 +451,7 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
 TCLSTUBOBJS = \
 	$(TMP_DIR)\tclStubLib.obj \
 	$(TMP_DIR)\tclStubLibTbl.obj \
+	$(TMP_DIR)\tclStubLibDl.obj \
 	$(TMP_DIR)\tclTomMathStubLib.obj \
 	$(TMP_DIR)\tclOOStubLib.obj
 
@@ -983,6 +984,9 @@ $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
 $(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
+$(TMP_DIR)\tclStubLibDl.obj: $(GENERICDIR)\tclStubLibDl.c
+	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
 $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
 	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
 
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 2708051..afe1960 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclStubLibTbl.c
 # End Source File
 # Begin Source File
 
+SOURCE=..\generic\tclStubLibDl.c
+# End Source File
+# Begin Source File
+
 SOURCE=..\generic\tclOOStubLib.c
 # End Source File
 # Begin Source File