diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStubLib.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStubLib.c Fri Jun 15 03:10:57 2012 +0200 @@ -0,0 +1,117 @@ +/* + * tclStubLib.c -- + * + * Stub object that will be statically linked into extensions that wish + * 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. + * + * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish 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" +#include "tclPort.h" + +/* + * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub + * functions should be built as non-exported symbols. + */ + +TclStubs *tclStubsPtr = NULL; +TclPlatStubs *tclPlatStubsPtr = NULL; +TclIntStubs *tclIntStubsPtr = NULL; +TclIntPlatStubs *tclIntPlatStubsPtr = NULL; + +static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); + +static TclStubs * +HasStubSupport (interp) + 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; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +#ifdef Tcl_InitStubs +#undef Tcl_InitStubs +#endif + +CONST char * +Tcl_InitStubs (interp, version, exact) + Tcl_Interp *interp; + CONST char *version; + int exact; +{ + CONST char *actualVersion = NULL; + ClientData pkgData = NULL; + + /* + * 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] + */ + + tclStubsPtr = HasStubSupport(interp); + if (!tclStubsPtr) { + return NULL; + } + + actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData); + 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; +}