sl@0: /* 
sl@0:  * tclWinLoad.c --
sl@0:  *
sl@0:  *	This procedure provides a version of the TclLoadFile that
sl@0:  *	works with the Windows "LoadLibrary" and "GetProcAddress"
sl@0:  *	API for dynamic loading.
sl@0:  *
sl@0:  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclWinLoad.c,v 1.15 2002/10/10 12:25:53 vincentdarley Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclWinInt.h"
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpDlopen --
sl@0:  *
sl@0:  *	Dynamically loads a binary code file into memory and returns
sl@0:  *	a handle to the new code.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl completion code.  If an error occurs, an error
sl@0:  *	message is left in the interp's result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	New code suddenly appears in memory.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
sl@0:     Tcl_Interp *interp;		/* Used for error reporting. */
sl@0:     Tcl_Obj *pathPtr;		/* Name of the file containing the desired
sl@0: 				 * code (UTF-8). */
sl@0:     Tcl_LoadHandle *loadHandle;	/* Filled with token for dynamically loaded
sl@0: 				 * file which will be passed back to 
sl@0: 				 * (*unloadProcPtr)() to unload the file. */
sl@0:     Tcl_FSUnloadFileProc **unloadProcPtr;	
sl@0: 				/* Filled with address of Tcl_FSUnloadFileProc
sl@0: 				 * function which should be used for
sl@0: 				 * this file. */
sl@0: {
sl@0:     HINSTANCE handle;
sl@0:     CONST TCHAR *nativeName;
sl@0: 
sl@0:     /* 
sl@0:      * First try the full path the user gave us.  This is particularly
sl@0:      * important if the cwd is inside a vfs, and we are trying to load
sl@0:      * using a relative path.
sl@0:      */
sl@0:     nativeName = Tcl_FSGetNativePath(pathPtr);
sl@0:     handle = (*tclWinProcs->loadLibraryProc)(nativeName);
sl@0:     if (handle == NULL) {
sl@0: 	/* 
sl@0: 	 * Let the OS loader examine the binary search path for
sl@0: 	 * whatever string the user gave us which hopefully refers
sl@0: 	 * to a file on the binary path
sl@0: 	 */
sl@0: 	Tcl_DString ds;
sl@0:         char *fileName = Tcl_GetString(pathPtr);
sl@0: 	nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
sl@0: 	handle = (*tclWinProcs->loadLibraryProc)(nativeName);
sl@0: 	Tcl_DStringFree(&ds);
sl@0:     }
sl@0: 
sl@0:     *loadHandle = (Tcl_LoadHandle) handle;
sl@0:     
sl@0:     if (handle == NULL) {
sl@0: 	DWORD lastError = GetLastError();
sl@0: #if 0
sl@0: 	/*
sl@0: 	 * It would be ideal if the FormatMessage stuff worked better,
sl@0: 	 * but unfortunately it doesn't seem to want to...
sl@0: 	 */
sl@0: 	LPTSTR lpMsgBuf;
sl@0: 	char *buf;
sl@0: 	int size;
sl@0: 	size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
sl@0: 		FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
sl@0: 		(LPTSTR) &lpMsgBuf, 0, NULL);
sl@0: 	buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
sl@0: 	sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
sl@0: #endif
sl@0: 	Tcl_AppendResult(interp, "couldn't load library \"",
sl@0: 			 Tcl_GetString(pathPtr), "\": ", (char *) NULL);
sl@0: 	/*
sl@0: 	 * Check for possible DLL errors.  This doesn't work quite right,
sl@0: 	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for
sl@0: 	 * just about any problem, but it's better than nothing.  It'd be
sl@0: 	 * even better if there was a way to get what DLLs
sl@0: 	 */
sl@0: 	switch (lastError) {
sl@0: 	    case ERROR_MOD_NOT_FOUND:
sl@0: 	    case ERROR_DLL_NOT_FOUND:
sl@0: 		Tcl_AppendResult(interp, "this library or a dependent library",
sl@0: 			" could not be found in library path",
sl@0: 			(char *) NULL);
sl@0: 		break;
sl@0: 	    case ERROR_PROC_NOT_FOUND:
sl@0: 		Tcl_AppendResult(interp, "could not find specified procedure",
sl@0: 			(char *) NULL);
sl@0: 		break;
sl@0: 	    case ERROR_INVALID_DLL:
sl@0: 		Tcl_AppendResult(interp, "this library or a dependent library",
sl@0: 			" is damaged", (char *) NULL);
sl@0: 		break;
sl@0: 	    case ERROR_DLL_INIT_FAILED:
sl@0: 		Tcl_AppendResult(interp, "the library initialization",
sl@0: 			" routine failed", (char *) NULL);
sl@0: 		break;
sl@0: 	    default:
sl@0: 		TclWinConvertError(lastError);
sl@0: 		Tcl_AppendResult(interp, Tcl_PosixError(interp),
sl@0: 			(char *) NULL);
sl@0: 	}
sl@0: 	return TCL_ERROR;
sl@0:     } else {
sl@0: 	*unloadProcPtr = &TclpUnloadFile;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFindSymbol --
sl@0:  *
sl@0:  *	Looks up a symbol, by name, through a handle associated with
sl@0:  *	a previously loaded piece of code (shared library).
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a pointer to the function associated with 'symbol' if
sl@0:  *	it is found.  Otherwise returns NULL and may leave an error
sl@0:  *	message in the interp's result.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: Tcl_PackageInitProc*
sl@0: TclpFindSymbol(interp, loadHandle, symbol) 
sl@0:     Tcl_Interp *interp;
sl@0:     Tcl_LoadHandle loadHandle;
sl@0:     CONST char *symbol;
sl@0: {
sl@0:     Tcl_PackageInitProc *proc = NULL;
sl@0:     HINSTANCE handle = (HINSTANCE)loadHandle;
sl@0: 
sl@0:     /*
sl@0:      * For each symbol, check for both Symbol and _Symbol, since Borland
sl@0:      * generates C symbols with a leading '_' by default.
sl@0:      */
sl@0: 
sl@0:     proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
sl@0:     if (proc == NULL) {
sl@0: 	Tcl_DString ds;
sl@0: 	Tcl_DStringInit(&ds);
sl@0: 	Tcl_DStringAppend(&ds, "_", 1);
sl@0: 	symbol = Tcl_DStringAppend(&ds, symbol, -1);
sl@0: 	proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
sl@0: 	Tcl_DStringFree(&ds);
sl@0:     }
sl@0:     return proc;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpUnloadFile --
sl@0:  *
sl@0:  *	Unloads a dynamically loaded binary code file from memory.
sl@0:  *	Code pointers in the formerly loaded file are no longer valid
sl@0:  *	after calling this function.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Code removed from memory.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpUnloadFile(loadHandle)
sl@0:     Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call
sl@0: 				 * to TclpDlopen().  The loadHandle is 
sl@0: 				 * a token that represents the loaded 
sl@0: 				 * file. */
sl@0: {
sl@0:     HINSTANCE handle;
sl@0: 
sl@0:     handle = (HINSTANCE) loadHandle;
sl@0:     FreeLibrary(handle);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGuessPackageName --
sl@0:  *
sl@0:  *	If the "load" command is invoked without providing a package
sl@0:  *	name, this procedure is invoked to try to figure it out.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Always returns 0 to indicate that we couldn't figure out a
sl@0:  *	package name;  generic code will then try to guess the package
sl@0:  *	from the file name.  A return value of 1 would have meant that
sl@0:  *	we figured out the package name and put it in bufPtr.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclGuessPackageName(fileName, bufPtr)
sl@0:     CONST char *fileName;	/* Name of file containing package (already
sl@0: 				 * translated to local form if needed). */
sl@0:     Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
sl@0: 				 * package name to this if possible. */
sl@0: {
sl@0:     return 0;
sl@0: }