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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 67 - (hide annotations) (download)
Mon Oct 31 00:57:34 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 5884 byte(s)
Header and footer cleanup.
1 dashley 64 /* $Header$ */
2 dashley 25 /*
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 dashley 67 /* End of tclwinload.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25