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 */
|