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