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