128 lines
3.0 KiB
C
128 lines
3.0 KiB
C
|
/*
|
|||
|
|
* tclStubLib.c --
|
|||
|
|
*
|
|||
|
|
* Stub object that will be statically linked into extensions that want
|
|||
|
|
* to access Tcl.
|
|||
|
|
*
|
|||
|
|
* Copyright (c) 1998-1999 by Scriptics Corporation.
|
|||
|
|
* Copyright (c) 1998 Paul Duffin.
|
|||
|
|
*
|
|||
|
|
* See the file "license.terms" for information on usage and redistribution of
|
|||
|
|
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
#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;
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Use our own isDigit to avoid linking to libc on windows
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
static int isDigit(const int c)
|
|||
|
|
{
|
|||
|
|
return (c >= '0' && c <= '9');
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*
|
|||
|
|
* 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)
|
|||
|
|
{
|
|||
|
|
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
|
|||
|
|
* prevents apps from being able to load/unload Tcl dynamically multiple
|
|||
|
|
* times. [Bug 615304]
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
|
|||
|
|
iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
|
|||
|
|
iPtr->freeProc = TCL_STATIC;
|
|||
|
|
return NULL;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
|
|||
|
|
if (actualVersion == NULL) {
|
|||
|
|
return NULL;
|
|||
|
|
}
|
|||
|
|
if (exact) {
|
|||
|
|
const char *p = version;
|
|||
|
|
int count = 0;
|
|||
|
|
|
|||
|
|
while (*p) {
|
|||
|
|
count += !isDigit(*p++);
|
|||
|
|
}
|
|||
|
|
if (count == 1) {
|
|||
|
|
const char *q = actualVersion;
|
|||
|
|
|
|||
|
|
p = version;
|
|||
|
|
while (*p && (*p == *q)) {
|
|||
|
|
p++; q++;
|
|||
|
|
}
|
|||
|
|
if (*p || isDigit(*q)) {
|
|||
|
|
/* Construct error message */
|
|||
|
|
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
|||
|
|
return NULL;
|
|||
|
|
}
|
|||
|
|
} else {
|
|||
|
|
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
|
|||
|
|
if (actualVersion == NULL) {
|
|||
|
|
return NULL;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
tclStubsPtr = (TclStubs *)pkgData;
|
|||
|
|
|
|||
|
|
if (tclStubsPtr->hooks) {
|
|||
|
|
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
|
|||
|
|
tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
|
|||
|
|
tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
|
|||
|
|
} else {
|
|||
|
|
tclPlatStubsPtr = NULL;
|
|||
|
|
tclIntStubsPtr = NULL;
|
|||
|
|
tclIntPlatStubsPtr = NULL;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return actualVersion;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Local Variables:
|
|||
|
|
* mode: c
|
|||
|
|
* c-basic-offset: 4
|
|||
|
|
* fill-column: 78
|
|||
|
|
* End:
|
|||
|
|
*/
|