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