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

Annotation of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstublib.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (8 years, 1 month ago) by dashley
Original Path: projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstublib.c
File MIME type: text/plain
File size: 3344 byte(s)
Rename for reorganization.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclstublib.c,v 1.1.1.1 2001/06/13 04:46:23 dtashley Exp $ */
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 */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25