sl@0: /* 
sl@0:  * tclStubLib.c --
sl@0:  *
sl@0:  *	Stub object that will be statically linked into extensions that wish
sl@0:  *	to access Tcl.
sl@0:  *
sl@0:  * Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0:  * Copyright (c) 1998 Paul Duffin.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish Exp $
sl@0:  */
sl@0: 
sl@0: /*
sl@0:  * We need to ensure that we use the stub macros so that this file contains
sl@0:  * no references to any of the stub functions.  This will make it possible
sl@0:  * to build an extension that references Tcl_InitStubs but doesn't end up
sl@0:  * including the rest of the stub functions.
sl@0:  */
sl@0: 
sl@0: #ifndef USE_TCL_STUBS
sl@0: #define USE_TCL_STUBS
sl@0: #endif
sl@0: #undef USE_TCL_STUB_PROCS
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: 
sl@0: /*
sl@0:  * Ensure that Tcl_InitStubs is built as an exported symbol.  The other stub
sl@0:  * functions should be built as non-exported symbols.
sl@0:  */
sl@0: 
sl@0: TclStubs *tclStubsPtr = NULL;
sl@0: TclPlatStubs *tclPlatStubsPtr = NULL;
sl@0: TclIntStubs *tclIntStubsPtr = NULL;
sl@0: TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
sl@0: 
sl@0: static TclStubs *	HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
sl@0: 
sl@0: static TclStubs *
sl@0: HasStubSupport (interp)
sl@0:     Tcl_Interp *interp;
sl@0: {
sl@0:     Interp *iPtr = (Interp *) interp;
sl@0: 
sl@0:     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
sl@0: 	return iPtr->stubTable;
sl@0:     }
sl@0:     interp->result = "This interpreter does not support stubs-enabled extensions.";
sl@0:     interp->freeProc = TCL_STATIC;
sl@0: 
sl@0:     return NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_InitStubs --
sl@0:  *
sl@0:  *	Tries to initialise the stub table pointers and ensures that
sl@0:  *	the correct version of Tcl is loaded.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The actual version of Tcl that satisfies the request, or
sl@0:  *	NULL to indicate that an error occurred.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Sets the stub table pointers.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: #ifdef Tcl_InitStubs
sl@0: #undef Tcl_InitStubs
sl@0: #endif
sl@0: 
sl@0: CONST char *
sl@0: Tcl_InitStubs (interp, version, exact)
sl@0:     Tcl_Interp *interp;
sl@0:     CONST char *version;
sl@0:     int exact;
sl@0: {
sl@0:     CONST char *actualVersion = NULL;
sl@0:     ClientData pkgData = NULL;
sl@0: 
sl@0:     /*
sl@0:      * We can't optimize this check by caching tclStubsPtr because
sl@0:      * that prevents apps from being able to load/unload Tcl dynamically
sl@0:      * multiple times. [Bug 615304]
sl@0:      */
sl@0: 
sl@0:     tclStubsPtr = HasStubSupport(interp);
sl@0:     if (!tclStubsPtr) {
sl@0: 	return NULL;
sl@0:     }
sl@0: 
sl@0:     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
sl@0:     if (actualVersion == NULL) {
sl@0: 	return NULL;
sl@0:     }
sl@0:     tclStubsPtr = (TclStubs*)pkgData;
sl@0: 
sl@0:     if (tclStubsPtr->hooks) {
sl@0: 	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
sl@0: 	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
sl@0: 	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
sl@0:     } else {
sl@0: 	tclPlatStubsPtr = NULL;
sl@0: 	tclIntStubsPtr = NULL;
sl@0: 	tclIntPlatStubsPtr = NULL;
sl@0:     }
sl@0:     
sl@0:     return actualVersion;
sl@0: }