diff options
Diffstat (limited to 'generic/tclStubLib.c')
| -rw-r--r-- | generic/tclStubLib.c | 104 |
1 files changed, 75 insertions, 29 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index dd951bf..31fc865 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -13,15 +13,11 @@ #include "tclInt.h" -MODULE_SCOPE const TclStubs *tclStubsPtr; -MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; -MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; -MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; - -const TclStubs *tclStubsPtr = NULL; -const TclPlatStubs *tclPlatStubsPtr = NULL; -const TclIntStubs *tclIntStubsPtr = NULL; -const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; +TclStubs *tclStubsPtr = NULL; +TclPlatStubs *tclPlatStubsPtr = NULL; +TclIntStubs *tclIntStubsPtr = NULL; +TclIntPlatStubs *tclIntPlatStubsPtr = NULL; +TclTomMathStubs* tclTomMathStubsPtr = NULL; /* * Use our own ISDIGIT to avoid linking to libc on windows @@ -47,17 +43,16 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; *---------------------------------------------------------------------- */ #undef Tcl_InitStubs -MODULE_SCOPE const char * +CONST char * Tcl_InitStubs( Tcl_Interp *interp, - const char *version, - int exact, - int magic) + CONST char *version, + int exact) { Interp *iPtr = (Interp *) interp; - const char *actualVersion = NULL; + CONST char *actualVersion = NULL; ClientData pkgData = NULL; - const TclStubs *stubsPtr = iPtr->stubTable; + TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that @@ -65,8 +60,8 @@ Tcl_InitStubs( * times. [Bug 615304] */ - if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; iPtr->freeProc = TCL_STATIC; return NULL; } @@ -75,15 +70,15 @@ Tcl_InitStubs( if (actualVersion == NULL) { return NULL; } - if (exact&1) { - const char *p = version; + if (exact) { + 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)) { @@ -101,16 +96,12 @@ Tcl_InitStubs( } } } - if (((exact&0xff00) < 0x900)) { - /* We are running Tcl 8.x */ - stubsPtr = (TclStubs *)pkgData; - } - tclStubsPtr = stubsPtr; + tclStubsPtr = (TclStubs *)pkgData; - if (stubsPtr->hooks) { - tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs; - tclIntStubsPtr = stubsPtr->hooks->tclIntStubs; - tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs; + if (tclStubsPtr->hooks) { + tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; + tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; + tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; @@ -121,6 +112,61 @@ 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 |
