diff options
Diffstat (limited to 'generic/tclStubLib.c')
-rw-r--r-- | generic/tclStubLib.c | 101 |
1 files changed, 19 insertions, 82 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index c98956e..859cbf9 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -13,28 +13,18 @@ #include "tclInt.h" -TclStubs *tclStubsPtr = NULL; -TclPlatStubs *tclPlatStubsPtr = NULL; -TclIntStubs *tclIntStubsPtr = NULL; -TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -TclTomMathStubs* tclTomMathStubsPtr = NULL; +MODULE_SCOPE const TclStubs *tclStubsPtr; +MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; +MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; +MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; -static TclStubs * -HasStubSupport( - Tcl_Interp *interp) -{ - Interp *iPtr = (Interp *) interp; +const TclStubs *tclStubsPtr = NULL; +const TclPlatStubs *tclPlatStubsPtr = NULL; +const TclIntStubs *tclIntStubsPtr = NULL; +const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; - } - interp->result = "interpreter uses an incompatible stubs mechanism"; - interp->freeProc = TCL_STATIC; - return NULL; -} - /* - * Use our own isdigit to avoid linking to libc on windows + * Use our own isDigit to avoid linking to libc on windows */ static int isDigit(const int c) @@ -60,15 +50,16 @@ static int isDigit(const int c) *---------------------------------------------------------------------- */ #undef Tcl_InitStubs -CONST char * +MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, - CONST char *version, + const char *version, int exact) { - CONST char *actualVersion = NULL; + Interp *iPtr = (Interp *) interp; + const char *actualVersion = NULL; ClientData pkgData = NULL; - TclStubs *stubsPtr; + const TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that @@ -76,8 +67,9 @@ Tcl_InitStubs( * times. [Bug 615304] */ - stubsPtr = HasStubSupport(interp); - if (!stubsPtr) { + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } @@ -86,14 +78,14 @@ Tcl_InitStubs( return NULL; } if (exact) { - CONST char *p = version; + const char *p = version; int count = 0; while (*p) { count += !isDigit(*p++); } if (count == 1) { - CONST char *q = actualVersion; + const char *q = actualVersion; p = version; while (*p && (*p == *q)) { @@ -127,61 +119,6 @@ Tcl_InitStubs( } /* - *---------------------------------------------------------------------- - * - * TclTomMathInitStubs -- - * - * Initializes the Stubs table for Tcl's subset of libtommath - * - * Results: - * Returns a standard Tcl result. - * - * This procedure should not be called directly, but rather through - * the TclTomMath_InitStubs macro, to insure that the Stubs table - * matches the header files used in compilation. - * - *---------------------------------------------------------------------- - */ - -#undef TclTomMathInitializeStubs - -CONST char* -TclTomMathInitializeStubs( - Tcl_Interp* interp, /* Tcl interpreter */ - CONST char* version, /* Tcl version needed */ - int epoch, /* Stubs table epoch from the header files */ - int revision /* Stubs table revision number from the - * header files */ -) { - int exact = 0; - const char* packageName = "tcl::tommath"; - const char* errMsg = NULL; - ClientData pkgClientData = NULL; - const char* actualVersion = - tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData); - TclTomMathStubs* stubsPtr = (TclTomMathStubs*) pkgClientData; - if (actualVersion == NULL) { - return NULL; - } - if (pkgClientData == NULL) { - errMsg = "missing stub table pointer"; - } else if ((stubsPtr->tclBN_epoch)() != epoch) { - errMsg = "epoch number mismatch"; - } else if ((stubsPtr->tclBN_revision)() != revision) { - errMsg = "requires a later revision"; - } else { - tclTomMathStubsPtr = stubsPtr; - return actualVersion; - } - tclStubsPtr->tcl_ResetResult(interp); - tclStubsPtr->tcl_AppendResult(interp, "error loading ", packageName, - " (requested version ", version, - ", actual version ", actualVersion, - "): ", errMsg, NULL); - return NULL; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 |