diff options
Diffstat (limited to 'generic/tclStubLib.c')
| -rw-r--r-- | generic/tclStubLib.c | 138 | 
1 files changed, 29 insertions, 109 deletions
| diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 117e5cd..859cbf9 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -9,52 +9,22 @@   *   * See the file "license.terms" for information on usage and redistribution of   * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclStubLib.c,v 1.21.2.1 2008/04/01 19:21:06 dgp Exp $   */ -/* - * We need to ensure that we use the stub macros so that this file contains no - * references to any of the stub functions. This will make it possible to - * build an extension that references Tcl_InitStubs but doesn't end up - * 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 * -HasStubSupport( -    Tcl_Interp *interp) -{ -    Interp *iPtr = (Interp *) interp; - -    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { -	return iPtr->stubTable; -    } - -    interp->result = -	    "This interpreter does not support stubs-enabled extensions."; -    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) @@ -79,19 +49,17 @@ 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; +    Interp *iPtr = (Interp *) interp; +    const char *actualVersion = NULL;      ClientData pkgData = NULL; +    const TclStubs *stubsPtr = iPtr->stubTable;      /*       * We can't optimize this check by caching tclStubsPtr because that @@ -99,42 +67,43 @@ Tcl_InitStubs(       * times. [Bug 615304]       */ -    tclStubsPtr = HasStubSupport(interp); -    if (!tclStubsPtr) { +    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { +	iPtr->result = "interpreter uses an incompatible stubs mechanism"; +	iPtr->freeProc = TCL_STATIC;  	return NULL;      } -    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); +    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);      if (actualVersion == NULL) {  	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)) {  		p++; q++;  	    } -	    if (*p) { +	    if (*p || isDigit(*q)) {  		/* Construct error message */ -		Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); +		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);  		return NULL;  	    }  	} else { -	    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); +	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);  	    if (actualVersion == NULL) {  		return NULL;  	    }  	}      } -    tclStubsPtr = (TclStubs*)pkgData; +    tclStubsPtr = (TclStubs *)pkgData;      if (tclStubsPtr->hooks) {  	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; @@ -150,58 +119,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; -} | 
