1/*
2 * tclWinLoad.c --
3 *
4 *	This function provides a version of the TclLoadFile that works with
5 *	the Windows "LoadLibrary" and "GetProcAddress" API for dynamic
6 *	loading.
7 *
8 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclWinLoad.c,v 1.20.4.1 2010/08/04 19:17:29 hobbs Exp $
14 */
15
16#include "tclWinInt.h"
17
18
19/*
20 *----------------------------------------------------------------------
21 *
22 * TclpDlopen --
23 *
24 *	Dynamically loads a binary code file into memory and returns a handle
25 *	to the new code.
26 *
27 * Results:
28 *	A standard Tcl completion code. If an error occurs, an error message
29 *	is left in the interp's result.
30 *
31 * Side effects:
32 *	New code suddenly appears in memory.
33 *
34 *----------------------------------------------------------------------
35 */
36
37int
38TclpDlopen(
39    Tcl_Interp *interp,		/* Used for error reporting. */
40    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
41				 * code (UTF-8). */
42    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
43				 * file which will be passed back to
44				 * (*unloadProcPtr)() to unload the file. */
45    Tcl_FSUnloadFileProc **unloadProcPtr)
46				/* Filled with address of Tcl_FSUnloadFileProc
47				 * function which should be used for this
48				 * file. */
49{
50    HINSTANCE handle;
51    CONST TCHAR *nativeName;
52
53    /*
54     * First try the full path the user gave us. This is particularly
55     * important if the cwd is inside a vfs, and we are trying to load using a
56     * relative path.
57     */
58
59    nativeName = Tcl_FSGetNativePath(pathPtr);
60    handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
61	    LOAD_WITH_ALTERED_SEARCH_PATH);
62    if (handle == NULL) {
63	/*
64	 * Let the OS loader examine the binary search path for whatever
65	 * string the user gave us which hopefully refers to a file on the
66	 * binary path.
67	 */
68
69	Tcl_DString ds;
70	char *fileName = Tcl_GetString(pathPtr);
71
72	nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
73	handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
74		LOAD_WITH_ALTERED_SEARCH_PATH);
75	Tcl_DStringFree(&ds);
76    }
77
78    *loadHandle = (Tcl_LoadHandle) handle;
79
80    if (handle == NULL) {
81	DWORD lastError = GetLastError();
82
83#if 0
84	/*
85	 * It would be ideal if the FormatMessage stuff worked better, but
86	 * unfortunately it doesn't seem to want to...
87	 */
88
89	LPTSTR lpMsgBuf;
90	char *buf;
91	int size;
92
93	size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
94		FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
95		(LPTSTR) &lpMsgBuf, 0, NULL);
96	buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
97	sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
98#endif
99
100	Tcl_AppendResult(interp, "couldn't load library \"",
101		Tcl_GetString(pathPtr), "\": ", NULL);
102
103	/*
104	 * Check for possible DLL errors. This doesn't work quite right,
105	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
106	 * about any problem, but it's better than nothing. It'd be even
107	 * better if there was a way to get what DLLs
108	 */
109
110	switch (lastError) {
111	case ERROR_MOD_NOT_FOUND:
112	case ERROR_DLL_NOT_FOUND:
113	    Tcl_AppendResult(interp, "this library or a dependent library"
114		    " could not be found in library path", NULL);
115	    break;
116	case ERROR_PROC_NOT_FOUND:
117	    Tcl_AppendResult(interp, "A function specified in the import"
118		    " table could not be resolved by the system.  Windows"
119		    " is not telling which one, I'm sorry.", NULL);
120	    break;
121	case ERROR_INVALID_DLL:
122	    Tcl_AppendResult(interp, "this library or a dependent library"
123		    " is damaged", NULL);
124	    break;
125	case ERROR_DLL_INIT_FAILED:
126	    Tcl_AppendResult(interp, "the library initialization"
127		    " routine failed", NULL);
128	    break;
129	default:
130	    TclWinConvertError(lastError);
131	    Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
132	}
133	return TCL_ERROR;
134    } else {
135	*unloadProcPtr = &TclpUnloadFile;
136    }
137    return TCL_OK;
138}
139
140/*
141 *----------------------------------------------------------------------
142 *
143 * TclpFindSymbol --
144 *
145 *	Looks up a symbol, by name, through a handle associated with a
146 *	previously loaded piece of code (shared library).
147 *
148 * Results:
149 *	Returns a pointer to the function associated with 'symbol' if it is
150 *	found. Otherwise returns NULL and may leave an error message in the
151 *	interp's result.
152 *
153 *----------------------------------------------------------------------
154 */
155
156Tcl_PackageInitProc *
157TclpFindSymbol(
158    Tcl_Interp *interp,
159    Tcl_LoadHandle loadHandle,
160    CONST char *symbol)
161{
162    Tcl_PackageInitProc *proc = NULL;
163    HINSTANCE handle = (HINSTANCE)loadHandle;
164
165    /*
166     * For each symbol, check for both Symbol and _Symbol, since Borland
167     * generates C symbols with a leading '_' by default.
168     */
169
170    proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
171    if (proc == NULL) {
172	Tcl_DString ds;
173
174	Tcl_DStringInit(&ds);
175	Tcl_DStringAppend(&ds, "_", 1);
176	symbol = Tcl_DStringAppend(&ds, symbol, -1);
177	proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
178	Tcl_DStringFree(&ds);
179    }
180    return proc;
181}
182
183/*
184 *----------------------------------------------------------------------
185 *
186 * TclpUnloadFile --
187 *
188 *	Unloads a dynamically loaded binary code file from memory. Code
189 *	pointers in the formerly loaded file are no longer valid after calling
190 *	this function.
191 *
192 * Results:
193 *	None.
194 *
195 * Side effects:
196 *	Code removed from memory.
197 *
198 *----------------------------------------------------------------------
199 */
200
201void
202TclpUnloadFile(
203    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
204				 * TclpDlopen(). The loadHandle is a token
205				 * that represents the loaded file. */
206{
207    HINSTANCE handle;
208
209    handle = (HINSTANCE) loadHandle;
210    FreeLibrary(handle);
211}
212
213/*
214 *----------------------------------------------------------------------
215 *
216 * TclGuessPackageName --
217 *
218 *	If the "load" command is invoked without providing a package name,
219 *	this function is invoked to try to figure it out.
220 *
221 * Results:
222 *	Always returns 0 to indicate that we couldn't figure out a package
223 *	name; generic code will then try to guess the package from the file
224 *	name. A return value of 1 would have meant that we figured out the
225 *	package name and put it in bufPtr.
226 *
227 * Side effects:
228 *	None.
229 *
230 *----------------------------------------------------------------------
231 */
232
233int
234TclGuessPackageName(
235    CONST char *fileName,	/* Name of file containing package (already
236				 * translated to local form if needed). */
237    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
238				 * name to this if possible. */
239{
240    return 0;
241}
242
243/*
244 * Local Variables:
245 * mode: c
246 * c-basic-offset: 4
247 * fill-column: 78
248 * End:
249 */
250