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