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