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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (hide annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (7 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 3013 byte(s)
Header and footer cleanup.
1 dashley 64 /* $Header$ */
2 dashley 25 /*
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 dashley 66 /* End of tclstublib.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25