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

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclstublib.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstublib.c revision 44 by dashley, Fri Oct 14 02:09:58 2016 UTC projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclstublib.c revision 220 by dashley, Sun Jul 22 15:58:07 2018 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclstublib.c,v 1.1.1.1 2001/06/13 04:46:23 dtashley Exp $ */  
   
 /*  
  * tclStubLib.c --  
  *  
  *      Stub object that will be statically linked into extensions that wish  
  *      to access Tcl.  
  *  
  * Copyright (c) 1998-1999 by Scriptics Corporation.  
  * Copyright (c) 1998 Paul Duffin.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclstublib.c,v 1.1.1.1 2001/06/13 04:46:23 dtashley Exp $  
  */  
   
 /*  
  * We need to ensure that we use the stub macros so that this file contains  
  * no references to any of the stub functions.  This will make it possible  
  * to build an extension that references Tcl_InitStubs but doesn't end up  
  * including the rest of the stub functions.  
  */  
   
 #ifndef USE_TCL_STUBS  
 #define USE_TCL_STUBS  
 #endif  
 #undef USE_TCL_STUB_PROCS  
   
 #include "tclInt.h"  
 #include "tclPort.h"  
   
 /*  
  * Ensure that Tcl_InitStubs is built as an exported symbol.  The other stub  
  * functions should be built as non-exported symbols.  
  */  
   
 #undef TCL_STORAGE_CLASS  
 #define TCL_STORAGE_CLASS DLLEXPORT  
   
 TclStubs *tclStubsPtr;  
 TclPlatStubs *tclPlatStubsPtr;  
 TclIntStubs *tclIntStubsPtr;  
 TclIntPlatStubs *tclIntPlatStubsPtr;  
   
 static TclStubs *       HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));  
   
 static TclStubs *  
 HasStubSupport (interp)  
     Tcl_Interp *interp;  
 {  
     Interp *iPtr = (Interp *) interp;  
   
     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {  
         return iPtr->stubTable;  
     }  
     interp->result = "This interpreter does not support stubs-enabled extensions.";  
     interp->freeProc = TCL_STATIC;  
   
     return NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_InitStubs --  
  *  
  *      Tries to initialise the stub table pointers and ensures that  
  *      the correct version of Tcl is loaded.  
  *  
  * Results:  
  *      The actual version of Tcl that satisfies the request, or  
  *      NULL to indicate that an error occurred.  
  *  
  * Side effects:  
  *      Sets the stub table pointers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 #ifdef Tcl_InitStubs  
 #undef Tcl_InitStubs  
 #endif  
   
 char *  
 Tcl_InitStubs (interp, version, exact)  
     Tcl_Interp *interp;  
     char *version;  
     int exact;  
 {  
     char *actualVersion;  
     TclStubs *tmp;  
       
     if (!tclStubsPtr) {  
         tclStubsPtr = HasStubSupport(interp);  
         if (!tclStubsPtr) {  
             return NULL;  
         }  
     }  
   
     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact,  
             (ClientData *) &tmp);  
     if (actualVersion == NULL) {  
         tclStubsPtr = NULL;  
         return NULL;  
     }  
   
     if (tclStubsPtr->hooks) {  
         tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;  
         tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;  
         tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;  
     } else {  
         tclPlatStubsPtr = NULL;  
         tclIntStubsPtr = NULL;  
         tclIntPlatStubsPtr = NULL;  
     }  
       
     return actualVersion;  
 }  
   
   
 /* $History: tclstublib.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:02a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLSTUBLIB.C */  
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 */
Legend:
Removed from v.44  
changed lines
  Added in v.220
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25