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