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

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinload.c

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

revision 44 by dashley, Fri Oct 14 02:09:58 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $ */  
   
 /*  
  * tclWinLoad.c --  
  *  
  *      This procedure provides a version of the TclLoadFile that  
  *      works with the Windows "LoadLibrary" and "GetProcAddress"  
  *      API for dynamic loading.  
  *  
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $  
  */  
   
 #include "tclWinInt.h"  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpLoadFile --  
  *  
  *      Dynamically loads a binary code file into memory and returns  
  *      the addresses of two procedures within that file, if they  
  *      are defined.  
  *  
  * Results:  
  *      A standard Tcl completion code.  If an error occurs, an error  
  *      message is left in the interp's result.  
  *  
  * Side effects:  
  *      New code suddenly appears in memory.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)  
     Tcl_Interp *interp;         /* Used for error reporting. */  
     char *fileName;             /* Name of the file containing the desired  
                                  * code. */  
     char *sym1, *sym2;          /* Names of two procedures to look up in  
                                  * the file's symbol table. */  
     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;  
                                 /* Where to return the addresses corresponding  
                                  * to sym1 and sym2. */  
     ClientData *clientDataPtr;  /* Filled with token for dynamically loaded  
                                  * file which will be passed back to  
                                  * TclpUnloadFile() to unload the file. */  
 {  
     HINSTANCE handle;  
     TCHAR *nativeName;  
     Tcl_DString ds;  
   
     nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);  
     handle = (*tclWinProcs->loadLibraryProc)(nativeName);  
     Tcl_DStringFree(&ds);  
   
     *clientDataPtr = (ClientData) handle;  
       
     if (handle == NULL) {  
         DWORD lastError = GetLastError();  
 #if 0  
         /*  
          * It would be ideal if the FormatMessage stuff worked better,  
          * but unfortunately it doesn't seem to want to...  
          */  
         LPTSTR lpMsgBuf;  
         char *buf;  
         int size;  
         size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |  
                 FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,  
                 (LPTSTR) &lpMsgBuf, 0, NULL);  
         buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);  
         sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);  
 #endif  
         Tcl_AppendResult(interp, "couldn't load library \"",  
                 fileName, "\": ", (char *) NULL);  
         /*  
          * Check for possible DLL errors.  This doesn't work quite right,  
          * because Windows seems to only return ERROR_MOD_NOT_FOUND for  
          * just about any problem, but it's better than nothing.  It'd be  
          * even better if there was a way to get what DLLs  
          */  
         switch (lastError) {  
             case ERROR_MOD_NOT_FOUND:  
             case ERROR_DLL_NOT_FOUND:  
                 Tcl_AppendResult(interp, "this library or a dependent library",  
                         " could not be found in library path", (char *)  
                         NULL);  
                 break;  
             case ERROR_INVALID_DLL:  
                 Tcl_AppendResult(interp, "this library or a dependent library",  
                         " is damaged", (char *) NULL);  
                 break;  
             case ERROR_DLL_INIT_FAILED:  
                 Tcl_AppendResult(interp, "the library initialization",  
                         " routine failed", (char *) NULL);  
                 break;  
             default:  
                 TclWinConvertError(lastError);  
                 Tcl_AppendResult(interp, Tcl_PosixError(interp),  
                         (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
   
     /*  
      * For each symbol, check for both Symbol and _Symbol, since Borland  
      * generates C symbols with a leading '_' by default.  
      */  
   
     *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);  
     if (*proc1Ptr == NULL) {  
         Tcl_DStringAppend(&ds, "_", 1);  
         sym1 = Tcl_DStringAppend(&ds, sym1, -1);  
         *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);  
         Tcl_DStringFree(&ds);  
     }  
       
     *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);  
     if (*proc2Ptr == NULL) {  
         Tcl_DStringAppend(&ds, "_", 1);  
         sym2 = Tcl_DStringAppend(&ds, sym2, -1);  
         *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);  
         Tcl_DStringFree(&ds);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpUnloadFile --  
  *  
  *      Unloads a dynamically loaded binary code file from memory.  
  *      Code pointers in the formerly loaded file are no longer valid  
  *      after calling this function.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Code removed from memory.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TclpUnloadFile(clientData)  
     ClientData clientData;      /* ClientData returned by a previous call  
                                  * to TclpLoadFile().  The clientData is  
                                  * a token that represents the loaded  
                                  * file. */  
 {  
     HINSTANCE handle;  
   
     handle = (HINSTANCE) clientData;  
     FreeLibrary(handle);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclGuessPackageName --  
  *  
  *      If the "load" command is invoked without providing a package  
  *      name, this procedure is invoked to try to figure it out.  
  *  
  * Results:  
  *      Always returns 0 to indicate that we couldn't figure out a  
  *      package name;  generic code will then try to guess the package  
  *      from the file name.  A return value of 1 would have meant that  
  *      we figured out the package name and put it in bufPtr.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclGuessPackageName(fileName, bufPtr)  
     char *fileName;             /* Name of file containing package (already  
                                  * translated to local form if needed). */  
     Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append  
                                  * package name to this if possible. */  
 {  
     return 0;  
 }  
   
   
 /* $History: tclwinload.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:40a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLWINLOAD.C */  
1    /* $Header$ */
2    /*
3     * tclWinLoad.c --
4     *
5     *      This procedure provides a version of the TclLoadFile that
6     *      works with the Windows "LoadLibrary" and "GetProcAddress"
7     *      API for dynamic loading.
8     *
9     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
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: tclwinload.c,v 1.1.1.1 2001/06/13 04:49:20 dtashley Exp $
15     */
16    
17    #include "tclWinInt.h"
18    
19    
20    /*
21     *----------------------------------------------------------------------
22     *
23     * TclpLoadFile --
24     *
25     *      Dynamically loads a binary code file into memory and returns
26     *      the addresses of two procedures within that file, if they
27     *      are defined.
28     *
29     * Results:
30     *      A standard Tcl completion code.  If an error occurs, an error
31     *      message is left in the interp's result.
32     *
33     * Side effects:
34     *      New code suddenly appears in memory.
35     *
36     *----------------------------------------------------------------------
37     */
38    
39    int
40    TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
41        Tcl_Interp *interp;         /* Used for error reporting. */
42        char *fileName;             /* Name of the file containing the desired
43                                     * code. */
44        char *sym1, *sym2;          /* Names of two procedures to look up in
45                                     * the file's symbol table. */
46        Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
47                                    /* Where to return the addresses corresponding
48                                     * to sym1 and sym2. */
49        ClientData *clientDataPtr;  /* Filled with token for dynamically loaded
50                                     * file which will be passed back to
51                                     * TclpUnloadFile() to unload the file. */
52    {
53        HINSTANCE handle;
54        TCHAR *nativeName;
55        Tcl_DString ds;
56    
57        nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
58        handle = (*tclWinProcs->loadLibraryProc)(nativeName);
59        Tcl_DStringFree(&ds);
60    
61        *clientDataPtr = (ClientData) handle;
62        
63        if (handle == NULL) {
64            DWORD lastError = GetLastError();
65    #if 0
66            /*
67             * It would be ideal if the FormatMessage stuff worked better,
68             * but unfortunately it doesn't seem to want to...
69             */
70            LPTSTR lpMsgBuf;
71            char *buf;
72            int size;
73            size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
74                    FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
75                    (LPTSTR) &lpMsgBuf, 0, NULL);
76            buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
77            sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
78    #endif
79            Tcl_AppendResult(interp, "couldn't load library \"",
80                    fileName, "\": ", (char *) NULL);
81            /*
82             * Check for possible DLL errors.  This doesn't work quite right,
83             * because Windows seems to only return ERROR_MOD_NOT_FOUND for
84             * just about any problem, but it's better than nothing.  It'd be
85             * even better if there was a way to get what DLLs
86             */
87            switch (lastError) {
88                case ERROR_MOD_NOT_FOUND:
89                case ERROR_DLL_NOT_FOUND:
90                    Tcl_AppendResult(interp, "this library or a dependent library",
91                            " could not be found in library path", (char *)
92                            NULL);
93                    break;
94                case ERROR_INVALID_DLL:
95                    Tcl_AppendResult(interp, "this library or a dependent library",
96                            " is damaged", (char *) NULL);
97                    break;
98                case ERROR_DLL_INIT_FAILED:
99                    Tcl_AppendResult(interp, "the library initialization",
100                            " routine failed", (char *) NULL);
101                    break;
102                default:
103                    TclWinConvertError(lastError);
104                    Tcl_AppendResult(interp, Tcl_PosixError(interp),
105                            (char *) NULL);
106            }
107            return TCL_ERROR;
108        }
109    
110        /*
111         * For each symbol, check for both Symbol and _Symbol, since Borland
112         * generates C symbols with a leading '_' by default.
113         */
114    
115        *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
116        if (*proc1Ptr == NULL) {
117            Tcl_DStringAppend(&ds, "_", 1);
118            sym1 = Tcl_DStringAppend(&ds, sym1, -1);
119            *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
120            Tcl_DStringFree(&ds);
121        }
122        
123        *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
124        if (*proc2Ptr == NULL) {
125            Tcl_DStringAppend(&ds, "_", 1);
126            sym2 = Tcl_DStringAppend(&ds, sym2, -1);
127            *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
128            Tcl_DStringFree(&ds);
129        }
130        return TCL_OK;
131    }
132    
133    /*
134     *----------------------------------------------------------------------
135     *
136     * TclpUnloadFile --
137     *
138     *      Unloads a dynamically loaded binary code file from memory.
139     *      Code pointers in the formerly loaded file are no longer valid
140     *      after calling this function.
141     *
142     * Results:
143     *      None.
144     *
145     * Side effects:
146     *      Code removed from memory.
147     *
148     *----------------------------------------------------------------------
149     */
150    
151    void
152    TclpUnloadFile(clientData)
153        ClientData clientData;      /* ClientData returned by a previous call
154                                     * to TclpLoadFile().  The clientData is
155                                     * a token that represents the loaded
156                                     * file. */
157    {
158        HINSTANCE handle;
159    
160        handle = (HINSTANCE) clientData;
161        FreeLibrary(handle);
162    }
163    
164    /*
165     *----------------------------------------------------------------------
166     *
167     * TclGuessPackageName --
168     *
169     *      If the "load" command is invoked without providing a package
170     *      name, this procedure is invoked to try to figure it out.
171     *
172     * Results:
173     *      Always returns 0 to indicate that we couldn't figure out a
174     *      package name;  generic code will then try to guess the package
175     *      from the file name.  A return value of 1 would have meant that
176     *      we figured out the package name and put it in bufPtr.
177     *
178     * Side effects:
179     *      None.
180     *
181     *----------------------------------------------------------------------
182     */
183    
184    int
185    TclGuessPackageName(fileName, bufPtr)
186        char *fileName;             /* Name of file containing package (already
187                                     * translated to local form if needed). */
188        Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
189                                     * package name to this if possible. */
190    {
191        return 0;
192    }
193    
194    /* End of tclwinload.c */
Legend:
Removed from v.44  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25