diff options
Diffstat (limited to 'win/tclWinLoad.c')
| -rw-r--r-- | win/tclWinLoad.c | 335 |
1 files changed, 89 insertions, 246 deletions
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index a03132f..c4d08e8 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -5,7 +5,7 @@ * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -13,25 +13,6 @@ #include "tclWinInt.h" -/* - * Native name of the directory in the native filesystem where DLLs used in - * this process are copied prior to loading, and mutex used to protect its - * allocation. - */ - -static WCHAR *dllDirectoryName = NULL; -#if TCL_THREADS -static Tcl_Mutex dllDirectoryNameMutex; -#endif - -/* - * Static functions defined within this file. - */ - -static void * FindSymbol(Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, const char *symbol); -static int InitDLLDirectoryName(void); -static void UnloadFile(Tcl_LoadHandle loadHandle); /* *---------------------------------------------------------------------- @@ -59,16 +40,13 @@ TclpDlopen( Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr, + Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ - TCL_UNUSED(int) /*flags*/) { - HINSTANCE hInstance = NULL; - const WCHAR *nativeName; - Tcl_LoadHandle handlePtr; - DWORD firstError; + HINSTANCE handle; + CONST TCHAR *nativeName; /* * First try the full path the user gave us. This is particularly @@ -76,12 +54,10 @@ TclpDlopen( * relative path. */ - nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); - if (nativeName != NULL) { - hInstance = LoadLibraryExW(nativeName, NULL, - LOAD_WITH_ALTERED_SEARCH_PATH); - } - if (hInstance == NULL) { + nativeName = Tcl_FSGetNativePath(pathPtr); + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, + LOAD_WITH_ALTERED_SEARCH_PATH); + if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the @@ -89,39 +65,38 @@ TclpDlopen( */ Tcl_DString ds; + char *fileName = Tcl_GetString(pathPtr); - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? - ERROR_MOD_NOT_FOUND : GetLastError(); - - Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds); - hInstance = LoadLibraryExW(nativeName, NULL, + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } - if (hInstance == NULL) { - DWORD lastError; - Tcl_Obj *errMsg; + *loadHandle = (Tcl_LoadHandle) handle; - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || - firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + if (handle == NULL) { + DWORD lastError = GetLastError(); + +#if 0 + /* + * It would be ideal if the FormatMessage stuff worked better, but + * unfortunately it doesn't seem to want to... + */ + + LPTSTR lpMsgBuf; + char *buf; + int size; + + size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, + (LPTSTR) &lpMsgBuf, 0, NULL); + buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1); + sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); +#endif - errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - TclGetString(pathPtr)); + Tcl_AppendResult(interp, "couldn't load library \"", + Tcl_GetString(pathPtr), "\": ", NULL); /* * Check for possible DLL errors. This doesn't work quite right, @@ -130,63 +105,40 @@ TclpDlopen( * better if there was a way to get what DLLs */ - if (interp) { - switch (lastError) { - case ERROR_MOD_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (void *)NULL); - goto notFoundMsg; - case ERROR_DLL_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (void *)NULL); - notFoundMsg: - Tcl_AppendToObj(errMsg, "this library or a dependent library" - " could not be found in library path", TCL_INDEX_NONE); - break; - case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (void *)NULL); - Tcl_AppendToObj(errMsg, "A function specified in the import" - " table could not be resolved by the system. Windows" - " is not telling which one, I'm sorry.", TCL_INDEX_NONE); - break; - case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (void *)NULL); - Tcl_AppendToObj(errMsg, "this library or a dependent library" - " is damaged", TCL_INDEX_NONE); - break; - case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (void *)NULL); - Tcl_AppendToObj(errMsg, "the library initialization" - " routine failed", TCL_INDEX_NONE); - break; - case ERROR_BAD_EXE_FORMAT: - Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (void *)NULL); - Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: - Tcl_WinConvertError(lastError); - Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); - } - Tcl_SetObjResult(interp, errMsg); + switch (lastError) { + case ERROR_MOD_NOT_FOUND: + case ERROR_DLL_NOT_FOUND: + Tcl_AppendResult(interp, "this library or a dependent library" + " could not be found in library path", NULL); + break; + case ERROR_PROC_NOT_FOUND: + Tcl_AppendResult(interp, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", NULL); + break; + case ERROR_INVALID_DLL: + Tcl_AppendResult(interp, "this library or a dependent library" + " is damaged", NULL); + break; + case ERROR_DLL_INIT_FAILED: + Tcl_AppendResult(interp, "the library initialization" + " routine failed", NULL); + break; + default: + TclWinConvertError(lastError); + Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); } return TCL_ERROR; + } else { + *unloadProcPtr = &TclpUnloadFile; } - - /* - * Succeded; package everything up for Tcl. - */ - - handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (void *) hInstance; - handlePtr->findSymbolProcPtr = &FindSymbol; - handlePtr->unloadFileProcPtr = &UnloadFile; - *loadHandle = handlePtr; - *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * - * FindSymbol -- + * TclpFindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -199,43 +151,37 @@ TclpDlopen( *---------------------------------------------------------------------- */ -static void * -FindSymbol( +Tcl_PackageInitProc * +TclpFindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, - const char *symbol) + CONST char *symbol) { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - void *proc = NULL; + Tcl_PackageInitProc *proc = NULL; + HINSTANCE handle = (HINSTANCE)loadHandle; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void *)GetProcAddress(hInstance, symbol); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); if (proc == NULL) { Tcl_DString ds; - const char *sym2; Tcl_DStringInit(&ds); - TclDStringAppendLiteral(&ds, "_"); - sym2 = Tcl_DStringAppend(&ds, symbol, TCL_INDEX_NONE); - proc = (void *)GetProcAddress(hInstance, sym2); + Tcl_DStringAppend(&ds, "_", 1); + symbol = Tcl_DStringAppend(&ds, symbol, -1); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); Tcl_DStringFree(&ds); } - if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); - } return proc; } /* *---------------------------------------------------------------------- * - * UnloadFile -- + * TclpUnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling @@ -250,149 +196,46 @@ FindSymbol( *---------------------------------------------------------------------- */ -static void -UnloadFile( +void +TclpUnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - - FreeLibrary(hInstance); - ckfree(loadHandle); -} - -/* - *---------------------------------------------------------------------- - * - * TclpTempFileNameForLibrary -- - * - * Constructs a temporary file name for loading a shared object (DLL). - * - * Results: - * Returns the constructed file name. - * - * On Windows, a DLL is identified by the final component of its path name. - * Cross linking among DLL's (and hence, preloading) will not work unless this - * name is preserved when copying a DLL from a VFS to a temp file for - * preloading. For this reason, all DLLs in a given process are copied to a - * temp directory, and their names are preserved. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclpTempFileNameForLibrary( - Tcl_Interp *interp, /* Tcl interpreter. */ - Tcl_Obj *path) /* Path name of the DLL in the VFS. */ -{ - Tcl_Obj *fileName; /* Name of the temp file. */ - Tcl_Obj *tail; /* Tail of the source path. */ - - Tcl_MutexLock(&dllDirectoryNameMutex); - if (dllDirectoryName == NULL) { - if (InitDLLDirectoryName() == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't create temporary directory: %s", - Tcl_PosixError(interp))); - Tcl_MutexUnlock(&dllDirectoryNameMutex); - return NULL; - } - } - Tcl_MutexUnlock(&dllDirectoryNameMutex); + HINSTANCE handle; - /* - * Now we know where to put temporary DLLs, construct the name. - */ - - fileName = TclpNativeToNormalized(dllDirectoryName); - tail = TclPathPart(interp, path, TCL_PATH_TAIL); - if (tail == NULL) { - Tcl_DecrRefCount(fileName); - return NULL; - } - Tcl_AppendToObj(fileName, "/", 1); - Tcl_AppendObjToObj(fileName, tail); - return fileName; + handle = (HINSTANCE) loadHandle; + FreeLibrary(handle); } /* *---------------------------------------------------------------------- * - * InitDLLDirectoryName -- + * TclGuessPackageName -- * - * Helper for TclpTempFileNameForLibrary; builds a temporary directory - * that is specific to the current process. Should only be called once - * per process start. Caller must hold dllDirectoryNameMutex. + * If the "load" command is invoked without providing a package name, + * this function is invoked to try to figure it out. * * Results: - * Tcl result code. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * - * Side-effects: - * Creates temp directory. - * Allocates memory pointed to by dllDirectoryName. + * Side effects: + * None. * *---------------------------------------------------------------------- - * [Candidate for process global?] */ -static int -InitDLLDirectoryName(void) +int +TclGuessPackageName( + CONST char *fileName, /* Name of file containing package (already + * translated to local form if needed). */ + Tcl_DString *bufPtr) /* Initialized empty dstring. Append package + * name to this if possible. */ { - size_t nameLen; /* Length of the temp folder name. */ - WCHAR name[MAX_PATH]; /* Path name of the temp folder. */ - DWORD id; /* The process id. */ - DWORD lastError; /* Last error to happen in Win API. */ - int i; - - /* - * Determine the name of the directory to use, and create it. (Keep - * trying with new names until an attempt to create the directory - * succeeds) - */ - - nameLen = GetTempPathW(MAX_PATH, name); - if (nameLen >= MAX_PATH-12) { - Tcl_SetErrno(ENAMETOOLONG); - return TCL_ERROR; - } - - wcscpy(name+nameLen, L"TCLXXXXXXXX"); - nameLen += 11; - - id = GetCurrentProcessId(); - lastError = ERROR_ALREADY_EXISTS; - - for (i=0 ; i<256 ; i++) { - wsprintfW(name+nameLen-8, L"%08x", id); - if (CreateDirectoryW(name, NULL)) { - /* - * Issue: we don't schedule this directory for deletion by anyone. - * Can we ask the OS to do this for us? There appears to be - * potential for using CreateFile (with the flag - * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this... - */ - - goto copyToGlobalBuffer; - } - lastError = GetLastError(); - if (lastError != ERROR_ALREADY_EXISTS) { - break; - } - id *= 16777619; - } - - Tcl_WinConvertError(lastError); - return TCL_ERROR; - - /* - * Store our computed value in the global. - */ - - copyToGlobalBuffer: - dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); - wcscpy(dllDirectoryName, name); - return TCL_OK; + return 0; } /* |