1/* 2 * tclStubLib.c -- 3 * 4 * Stub object that will be statically linked into extensions that wish 5 * to access Tcl. 6 * 7 * Copyright (c) 1998-1999 by Scriptics Corporation. 8 * Copyright (c) 1998 Paul Duffin. 9 * 10 * See the file "license.terms" for information on usage and redistribution 11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish Exp $ 14 */ 15 16/* 17 * We need to ensure that we use the stub macros so that this file contains 18 * no references to any of the stub functions. This will make it possible 19 * to build an extension that references Tcl_InitStubs but doesn't end up 20 * including the rest of the stub functions. 21 */ 22 23#ifndef USE_TCL_STUBS 24#define USE_TCL_STUBS 25#endif 26#undef USE_TCL_STUB_PROCS 27 28#include "tclInt.h" 29#include "tclPort.h" 30 31/* 32 * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub 33 * functions should be built as non-exported symbols. 34 */ 35 36TclStubs *tclStubsPtr = NULL; 37TclPlatStubs *tclPlatStubsPtr = NULL; 38TclIntStubs *tclIntStubsPtr = NULL; 39TclIntPlatStubs *tclIntPlatStubsPtr = NULL; 40 41static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); 42 43static TclStubs * 44HasStubSupport (interp) 45 Tcl_Interp *interp; 46{ 47 Interp *iPtr = (Interp *) interp; 48 49 if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { 50 return iPtr->stubTable; 51 } 52 interp->result = "This interpreter does not support stubs-enabled extensions."; 53 interp->freeProc = TCL_STATIC; 54 55 return NULL; 56} 57 58/* 59 *---------------------------------------------------------------------- 60 * 61 * Tcl_InitStubs -- 62 * 63 * Tries to initialise the stub table pointers and ensures that 64 * the correct version of Tcl is loaded. 65 * 66 * Results: 67 * The actual version of Tcl that satisfies the request, or 68 * NULL to indicate that an error occurred. 69 * 70 * Side effects: 71 * Sets the stub table pointers. 72 * 73 *---------------------------------------------------------------------- 74 */ 75 76#ifdef Tcl_InitStubs 77#undef Tcl_InitStubs 78#endif 79 80CONST char * 81Tcl_InitStubs (interp, version, exact) 82 Tcl_Interp *interp; 83 CONST char *version; 84 int exact; 85{ 86 CONST char *actualVersion = NULL; 87 ClientData pkgData = NULL; 88 89 /* 90 * We can't optimize this check by caching tclStubsPtr because 91 * that prevents apps from being able to load/unload Tcl dynamically 92 * multiple times. [Bug 615304] 93 */ 94 95 tclStubsPtr = HasStubSupport(interp); 96 if (!tclStubsPtr) { 97 return NULL; 98 } 99 100 actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData); 101 if (actualVersion == NULL) { 102 return NULL; 103 } 104 tclStubsPtr = (TclStubs*)pkgData; 105 106 if (tclStubsPtr->hooks) { 107 tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; 108 tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; 109 tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; 110 } else { 111 tclPlatStubsPtr = NULL; 112 tclIntStubsPtr = NULL; 113 tclIntPlatStubsPtr = NULL; 114 } 115 116 return actualVersion; 117} 118