diff options
Diffstat (limited to 'win/tclWinLoad.c')
| -rw-r--r-- | win/tclWinLoad.c | 77 |
1 files changed, 57 insertions, 20 deletions
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 01bf6a8..124f5e2 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -5,22 +5,21 @@ * works with the Windows "LoadLibrary" and "GetProcAddress" * API for dynamic loading. * - * Copyright (c) 1995 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. * - * RCS: @(#) $Id: tclWinLoad.c,v 1.2 1998/09/14 18:40:20 stanton Exp $ + * RCS: @(#) $Id: tclWinLoad.c,v 1.3 1999/04/16 00:48:09 stanton Exp $ */ -#include "tclInt.h" -#include "tclPort.h" +#include "tclWinInt.h" /* *---------------------------------------------------------------------- * - * TclLoadFile -- + * TclpLoadFile -- * * Dynamically loads a binary code file into memory and returns * the addresses of two procedures within that file, if they @@ -28,7 +27,7 @@ * * Results: * A standard Tcl completion code. If an error occurs, an error - * message is left in interp->result. + * message is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -37,7 +36,7 @@ */ int -TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) +TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ char *fileName; /* Name of the file containing the desired * code. */ @@ -46,12 +45,22 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) Tcl_PackageInitProc **proc1Ptr, **proc2Ptr; /* Where to return the addresses corresponding * to sym1 and sym2. */ + ClientData *clientDataPtr; /* Filled with token for dynamically loaded + * file which will be passed back to + * TclpUnloadFile() to unload the file. */ { HINSTANCE handle; - char *buffer; + TCHAR *nativeName; + Tcl_DString ds; - handle = TclWinLoadLibrary(fileName); + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + handle = (*tclWinProcs->loadLibraryProc)(nativeName); + Tcl_DStringFree(&ds); + + *clientDataPtr = (ClientData) handle; + if (handle == NULL) { + TclWinConvertError(GetLastError()); Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; @@ -64,28 +73,56 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1); if (*proc1Ptr == NULL) { - buffer = ckalloc(strlen(sym1)+2); - buffer[0] = '_'; - strcpy(buffer+1, sym1); - *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer); - ckfree(buffer); + Tcl_DStringAppend(&ds, "_", 1); + sym1 = Tcl_DStringAppend(&ds, sym1, -1); + *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1); + Tcl_DStringFree(&ds); } *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2); if (*proc2Ptr == NULL) { - buffer = ckalloc(strlen(sym2)+2); - buffer[0] = '_'; - strcpy(buffer+1, sym2); - *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer); - ckfree(buffer); + Tcl_DStringAppend(&ds, "_", 1); + sym2 = Tcl_DStringAppend(&ds, sym2, -1); + *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2); + Tcl_DStringFree(&ds); } - return TCL_OK; } /* *---------------------------------------------------------------------- * + * TclpUnloadFile -- + * + * Unloads a dynamically loaded binary code file from memory. + * Code pointers in the formerly loaded file are no longer valid + * after calling this function. + * + * Results: + * None. + * + * Side effects: + * Code removed from memory. + * + *---------------------------------------------------------------------- + */ + +void +TclpUnloadFile(clientData) + ClientData clientData; /* ClientData returned by a previous call + * to TclpLoadFile(). The clientData is + * a token that represents the loaded + * file. */ +{ + HINSTANCE handle; + + handle = (HINSTANCE) clientData; + FreeLibrary(handle); +} + +/* + *---------------------------------------------------------------------- + * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package |