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