diff options
author | stanton <stanton> | 1999-03-05 20:18:02 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-03-05 20:18:02 (GMT) |
commit | 4848a73bb6c843cd8ba7e7d036ccf9c76a7ab6a4 (patch) | |
tree | 48c4d4ac8a137bb69266d3385e3c1376636de8c7 /generic/tclStubLib.c | |
parent | bd758c72b2b9652bcd22a8856ee0bf804c80b699 (diff) | |
download | tcl-4848a73bb6c843cd8ba7e7d036ccf9c76a7ab6a4.zip tcl-4848a73bb6c843cd8ba7e7d036ccf9c76a7ab6a4.tar.gz tcl-4848a73bb6c843cd8ba7e7d036ccf9c76a7ab6a4.tar.bz2 |
* generic/tclCompile.h:
* generic/tclStubInit.c:
* generic/tclCompileDecls.h:
* generic/tclCompileStubs.c:
* generic/tclInt.decls: Added functions from tclCompile.h into a
new tclCompile interface.
* generic/tclStubs.c:
* generic/tclDecls.h:
* generic/tcl.decls: Added Tcl_InitMemory.
* generic/tclStubLib.c: Changed to define USE_TCL_STUBS and
USE_TCL_STUB_PROCS automatically.
* unix/Makefile.in: Changes to get stubs mechanism working.
* generic/tclGetDate.y: Updated to reflect tclDate.c changes.
* tools/genStubs.tcl:
* generic/tclProc.c:
* generic/tclStubInit.c:
* generic/tclTest.c:
* unix/tclUnixFile.c:
* unix/tclUnixPort.h: lint
* win/makefile.vc:
* generic/tclAlloc.c: Changed USE_NATIVEMALLOC to USE_NATIVE_MALLOC.
Diffstat (limited to 'generic/tclStubLib.c')
-rw-r--r-- | generic/tclStubLib.c | 113 |
1 files changed, 113 insertions, 0 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c new file mode 100644 index 0000000..ad66578 --- /dev/null +++ b/generic/tclStubLib.c @@ -0,0 +1,113 @@ +/* + * 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.2.2.1 1999/03/05 20:18:06 stanton 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. + * + *---------------------------------------------------------------------- + */ + +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; +} |