From 02e5732cffb9d23e1ea6612ee37c19a88e4891f2 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 17:25:59 +0000 Subject: Proposed rollback of the TCL_STUB_MAGIC change on novem branch. --- generic/tcl.h | 7 ++--- generic/tclBasic.c | 23 -------------- generic/tclLoad.c | 3 +- generic/tclStubLib.c | 74 ++++++++++++++++++++++++++++++++-------------- generic/tclStubLibCompat.c | 57 ----------------------------------- unix/Makefile.in | 5 ---- win/Makefile.in | 4 --- win/makefile.vc | 1 - 8 files changed, 56 insertions(+), 118 deletions(-) delete mode 100644 generic/tclStubLibCompat.c diff --git a/generic/tcl.h b/generic/tcl.h index b9ff28c..91bf623 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -136,7 +136,6 @@ extern "C" { */ #include -#include /* *---------------------------------------------------------------------------- @@ -2276,7 +2275,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) 0xFCA3BACF) /* * The following function is required to be defined in all stubs aware @@ -2286,7 +2285,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, */ const char * TclInitStubs(Tcl_Interp *interp, const char *version, - int exact, int magic); + int exact, int major, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); @@ -2296,7 +2295,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #ifdef USE_TCL_STUBS #define Tcl_InitStubs(interp, version, exact) \ - TclInitStubs(interp, version, exact, TCL_STUB_MAGIC) + TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION, TCL_STUB_MAGIC) #else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 146247e..4f3b77e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -431,14 +431,6 @@ TclFinalizeEvaluation(void) *---------------------------------------------------------------------- */ -/* Template for internal Interp structure: the stubTable entry cannot move! */ -typedef struct { - char *dumm1; - Tcl_FreeProc *dummy2; - int dummy3; - const struct TclStubs *stubTable; -} InterpTemplate; - Tcl_Interp * Tcl_CreateInterp(void) { @@ -474,21 +466,6 @@ Tcl_CreateInterp(void) /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } - if ((void *) tclStubs.tcl_SetObjResult - != (void *)((&(tclStubs.tcl_PkgProvideEx))[235])) { - /*NOTREACHED*/ - Tcl_Panic("Tcl_SetObjResult entry in the stub table must be kept"); - } - if ((void *) tclStubs.tcl_NewStringObj - != (void *)((&(tclStubs.tcl_PkgProvideEx))[56])) { - /*NOTREACHED*/ - Tcl_Panic("Tcl_NewStringObj entry in the stub table must be kept"); - } - if (TclOffset(InterpTemplate, stubTable) - != TclOffset(Interp, stubTable)) { - /*NOTREACHED*/ - Tcl_Panic("stubsTable entry in the Interp structure must be kept"); - } if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 61c763f..6f5b9cf 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -474,9 +474,8 @@ Tcl_LoadObjCmd( /* We have an Tcl 8.x extension with incompatible stub table. */ Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); Tcl_SetObjResult(interp, obj); - } else { - Tcl_TransferResult(target, code, interp); } + Tcl_TransferResult(target, code, interp); goto done; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index bd80ec1..f1229d5 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -34,29 +34,17 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static const TclStubs * HasStubSupport( - Tcl_Interp *interp, - int magic) + Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; - if (!iPtr->stubTable) { - /* No stub table at all? Nothing we can do. */ - return NULL; - } - if (iPtr->stubTable->magic != magic) { - /* - * The iPtr->stubTable entry from Tcl_Interp and the - * Tcl_NewStringObj() and Tcl_SetObjResult() entries - * in the stub table cannot change in Tcl 9 compared - * to Tcl 8.x. Otherwise the lines below won't work. - * TODO: add a test case for that. - */ - iPtr->stubTable->tcl_SetObjResult(interp, - iPtr->stubTable->tcl_NewStringObj( - "This extension is compiled for Tcl 9.x", -1)); - return NULL; + if (iPtr->stubTable && iPtr->stubTable->magic == TCL_STUB_MAGIC) { + return iPtr->stubTable; } - return iPtr->stubTable; + iPtr->result = + (char *) "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; + return NULL; } /* @@ -91,10 +79,52 @@ TclInitStubs( Tcl_Interp *interp, const char *version, int exact, + int major, int magic) { + Interp *iPtr = (Interp *) interp; const char *actualVersion = NULL; ClientData pkgData = NULL; + const char *p, *q; + + /* + * Detect whether the extension and the stubs library were built + * against Tcl header files declaring use of incompatible stubs + * mechanisms. Even within the same mechanism, also detect if + * the header files are from different major versions. Either + * is seriously broken. An extension and its stubs library ought + * to share compatible headers, if not the same one. + */ + + if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) { + iPtr->result = + (char *) "extension linked to incompatible stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } + + /* + * Detect whether an extension compiled against a Tcl header file + * of one major version is requesting to use a stubs table of a + * different major version. According to our compat rules, that's + * a request that cannot succeed. Different major versions imply + * incompatible stub tables. + */ + + p = version; + q = TCL_VERSION; + while (isDigit(*p)) { + if (*p++ != *q++) { + goto badVersion; + } + } + if (isDigit(*q)) { + badVersion: + iPtr->result = (char *) + "extension passed bad version argument to stubs library"; + iPtr->freeProc = TCL_STATIC; + return NULL; + } /* * We can't optimize this check by caching tclStubsPtr because that @@ -102,7 +132,7 @@ TclInitStubs( * times. [Bug 615304] */ - tclStubsPtr = HasStubSupport(interp, magic); + tclStubsPtr = HasStubSupport(interp); if (!tclStubsPtr) { return NULL; } @@ -112,14 +142,14 @@ TclInitStubs( return NULL; } if (exact) { - const char *p = version; + p = version; int count = 0; while (*p) { count += !isDigit(*p++); } if (count == 1) { - const char *q = actualVersion; + q = actualVersion; p = version; while (*p && (*p == *q)) { diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c deleted file mode 100644 index 7d8c5c3..0000000 --- a/generic/tclStubLibCompat.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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: - */ - diff --git a/unix/Makefile.in b/unix/Makefile.in index 9a7d6db..b89b2e6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -336,7 +336,6 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ - tclStubLibCompat.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} @@ -472,7 +471,6 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ - $(GENERIC_DIR)/tclStubLibCompat.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -1661,9 +1659,6 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c -tclStubLibCompat.o: $(GENERIC_DIR)/tclStubLibCompat.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibCompat.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 6b9685d..dacbbb5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -378,7 +378,6 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ - tclStubLibCompat.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) @@ -506,9 +505,6 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported -tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) diff --git a/win/makefile.vc b/win/makefile.vc index 823142f..2784140 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -448,7 +448,6 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclStubLibCompat.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj -- cgit v0.12