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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25