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.6.2.1 2005/11/20 18:23:03 jenglish 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
36TclStubs *tclStubsPtr = NULL;
37TclPlatStubs *tclPlatStubsPtr = NULL;
38TclIntStubs *tclIntStubsPtr = NULL;
39TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
40
41static TclStubs *	HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
42
43static TclStubs *
44HasStubSupport (interp)
45    Tcl_Interp *interp;
46{
47    Interp *iPtr = (Interp *) interp;
48
49    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
50	return iPtr->stubTable;
51    }
52    interp->result = "This interpreter does not support stubs-enabled extensions.";
53    interp->freeProc = TCL_STATIC;
54
55    return NULL;
56}
57
58/*
59 *----------------------------------------------------------------------
60 *
61 * Tcl_InitStubs --
62 *
63 *	Tries to initialise the stub table pointers and ensures that
64 *	the correct version of Tcl is loaded.
65 *
66 * Results:
67 *	The actual version of Tcl that satisfies the request, or
68 *	NULL to indicate that an error occurred.
69 *
70 * Side effects:
71 *	Sets the stub table pointers.
72 *
73 *----------------------------------------------------------------------
74 */
75
76#ifdef Tcl_InitStubs
77#undef Tcl_InitStubs
78#endif
79
80CONST char *
81Tcl_InitStubs (interp, version, exact)
82    Tcl_Interp *interp;
83    CONST char *version;
84    int exact;
85{
86    CONST char *actualVersion = NULL;
87    ClientData pkgData = NULL;
88
89    /*
90     * We can't optimize this check by caching tclStubsPtr because
91     * that prevents apps from being able to load/unload Tcl dynamically
92     * multiple times. [Bug 615304]
93     */
94
95    tclStubsPtr = HasStubSupport(interp);
96    if (!tclStubsPtr) {
97	return NULL;
98    }
99
100    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
101    if (actualVersion == NULL) {
102	return NULL;
103    }
104    tclStubsPtr = (TclStubs*)pkgData;
105
106    if (tclStubsPtr->hooks) {
107	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
108	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
109	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
110    } else {
111	tclPlatStubsPtr = NULL;
112	tclIntStubsPtr = NULL;
113	tclIntPlatStubsPtr = NULL;
114    }
115
116    return actualVersion;
117}
118