diff options
Diffstat (limited to 'tcl8.6/generic/tclStubLib.c')
-rw-r--r-- | tcl8.6/generic/tclStubLib.c | 127 |
1 files changed, 0 insertions, 127 deletions
diff --git a/tcl8.6/generic/tclStubLib.c b/tcl8.6/generic/tclStubLib.c deleted file mode 100644 index 859cbf9..0000000 --- a/tcl8.6/generic/tclStubLib.c +++ /dev/null @@ -1,127 +0,0 @@ -/* - * 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 = "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: - */ |