diff options
Diffstat (limited to 'generic/tclStubLib.c')
-rw-r--r-- | generic/tclStubLib.c | 100 |
1 files changed, 22 insertions, 78 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 9774731..0efaf50 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -18,24 +18,21 @@ * including the rest of the stub functions. */ -#ifndef USE_TCL_STUBS #define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS #include "tclInt.h" -/* - * Tcl_InitStubs and stub table pointers are built as exported symbols. - */ +MODULE_SCOPE const TclStubs *tclStubsPtr; +MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; +MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; +MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; -TclStubs *tclStubsPtr = NULL; -TclPlatStubs *tclPlatStubsPtr = NULL; -TclIntStubs *tclIntStubsPtr = NULL; -TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -TclTomMathStubs* tclTomMathStubsPtr = NULL; +const TclStubs *tclStubsPtr = NULL; +const TclPlatStubs *tclPlatStubsPtr = NULL; +const TclIntStubs *tclIntStubsPtr = NULL; +const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -static TclStubs * +static const TclStubs * HasStubSupport( Tcl_Interp *interp) { @@ -44,8 +41,8 @@ HasStubSupport( if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - interp->result = "interpreter uses an incompatible stubs mechanism"; - interp->freeProc = TCL_STATIC; + iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } @@ -76,17 +73,13 @@ static int isDigit(const int c) *---------------------------------------------------------------------- */ -#ifdef Tcl_InitStubs -#undef Tcl_InitStubs -#endif - -CONST char * +MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, - CONST char *version, + const char *version, int exact) { - CONST char *actualVersion = NULL; + const char *actualVersion = NULL; ClientData pkgData = NULL; /* @@ -105,14 +98,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)) { @@ -130,7 +123,7 @@ Tcl_InitStubs( } } } - tclStubsPtr = (TclStubs*)pkgData; + tclStubsPtr = (TclStubs *) pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; @@ -146,58 +139,9 @@ 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. - * - *---------------------------------------------------------------------- + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: */ - -#ifdef TclTomMathInitializeStubs -#undef TclTomMathInitializeStubs -#endif - -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 = - 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; - } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error loading ", packageName, - " (requested version ", version, - ", actual version ", actualVersion, - "): ", errMsg, NULL); - return NULL; -} |