--- sf_code/esrgpcpj/shared/tcl_base/tclstublib.c 2016/10/08 06:43:03 25 +++ projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclstublib.c 2018/07/22 15:58:07 220 @@ -1,130 +1,120 @@ -/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclstublib.c,v 1.1.1.1 2001/06/13 04:46:23 dtashley Exp $ */ - -/* - * 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.1.1.1 2001/06/13 04:46:23 dtashley 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. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -TclStubs *tclStubsPtr; -TclPlatStubs *tclPlatStubsPtr; -TclIntStubs *tclIntStubsPtr; -TclIntPlatStubs *tclIntPlatStubsPtr; - -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 - -char * -Tcl_InitStubs (interp, version, exact) - Tcl_Interp *interp; - char *version; - int exact; -{ - char *actualVersion; - TclStubs *tmp; - - if (!tclStubsPtr) { - tclStubsPtr = HasStubSupport(interp); - if (!tclStubsPtr) { - return NULL; - } - } - - actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, - (ClientData *) &tmp); - if (actualVersion == NULL) { - tclStubsPtr = NULL; - return NULL; - } - - if (tclStubsPtr->hooks) { - tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; - tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; - tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; - } else { - tclPlatStubsPtr = NULL; - tclIntStubsPtr = NULL; - tclIntPlatStubsPtr = NULL; - } - - return actualVersion; -} - - -/* $History: tclstublib.c $ - * - * ***************** Version 1 ***************** - * User: Dtashley Date: 1/02/01 Time: 1:02a - * Created in $/IjuScripter, IjuConsole/Source/Tcl Base - * Initial check-in. - */ - -/* End of TCLSTUBLIB.C */ \ No newline at end of file +/* $Header$ */ +/* + * 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.1.1.1 2001/06/13 04:46:23 dtashley 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. + */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +TclStubs *tclStubsPtr; +TclPlatStubs *tclPlatStubsPtr; +TclIntStubs *tclIntStubsPtr; +TclIntPlatStubs *tclIntPlatStubsPtr; + +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 + +char * +Tcl_InitStubs (interp, version, exact) + Tcl_Interp *interp; + char *version; + int exact; +{ + char *actualVersion; + TclStubs *tmp; + + if (!tclStubsPtr) { + tclStubsPtr = HasStubSupport(interp); + if (!tclStubsPtr) { + return NULL; + } + } + + actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, + (ClientData *) &tmp); + if (actualVersion == NULL) { + tclStubsPtr = NULL; + return NULL; + } + + if (tclStubsPtr->hooks) { + tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; + tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; + tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; + } else { + tclPlatStubsPtr = NULL; + tclIntStubsPtr = NULL; + tclIntPlatStubsPtr = NULL; + } + + return actualVersion; +} + +/* End of tclstublib.c */