/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstublib.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstublib.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (show annotations) (download)
Sun Oct 30 04:21:11 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 3240 byte(s)
Adjust line endings to Windows style.
Set properties to expand the "Header" keyword.
Change header and footer.
1 /* $Header$ */
2
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 */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25